Set CARDANO_NODE_SOCKET_PATH only in child processes

Using the global environment variable CARDANO_NODE_SOCKET_PATH caused
problems when setting up multiple test clusters in one process.

So now the socket path is passed only to the cardano-cli commands
which need it.

The bulk of this change is using the CardanoNodeConn newtype
everywhere, so that FilePath arguments don't get mixed up.

Then, the `cli` function calls needed to be modified to set
CARDANO_NODE_SOCKET_PATH in the child process environment, if
needed. Since I was changing them all anyway, I thought we may as well
use typed-process, which is better and safer than process.

lib/core-integration/src/Cardano/Wallet/BenchShared.hs

@@ -36,8 +36,9 @@ import Cardano.BM.Trace
     ( Trace, nullTracer )
 import Cardano.Launcher.Node
     ( CardanoNodeConfig (..)
-    , CardanoNodeConn (..)
+    , CardanoNodeConn
     , NodePort (..)
+    , cardanoNodeConn
     , withCardanoNode
     )
 import Cardano.Startup
@@ -68,12 +69,14 @@ import Options.Applicative
     ( HasValue
     , Mod
     , Parser
+    , eitherReader
     , execParser
     , help
     , helper
     , info
     , long
     , metavar
+    , option
     , optional
     , short
     , showDefaultWith
@@ -88,6 +91,8 @@ import System.Directory
     ( createDirectoryIfMissing )
 import System.Environment
     ( lookupEnv )
+import System.Exit
+    ( die )
 import System.FilePath
     ( (</>) )
 import System.IO
@@ -109,7 +114,7 @@ import qualified Cardano.BM.Data.BackendKind as CM
 execBenchWithNode
     :: (RestoreBenchArgs -> cfg)
     -- ^ Get backend-specific network configuration from args
-    -> (Trace IO Text -> cfg -> FilePath -> IO ())
+    -> (Trace IO Text -> cfg -> CardanoNodeConn -> IO ())
     -- ^ Action to run
     -> IO ()
 execBenchWithNode networkConfig action = do
@@ -123,12 +128,12 @@ execBenchWithNode networkConfig action = do
     installSignalHandlers (return ())
 
     case argUseAlreadyRunningNodeSocketPath args of
-        Just socket ->
-            action tr (networkConfig args) socket
+        Just conn ->
+            action tr (networkConfig args) conn
         Nothing -> do
             void $ withNetworkConfiguration args $ \nodeConfig ->
-                withCardanoNode (trMessageText tr) nodeConfig $ \cp ->
-                    action tr (networkConfig args) (nodeSocketFile cp)
+                withCardanoNode (trMessageText tr) nodeConfig $
+                    action tr (networkConfig args)
 
 withNetworkConfiguration :: RestoreBenchArgs -> (CardanoNodeConfig -> IO a) -> IO a
 withNetworkConfiguration args action = do
@@ -166,16 +171,17 @@ data RestoreBenchArgs = RestoreBenchArgs
     { argNetworkName :: String
     , argConfigsDir :: FilePath
     , argNodeDatabaseDir :: Maybe FilePath
-    , argUseAlreadyRunningNodeSocketPath :: Maybe FilePath
+    , argUseAlreadyRunningNodeSocketPath :: Maybe CardanoNodeConn
     , argQuiet :: Bool
     } deriving (Show, Eq)
 
 restoreBenchArgsParser
     :: Maybe String
     -> Maybe FilePath
     -> Maybe FilePath
+    -> Maybe CardanoNodeConn
     -> Parser RestoreBenchArgs
-restoreBenchArgsParser envNetwork envConfigsDir envNodeDatabaseDir = RestoreBenchArgs
+restoreBenchArgsParser envNetwork envConfigsDir envNodeDatabaseDir envNodeSocket = RestoreBenchArgs
     <$> strArgument
         ( metavar "NETWORK"
           <> envDefault "NETWORK" envNetwork
@@ -194,12 +200,12 @@ restoreBenchArgsParser envNetwork envConfigsDir envNodeDatabaseDir = RestoreBenc
           <> envDefault "NODE_DB" envNodeDatabaseDir
           <> help "Directory to put cardano-node state. Defaults to $NODE_DB, \
               \falls back to temporary directory"))
-    <*> optional (strOption
+    <*> optional (option (eitherReader cardanoNodeConn)
         ( long "running-node"
           <> metavar "SOCKET"
-          <> envDefault "CARDANO_NODE_SOCKET" envNodeDatabaseDir
+          <> envDefault "CARDANO_NODE_SOCKET_PATH" envNodeSocket
           <> help "Path to the socket of an already running cardano-node. \
-                  \Also set by $CARDANO_NODE_SOCKET. If not set, cardano-node \
+              \Also set by $CARDANO_NODE_SOCKET_PATH. If not set, cardano-node \
               \will automatically be started."))
     <*> switch
         ( long ("quiet")
@@ -216,11 +222,14 @@ 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
+    parseEnv p k = lookupEnv' k >>= traverse (either exit pure . p)
+        where exit err = die (k ++ ": " ++ err)
 
 getRestoreBenchArgs :: IO RestoreBenchArgs
 getRestoreBenchArgs = do

lib/launcher/src/Cardano/Launcher/Node.hs

@@ -6,11 +6,17 @@
 -- Provides a function to launch @cardano-node@.
 
 module Cardano.Launcher.Node
-    ( withCardanoNode
+    ( -- * Startup
+      withCardanoNode
     , CardanoNodeConfig (..)
     , defaultCardanoNodeConfig
-    , CardanoNodeConn (..)
     , NodePort (..)
+
+      -- * cardano-node Snockets
+    , CardanoNodeConn
+    , cardanoNodeConn
+    , nodeSocketFile
+    , isWindows
     ) where
 
 import Prelude
@@ -19,21 +25,59 @@ import Cardano.Launcher
     ( LauncherLog, ProcessHasExited, withBackendCreateProcess )
 import Control.Tracer
     ( Tracer (..) )
+import Data.Bifunctor
+    ( first )
+import Data.List
+    ( isPrefixOf )
 import Data.Maybe
     ( maybeToList )
+import Data.Text.Class
+    ( FromText (..), TextDecodingError (..), ToText (..) )
 import System.Environment
     ( getEnvironment )
 import System.FilePath
-    ( takeFileName, (</>) )
+    ( isValid, takeFileName, (</>) )
 import System.Info
     ( os )
 import UnliftIO.Process
     ( CreateProcess (..), proc )
 
+import qualified Data.Text as T
+
 -- | Parameters for connecting to the node.
-newtype CardanoNodeConn = CardanoNodeConn
-    { nodeSocketFile :: FilePath
-    } deriving (Show, Eq)
+newtype CardanoNodeConn = CardanoNodeConn FilePath
+    deriving (Show, Eq)
+
+-- | Gets the socket filename or pipe name from 'CardanoNodeConn'. Whether it's
+-- a unix socket or named pipe depends on the value of 'isWindows'.
+nodeSocketFile :: CardanoNodeConn -> FilePath
+nodeSocketFile (CardanoNodeConn name) = name
+
+-- | Produces a 'CardanoNodeConn' if the socket path or pipe name (depending on
+-- 'isWindows') is valid.
+cardanoNodeConn :: FilePath -> Either String CardanoNodeConn
+cardanoNodeConn name
+    | isWindows = if isValidWindowsPipeName name
+        then Right $ CardanoNodeConn name
+        else Left "Invalid pipe name."
+    | otherwise = if isValid name
+        then Right $ CardanoNodeConn name
+        else Left "Invalid file path."
+
+isWindows :: Bool
+isWindows = os == "mingw32"
+
+isValidWindowsPipeName :: FilePath -> Bool
+isValidWindowsPipeName name = slashPipe `isPrefixOf` name
+    && isValid (drop (length slashPipe) name)
+  where
+    slashPipe = "\\\\.\\pipe\\"
+
+instance ToText CardanoNodeConn where
+    toText = T.pack . nodeSocketFile
+
+instance FromText CardanoNodeConn where
+    fromText = first TextDecodingError . cardanoNodeConn . T.unpack
 
 newtype NodePort = NodePort { unNodePort :: Int }
     deriving (Show, Eq)

lib/shelley/bench/Latency.hs

@@ -405,16 +405,16 @@ withShelleyServer tracers action = do
             let logCfg = LogFileConfig Error Nothing Error
             let clusterCfg = LocalClusterConfig [] maxBound logCfg
             withCluster nullTracer dir clusterCfg $
-                onClusterStart act dir
+                onClusterStart act dir db
 
-    setupFaucet dir = do
+    setupFaucet conn dir = do
         let encodeAddr = T.unpack . encodeAddress @'Mainnet
         let addresses = map (first encodeAddr) shelleyIntegrationTestFunds
-        sendFaucetFundsTo nullTracer dir addresses
+        sendFaucetFundsTo nullTracer conn dir addresses
 
-    onClusterStart act db (RunningNode socketPath block0 (gp, vData)) = do
+    onClusterStart act dir db (RunningNode conn block0 (np, vData)) = do
         listen <- walletListenFromEnv
-        setupFaucet db
+        setupFaucet conn dir
         serveWallet
             (SomeNetworkDiscriminant $ Proxy @'Mainnet)
             tracers
@@ -425,7 +425,7 @@ withShelleyServer tracers action = do
             listen
             Nothing
             Nothing
-            socketPath
+            conn
             block0
-            (gp, vData)
-            (act gp)
+            (np, vData)
+            (act np)

lib/shelley/bench/Restore.hs

@@ -35,7 +35,7 @@
 -- @
 --      stack bench cardano-wallet:bench:restore
 --          --ba 'mainnet -c $CONFIGURATION_DIR
---          --running-node $SOCKET_PATH
+--          --running-node $CARDANO_NODE_SOCKET_PATH
 -- @
 --
 -- This makes iteration easy, but requires you to have the configuration
@@ -134,7 +134,7 @@ import Cardano.Wallet.Shelley
 import Cardano.Wallet.Shelley.Compatibility
     ( HasNetworkId (..), NodeVersionData, emptyGenesis, fromCardanoBlock )
 import Cardano.Wallet.Shelley.Launch
-    ( NetworkConfiguration (..), parseGenesisData )
+    ( CardanoNodeConn, NetworkConfiguration (..), parseGenesisData )
 import Cardano.Wallet.Shelley.Network
     ( withNetworkLayer )
 import Cardano.Wallet.Shelley.Transaction
@@ -229,7 +229,7 @@ argsNetworkConfig args = case argNetworkName args of
         TestnetConfig (argsNetworkDir args </> "genesis-byron.json")
 
 -- | Run all available benchmarks.
-cardanoRestoreBench :: Trace IO Text -> NetworkConfiguration -> FilePath -> IO ()
+cardanoRestoreBench :: Trace IO Text -> NetworkConfiguration -> CardanoNodeConn -> IO ()
 cardanoRestoreBench tr c socketFile = do
     (SomeNetworkDiscriminant networkProxy, np, vData, _b)
         <- unsafeRunExceptT $ parseGenesisData c
@@ -567,8 +567,7 @@ bench_restoration
         )
     => Proxy n
     -> Tracer IO (BenchmarkLog n)
-    -> FilePath
-       -- ^ Socket path
+    -> CardanoNodeConn  -- ^ Socket path
     -> NetworkParameters
     -> NodeVersionData
     -> Text -- ^ Benchmark name (used for naming resulting files)
@@ -690,7 +689,7 @@ prepareNode
     :: forall n. (NetworkDiscriminantVal n)
     => Tracer IO (BenchmarkLog n)
     -> Proxy n
-    -> FilePath
+    -> CardanoNodeConn
     -> NetworkParameters
     -> NodeVersionData
     -> IO ()

lib/shelley/cardano-wallet.cabal

@@ -80,6 +80,7 @@ library
     , text-class
     , time
     , transformers
+    , typed-process
     , unliftio
     , unliftio-core
     , unordered-containers

lib/shelley/exe/cardano-wallet.hs

@@ -62,6 +62,8 @@ import Cardano.CLI
     , tlsOption
     , withLogging
     )
+import Cardano.Launcher.Node
+    ( CardanoNodeConn )
 import Cardano.Startup
     ( ShutdownHandlerLog
     , installSignalHandlers
@@ -179,7 +181,7 @@ data ServeArgs = ServeArgs
     { _hostPreference :: HostPreference
     , _listen :: Listen
     , _tlsConfig :: Maybe TlsConfiguration
-    , _nodeSocket :: FilePath
+    , _nodeSocket :: CardanoNodeConn
     , _networkConfiguration :: NetworkConfiguration
     , _database :: Maybe FilePath
     , _syncTolerance :: SyncTolerance
@@ -212,7 +214,7 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty
       host
       listen
       tlsConfig
-      nodeSocket
+      conn
       networkConfig
       databaseDir
       sTolerance
@@ -241,7 +243,7 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty
                     listen
                     tlsConfig
                     (fmap Settings poolMetadataFetching)
-                    nodeSocket
+                    conn
                     block0
                     (gp, vData)
                     (beforeMainLoop tr)

lib/shelley/exe/shelley-test-cluster.hs

@@ -208,30 +208,30 @@ main :: IO ()
 main = withLocalClusterSetup $ \dir clusterLogs walletLogs ->
     withLoggingNamed "test-cluster" clusterLogs $ \(_, (_, trCluster)) -> do
         let tr' = contramap MsgCluster $ trMessageText trCluster
-        clusterCfg <- localClusterConfigFromEnv
+        clusterCfg <- localClusterConfigFromEnv Nothing
         withCluster tr' dir clusterCfg $
             whenReady dir (trMessageText trCluster) walletLogs
   where
-    setupFaucet dir trCluster = do
+    setupFaucet dir trCluster socketPath = do
         traceWith trCluster MsgSettingUpFaucet
         let trCluster' = contramap MsgCluster trCluster
         let encodeAddr = T.unpack . encodeAddress @'Mainnet
         let addresses = map (first encodeAddr) shelleyIntegrationTestFunds
         let accts = concatMap genRewardAccounts mirMnemonics
         let rewards = (,Coin $ fromIntegral oneMillionAda) <$> accts
-        sendFaucetFundsTo trCluster' dir addresses
-        moveInstantaneousRewardsTo trCluster' dir rewards
+        sendFaucetFundsTo trCluster' socketPath dir addresses
+        moveInstantaneousRewardsTo trCluster' socketPath dir rewards
 
     whenReady dir trCluster logs (RunningNode socketPath block0 (gp, vData)) =
         withLoggingNamed "cardano-wallet" logs $ \(sb, (cfg, tr)) -> do
-            setupFaucet dir trCluster
+            setupFaucet dir trCluster socketPath
 
             ekgEnabled >>= flip when (EKG.plugin cfg tr sb >>= loadPlugin sb)
 
             let tracers = setupTracers (tracerSeverities (Just Debug)) tr
             let db = dir </> "wallets"
             createDirectory db
-            listen <- walletListenFromEnv Nothing
+            listen <- walletListenFromEnv
 
             prometheusUrl <- (maybe "none"
                     (\(h, p) -> T.pack h <> ":" <> toText @(Port "Prometheus") p)