Use a record to pass around handles for local-cluster processes

lib/launcher/src/Cardano/Launcher.hs

@@ -16,6 +16,7 @@
 
 module Cardano.Launcher
     ( Command (..)
+    , ProcessHandles (..)
     , StdStream(..)
     , ProcessHasExited(..)
     , withBackendProcess
@@ -185,6 +186,12 @@ data ProcessHasExited
 
 instance Exception ProcessHasExited
 
+data ProcessHandles = ProcessHandles
+    { inputHandle :: Maybe Handle
+    , outputHandle :: Maybe Handle
+    , errorHandle :: Maybe Handle
+    , processHandle :: ProcessHandle
+    }
 -- | Starts a command in the background and then runs an action. If the action
 -- finishes (through an exception or otherwise) then the process is terminated
 -- (see 'withCreateProcess') for details. If the process exits, the action is
@@ -197,7 +204,7 @@ withBackendProcess
     -- ^ Logging
     -> Command
     -- ^ 'Command' description
-    -> (Maybe Handle -> ProcessHandle -> m a)
+    -> (ProcessHandles -> m a)
     -- ^ Action to execute while process is running.
     -> m (Either ProcessHasExited a)
 withBackendProcess tr (Command name args before std_in std_out) action =
@@ -230,7 +237,7 @@ withBackendCreateProcess
     -- ^ Logging
     -> CreateProcess
     -- ^ 'Command' description
-    -> (Maybe Handle -> ProcessHandle -> m a)
+    -> (ProcessHandles -> m a)
     -- ^ Action to execute while process is running.
     -> m (Either ProcessHasExited a)
 withBackendCreateProcess tr process action = do
@@ -239,7 +246,7 @@ withBackendCreateProcess tr process action = do
     res <- fmap join $ tryJust spawnPredicate $ bracket
         (createProcess process)
         (cleanupProcessAndWait (readMVar exitVar)) $
-            \(mstdin, _, _, ph) -> do
+            \(mstdin, mstdout, mstderr, ph) -> do
                 pid <- maybe "-" (T.pack . show) <$> liftIO (getPid ph)
                 let tr' = contramap (WithProcessInfo name pid) tr
                 let tr'' = contramap MsgLauncherWait tr'
@@ -248,7 +255,7 @@ withBackendCreateProcess tr process action = do
                 race (ProcessHasExited name <$> readMVar exitVar) $ bracket_
                     (traceWith tr' MsgLauncherAction)
                     (traceWith tr' MsgLauncherActionDone)
-                    (action mstdin ph)
+                    (action $ ProcessHandles mstdin mstdout mstderr ph)
 
     traceWith tr $ MsgLauncherFinish (leftToMaybe res)
     pure res

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

@@ -140,7 +140,7 @@ withCardanoNode tr cfg action = do
     let run output = do
             cp <- cardanoNodeProcess cfg output socketPath
             withBackendCreateProcess tr cp
-                $ \_ _ -> action $ CardanoNodeConn socketPath
+                $ \_ -> action $ CardanoNodeConn socketPath
     case nodeOutputFile cfg of
         Nothing -> run Inherit
         Just file ->

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

@@ -94,7 +94,7 @@ withCardanoWallet
     -> IO (Either ProcessHasExited a)
 withCardanoWallet tr node cfg@CardanoWalletConfig{..} action =
     withBackendCreateProcess tr (cardanoWallet cfg node)
-        $ \_ _ -> action $ CardanoWalletConn walletPort
+        $ \_ -> action $ CardanoWalletConn walletPort
 
 cardanoWallet :: CardanoWalletConfig -> CardanoNodeConn -> CreateProcess
 cardanoWallet CardanoWalletConfig{..} node =

lib/launcher/test/unit/Cardano/LauncherSpec.hs

@@ -38,6 +38,7 @@ import Cardano.BM.Trace
 import Cardano.Launcher
     ( Command (..)
     , LauncherLog
+    , ProcessHandles (..)
     , ProcessHasExited (..)
     , StdStream (..)
     , withBackendProcess
@@ -205,9 +206,10 @@ spec = beforeAll setupMockCommands $ do
     it "Backend process is terminated when Async thread is cancelled" $ \MockCommands{..} -> withTestLogging $ \tr -> do
         pendingOnWine "SYSTEM32 commands not available under wine"
         mvar <- newEmptyMVar
-        let backend = withBackendProcess tr foreverCommand $ \_ ph -> do
-                putMVar mvar ph
-                forever $ threadDelay maxBound
+        let backend = withBackendProcess tr foreverCommand
+                $ \(ProcessHandles _ _ _ ph) -> do
+                    putMVar mvar ph
+                    forever $ threadDelay maxBound
         before <- getCurrentTime
         race_ backend (threadDelay 1000000)
         after <- getCurrentTime
@@ -220,9 +222,10 @@ spec = beforeAll setupMockCommands $ do
     it "Misbehaving backend process is killed when Async thread is cancelled" $ \_ -> withTestLogging $ \tr -> do
         skipOnWindows "Not applicable"
         mvar <- newEmptyMVar
-        let backend = withBackendProcess tr unkillableCommand $ \_ ph -> do
-                putMVar mvar ph
-                forever $ threadDelay maxBound
+        let backend = withBackendProcess tr unkillableCommand
+                $ \(ProcessHandles _ _ _ ph) -> do
+                    putMVar mvar ph
+                    forever $ threadDelay maxBound
         before <- getCurrentTime
         race_ backend (threadDelay 1000000)
         after <- getCurrentTime
@@ -271,7 +274,7 @@ launch :: Tracer IO LauncherLog -> [Command] -> IO ([ProcessHandle], ProcessHasE
 launch tr cmds = do
     phsVar <- newMVar []
     let
-        waitForOthers _ ph = do
+        waitForOthers (ProcessHandles _ _ _ ph) = do
             modifyMVar_ phsVar (pure . (ph:))
             forever $ threadDelay maxBound
         start = async . flip (withBackendProcess tr) waitForOthers

lib/local-cluster/exe/local-cluster.hs

@@ -43,6 +43,9 @@ import Cardano.Wallet.Launch.Cluster.FileOf
 import Cardano.Wallet.Primitive.Types.Coin
     ( Coin (..)
     )
+import Control.Exception
+    ( bracket
+    )
 import Control.Lens
     ( over
     )
@@ -76,8 +79,6 @@ import System.Path
 import UnliftIO.Concurrent
     ( threadDelay
     )
-import Control.Exception (bracket)
-
 
 import qualified Cardano.Node.Cli.Launcher as NC
 import qualified Cardano.Wallet.Cli.Launcher as WC