diff --git a/cardano-testnet/src/Cardano/Testnet.hs b/cardano-testnet/src/Cardano/Testnet.hs index a6fcb023317..5525100e2ee 100644 --- a/cardano-testnet/src/Cardano/Testnet.hs +++ b/cardano-testnet/src/Cardano/Testnet.hs @@ -15,7 +15,7 @@ module Cardano.Testnet ( -- * Configuration Conf(..), TmpAbsolutePath(..), - YamlFilePath(..), + NodeConfigurationYaml(..), mkConf, makeLogDir, makeSocketDir, diff --git a/cardano-testnet/src/Parsers/Cardano.hs b/cardano-testnet/src/Parsers/Cardano.hs index 3441c6fffbe..e36fbfd4dee 100644 --- a/cardano-testnet/src/Parsers/Cardano.hs +++ b/cardano-testnet/src/Parsers/Cardano.hs @@ -1,6 +1,5 @@ module Parsers.Cardano - ( CardanoOptions(..) - , cmdCardano + ( cmdCardano ) where import Cardano.CLI.Environment @@ -17,14 +16,13 @@ import Testnet.Process.Cli import Testnet.Property.Utils import Testnet.Runtime (readNodeLoggingFormat) import Testnet.Start.Cardano +import Testnet.Start.Types -newtype CardanoOptions = CardanoOptions - { testnetOptions :: CardanoTestnetOptions - } deriving (Eq, Show) optsTestnet :: EnvCli -> Parser CardanoTestnetOptions optsTestnet envCli = CardanoTestnetOptions - <$> pNumBftAndSpoNodes + -- TODO <$> (OA.many pSpo <|> pNumSpoNodes) + <$> pNumSpoNodes <*> pLegacyCardanoEra envCli <*> OA.option auto ( OA.long "epoch-length" @@ -64,19 +62,41 @@ optsTestnet envCli = CardanoTestnetOptions <> OA.value (cardanoNodeLoggingFormat cardanoDefaultTestnetOptions) ) -pNumBftAndSpoNodes :: Parser [TestnetNodeOptions] -pNumBftAndSpoNodes = +pNumSpoNodes :: Parser [TestnetNodeOptions] +pNumSpoNodes = OA.option - ((`L.replicate` SpoTestnetNodeOptions []) <$> auto) - ( OA.long "num-pool-nodes" - <> OA.help "Number of pool nodes" - <> OA.metavar "COUNT" - <> OA.showDefault - <> OA.value (cardanoNodes cardanoDefaultTestnetOptions) + ((`L.replicate` SpoTestnetNodeOptions 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" + <> OA.showDefault + <> OA.value (cardanoNodes cardanoDefaultTestnetOptions) + ) + + +_pSpo :: Parser TestnetNodeOptions +_pSpo = + SpoTestnetNodeOptions . Just + <$> parseNodeConfigFile + <*> pure [] -- TODO: Consider adding support for extra args + +parseNodeConfigFile :: Parser NodeConfigurationYaml +parseNodeConfigFile = NodeConfigurationYaml <$> + strOption + (mconcat + [ long "configuration-file" + , metavar "NODE-CONFIGURATION" + , help helpText + , completer (bashCompleter "file") + ] ) + where + helpText = unwords + [ "Configuration file for the cardano-node(s)." + , "Specify a configuration file per node you want to have in the cluster." + , "Or use num-pool-nodes to use cardano-testnet's default configuration." + ] -optsCardano :: EnvCli -> Parser CardanoOptions -optsCardano envCli = CardanoOptions <$> optsTestnet envCli -cmdCardano :: EnvCli -> Mod CommandFields CardanoOptions -cmdCardano envCli = command' "cardano" "Start a testnet in any era" (optsCardano envCli) +cmdCardano :: EnvCli -> Mod CommandFields CardanoTestnetOptions +cmdCardano envCli = command' "cardano" "Start a testnet in any era" (optsTestnet envCli) diff --git a/cardano-testnet/src/Parsers/Run.hs b/cardano-testnet/src/Parsers/Run.hs index e5da607f7f1..ff486fac77a 100644 --- a/cardano-testnet/src/Parsers/Run.hs +++ b/cardano-testnet/src/Parsers/Run.hs @@ -30,7 +30,7 @@ opts envCli = Opt.info (commands envCli <**> helper) idm -- by allowing the user to start testnets in any era (excluding Byron) -- via StartCardanoTestnet data CardanoTestnetCommands - = StartCardanoTestnet CardanoOptions + = StartCardanoTestnet CardanoTestnetOptions | GetVersion VersionOptions | Help ParserPrefs (ParserInfo CardanoTestnetCommands) HelpOptions @@ -50,6 +50,6 @@ runTestnetCmd = \case Help pPrefs pInfo cmdOpts -> runHelpOptions pPrefs pInfo cmdOpts -runCardanoOptions :: CardanoOptions -> IO () +runCardanoOptions :: CardanoTestnetOptions -> IO () runCardanoOptions options = - runTestnet $ cardanoTestnet (testnetOptions options) + runTestnet $ cardanoTestnet options diff --git a/cardano-testnet/src/Testnet/Components/Configuration.hs b/cardano-testnet/src/Testnet/Components/Configuration.hs index 6503a294403..8dd34a5adfd 100644 --- a/cardano-testnet/src/Testnet/Components/Configuration.hs +++ b/cardano-testnet/src/Testnet/Components/Configuration.hs @@ -1,9 +1,10 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} - +{-# LANGUAGE TypeApplications #-} module Testnet.Components.Configuration ( createConfigYaml + , createSPOGenesisAndFiles , mkTopologyConfig ) where @@ -15,29 +16,40 @@ import Cardano.Node.Types import Ouroboros.Network.PeerSelection.LedgerPeers import Ouroboros.Network.PeerSelection.State.LocalRootPeers +import Control.Monad +import Control.Monad.Catch (MonadCatch) import Control.Monad.IO.Class (MonadIO) +import Data.Aeson import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy as LBS +import qualified Data.HashMap.Lazy as HM import qualified Data.List as List import Data.String +import Data.Time import GHC.Stack (HasCallStack) import qualified GHC.Stack as GHC import System.FilePath.Posix (()) import Hedgehog +import qualified Hedgehog as H +import qualified Hedgehog.Extras.Stock.Aeson as J +import qualified Hedgehog.Extras.Stock.Time as DTC +import qualified Hedgehog.Extras.Test.Base as H +import qualified Hedgehog.Extras.Test.File as H import Testnet.Defaults import Testnet.Filepath +import Testnet.Process.Run (execCli_) import Testnet.Property.Utils +import Testnet.Start.Types + createConfigYaml :: (MonadTest m, MonadIO m, HasCallStack) => TmpAbsolutePath -> AnyCardanoEra -> m LBS.ByteString -createConfigYaml tempAbsPath anyCardanoEra' = GHC.withFrozenCallStack $ do - let tempAbsPath' = unTmpAbsPath tempAbsPath - +createConfigYaml (TmpAbsolutePath tempAbsPath') anyCardanoEra' = GHC.withFrozenCallStack $ do -- Add Byron, Shelley and Alonzo genesis hashes to node configuration -- TODO: These genesis filepaths should not be hardcoded. Using the cli as a library -- rather as an executable will allow us to get the genesis files paths in a more @@ -58,6 +70,79 @@ createConfigYaml tempAbsPath anyCardanoEra' = GHC.withFrozenCallStack $ do ] +createSPOGenesisAndFiles + :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) + => CardanoTestnetOptions + -> UTCTime -- ^ Start time + -> TmpAbsolutePath + -> m FilePath -- ^ Shelley genesis directory +createSPOGenesisAndFiles testnetOptions startTime (TmpAbsolutePath tempAbsPath') = do + let testnetMagic = cardanoTestnetMagic testnetOptions + numPoolNodes = length $ cardanoNodes testnetOptions + -- TODO: Even this is cumbersome. You need to know where to put the initial + -- shelley genesis for create-staked to use. + createStakedInitialGenesisFile = tempAbsPath' "genesis.spec.json" + + -- TODO: We need to read the genesis files into Haskell and modify them + -- based on cardano-testnet's cli parameters + + -- We create the initial genesis file to avoid having to re-write the genesis file later + -- with the parameters we want. The user must provide genesis files or we will use a default. + -- We should *never* be modifying the genesis file after cardano-testnet is run because this + -- is sure to be a source of confusion if users provide genesis files and we are mutating them + -- without their knowledge. + let shelleyGenesis :: LBS.ByteString + shelleyGenesis = encode $ defaultShelleyGenesis startTime testnetOptions + + H.evalIO $ LBS.writeFile createStakedInitialGenesisFile shelleyGenesis + + -- TODO: Remove this rewrite. + -- 50 second epochs + -- Epoch length should be "10 * k / f" where "k = securityParam, f = activeSlotsCoeff" + H.rewriteJsonFile createStakedInitialGenesisFile $ J.rewriteObject + ( HM.insert "securityParam" (toJSON @Int 5) -- TODO: USE config p arameter + . HM.adjust + (J.rewriteObject + $ HM.adjust + (J.rewriteObject (HM.insert "major" (toJSON @Int 8))) + "protocolVersion" + ) "protocolParams" + . HM.insert "rho" (toJSON @Double 0.1) + . HM.insert "tau" (toJSON @Double 0.1) + . HM.insert "updateQuorum" (toJSON @Int 2) + ) + + execCli_ + [ "genesis", "create-staked" + , "--genesis-dir", tempAbsPath' + , "--testnet-magic", show @Int testnetMagic + , "--gen-pools", show @Int numPoolNodes + , "--supply", "1000000000000" + , "--supply-delegated", "1000000000000" + , "--gen-stake-delegs", "3" + , "--gen-utxo-keys", "3" + , "--start-time", DTC.formatIso8601 startTime + ] + + -- Here we move all of the keys etc generated by create-staked + -- for the nodes to use + + -- Move all genesis related files + + genesisByronDir <- H.createDirectoryIfMissing $ tempAbsPath' "byron" + genesisShelleyDir <- H.createDirectoryIfMissing $ tempAbsPath' "shelley" + + files <- H.listDirectory tempAbsPath' + forM_ files $ \file -> do + H.note file + + H.renameFile (tempAbsPath' "byron-gen-command/genesis.json") (genesisByronDir "genesis.json") + H.renameFile (tempAbsPath' "genesis.alonzo.json") (genesisShelleyDir "genesis.alonzo.json") + H.renameFile (tempAbsPath' "genesis.conway.json") (genesisShelleyDir "genesis.conway.json") + H.renameFile (tempAbsPath' "genesis.json") (genesisShelleyDir "genesis.json") + + return genesisShelleyDir + ifaceAddress :: String ifaceAddress = "127.0.0.1" diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs index 08ec40989e9..1720a3a1dd9 100644 --- a/cardano-testnet/src/Testnet/Defaults.hs +++ b/cardano-testnet/src/Testnet/Defaults.hs @@ -8,6 +8,7 @@ module Testnet.Defaults , defaultByronProtocolParamsJsonValue , defaultYamlConfig , defaultConwayGenesis + , defaultShelleyGenesis , defaultYamlHardforkViaConfig , defaultMainnetTopology ) where @@ -22,6 +23,7 @@ import Cardano.Ledger.BaseTypes import Cardano.Ledger.Coin import Cardano.Ledger.Conway.Genesis import Cardano.Ledger.Crypto (StandardCrypto) +import Cardano.Ledger.Shelley.Genesis import Cardano.Node.Configuration.Topology import Cardano.Tracing.Config @@ -37,9 +39,12 @@ import qualified Data.Map.Strict as Map import Data.Proxy import Data.Ratio import Data.Scientific +import Data.Time (UTCTime) import qualified Data.Vector as Vector import Data.Word +import Testnet.Start.Types + instance Api.Error AlonzoGenesisError where displayError (AlonzoGenErrCostModels e) = @@ -401,6 +406,23 @@ defaultByronProtocolParamsJsonValue = , "updateVoteThd" .= toJSON @String "1000000000000" ] +defaultShelleyGenesis + :: UTCTime + -> CardanoTestnetOptions + -> Api.ShelleyGenesis StandardCrypto +defaultShelleyGenesis startTime testnetOptions = + let testnetMagic = cardanoTestnetMagic testnetOptions + slotLength = cardanoSlotLength testnetOptions + epochLength = cardanoEpochLength testnetOptions + maxLovelaceLovelaceSupply = cardanoMaxSupply testnetOptions + in Api.shelleyGenesisDefaults + { Api.sgNetworkMagic = fromIntegral testnetMagic + , Api.sgSlotLength = secondsToNominalDiffTimeMicro $ realToFrac slotLength + , Api.sgEpochLength = EpochSize $ fromIntegral epochLength + , Api.sgMaxLovelaceSupply = maxLovelaceLovelaceSupply + , Api.sgSystemStart = startTime + } + defaultMainnetTopology :: NetworkTopology defaultMainnetTopology = let single = RemoteAddress diff --git a/cardano-testnet/src/Testnet/Start/Cardano.hs b/cardano-testnet/src/Testnet/Start/Cardano.hs index 9b7d0814d2e..78f6476599d 100644 --- a/cardano-testnet/src/Testnet/Start/Cardano.hs +++ b/cardano-testnet/src/Testnet/Start/Cardano.hs @@ -31,8 +31,8 @@ import qualified Data.Aeson as J import Data.Bifunctor import qualified Data.ByteString.Lazy as LBS import Data.Either -import qualified Data.HashMap.Lazy as HM import qualified Data.List as L +import Data.Maybe import qualified Data.Text as Text import qualified Data.Time.Clock as DTC import qualified GHC.Stack as GHC @@ -41,9 +41,7 @@ import qualified System.Info as OS import qualified Hedgehog as H import Hedgehog.Extras (failMessage) -import qualified Hedgehog.Extras.Stock.Aeson as J import qualified Hedgehog.Extras.Stock.OS as OS -import qualified Hedgehog.Extras.Stock.Time as DTC import qualified Hedgehog.Extras.Test.Base as H import qualified Hedgehog.Extras.Test.File as H @@ -90,309 +88,261 @@ cardanoTestnet testnetOptions Conf {tempAbsPath} = do void $ H.note OS.os currentTime <- H.noteShowIO DTC.getCurrentTime let tempAbsPath' = unTmpAbsPath tempAbsPath - startTime <- H.noteShow $ DTC.addUTCTime startTimeOffsetSeconds currentTime - let testnetMagic = cardanoTestnetMagic testnetOptions - - let logDir = makeLogDir $ TmpAbsolutePath tempAbsPath' - H.createDirectoryIfMissing_ logDir - - H.lbsWriteFile (tempAbsPath' "byron.genesis.spec.json") - . J.encode $ defaultByronProtocolParamsJsonValue - - -- stuff - Byron.createByronGenesis - testnetMagic - startTime - Byron.byronDefaultGenesisOptions - (tempAbsPath' "byron.genesis.spec.json") - (tempAbsPath' "byron-gen-command") - -- Because in Conway the overlay schedule and decentralization parameter - -- are deprecated, we must use the "create-staked" cli command to create - -- SPOs in the ShelleyGenesis - - alonzoConwayTestGenesisJsonTargetFile <- H.noteShow $ tempAbsPath' "genesis.alonzo.spec.json" - gen <- H.evalEither $ first displayError defaultAlonzoGenesis - H.evalIO $ LBS.writeFile alonzoConwayTestGenesisJsonTargetFile $ Aeson.encode gen - - conwayConwayTestGenesisJsonTargetFile <- H.noteShow $ tempAbsPath' "genesis.conway.spec.json" - H.evalIO $ LBS.writeFile conwayConwayTestGenesisJsonTargetFile $ Aeson.encode defaultConwayGenesis - - configurationFile <- H.noteShow $ tempAbsPath' "configuration.yaml" - - let numPoolNodes = length $ cardanoNodes testnetOptions - -- TODO: No need to use the executable directly. We need to wrap - -- the function that create-staked called and parameterize it on CardanoTestnetOptions or CardanoTestnetOptions - execCli_ - [ "genesis", "create-staked" - , "--genesis-dir", tempAbsPath' - , "--testnet-magic", show @Int testnetMagic - , "--gen-pools", show @Int numPoolNodes - , "--supply", "1000000000000" - , "--supply-delegated", "1000000000000" - , "--gen-stake-delegs", "3" - , "--gen-utxo-keys", "3" - , "--start-time", DTC.formatIso8601 startTime - ] - - poolKeys <- H.noteShow $ flip fmap [1..numPoolNodes] $ \n -> - PoolNodeKeys - { poolNodeKeysColdVkey = tempAbsPath' "pools" "cold" <> show n <> ".vkey" - , poolNodeKeysColdSkey = tempAbsPath' "pools" "cold" <> show n <> ".skey" - , poolNodeKeysVrfVkey = tempAbsPath' "pools" "vrf" <> show n <> ".vkey" - , poolNodeKeysVrfSkey = tempAbsPath' "pools" "vrf" <> show n <> ".skey" - , poolNodeKeysStakingVkey = tempAbsPath' "pools" "staking-reward" <> show n <> ".vkey" - , poolNodeKeysStakingSkey = tempAbsPath' "pools" "staking-reward" <> show n <> ".skey" - } - - wallets <- forM [1..3] $ \idx -> do - let paymentSKeyFile = tempAbsPath' "utxo-keys/utxo" <> show @Int idx <> ".skey" - let paymentVKeyFile = tempAbsPath' "utxo-keys/utxo" <> show @Int idx <> ".vkey" - let paymentAddrFile = tempAbsPath' "utxo-keys/utxo" <> show @Int idx <> ".addr" - - execCli_ - [ "address", "build" - , "--payment-verification-key-file", paymentVKeyFile - , "--testnet-magic", show @Int testnetMagic - , "--out-file", paymentAddrFile - ] + testnetMagic = cardanoTestnetMagic testnetOptions + logDir = makeLogDir $ TmpAbsolutePath tempAbsPath' + numPoolNodes = length $ cardanoNodes testnetOptions + + if all isJust [mconfig | SpoTestnetNodeOptions mconfig _ <- cardanoNodes testnetOptions] + then + -- TODO: We need a very simple non-obscure way of generating the files necessary + -- to run a testnet. "create-staked" is not a good way to do this especially because it + -- makes assumptions about where things should go and where genesis template files should be. + -- See all of the ad hoc file creation/renaming/dir creation etc below. + H.failMessage GHC.callStack "Specifying node configuration files per node not supported yet." + else do + startTime <- H.noteShow $ DTC.addUTCTime startTimeOffsetSeconds currentTime - paymentAddr <- H.readFile paymentAddrFile + H.createDirectoryIfMissing_ logDir - pure $ PaymentKeyInfo - { paymentKeyInfoPair = PaymentKeyPair - { paymentSKey = paymentSKeyFile - , paymentVKey = paymentVKeyFile - } - , paymentKeyInfoAddr = Text.pack paymentAddr - } - - _delegators <- forM [1..3] $ \idx -> do - pure $ Delegator - { paymentKeyPair = PaymentKeyPair - { paymentSKey = tempAbsPath' "stake-delegator-keys/payment" <> show @Int idx <> ".skey" - , paymentVKey = tempAbsPath' "stake-delegator-keys/payment" <> show @Int idx <> ".vkey" - } - , stakingKeyPair = StakingKeyPair - { stakingSKey = tempAbsPath' "stake-delegator-keys/staking" <> show @Int idx <> ".skey" - , stakingVKey = tempAbsPath' "stake-delegator-keys/staking" <> show @Int idx <> ".vkey" - } - } + H.lbsWriteFile (tempAbsPath' "byron.genesis.spec.json") + . J.encode $ defaultByronProtocolParamsJsonValue - let spoNodes :: [String] = ("node-spo" <>) . show <$> [1 .. numPoolNodes] + -- Because in Conway the overlay schedule and decentralization parameter + -- are deprecated, we must use the "create-staked" cli command to create + -- SPOs in the ShelleyGenesis + Byron.createByronGenesis + testnetMagic + startTime + Byron.byronDefaultGenesisOptions + (tempAbsPath' "byron.genesis.spec.json") + (tempAbsPath' "byron-gen-command") - -- Create the node directories - forM_ spoNodes $ \node -> do - H.createDirectoryIfMissing_ (tempAbsPath' node) + alonzoConwayTestGenesisJsonTargetFile <- H.noteShow $ tempAbsPath' "genesis.alonzo.spec.json" + gen <- H.evalEither $ first displayError defaultAlonzoGenesis + H.evalIO $ LBS.writeFile alonzoConwayTestGenesisJsonTargetFile $ Aeson.encode gen - -- Here we move all of the keys etc generated by create-staked - -- for the nodes to use + conwayConwayTestGenesisJsonTargetFile <- H.noteShow $ tempAbsPath' "genesis.conway.spec.json" + H.evalIO $ LBS.writeFile conwayConwayTestGenesisJsonTargetFile $ Aeson.encode defaultConwayGenesis - -- Move all genesis related files + configurationFile <- H.noteShow $ tempAbsPath' "configuration.yaml" - genesisByronDir <- H.createDirectoryIfMissing $ tempAbsPath' "byron" - genesisShelleyDir <- H.createDirectoryIfMissing $ tempAbsPath' "shelley" + genesisShelleyDir <- createSPOGenesisAndFiles testnetOptions startTime (TmpAbsolutePath tempAbsPath') - files <- H.listDirectory tempAbsPath' - forM_ files $ \file -> do - H.note file + poolKeys <- H.noteShow $ flip fmap [1..numPoolNodes] $ \n -> + PoolNodeKeys + { poolNodeKeysColdVkey = tempAbsPath' "pools" "cold" <> show n <> ".vkey" + , poolNodeKeysColdSkey = tempAbsPath' "pools" "cold" <> show n <> ".skey" + , poolNodeKeysVrfVkey = tempAbsPath' "pools" "vrf" <> show n <> ".vkey" + , poolNodeKeysVrfSkey = tempAbsPath' "pools" "vrf" <> show n <> ".skey" + , poolNodeKeysStakingVkey = tempAbsPath' "pools" "staking-reward" <> show n <> ".vkey" + , poolNodeKeysStakingSkey = tempAbsPath' "pools" "staking-reward" <> show n <> ".skey" + } - H.renameFile (tempAbsPath' "byron-gen-command/genesis.json") (genesisByronDir "genesis.json") - H.renameFile (tempAbsPath' "genesis.alonzo.json") (genesisShelleyDir "genesis.alonzo.json") - H.renameFile (tempAbsPath' "genesis.conway.json") (genesisShelleyDir "genesis.conway.json") - H.renameFile (tempAbsPath' "genesis.json") (genesisShelleyDir "genesis.json") + wallets <- forM [1..3] $ \idx -> do + let paymentSKeyFile = tempAbsPath' "utxo-keys/utxo" <> show @Int idx <> ".skey" + let paymentVKeyFile = tempAbsPath' "utxo-keys/utxo" <> show @Int idx <> ".vkey" + let paymentAddrFile = tempAbsPath' "utxo-keys/utxo" <> show @Int idx <> ".addr" - H.rewriteJsonFile (genesisByronDir "genesis.json") $ J.rewriteObject - $ flip HM.adjust "protocolConsts" - ( J.rewriteObject ( HM.insert "protocolMagic" (toJSON @Int testnetMagic))) + execCli_ + [ "address", "build" + , "--payment-verification-key-file", paymentVKeyFile + , "--testnet-magic", show @Int testnetMagic + , "--out-file", paymentAddrFile + ] + paymentAddr <- H.readFile paymentAddrFile - H.rewriteJsonFile (genesisShelleyDir "genesis.json") $ J.rewriteObject - ( HM.insert "slotLength" (toJSON @Double 0.1) - . HM.insert "activeSlotsCoeff" (toJSON @Double 0.1) - . HM.insert "securityParam" (toJSON @Int 6) -- TODO: USE config parameter - . HM.insert "epochLength" (toJSON @Int 600) -- Should be "10 * k / f" where "k = securityParam, f = activeSlotsCoeff" - . HM.insert "maxLovelaceSupply" (toJSON @Int 1000000000000) - . HM.insert "minFeeA" (toJSON @Int 44) - . HM.insert "minFeeB" (toJSON @Int 155381) - . HM.insert "minUTxOValue" (toJSON @Int 1000000) - . HM.insert "decentralisationParam" (toJSON @Double 0.7) - . flip HM.adjust "protocolParams" - ( J.rewriteObject - ( flip HM.adjust "protocolVersion" - ( J.rewriteObject ( HM.insert "major" (toJSON @Int 8))) - ) - ) - . HM.insert "rho" (toJSON @Double 0.1) - . HM.insert "tau" (toJSON @Double 0.1) - . HM.insert "updateQuorum" (toJSON @Int 2) - ) + pure $ PaymentKeyInfo + { paymentKeyInfoPair = PaymentKeyPair + { paymentSKey = paymentSKeyFile + , paymentVKey = paymentVKeyFile + } + , paymentKeyInfoAddr = Text.pack paymentAddr + } + _delegators <- forM [1..3] $ \idx -> do + pure $ Delegator + { paymentKeyPair = PaymentKeyPair + { paymentSKey = tempAbsPath' "stake-delegator-keys/payment" <> show @Int idx <> ".skey" + , paymentVKey = tempAbsPath' "stake-delegator-keys/payment" <> show @Int idx <> ".vkey" + } + , stakingKeyPair = StakingKeyPair + { stakingSKey = tempAbsPath' "stake-delegator-keys/staking" <> show @Int idx <> ".skey" + , stakingVKey = tempAbsPath' "stake-delegator-keys/staking" <> show @Int idx <> ".vkey" + } + } - -- Add Byron, Shelley and Alonzo genesis hashes to node configuration - -- TODO: These genesis filepaths should not be hardcoded. Using the cli as a library - -- rather as an executable will allow us to get the genesis files paths in a more - -- direct fashion. - finalYamlConfig <- createConfigYaml tempAbsPath $ cardanoNodeEra testnetOptions + let spoNodes :: [String] = ("node-spo" <>) . show <$> [1 .. numPoolNodes] - H.evalIO $ LBS.writeFile configurationFile finalYamlConfig + -- Create the node directories - H.renameFile (tempAbsPath' "pools/vrf1.skey") (tempAbsPath' "node-spo1/vrf.skey") - H.renameFile (tempAbsPath' "pools/vrf2.skey") (tempAbsPath' "node-spo2/vrf.skey") - H.renameFile (tempAbsPath' "pools/vrf3.skey") (tempAbsPath' "node-spo3/vrf.skey") + forM_ spoNodes $ \node -> do + H.createDirectoryIfMissing_ (tempAbsPath' node) - H.renameFile (tempAbsPath' "pools/opcert1.cert") (tempAbsPath' "node-spo1/opcert.cert") - H.renameFile (tempAbsPath' "pools/opcert2.cert") (tempAbsPath' "node-spo2/opcert.cert") - H.renameFile (tempAbsPath' "pools/opcert3.cert") (tempAbsPath' "node-spo3/opcert.cert") - H.renameFile (tempAbsPath' "pools/kes1.skey") (tempAbsPath' "node-spo1/kes.skey") - H.renameFile (tempAbsPath' "pools/kes2.skey") (tempAbsPath' "node-spo2/kes.skey") - H.renameFile (tempAbsPath' "pools/kes3.skey") (tempAbsPath' "node-spo3/kes.skey") + -- Add Byron, Shelley and Alonzo genesis hashes to node configuration + finalYamlConfig <- createConfigYaml tempAbsPath $ cardanoNodeEra testnetOptions - -- Byron related + H.evalIO $ LBS.writeFile configurationFile finalYamlConfig - H.renameFile (tempAbsPath' "byron-gen-command/delegate-keys.000.key") (tempAbsPath' "node-spo1/byron-delegate.key") - H.renameFile (tempAbsPath' "byron-gen-command/delegate-keys.001.key") (tempAbsPath' "node-spo2/byron-delegate.key") - H.renameFile (tempAbsPath' "byron-gen-command/delegate-keys.002.key") (tempAbsPath' "node-spo3/byron-delegate.key") + H.renameFile (tempAbsPath' "pools/vrf1.skey") (tempAbsPath' "node-spo1/vrf.skey") + H.renameFile (tempAbsPath' "pools/vrf2.skey") (tempAbsPath' "node-spo2/vrf.skey") + H.renameFile (tempAbsPath' "pools/vrf3.skey") (tempAbsPath' "node-spo3/vrf.skey") - H.renameFile (tempAbsPath' "byron-gen-command/delegation-cert.000.json") (tempAbsPath' "node-spo1/byron-delegation.cert") - H.renameFile (tempAbsPath' "byron-gen-command/delegation-cert.001.json") (tempAbsPath' "node-spo2/byron-delegation.cert") - H.renameFile (tempAbsPath' "byron-gen-command/delegation-cert.002.json") (tempAbsPath' "node-spo3/byron-delegation.cert") + H.renameFile (tempAbsPath' "pools/opcert1.cert") (tempAbsPath' "node-spo1/opcert.cert") + H.renameFile (tempAbsPath' "pools/opcert2.cert") (tempAbsPath' "node-spo2/opcert.cert") + H.renameFile (tempAbsPath' "pools/opcert3.cert") (tempAbsPath' "node-spo3/opcert.cert") - H.writeFile (tempAbsPath' "node-spo1/port") "3001" - H.writeFile (tempAbsPath' "node-spo2/port") "3002" - H.writeFile (tempAbsPath' "node-spo3/port") "3003" + H.renameFile (tempAbsPath' "pools/kes1.skey") (tempAbsPath' "node-spo1/kes.skey") + H.renameFile (tempAbsPath' "pools/kes2.skey") (tempAbsPath' "node-spo2/kes.skey") + H.renameFile (tempAbsPath' "pools/kes3.skey") (tempAbsPath' "node-spo3/kes.skey") + -- Byron related - -- Make topology files - -- TODO generalise this over the N BFT nodes and pool nodes + H.renameFile (tempAbsPath' "byron-gen-command/delegate-keys.000.key") (tempAbsPath' "node-spo1/byron-delegate.key") + H.renameFile (tempAbsPath' "byron-gen-command/delegate-keys.001.key") (tempAbsPath' "node-spo2/byron-delegate.key") + H.renameFile (tempAbsPath' "byron-gen-command/delegate-keys.002.key") (tempAbsPath' "node-spo3/byron-delegate.key") - H.lbsWriteFile (tempAbsPath' "node-spo1/topology.json") $ encode $ - object - [ "Producers" .= toJSON - [ object - [ "addr" .= toJSON @String "127.0.0.1" - , "port" .= toJSON @Int 3002 - , "valency" .= toJSON @Int 1 - ] - , object - [ "addr" .= toJSON @String "127.0.0.1" - , "port" .= toJSON @Int 3003 - , "valency" .= toJSON @Int 1 - ] - , object - [ "addr" .= toJSON @String "127.0.0.1" - , "port" .= toJSON @Int 3005 - , "valency" .= toJSON @Int 1 - ] - ] - ] - - H.lbsWriteFile (tempAbsPath' "node-spo2/topology.json") $ encode $ - object - [ "Producers" .= toJSON - [ object - [ "addr" .= toJSON @String "127.0.0.1" - , "port" .= toJSON @Int 3001 - , "valency" .= toJSON @Int 1 - ] - , object - [ "addr" .= toJSON @String "127.0.0.1" - , "port" .= toJSON @Int 3003 - , "valency" .= toJSON @Int 1 - ] - , object - [ "addr" .= toJSON @String "127.0.0.1" - , "port" .= toJSON @Int 3005 - , "valency" .= toJSON @Int 1 - ] - ] - ] - - H.lbsWriteFile (tempAbsPath' "node-spo3/topology.json") $ encode $ - object - [ "Producers" .= toJSON - [ object - [ "addr" .= toJSON @String "127.0.0.1" - , "port" .= toJSON @Int 3001 - , "valency" .= toJSON @Int 1 - ] - , object - [ "addr" .= toJSON @String "127.0.0.1" - , "port" .= toJSON @Int 3002 - , "valency" .= toJSON @Int 1 - ] - , object - [ "addr" .= toJSON @String "127.0.0.1" - , "port" .= toJSON @Int 3005 - , "valency" .= toJSON @Int 1 - ] - ] - ] - nodeStdoutFiles <- forM spoNodes $ \node -> do - H.noteTempFile (makeLogDir $ TmpAbsolutePath tempAbsPath') $ node <> ".stdout.log" - - let spoNodesWithPortNos = L.zip spoNodes [3001..] - nodeConfigFile = tempAbsPath' "configuration.yaml" - ePoolNodes <- forM (L.zip spoNodesWithPortNos poolKeys) $ \((node, port),key) -> do - eRuntime <- lift . lift . runExceptT $ startNode (TmpAbsolutePath tempAbsPath') node port - [ "run" - , "--config", nodeConfigFile - , "--topology", tempAbsPath' node "topology.json" - , "--database-path", tempAbsPath' node "db" - , "--shelley-kes-key", tempAbsPath' node "kes.skey" - , "--shelley-vrf-key", tempAbsPath' node "vrf.skey" - , "--byron-delegation-certificate", tempAbsPath' node "byron-delegation.cert" - , "--byron-signing-key", tempAbsPath' node "byron-delegate.key" - , "--shelley-operational-certificate", tempAbsPath' node "opcert.cert" - ] - return $ flip PoolNode key <$> eRuntime - - if any isLeft ePoolNodes - then failMessage GHC.callStack $ show $ map show $ lefts ePoolNodes - else do - let (_ , poolNodes) = partitionEithers ePoolNodes - now <- H.noteShowIO DTC.getCurrentTime - deadline <- H.noteShow $ DTC.addUTCTime 30 now - - forM_ nodeStdoutFiles $ \nodeStdoutFile -> do - H.assertChainExtended deadline (cardanoNodeLoggingFormat testnetOptions) nodeStdoutFile - - H.noteShowIO_ DTC.getCurrentTime - - forM_ wallets $ \wallet -> do - H.cat $ paymentSKey $ paymentKeyInfoPair wallet - H.cat $ paymentVKey $ paymentKeyInfoPair wallet - - let runtime = TestnetRuntime - { configurationFile - , shelleyGenesisFile = genesisShelleyDir "genesis.json" - , testnetMagic - , poolNodes - , wallets = wallets - , delegators = [] - } + H.renameFile (tempAbsPath' "byron-gen-command/delegation-cert.000.json") (tempAbsPath' "node-spo1/byron-delegation.cert") + H.renameFile (tempAbsPath' "byron-gen-command/delegation-cert.001.json") (tempAbsPath' "node-spo2/byron-delegation.cert") + H.renameFile (tempAbsPath' "byron-gen-command/delegation-cert.002.json") (tempAbsPath' "node-spo3/byron-delegation.cert") - let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath + H.writeFile (tempAbsPath' "node-spo1/port") "3001" + H.writeFile (tempAbsPath' "node-spo2/port") "3002" + H.writeFile (tempAbsPath' "node-spo3/port") "3003" - execConfig <- H.headM (poolSprockets runtime) >>= H.mkExecConfig tempBaseAbsPath - forM_ wallets $ \wallet -> do - H.cat $ paymentSKey $ paymentKeyInfoPair wallet - H.cat $ paymentVKey $ paymentKeyInfoPair wallet + -- Make topology files + -- TODO generalise this over the N BFT nodes and pool nodes - utxos <- execCli' execConfig - [ "query", "utxo" - , "--address", Text.unpack $ paymentKeyInfoAddr wallet - , "--cardano-mode" - , "--testnet-magic", show @Int testnetMagic + H.lbsWriteFile (tempAbsPath' "node-spo1/topology.json") $ encode $ + object + [ "Producers" .= toJSON + [ object + [ "addr" .= toJSON @String "127.0.0.1" + , "port" .= toJSON @Int 3002 + , "valency" .= toJSON @Int 1 + ] + , object + [ "addr" .= toJSON @String "127.0.0.1" + , "port" .= toJSON @Int 3003 + , "valency" .= toJSON @Int 1 + ] + , object + [ "addr" .= toJSON @String "127.0.0.1" + , "port" .= toJSON @Int 3005 + , "valency" .= toJSON @Int 1 + ] ] + ] - H.note_ utxos - - stakePoolsFp <- H.note $ tempAbsPath' "current-stake-pools.json" - - prop_spos_in_ledger_state stakePoolsFp testnetOptions execConfig + H.lbsWriteFile (tempAbsPath' "node-spo2/topology.json") $ encode $ + object + [ "Producers" .= toJSON + [ object + [ "addr" .= toJSON @String "127.0.0.1" + , "port" .= toJSON @Int 3001 + , "valency" .= toJSON @Int 1 + ] + , object + [ "addr" .= toJSON @String "127.0.0.1" + , "port" .= toJSON @Int 3003 + , "valency" .= toJSON @Int 1 + ] + , object + [ "addr" .= toJSON @String "127.0.0.1" + , "port" .= toJSON @Int 3005 + , "valency" .= toJSON @Int 1 + ] + ] + ] - pure runtime + H.lbsWriteFile (tempAbsPath' "node-spo3/topology.json") $ encode $ + object + [ "Producers" .= toJSON + [ object + [ "addr" .= toJSON @String "127.0.0.1" + , "port" .= toJSON @Int 3001 + , "valency" .= toJSON @Int 1 + ] + , object + [ "addr" .= toJSON @String "127.0.0.1" + , "port" .= toJSON @Int 3002 + , "valency" .= toJSON @Int 1 + ] + , object + [ "addr" .= toJSON @String "127.0.0.1" + , "port" .= toJSON @Int 3005 + , "valency" .= toJSON @Int 1 + ] + ] + ] + nodeStdoutFiles <- forM spoNodes $ \node -> do + H.noteTempFile (makeLogDir $ TmpAbsolutePath tempAbsPath') $ node <> ".stdout.log" + + let spoNodesWithPortNos = L.zip spoNodes [3001..] + nodeConfigFile = tempAbsPath' "configuration.yaml" + ePoolNodes <- forM (L.zip spoNodesWithPortNos poolKeys) $ \((node, port),key) -> do + eRuntime <- lift . lift . runExceptT $ startNode (TmpAbsolutePath tempAbsPath') node port + [ "run" + , "--config", nodeConfigFile + , "--topology", tempAbsPath' node "topology.json" + , "--database-path", tempAbsPath' node "db" + , "--shelley-kes-key", tempAbsPath' node "kes.skey" + , "--shelley-vrf-key", tempAbsPath' node "vrf.skey" + , "--byron-delegation-certificate", tempAbsPath' node "byron-delegation.cert" + , "--byron-signing-key", tempAbsPath' node "byron-delegate.key" + , "--shelley-operational-certificate", tempAbsPath' node "opcert.cert" + ] + return $ flip PoolNode key <$> eRuntime + + if any isLeft ePoolNodes + -- TODO: We can render this in a nicer way + then failMessage GHC.callStack . show . map show $ lefts ePoolNodes + else do + let (_ , poolNodes) = partitionEithers ePoolNodes + now <- H.noteShowIO DTC.getCurrentTime + deadline <- H.noteShow $ DTC.addUTCTime 30 now + + forM_ nodeStdoutFiles $ \nodeStdoutFile -> do + H.assertChainExtended deadline (cardanoNodeLoggingFormat testnetOptions) nodeStdoutFile + + H.noteShowIO_ DTC.getCurrentTime + + forM_ wallets $ \wallet -> do + H.cat $ paymentSKey $ paymentKeyInfoPair wallet + H.cat $ paymentVKey $ paymentKeyInfoPair wallet + + let runtime = TestnetRuntime + { configurationFile + , shelleyGenesisFile = genesisShelleyDir "genesis.json" + , testnetMagic + , poolNodes + , wallets = wallets + , delegators = [] + } + + let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath + + execConfig <- H.headM (poolSprockets runtime) >>= H.mkExecConfig tempBaseAbsPath + + forM_ wallets $ \wallet -> do + H.cat $ paymentSKey $ paymentKeyInfoPair wallet + H.cat $ paymentVKey $ paymentKeyInfoPair wallet + + utxos <- execCli' execConfig + [ "query", "utxo" + , "--address", Text.unpack $ paymentKeyInfoAddr wallet + , "--cardano-mode" + , "--testnet-magic", show @Int testnetMagic + ] + + H.note_ utxos + + stakePoolsFp <- H.note $ tempAbsPath' "current-stake-pools.json" + + prop_spos_in_ledger_state stakePoolsFp testnetOptions execConfig + + pure runtime diff --git a/cardano-testnet/src/Testnet/Start/Types.hs b/cardano-testnet/src/Testnet/Start/Types.hs index 5acfedba366..5f79a62e780 100644 --- a/cardano-testnet/src/Testnet/Start/Types.hs +++ b/cardano-testnet/src/Testnet/Start/Types.hs @@ -11,7 +11,7 @@ module Testnet.Start.Types , NodeLoggingFormat(..) , Conf(..) - , YamlFilePath(..) + , NodeConfigurationYaml(..) , mkConf ) where @@ -48,37 +48,37 @@ cardanoDefaultTestnetOptions :: CardanoTestnetOptions cardanoDefaultTestnetOptions = CardanoTestnetOptions { cardanoNodes = cardanoDefaultTestnetNodeOptions , cardanoNodeEra = AnyCardanoEra BabbageEra - , cardanoEpochLength = 1500 - , cardanoSlotLength = 0.2 + , cardanoEpochLength = 500 + , cardanoSlotLength = 0.1 , cardanoTestnetMagic = 42 - , cardanoActiveSlotsCoeff = 0.2 + , cardanoActiveSlotsCoeff = 0.1 , cardanoMaxSupply = 10020000000 , cardanoEnableP2P = False , cardanoNodeLoggingFormat = NodeLoggingFormatAsJson } -- | Specify a BFT node (Pre-Babbage era only) or an SPO (Shelley era onwards only) -newtype TestnetNodeOptions - = SpoTestnetNodeOptions [String] +data TestnetNodeOptions + = SpoTestnetNodeOptions (Maybe NodeConfigurationYaml) [String] -- ^ These arguments will be appended to the default set of CLI options when -- starting the node. deriving (Eq, Show) extraSpoNodeCliArgs :: TestnetNodeOptions -> [String] -extraSpoNodeCliArgs (SpoTestnetNodeOptions args) = args +extraSpoNodeCliArgs (SpoTestnetNodeOptions _ args) = args cardanoDefaultTestnetNodeOptions :: [TestnetNodeOptions] cardanoDefaultTestnetNodeOptions = - [ SpoTestnetNodeOptions [] - , SpoTestnetNodeOptions [] - , SpoTestnetNodeOptions [] + [ SpoTestnetNodeOptions Nothing [] + , SpoTestnetNodeOptions Nothing [] + , SpoTestnetNodeOptions Nothing [] ] data NodeLoggingFormat = NodeLoggingFormatAsJson | NodeLoggingFormatAsText deriving (Eq, Show) -newtype YamlFilePath = YamlFilePath +newtype NodeConfigurationYaml = NodeConfigurationYaml { unYamlFilePath :: FilePath } deriving (Eq, Show) diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/help/cardano.cli b/cardano-testnet/test/cardano-testnet-golden/files/golden/help/cardano.cli index fa811a5d535..149279727cc 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/help/cardano.cli +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/help/cardano.cli @@ -17,8 +17,9 @@ Usage: cardano-testnet cardano [--num-pool-nodes COUNT] Start a testnet in any era Available options: - --num-pool-nodes COUNT Number of pool nodes - (default: [SpoTestnetNodeOptions [],SpoTestnetNodeOptions [],SpoTestnetNodeOptions []]) + --num-pool-nodes COUNT Number of pool nodes. Note this uses a default node + configuration for all nodes. + (default: [SpoTestnetNodeOptions Nothing [],SpoTestnetNodeOptions Nothing [],SpoTestnetNodeOptions Nothing []]) --byron-era Specify the Byron era --shelley-era Specify the Shelley era --allegra-era Specify the Allegra era @@ -26,11 +27,11 @@ Available options: --alonzo-era Specify the Alonzo era --babbage-era Specify the Babbage era (default) --epoch-length MILLISECONDS - Epoch length (default: 1500) - --slot-length SECONDS Slot length (default: 0.2) + Epoch length (default: 500) + --slot-length SECONDS Slot length (default: 0.1) --testnet-magic INT Specify a testnet magic id. --active-slots-coeff DOUBLE - Active slots co-efficient (default: 0.2) + Active slots co-efficient (default: 0.1) --max-lovelace-supply WORD64 Max lovelace supply that your testnet starts with. (default: 10020000000) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs index c948ba8075d..7c6f311dac5 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs @@ -70,8 +70,7 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch let era = BabbageEra cTestnetOptions = cardanoDefaultTestnetOptions { cardanoNodes = cardanoDefaultTestnetNodeOptions - , cardanoEpochLength = 1000 - , cardanoSlotLength = 0.02 + , cardanoSlotLength = 0.1 , cardanoActiveSlotsCoeff = 0.1 , cardanoNodeEra = AnyCardanoEra era -- TODO: We should only support the latest era and the upcoming era } diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/StakeSnapshot.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/StakeSnapshot.hs index 8e49057f9c0..9a92febf7bd 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/StakeSnapshot.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/StakeSnapshot.hs @@ -55,8 +55,7 @@ hprop_stakeSnapshot = H.integrationRetryWorkspace 2 "babbage-stake-snapshot" $ \ era = BabbageEra options = cardanoDefaultTestnetOptions { cardanoNodes = cardanoDefaultTestnetNodeOptions - , cardanoEpochLength = 1000 - , cardanoSlotLength = 0.02 + , cardanoSlotLength = 0.1 , cardanoNodeEra = AnyCardanoEra era -- TODO: We should only support the latest era and the upcoming era } diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/StakeSnapshot.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/StakeSnapshot.hs index 2acc36ecb04..c91b0060d41 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/StakeSnapshot.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/StakeSnapshot.hs @@ -55,8 +55,7 @@ hprop_stakeSnapshot = H.integrationRetryWorkspace 2 "conway-stake-snapshot" $ \t era = BabbageEra options = cardanoDefaultTestnetOptions { cardanoNodes = cardanoDefaultTestnetNodeOptions - , cardanoEpochLength = 1000 - , cardanoSlotLength = 0.02 + , cardanoSlotLength = 0.1 , cardanoNodeEra = AnyCardanoEra era -- TODO: We should only support the latest era and the upcoming era } diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs index d2729dabfd8..39afde93556 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs @@ -61,8 +61,7 @@ hprop_kes_period_info = H.integrationRetryWorkspace 2 "kes-period-info" $ \tempA era = BabbageEra cTestnetOptions = cardanoDefaultTestnetOptions { cardanoNodes = cardanoDefaultTestnetNodeOptions - , cardanoEpochLength = 1_000 - , cardanoSlotLength = 0.02 + , cardanoSlotLength = 0.1 , cardanoActiveSlotsCoeff = 0.1 , cardanoNodeEra = AnyCardanoEra era -- TODO: We should only support the latest era and the upcoming era } diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/QuerySlotNumber.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/QuerySlotNumber.hs index e2ada6e832a..4d3e4e93a88 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/QuerySlotNumber.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/QuerySlotNumber.hs @@ -47,8 +47,7 @@ hprop_querySlotNumber = H.integrationRetryWorkspace 2 "query-slot-number" $ \tem era = BabbageEra options = cardanoDefaultTestnetOptions { cardanoNodes = cardanoDefaultTestnetNodeOptions - , cardanoEpochLength = 1000 - , cardanoSlotLength = 0.02 + , cardanoSlotLength = 0.1 , cardanoNodeEra = AnyCardanoEra era -- TODO: We should only support the latest era and the upcoming era } diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldBlocks.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldBlocks.hs index 7d910439f51..cf4839bf446 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldBlocks.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldBlocks.hs @@ -45,8 +45,7 @@ prop_foldBlocks = H.integrationRetryWorkspace 2 "foldblocks" $ \tempAbsBasePath' era = BabbageEra options = cardanoDefaultTestnetOptions { cardanoNodes = cardanoDefaultTestnetNodeOptions - , cardanoEpochLength = 1000 - , cardanoSlotLength = 0.02 + , cardanoSlotLength = 0.1 , cardanoNodeEra = AnyCardanoEra era -- TODO: We should only support the latest era and the upcoming era } diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs index dbbe042fae7..6af0fe91509 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs @@ -124,7 +124,7 @@ hprop_shutdown = H.integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' -> $ mconcat [ byronGenesisHash , shelleyGenesisHash , alonzoGenesisHash - , defaultYamlHardforkViaConfig (AnyCardanoEra BabbageEra)] + , defaultYamlHardforkViaConfig (AnyCardanoEra BabbageEra)] -- TODO: This should not be hardcoded H.evalIO $ LBS.writeFile (tempAbsPath' "configuration.yaml") finalYamlConfig @@ -188,9 +188,9 @@ hprop_shutdownOnSlotSynced = H.integrationRetryWorkspace 2 "shutdown-on-slot-syn { cardanoEpochLength = 300 , cardanoSlotLength = slotLen , cardanoNodes = - [ SpoTestnetNodeOptions ["--shutdown-on-slot-synced", show maxSlot] - , SpoTestnetNodeOptions [] - , SpoTestnetNodeOptions [] + [ SpoTestnetNodeOptions Nothing ["--shutdown-on-slot-synced", show maxSlot] + , SpoTestnetNodeOptions Nothing [] + , SpoTestnetNodeOptions Nothing [] ] } testnetRuntime <- cardanoTestnet fastTestnetOptions conf