Skip to content

Commit 2efea38

Browse files
dcouttsdcoutts
committed
Factor common CLI arguments into a shared type and parser
So that they are shared between the node, client and chairman. There will be a couple more shared args to be added so we'll benefit from the sharing. Also update the way the config merging is done to fully take advantage of the monoidal approach.
1 parent ea9eea5 commit 2efea38

File tree

6 files changed

+80
-125
lines changed

6 files changed

+80
-125
lines changed

‎app/CLI.hs‎

Lines changed: 2 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -27,8 +27,6 @@ import qualified Data.IP as IP
2727
import Options.Applicative
2828
import Network.Socket (PortNumber)
2929

30-
import Cardano.Prelude hiding (option, (.))
31-
3230
import Ouroboros.Consensus.BlockchainTime
3331
import qualified Ouroboros.Consensus.Ledger.Mock as Mock
3432

@@ -44,10 +42,7 @@ import Cardano.Node.CLI
4442
data NodeCLIArguments = NodeCLIArguments {
4543
systemStart :: !SystemStart
4644
, slotDuration :: !SlotLength
47-
, cliGenesisFile :: !(Last FilePath)
48-
, cliGenesisHash :: !(Last Text)
49-
, cliStaticKeySigningKeyFile :: !(Last FilePath)
50-
, cliStaticKeyDlgCertFile :: !(Last FilePath)
45+
, commonCLI :: !CommonCLI
5146
, command :: !Command
5247
}
5348

@@ -94,26 +89,7 @@ nodeParser :: Parser NodeCLIArguments
9489
nodeParser = NodeCLIArguments
9590
<$> parseSystemStart
9691
<*> parseSlotDuration
97-
<*> lastStrOption
98-
( long "genesis-file"
99-
<> metavar "FILEPATH"
100-
<> help "The filepath to the genesis file."
101-
)
102-
<*> lastStrOption
103-
( long "genesis-hash"
104-
<> metavar "GENESIS-HASH"
105-
<> help "The genesis hash value."
106-
)
107-
<*> lastStrOption
108-
( long "signing-key"
109-
<> metavar "FILEPATH"
110-
<> help "Path to the signing key."
111-
)
112-
<*> lastStrOption
113-
( long "delegation-certificate"
114-
<> metavar "FILEPATH"
115-
<> help "Path to the delegation certificate."
116-
)
92+
<*> parseCommonCLI
11793
<*> parseCommand
11894

11995
parseCommand :: Parser Command

‎app/Main.hs‎

Lines changed: 1 addition & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -68,15 +68,8 @@ main = do
6868

6969
initializeAllFeatures :: CLIArguments -> PartialCardanoConfiguration -> CardanoEnvironment -> IO ([CardanoFeature], NodeLayer)
7070
initializeAllFeatures (CLIArguments logCli nodeCli) partialConfig cardanoEnvironment = do
71-
let NodeCLIArguments
72-
{ cliGenesisFile, cliGenesisHash
73-
, cliStaticKeySigningKeyFile, cliStaticKeyDlgCertFile
74-
} = nodeCli
7571
finalConfig <- case finaliseCardanoConfiguration $
76-
mergeConfiguration
77-
partialConfig
78-
cliGenesisFile cliGenesisHash
79-
cliStaticKeySigningKeyFile cliStaticKeyDlgCertFile
72+
mergeConfiguration partialConfig (commonCLI nodeCli)
8073
of
8174
Left err -> throwIO $ ConfigurationError err
8275
Right x -> pure x

‎cardano-node/Cardano/Node/CLI.hs‎

Lines changed: 66 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,9 @@ module Cardano.Node.CLI (
1212
, TraceConstraints
1313
, ViewMode(..)
1414
, fromProtocol
15-
-- * Configuration
15+
-- * Common CLI
16+
, CommonCLI(..)
17+
, parseCommonCLI
1618
, mergeConfiguration
1719
-- * Parsers
1820
, parseSystemStart
@@ -188,6 +190,45 @@ data ViewMode =
188190
LiveView -- Live mode with TUI
189191
| SimpleView -- Simple mode, just output text.
190192

193+
{-------------------------------------------------------------------------------
194+
Common CLI
195+
-------------------------------------------------------------------------------}
196+
197+
-- | CLI Arguments common to all Cardano node flavors
198+
data CommonCLI = CommonCLI
199+
{ cliGenesisFile :: !(Last FilePath)
200+
, cliGenesisHash :: !(Last Text)
201+
, cliStaticKeySigningKeyFile :: !(Last FilePath)
202+
, cliStaticKeyDlgCertFile :: !(Last FilePath)
203+
--TODO cliPBftSigThd :: !(Last Double)
204+
--TODO cliUpdate :: !PartialUpdate
205+
}
206+
207+
parseCommonCLI :: Parser CommonCLI
208+
parseCommonCLI =
209+
CommonCLI
210+
<$> lastStrOption
211+
( long "genesis-file"
212+
<> metavar "FILEPATH"
213+
<> help "The filepath to the genesis file."
214+
)
215+
<*> lastStrOption
216+
( long "genesis-hash"
217+
<> metavar "GENESIS-HASH"
218+
<> help "The genesis hash value."
219+
)
220+
<*> lastStrOption
221+
( long "signing-key"
222+
<> metavar "FILEPATH"
223+
<> help "Path to the signing key."
224+
)
225+
<*> lastStrOption
226+
( long "delegation-certificate"
227+
<> metavar "FILEPATH"
228+
<> help "Path to the delegation certificate."
229+
)
230+
231+
191232
{-------------------------------------------------------------------------------
192233
Configuration merging
193234
-------------------------------------------------------------------------------}
@@ -197,25 +238,31 @@ data ViewMode =
197238
-- We expect this process to become generic at some point.
198239
mergeConfiguration
199240
:: PartialCardanoConfiguration
200-
-> Last FilePath
201-
-> Last Text
202-
-> Last FilePath
203-
-> Last FilePath
241+
-> CommonCLI
204242
-> PartialCardanoConfiguration
205-
mergeConfiguration pcc lGenF lGenH lSKF lDlgF =
206-
let PartialCore
207-
{ pcoGenesisFile
208-
, pcoGenesisHash
209-
, pcoStaticKeySigningKeyFile
210-
, pcoStaticKeyDlgCertFile
211-
} = pccCore pcc
212-
in
213-
pcc { pccCore = pccCore pcc <> mempty
214-
{ pcoGenesisFile = pcoGenesisFile <> lGenF
215-
, pcoGenesisHash = pcoGenesisHash <> lGenH
216-
, pcoStaticKeySigningKeyFile = pcoStaticKeySigningKeyFile <> lSKF
217-
, pcoStaticKeyDlgCertFile = pcoStaticKeyDlgCertFile <> lDlgF
218-
}}
243+
mergeConfiguration pcc cli =
244+
-- The beauty of this kind of configuration management (using trees of
245+
-- monoids) is that we can override individual config elements by simply
246+
-- merging an extra partial config on top. That extra partial config is
247+
-- built starting from mempty and setting the fields of interest.
248+
pcc <> commonCLIToPCC cli
249+
where
250+
commonCLIToPCC :: CommonCLI -> PartialCardanoConfiguration
251+
commonCLIToPCC CommonCLI {
252+
cliGenesisFile
253+
, cliGenesisHash
254+
, cliStaticKeySigningKeyFile
255+
, cliStaticKeyDlgCertFile
256+
} =
257+
mempty {
258+
pccCore = mempty {
259+
pcoGenesisFile = cliGenesisFile
260+
, pcoGenesisHash = cliGenesisHash
261+
, pcoStaticKeySigningKeyFile = cliStaticKeySigningKeyFile
262+
, pcoStaticKeyDlgCertFile = cliStaticKeyDlgCertFile
263+
-- TODO: cliPBftSigThd, cliUpdate
264+
}
265+
}
219266

220267
{-------------------------------------------------------------------------------
221268
Command parsers

‎chairman/Main.hs‎

Lines changed: 4 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -3,12 +3,10 @@
33
{-# LANGUAGE NumericUnderscores #-}
44
module Main where
55

6-
import Data.Text (Text)
76
import Control.Applicative (some)
87
import Control.Exception (Exception, throwIO)
98
import Control.Concurrent (threadDelay)
109
import Control.Concurrent.Async
11-
import Data.Monoid
1210
import Options.Applicative
1311

1412
import Cardano.Shell.Presets (mainnetConfiguration)
@@ -41,10 +39,7 @@ data ChairmanArgs = ChairmanArgs {
4139
-- detect progress errors when running 'chain-sync' protocol and we will
4240
-- be able to remove this option
4341
, caTimeout :: !(Maybe Int)
44-
, caGenesisFile :: !(Last FilePath)
45-
, caGenesisHash :: !(Last Text)
46-
, caStaticKeySigningKeyFile :: !(Last FilePath)
47-
, caStaticKeyDlgCertFile :: !(Last FilePath)
42+
, caCommonCLI :: !CommonCLI
4843
}
4944

5045
parseSecurityParam :: Parser SecurityParam
@@ -82,26 +77,7 @@ parseChairmanArgs =
8277
<*> parseSecurityParam
8378
<*> optional parseSlots
8479
<*> optional parseTimeout
85-
<*> lastStrOption
86-
( long "genesis-file"
87-
<> metavar "FILEPATH"
88-
<> help "The filepath to the genesis file."
89-
)
90-
<*> lastStrOption
91-
( long "genesis-hash"
92-
<> metavar "GENESIS-HASH"
93-
<> help "The genesis hash value."
94-
)
95-
<*> lastStrOption
96-
( long "signing-key"
97-
<> metavar "FILEPATH"
98-
<> help "Path to the signing key."
99-
)
100-
<*> lastStrOption
101-
( long "delegation-certificate"
102-
<> metavar "FILEPATH"
103-
<> help "Path to the delegation certificate."
104-
)
80+
<*> parseCommonCLI
10581

10682
opts :: ParserInfo ChairmanArgs
10783
opts = info (parseChairmanArgs <**> helper)
@@ -121,19 +97,14 @@ main = do
12197
, caSecurityParam
12298
, caMaxBlockNo
12399
, caTimeout
124-
, caGenesisFile
125-
, caGenesisHash
126-
, caStaticKeySigningKeyFile
127-
, caStaticKeyDlgCertFile
100+
, caCommonCLI
128101
} <- execParser opts
129102

130103
SomeProtocol p
131104
<- case finaliseCardanoConfiguration $
132105
mergeConfiguration
133106
mainnetConfiguration
134-
caGenesisFile caGenesisHash
135-
caStaticKeySigningKeyFile
136-
caStaticKeyDlgCertFile of
107+
caCommonCLI of
137108
Left err -> throwIO (ConfigurationError err)
138109
Right cc -> fromProtocol cc caProtocol
139110

‎wallet-client/CLI.hs‎

Lines changed: 6 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -8,48 +8,23 @@ module CLI
88
, fromProtocol
99
) where
1010

11-
import Data.Monoid (Last (..))
12-
import Data.Text (Text)
13-
1411
import Options.Applicative
1512

1613
import Ouroboros.Consensus.Node.ProtocolInfo
1714
import Ouroboros.Consensus.NodeId (CoreNodeId (..))
1815

1916
import Cardano.Node.CLI
2017

21-
data CLI = CLI
22-
{ cliCoreNodeId :: CoreNodeId
23-
, cliNumCoreNodes :: NumCoreNodes
24-
, cliProtocol :: Protocol
25-
, cliGenesisFile :: Last FilePath
26-
, cliGenesisHash :: Last Text
27-
, cliStaticKeySigningKeyFile :: Last FilePath
28-
, cliStaticKeyDlgCertFile :: Last FilePath
18+
data CLI = CLI {
19+
cliCoreNodeId :: CoreNodeId,
20+
cliNumCoreNodes :: NumCoreNodes,
21+
cliProtocol :: Protocol,
22+
cliCommon :: CommonCLI
2923
}
3024

3125
parseCLI :: Parser CLI
3226
parseCLI = CLI
3327
<$> parseCoreNodeId
3428
<*> parseNumCoreNodes
3529
<*> parseProtocol
36-
<*> lastStrOption
37-
( long "genesis-file"
38-
<> metavar "FILEPATH"
39-
<> help "The filepath to the genesis file."
40-
)
41-
<*> lastStrOption
42-
( long "genesis-hash"
43-
<> metavar "GENESIS-HASH"
44-
<> help "The genesis hash value."
45-
)
46-
<*> lastStrOption
47-
( long "signing-key"
48-
<> metavar "FILEPATH"
49-
<> help "Path to the signing key."
50-
)
51-
<*> lastStrOption
52-
( long "delegation-certificate"
53-
<> metavar "FILEPATH"
54-
<> help "Path to the delegation certificate."
55-
)
30+
<*> parseCommonCLI

‎wallet-client/Main.hs‎

Lines changed: 1 addition & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -72,15 +72,8 @@ main = do
7272

7373
initializeAllFeatures :: ArgParser -> PartialCardanoConfiguration -> CardanoEnvironment -> IO ([CardanoFeature], NodeLayer)
7474
initializeAllFeatures (ArgParser logCli cli) partialConfig cardanoEnvironment = do
75-
let CLI
76-
{ cliGenesisFile, cliGenesisHash
77-
, cliStaticKeySigningKeyFile, cliStaticKeyDlgCertFile
78-
} = cli
7975
finalConfig <- case finaliseCardanoConfiguration $
80-
mergeConfiguration
81-
partialConfig
82-
cliGenesisFile cliGenesisHash
83-
cliStaticKeySigningKeyFile cliStaticKeyDlgCertFile
76+
mergeConfiguration partialConfig (cliCommon cli)
8477
of
8578
Left err -> throwIO $ ConfigurationError err
8679
--TODO: if we're using exceptions for this, then we should use a local

0 commit comments

Comments
 (0)