make pool configurable

IntersectMBO · Oct 8, 2024 · bbebcc0 · bbebcc0
1 parent a58986c
commit bbebcc0
Show file tree

Hide file tree

Showing 7 changed files with 282 additions and 246 deletions.
diff --git a/cardano-testnet/src/Parsers/Cardano.hs b/cardano-testnet/src/Parsers/Cardano.hs
@@ -2,7 +2,7 @@ module Parsers.Cardano
   ( cmdCardano
   ) where
 
-import           Cardano.Api (EraInEon (..), bounded, AnyShelleyBasedEra (AnyShelleyBasedEra))
+import           Cardano.Api (AnyShelleyBasedEra (AnyShelleyBasedEra), EraInEon (..), bounded)
 
 import           Cardano.CLI.Environment
 import           Cardano.CLI.EraBased.Options.Common hiding (pNetworkId)
@@ -65,7 +65,7 @@ pCardanoTestnetCliOptions envCli = CardanoTestnetOptions
 pNumSpoNodes :: Parser [TestnetNodeOptions]
 pNumSpoNodes =
   OA.option
-     ((`L.replicate` SpoTestnetNodeOptions Nothing []) <$> auto)
+     ((`L.replicate` TestnetNodeOptions TestnetNodeSpo Nothing []) <$> auto)
      (   OA.long "num-pool-nodes"
      <>  OA.help "Number of pool nodes. Note this uses a default node configuration for all nodes."
      <>  OA.metavar "COUNT"
@@ -75,8 +75,8 @@ pNumSpoNodes =
 
 _pSpo :: Parser TestnetNodeOptions
 _pSpo =
-  SpoTestnetNodeOptions . Just
-    <$> parseNodeConfigFile
+  TestnetNodeOptions TestnetNodeSpo -- TODO add parser for node roles
+    . Just <$> parseNodeConfigFile
     <*> pure [] -- TODO: Consider adding support for extra args
 
 parseNodeConfigFile :: Parser NodeConfigurationYaml

diff --git a/cardano-testnet/src/Testnet/Components/Configuration.hs b/cardano-testnet/src/Testnet/Components/Configuration.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -14,11 +13,6 @@ module Testnet.Components.Configuration
   , getByronGenesisHash
   , getShelleyGenesisHash
 
-  , NumPools(..)
-  , numPools
-  , NumDReps
-  , numDReps
-
   , anyEraToString
   , eraToString
   ) where
@@ -62,8 +56,8 @@ import           System.FilePath.Posix (takeDirectory, (</>))
 import           Testnet.Defaults
 import           Testnet.Filepath
 import           Testnet.Process.Run (execCli_)
-import           Testnet.Start.Types (CardanoTestnetOptions (..), anyEraToString,
-                   anyShelleyBasedEraToString, eraToString)
+import           Testnet.Start.Types (CardanoTestnetOptions (..), NumDReps (..), NumPools (..),
+                   anyEraToString, anyShelleyBasedEraToString, eraToString)
 
 import           Hedgehog
 import qualified Hedgehog as H
@@ -120,17 +114,6 @@ getShelleyGenesisHash path key = do
 numSeededUTxOKeys :: Int
 numSeededUTxOKeys = 3
 
-newtype NumPools = NumPools Int
-  deriving (Show, Eq, Ord, Num) via Int
-
-numPools :: CardanoTestnetOptions -> NumPools
-numPools CardanoTestnetOptions { cardanoNodes } = NumPools $ length cardanoNodes
-
-newtype NumDReps = NumDReps Int
-
-numDReps :: CardanoTestnetOptions -> NumDReps
-numDReps CardanoTestnetOptions { cardanoNumDReps } = NumDReps cardanoNumDReps
-
 createSPOGenesisAndFiles
   :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
   => NumPools -- ^ The number of pools to make
@@ -142,7 +125,7 @@ createSPOGenesisAndFiles
   -> ConwayGenesis StandardCrypto -- ^ The conway genesis to use, for example 'Defaults.defaultConwayGenesis'.
   -> TmpAbsolutePath
   -> m FilePath -- ^ Shelley genesis directory
-createSPOGenesisAndFiles (NumPools numPoolNodes) (NumDReps numDelReps) maxSupply sbe shelleyGenesis
+createSPOGenesisAndFiles numPoolNodes numDelReps maxSupply sbe shelleyGenesis
                          alonzoGenesis conwayGenesis (TmpAbsolutePath tempAbsPath) = GHC.withFrozenCallStack $ do
   let inputGenesisShelleyFp = tempAbsPath </> genesisInputFilepath ShelleyEra
       inputGenesisAlonzoFp  = tempAbsPath </> genesisInputFilepath AlonzoEra
@@ -161,7 +144,7 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) (NumDReps numDelReps) maxSupply
   let testnetMagic = sgNetworkMagic shelleyGenesis
       -- At least there should be a delegator per DRep
       -- otherwise some won't be representing anybody
-      numStakeDelegators = max 3 numDelReps :: Int
+      numStakeDelegators = max 3 (fromIntegral numDelReps) :: Int
       startTime = sgSystemStart shelleyGenesis
 
  -- TODO: Remove this rewrite.
@@ -184,7 +167,7 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) (NumDReps numDelReps) maxSupply
     , "--spec-alonzo",  inputGenesisAlonzoFp
     , "--spec-conway",  inputGenesisConwayFp
     , "--testnet-magic", show testnetMagic
-    , "--pools", "1" -- show numPoolNodes
+    , "--pools", show numPoolNodes
     , "--total-supply",     show maxSupply
     , "--stake-delegators", show numStakeDelegators
     , "--utxo-keys", show numSeededUTxOKeys

diff --git a/cardano-testnet/src/Testnet/Property/Assert.hs b/cardano-testnet/src/Testnet/Property/Assert.hs
@@ -40,7 +40,6 @@ import           Data.Type.Equality
 import           Data.Word (Word8)
 import           GHC.Stack as GHC
 
-import           Testnet.Components.Configuration (NumPools(..))
 import           Testnet.Process.Run
 import           Testnet.Start.Types
 

diff --git a/cardano-testnet/src/Testnet/Runtime.hs b/cardano-testnet/src/Testnet/Runtime.hs
@@ -49,7 +49,7 @@ import           Testnet.Filepath
 import qualified Testnet.Ping as Ping
 import           Testnet.Process.Run
 import           Testnet.Types (NodeRuntime (NodeRuntime), TestnetRuntime (configurationFile),
-                   poolSprockets, showIpv4Address)
+                   showIpv4Address, testnetSprockets)
 
 import           Hedgehog (MonadTest)
 import qualified Hedgehog as H
@@ -190,7 +190,7 @@ startNode tp node ipv4 port testnetMagic nodeCmd = GHC.withFrozenCallStack $ do
         NodeExecutableError . hsep $
           ["Socket", pretty socketAbsPath, "was not created after 120 seconds. There was no output on stderr. Exception:", prettyException ioex])
       $ hoistEither eSprocketError
-      
+
     -- Ping node and fail on error
     Ping.pingNode (fromIntegral testnetMagic) sprocket
        >>= (firstExceptT (NodeExecutableError . ("Ping error:" <+>) . prettyError) . hoistEither)
@@ -286,7 +286,7 @@ startLedgerNewEpochStateLogging testnetRuntime tmpWorkspace = withFrozenCallStac
       H.note_ $ "Epoch states logging to " <> logFile <> " is already started."
     False -> do
       H.evalIO $ appendFile logFile ""
-      socketPath <- H.noteM $ H.sprocketSystemName <$> H.headM (poolSprockets testnetRuntime)
+      socketPath <- H.noteM $ H.sprocketSystemName <$> H.headM (testnetSprockets testnetRuntime)
 
       _ <- H.asyncRegister_ . runExceptT $
         foldEpochState