Skip to content
Permalink
Browse files

Example of using withCreateProcess and race

It will ensure that:
- the subprocess is killed if the main thread dies.
- if the subprocess exits, the main thread will be cancelled.
  • Loading branch information...
rvl committed Mar 15, 2019
1 parent 93e32c4 commit 10e8891f7b96c84a4386a502fd0451396fee09ac
Showing with 30 additions and 5 deletions.
  1. +27 −5 app/server/Main.hs
  2. +3 −0 cardano-wallet.cabal
@@ -22,15 +22,19 @@ import CLI
import Control.Monad
( when )
import Fmt
( build, fmt )
( build, fmt, (+||), (||+), (+|), (|+) )
import System.Console.Docopt
( Docopt, docopt, exitWithUsage, isPresent, longOption, parseArgsOrExit )
import System.Environment
( getArgs )
import System.Process (withCreateProcess, waitForProcess, proc, StdStream(..), CreateProcess(..))
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (race_)
import Say
( say, sayErr, sayString )

import qualified Cardano.NetworkLayer.HttpBridge as HttpBridge
import qualified Data.Text as T
import qualified Data.Text.IO as T

-- | Command-Line Interface specification. See http://docopt.org/
cli :: Docopt
@@ -62,8 +66,26 @@ main = do

--_ <- getArg args (longOption "wallet-server-port") decode

network <- HttpBridge.newNetworkLayer (T.pack . encode $ networkName) nodePort
listen network logBlock
let
httpBridgeExe = "cardano-http-bridge"
httpBridgeArgs = ["start", "--template", encode networkName
, "--port", show nodePort]
httpBridgeProc =
(proc httpBridgeExe httpBridgeArgs)
{ std_in = NoStream, std_out = Inherit, std_err = Inherit }

listenThread = do
threadDelay 1000000 -- wait 1sec for socket to appear
network <- HttpBridge.newNetworkLayer (T.pack . encode $ networkName) nodePort
listen network logBlock

sayString $ "Starting " ++ httpBridgeExe ++ " " ++ unwords httpBridgeArgs
withCreateProcess httpBridgeProc $ \_ _ _ ph -> do
race_ listenThread $ do
status <- waitForProcess ph
sayErr . fmt $ ""+|httpBridgeExe|+" exited with "+||status||+""
say "bye bye"

where
logBlock :: Block -> IO ()
logBlock = T.putStrLn . fmt . build
logBlock = say . fmt . build
@@ -91,6 +91,9 @@ executable cardano-wallet-server
, docopt
, text
, fmt
, process
, async
, say
hs-source-dirs:
app/server
app/cli

0 comments on commit 10e8891

Please sign in to comment.
You can’t perform that action at this time.