33module Parsers.Cardano
44 ( cmdCardano
55 , cmdCreateEnv
6+ , parseNodeSpecs
67 ) where
78
89import Cardano.Api (AnyShelleyBasedEra (.. ))
@@ -13,6 +14,7 @@ import Cardano.Prelude (readMaybe)
1314import Prelude
1415
1516import Control.Applicative (optional , (<|>) )
17+ import Control.Monad (unless )
1618import Data.Default.Class (def )
1719import qualified Data.List as L
1820import Data.List.NonEmpty (NonEmpty ((:|) ))
@@ -21,6 +23,10 @@ import Data.Word (Word64)
2123import Options.Applicative (CommandFields , Mod , Parser )
2224import qualified Options.Applicative as OA
2325import Options.Applicative.Types (readerAsk )
26+ import Text.Parsec (char , many1 , noneOf ,
27+ sepBy1 , string , try , (<?>) , parse , eof , notFollowedBy )
28+ import qualified Text.Parsec as Parsec
29+ import qualified Text.Parsec.String as Parsec
2430
2531import Testnet.Defaults (defaultEra )
2632import Testnet.Start.Cardano
@@ -55,7 +61,7 @@ pFromEnv = TestnetEnvOptions
5561
5662pCreationOptions :: Parser TestnetCreationOptions
5763pCreationOptions = TestnetCreationOptions
58- <$> pTestnetNodeOptions
64+ <$> pTestnetNodesWithOptions
5965 <*> pure (AnyShelleyBasedEra defaultEra)
6066 <*> pMaxLovelaceSupply
6167 <*> pNumDReps
@@ -105,28 +111,99 @@ pKesSource = OA.flag UseKesKeyFile UseKesSocket
105111 <> OA. showDefault
106112 )
107113
108- pTestnetNodeOptions :: Parser TestnetNodeOptions
109- pTestnetNodeOptions =
110- fmap (maybe cardanoDefaultTestnetNodeOptions mkPoolNodes) <$>
111- optional $ OA. option ensureAtLeastOne
112- ( OA. long " num-pool-nodes"
113- <> OA. help " Number of pool nodes. Note this uses a default node configuration for all nodes."
114- <> OA. metavar " COUNT"
115- )
114+ pTestnetNodesWithOptions :: Parser TestnetNodesWithOptions
115+ pTestnetNodesWithOptions =
116+ pNodes <|> pNumPoolNodes <|> pure cardanoDefaultTestnetNodesWithOptions
116117 where
117- defaultSpoOption = NodeOptions []
118-
119- mkPoolNodes num = TestnetNodeOptions
120- { optSpoNodes = defaultSpoOption :| L. replicate (num - 1 ) defaultSpoOption
121- , optRelayNodes = []
122- }
118+ pNumPoolNodes :: Parser TestnetNodesWithOptions
119+ pNumPoolNodes =
120+ (\ num -> TestnetNodesWithOptions { optSpoNodes = defaultSpoOption :| L. replicate (num - 1 ) defaultSpoOption, optRelayNodes = [] }) <$>
121+ OA. option ensureAtLeastOne
122+ ( OA. long " num-pool-nodes"
123+ <> OA. help " Number of pool nodes. Note this uses a default node configuration for all nodes."
124+ <> OA. metavar " COUNT"
125+ )
126+ defaultSpoOption = NodeWithOptions Nothing []
123127
124128 ensureAtLeastOne :: OA. ReadM Int
125129 ensureAtLeastOne = readerAsk >>= \ arg ->
126130 case readMaybe arg of
127131 Just n | n >= 1 -> pure n
128132 _ -> fail " Need at least one SPO node to produce blocks, but got none."
129133
134+ pNodes :: Parser TestnetNodesWithOptions
135+ pNodes = OA. option readNodeSpecs
136+ ( OA. long " nodes"
137+ <> OA. help " Comma-separated node specifications. SPO nodes must come before relay nodes. \
138+ \Each spec is a role (spo or relay) optionally followed by :node-bin=<path>. \
139+ \If the path contains commas, colons, double quotes, or backslashes, wrap it \
140+ \in double quotes and escape any literal double quotes as \\\" and backslashes \
141+ \as \\\\ within. To prevent bash from consuming the double quotes, enclose the \
142+ \whole argument in single quotes. \
143+ \Examples: --nodes spo,spo:node-bin=/path/to/bin,relay,relay | \
144+ \--nodes 'spo:node-bin=\" /path,with:commas\" ,relay'"
145+ <> OA. metavar " SPEC[,SPEC...]"
146+ )
147+
148+ readNodeSpecs :: OA. ReadM TestnetNodesWithOptions
149+ readNodeSpecs = readerAsk >>= either (fail . show ) pure . parseNodeSpecs
150+
151+ -- | Parse a @--nodes@ argument string into 'TestnetNodesWithOptions'.
152+ --
153+ -- SPO nodes are required to appear before relay nodes because:
154+ --
155+ -- 1. The testnet configuration assigns node directories by position (node-spo1,
156+ -- node-spo2, …, relay1, relay2, …). Allowing arbitrary ordering would require
157+ -- maintaining a separate mapping between pool indices and node positions, which
158+ -- much of the existing code does not expect.
159+ --
160+ -- 2. Silently reordering (e.g. turning @relay,spo@ into @spo,relay@) would
161+ -- violate the user's expectations about which node gets which configuration.
162+ --
163+ -- 3. Requiring SPOs first lets us represent the result directly as a 'NonEmpty'
164+ -- list of SPO nodes (guaranteeing at least one) plus a plain list of relays,
165+ -- so the type itself makes an invalid configuration unrepresentable.
166+ parseNodeSpecs :: String -> Either Parsec. ParseError TestnetNodesWithOptions
167+ parseNodeSpecs = parse (nodeSpecsParser <* eof) " Error parsing node specifications"
168+ where
169+ nodeSpecsParser :: Parsec. Parser TestnetNodesWithOptions
170+ nodeSpecsParser = do
171+ specs <- nodeSpec `sepBy1` char ' ,'
172+ let (spos, relays) = span (\ (role, _) -> role == Spo ) specs
173+ unless (all (\ (role, _) -> role == Relay ) relays) $
174+ fail " SPO nodes must come before relay nodes. Example: --nodes spo,spo,relay,relay"
175+ case map snd spos of
176+ [] -> fail " Need at least one SPO node to produce blocks."
177+ (s: ss) -> pure $ TestnetNodesWithOptions
178+ { optSpoNodes = s :| ss
179+ , optRelayNodes = map snd relays
180+ }
181+
182+ nodeSpec :: Parsec. Parser (NodeRole , NodeWithOptions )
183+ nodeSpec = do
184+ role <- nodeRole
185+ bin <- optional $ char ' :' *> nodeBinKV
186+ pure (role, NodeWithOptions bin [] )
187+
188+ nodeRole :: Parsec. Parser NodeRole
189+ nodeRole =
190+ Spo <$ try (string " spo" <* notFollowedBy (noneOf " ,:\"\\ " ))
191+ <|> Relay <$ try (string " relay" <* notFollowedBy (noneOf " ,:\"\\ " ))
192+ <?> " node role (\" spo\" or \" relay\" )"
193+
194+ nodeBinKV :: Parsec. Parser FilePath
195+ nodeBinKV = string " node-bin=" *> (quotedPath <|> unquotedPath) <?> " \" node-bin=<path>\" , where <path> is the path to the node binary, optionally quoted if it contains special characters"
196+
197+ quotedPath :: Parsec. Parser FilePath
198+ quotedPath = char ' "' *> Parsec. many quotedChar <* char ' "'
199+ where
200+ quotedChar = try (char ' \\ ' *> (char ' "' <|> char ' \\ ' )) <|> noneOf " \" "
201+
202+ unquotedPath :: Parsec. Parser FilePath
203+ unquotedPath = many1 (noneOf " ,:\"\\ " )
204+
205+ data NodeRole = Spo | Relay deriving Eq
206+
130207pOnChainParams :: Parser TestnetOnChainParams
131208pOnChainParams = fmap (fromMaybe DefaultParams ) <$> optional $
132209 pCustomParamsFile <|> pMainnetParams
0 commit comments