testtest

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

cardano-testnet/src/Testnet/Defaults.hs

@@ -456,7 +456,7 @@ defaultShelleyGenesis startTime testnetOptions = do
       -- f
       activeSlotsCoeff = round (cardanoActiveSlotsCoeff * 100) % 100
       -- make security param k satisfy: epochLength = 10 * k / f
-      securityParam = fromIntegral epochLength * cardanoActiveSlotsCoeff / 10
+      -- securityParam = fromIntegral epochLength * cardanoActiveSlotsCoeff / 10
       pVer = eraToProtocolVersion cardanoNodeEra
       protocolParams = Api.sgProtocolParams Api.shelleyGenesisDefaults
       protocolParamsWithPVer = protocolParams & ppProtocolVersionL' .~ pVer
@@ -466,7 +466,7 @@ defaultShelleyGenesis startTime testnetOptions = do
         , Api.sgMaxLovelaceSupply = maxLovelaceLovelaceSupply
         , Api.sgNetworkMagic = fromIntegral testnetMagic
         , Api.sgProtocolParams = protocolParamsWithPVer
-        , Api.sgSecurityParam = round securityParam
+        -- , Api.sgSecurityParam = round securityParam
         , Api.sgSlotLength = secondsToNominalDiffTimeMicro $ realToFrac slotLength
         , Api.sgSystemStart = startTime
         }

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

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

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
   }

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
                           }
 

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/StakeSnapshot.hs

@@ -42,7 +42,6 @@ hprop_stakeSnapshot = H.integrationRetryWorkspace 2 "conway-stake-snapshot" $ \t
     era = BabbageEra
     options = cardanoDefaultTestnetOptions
                         { cardanoNodes = cardanoDefaultTestnetNodeOptions
-                        , cardanoSlotLength = 0.1
                         , cardanoNodeEra = AnyCardanoEra era -- TODO: We should only support the latest era and the upcoming era
                         }
 

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
                           }
 

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

@@ -220,8 +220,7 @@ hprop_shutdownOnSlotSynced = H.integrationRetryWorkspace 2 "shutdown-on-slot-syn
     (Right s):_ -> return s
 
   let epsilon = 50
-
-  H.assert (maxSlot <= slotTip && slotTip <= maxSlot + epsilon)
+  H.assertWithinTolerance slotTip maxSlot epsilon
 
 hprop_shutdownOnSigint :: Property
 hprop_shutdownOnSigint = H.integrationRetryWorkspace 2 "shutdown-on-sigint" $ \tempAbsBasePath' -> do
@@ -231,7 +230,6 @@ hprop_shutdownOnSigint = H.integrationRetryWorkspace 2 "shutdown-on-sigint" $ \t
 
   let fastTestnetOptions = cardanoDefaultTestnetOptions
         { cardanoEpochLength = 300
-        , cardanoSlotLength = 0.01
         }
   testnetRuntime
     <- cardanoTestnetDefault fastTestnetOptions conf

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