-
Notifications
You must be signed in to change notification settings - Fork 212
/
cardano-wallet-jormungandr.hs
450 lines (418 loc) · 14.8 KB
/
cardano-wallet-jormungandr.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- This module parses command line arguments for the wallet and executes
-- corresponding commands.
--
-- In essence, it's a proxy to the wallet server, which is required for most
-- commands. Commands are turned into corresponding API calls, and submitted
-- to an up-and-running server. Some commands do not require an active server
-- and can be run "offline".
module Main where
import Prelude
import Cardano.BM.Data.Severity
( Severity (..) )
import Cardano.BM.Trace
( Trace, appendName, logInfo, logNotice )
import Cardano.CLI
( LogOutput (..)
, LoggingOptions (..)
, Port (..)
, cli
, cmdAddress
, cmdKey
, cmdMnemonic
, cmdNetwork
, cmdStakePool
, cmdTransaction
, cmdVersion
, cmdWallet
, cmdWalletCreate
, databaseOption
, enableWindowsANSI
, getDataDir
, helperTracing
, hostPreferenceOption
, listenOption
, loggingOptions
, loggingSeverityOrOffReader
, nodePortMaybeOption
, nodePortOption
, optionT
, requireFilePath
, runCli
, setupDirectory
, shutdownHandlerFlag
, stateDirOption
, syncToleranceOption
, withLogging
)
import Cardano.Launcher
( StdStream (..) )
import Cardano.Pool.Jormungandr.Metadata
( ApiStakePool )
import Cardano.Startup
( ShutdownHandlerLog
, installSignalHandlers
, withShutdownHandler
, withUtf8Encoding
)
import Cardano.Wallet.Api.Client
( addressClient
, networkClient
, stakePoolClient
, transactionClient
, walletClient
)
import Cardano.Wallet.Api.Server
( HostPreference, Listen (..) )
import Cardano.Wallet.Jormungandr
( TracerSeverities
, Tracers
, Tracers' (..)
, serveWallet
, setupTracers
, tracerDescriptions
, tracerLabels
)
import Cardano.Wallet.Jormungandr.Compatibility
( localhostBaseUrl )
import Cardano.Wallet.Jormungandr.Network
( JormungandrBackend (..)
, JormungandrConfig (..)
, JormungandrConnParams (..)
)
import Cardano.Wallet.Logging
( trMessage, transformTextTrace )
import Cardano.Wallet.Primitive.AddressDerivation
( NetworkDiscriminant (..) )
import Cardano.Wallet.Primitive.SyncProgress
( SyncTolerance )
import Cardano.Wallet.Primitive.Types
( Hash (..), NetworkParameters )
import Cardano.Wallet.Version
( GitRevision, Version, gitRevision, showFullVersion, version )
import Control.Applicative
( Const (..), optional, (<|>) )
import Control.Arrow
( second )
import Control.Monad
( void )
import Control.Tracer
( contramap )
import Data.List
( isPrefixOf )
import Data.Maybe
( fromMaybe )
import Data.Text
( Text )
import Data.Text.Class
( ToText (..) )
import Network.Socket
( SockAddr )
import Options.Applicative
( CommandFields
, Mod
, Parser
, argument
, command
, footerDoc
, help
, helper
, info
, internal
, long
, many
, metavar
, option
, progDesc
, value
)
import Options.Applicative.Types
( readerAsk, readerError )
import System.Environment
( getArgs, getExecutablePath )
import System.Exit
( exitWith )
import System.FilePath
( (</>) )
import qualified Data.Text as T
import qualified Options.Applicative.Help.Pretty as D
{-------------------------------------------------------------------------------
Main entry point
FIXME:
We instiantiate everything below to 'Testnet' because there's no way
to actually implement the wallet, transaction and address command without
any prior knowledge of the target network (since the serialization of
addresses depends on that).
This is okay for now as do only have access to a 'Testnet' anyway, but in the
long run, we may want to (pick one):
- Provide a `--network` parameter to pretty much every command
- Construct two executables, one for 'Testnet' and one for 'Mainnet'
- Use an environment variable
- ?
-------------------------------------------------------------------------------}
main :: IO ()
main = withUtf8Encoding $ do
enableWindowsANSI
dataDir <- getDataDir "jormungandr"
runCli $ cli $ mempty
<> cmdLaunch dataDir
<> cmdServe
<> cmdMnemonic
<> cmdWallet cmdWalletCreate walletClient
<> cmdTransaction transactionClient walletClient
<> cmdAddress addressClient
<> cmdStakePool @ApiStakePool stakePoolClient
<> cmdNetwork networkClient
<> cmdVersion
<> cmdKey
beforeMainLoop
:: Trace IO MainLog
-> SockAddr
-> Port "node"
-> NetworkParameters
-> IO ()
beforeMainLoop tr addr _ _ = logInfo tr $ MsgListenAddress addr
{-------------------------------------------------------------------------------
Command - 'launch'
-------------------------------------------------------------------------------}
-- | Arguments for the 'launch' command
data LaunchArgs = LaunchArgs
{ _hostPreference :: HostPreference
, _listen :: Listen
, _nodePort :: Maybe (Port "Node")
, _stateDir :: Maybe FilePath
, _syncTolerance :: SyncTolerance
, _logging :: LoggingOptions TracerSeverities
, _jormungandrArgs :: JormungandrArgs
} deriving (Show, Eq)
data JormungandrArgs = JormungandrArgs
{ genesisBlock :: Either (Hash "Genesis") FilePath
, extraJormungandrArgs :: [String]
} deriving (Show, Eq)
cmdLaunch
:: FilePath
-> Mod CommandFields (IO ())
cmdLaunch dataDir = command "launch" $ info (helper <*> helper' <*> cmd) $ mempty
<> progDesc "Launch and monitor a wallet server and its chain producers."
<> footerDoc (Just $ D.empty
<> D.text "Examples:"
<> D.line
<> D.text "1) Minimal setup, relying on sensible defaults:" <> D.line
<> D.text " launch --genesis-block block0.bin" <> D.line
<> D.line
<> D.text "2) Launching a full node: " <> D.line
<> D.text " launch --genesis-block block0.bin -- --secret secret.yaml" <> D.line
<> D.line
<> D.text "3) Bootstrapping from trusted peers*:" <> D.line
<> D.text " launch --genesis-block-hash 4c05c5bb -- --config config.yaml" <> D.line
<> D.line
<> D.text "(*) assuming 'trusted_peers' is defined in 'config.yaml'"
<> D.line
<> D.line
<> D.text "Please also note that 'launch' will define a 'rest' and" <> D.line
<> D.text "'storage' configuration for Jörmungandr so in case you" <> D.line
<> D.text "provide a configuration file as extra arguments, make sure" <> D.line
<> D.text "not to define any these configuration settings."
)
where
helper' = helperTracing tracerDescriptions
cmd = fmap exec $ LaunchArgs
<$> hostPreferenceOption
<*> listenOption
<*> nodePortMaybeOption
<*> stateDirOption dataDir
<*> syncToleranceOption
<*> loggingOptions tracerSeveritiesOption
<*> (JormungandrArgs
<$> genesisBlockOption
<*> extraArguments)
exec args@(LaunchArgs hostPreference listen nodePort mStateDir sTolerance logOpt jArgs) = do
withTracers logOpt $ \tr tracers -> do
installSignalHandlers (logNotice tr MsgSigTerm)
logInfo tr $ MsgLaunchArgs args
case genesisBlock jArgs of
Right block0File -> requireFilePath block0File
Left _ -> pure ()
let stateDir = fromMaybe (dataDir </> "testnet") mStateDir
let databaseDir = stateDir </> "wallets"
let cp = JormungandrConfig
{ _stateDir = stateDir
, _genesisBlock = genesisBlock jArgs
, _restApiPort = fromIntegral . getPort <$> nodePort
, _outputStream = Inherit
, _extraArgs = extraJormungandrArgs jArgs
}
setupDirectory (logInfo tr . MsgSetupStateDir) stateDir
setupDirectory (logInfo tr . MsgSetupDatabases) databaseDir
exitWith =<< serveWallet @('Testnet 0)
tracers
sTolerance
(Just databaseDir)
hostPreference
listen
(Launch cp)
(beforeMainLoop tr)
{-------------------------------------------------------------------------------
Command - 'serve'
-------------------------------------------------------------------------------}
-- | Arguments for the 'serve' command
data ServeArgs = ServeArgs
{ _hostPreference :: HostPreference
, _listen :: Listen
, _nodePort :: Port "Node"
, _database :: Maybe FilePath
, _syncTolerance :: SyncTolerance
, _block0H :: Hash "Genesis"
, _enableShutdownHandler :: Bool
, _logging :: LoggingOptions TracerSeverities
} deriving (Show, Eq)
cmdServe
:: Mod CommandFields (IO ())
cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty
<> progDesc "Serve API that listens for commands/actions."
where
helper' = helperTracing tracerDescriptions
cmd = fmap exec $ ServeArgs
<$> hostPreferenceOption
<*> listenOption
<*> nodePortOption
<*> optional databaseOption
<*> syncToleranceOption
<*> genesisHashOption
<*> shutdownHandlerFlag
<*> loggingOptions tracerSeveritiesOption
exec
:: ServeArgs
-> IO ()
exec args@(ServeArgs hostPreference listen nodePort databaseDir sTolerance block0H enableShutdownHandler logOpt) = do
withTracers logOpt $ \tr tracers -> do
installSignalHandlers (logNotice tr MsgSigTerm)
withShutdownHandlerMaybe tr enableShutdownHandler $ do
logInfo tr $ MsgServeArgs args
let baseUrl = localhostBaseUrl $ getPort nodePort
let cp = JormungandrConnParams block0H baseUrl
whenJust databaseDir $ setupDirectory (logInfo tr . MsgSetupDatabases)
exitWith =<< serveWallet @('Testnet 0)
tracers
sTolerance
databaseDir
hostPreference
listen
(UseRunning cp)
(beforeMainLoop tr)
whenJust m fn = case m of
Nothing -> pure ()
Just a -> fn a
withShutdownHandlerMaybe :: Trace IO MainLog -> Bool -> IO () -> IO ()
withShutdownHandlerMaybe _ False = void
withShutdownHandlerMaybe tr True = void . withShutdownHandler trShutdown
where
trShutdown = trMessage
$ contramap (second $ fmap MsgShutdownHandler) tr
{-------------------------------------------------------------------------------
Options
-------------------------------------------------------------------------------}
genesisBlockOption :: Parser (Either (Hash "Genesis") FilePath)
genesisBlockOption =
fmap Left genesisHashOption <|>
fmap Right genesisBlockFileOption
-- | --genesis-block=FILE
genesisBlockFileOption :: Parser FilePath
genesisBlockFileOption = optionT $ mempty
<> long "genesis-block"
<> metavar "FILE"
<> help "Path to the genesis block in binary format."
-- | --genesis-block-hash=STRING
genesisHashOption :: Parser (Hash "Genesis")
genesisHashOption = optionT $ mempty
<> long "genesis-block-hash"
<> metavar "STRING"
<> help "Blake2b_256 hash of the genesis block, in base 16."
-- | -- [ARGUMENTS...]
extraArguments :: Parser [String]
extraArguments = many $ argument jmArg $ mempty
<> metavar "[-- ARGUMENTS...]"
<> help "Extra arguments to be passed to Jörmungandr."
where
jmArg = do
arg <- readerAsk
case validate arg of
Just err -> readerError err
Nothing -> pure arg
validate arg
| "--genesis-block" `isPrefixOf` arg = Just $
"The " <> arg <> " option must be placed before the --"
| "--rest-listen" `isPrefixOf` arg = Just $
suggestion "--rest-listen"
| "--storage" `isPrefixOf` arg = Just $
suggestion "--storage"
| otherwise = Nothing
suggestion arg = "The " <> arg <> " option is used by the 'launch'"
<> " command.\nIf you need to use this option,"
<> " run Jörmungandr separately and use 'serve'."
tracerSeveritiesOption :: Parser TracerSeverities
tracerSeveritiesOption = Tracers
<$> traceOpt applicationTracer (Just Info)
<*> traceOpt apiServerTracer (Just Info)
<*> traceOpt walletEngineTracer (Just Info)
<*> traceOpt walletDbTracer (Just Info)
<*> traceOpt stakePoolEngineTracer (Just Info)
<*> traceOpt stakePoolDbTracer (Just Info)
<*> traceOpt networkTracer (Just Info)
<*> traceOpt ntpClientTracer (Just Info)
where
traceOpt field def = fmap Const . option loggingSeverityOrOffReader $ mempty
<> long ("trace-" <> T.unpack (getConst (field tracerLabels)))
<> value def
<> metavar "SEVERITY"
<> internal
{-------------------------------------------------------------------------------
Logging
-------------------------------------------------------------------------------}
data MainLog
= MsgCmdLine String [String]
| MsgVersion Version GitRevision
| MsgSetupStateDir Text
| MsgSetupDatabases Text
| MsgLaunchArgs LaunchArgs
| MsgServeArgs ServeArgs
| MsgListenAddress SockAddr
| MsgSigTerm
| MsgShutdownHandler ShutdownHandlerLog
deriving (Show, Eq)
instance ToText MainLog where
toText msg = case msg of
MsgCmdLine exe args ->
T.pack $ unwords ("Command line:":exe:args)
MsgVersion ver rev ->
"Running as v" <> T.pack (showFullVersion ver rev)
MsgSetupStateDir txt -> "Wallet state: " <> txt
MsgSetupDatabases txt -> "Wallet databases: " <> txt
MsgLaunchArgs args -> T.pack $ show args
MsgServeArgs args -> T.pack $ show args
MsgListenAddress addr ->
"Wallet backend server listening on " <> T.pack (show addr)
MsgSigTerm -> "Terminated by signal."
MsgShutdownHandler msg' -> toText msg'
withTracers
:: LoggingOptions TracerSeverities
-> (Trace IO MainLog -> Tracers IO -> IO a)
-> IO a
withTracers logOpt action =
withLogging [LogToStdout $ loggingMinSeverity logOpt] $ \(_, tr) -> do
let trMain = appendName "main" (transformTextTrace tr)
let tracers = setupTracers (loggingTracers logOpt) tr
logInfo trMain $ MsgVersion version gitRevision
logInfo trMain =<< MsgCmdLine <$> getExecutablePath <*> getArgs
action trMain tracers