From 05949c00a9f65d0f5b06f184d1b9b82fac6c5088 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 28 Feb 2024 20:20:26 +0100 Subject: [PATCH] testtest --- cardano-testnet/cardano-testnet.cabal | 2 +- .../src/Testnet/Property/Assert.hs | 40 +++--- cardano-testnet/src/Testnet/Start/Cardano.hs | 127 +++++++----------- cardano-testnet/src/Testnet/Start/Types.hs | 3 +- .../Test/Cli/Babbage/LeadershipSchedule.hs | 2 - .../Testnet/Test/Cli/Conway/StakeSnapshot.hs | 2 + .../Cardano/Testnet/Test/Cli/KesPeriodInfo.hs | 2 - .../Cardano/Testnet/Test/Node/Shutdown.hs | 4 +- .../cardano-testnet-test.hs | 2 - 9 files changed, 77 insertions(+), 107 deletions(-) diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 3047ce15841..94b217ba2d7 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -215,7 +215,7 @@ test-suite cardano-testnet-test , time , transformers - ghc-options: -threaded -rtsopts "-with-rtsopts=-N -T" + ghc-options: -threaded -rtsopts "-with-rtsopts=-N4 -T" build-tool-depends: cardano-node:cardano-node , cardano-cli:cardano-cli diff --git a/cardano-testnet/src/Testnet/Property/Assert.hs b/cardano-testnet/src/Testnet/Property/Assert.hs index f158b4b2def..4a2bb41edda 100644 --- a/cardano-testnet/src/Testnet/Property/Assert.hs +++ b/cardano-testnet/src/Testnet/Property/Assert.hs @@ -67,7 +67,7 @@ fileJsonGrep fp f = do assertByDeadlineIOCustom :: (MonadTest m, MonadIO m, HasCallStack) => String -> DTC.UTCTime -> IO Bool -> m () -assertByDeadlineIOCustom str deadline f = GHC.withFrozenCallStack $ do +assertByDeadlineIOCustom str deadline f = withFrozenCallStack $ do success <- H.evalIO f unless success $ do currentTime <- H.evalIO DTC.getCurrentTime @@ -86,33 +86,35 @@ assertExpectedSposInLedgerState -> CardanoTestnetOptions -> ExecConfig -> m () -assertExpectedSposInLedgerState output tNetOptions execConfig = - GHC.withFrozenCallStack $ do - let numExpectedPools = length $ cardanoNodes tNetOptions +assertExpectedSposInLedgerState output tNetOptions execConfig = withFrozenCallStack $ do + let numExpectedPools = length $ cardanoNodes tNetOptions - void $ execCli' execConfig - [ "query", "stake-pools" - , "--out-file", output - ] + void $ execCli' execConfig + [ "query", "stake-pools" + , "--out-file", output + ] - poolSet <- H.evalEither =<< H.evalIO (Aeson.eitherDecodeFileStrict' @(Set PoolId) output) + poolSet <- H.evalEither =<< H.evalIO (Aeson.eitherDecodeFileStrict' @(Set PoolId) output) - H.cat output + H.cat output - let numPoolsInLedgerState = Set.size poolSet - unless (numPoolsInLedgerState == numExpectedPools) $ - failMessage GHC.callStack - $ unlines [ "Expected number of stake pools not found in ledger state" - , "Expected: ", show numExpectedPools - , "Actual: ", show numPoolsInLedgerState - ] + let numPoolsInLedgerState = Set.size poolSet + unless (numPoolsInLedgerState == numExpectedPools) $ + failMessage GHC.callStack + $ unlines [ "Expected number of stake pools not found in ledger state" + , "Expected: ", show numExpectedPools + , "Actual: ", show numPoolsInLedgerState + ] -assertChainExtended :: (HasCallStack, H.MonadTest m, MonadIO m) +assertChainExtended + :: HasCallStack + => H.MonadTest m + => MonadIO m => DTC.UTCTime -> NodeLoggingFormat -> FilePath -> m () -assertChainExtended deadline nodeLoggingFormat nodeStdoutFile = +assertChainExtended deadline nodeLoggingFormat nodeStdoutFile = withFrozenCallStack $ assertByDeadlineIOCustom "Chain not extended" deadline $ do case nodeLoggingFormat of NodeLoggingFormatAsText -> IO.fileContains "Chain extended, new tip" nodeStdoutFile diff --git a/cardano-testnet/src/Testnet/Start/Cardano.hs b/cardano-testnet/src/Testnet/Start/Cardano.hs index 417c065c15d..be38751aadf 100644 --- a/cardano-testnet/src/Testnet/Start/Cardano.hs +++ b/cardano-testnet/src/Testnet/Start/Cardano.hs @@ -65,6 +65,11 @@ import Hedgehog.Extras (failMessage) import qualified Hedgehog.Extras.Stock.OS as OS import qualified Hedgehog.Extras.Test.Base as H import qualified Hedgehog.Extras.Test.File as H +import Data.IORef +import GHC.IO.Unsafe (unsafePerformIO) +import Hedgehog (MonadTest) +import GHC.Stack +import Text.Printf (printf) {- HLINT ignore "Redundant flip" -} {- HLINT ignore "Redundant id" -} @@ -106,6 +111,31 @@ cardanoTestnetDefault opts conf = do opts conf startTime (Defaults.defaultShelleyGenesis startTime opts) alonzoGenesis Defaults.defaultConwayGenesis + +-- | Starting port number, from which testnet nodes will get new ports. +defaultTestnetNodeStartingPortNumber :: Int +defaultTestnetNodeStartingPortNumber = 13000 + +availablePortNumber :: IORef Int +availablePortNumber = unsafePerformIO $ newIORef defaultTestnetNodeStartingPortNumber +{-# NOINLINE availablePortNumber #-} + +requestAvailablePortNumbers + :: HasCallStack + => MonadIO m + => MonadTest m + => Int + -> m [Int] +requestAvailablePortNumbers numberOfPorts + | numberOfPorts > maxPortsPerRequest = withFrozenCallStack $ do + H.note_ $ "Tried to allocate " <> show numberOfPorts <> " port numbers in one request. " + <> "It's allowed to allocate no more than " <> show maxPortsPerRequest <> " per request." + H.failure + | otherwise = liftIO $ atomicModifyIORef' availablePortNumber $ \n -> + (n + maxPortsPerRequest, [n..n + numberOfPorts - 1]) + where + maxPortsPerRequest = 100 + -- | Setup a number of credentials and pools, like this: -- -- > ├── byron @@ -178,6 +208,8 @@ cardanoTestnet nbPools = numPools testnetOptions era = cardanoNodeEra testnetOptions + portNumbers <- requestAvailablePortNumbers numPoolNodes + -- Sanity checks testnetMinimumConfigurationRequirements testnetOptions when (shelleyStartTime /= startTime) $ do @@ -284,87 +316,26 @@ cardanoTestnet H.evalIO $ LBS.writeFile configurationFile finalYamlConfig -- Byron related - - H.renameFile (tmpAbsPath "byron-gen-command/delegate-keys.000.key") (tmpAbsPath poolKeyDir 1 "byron-delegate.key") - H.renameFile (tmpAbsPath "byron-gen-command/delegate-keys.001.key") (tmpAbsPath poolKeyDir 2 "byron-delegate.key") - H.renameFile (tmpAbsPath "byron-gen-command/delegate-keys.002.key") (tmpAbsPath poolKeyDir 3 "byron-delegate.key") - - H.renameFile (tmpAbsPath "byron-gen-command/delegation-cert.000.json") (tmpAbsPath poolKeyDir 1 "byron-delegation.cert") - H.renameFile (tmpAbsPath "byron-gen-command/delegation-cert.001.json") (tmpAbsPath poolKeyDir 2 "byron-delegation.cert") - H.renameFile (tmpAbsPath "byron-gen-command/delegation-cert.002.json") (tmpAbsPath poolKeyDir 3 "byron-delegation.cert") - - H.writeFile (tmpAbsPath poolKeyDir 1 "port") "3001" - H.writeFile (tmpAbsPath poolKeyDir 2 "port") "3002" - H.writeFile (tmpAbsPath poolKeyDir 3 "port") "3003" + forM_ (zip [1..] portNumbers) $ \(i, portNumber) -> do + let iStr = printf "%03d" (i - 1) + H.renameFile (tmpAbsPath "byron-gen-command" "delegate-keys." <> iStr <> ".key") (tmpAbsPath poolKeyDir i "byron-delegate.key") + H.renameFile (tmpAbsPath "byron-gen-command" "delegation-cert." <> iStr <> ".json") (tmpAbsPath poolKeyDir i "byron-delegation.cert") + H.writeFile (tmpAbsPath poolKeyDir i "port") (show portNumber) -- Make topology files - -- TODO generalise this over the N BFT nodes and pool nodes - - H.lbsWriteFile (tmpAbsPath poolKeyDir 1 "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 (tmpAbsPath poolKeyDir 2 "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 (tmpAbsPath poolKeyDir 3 "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 - ] - ] - ] - - let spoNodesWithPortNos = L.zip poolKeysFps [3001..] + forM_ (zip [1..] portNumbers) $ \(i, myPortNumber) -> do + let producers = flip map (filter (/= myPortNumber) portNumbers) $ \otherProducerPort -> + object + [ "addr" .= toJSON @String "127.0.0.1" + , "port" .= toJSON otherProducerPort + , "valency" .= toJSON @Int 1 + ] + + H.lbsWriteFile (tmpAbsPath poolKeyDir i "topology.json") $ encode $ + object [ "Producers" .= producers ] + + let spoNodesWithPortNos = L.zip poolKeysFps portNumbers ePoolNodes <- forM (L.zip spoNodesWithPortNos poolKeys) $ \((node, port),key) -> do let nodeName = tail $ dropWhile (/= '/') node H.note_ $ "Node name: " <> nodeName diff --git a/cardano-testnet/src/Testnet/Start/Types.hs b/cardano-testnet/src/Testnet/Start/Types.hs index 76822953b3e..27bcf9ec45d 100644 --- a/cardano-testnet/src/Testnet/Start/Types.hs +++ b/cardano-testnet/src/Testnet/Start/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE ScopedTypeVariables #-} module Testnet.Start.Types @@ -55,7 +56,7 @@ cardanoDefaultTestnetOptions = CardanoTestnetOptions , cardanoSlotLength = 0.1 , cardanoTestnetMagic = 42 , cardanoActiveSlotsCoeff = 0.1 - , cardanoMaxSupply = 10020000000 + , cardanoMaxSupply = 10_020_000_000 , cardanoEnableP2P = False , cardanoNodeLoggingFormat = NodeLoggingFormatAsJson } 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 1c8df4b9a54..5f46c253f6a 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 @@ -73,8 +73,6 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch let era = BabbageEra cTestnetOptions = cardanoDefaultTestnetOptions { cardanoNodes = cardanoDefaultTestnetNodeOptions - , 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/Conway/StakeSnapshot.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/StakeSnapshot.hs index 8c0d93f998f..acb910f6275 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 @@ -42,7 +42,9 @@ hprop_stakeSnapshot = H.integrationRetryWorkspace 2 "conway-stake-snapshot" $ \t era = BabbageEra options = cardanoDefaultTestnetOptions { cardanoNodes = cardanoDefaultTestnetNodeOptions + , cardanoEpochLength = 100 , cardanoSlotLength = 0.1 + , cardanoActiveSlotsCoeff = 0.5 , 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 ce3f757cac9..5666f21b6a3 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 @@ -66,8 +66,6 @@ hprop_kes_period_info = H.integrationRetryWorkspace 2 "kes-period-info" $ \tempA anyEra = AnyCardanoEra era cTestnetOptions = cardanoDefaultTestnetOptions { cardanoNodes = cardanoDefaultTestnetNodeOptions - , 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/Node/Shutdown.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs index 2012a21094f..92a2e41d978 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 @@ -230,8 +230,8 @@ hprop_shutdownOnSigint = H.integrationRetryWorkspace 2 "shutdown-on-sigint" $ \t conf <- mkConf tempAbsBasePath' let fastTestnetOptions = cardanoDefaultTestnetOptions - { cardanoEpochLength = 300 - , cardanoSlotLength = 0.01 + { cardanoEpochLength = 150 + -- , cardanoSlotLength = 0.1 } testnetRuntime <- cardanoTestnetDefault fastTestnetOptions conf diff --git a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs index 17debf52f8e..f26101491db 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -13,8 +13,6 @@ import qualified Cardano.Testnet.Test.Cli.Conway.Plutus import qualified Cardano.Testnet.Test.Cli.KesPeriodInfo import qualified Cardano.Testnet.Test.Cli.QuerySlotNumber import qualified Cardano.Testnet.Test.FoldBlocks -import qualified Cardano.Testnet.Test.LedgerEvents.Gov.InfoAction as LedgerEvents -import qualified Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution as LedgerEvents import qualified Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitutionSPO as LedgerEvents import qualified Cardano.Testnet.Test.LedgerEvents.SanityCheck as LedgerEvents import qualified Cardano.Testnet.Test.Node.Shutdown