diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal index 4150ad6e125..9a2484ee34a 100644 --- a/cardano-node-chairman/cardano-node-chairman.cabal +++ b/cardano-node-chairman/cardano-node-chairman.cabal @@ -70,6 +70,7 @@ test-suite chairman-tests build-depends: cardano-testnet , cardano-crypto-class ^>= 2.1.2 + , data-default-class , filepath , hedgehog , hedgehog-extras ^>= 0.6.4 diff --git a/cardano-node-chairman/test/Spec/Chairman/Cardano.hs b/cardano-node-chairman/test/Spec/Chairman/Cardano.hs index d84616db172..fee7a3d7a86 100644 --- a/cardano-node-chairman/test/Spec/Chairman/Cardano.hs +++ b/cardano-node-chairman/test/Spec/Chairman/Cardano.hs @@ -4,9 +4,10 @@ module Spec.Chairman.Cardano where -import Cardano.Testnet (NodeRuntime (nodeName), allNodes, cardanoDefaultTestnetOptions, +import Cardano.Testnet (NodeRuntime (nodeName), allNodes, cardanoTestnetDefault, mkConf) +import Data.Default.Class import Testnet.Property.Util (integrationRetryWorkspace) import qualified Hedgehog as H @@ -18,6 +19,6 @@ hprop_chairman :: H.Property hprop_chairman = integrationRetryWorkspace 2 "cardano-chairman" $ \tempAbsPath' -> do conf <- mkConf tempAbsPath' - allNodes' <- fmap nodeName . allNodes <$> cardanoTestnetDefault cardanoDefaultTestnetOptions conf + allNodes' <- fmap nodeName . allNodes <$> cardanoTestnetDefault def def conf chairmanOver 120 50 conf allNodes' diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index e410642c547..57736f5197b 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -228,6 +228,7 @@ test-suite cardano-testnet-test , cardano-strict-containers ^>= 0.1 , cardano-testnet , containers + , data-default-class , directory , exceptions , filepath diff --git a/cardano-testnet/src/Cardano/Testnet.hs b/cardano-testnet/src/Cardano/Testnet.hs index c506c054bf3..33ed84e2f23 100644 --- a/cardano-testnet/src/Cardano/Testnet.hs +++ b/cardano-testnet/src/Cardano/Testnet.hs @@ -11,7 +11,6 @@ module Cardano.Testnet ( -- ** Testnet options CardanoTestnetOptions(..), TestnetNodeOptions(..), - cardanoDefaultTestnetOptions, cardanoDefaultTestnetNodeOptions, getDefaultAlonzoGenesis, getDefaultShelleyGenesis, diff --git a/cardano-testnet/src/Parsers/Cardano.hs b/cardano-testnet/src/Parsers/Cardano.hs index a042521a1c2..46abc97f0f2 100644 --- a/cardano-testnet/src/Parsers/Cardano.hs +++ b/cardano-testnet/src/Parsers/Cardano.hs @@ -9,6 +9,7 @@ import Cardano.CLI.EraBased.Options.Common hiding (pNetworkId) import Prelude +import Data.Default.Class import Data.Functor import qualified Data.List as L import Data.Word (Word64) @@ -20,46 +21,29 @@ import Testnet.Start.Types import Testnet.Types (readNodeLoggingFormat) -optsTestnet :: EnvCli -> Parser CardanoTestnetOptions -optsTestnet envCli = CardanoTestnetOptions +optsTestnet :: EnvCli -> Parser CardanoTestnetCliOptions +optsTestnet envCli = CardanoTestnetCliOptions + <$> pCardanoTestnetCliOptions envCli + <*> pShelleyTestnetOptions + +pCardanoTestnetCliOptions :: EnvCli -> Parser CardanoTestnetOptions +pCardanoTestnetCliOptions envCli = CardanoTestnetOptions <$> pNumSpoNodes <*> pAnyShelleyBasedEra' - <*> OA.option auto - ( OA.long "epoch-length" - <> OA.help "Epoch length, in number of slots" - <> OA.metavar "SLOTS" - <> OA.showDefault - <> OA.value (cardanoEpochLength cardanoDefaultTestnetOptions) - ) - <*> OA.option auto - ( OA.long "slot-length" - <> OA.help "Slot length" - <> OA.metavar "SECONDS" - <> OA.showDefault - <> OA.value (cardanoSlotLength cardanoDefaultTestnetOptions) - ) - <*> pNetworkId - <*> OA.option auto - ( OA.long "active-slots-coeff" - <> OA.help "Active slots co-efficient" - <> OA.metavar "DOUBLE" - <> OA.showDefault - <> OA.value (cardanoActiveSlotsCoeff cardanoDefaultTestnetOptions) - ) <*> pMaxLovelaceSupply <*> OA.option auto ( OA.long "enable-p2p" <> OA.help "Enable P2P" <> OA.metavar "BOOL" <> OA.showDefault - <> OA.value (cardanoEnableP2P cardanoDefaultTestnetOptions) + <> OA.value (cardanoEnableP2P def) ) <*> OA.option (OA.eitherReader readNodeLoggingFormat) ( OA.long "nodeLoggingFormat" <> OA.help "Node logging format (json|text)" <> OA.metavar "LOGGING_FORMAT" <> OA.showDefault - <> OA.value (cardanoNodeLoggingFormat cardanoDefaultTestnetOptions) + <> OA.value (cardanoNodeLoggingFormat def) ) <*> OA.option auto ( OA.long "num-dreps" @@ -86,10 +70,9 @@ pNumSpoNodes = <> 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) + <> OA.value (cardanoNodes def) ) - _pSpo :: Parser TestnetNodeOptions _pSpo = SpoTestnetNodeOptions . Just @@ -113,8 +96,40 @@ parseNodeConfigFile = NodeConfigurationYaml <$> , "Or use num-pool-nodes to use cardano-testnet's default configuration." ] - -cmdCardano :: EnvCli -> Mod CommandFields CardanoTestnetOptions +pShelleyTestnetOptions :: Parser ShelleyTestnetOptions +pShelleyTestnetOptions = + ShelleyTestnetOptions + <$> pNetworkId + <*> pEpochLength + <*> pSlotLength + <*> pActiveSlotCoeffs + where + pEpochLength = + OA.option auto + ( OA.long "epoch-length" + <> OA.help "Epoch length, in number of slots" + <> OA.metavar "SLOTS" + <> OA.showDefault + <> OA.value (shelleyEpochLength def) + ) + pSlotLength = + OA.option auto + ( OA.long "slot-length" + <> OA.help "Slot length" + <> OA.metavar "SECONDS" + <> OA.showDefault + <> OA.value (shelleySlotLength def) + ) + pActiveSlotCoeffs = + OA.option auto + ( OA.long "active-slots-coeff" + <> OA.help "Active slots co-efficient" + <> OA.metavar "DOUBLE" + <> OA.showDefault + <> OA.value (shelleyActiveSlotsCoeff def) + ) + +cmdCardano :: EnvCli -> Mod CommandFields CardanoTestnetCliOptions cmdCardano envCli = command' "cardano" "Start a testnet in any era" (optsTestnet envCli) pNetworkId :: Parser Int @@ -132,6 +147,6 @@ pMaxLovelaceSupply = <> help "Max lovelace supply that your testnet starts with." <> metavar "WORD64" <> showDefault - <> value (cardanoMaxSupply cardanoDefaultTestnetOptions) + <> value (cardanoMaxSupply def) ) diff --git a/cardano-testnet/src/Parsers/Run.hs b/cardano-testnet/src/Parsers/Run.hs index 428f663c2ec..7ea49f8e920 100644 --- a/cardano-testnet/src/Parsers/Run.hs +++ b/cardano-testnet/src/Parsers/Run.hs @@ -31,7 +31,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 CardanoTestnetOptions + = StartCardanoTestnet CardanoTestnetCliOptions | GetVersion VersionOptions | Help ParserPrefs (ParserInfo CardanoTestnetCommands) HelpOptions @@ -51,6 +51,6 @@ runTestnetCmd = \case Help pPrefs pInfo cmdOpts -> runHelpOptions pPrefs pInfo cmdOpts -runCardanoOptions :: CardanoTestnetOptions -> IO () -runCardanoOptions options = - runTestnet $ cardanoTestnetDefault options +runCardanoOptions :: CardanoTestnetCliOptions -> IO () +runCardanoOptions (CardanoTestnetCliOptions testnetOptions shelleyOptions) = + runTestnet $ cardanoTestnetDefault testnetOptions shelleyOptions diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs index 7a0d2bb6e83..32029b6333c 100644 --- a/cardano-testnet/src/Testnet/Defaults.hs +++ b/cardano-testnet/src/Testnet/Defaults.hs @@ -68,6 +68,7 @@ import Data.Text (Text) import qualified Data.Text as Text import Data.Time (UTCTime) import qualified Data.Vector as Vector +import Data.Word (Word64) import Lens.Micro import Numeric.Natural import System.FilePath (()) @@ -416,31 +417,31 @@ defaultByronProtocolParamsJsonValue = ] defaultShelleyGenesis - :: UTCTime - -> CardanoTestnetOptions + :: AnyShelleyBasedEra + -> UTCTime + -> Word64 + -> ShelleyTestnetOptions -> Api.ShelleyGenesis StandardCrypto -defaultShelleyGenesis startTime testnetOptions = do - let CardanoTestnetOptions - { cardanoTestnetMagic = testnetMagic - , cardanoSlotLength = slotLength - , cardanoEpochLength = epochLength - , cardanoMaxSupply = sgMaxLovelaceSupply - , cardanoActiveSlotsCoeff - , cardanoNodeEra - } = testnetOptions +defaultShelleyGenesis asbe startTime maxSupply options = do + let ShelleyTestnetOptions + { shelleyTestnetMagic = magic + , shelleySlotLength = slotLength + , shelleyEpochLength = epochLength + , shelleyActiveSlotsCoeff + } = options -- f - activeSlotsCoeff = round (cardanoActiveSlotsCoeff * 100) % 100 + activeSlotsCoeff = round (shelleyActiveSlotsCoeff * 100) % 100 -- make security param k satisfy: epochLength = 10 * k / f -- TODO: find out why this actually degrates network stability - turned off for now -- securityParam = ceiling $ fromIntegral epochLength * cardanoActiveSlotsCoeff / 10 - pVer = eraToProtocolVersion cardanoNodeEra + pVer = eraToProtocolVersion asbe protocolParams = Api.sgProtocolParams Api.shelleyGenesisDefaults protocolParamsWithPVer = protocolParams & ppProtocolVersionL' .~ pVer Api.shelleyGenesisDefaults { Api.sgActiveSlotsCoeff = unsafeBoundedRational activeSlotsCoeff , Api.sgEpochLength = EpochSize $ fromIntegral epochLength - , Api.sgMaxLovelaceSupply - , Api.sgNetworkMagic = fromIntegral testnetMagic + , Api.sgMaxLovelaceSupply = maxSupply + , Api.sgNetworkMagic = fromIntegral magic , Api.sgProtocolParams = protocolParamsWithPVer -- using default from shelley genesis k = 2160 -- , Api.sgSecurityParam = securityParam diff --git a/cardano-testnet/src/Testnet/Process/Cli/SPO.hs b/cardano-testnet/src/Testnet/Process/Cli/SPO.hs index 4161bb25f0e..78430b06fbb 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/SPO.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/SPO.hs @@ -241,12 +241,13 @@ createStakeKeyDeregistrationCertificate tempAbsP sbe stakeVerKey deposit outputF -- | Related documentation: https://github.com/input-output-hk/cardano-node-wiki/blob/main/docs/stake-pool-operations/8_register_stakepool.md registerSingleSpo :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) - => Int -- ^ Identifier for stake pool + => AnyShelleyBasedEra + -> Int -- ^ Identifier for stake pool -> TmpAbsolutePath -> NodeConfigFile 'In -> SocketPath -> EpochNo -- ^ Termination epoch - -> CardanoTestnetOptions + -> Int -- ^ Testnet magic -> ExecConfig -> (TxIn, FilePath, String) -> m ( String @@ -260,10 +261,8 @@ registerSingleSpo -- 3. FilePath: Stake pool cold verification key -- 4. FilePath: Stake pool VRF signing key -- 5. FilePath: Stake pool VRF verification key -registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigFile socketPath termEpoch cTestnetOptions execConfig +registerSingleSpo asbe identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigFile socketPath termEpoch testnetMag execConfig (fundingInput, fundingSigninKey, changeAddr) = GHC.withFrozenCallStack $ do - let testnetMag = cardanoTestnetMagic cTestnetOptions - workDir <- H.note tempAbsPath' -- In order to register a stake pool we need two certificates: @@ -322,7 +321,6 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigFile s -- 5. Create registration certificate let poolRegCertFp = spoReqDir "registration.cert" - let asbe = cardanoNodeEra cTestnetOptions -- The pledge, pool cost and pool margin can all be 0 execCli_ diff --git a/cardano-testnet/src/Testnet/Property/Assert.hs b/cardano-testnet/src/Testnet/Property/Assert.hs index 67f0991f804..5840a293e17 100644 --- a/cardano-testnet/src/Testnet/Property/Assert.hs +++ b/cardano-testnet/src/Testnet/Property/Assert.hs @@ -40,7 +40,7 @@ import Data.Type.Equality import Data.Word (Word8) import GHC.Stack as GHC -import Testnet.Components.Configuration (NumPools(..), numPools) +import Testnet.Components.Configuration (NumPools(..)) import Testnet.Process.Run import Testnet.Start.Types @@ -84,12 +84,10 @@ assertByDeadlineIOCustom str deadline f = withFrozenCallStack $ do assertExpectedSposInLedgerState :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => FilePath -- ^ Stake pools query output filepath - -> CardanoTestnetOptions + -> NumPools -> ExecConfig -> m () -assertExpectedSposInLedgerState output tNetOptions execConfig = withFrozenCallStack $ do - let NumPools numExpectedPools = numPools tNetOptions - +assertExpectedSposInLedgerState output (NumPools numExpectedPools) execConfig = withFrozenCallStack $ do void $ execCli' execConfig [ "query", "stake-pools" , "--out-file", output diff --git a/cardano-testnet/src/Testnet/Start/Cardano.hs b/cardano-testnet/src/Testnet/Start/Cardano.hs index 80ec4b5ca70..f473b8aab05 100644 --- a/cardano-testnet/src/Testnet/Start/Cardano.hs +++ b/cardano-testnet/src/Testnet/Start/Cardano.hs @@ -8,10 +8,10 @@ module Testnet.Start.Cardano ( ForkPoint(..) + , CardanoTestnetCliOptions(..) , CardanoTestnetOptions(..) , extraSpoNodeCliArgs , TestnetNodeOptions(..) - , cardanoDefaultTestnetOptions , cardanoDefaultTestnetNodeOptions , TestnetRuntime (..) @@ -43,10 +43,10 @@ import Data.Either import qualified Data.List as L import Data.Maybe import qualified Data.Text as Text -import Data.Time (UTCTime, diffUTCTime) +import Data.Time (diffUTCTime) import Data.Time.Clock (NominalDiffTime) import qualified Data.Time.Clock as DTC -import Data.Word (Word32) +import Data.Word (Word64) import GHC.Stack import qualified GHC.Stack as GHC import System.FilePath (()) @@ -71,12 +71,10 @@ import qualified Hedgehog.Extras.Stock.OS as OS -- | There are certain conditions that need to be met in order to run -- a valid node cluster. -testnetMinimumConfigurationRequirements :: MonadTest m => CardanoTestnetOptions -> m () -testnetMinimumConfigurationRequirements cTestnetOpts = do - let actualLength = length (cardanoNodes cTestnetOpts) - when (actualLength < 2) $ do - H.noteShow_ ("Need at least two nodes to run a cluster, but got: " <> show actualLength) - H.noteShow_ cTestnetOpts +testnetMinimumConfigurationRequirements :: MonadTest m => NumPools -> m () +testnetMinimumConfigurationRequirements (NumPools n) = + when (n < 2) $ do + H.noteShow_ ("Need at least two nodes to run a cluster, but got: " <> show n) H.failure data ForkPoint @@ -90,19 +88,23 @@ data ForkPoint startTimeOffsetSeconds :: DTC.NominalDiffTime startTimeOffsetSeconds = if OS.isWin32 then 90 else 15 --- | Like 'cardanoTestnet', but using defaults for all configuration files. +-- | Like 'cardanoTestnet', but using 'ShelleyTestnetOptions' to obtain +-- the genesis files, instead of passing them directly. -- See 'cardanoTestnet' for additional documentation. cardanoTestnetDefault :: () => HasCallStack => CardanoTestnetOptions + -> ShelleyTestnetOptions -> Conf -> H.Integration TestnetRuntime -cardanoTestnetDefault opts conf = do - AnyShelleyBasedEra sbe <- pure $ cardanoNodeEra cardanoDefaultTestnetOptions +cardanoTestnetDefault testnetOptions shelleyOptions conf = do + AnyShelleyBasedEra sbe <- pure cardanoNodeEra alonzoGenesis <- getDefaultAlonzoGenesis sbe - (startTime, shelleyGenesis) <- getDefaultShelleyGenesis opts - cardanoTestnet opts conf startTime shelleyGenesis alonzoGenesis Defaults.defaultConwayGenesis + shelleyGenesis <- getDefaultShelleyGenesis cardanoNodeEra cardanoMaxSupply shelleyOptions + cardanoTestnet testnetOptions conf shelleyGenesis alonzoGenesis Defaults.defaultConwayGenesis + where + CardanoTestnetOptions{cardanoNodeEra, cardanoMaxSupply} = testnetOptions -- | An 'AlonzoGenesis' value that is fit to pass to 'cardanoTestnet' getDefaultAlonzoGenesis :: () @@ -117,12 +119,14 @@ getDefaultShelleyGenesis :: () => HasCallStack => MonadIO m => MonadTest m - => CardanoTestnetOptions - -> m (UTCTime, ShelleyGenesis StandardCrypto) -getDefaultShelleyGenesis opts = do + => AnyShelleyBasedEra + -> Word64 -- ^ The max supply + -> ShelleyTestnetOptions + -> m (ShelleyGenesis StandardCrypto) +getDefaultShelleyGenesis asbe maxSupply opts = do currentTime <- H.noteShowIO DTC.getCurrentTime startTime <- H.noteShow $ DTC.addUTCTime startTimeOffsetSeconds currentTime - return (startTime, Defaults.defaultShelleyGenesis startTime opts) + return $ Defaults.defaultShelleyGenesis asbe startTime maxSupply opts -- | Setup a number of credentials and pools, like this: -- @@ -174,37 +178,26 @@ getDefaultShelleyGenesis opts = do -- >    └── utxo.{addr,skey,vkey} cardanoTestnet :: () => HasCallStack - => CardanoTestnetOptions -- ^ The options to use. Must be consistent with the genesis files. + => CardanoTestnetOptions -- ^ The options to use -> Conf - -> UTCTime -- ^ The starting time. Must be the same as the one in the shelley genesis. -> ShelleyGenesis StandardCrypto -- ^ The shelley genesis to use, for example 'getDefaultShelleyGenesis' from this module. -- Some fields are overridden by the accompanying 'CardanoTestnetOptions'. -> AlonzoGenesis -- ^ The alonzo genesis to use, for example 'getDefaultAlonzoGenesis' from this module. -> ConwayGenesis StandardCrypto -- ^ The conway genesis to use, for example 'Defaults.defaultConwayGenesis'. -> H.Integration TestnetRuntime cardanoTestnet - testnetOptions Conf {tempAbsPath=TmpAbsolutePath tmpAbsPath} startTime + testnetOptions Conf {tempAbsPath=TmpAbsolutePath tmpAbsPath} shelleyGenesis alonzoGenesis conwayGenesis = do - let shelleyStartTime = sgSystemStart shelleyGenesis - shelleyTestnetMagic = sgNetworkMagic shelleyGenesis - optionsMagic :: Word32 = fromIntegral $ cardanoTestnetMagic testnetOptions - testnetMagic = cardanoTestnetMagic testnetOptions + let (CardanoTestnetOptions _cardanoNodes asbe maxSupply _p2p nodeLoggingFormat _numDReps newEpochStateLogging) = testnetOptions + startTime = sgSystemStart shelleyGenesis + testnetMagic = fromIntegral $ sgNetworkMagic shelleyGenesis numPoolNodes = length $ cardanoNodes testnetOptions nPools = numPools testnetOptions nDReps = numDReps testnetOptions - maxSupply = cardanoMaxSupply testnetOptions - asbe = cardanoNodeEra testnetOptions AnyShelleyBasedEra sbe <- pure asbe - -- Sanity checks - testnetMinimumConfigurationRequirements testnetOptions - when (shelleyStartTime /= startTime) $ do - H.note_ $ "Expected same system start in shelley genesis and parameter, but got " <> show shelleyStartTime <> " and " <> show startTime - H.failure - when (shelleyTestnetMagic /= optionsMagic) $ do - H.note_ $ "Expected same network magic in shelley genesis and parameter, but got " <> show shelleyTestnetMagic <> " and " <> show optionsMagic - H.failure - -- Done with sanity checks + -- Sanity check + testnetMinimumConfigurationRequirements nPools H.note_ OS.os @@ -359,7 +352,7 @@ cardanoTestnet now <- H.noteShowIO DTC.getCurrentTime deadline <- H.noteShow $ DTC.addUTCTime 45 now forM_ (map (nodeStdout . poolRuntime) poolNodes) $ \nodeStdoutFile -> do - assertChainExtended deadline (cardanoNodeLoggingFormat testnetOptions) nodeStdoutFile + assertChainExtended deadline nodeLoggingFormat nodeStdoutFile H.noteShowIO_ DTC.getCurrentTime @@ -395,9 +388,9 @@ cardanoTestnet stakePoolsFp <- H.note $ tmpAbsPath "current-stake-pools.json" - assertExpectedSposInLedgerState stakePoolsFp testnetOptions execConfig + assertExpectedSposInLedgerState stakePoolsFp nPools execConfig - when (cardanoEnableNewEpochStateLogging testnetOptions) $ + when newEpochStateLogging $ TR.startLedgerNewEpochStateLogging runtime tempBaseAbsPath pure runtime diff --git a/cardano-testnet/src/Testnet/Start/Types.hs b/cardano-testnet/src/Testnet/Start/Types.hs index 173a69ee02b..7ab6af6a5e7 100644 --- a/cardano-testnet/src/Testnet/Start/Types.hs +++ b/cardano-testnet/src/Testnet/Start/Types.hs @@ -3,8 +3,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Testnet.Start.Types - ( CardanoTestnetOptions(..) - , cardanoDefaultTestnetOptions + ( CardanoTestnetCliOptions(..) + , CardanoTestnetOptions(..) , anyEraToString , anyShelleyBasedEraToString @@ -13,6 +13,7 @@ module Testnet.Start.Types , TestnetNodeOptions(..) , extraSpoNodeCliArgs , cardanoDefaultTestnetNodeOptions + , ShelleyTestnetOptions(..) , NodeLoggingFormat(..) , Conf(..) @@ -25,6 +26,7 @@ import Cardano.Api hiding (cardanoEra) import Prelude import Data.Char (toLower) +import Data.Default.Class import Data.Word import GHC.Stack import System.FilePath (addTrailingPathSeparator) @@ -34,37 +36,61 @@ import Testnet.Filepath import Hedgehog (MonadTest) import qualified Hedgehog.Extras as H +-- | Command line options for the @cardano-testnet@ executable. They are used +-- in the parser, and then get split into 'CardanoTestnetOptions' and +-- 'ShelleyTestnetOptions' +data CardanoTestnetCliOptions = CardanoTestnetCliOptions + { cliTestnetOptions :: CardanoTestnetOptions + , cliShelleyOptions :: ShelleyTestnetOptions + } deriving (Eq, Show) + +instance Default CardanoTestnetCliOptions where + def = CardanoTestnetCliOptions + { cliTestnetOptions = def + , cliShelleyOptions = def + } +-- | Options which, contrary to 'ShelleyTestnetOptions' are not implemented +-- by tuning the genesis files. data CardanoTestnetOptions = CardanoTestnetOptions { -- | List of node options. Each option will result in a single node being -- created. cardanoNodes :: [TestnetNodeOptions] , cardanoNodeEra :: AnyShelleyBasedEra -- ^ The era to start at - , cardanoEpochLength :: Int -- ^ An epoch's duration, in number of slots - , cardanoSlotLength :: Double -- ^ Slot length, in seconds - , cardanoTestnetMagic :: Int - , cardanoActiveSlotsCoeff :: Double , cardanoMaxSupply :: Word64 -- ^ The amount of Lovelace you are starting your testnet with (forwarded to shelley genesis) + -- TODO move me to ShelleyTestnetOptions when https://github.com/IntersectMBO/cardano-cli/pull/874 makes it to cardano-node , cardanoEnableP2P :: Bool , cardanoNodeLoggingFormat :: NodeLoggingFormat , cardanoNumDReps :: Int -- ^ The number of DReps to generate at creation , cardanoEnableNewEpochStateLogging :: Bool -- ^ if epoch state logging is enabled } deriving (Eq, Show) -cardanoDefaultTestnetOptions :: CardanoTestnetOptions -cardanoDefaultTestnetOptions = CardanoTestnetOptions - { cardanoNodes = cardanoDefaultTestnetNodeOptions - , cardanoNodeEra = AnyShelleyBasedEra ShelleyBasedEraBabbage - , cardanoEpochLength = 500 - , cardanoSlotLength = 0.1 - , cardanoTestnetMagic = 42 - , cardanoActiveSlotsCoeff = 0.05 - , cardanoMaxSupply = 100_000_020_000_000 -- 100 000 billions Lovelace, so 100 millions ADA. This amount should be bigger than the 'byronTotalBalance' in Testnet.Start.Byron - , cardanoEnableP2P = False - , cardanoNodeLoggingFormat = NodeLoggingFormatAsJson - , cardanoNumDReps = 3 - , cardanoEnableNewEpochStateLogging = True - } +instance Default CardanoTestnetOptions where + def = CardanoTestnetOptions + { cardanoNodes = cardanoDefaultTestnetNodeOptions + , cardanoNodeEra = AnyShelleyBasedEra ShelleyBasedEraBabbage + , cardanoMaxSupply = 100_000_020_000_000 -- 100 000 billions Lovelace, so 100 millions ADA. This amount should be bigger than the 'byronTotalBalance' in Testnet.Start.Byron + , cardanoEnableP2P = False + , cardanoNodeLoggingFormat = NodeLoggingFormatAsJson + , cardanoNumDReps = 3 + , cardanoEnableNewEpochStateLogging = True + } + +-- | Options that are implemented by writing fields in the Shelley genesis file. +data ShelleyTestnetOptions = ShelleyTestnetOptions + { shelleyTestnetMagic :: Int -- TODO Use the NetworkMagic type from API + , shelleyEpochLength :: Int -- ^ An epoch's duration, in number of slots + , shelleySlotLength :: Double -- ^ Slot length, in seconds + , shelleyActiveSlotsCoeff :: Double + } deriving (Eq, Show) + +instance Default ShelleyTestnetOptions where + def = ShelleyTestnetOptions + { shelleyTestnetMagic = 42 + , shelleyEpochLength = 500 + , shelleySlotLength = 0.1 + , shelleyActiveSlotsCoeff = 0.05 + } -- | Specify a BFT node (Pre-Babbage era only) or an SPO (Shelley era onwards only) data TestnetNodeOptions diff --git a/cardano-testnet/test/cardano-testnet-golden/files/golden/help.cli b/cardano-testnet/test/cardano-testnet-golden/files/golden/help.cli index a1260b83330..a3432216cfa 100644 --- a/cardano-testnet/test/cardano-testnet-golden/files/golden/help.cli +++ b/cardano-testnet/test/cardano-testnet-golden/files/golden/help.cli @@ -8,15 +8,15 @@ Usage: cardano-testnet cardano [--num-pool-nodes COUNT] | --babbage-era | --conway-era ] - [--epoch-length SLOTS] - [--slot-length SECONDS] - --testnet-magic INT - [--active-slots-coeff DOUBLE] [--max-lovelace-supply WORD64] [--enable-p2p BOOL] [--nodeLoggingFormat LOGGING_FORMAT] [--num-dreps NUMBER] [--enable-new-epoch-state-logging] + --testnet-magic INT + [--epoch-length SLOTS] + [--slot-length SECONDS] + [--active-slots-coeff DOUBLE] Start a testnet in any era 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 98eb490d148..16698b98a4c 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 @@ -6,15 +6,15 @@ Usage: cardano-testnet cardano [--num-pool-nodes COUNT] | --babbage-era | --conway-era ] - [--epoch-length SLOTS] - [--slot-length SECONDS] - --testnet-magic INT - [--active-slots-coeff DOUBLE] [--max-lovelace-supply WORD64] [--enable-p2p BOOL] [--nodeLoggingFormat LOGGING_FORMAT] [--num-dreps NUMBER] [--enable-new-epoch-state-logging] + --testnet-magic INT + [--epoch-length SLOTS] + [--slot-length SECONDS] + [--active-slots-coeff DOUBLE] Start a testnet in any era @@ -28,11 +28,6 @@ Available options: --alonzo-era Specify the Alonzo era --babbage-era Specify the Babbage era (default) --conway-era Specify the Conway era - --epoch-length SLOTS Epoch length, in number of slots (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: 5.0e-2) --max-lovelace-supply WORD64 Max lovelace supply that your testnet starts with. (default: 100000020000000) @@ -45,4 +40,9 @@ Available options: --enable-new-epoch-state-logging Enable new epoch state logging to logs/ledger-epoch-state.log + --testnet-magic INT Specify a testnet magic id. + --epoch-length SLOTS Epoch length, in number of slots (default: 500) + --slot-length SECONDS Slot length (default: 0.1) + --active-slots-coeff DOUBLE + Active slots co-efficient (default: 5.0e-2) -h,--help Show this help text 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 cd3e8b6209c..14f771e951b 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 @@ -25,6 +25,7 @@ import Control.Monad (void) import qualified Data.Aeson as Aeson import qualified Data.Aeson as J import qualified Data.Aeson.Types as J +import Data.Default.Class import Data.List ((\\)) import qualified Data.List as L import qualified Data.Map.Strict as Map @@ -59,17 +60,16 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "babbage-leadership-sched H.note_ SYS.os conf@Conf { tempAbsPath=tempAbsPath@(TmpAbsolutePath work) } <- mkConf tempAbsBasePath' let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath - sbe = shelleyBasedEra @BabbageEra - cTestnetOptions = cardanoDefaultTestnetOptions - { cardanoNodeEra = AnyShelleyBasedEra sbe -- TODO: We should only support the latest era and the upcoming era - } + sbe = shelleyBasedEra @BabbageEra -- TODO: We should only support the latest era and the upcoming era + asbe = AnyShelleyBasedEra sbe + cTestnetOptions = def { cardanoNodeEra = asbe } tr@TestnetRuntime { testnetMagic , wallets=wallet0:_ , configurationFile , poolNodes - } <- cardanoTestnetDefault cTestnetOptions conf + } <- cardanoTestnetDefault cTestnetOptions def conf node1sprocket <- H.headM $ poolSprockets tr execConfig <- mkExecConfig tempBaseAbsPath node1sprocket testnetMagic @@ -90,11 +90,11 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "babbage-leadership-sched let node1SocketPath = Api.File $ IO.sprocketSystemName node1sprocket termEpoch = EpochNo 15 (stakePoolIdNewSpo, stakePoolColdSigningKey, stakePoolColdVKey, vrfSkey, _) - <- registerSingleSpo 1 tempAbsPath + <- registerSingleSpo asbe 1 tempAbsPath configurationFile node1SocketPath (EpochNo 10) - cTestnetOptions + testnetMagic execConfig (txin1, utxoSKeyFile, utxoAddr) 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 7dfd0273842..ec2667c24ba 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 @@ -17,6 +17,7 @@ import Prelude import Control.Monad import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as KM +import Data.Default.Class import qualified System.Info as SYS import Testnet.Process.Run (execCliStdoutToJson, mkExecConfig) @@ -40,7 +41,7 @@ hprop_stakeSnapshot = integrationRetryWorkspace 2 "babbage-stake-snapshot" $ \te { testnetMagic , poolNodes , configurationFile - } <- cardanoTestnetDefault cardanoDefaultTestnetOptions conf + } <- cardanoTestnetDefault def def conf poolNode1 <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1 diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs index 667af8c7995..896a5510851 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs @@ -22,6 +22,7 @@ import Prelude import Control.Monad (void) import qualified Data.List as List +import Data.Default.Class import qualified Data.Map as Map import qualified Data.Text as Text import Lens.Micro @@ -47,19 +48,17 @@ hprop_transaction = integrationRetryWorkspace 0 "babbage-transaction" $ \tempAbs work <- H.createDirectoryIfMissing $ tempAbsPath' "work" let - sbe = ShelleyBasedEraBabbage + sbe = ShelleyBasedEraBabbage -- TODO: We should only support the latest era and the upcoming era era = toCardanoEra sbe cEra = AnyCardanoEra era tempBaseAbsPath = makeTmpBaseAbsPath $ TmpAbsolutePath tempAbsPath' - options = cardanoDefaultTestnetOptions - { cardanoNodeEra = AnyShelleyBasedEra sbe -- TODO: We should only support the latest era and the upcoming era - } + options = def { cardanoNodeEra = AnyShelleyBasedEra sbe } TestnetRuntime { testnetMagic , poolNodes , wallets=wallet0:_ - } <- cardanoTestnetDefault options conf + } <- cardanoTestnetDefault options def conf poolNode1 <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1 diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs index 1d055d361c9..dff51f99e39 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs @@ -17,6 +17,7 @@ import Cardano.Testnet import Prelude import Control.Monad (void) +import Data.Default.Class import qualified Data.Text as Text import System.FilePath (()) import qualified System.Info as SYS @@ -50,19 +51,17 @@ hprop_plutus_v3 = integrationWorkspace "all-plutus-script-purposes" $ \tempAbsBa let tempBaseAbsPath = makeTmpBaseAbsPath $ TmpAbsolutePath tempAbsPath' - sbe = ShelleyBasedEraConway + sbe = ShelleyBasedEraConway -- TODO: We should only support the latest era and the upcoming era era = toCardanoEra sbe anyEra = AnyCardanoEra era - options = cardanoDefaultTestnetOptions - { cardanoNodeEra = AnyShelleyBasedEra sbe -- TODO: We should only support the latest era and the upcoming era - } + options = def { cardanoNodeEra = AnyShelleyBasedEra sbe } TestnetRuntime { configurationFile , testnetMagic , poolNodes , wallets=wallet0:wallet1:_ - } <- cardanoTestnetDefault options conf + } <- cardanoTestnetDefault options def conf PoolNode{poolRuntime} <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime 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 ffd28a6f02c..6d319cbd72d 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 @@ -16,6 +16,7 @@ import Prelude import Control.Monad import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as KM +import Data.Default.Class import qualified System.Info as SYS import Testnet.Process.Run (execCliStdoutToJson, mkExecConfig) @@ -39,7 +40,7 @@ hprop_stakeSnapshot = integrationRetryWorkspace 2 "conway-stake-snapshot" $ \tem { testnetMagic , poolNodes , configurationFile - } <- cardanoTestnetDefault cardanoDefaultTestnetOptions conf + } <- cardanoTestnetDefault def def conf poolNode1 <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1 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 00b32ee2837..a1ebb99f318 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 @@ -23,6 +23,7 @@ import Prelude import Control.Monad import qualified Data.Aeson as Aeson import qualified Data.Aeson as J +import Data.Default.Class import Data.Function import qualified Data.Map.Strict as Map import qualified Data.Text as Text @@ -56,18 +57,17 @@ hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbs <- mkConf tempAbsBasePath' let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath - sbe = ShelleyBasedEraBabbage + sbe = ShelleyBasedEraBabbage -- TODO: We should only support the latest era and the upcoming era + asbe = AnyShelleyBasedEra sbe eraString = eraToString sbe - cTestnetOptions = cardanoDefaultTestnetOptions - { cardanoNodeEra = AnyShelleyBasedEra sbe -- TODO: We should only support the latest era and the upcoming era - } + cTestnetOptions = def { cardanoNodeEra = asbe } runTime@TestnetRuntime { configurationFile , testnetMagic , wallets=wallet0:_ , poolNodes - } <- cardanoTestnetDefault cTestnetOptions conf + } <- cardanoTestnetDefault cTestnetOptions def conf node1sprocket <- H.headM $ poolSprockets runTime execConfig <- mkExecConfig tempBaseAbsPath node1sprocket testnetMagic @@ -88,11 +88,11 @@ hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbs let node1SocketPath = Api.File $ IO.sprocketSystemName node1sprocket termEpoch = EpochNo 3 (stakePoolId, stakePoolColdSigningKey, stakePoolColdVKey, _, _) - <- registerSingleSpo 1 tempAbsPath + <- registerSingleSpo asbe 1 tempAbsPath configurationFile node1SocketPath termEpoch - cTestnetOptions + testnetMagic execConfig (txin1, utxoSKeyFile, utxoAddr) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index 1ad6d8e4a11..004af280859 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -45,6 +45,7 @@ import qualified Data.Aeson.Lens as Aeson import Data.Bifunctor (bimap) import qualified Data.ByteString.Lazy as LBS import Data.Data (type (:~:) (Refl)) +import Data.Default.Class import qualified Data.Map as Map import Data.String (IsString (fromString)) import Data.Text (Text) @@ -69,6 +70,7 @@ import Testnet.Process.Cli.Transaction (TxOutAddress (ReferenceScriptA import Testnet.Process.Run (execCli', execCliStdoutToJson, mkExecConfig) import Testnet.Property.Assert (assertErasEqual) import Testnet.Property.Util (integrationWorkspace) +import Testnet.Start.Types (ShelleyTestnetOptions(..)) import Testnet.TestQueryCmds (TestQueryCmds (..), forallQueryCommands) import Testnet.Types @@ -90,16 +92,16 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath let sbe = ShelleyBasedEraConway + asbe = AnyShelleyBasedEra sbe era = toCardanoEra sbe cEra = AnyCardanoEra era eraName = eraToString era - fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 100 - , cardanoSlotLength = 0.1 - , cardanoNodeEra = AnyShelleyBasedEra sbe + fastTestnetOptions = def { cardanoNodeEra = asbe } + shelleyOptions = def + { shelleyEpochLength = 100 -- We change slotCoeff because epochLength must be equal to: -- securityParam * 10 / slotCoeff - , cardanoActiveSlotsCoeff = 0.5 + , shelleyActiveSlotsCoeff = 0.5 } TestnetRuntime @@ -108,7 +110,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. , configurationFile , wallets=wallet0:wallet1:_ } - <- cardanoTestnetDefault fastTestnetOptions conf + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf let shelleyGeneisFile = work Defaults.defaultGenesisFilepath ShelleyEra 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 25257229c1a..cdc30d965db 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 @@ -18,6 +18,7 @@ import Cardano.Testnet import Prelude +import Data.Default.Class import Data.Either import qualified Data.Time.Clock as DT import qualified Data.Time.Format as DT @@ -44,7 +45,7 @@ hprop_querySlotNumber = integrationRetryWorkspace 2 "query-slot-number" $ \tempA tr@TestnetRuntime { testnetMagic , poolNodes - } <- cardanoTestnetDefault cardanoDefaultTestnetOptions conf + } <- cardanoTestnetDefault def def conf ShelleyGenesis{sgSlotLength, sgEpochLength} <- H.noteShowM $ shelleyGenesis tr startTime <- H.noteShowM $ getStartTime tempAbsBasePath' tr diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldEpochState.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldEpochState.hs index ae2a5235026..55e68125a83 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldEpochState.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldEpochState.hs @@ -12,6 +12,7 @@ import Prelude import Control.Concurrent.Async () import Control.Monad.Trans.State.Strict +import Data.Default.Class import qualified System.Directory as IO import System.FilePath (()) @@ -29,11 +30,9 @@ prop_foldEpochState = integrationWorkspace "foldEpochState" $ \tempAbsBasePath' let tempAbsPath' = unTmpAbsPath $ tempAbsPath conf sbe = ShelleyBasedEraBabbage - options = cardanoDefaultTestnetOptions - { cardanoNodeEra = AnyShelleyBasedEra sbe - } + options = def { cardanoNodeEra = AnyShelleyBasedEra sbe } - runtime@TestnetRuntime{configurationFile} <- cardanoTestnetDefault options conf + runtime@TestnetRuntime{configurationFile} <- cardanoTestnetDefault options def conf socketPathAbs <- do socketPath' <- H.sprocketArgumentName <$> H.headM (poolSprockets runtime) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs index 2875b5e6415..d7606eee2e7 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs @@ -23,6 +23,7 @@ import Prelude import Control.Monad import qualified Data.Char as C +import Data.Default.Class import qualified Data.Map as Map import Data.Maybe.Strict import Data.Set (Set) @@ -44,6 +45,7 @@ import Testnet.Process.Cli.Transaction import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationWorkspace) import Testnet.Types +import Testnet.Start.Types (ShelleyTestnetOptions(..)) import Hedgehog import qualified Hedgehog.Extras as H @@ -71,11 +73,11 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co era = toCardanoEra sbe cEra = AnyCardanoEra era eraName = eraToString era - fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 200 - , cardanoNodeEra = AnyShelleyBasedEra sbe + fastTestnetOptions = def + { cardanoNodeEra = AnyShelleyBasedEra sbe , cardanoNumDReps = nDrepVotes } + shelleyOptions = def { shelleyEpochLength = 200 } TestnetRuntime { testnetMagic @@ -83,7 +85,7 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co , wallets=wallet0:_ , configurationFile } - <- cardanoTestnetDefault fastTestnetOptions conf + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf PoolNode{poolRuntime, poolKeys} <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs index d0f278883d7..0165e91da5c 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs @@ -22,6 +22,7 @@ import Prelude import Control.Monad import Control.Monad.Catch (MonadCatch) import Data.Data (Typeable) +import Data.Default.Class import qualified Data.Map as Map import Data.Word (Word16) import GHC.Stack (HasCallStack, withFrozenCallStack) @@ -34,6 +35,7 @@ import Testnet.Process.Cli.Transaction import Testnet.Process.Run (mkExecConfig) import Testnet.Property.Util (integrationWorkspace) import Testnet.Types +import Testnet.Start.Types import Hedgehog (MonadTest, Property, annotateShow) import qualified Hedgehog.Extras as H @@ -53,11 +55,11 @@ hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBaseP -- Create default testnet with 3 DReps and 3 stake holders delegated, one to each DRep. let ceo = ConwayEraOnwardsConway sbe = conwayEraOnwardsToShelleyBasedEra ceo - fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 200 - , cardanoNodeEra = AnyShelleyBasedEra sbe + fastTestnetOptions = def + { cardanoNodeEra = AnyShelleyBasedEra sbe , cardanoNumDReps = 1 } + shelleyOptions = def { shelleyEpochLength = 200 } TestnetRuntime { testnetMagic @@ -65,7 +67,7 @@ hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBaseP , wallets=wallet0:wallet1:wallet2:_ , configurationFile } - <- cardanoTestnetDefault fastTestnetOptions conf + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf PoolNode{poolRuntime} <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs index 092daec8738..135025c792b 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs @@ -12,6 +12,7 @@ import Cardano.Testnet import Prelude import Control.Monad (void) +import Data.Default.Class import qualified Data.Map as Map import System.FilePath (()) @@ -21,6 +22,7 @@ import Testnet.Process.Cli.Transaction import Testnet.Process.Run (mkExecConfig) import Testnet.Property.Util (integrationWorkspace) import Testnet.Types +import Testnet.Start.Types import Hedgehog (Property) import qualified Hedgehog.Extras as H @@ -42,11 +44,11 @@ hprop_ledger_events_drep_deposits = integrationWorkspace "drep-deposits" $ \temp sbe = conwayEraOnwardsToShelleyBasedEra ceo era = toCardanoEra sbe cEra = AnyCardanoEra era - fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 100 - , cardanoNodeEra = AnyShelleyBasedEra sbe + fastTestnetOptions = def + { cardanoNodeEra = AnyShelleyBasedEra sbe , cardanoNumDReps = 0 } + shelleyOptions = def { shelleyEpochLength = 100 } TestnetRuntime { testnetMagic @@ -54,7 +56,7 @@ hprop_ledger_events_drep_deposits = integrationWorkspace "drep-deposits" $ \temp , wallets=wallet0:wallet1:_ , configurationFile } - <- cardanoTestnetDefault fastTestnetOptions conf + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf PoolNode{poolRuntime} <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepRetirement.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepRetirement.hs index 8b5cec7c68d..52756141539 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepRetirement.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepRetirement.hs @@ -16,6 +16,7 @@ import Cardano.Testnet import Prelude +import Data.Default.Class import qualified Data.Text as Text import System.FilePath (()) @@ -24,6 +25,7 @@ import Testnet.Defaults import Testnet.Process.Cli.Keys import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) +import Testnet.Start.Types import Testnet.Types import Hedgehog @@ -46,11 +48,8 @@ hprop_drep_retirement = integrationRetryWorkspace 2 "drep-retirement" $ \tempAbs work <- H.createDirectoryIfMissing $ tempAbsPath' "work" let cardanoNodeEra = AnyShelleyBasedEra sbe - fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 50 -- 50 * (1/10s) length, i.e. 5 seconds - , cardanoSlotLength = 0.1 -- 1/10s slot (100ms) - , cardanoNodeEra - } + fastTestnetOptions = def { cardanoNodeEra } + shelleyOptions = def { shelleyEpochLength = 50 } -- 50 * (1/10s) length, i.e. 5 seconds TestnetRuntime { testnetMagic @@ -58,7 +57,7 @@ hprop_drep_retirement = integrationRetryWorkspace 2 "drep-retirement" $ \tempAbs , wallets=wallet0:_ , configurationFile } - <- cardanoTestnetDefault fastTestnetOptions conf + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf PoolNode{poolRuntime} <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs index 350b2f8abfe..31f170d5b67 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs @@ -16,6 +16,7 @@ import Cardano.Testnet import Prelude import Control.Monad (void) +import Data.Default.Class import Data.String (fromString) import System.FilePath (()) @@ -23,6 +24,7 @@ import Testnet.Components.Query import Testnet.Process.Cli.DRep (makeActivityChangeProposal) import Testnet.Process.Run (mkExecConfig) import Testnet.Property.Util (integrationWorkspace) +import Testnet.Start.Types import Testnet.Types import Hedgehog (Property) @@ -45,10 +47,9 @@ hprop_check_gov_action_timeout = integrationWorkspace "gov-action-timeout" $ \te -- Create default testnet let ceo = ConwayEraOnwardsConway sbe = conwayEraOnwardsToShelleyBasedEra ceo - fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 200 - , cardanoNodeEra = AnyShelleyBasedEra sbe - } + asbe = AnyShelleyBasedEra sbe + fastTestnetOptions = def { cardanoNodeEra = asbe } + shelleyOptions = def { shelleyEpochLength = 200 } TestnetRuntime { testnetMagic @@ -56,7 +57,7 @@ hprop_check_gov_action_timeout = integrationWorkspace "gov-action-timeout" $ \te , wallets=wallet0:_ , configurationFile } - <- cardanoTestnetDefault fastTestnetOptions conf + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf PoolNode{poolRuntime} <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs index 2f9fcc28ac6..878e2462942 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs @@ -24,6 +24,7 @@ import Prelude import Control.Monad import Data.Bifunctor (first) +import Data.Default.Class import Data.Foldable import qualified Data.Map.Strict as Map import Data.String @@ -37,6 +38,7 @@ import Testnet.Defaults import Testnet.Process.Cli.Keys import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) +import Testnet.Start.Types import Testnet.Types import Hedgehog @@ -56,10 +58,9 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 0 "info-hash" $ \tem let ceo = ConwayEraOnwardsConway sbe = conwayEraOnwardsToShelleyBasedEra ceo - fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 200 - , cardanoNodeEra = AnyShelleyBasedEra sbe - } + asbe = AnyShelleyBasedEra sbe + fastTestnetOptions = def { cardanoNodeEra = asbe } + shelleyOptions = def { shelleyEpochLength = 200 } TestnetRuntime { testnetMagic @@ -67,7 +68,7 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 0 "info-hash" $ \tem , wallets=wallet0:wallet1:_ , configurationFile } - <- cardanoTestnetDefault fastTestnetOptions conf + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf PoolNode{poolRuntime} <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs index 295bff66dee..bef0d348237 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs @@ -22,6 +22,7 @@ import Prelude import Control.Monad import qualified Data.ByteString.Char8 as BSC +import Data.Default.Class import qualified Data.Map.Strict as Map import Data.Maybe.Strict import Data.String @@ -40,6 +41,7 @@ import qualified Testnet.Process.Cli.SPO as SPO import Testnet.Process.Cli.Transaction import qualified Testnet.Process.Run as H import Testnet.Property.Util (integrationWorkspace) +import Testnet.Start.Types import Testnet.Types import Hedgehog @@ -60,15 +62,14 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat work <- H.createDirectoryIfMissing $ tempAbsPath' "work" - let ceo = ConwayEraOnwardsConway sbe = conwayEraOnwardsToShelleyBasedEra ceo + asbe = AnyShelleyBasedEra sbe era = toCardanoEra sbe cEra = AnyCardanoEra era - fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 200 - , cardanoNodeEra = AnyShelleyBasedEra sbe - } + fastTestnetOptions = def { cardanoNodeEra = asbe } + shelleyOptions = def { shelleyEpochLength = 200 } + execConfigOffline <- H.mkExecConfigOffline tempBaseAbsPath -- Step 1. Define generate and define a committee in the genesis file @@ -103,7 +104,11 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat committee = L.Committee (Map.fromList [(comKeyCred1, EpochNo 100)]) committeeThreshold alonzoGenesis <- getDefaultAlonzoGenesis sbe - (startTime, shelleyGenesis') <- getDefaultShelleyGenesis fastTestnetOptions + shelleyGenesis' <- + getDefaultShelleyGenesis + asbe + (cardanoMaxSupply fastTestnetOptions) + shelleyOptions let conwayGenesisWithCommittee = defaultConwayGenesis { L.cgCommittee = committee } @@ -114,7 +119,7 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat , configurationFile } <- cardanoTestnet fastTestnetOptions - conf startTime shelleyGenesis' + conf shelleyGenesis' alonzoGenesis conwayGenesisWithCommittee poolNode1 <- H.headM poolNodes diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs index f3f066124ab..6113c47ba59 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs @@ -16,6 +16,7 @@ import Cardano.Testnet import Prelude import Control.Monad.Catch (MonadCatch) +import Data.Default.Class import Data.Typeable (Typeable) import Data.Word (Word16) import System.FilePath (()) @@ -27,6 +28,7 @@ import qualified Testnet.Process.Cli.SPO as SPO import Testnet.Process.Cli.Transaction (failToSubmitTx, signTx) import Testnet.Process.Run (mkExecConfig) import Testnet.Property.Util (integrationWorkspace) +import Testnet.Start.Types import Testnet.Types import Hedgehog (Property, annotateShow) @@ -50,10 +52,9 @@ hprop_check_pparam_fails_spo = integrationWorkspace "test-pparam-spo" $ \tempAbs -- Create default testnet let ceo = ConwayEraOnwardsConway sbe = conwayEraOnwardsToShelleyBasedEra ceo - fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 200 - , cardanoNodeEra = AnyShelleyBasedEra sbe - } + asbe = AnyShelleyBasedEra sbe + fastTestnetOptions = def { cardanoNodeEra = asbe } + shelleyOptions = def { shelleyEpochLength = 200 } TestnetRuntime { testnetMagic @@ -61,7 +62,7 @@ hprop_check_pparam_fails_spo = integrationWorkspace "test-pparam-spo" $ \tempAbs , wallets=wallet0:wallet1:_wallet2:_ , configurationFile } - <- cardanoTestnetDefault fastTestnetOptions conf + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf PoolNode{poolRuntime} <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs index 1dc5b18b3be..3f0e6ee8c07 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs @@ -24,6 +24,7 @@ import Prelude import Control.Monad import Control.Monad.Catch (MonadCatch) import Data.Data (Typeable) +import Data.Default.Class import Data.String (fromString) import qualified Data.Text as Text import Data.Word (Word16) @@ -31,7 +32,6 @@ import GHC.Stack (HasCallStack) import Lens.Micro ((^.)) import System.FilePath (()) -import Testnet.Components.Configuration (anyEraToString) import Testnet.Components.Query import Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair) import Testnet.Process.Cli.DRep (createCertificatePublicationTxBody, createVotingTxBody, @@ -40,6 +40,7 @@ import qualified Testnet.Process.Cli.Keys as P import Testnet.Process.Cli.Transaction (retrieveTransactionId, signTx, submitTx) import qualified Testnet.Process.Run as H import qualified Testnet.Property.Util as H +import Testnet.Start.Types import Testnet.Types (KeyPair (..), PaymentKeyInfo (paymentKeyInfoAddr, paymentKeyInfoPair), PoolNode (..), SomeKeyPair (SomeKeyPair), StakingKey, TestnetRuntime (..), nodeSocketPath) @@ -74,11 +75,11 @@ hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \ -- Create default testnet with 3 DReps and 3 stake holders delegated, one to each DRep. let ceo = ConwayEraOnwardsConway sbe = conwayEraOnwardsToShelleyBasedEra ceo - fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 200 - , cardanoNodeEra = AnyShelleyBasedEra sbe + fastTestnetOptions = def + { cardanoNodeEra = AnyShelleyBasedEra sbe , cardanoNumDReps = 3 } + shelleyOptions = def { shelleyEpochLength = 200 } TestnetRuntime { testnetMagic @@ -86,7 +87,7 @@ hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \ , wallets=wallet0:wallet1:wallet2:_ , configurationFile } - <- cardanoTestnetDefault fastTestnetOptions conf + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf PoolNode{poolRuntime} <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs index 93aff8bb7fe..b004e3e277d 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs @@ -22,6 +22,7 @@ import Prelude import Control.Monad import Control.Monad.State.Strict (StateT) +import Data.Default.Class import Data.Maybe import Data.Maybe.Strict import Data.String @@ -39,6 +40,7 @@ import Testnet.Process.Cli.Keys import Testnet.Process.Cli.Transaction import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationWorkspace) +import Testnet.Start.Types import Testnet.Types import Hedgehog @@ -68,11 +70,11 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new sbe = conwayEraOnwardsToShelleyBasedEra ceo era = toCardanoEra sbe cEra = AnyCardanoEra era - fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 200 - , cardanoNodeEra = AnyShelleyBasedEra sbe + fastTestnetOptions = def + { cardanoNodeEra = AnyShelleyBasedEra sbe , cardanoNumDReps = numVotes } + shelleyOptions = def { shelleyEpochLength = 200 } TestnetRuntime { testnetMagic @@ -80,7 +82,7 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new , wallets=wallet0:wallet1:_ , configurationFile } - <- cardanoTestnetDefault fastTestnetOptions conf + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf PoolNode{poolRuntime} <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs index 78cdcfdfe82..98017652e5f 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs @@ -19,6 +19,7 @@ import Prelude import Control.Monad.Trans.State.Strict (put) import Data.Bifunctor (Bifunctor (..)) +import Data.Default.Class import qualified Data.Map.Strict as Map import qualified Data.Text as Text import GHC.Stack (HasCallStack) @@ -33,6 +34,7 @@ import qualified Testnet.Process.Cli.SPO as SPO import Testnet.Process.Cli.Transaction import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationWorkspace) +import Testnet.Start.Types import Testnet.Types import Hedgehog @@ -52,11 +54,8 @@ hprop_ledger_events_propose_new_constitution_spo = integrationWorkspace "propose sbe = conwayEraOnwardsToShelleyBasedEra ceo era = toCardanoEra sbe cEra = AnyCardanoEra era - fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 100 - , cardanoSlotLength = 0.1 - , cardanoNodeEra = AnyShelleyBasedEra sbe - } + fastTestnetOptions = def { cardanoNodeEra = AnyShelleyBasedEra sbe } + shelleyOptions = def { shelleyEpochLength = 100 } TestnetRuntime { testnetMagic @@ -64,7 +63,7 @@ hprop_ledger_events_propose_new_constitution_spo = integrationWorkspace "propose , wallets=wallet0:_ , configurationFile } - <- cardanoTestnetDefault fastTestnetOptions conf + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf PoolNode{poolRuntime} <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs index 8517cb7cf65..40becc66154 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs @@ -19,6 +19,7 @@ import Prelude import Control.Monad (unless, void) import Control.Monad.Catch (MonadCatch) +import Data.Default.Class import qualified Data.Text as Text import GHC.Stack (HasCallStack) import System.Exit @@ -27,6 +28,7 @@ import System.FilePath (()) import Testnet.Components.Query import Testnet.Process.Run (execCli', execCliAny, mkExecConfig) import Testnet.Property.Util (integrationWorkspace) +import Testnet.Start.Types import Testnet.Types import Hedgehog @@ -44,11 +46,8 @@ hprop_ledger_events_treasury_donation = integrationWorkspace "treasury-donation" let ceo = ConwayEraOnwardsConway sbe = conwayEraOnwardsToShelleyBasedEra ceo - fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 100 - , cardanoSlotLength = 0.1 - , cardanoNodeEra = AnyShelleyBasedEra sbe - } + fastTestnetOptions = def { cardanoNodeEra = AnyShelleyBasedEra sbe } + shelleyOptions = def { shelleyEpochLength = 100 } TestnetRuntime { testnetMagic @@ -56,7 +55,7 @@ hprop_ledger_events_treasury_donation = integrationWorkspace "treasury-donation" , wallets=wallet0:_ , configurationFile } - <- cardanoTestnetDefault fastTestnetOptions conf + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf PoolNode{poolRuntime} <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryGrowth.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryGrowth.hs index c8a21aabe82..e7f9e816041 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryGrowth.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryGrowth.hs @@ -15,6 +15,7 @@ import Cardano.Testnet as TN import Prelude import Control.Monad.Trans.State.Strict +import Data.Default.Class import Data.List (sortOn) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M @@ -24,7 +25,7 @@ import System.FilePath (()) import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) -import Testnet.Start.Types (eraToString) +import Testnet.Start.Types import Testnet.Types import qualified Hedgehog as H @@ -41,13 +42,12 @@ prop_check_if_treasury_is_growing = integrationRetryWorkspace 0 "growing-treasur let era = ConwayEra sbe = ShelleyBasedEraConway - options = cardanoDefaultTestnetOptions - { cardanoEpochLength = 100 - , cardanoNodeEra = AnyShelleyBasedEra sbe -- TODO: We should only support the latest era and the upcoming era - , cardanoActiveSlotsCoeff = 0.3 - } + options = def { cardanoNodeEra = AnyShelleyBasedEra sbe } -- TODO: We should only support the latest era and the upcoming era + shelleyOptions = def { shelleyEpochLength = 100 + , shelleyActiveSlotsCoeff = 0.3 + } - TestnetRuntime{testnetMagic, configurationFile, poolNodes} <- cardanoTestnetDefault options conf + TestnetRuntime{testnetMagic, configurationFile, poolNodes} <- cardanoTestnetDefault options shelleyOptions conf (execConfig, socketPathAbs) <- do PoolNode{poolRuntime} <- H.headM poolNodes diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs index 1c17d5f7d09..e1f24828e37 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs @@ -29,6 +29,7 @@ import Prelude import Control.Monad import Control.Monad.State.Class import Data.Bifunctor (Bifunctor (..)) +import Data.Default.Class import Data.Map (Map) import qualified Data.Map.Strict as M import qualified Data.Text as Text @@ -41,7 +42,7 @@ import Testnet.Defaults import Testnet.Process.Cli.Keys (cliStakeAddressKeyGen) import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) -import Testnet.Start.Types (eraToString) +import Testnet.Start.Types import Testnet.Types import Hedgehog @@ -60,11 +61,10 @@ hprop_ledger_events_treasury_withdrawal = integrationRetryWorkspace 1 "treasury era = toCardanoEra sbe eraName = eraToString era - fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 200 - , cardanoNodeEra = AnyShelleyBasedEra sbe - , cardanoActiveSlotsCoeff = 0.3 - } + fastTestnetOptions = def { cardanoNodeEra = AnyShelleyBasedEra sbe } + shelleyOptions = def { shelleyEpochLength = 200 + , shelleyActiveSlotsCoeff = 0.3 + } TestnetRuntime { testnetMagic @@ -72,7 +72,7 @@ hprop_ledger_events_treasury_withdrawal = integrationRetryWorkspace 1 "treasury , wallets=wallet0:wallet1:_ , configurationFile } - <- cardanoTestnetDefault fastTestnetOptions conf + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf PoolNode{poolRuntime} <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime 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 53a9d75dcfd..a3e41f0a0dc 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 @@ -21,6 +21,7 @@ import Control.Monad import Data.Aeson import Data.Aeson.Types import qualified Data.ByteString.Lazy.Char8 as LBS +import Data.Default.Class import Data.Either (isRight) import qualified Data.List as L import Data.Maybe @@ -39,6 +40,7 @@ import Testnet.Defaults import Testnet.Process.Run (execCli_, initiateProcess, procNode) import Testnet.Property.Util (integrationRetryWorkspace) import Testnet.Start.Byron +import Testnet.Start.Types import Testnet.Types import Hedgehog (Property, (===)) @@ -192,16 +194,18 @@ hprop_shutdownOnSlotSynced = integrationRetryWorkspace 2 "shutdown-on-slot-synce let maxSlot = 150 slotLen = 0.01 - let fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 300 - , cardanoSlotLength = slotLen - , cardanoNodes = + let fastTestnetOptions = def + { cardanoNodes = [ SpoTestnetNodeOptions Nothing ["--shutdown-on-slot-synced", show maxSlot] , SpoTestnetNodeOptions Nothing [] , SpoTestnetNodeOptions Nothing [] ] } - testnetRuntime <- cardanoTestnetDefault fastTestnetOptions conf + shelleyOptions = def + { shelleyEpochLength = 300 + , shelleySlotLength = slotLen + } + testnetRuntime <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf let allNodes' = poolNodes testnetRuntime H.note_ $ "All nodes: " <> show (map (nodeName . poolRuntime) allNodes') @@ -239,11 +243,10 @@ hprop_shutdownOnSigint = integrationRetryWorkspace 2 "shutdown-on-sigint" $ \tem -- TODO: Move yaml filepath specification into individual node options conf <- mkConf tempAbsBasePath' - let fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 300 - } + let fastTestnetOptions = def + shelleyOptions = def { shelleyEpochLength = 300 } testnetRuntime - <- cardanoTestnetDefault fastTestnetOptions conf + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf node@NodeRuntime{nodeProcessHandle} <- H.headM $ poolRuntime <$> poolNodes testnetRuntime -- send SIGINT diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SanityCheck.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SanityCheck.hs index 568f126ad54..2356df37f57 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SanityCheck.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SanityCheck.hs @@ -14,12 +14,14 @@ import Cardano.Api.Shelley import Cardano.Testnet +import Data.Default.Class import Prelude import GHC.IO.Exception (IOException) import GHC.Stack import Testnet.Property.Util (integrationWorkspace) +import Testnet.Start.Types import Testnet.Types import Hedgehog @@ -43,13 +45,14 @@ hprop_ledger_events_sanity_check = integrationWorkspace "ledger-events-sanity-ch -- Start a local test net conf <- mkConf tempAbsBasePath' - let fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 100 - , cardanoSlotLength = 0.1 + let fastTestnetOptions = def + shelleyOptions = def + { shelleyEpochLength = 100 + , shelleySlotLength = 0.1 } TestnetRuntime{configurationFile, poolNodes} - <- cardanoTestnetDefault fastTestnetOptions conf + <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf nr@NodeRuntime{nodeSprocket} <- H.headM $ poolRuntime <$> poolNodes let socketPath = nodeSocketPath nr diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Babbage/Transaction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Babbage/Transaction.hs index fc6c6c93788..609dab2272e 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Babbage/Transaction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Babbage/Transaction.hs @@ -25,6 +25,7 @@ import qualified Data.Aeson.Lens as Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Lazy as LBS +import Data.Default.Class import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Text as Text @@ -54,7 +55,7 @@ hprop_transaction = integrationRetryWorkspace 0 "submit-api-babbage-transaction" let tempAbsPath' = unTmpAbsPath tempAbsPath sbe = ShelleyBasedEraBabbage tempBaseAbsPath = makeTmpBaseAbsPath $ TmpAbsolutePath tempAbsPath' - options = cardanoDefaultTestnetOptions + options = def { cardanoNodeEra = AnyShelleyBasedEra sbe -- TODO: We should only support the latest era and the upcoming era } @@ -65,7 +66,7 @@ hprop_transaction = integrationRetryWorkspace 0 "submit-api-babbage-transaction" , testnetMagic , poolNodes , wallets=wallet0:_ - } <- cardanoTestnetDefault options conf + } <- cardanoTestnetDefault options def conf poolNode1 <- H.headM poolNodes diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json index 12a7f523266..96dc93f55c8 100644 --- a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json +++ b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json @@ -358,16 +358,16 @@ 38887044, 32947, 10, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807 + 1292075, + 24469, + 74, + 0, + 1, + 936157, + 49601, + 237, + 0, + 1 ], "PlutusV3": [ 0, @@ -1026,16 +1026,16 @@ 38887044, 32947, 10, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807 + 1292075, + 24469, + 74, + 0, + 1, + 936157, + 49601, + 237, + 0, + 1 ], "PlutusV3": [ 0, @@ -1683,16 +1683,16 @@ 38887044, 32947, 10, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807 + 1292075, + 24469, + 74, + 0, + 1, + 936157, + 49601, + 237, + 0, + 1 ], "PlutusV3": [ 0, @@ -2337,16 +2337,16 @@ 38887044, 32947, 10, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807 + 1292075, + 24469, + 74, + 0, + 1, + 936157, + 49601, + 237, + 0, + 1 ], "PlutusV3": [ 0, diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersFileOut.json b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersFileOut.json index 6f3c1b5982c..bfd05cf4ce3 100644 --- a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersFileOut.json +++ b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersFileOut.json @@ -347,16 +347,16 @@ 38887044, 32947, 10, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807 + 1292075, + 24469, + 74, + 0, + 1, + 936157, + 49601, + 237, + 0, + 1 ], "PlutusV3": [ 0, diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersOut.txt b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersOut.txt index 6f3c1b5982c..bfd05cf4ce3 100644 --- a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersOut.txt +++ b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/protocolParametersOut.txt @@ -347,16 +347,16 @@ 38887044, 32947, 10, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807, - 9223372036854775807 + 1292075, + 24469, + 74, + 0, + 1, + 936157, + 49601, + 237, + 0, + 1 ], "PlutusV3": [ 0,