Try #2438:

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

@@ -60,11 +60,14 @@ import Cardano.Wallet.Shelley
 import Cardano.Wallet.Shelley.Faucet
     ( initFaucet )
 import Cardano.Wallet.Shelley.Launch
-    ( RunningNode (..)
+    ( withSystemTempDir )
+import Cardano.Wallet.Shelley.Launch.Cluster
+    ( LocalClusterConfig (..)
+    , LogFileConfig (..)
+    , RunningNode (..)
     , sendFaucetFundsTo
     , walletListenFromEnv
     , withCluster
-    , withSystemTempDir
     )
 import Control.Arrow
     ( first )
@@ -400,22 +403,19 @@ withShelleyServer tracers action = do
     withServer act = withSystemTempDir nullTracer "latency" $ \dir -> do
             let db = dir </> "wallets"
             createDirectory db
-            withCluster
-                nullTracer
-                Error
-                []
-                dir
-                Nothing
-                (onClusterStart act dir)
-
-    setupFaucet dir = do
+            let logCfg = LogFileConfig Error Nothing Error
+            let clusterCfg = LocalClusterConfig [] maxBound logCfg
+            withCluster nullTracer dir clusterCfg $
+                onClusterStart act dir db
+
+    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
@@ -426,7 +426,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
@@ -97,6 +98,7 @@ library
       Cardano.Wallet.Shelley.Network
       Cardano.Wallet.Shelley.Transaction
       Cardano.Wallet.Shelley.Launch
+      Cardano.Wallet.Shelley.Launch.Cluster
       Cardano.Wallet.Shelley.Pools
 
 executable cardano-wallet
@@ -130,7 +132,7 @@ executable cardano-wallet
   main-is:
     cardano-wallet.hs
 
-executable shelley-test-cluster
+executable local-cluster
   default-language:
       Haskell2010
   default-extensions:
@@ -158,7 +160,7 @@ executable shelley-test-cluster
   hs-source-dirs:
       exe
   main-is:
-      shelley-test-cluster.hs
+      local-cluster.hs
 
 test-suite unit
   default-language:
@@ -236,6 +238,7 @@ test-suite integration
     , either
     , filepath
     , hspec
+    , hspec-core
     , http-client
     , iohk-monitoring
     , lobemo-backend-ekg

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)