Merge pull request #6563 from IntersectMBO/split-nodes-list-into-spo-and-relay

cardano-testnet: Enforce SPOs come first and split node list into SPO and relay

Author: palas

cardano-node-chairman/test/Spec/Chairman/Cardano.hs

@@ -8,7 +8,6 @@ module Spec.Chairman.Cardano where
 import           Cardano.Testnet
 
 import           Data.Default.Class
-import           Data.List.NonEmpty (NonEmpty ((:|)))
 import           Testnet.Property.Util (integrationRetryWorkspace)
 
 import qualified Hedgehog as H
@@ -20,7 +19,7 @@ hprop_chairman :: H.Property
 hprop_chairman = integrationRetryWorkspace 2 "cardano-chairman" $ \tempAbsPath' -> H.runWithDefaultWatchdog_ $ do
   conf <- mkConf tempAbsPath'
 
-  let creationOptions = def{ creationNodes = SpoNodeOptions [] :| [RelayNodeOptions [], RelayNodeOptions []] }
+  let creationOptions = def{ creationNodes = cardanoDefaultTestnetNodeOptions }
   allNodes <- testnetNodes <$> createAndRunTestnet creationOptions def conf
 
   chairmanOver 120 50 conf allNodes

cardano-testnet/changelog.d/20260507_012915_palas_split_nodes_list_into_spo_and_relay.md

@@ -0,0 +1,6 @@
+### Changed
+
+- Refactored `NodeOption` from a sum type into a record with a `TestnetNodeOptions` container
+  that enforces at the type level that SPO nodes come first and at least one is present.
+- `readNodeOptionsFromEnv` now validates that node directories are consecutively numbered
+  and that SPOs come before relays.

cardano-testnet/src/Cardano/Testnet.hs

@@ -14,7 +14,8 @@ module Cardano.Testnet (
   TestnetRuntimeOptions(..),
   TestnetEnvOptions(..),
   RpcSupport(..),
-  NodeOption(..),
+  TestnetNodeOptions(..),
+  NodeOptions(..),
   cardanoDefaultTestnetNodeOptions,
   getDefaultAlonzoGenesis,
   getDefaultShelleyGenesis,

cardano-testnet/src/Parsers/Cardano.hs

@@ -105,18 +105,21 @@ pKesSource = OA.flag UseKesKeyFile UseKesSocket
   <>  OA.showDefault
   )
 
-pTestnetNodeOptions :: Parser (NonEmpty NodeOption)
+pTestnetNodeOptions :: Parser TestnetNodeOptions
 pTestnetNodeOptions =
-  -- If `--num-pool-nodes N` is present, return N nodes with option `SpoNodeOptions []`.
-  -- Otherwise, return `cardanoDefaultTestnetNodeOptions`
-  fmap (maybe cardanoDefaultTestnetNodeOptions (\num -> defaultSpoOptions :| L.replicate (num - 1) defaultSpoOptions)) <$>
+  fmap (maybe cardanoDefaultTestnetNodeOptions mkPoolNodes) <$>
     optional $ OA.option ensureAtLeastOne
       (   OA.long "num-pool-nodes"
       <>  OA.help "Number of pool nodes. Note this uses a default node configuration for all nodes."
       <>  OA.metavar "COUNT"
       )
   where
-    defaultSpoOptions = SpoNodeOptions []
+    defaultSpoOption = NodeOptions []
+
+    mkPoolNodes num = TestnetNodeOptions
+      { optSpoNodes = defaultSpoOption :| L.replicate (num - 1) defaultSpoOption
+      , optRelayNodes = []
+      }
 
     ensureAtLeastOne :: OA.ReadM Int
     ensureAtLeastOne = readerAsk >>= \arg ->

cardano-testnet/src/Testnet/Start/Cardano.hs

@@ -17,7 +17,8 @@ module Testnet.Start.Cardano
   , TestnetCreationOptions(..)
   , TestnetRuntimeOptions(..)
   , TestnetEnvOptions(..)
-  , NodeOption(..)
+  , TestnetNodeOptions(..)
+  , NodeOptions(..)
   , cardanoDefaultTestnetNodeOptions
 
   , TestnetRuntime (..)
@@ -92,16 +93,6 @@ import           RIO.State (put)
 import           UnliftIO.Async
 import           UnliftIO.Exception (stringException)
 
--- | There are certain conditions that need to be met in order to run
--- a valid node cluster.
-testMinimumConfigurationRequirements :: ()
-  => HasCallStack
-  => MonadIO m
-  => NonEmpty NodeOption -> m ()
-testMinimumConfigurationRequirements nodes = withFrozenCallStack $ do
-  unless (any isSpoNodeOptions nodes) $ do
-    throwString "Need at least one SPO node to produce blocks, but got none."
-
 liftToIntegration :: HasCallStack => RIO ResourceMap a -> H.Integration a
 liftToIntegration r =  do
    rMap <- lift $ lift getInternalState
@@ -118,15 +109,13 @@ createTestnetEnv :: ()
 createTestnetEnv
   creationOptions@TestnetCreationOptions
     { creationEra=asbe
-    , creationNodes
+    , creationNodes=TestnetNodeOptions{optSpoNodes, optRelayNodes}
     }
   Conf
     { genesisHashesPolicy
     , tempAbsPath=TmpAbsolutePath tmpAbsPath
     } = do
 
-  testMinimumConfigurationRequirements creationNodes
-
   AnyShelleyBasedEra sbe <- pure asbe
 
   _ <- createSPOGenesisAndFiles
@@ -141,13 +130,16 @@ createTestnetEnv
 
   liftIOAnnotated . LBS.writeFile configurationFile $ A.encodePretty $ Object config
 
-  portNumbers <- forM (NEL.zip (1 :| [2..]) creationNodes)
+  let allNodes = NEL.toList optSpoNodes ++ optRelayNodes
+      numberedNodes = zip [1..] allNodes
+      nodeIds = map fst numberedNodes
+
+  portNumbers <- forM numberedNodes
     (\(i, _nodeOption) -> (i,) <$> H.randomPort testnetDefaultIpv4Address)
 
-  let portNumbersMap = Map.fromList (NEL.toList portNumbers)
+  let portNumbersMap = Map.fromList portNumbers
 
   -- Create network topology and write port files
-  let nodeIds = fst <$> NEL.zip (1 :| [2..]) creationNodes
   forM_ nodeIds $ \i -> do
     let nodeDataDir = tmpAbsPath </> Defaults.defaultNodeDataDir i
     liftIOAnnotated $ IO.createDirectoryIfMissing True nodeDataDir
@@ -157,7 +149,7 @@ createTestnetEnv
       Just port -> liftIOAnnotated $ writeFile (tmpAbsPath </> defaultPortFile i) (show port)
       Nothing -> throwString $ "Port not found for node " <> show i
 
-    producers <- mapM (idToRemoteAddressP2P portNumbersMap) $ NodeId <$> NEL.filter (/= i) nodeIds
+    producers <- mapM (idToRemoteAddressP2P portNumbersMap) $ NodeId <$> filter (/= i) nodeIds
     let topology = Defaults.defaultP2PTopology producers
     liftIOAnnotated . LBS.writeFile (nodeDataDir </> "topology.json") $ A.encodePretty topology
 
@@ -232,12 +224,12 @@ cardanoTestnet
   => MonadResource m
   => MonadCatch m
   => MonadFail m
-  => NonEmpty NodeOption -- ^ The nodes to start
+  => TestnetNodeOptions -- ^ The nodes to start
   -> TestnetRuntimeOptions -- ^ Runtime options
   -> Conf -- ^ Path to the test sandbox
   -> m TestnetRuntime
 cardanoTestnet
-  cardanoNodes
+  TestnetNodeOptions{optSpoNodes=cardanoSpoNodes, optRelayNodes=cardanoRelayNodes}
   TestnetRuntimeOptions
     { runtimeEnableNewEpochStateLogging=enableNewEpochStateLogging
     , runtimeEnableRpc=cardanoEnableRpc
@@ -247,8 +239,8 @@ cardanoTestnet
     { tempAbsPath=TmpAbsolutePath tmpAbsPath
     , updateTimestamps
     } = do
-  testMinimumConfigurationRequirements cardanoNodes
-  let nPools = NumPools $ length $ NEL.filter isSpoNodeOptions cardanoNodes
+  let nPools = NumPools $ NEL.length cardanoSpoNodes
+      allNodes = map (True,) (NEL.toList cardanoSpoNodes) ++ map (False,) cardanoRelayNodes
       nodeConfigFile = tmpAbsPath </> defaultConfigFile
       byronGenesisFile = tmpAbsPath </> "byron-genesis.json"
       shelleyGenesisFile = tmpAbsPath </> "shelley-genesis.json"
@@ -279,7 +271,7 @@ cardanoTestnet
       }
 
   -- Read port numbers from disk (written by createTestnetEnv)
-  portNumbers <- forM (NEL.zip (1 :| [2..]) cardanoNodes) $ \(i, _nodeOption) -> do
+  portNumbers <- forM (zip [1..] allNodes) $ \(i, _) -> do
     let nodeDataDir = tmpAbsPath </> Defaults.defaultNodeDataDir i
         portPath = tmpAbsPath </> defaultPortFile i
     portStr <- liftIOAnnotated $ readFile portPath
@@ -316,19 +308,16 @@ cardanoTestnet
     let shelleyGenesis' = shelleyGenesis{sgSystemStart = startTime}
     liftIOAnnotated . LBS.writeFile shelleyGenesisFile $ A.encodePretty shelleyGenesis'
 
-  let portNumbersMap = Map.fromList (NEL.toList portNumbers)
+  let portNumbersMap = Map.fromList portNumbers
 
-  eTestnetNodes <- forConcurrently (NEL.zip (1 :| [2..]) cardanoNodes) $ \(i, nodeOptions) -> do
+  eTestnetNodes <- forConcurrently (zip [1..] allNodes) $ \(i, (isSpo, nodeOptions)) -> do
     port <- case Map.lookup i portNumbersMap of
       Just p -> pure p
       Nothing -> throwString $ "Port not found for node " <> show i
     let nodeName = Defaults.defaultNodeName i
         nodeDataDir = tmpAbsPath </> Defaults.defaultNodeDataDir i
         nodePoolKeysDir = tmpAbsPath </> Defaults.defaultSpoKeysDir i
-    (mKeys, spoNodeCliArgs) <-
-      case nodeOptions of
-        RelayNodeOptions{} -> pure (Nothing, [])
-        SpoNodeOptions{} -> do
+    (mKeys, spoNodeCliArgs) <- if not isSpo then pure (Nothing, []) else do
           -- depending on testnet configuration, either start a 'kes-agent' or use a key from disk
           kesSourceCliArg <-
             case cardanoKESSource of
@@ -370,11 +359,11 @@ cardanoTestnet
         , "--database-path", nodeDataDir </> "db"
         ]
         <> spoNodeCliArgs
-        <> extraCliArgs nodeOptions
+        <> nodeExtraCliArgs nodeOptions
         <> ["--grpc-enable" | RpcEnabled <- [cardanoEnableRpc]]
     pure $ eRuntime <&> \rt -> rt{poolKeys=mKeys}
 
-  let (failedNodes, testnetNodes') = partitionEithers (NEL.toList eTestnetNodes)
+  let (failedNodes, testnetNodes') = partitionEithers eTestnetNodes
   unless (null failedNodes) $ do
     throwString $ "Some nodes failed to start:\n" ++ show (vsep $ prettyError <$> failedNodes)
 
@@ -417,9 +406,6 @@ cardanoTestnet
 
   pure runtime
   where
-    extraCliArgs = \case
-      SpoNodeOptions args -> args
-      RelayNodeOptions args -> args
     -- TODO: This should come from the configuration!
     makePathsAbsolute :: (Element a ~ FilePath, MonoFunctor a) => a -> a
     makePathsAbsolute = omap (tmpAbsPath </>)
@@ -511,19 +497,32 @@ retryOnAddressInUseError act = withFrozenCallStack $ go maximumTimeout retryTime
     retryTimeout = 5
 
 -- | Read node options from an existing testnet environment directory.
--- Scans @node-data/@ for node directories and checks @pools-keys/@ to
--- classify each node as SPO or relay.
-readNodeOptionsFromEnv :: MonadIO m => FilePath -> m (NonEmpty NodeOption)
+-- Scans @node-data/@ for node directories numbered @node1, node2, ...@
+-- and checks @pools-keys/@ to classify each as SPO or relay.
+-- Validates that nodes are consecutively numbered starting from 1,
+-- and that all SPO nodes come before relay nodes.
+readNodeOptionsFromEnv :: HasCallStack => MonadIO m => FilePath -> m TestnetNodeOptions
 readNodeOptionsFromEnv envDir = do
   entries <- liftIO $ IO.listDirectory (envDir </> "node-data")
   let nodeNums = sort $ mapMaybe parseNodeNum entries
-  case nodeNums of
-    [] -> throwString "No node directories found in environment"
-    (n:ns) -> mapM classifyNode (n :| ns)
+  when (null nodeNums) $
+    throwString "No node directories found in environment"
+  when (nodeNums /= [1 .. length nodeNums]) $
+    throwString $ "Node directories are not consecutively numbered from 1: " <> show nodeNums
+  isSpoFlags <- forM nodeNums $ \i ->
+    liftIO $ IO.doesDirectoryExist (envDir </> Defaults.defaultSpoKeysDir i)
+  let (spoFlags, relayFlags) = span id isSpoFlags
+  unless (all not relayFlags) $
+    throwString "SPO nodes must come before relay nodes in the environment"
+  when (null spoFlags) $
+    throwString "No SPO node directories found in environment"
+  let nSpos = length spoFlags
+  let spoOpts = map (const (NodeOptions [])) [1 .. nSpos]
+      relayOpts = map (const (NodeOptions [])) [nSpos + 1 .. length nodeNums]
+  case spoOpts of
+    (s:ss) -> pure $ TestnetNodeOptions { optSpoNodes = s :| ss, optRelayNodes = relayOpts }
+    [] -> throwString "No SPO node directories found in environment"
   where
     parseNodeNum s = do
       rest <- stripPrefix "node" s
       readMaybe rest :: Maybe Int
-    classifyNode i = do
-      hasPools <- liftIO $ IO.doesDirectoryExist (envDir </> Defaults.defaultSpoKeysDir i)
-      pure $ if hasPools then SpoNodeOptions [] else RelayNodeOptions []

cardano-testnet/src/Testnet/Start/Types.hs

@@ -31,9 +31,8 @@ module Testnet.Start.Types
   , UpdateTimestamps(..)
   , TestnetOnChainParams(..)
   , mainnetParamsRequest
-  , NodeOption(..)
-  , isSpoNodeOptions
-  , isRelayNodeOptions
+  , TestnetNodeOptions(..)
+  , NodeOptions(..)
   , cardanoDefaultTestnetNodeOptions
   , GenesisOptions(..)
   , UserProvidedData(..)
@@ -177,7 +176,7 @@ data RpcSupport
 -- 'Testnet.Start.Cardano.createAndRunTestnet' in tests.
 data TestnetCreationOptions = TestnetCreationOptions
   { -- | Options controlling how many nodes to create and of which type.
-    creationNodes :: NonEmpty NodeOption
+    creationNodes :: TestnetNodeOptions
   , creationEra :: AnyShelleyBasedEra -- ^ The era to start at
   , creationMaxSupply :: Word64 -- ^ The amount of Lovelace you are starting your testnet with (forwarded to shelley genesis)
                                 -- TODO move me to GenesisOptions when https://github.com/IntersectMBO/cardano-cli/pull/874 makes it to cardano-node
@@ -225,11 +224,11 @@ newtype InputNodeConfigFile = InputNodeConfigFile FilePath
 
 creationNumPools :: TestnetCreationOptions -> NumPools
 creationNumPools TestnetCreationOptions{creationNodes} =
-  NumPools $ length $ NEL.filter isSpoNodeOptions creationNodes
+  NumPools $ NEL.length $ optSpoNodes creationNodes
 
 creationNumRelays :: TestnetCreationOptions -> NumRelays
 creationNumRelays TestnetCreationOptions{creationNodes} =
-  NumRelays $ length $ NEL.filter isRelayNodeOptions creationNodes
+  NumRelays $ length $ optRelayNodes creationNodes
 
 -- | Number of stake pool nodes
 newtype NumPools = NumPools Int
@@ -259,12 +258,17 @@ instance Default GenesisOptions where
     , genesisActiveSlotsCoeff = 0.05
     }
 
--- | Whether a node should be an SPO or just a relay.
--- The '@String' arguments will be appended to the default options when starting the node.
-data NodeOption
-  = SpoNodeOptions [String]
-  | RelayNodeOptions [String]
-  deriving (Eq, Show)
+-- | Configuration specific to each node
+newtype NodeOptions = NodeOptions
+  { nodeExtraCliArgs :: [String] -- ^ Extra CLI arguments passed to @cardano-node run@
+  } deriving (Eq, Show)
+
+-- | Specifies the nodes to create for the testnet, split by role (SPO and relay).
+-- SPO nodes participate in block production. Relay nodes only forward blocks.
+data TestnetNodeOptions = TestnetNodeOptions
+  { optSpoNodes :: NonEmpty NodeOptions -- ^ SPO (stake pool operator) nodes. Must have at least one.
+  , optRelayNodes :: [NodeOptions] -- ^ Relay (non-producing) nodes
+  } deriving (Eq, Show)
 
 -- | Type used to track whether the user is providing its data (node configuration file path, genesis file, etc.)
 -- or whether it needs to be programmatically generated by @cardanoTestnet@ and friends.
@@ -276,19 +280,13 @@ data UserProvidedData a =
 instance Default (UserProvidedData a) where
   def = NoUserProvidedData
 
-isSpoNodeOptions :: NodeOption -> Bool
-isSpoNodeOptions SpoNodeOptions{} = True
-isSpoNodeOptions RelayNodeOptions{} = False
-
-isRelayNodeOptions :: NodeOption -> Bool
-isRelayNodeOptions SpoNodeOptions{} = False
-isRelayNodeOptions RelayNodeOptions{} = True
-
-cardanoDefaultTestnetNodeOptions :: NonEmpty NodeOption
-cardanoDefaultTestnetNodeOptions =
-  SpoNodeOptions [] :| [ RelayNodeOptions []
-                       , RelayNodeOptions []
-                       ]
+cardanoDefaultTestnetNodeOptions :: TestnetNodeOptions
+cardanoDefaultTestnetNodeOptions = TestnetNodeOptions
+  { optSpoNodes = NodeOptions [] :| []
+  , optRelayNodes = [ NodeOptions []
+                    , NodeOptions []
+                    ]
+  }
 
 data NodeLoggingFormat
   = NodeLoggingFormatAsJson

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/LeadershipSchedule.hs

@@ -71,10 +71,13 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "leadership-schedule" $ \
       cTestnetOptions = def
         { creationEra = asbe
         , creationNodes =
-            SpoNodeOptions [] :|
-          [ SpoNodeOptions []
-          , SpoNodeOptions []
-          ]
+            TestnetNodeOptions
+              { optSpoNodes = NodeOptions [] :|
+                [ NodeOptions []
+                , NodeOptions []
+                ]
+              , optRelayNodes = []
+              }
         }
       eraString = eraToString sbe
 

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs

@@ -59,10 +59,13 @@ hprop_ledger_events_propose_new_constitution_spo = integrationRetryWorkspace 2 "
       creationOptions = def
         { creationEra = AnyShelleyBasedEra sbe
         , creationNodes =
-            SpoNodeOptions [] :|
-          [ SpoNodeOptions []
-          , SpoNodeOptions []
-          ]
+            TestnetNodeOptions
+              { optSpoNodes = NodeOptions [] :|
+                [ NodeOptions []
+                , NodeOptions []
+                ]
+              , optRelayNodes = []
+              }
         , creationGenesisOptions = def { genesisEpochLength = 100 }
         }
 

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs

@@ -208,7 +208,10 @@ hprop_shutdownOnSlotSynced = integrationRetryWorkspace 2 "shutdown-on-slot-synce
       slotLen = 0.1
   let creationOptions = def
         { creationNodes =
-            SpoNodeOptions ["--shutdown-on-slot-synced", show maxSlot] :| []
+            TestnetNodeOptions
+              { optSpoNodes = NodeOptions ["--shutdown-on-slot-synced", show maxSlot] :| []
+              , optRelayNodes = []
+              }
         , creationGenesisOptions = def
             { genesisEpochLength = epochLength
             , genesisSlotLength = slotLen