Skip to content
Permalink
Browse files

Add Launcher

  • Loading branch information...
Anviking committed Mar 14, 2019
1 parent 4603d0f commit 2b1507725c648bbe7286f42ef154d1ffc44d3bff
Showing with 183 additions and 0 deletions.
  1. +72 −0 app/launcher/Launcher.hs
  2. +86 −0 app/launcher/Main.hs
  3. +25 −0 cardano-wallet.cabal
@@ -0,0 +1,72 @@
module Launcher where

import Control.Concurrent.Async
( forConcurrently )
import Control.Exception
( Exception, throwIO, try )
import GHC.IO.Handle
( Handle )
import Prelude
import System.Exit
( ExitCode )
import System.Process
( ProcessHandle
, cleanupProcess
, createProcess
, interruptProcessGroupOf
, proc
, waitForProcess
)

-- |
-- Copyright: © 2018-2019 IOHK
-- License: MIT
--
-- This module contains a mechanism for launching external processes together,
-- and provides the functionality needed to kill them all if one goes down.
-- (would be achieved using @monitor@ and @kill@ in combination)

data Command = Command
{ cmdName :: String
, cmdArgs :: [String]
}

data RunningProcess = RunningProcess
{ rpCommand :: Command
, rpHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
}

-- | ProcessHasExited is used by a monitoring thread to signal that the process
-- has exited.
data ProcessHasExited = ProcessHasExited String ExitCode
deriving Show

instance Exception ProcessHasExited

getProcessHandle :: RunningProcess -> ProcessHandle
getProcessHandle p = let (_,_,_,ph) = rpHandles p in ph

launch :: [Command] -> IO [RunningProcess]
launch = mapM (\c -> RunningProcess c <$> run c)
where
run (Command name args) = createProcess $ proc name args

-- | 
monitor :: [RunningProcess] -> IO ProcessHasExited
monitor running = do
r <- try $ forConcurrently running supervise
case r of
Left e -> return e
Right _
-> error "Unreachable. Supervising threads should never finish.\
\ They should stay running or throw @ProcessHasExited@."

supervise :: RunningProcess -> IO ()
supervise p@(RunningProcess (Command name _args) _) = do
code <- waitForProcess (getProcessHandle p)
throwIO $ ProcessHasExited name code

kill :: RunningProcess -> IO ()
kill p = do
interruptProcessGroupOf (getProcessHandle p)
cleanupProcess $ rpHandles p
@@ -0,0 +1,86 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-}

module Main where

import CLI
( Decodable (decode), Encodable (encode), Network, Port (..), getArg )
import Control.Monad
( forM_, when )
import Launcher
( Command (Command)
, ProcessHasExited (ProcessHasExited)
, kill
, launch
, monitor
)
import Prelude
import System.Console.Docopt
( Docopt, docopt, exitWithUsage, isPresent, longOption, parseArgsOrExit )
import System.Environment
( getArgs )
import System.Exit
( exitWith )

-- | Command-Line Interface specification. See http://docopt.org/
cli :: Docopt
cli = [docopt|
cardano-wallet-launcher

Start the cardano wallet along with its API and underlying node.

Requires cardano-http-bridge. To install, follow instructions at
https://github.com/input-output-hk/cardano-http-bridge, and run
cargo install --path .
in the directory.


Usage:
cardano-wallet-launcher [options]
cardano-wallet-launcher --help

Options:
--wallet-server-port <PORT> port used for serving the wallet API [default: 8090]
--node-port <PORT> port used for node-wallet communication [default: 8080]
--network <NETWORK> mainnet or testnet [default: mainnet]
|]



main :: IO ()
main = do
args <- parseArgsOrExit cli =<< getArgs
when (args `isPresent` (longOption "help")) $ exitWithUsage cli
let getArg' = getArg args cli

nodePort <- getArg' (longOption "node-port") decode
walletPort <- getArg' (longOption "wallet-server-port") decode
network <- getArg' (longOption "network") decode

putStrLn $
"Starting wallet on port " ++ (encode walletPort) ++
",\n connecting to node on port " ++ (encode nodePort)

running <- launch
[ nodeHttpBridgeOn nodePort network
, walletOn walletPort nodePort network
, Command "./app/launcher/mock/node-exit-0.sh" []
]

(ProcessHasExited name code) <- monitor running
putStrLn $ name <> " exited with code " <> show code 
forM_ running kill
exitWith code

nodeHttpBridgeOn :: Port "Node" -> Network -> Command
nodeHttpBridgeOn port _network = Command
"cardano-http-bridge"
["start", "--port", encode port]


walletOn :: Port "Wallet" -> Port "Node" -> Network -> Command
walletOn wp np net = Command
"cardano-wallet-server"
["--wallet-server-port", encode wp,
"--node-port", encode np,
"--network", encode net]
@@ -99,6 +99,31 @@ executable cardano-wallet-server
main-is:
Main.hs

executable cardano-wallet-launcher
default-language:
Haskell2010
default-extensions:
NoImplicitPrelude
OverloadedStrings
ghc-options:
-threaded -rtsopts
-Wall
-O2
build-depends:
async
, base
, docopt
, process
hs-source-dirs:
app/launcher
app/cli
other-modules:
CLI
Launcher
main-is:
Main.hs


executable cardano-generate-mnemonic
default-language:
Haskell2010

0 comments on commit 2b15077

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