Reserve testnet ports instead of picking random ones

cardano-testnet/cardano-testnet.cabal

@@ -73,7 +73,6 @@ library
                       , ouroboros-network-api
                       , prettyprinter
                       , process
-                      , random
                       , resourcet
                       , retry
                       , safe-exceptions

cardano-testnet/src/Cardano/Testnet.hs

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

cardano-testnet/src/Testnet/Property/Util.hs

@@ -97,9 +97,8 @@ workspace prefixPath f = withFrozenCallStack $ do
 -- | The 'FilePath' in '(FilePath -> H.Integration ())' is the work space directory.
 -- This is created (and returned) via 'H.workspace'.
 integrationWorkspace :: HasCallStack => FilePath -> (FilePath -> H.Integration ()) -> H.Property
-integrationWorkspace workspaceName f = withFrozenCallStack . f' $
+integrationWorkspace workspaceName f = withFrozenCallStack $
   integration $ H.runFinallies $ workspace workspaceName f
-  where f' = id
 
 isLinux :: Bool
 isLinux = os == "linux"

cardano-testnet/src/Testnet/Runtime.hs

@@ -13,6 +13,9 @@
 module Testnet.Runtime
   ( startNode
   , startLedgerNewEpochStateLogging
+
+  , testnetDefaultIpv4Address
+  , showIpv4Address
   ) where
 
 import           Cardano.Api
@@ -32,11 +35,12 @@ import           Data.Aeson.Encode.Pretty (encodePretty)
 import           Data.Algorithm.Diff
 import           Data.Algorithm.DiffOutput
 import qualified Data.ByteString.Lazy.Char8 as BSC
+import           Data.List (intercalate)
 import qualified Data.List as List
-import           Data.Text (Text, unpack)
+import           GHC.Exts (IsString (..))
 import           GHC.Stack
 import qualified GHC.Stack as GHC
-import           Network.Socket (PortNumber)
+import           Network.Socket (HostAddress, PortNumber, hostAddressToTuple, tupleToHostAddress)
 import           Prettyprinter (unAnnotate)
 import qualified System.Directory as IO
 import           System.FilePath
@@ -56,6 +60,14 @@ import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as H
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.Concurrent as H
 
+-- | Hardcoded testnet IP address pointing to local host
+testnetDefaultIpv4Address :: HostAddress
+testnetDefaultIpv4Address = tupleToHostAddress (127, 0, 0, 1)
+
+showIpv4Address :: IsString s => HostAddress -> s
+showIpv4Address address = fromString . intercalate "." $ show <$> [a,b,c,d]
+  where (a,b,c,d) = hostAddressToTuple address
+
 data NodeStartFailure
   = ProcessRelatedFailure ProcessError
   | ExecutableRelatedFailure ExecutableError
@@ -85,16 +97,19 @@ startNode
   -- ^ The temporary absolute path
   -> String
   -- ^ The name of the node
-  -> Text
+  -> HostAddress
   -- ^ Node IPv4 address
   -> PortNumber
   -- ^ Node port
+  -> Maybe ReleaseKey
+  -- ^ If the port number got reserved before calling 'startNode', this should be the release key used to free
+  -- it before starting the node.
   -> Int
   -- ^ Testnet magic
   -> [String]
   -- ^ The command --socket-path will be added automatically.
   -> ExceptT NodeStartFailure m NodeRuntime
-startNode tp node ipv4 port testnetMagic nodeCmd = GHC.withFrozenCallStack $ do
+startNode tp node ipv4 port mPortReleaseKey testnetMagic nodeCmd = GHC.withFrozenCallStack $ do
   let tempBaseAbsPath = makeTmpBaseAbsPath tp
       socketDir = makeSocketDir tp
       logDir = makeLogDir tp
@@ -121,10 +136,13 @@ startNode tp node ipv4 port testnetMagic nodeCmd = GHC.withFrozenCallStack $ do
                        [ nodeCmd
                        , [ "--socket-path", H.sprocketArgumentName sprocket
                          , "--port", show port
-                         , "--host-addr", unpack ipv4
+                         , "--host-addr", showIpv4Address ipv4
                          ]
                        ]
 
+  -- release reserved port to make it available to bind to by the node
+  mapM_ release mPortReleaseKey
+
   (Just stdIn, _, _, hProcess, _)
     <- firstExceptT ProcessRelatedFailure $ initiateProcess
           $ nodeProcess

cardano-testnet/src/Testnet/Start/Cardano.hs

@@ -17,7 +17,6 @@ module Testnet.Start.Cardano
   , cardanoTestnetDefault
   , getDefaultAlonzoGenesis
   , getDefaultShelleyGenesis
-  , requestAvailablePortNumbers
   ) where
 
 
@@ -36,21 +35,16 @@ import qualified Data.Aeson as Aeson
 import           Data.Bifunctor (first)
 import qualified Data.ByteString.Lazy as LBS
 import           Data.Either
-import           Data.IORef
 import qualified Data.List as L
 import           Data.Maybe
-import           Data.Text (Text)
 import qualified Data.Text as Text
 import           Data.Time (UTCTime)
 import qualified Data.Time.Clock as DTC
 import           Data.Word (Word32)
-import           GHC.IO.Unsafe (unsafePerformIO)
 import           GHC.Stack
 import qualified GHC.Stack as GHC
-import           Network.Socket (PortNumber)
 import           System.FilePath ((</>))
 import qualified System.Info as OS
-import qualified System.Random.Stateful as R
 import           Text.Printf (printf)
 
 import           Testnet.Components.Configuration
@@ -122,41 +116,6 @@ getDefaultShelleyGenesis opts = do
   startTime <- H.noteShow $ DTC.addUTCTime startTimeOffsetSeconds currentTime
   return (startTime, Defaults.defaultShelleyGenesis startTime opts)
 
--- | Hardcoded testnet IP address
-testnetIpv4Address :: Text
-testnetIpv4Address = "127.0.0.1"
-
--- | Starting port number, from which testnet nodes will get new ports.
-defaultTestnetNodeStartingPortNumber :: PortNumber
-defaultTestnetNodeStartingPortNumber = 20000
-
--- | Global counter used to track which testnet node's ports were already allocated
-availablePortNumber :: IORef PortNumber
-availablePortNumber = unsafePerformIO $ do
-  let startingPort = toInteger defaultTestnetNodeStartingPortNumber
-  -- add a random offset to the starting port number to avoid clashes when starting multiple testnets
-  randomPart <- R.uniformRM (1,9) R.globalStdGen
-  newIORef . fromInteger $ startingPort + randomPart * 1000
-{-# NOINLINE availablePortNumber #-}
-
--- | Request a list of unused port numbers for testnet nodes. This shifts 'availablePortNumber' by
--- 'maxPortsPerRequest' in order to make sure that each node gets an unique port.
-requestAvailablePortNumbers
-  :: HasCallStack
-  => MonadIO m
-  => MonadTest m
-  => Int -- ^ Number of ports to request
-  -> m [PortNumber]
-requestAvailablePortNumbers numberOfPorts
-  | numberOfPorts > fromIntegral 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 + fromIntegral numberOfPorts - 1])
-    where
-      maxPortsPerRequest = 50
-
 -- | Setup a number of credentials and pools, like this:
 --
 -- > ├── byron
@@ -337,27 +296,24 @@ cardanoTestnet
           }
         }
 
-
     -- Add Byron, Shelley and Alonzo genesis hashes to node configuration
     config <- createConfigJson (TmpAbsolutePath tmpAbsPath) era
 
     H.evalIO $ LBS.writeFile (unFile configurationFile) config
 
-    let ip = "10.0.0.1"
-    portNumbers <- requestAvailablePortNumbers numPoolNodes
-    -- H.reserveRandomPort
+    portNumbers <- replicateM numPoolNodes $ H.reserveRandomPort testnetDefaultIpv4Address
     -- Byron related
-    forM_ (zip [1..] portNumbers) $ \(i, portNumber) -> do
+    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
-    forM_ (zip [1..] portNumbers) $ \(i, myPortNumber) -> do
-      let producers = flip map (filter (/= myPortNumber) portNumbers) $ \otherProducerPort ->
+    forM_ (zip [1..] portNumbers) $ \(i, (_, myPortNumber)) -> do
+      let producers = flip map (filter ((/= myPortNumber) . snd) portNumbers) $ \(_, otherProducerPort) ->
             RemoteAddress
-              { raAddress = testnetIpv4Address
+              { raAddress = showIpv4Address testnetDefaultIpv4Address
               , raPort = otherProducerPort
               , raValency = 1
               }
@@ -366,12 +322,12 @@ cardanoTestnet
         RealNodeTopology producers
 
     let keysWithPorts = L.zip3 [1..] poolKeys portNumbers
-    ePoolNodes <- H.forConcurrently keysWithPorts $ \(i, key, port) -> do
+    ePoolNodes <- H.forConcurrently keysWithPorts $ \(i, key, (portReleaseKey, port)) -> do
       let nodeName = mkNodeName i
           keyDir = tmpAbsPath </> poolKeyDir i
       H.note_ $ "Node name: " <> nodeName
       eRuntime <- runExceptT $
-        startNode (TmpAbsolutePath tmpAbsPath) nodeName testnetIpv4Address port testnetMagic
+        startNode (TmpAbsolutePath tmpAbsPath) nodeName testnetDefaultIpv4Address port (Just portReleaseKey) testnetMagic
           [ "run"
           , "--config", unFile configurationFile
           , "--topology", keyDir </> "topology.json"

cardano-testnet/src/Testnet/Types.hs

@@ -60,7 +60,7 @@ import           Data.Time.Clock (UTCTime)
 import           GHC.Generics (Generic)
 import qualified GHC.IO.Handle as IO
 import           GHC.Stack
-import           Network.Socket (PortNumber)
+import           Network.Socket (HostAddress, PortNumber)
 import           System.FilePath
 import qualified System.Process as IO
 
@@ -115,7 +115,7 @@ poolNodeStdout = nodeStdout . poolRuntime
 
 data NodeRuntime = NodeRuntime
   { nodeName :: !String
-  , nodeIpv4 :: !Text
+  , nodeIpv4 :: !HostAddress
   , nodePort :: !PortNumber
   , nodeSprocket :: !Sprocket
   , nodeStdinHandle :: !IO.Handle

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs

@@ -46,6 +46,7 @@ import           Testnet.Types
 
 import           Hedgehog (Property, (===))
 import qualified Hedgehog as H
+import qualified Hedgehog.Extras.Stock.IO.Network.Port as H
 import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
@@ -220,7 +221,7 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "babbage-leadership-sched
   let valency = 1
       topology = RealNodeTopology $
         flip map poolNodes $ \PoolNode{poolRuntime=NodeRuntime{nodeIpv4,nodePort}} ->
-          RemoteAddress nodeIpv4 nodePort valency
+          RemoteAddress (showIpv4Address nodeIpv4) nodePort valency
   H.lbsWriteFile topologyFile $ Aeson.encode topology
   let testSpoKesVKey = work </> "kes.vkey"
       testSpoKesSKey = work </> "kes.skey"
@@ -248,8 +249,9 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "babbage-leadership-sched
 
   jsonBS <- createConfigJson tempAbsPath (cardanoNodeEra cTestnetOptions)
   H.lbsWriteFile (unFile configurationFile) jsonBS
-  [newNodePort] <- requestAvailablePortNumbers 1
-  eRuntime <- runExceptT $ startNode (TmpAbsolutePath work) "test-spo" "127.0.0.1" newNodePort testnetMagic
+  (portReleaseKey, newNodePort) <- H.reserveRandomPort testnetDefaultIpv4Address
+  eRuntime <- runExceptT $
+    startNode (TmpAbsolutePath work) "test-spo" testnetDefaultIpv4Address newNodePort (Just portReleaseKey) testnetMagic
         [ "run"
         , "--config", unFile configurationFile
         , "--topology", topologyFile

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs

@@ -42,6 +42,7 @@ import           Hedgehog (Property)
 import qualified Hedgehog as H
 import           Hedgehog.Extras (threadDelay)
 import           Hedgehog.Extras.Stock (sprocketSystemName)
+import qualified Hedgehog.Extras.Stock.IO.Network.Port as H
 import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
@@ -214,7 +215,7 @@ hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbs
   let valency = 1
       topology = RealNodeTopology $
         flip map poolNodes $ \PoolNode{poolRuntime=NodeRuntime{nodeIpv4,nodePort}} ->
-            RemoteAddress nodeIpv4 nodePort valency
+            RemoteAddress (showIpv4Address nodeIpv4) nodePort valency
   H.lbsWriteFile topologyFile $ Aeson.encode topology
 
   let testSpoVrfVKey = work </> "vrf.vkey"
@@ -247,8 +248,8 @@ hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbs
 
   jsonBS <- createConfigJson tempAbsPath (cardanoNodeEra cTestnetOptions)
   H.lbsWriteFile (unFile configurationFile) jsonBS
-  [newNodePortNumber] <- requestAvailablePortNumbers 1
-  eRuntime <- runExceptT $ startNode tempAbsPath "test-spo" "127.0.0.1" newNodePortNumber testnetMagic
+  (portReleaseKey, newNodePortNumber) <- H.reserveRandomPort testnetDefaultIpv4Address
+  eRuntime <- runExceptT $ startNode tempAbsPath "test-spo" testnetDefaultIpv4Address newNodePortNumber (Just portReleaseKey) testnetMagic
         [ "run"
         , "--config", unFile configurationFile
         , "--topology", topologyFile