Add socket option to local-cluster

cardano-foundation · May 3, 2024 · de68a6c · de68a6c
1 parent 2436f12
commit de68a6c
Show file tree

Hide file tree

Showing 16 changed files with 421 additions and 277 deletions.
diff --git a/justfile b/justfile
@@ -29,9 +29,12 @@ bench target:
 
 # run a local test cluster
 local-cluster:
-  nix shell '.#local-cluster' '.#cardano-node' '.#cardano-wallet' \
+  nix shell '.#local-cluster' '.#cardano-node' \
     -c "local-cluster" \
-    --cluster-configs lib/local-cluster/test/data/cluster-configs
+    control \
+    --cluster-configs lib/local-cluster/test/data/cluster-configs \
+    --cluster-logs ignore-me/cluster.logs \
+    --socket-path ignore-me/cluster.socket
 
 # run unit tests on a match
 unit-tests-cabal-match match:

diff --git a/lib/benchmarks/cardano-wallet-benchmarks.cabal b/lib/benchmarks/cardano-wallet-benchmarks.cabal
@@ -52,6 +52,7 @@ library
     , criterion-measurement
     , deepseq
     , directory
+    , extra
     , faucet
     , filepath
     , fmt
@@ -64,6 +65,7 @@ library
     , local-cluster
     , mtl
     , optparse-applicative
+    , pathtype
     , resourcet
     , say
     , servant-client
@@ -133,6 +135,7 @@ benchmark latency
     , cardano-wallet-primitive
     , directory
     , exceptions
+    , extra
     , faucet
     , filepath
     , fmt

diff --git a/lib/benchmarks/exe/latency-bench.hs b/lib/benchmarks/exe/latency-bench.hs
@@ -94,6 +94,7 @@ import Cardano.Wallet.Launch.Cluster.CommandLine
     )
 import Cardano.Wallet.Launch.Cluster.FileOf
     ( DirOf (..)
+    , FileOf (..)
     , mkRelDirOf
     , newAbsolutizer
     , toFilePath
@@ -203,12 +204,16 @@ import System.Directory
 import System.Environment.Extended
     ( isEnvSet
     )
+import System.IO.Extra
+    ( withTempFile
+    )
 import System.IO.Temp.Extra
     ( SkipCleanup (..)
     , withSystemTempDir
     )
 import System.Path
     ( absDir
+    , absFile
     , relDir
     , (</>)
     )
@@ -654,30 +659,32 @@ withShelleyServer tracers action = withFaucet $ \faucetClientEnv -> do
                     $ Just
                     $ mkRelDirOf
                     $ Cluster.clusterEraToString clusterEra
-            let clusterConfig =
-                    Cluster.Config
-                        { cfgStakePools = pure (NE.head defaultPoolConfigs)
-                        , cfgLastHardFork = clusterEra
-                        , cfgNodeLogging
-                        , cfgClusterDir = DirOf testDir
-                        , cfgClusterConfigs = clusterConfigsDir
-                        , cfgTestnetMagic
-                        , cfgShelleyGenesisMods =
-                            [ over #sgSlotLength (const 0.2)
-                            , -- to avoid "PastHorizonException" errors, as wallet
-                              -- doesn't keep up with retrieving fresh time interpreter.
-                              over #sgSecurityParam (const 100)
-                              -- when it low then cluster is not making blocks;
-                            ]
-                        , cfgTracer = stdoutTextTracer
-                        , cfgNodeOutputFile = Nothing
-                        , cfgRelayNodePath = mkRelDirOf "relay"
-                        , cfgClusterLogFile = Nothing
-                        }
-            withCluster
-                clusterConfig
-                faucetFunds
-                (onClusterStart cfgTestnetMagic setupAction db)
+            withTempFile $ \socket -> do
+                let clusterConfig =
+                        Cluster.Config
+                            { cfgStakePools = pure (NE.head defaultPoolConfigs)
+                            , cfgLastHardFork = clusterEra
+                            , cfgNodeLogging
+                            , cfgClusterDir = DirOf testDir
+                            , cfgClusterConfigs = clusterConfigsDir
+                            , cfgTestnetMagic
+                            , cfgShelleyGenesisMods =
+                                [ over #sgSlotLength (const 0.2)
+                                , -- to avoid "PastHorizonException" errors, as wallet
+                                  -- doesn't keep up with retrieving fresh time interpreter.
+                                  over #sgSecurityParam (const 100)
+                                  -- when it low then cluster is not making blocks;
+                                ]
+                            , cfgTracer = stdoutTextTracer
+                            , cfgNodeOutputFile = Nothing
+                            , cfgRelayNodePath = mkRelDirOf "relay"
+                            , cfgClusterLogFile = Nothing
+                            , cfgNodeToClientSocket = FileOf $ absFile socket
+                            }
+                withCluster
+                    clusterConfig
+                    faucetFunds
+                    (onClusterStart cfgTestnetMagic setupAction db)
 
     onClusterStart testnetMagic setupAction db node = do
         let (RunningNode conn genesisData vData) = node
@@ -722,7 +729,7 @@ parseCommandLineOptions = do
     absolutizer <- newAbsolutizer
     O.execParser
         $ O.info
-            (fmap CommandLineOptions (clusterConfigsDirParser absolutizer)
+            ( fmap CommandLineOptions (clusterConfigsDirParser absolutizer)
                 <**> O.helper
             )
             (O.progDesc "Cardano Wallet's Latency Benchmark")
diff --git a/lib/benchmarks/src/Cardano/Wallet/BenchShared.hs b/lib/benchmarks/src/Cardano/Wallet/BenchShared.hs
@@ -1,6 +1,7 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE PackageImports #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
@@ -10,19 +11,17 @@
 --
 -- Restore benchmark CLI handling and setup functions which are shared between
 -- backends.
-
 module Cardano.Wallet.BenchShared
     ( -- * CLI Parser
       RestoreBenchArgs (..)
     , getRestoreBenchArgs
     , argsNetworkDir
 
-    -- * Main function
+      -- * Main function
     , execBenchWithNode
-
     , initBenchmarkLogging
 
-    -- * Benchmark runner
+      -- * Benchmark runner
     , runBenchmarks
     , bench
     , Time
@@ -53,7 +52,9 @@ import Cardano.Launcher
 import Cardano.Launcher.Node
     ( CardanoNodeConfig (..)
     , CardanoNodeConn
+    , MaybeK (..)
     , NodePort (..)
+    , Presence (..)
     , cardanoNodeConn
     , withCardanoNode
     )
@@ -98,8 +99,7 @@ import Fmt
 import GHC.Generics
     ( Generic
     )
--- See ADP-1910
-import "optparse-applicative" Options.Applicative
+import Options.Applicative
     ( HasValue
     , Mod
     , Parser
@@ -135,6 +135,9 @@ import System.Exit
 import System.FilePath
     ( (</>)
     )
+import System.IO.Extra
+    ( withTempFile
+    )
 import Test.Utils.Startup
     ( withNoBuffering
     )
@@ -175,16 +178,20 @@ execBenchWithNode networkConfig action = withNoBuffering $ do
             pure ExitSuccess
         Nothing -> do
             res <- try $ withNetworkConfiguration args $ \nodeConfig ->
-                withCardanoNode (trMessageText tr) nodeConfig $
-                    action tr (networkConfig args)
+                withCardanoNode (trMessageText tr) nodeConfig
+                    $ \(JustK socket) -> action tr (networkConfig args) socket
             case res of
                 Left (exited :: ProcessHasExited) -> do
-                    sayErr $ "FAIL: cardano-node exited with status "
-                        <> toText exited
+                    sayErr
+                        $ "FAIL: cardano-node exited with status "
+                            <> toText exited
                     pure $ ExitFailure 1
                 Right _ -> pure ExitSuccess
 
-withNetworkConfiguration :: RestoreBenchArgs -> (CardanoNodeConfig -> IO a) -> IO a
+withNetworkConfiguration
+    :: RestoreBenchArgs
+    -> (CardanoNodeConfig 'Present -> IO a)
+    -> IO a
 withNetworkConfiguration args action = do
     -- Temporary directory for storing socket and node database
     let withNodeDir cb = case argNodeDatabaseDir args of
@@ -195,21 +202,25 @@ withNetworkConfiguration args action = do
 
     let networkDir = argsNetworkDir args
     port <- fromIntegral <$> getRandomPort
-    withNodeDir $ \dir -> action CardanoNodeConfig
-        { nodeDir          = dir
-        , nodeConfigFile   = networkDir </> "config.json"
-        , nodeDatabaseDir  = fromMaybe "db" (argNodeDatabaseDir args)
-        , nodeDlgCertFile  = Nothing
-        , nodeSignKeyFile  = Nothing
-        , nodeTopologyFile = networkDir </> "topology.json"
-        , nodeOpCertFile   = Nothing
-        , nodeKesKeyFile   = Nothing
-        , nodeVrfKeyFile   = Nothing
-        , nodePort         = Just (NodePort port)
-        , nodeLoggingHostname = Nothing
-        , nodeExecutable   = Nothing
-        , nodeOutputFile   = Nothing
-        }
+    withNodeDir $ \dir ->
+        withTempFile $ \socket -> do
+            action
+                CardanoNodeConfig
+                    { nodeDir = dir
+                    , nodeConfigFile = networkDir </> "config.json"
+                    , nodeDatabaseDir = fromMaybe "db" (argNodeDatabaseDir args)
+                    , nodeDlgCertFile = Nothing
+                    , nodeSignKeyFile = Nothing
+                    , nodeTopologyFile = networkDir </> "topology.json"
+                    , nodeOpCertFile = Nothing
+                    , nodeKesKeyFile = Nothing
+                    , nodeVrfKeyFile = Nothing
+                    , nodePort = Just (NodePort port)
+                    , nodeLoggingHostname = Nothing
+                    , nodeExecutable = Nothing
+                    , nodeOutputFile = Nothing
+                    , nodeSocketPathFile = JustK socket
+                    }
 
 argsNetworkDir :: RestoreBenchArgs -> FilePath
 argsNetworkDir args = argConfigsDir args </> argNetworkName args
@@ -224,63 +235,82 @@ data RestoreBenchArgs = RestoreBenchArgs
     , argNodeDatabaseDir :: Maybe FilePath
     , argUseAlreadyRunningNodeSocketPath :: Maybe CardanoNodeConn
     , argQuiet :: Bool
-    } deriving (Show, Eq)
+    }
+    deriving (Show, Eq)
 
 restoreBenchArgsParser
     :: Maybe String
     -> Maybe FilePath
     -> Maybe FilePath
     -> Maybe CardanoNodeConn
     -> Parser RestoreBenchArgs
-restoreBenchArgsParser envNetwork envConfigsDir envNodeDatabaseDir envNodeSocket = RestoreBenchArgs
-    <$> strArgument
-        ( metavar "NETWORK"
-          <> envDefault "NETWORK" envNetwork
-          <> help "Blockchain to use. Defaults to $NETWORK.")
-    <*> strOption
-        ( long "cardano-node-configs"
-          <> short 'c'
-          <> metavar "DIR"
-          <> envDefault "CARDANO_NODE_CONFIGS" envConfigsDir
-          <> help "Directory containing configurations for each network. \
-              \This must contain a subdirectory corresponding to NETWORK, \
-              \which has the files configuration.json and topology.json.")
-    <*> optional (strOption
-        ( long "node-db"
-          <> metavar "DB"
-          <> envDefault "NODE_DB" envNodeDatabaseDir
-          <> help "Directory to put cardano-node state. Defaults to $NODE_DB, \
-              \falls back to temporary directory"))
-    <*> optional (option (eitherReader cardanoNodeConn)
-        ( long "running-node"
-          <> metavar "SOCKET"
-          <> envDefault "CARDANO_NODE_SOCKET_PATH" envNodeSocket
-          <> help "Path to the socket of an already running cardano-node. \
-              \Also set by $CARDANO_NODE_SOCKET_PATH. If not set, cardano-node \
-              \will automatically be started."))
-    <*> switch
-        ( long ("quiet")
-          <> help "Reduce unnecessary log output.")
+restoreBenchArgsParser envNetwork envConfigsDir envNodeDatabaseDir envNodeSocket =
+    RestoreBenchArgs
+        <$> strArgument
+            ( metavar "NETWORK"
+                <> envDefault "NETWORK" envNetwork
+                <> help "Blockchain to use. Defaults to $NETWORK."
+            )
+        <*> strOption
+            ( long "cardano-node-configs"
+                <> short 'c'
+                <> metavar "DIR"
+                <> envDefault "CARDANO_NODE_CONFIGS" envConfigsDir
+                <> help
+                    "Directory containing configurations for each network. \
+                    \This must contain a subdirectory corresponding to NETWORK, \
+                    \which has the files configuration.json and topology.json."
+            )
+        <*> optional
+            ( strOption
+                ( long "node-db"
+                    <> metavar "DB"
+                    <> envDefault "NODE_DB" envNodeDatabaseDir
+                    <> help
+                        "Directory to put cardano-node state. Defaults to $NODE_DB, \
+                        \falls back to temporary directory"
+                )
+            )
+        <*> optional
+            ( option
+                (eitherReader cardanoNodeConn)
+                ( long "running-node"
+                    <> metavar "SOCKET"
+                    <> envDefault "CARDANO_NODE_SOCKET_PATH" envNodeSocket
+                    <> help
+                        "Path to the socket of an already running cardano-node. \
+                        \Also set by $CARDANO_NODE_SOCKET_PATH. If not set, cardano-node \
+                        \will automatically be started."
+                )
+            )
+        <*> switch
+            ( long ("quiet")
+                <> help "Reduce unnecessary log output."
+            )
   where
     envDefault :: HasValue f => String -> Maybe a -> Mod f a
-    envDefault name env = showDefaultWith (const ('$':name))
-        <> maybe mempty value env
+    envDefault name env =
+        showDefaultWith (const ('$' : name))
+            <> maybe mempty value env
 
 -- Add fallback environment variables to parsed args. These are set by
 -- `nix/haskell.nix` or `./buildkite/bench-restore.sh` or manually.
 getRestoreBenchArgsParser :: IO (Parser RestoreBenchArgs)
-getRestoreBenchArgsParser = restoreBenchArgsParser
-    <$> lookupEnv' "NETWORK"
-    <*> lookupEnv' "CARDANO_NODE_CONFIGS"
-    <*> lookupEnv' "NODE_DB"
-    <*> parseEnv cardanoNodeConn "CARDANO_NODE_SOCKET"
+getRestoreBenchArgsParser =
+    restoreBenchArgsParser
+        <$> lookupEnv' "NETWORK"
+        <*> lookupEnv' "CARDANO_NODE_CONFIGS"
+        <*> lookupEnv' "NODE_DB"
+        <*> parseEnv cardanoNodeConn "CARDANO_NODE_SOCKET"
   where
-    lookupEnv' k = lookupEnv k <&> \case
-        Just "" -> Nothing
-        Just v -> Just v
-        Nothing -> Nothing
+    lookupEnv' k =
+        lookupEnv k <&> \case
+            Just "" -> Nothing
+            Just v -> Just v
+            Nothing -> Nothing
     parseEnv p k = lookupEnv' k >>= traverse (either exit pure . p)
-        where exit err = die (k ++ ": " ++ err)
+      where
+        exit err = die (k ++ ": " ++ err)
 
 getRestoreBenchArgs :: IO RestoreBenchArgs
 getRestoreBenchArgs = do
@@ -293,7 +323,8 @@ getRestoreBenchArgs = do
 
 newtype Time = Time
     { unTime :: Double
-    } deriving (Show, Generic)
+    }
+    deriving (Show, Generic)
 
 instance Buildable Time where
     build = build . secs . unTime