Fix testnet node ports allocation

cardano-testnet/cardano-testnet.cabal

@@ -199,6 +199,7 @@ test-suite cardano-testnet-test
                       , cardano-crypto-class
                       , cardano-ledger-conway
                       , cardano-ledger-shelley
+                      , cardano-node
                       , cardano-testnet
                       , containers
                       , directory

cardano-testnet/src/Cardano/Testnet.hs

@@ -6,6 +6,7 @@ module Cardano.Testnet (
   -- ** Start a testnet
   cardanoTestnet,
   cardanoTestnetDefault,
+  requestAvailablePortNumbers,
 
   -- ** Testnet options
   CardanoTestnetOptions(..),

cardano-testnet/src/Testnet/Defaults.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
@@ -50,14 +51,17 @@ import qualified Data.Aeson.KeyMap as KeyMapAeson
 import           Data.Bifunctor
 import qualified Data.Default.Class as DefaultClass
 import qualified Data.Map.Strict as Map
+import           Data.Maybe
 import           Data.Proxy
 import           Data.Ratio
 import           Data.Scientific
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import           Data.Time (UTCTime)
+import           Data.Typeable
 import qualified Data.Vector as Vector
 import           Data.Word
+import           GHC.Stack
 import           Lens.Micro
 import           Numeric.Natural
 
@@ -482,21 +486,33 @@ defaultShelleyGenesis
   :: UTCTime
   -> CardanoTestnetOptions
   -> Api.ShelleyGenesis StandardCrypto
-defaultShelleyGenesis startTime testnetOptions =
-  let testnetMagic = cardanoTestnetMagic testnetOptions
-      slotLength = cardanoSlotLength testnetOptions
-      epochLength = cardanoEpochLength testnetOptions
-      maxLovelaceLovelaceSupply = cardanoMaxSupply testnetOptions
-      pVer = eraToProtocolVersion $ cardanoNodeEra testnetOptions
+defaultShelleyGenesis startTime testnetOptions = do
+  let CardanoTestnetOptions
+        { cardanoTestnetMagic = testnetMagic
+        , cardanoSlotLength = slotLength
+        , cardanoEpochLength = epochLength
+        , cardanoMaxSupply = maxLovelaceLovelaceSupply
+        , cardanoActiveSlotsCoeff
+        , cardanoNodeEra
+        } = testnetOptions
+      -- f
+      activeSlotsCoeff = round (cardanoActiveSlotsCoeff * 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
       protocolParams = Api.sgProtocolParams Api.shelleyGenesisDefaults
       protocolParamsWithPVer = protocolParams & ppProtocolVersionL' .~ pVer
-  in Api.shelleyGenesisDefaults
-        { Api.sgNetworkMagic = fromIntegral testnetMagic
-        , Api.sgSlotLength = secondsToNominalDiffTimeMicro $ realToFrac slotLength
+  Api.shelleyGenesisDefaults
+        { Api.sgActiveSlotsCoeff = unsafeBoundedRational activeSlotsCoeff
         , Api.sgEpochLength = EpochSize $ fromIntegral epochLength
         , Api.sgMaxLovelaceSupply = maxLovelaceLovelaceSupply
-        , Api.sgSystemStart = startTime
+        , Api.sgNetworkMagic = fromIntegral testnetMagic
         , Api.sgProtocolParams = protocolParamsWithPVer
+        -- using default from shelley genesis k = 2160
+        -- , Api.sgSecurityParam = securityParam
+        , Api.sgSlotLength = secondsToNominalDiffTimeMicro $ realToFrac slotLength
+        , Api.sgSystemStart = startTime
         }
 
 
@@ -564,3 +580,11 @@ plutusV3SpendingScript =
                , ",\"cborHex\": \"484701010022280001\""
                , "}"
                ]
+
+-- TODO: move to cardano-api
+unsafeBoundedRational :: forall r. (HasCallStack, Typeable r, BoundedRational r)
+                      => Rational
+                      -> r
+unsafeBoundedRational x = fromMaybe (error errMessage) $ boundRational x
+  where
+    errMessage = show (typeRep (Proxy @r)) <> " is out of bounds: " <> show x

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/Runtime.hs

@@ -50,12 +50,13 @@ import           Control.Monad.State.Strict (StateT)
 import           Control.Monad.Trans.Resource
 import qualified Data.Aeson as A
 import qualified Data.List as List
-import           Data.Text (Text)
+import           Data.Text (Text, unpack)
 import           Data.Time.Clock (UTCTime)
 import           GHC.Generics (Generic)
 import qualified GHC.IO.Handle as IO
 import           GHC.Stack
 import qualified GHC.Stack as GHC
+import           Network.Socket (PortNumber)
 import qualified System.Directory as IO
 import           System.Directory (doesDirectoryExist)
 import           System.FilePath
@@ -85,6 +86,8 @@ data TestnetRuntime = TestnetRuntime
 
 data NodeRuntime = NodeRuntime
   { nodeName :: String
+  , nodeIpv4 :: Text
+  , nodePort :: PortNumber
   , nodeSprocket :: Sprocket
   , nodeStdinHandle :: IO.Handle
   , nodeStdout :: FilePath
@@ -187,14 +190,16 @@ startNode
   -- ^ The temporary absolute path
   -> String
   -- ^ The name of the node
-  -> Int
+  -> Text
+  -- ^ Node IPv4 address
+  -> PortNumber
   -- ^ Node port
   -> Int
   -- ^ Testnet magic
   -> [String]
   -- ^ The command --socket-path will be added automatically.
   -> ExceptT NodeStartFailure (ResourceT IO) NodeRuntime
-startNode tp node port testnetMagic nodeCmd = GHC.withFrozenCallStack $ do
+startNode tp node ipv4 port testnetMagic nodeCmd = GHC.withFrozenCallStack $ do
   let tempBaseAbsPath = makeTmpBaseAbsPath tp
       socketDir = makeSocketDir tp
       logDir = makeLogDir tp
@@ -213,15 +218,15 @@ startNode tp node port testnetMagic nodeCmd = GHC.withFrozenCallStack $ do
   unless (List.length (H.sprocketArgumentName sprocket) <= H.maxSprocketArgumentNameLength) $
      left MaxSprocketLengthExceededError
 
-  let portString = show port
-      socketAbsPath = H.sprocketSystemName sprocket
+  let socketAbsPath = H.sprocketSystemName sprocket
 
   nodeProcess
     <- firstExceptT ExecutableRelatedFailure
          $ hoistExceptT lift $ procNode $ mconcat
                        [ nodeCmd
                        , [ "--socket-path", H.sprocketArgumentName sprocket
-                         , "--port", portString
+                         , "--port", show port
+                         , "--host-addr", unpack ipv4
                          ]
                        ]
 
@@ -266,7 +271,7 @@ startNode tp node port testnetMagic nodeCmd = GHC.withFrozenCallStack $ do
   Ping.pingNode (fromIntegral testnetMagic) sprocket
     >>= (firstExceptT (NodeExecutableError . docToString . ("Ping error:" <+>) . prettyError) . hoistEither)
 
-  pure $ NodeRuntime node sprocket stdIn nodeStdoutFile nodeStderrFile hProcess
+  pure $ NodeRuntime node ipv4 port sprocket stdIn nodeStdoutFile nodeStderrFile hProcess
 
 
 createDirectoryIfMissingNew :: HasCallStack => FilePath -> IO FilePath