EnableP2P and Improve message when running the cluster

Enhances the `cardano-testnet` user experience by refining startup output.

Improve messages when running the testnet

The HTTP call fetching mainnet protocol parameters from https://github.com/input-output-hk/cardano-parameters/blob/main/mainnet/parameters.json had no retry logic, so a transient network or TLS error would kill the testnet setup with an opaque exception. Retry up to 3 times with a  2-second delay, logging each attempt to stderr, and wrap the final failure in a descriptive error.

Update node_default_config.json

Author: CarlosLopezDeLara

cardano-testnet/src/Parsers/Run.hs

@@ -12,13 +12,17 @@ module Parsers.Run
   ) where
 import           Cardano.CLI.Environment
 
-import           Control.Monad (void)
+import           Control.Monad (forM_)
 import           Data.Default.Class (def)
+import qualified Data.Text as Text
 import           Options.Applicative
 import qualified Options.Applicative as Opt
 
 import           Testnet.Start.Cardano
 import           Testnet.Start.Types
+import           Testnet.Types (TestnetNode (..))
+
+import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as H
 
 import           Parsers.Cardano
 import           Parsers.Help
@@ -85,22 +89,38 @@ runCardanoOptions CardanoTestnetCliOptions
         runSimpleApp . runResourceT $ do
           logInfo $ "Creating environment: " <> display (tempAbsPath conf)
           createTestnetEnv testnetOptions genesisOptions def conf
-          logInfo $ "Starting testnet in environment: " <> display (tempAbsPath conf)
-          void $ cardanoTestnet testnetOptions conf
-          logInfo "Testnet started"
+          testnetRuntime <- cardanoTestnet testnetOptions conf
+          logTestnetInfo conf testnetRuntime
           waitForShutdown
       UserProvidedEnv nodeEnvPath -> do
         -- Run cardano-testnet in the sandbox provided by the user
         -- In that case, 'cardanoOutputDir' is not used
         conf <- mkConfigAbs nodeEnvPath
         runSimpleApp . runResourceT $ do
-          logInfo $ "Starting testnet in environment: " <> display (tempAbsPath conf)
-          void $ cardanoTestnet
+          testnetRuntime <- cardanoTestnet
             testnetOptions
             conf{updateTimestamps=updateTimestamps'}
-          logInfo "Testnet started"
+          logTestnetInfo conf testnetRuntime
           waitForShutdown
   where
+    logTestnetInfo conf testnetRuntime = do
+      let nodes = testnetNodes testnetRuntime
+      logInfo ""
+      logInfo $ "Testnet started in " <> display (tempAbsPath conf)
+                <> " with " <> display (length nodes) <> " nodes."
+      logInfo ""
+      case nodes of
+        (firstNode:_) -> do
+          logInfo "To interact with the testnet using cardano-cli:"
+          logInfo $ "  export CARDANO_NODE_NETWORK_ID=" <> display (testnetMagic testnetRuntime)
+          logInfo $ "  export CARDANO_NODE_SOCKET_PATH=" <> display (Text.pack (H.sprocketSystemName (nodeSprocket firstNode)))
+          logInfo ""
+        [] -> pure ()
+      logInfo "Node sockets:"
+      forM_ nodes $ \node ->
+        logInfo $ "  " <> display (Text.pack (nodeName node)) <> "  " <> display (Text.pack (H.sprocketSystemName (nodeSprocket node)))
+      logInfo ""
+
     waitForShutdown = do
-      logInfo "Waiting for shutdown (Ctrl+C)"
-      forever (threadDelay 100_000)
+      logInfo "Press Ctrl+C to stop all nodes."
+      forever (threadDelay 100_000)

cardano-testnet/src/Testnet/Components/Configuration.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -31,6 +32,7 @@ import           Cardano.Ledger.BaseTypes (unsafeNonZero)
 import           Cardano.Ledger.Dijkstra.Genesis (DijkstraGenesis)
 import           Cardano.Node.Protocol.Byron
 
+import           Control.Concurrent (threadDelay)
 import           Control.Exception
 import           Control.Monad
 import           Control.Monad.Extra
@@ -48,11 +50,12 @@ import           GHC.Stack (HasCallStack)
 import qualified GHC.Stack as GHC
 import qualified Network.HTTP.Simple as HTTP
 import           RIO ( MonadThrow, throwM)
+import           System.IO (hPutStrLn, stderr)
 import qualified System.Directory as System
 import           System.FilePath.Posix (takeDirectory, (</>))
 
 
-import           Testnet.Blockfrost (blockfrostToGenesis)
+import           Testnet.Blockfrost (BlockfrostParams, blockfrostToGenesis)
 import qualified Testnet.Defaults as Defaults
 import           Testnet.Filepath
 import           Testnet.Process.RunIO (execCli_, liftIOAnnotated)
@@ -102,7 +105,7 @@ getByronGenesisHash
   -> m (KeyMap Aeson.Value)
 getByronGenesisHash path = do
   e <- runExceptT $ readGenesisData path
-  case e of 
+  case e of
     Left err -> throwM $ GenesisReadError path err
     Right (_, genesisHash) -> do
       let genesisHash' = unGenesisHash genesisHash
@@ -141,7 +144,7 @@ getDefaultAlonzoGenesis :: ()
   => MonadThrow m
   => m AlonzoGenesis
 getDefaultAlonzoGenesis =
-  case Defaults.defaultAlonzoGenesis of 
+  case Defaults.defaultAlonzoGenesis of
     Right genesis -> return genesis
     Left err -> throwM err
 
@@ -164,9 +167,9 @@ createSPOGenesisAndFiles
   (TmpAbsolutePath tempAbsPath) =  do
   AnyShelleyBasedEra sbe <- pure cardanoNodeEra
 
-  
+
   let genesisShelleyDir = takeDirectory inputGenesisShelleyFp
-  
+
   liftIOAnnotated $ System.createDirectoryIfMissing True genesisShelleyDir
 
   let -- At least there should be a delegator per DRep
@@ -185,7 +188,7 @@ createSPOGenesisAndFiles
   let conwayGenesis' = Defaults.defaultConwayGenesis
       dijkstraGenesis' = dijkstraGenesisDefaults
 
-  (shelleyGenesis, alonzoGenesis, conwayGenesis, dijkstraGenesis)   
+  (shelleyGenesis, alonzoGenesis, conwayGenesis, dijkstraGenesis)
      <- resolveOnChainParams onChainParams
      (shelleyGenesis', alonzoGenesis', conwayGenesis', dijkstraGenesis')
 
@@ -243,13 +246,21 @@ createSPOGenesisAndFiles
 data BlockfrostParamsError = BlockfrostParamsDecodeError FilePath String
   deriving Show
 
-instance Exception BlockfrostParamsError where 
+instance Exception BlockfrostParamsError where
   displayException (BlockfrostParamsDecodeError fp err) =
     "Failed to decode Blockfrost on-chain parameters from file "
       <> fp
       <> ": "
       <> err
 
+newtype MainnetParamsFetchError = MainnetParamsFetchError SomeException
+  deriving Show
+
+instance Exception MainnetParamsFetchError where
+  displayException (MainnetParamsFetchError exc) =
+    "Failed to fetch mainnet on-chain parameters from GitHub after retries: "
+      <> displayException exc
+
 -- | Resolves different kinds of user-provided on-chain parameters
 -- into a unified, consistent set of Genesis files
 resolveOnChainParams :: ()
@@ -261,15 +272,35 @@ resolveOnChainParams :: ()
  -> m (ShelleyGenesis, AlonzoGenesis, ConwayGenesis, DijkstraGenesis)
 resolveOnChainParams onChainParams geneses = case onChainParams of
 
-  DefaultParams -> do 
+  DefaultParams -> do
     pure geneses
 
   OnChainParamsFile file -> do
     eParams <- eitherDecode <$> liftIOAnnotated (LBS.readFile file)
-    case eParams of 
+    case eParams of
       Right params -> pure $ blockfrostToGenesis geneses params
       Left err -> throwM $ BlockfrostParamsDecodeError file err
 
   OnChainParamsMainnet -> do
-    mainnetParams <- liftIOAnnotated $ HTTP.getResponseBody <$> HTTP.httpJSON mainnetParamsRequest
-    pure $ blockfrostToGenesis geneses mainnetParams
+    blockfrostToGenesis geneses <$> fetchMainnetParams
+  where
+    maxRetries = 3 :: Int
+    retryDelaySec = 2_000_000 -- 2 seconds in microseconds
+    fetchMainnetParams :: (MonadIO m, MonadThrow m) => m BlockfrostParams
+    fetchMainnetParams = go maxRetries
+      where
+        go n = do
+          result <- liftIO $ try @HTTP.HttpException $
+            HTTP.getResponseBody <$> HTTP.httpJSON mainnetParamsRequest
+          case result of
+            Right params -> pure params
+            Left exc
+              | n > 0 -> do
+                  liftIO $ hPutStrLn stderr $
+                    displayException exc
+                    <> "\n\nFailed to fetch mainnet parameters (retrying, "
+                    <> show n <> " attempts left)"
+                  liftIO $ threadDelay retryDelaySec
+                  go (n - 1)
+              | otherwise ->
+                  throwM $ MainnetParamsFetchError (toException exc)

cardano-testnet/src/Testnet/Defaults.hs

@@ -108,13 +108,13 @@ newtype AlonzoGenesisError
   = AlonzoGenErrTooMuchPrecision Rational
   deriving Show
 
-instance Exception AlonzoGenesisError where 
+instance Exception AlonzoGenesisError where
   displayException = Api.docToString . Api.prettyError
 
 
 defaultAlonzoGenesis :: Either AlonzoGenesisError AlonzoGenesis
 defaultAlonzoGenesis = do
-  let genesis = Api.alonzoGenesisDefaults  
+  let genesis = Api.alonzoGenesisDefaults
       prices = Ledger.agPrices genesis
 
   -- double check that prices have correct values - they're set using unsafeBoundedRational in cardano-api
@@ -326,6 +326,9 @@ defaultYamlConfig =
     -- Turn logging on or off
     , ("EnableLogging", Aeson.Bool True)
 
+    -- Configuration for the node's P2P network topology
+    , ("EnableP2P", Aeson.Bool True)
+
     -- Genesis filepaths
     , ("ByronGenesisFile", genesisPath ByronEra)
     , ("ShelleyGenesisFile", genesisPath ShelleyEra)

cardano-testnet/src/Testnet/Filepath.hs

@@ -38,11 +38,12 @@ newtype TmpAbsolutePath = TmpAbsolutePath
 instance Display TmpAbsolutePath where
   textDisplay = fromString . unTmpAbsPath
 
-makeTmpRelPath :: TmpAbsolutePath -> FilePath
-makeTmpRelPath (TmpAbsolutePath fp) = makeRelative (makeTmpBaseAbsPath (TmpAbsolutePath fp)) fp
-
 makeSocketDir :: TmpAbsolutePath -> FilePath
-makeSocketDir fp = makeTmpRelPath fp </> "socket"
+makeSocketDir (TmpAbsolutePath fp) =
+  let relPath = makeRelative (takeDirectory fp) fp
+  in if relPath == "."
+     then "socket"
+     else relPath </> "socket"
 
 makeTmpBaseAbsPath :: TmpAbsolutePath -> FilePath
 makeTmpBaseAbsPath (TmpAbsolutePath fp) = addTrailingPathSeparator $ takeDirectory fp

cardano-testnet/test/cardano-testnet-golden/files/golden/node_default_config.json

@@ -5,6 +5,7 @@
     "DijkstraGenesisFile": "dijkstra-genesis.json",
     "EnableLogMetrics": false,
     "EnableLogging": true,
+    "EnableP2P": true,
     "ExperimentalHardForksEnabled": true,
     "ExperimentalProtocolsEnabled": true,
     "LastKnownBlockVersion-Alt": 0,