Review launcher code, folder organization and API options

- allow launcher's command to take a 'setup' action before they're ran
  This allows for the wallet backend to wait a bit before it starts. Or,
  any kind of startup action we may think of, like generating TLS certs,
  etc ...

- review folder organization and tests scripts

- add Buildable intance to 'Command' and use that to format the initial info

- use --http-bridge-port instead of --node-port

.weeder.yaml

@@ -0,0 +1,12 @@
+- package:
+  - name: cardano-wallet
+  - section:
+    - name: exe:cardano-wallet-launcher exe:cardano-wallet-server
+    - message:
+      - name: Module reused between components
+      - module: Cardano.CLI
+  - section:
+    - name: exe:cardano-wallet-launcher test:unit
+    - message:
+      - name: Module reused between components
+      - module: Cardano.Launcher

app/cli/CLI.hs → app/Cardano/CLI.hs

@@ -1,6 +1,19 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE KindSignatures #-}
-module CLI where
+
+-- |
+-- Copyright: © 2018-2019 IOHK
+-- License: MIT
+--
+-- Shared types and helpers for CLI parsing
+
+module Cardano.CLI
+    ( getArg
+    , Port
+    , Network
+    , encode
+    , decode
+    ) where
 
 import GHC.TypeLits
     ( Symbol )
@@ -10,20 +23,12 @@ import System.Console.Docopt
 import Text.Read
     ( readMaybe )
 
-
--- Shared types and helpers for CLI parsing
-
-
 -- | Port number with a tag for describing what it is used for
-newtype Port (tag :: Symbol) = Port
-    { getPort :: Int
-    }
-
+newtype Port (tag :: Symbol) = Port Int
 
 data Network = Mainnet | Testnet
     deriving (Show, Enum)
 
-
 getArg
     :: Arguments
     -> Docopt
@@ -43,7 +48,6 @@ getArg args cli opt decod = do
 class Encodable a where
     encode :: a -> String
 
-
 -- | Decoding command line arguments
 class Decodable a where
     decode :: String -> Either String a

app/Cardano/Launcher.hs

@@ -0,0 +1,78 @@
+-- |
+-- 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)
+
+module Cardano.Launcher
+    ( Command (..)
+    , ProcessHasExited(..)
+    , launch
+    ) where
+
+import Prelude
+
+import Control.Concurrent.Async
+    ( forConcurrently )
+import Control.Exception
+    ( Exception, throwIO, try )
+import Data.List
+    ( isPrefixOf )
+import Fmt
+    ( Buildable (..), blockListF', indentF )
+import System.Exit
+    ( ExitCode )
+import System.Process
+    ( proc, waitForProcess, withCreateProcess )
+
+
+data Command = Command
+    { cmdName :: String
+    , cmdArgs :: [String]
+    , cmdSetup :: IO ()
+        -- ^ An extra action to run _before_ the command
+    }
+
+-- Format a command nicely with one argument / option per line.
+--
+-- e.g.
+--
+-- >>> fmt $ build $ Command "cardano-wallet-server" ["--port", "8080", "--network", "mainnet"] (return ())
+-- cardano-wallet-server
+--     --port 8080
+--     --network mainnet
+instance Buildable Command where
+    build (Command name args _) = build name
+        <> "\n"
+        <> indentF 4 (blockListF' "" build $ snd $ foldl buildOptions ("", []) args)
+      where
+        buildOptions :: (String, [String]) -> String -> (String, [String])
+        buildOptions ("", grp) arg =
+            (arg, grp)
+        buildOptions (partial, grp) arg =
+            if ("--" `isPrefixOf` partial) && not ("--" `isPrefixOf` arg) then
+                ("", grp ++ [partial <> " " <> arg])
+            else
+                (arg, grp ++ [partial])
+
+-- | ProcessHasExited is used by a monitoring thread to signal that the process
+-- has exited.
+data ProcessHasExited = ProcessHasExited String ExitCode
+    deriving Show
+
+instance Exception ProcessHasExited
+
+launch :: [Command] -> IO ProcessHasExited
+launch cmds = do
+    res <- try $ forConcurrently cmds $ \(Command name args before) -> do
+        before
+        withCreateProcess (proc name args) $ \_ _ _ h -> do
+            code <- waitForProcess h
+            throwIO $ ProcessHasExited name code
+    case res of
+        Left e -> return e
+        Right _ -> error
+            "Unreachable. Supervising threads should never finish. \
+            \They should stay running or throw @ProcessHasExited@."

app/launcher/Main.hs

@@ -3,25 +3,30 @@
 
 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 Cardano.CLI
+    ( Network, Port, decode, encode, getArg )
+import Cardano.Launcher
+    ( Command (Command), ProcessHasExited (ProcessHasExited), launch )
+import Control.Concurrent
+    ( threadDelay )
+import Control.Monad
+    ( when )
+import Fmt
+    ( blockListF, fmt )
+import Say
+    ( sayErr )
 import System.Console.Docopt
     ( Docopt, docopt, exitWithUsage, isPresent, longOption, parseArgsOrExit )
 import System.Environment
     ( getArgs )
 import System.Exit
     ( exitWith )
 
+import qualified Data.Text as T
+
+
 -- | Command-Line Interface specification. See http://docopt.org/
 cli :: Docopt
 cli = [docopt|
@@ -34,53 +39,50 @@ 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]
+  --wallet-server-port <PORT>  port used for serving the wallet API [default: 8090]
+  --http-bridge-port <PORT>    port used for communicating with the http-bridge [default: 8080]
 |]
 
-
-
 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
+    bridgePort <- getArg args cli (longOption "http-bridge-port") decode
+    walletPort <- getArg args cli (longOption "wallet-server-port") decode
+    network <- getArg args cli (longOption "network") decode
+
+    sayErr "Starting..."
+    let commands =
+            [ nodeHttpBridgeOn bridgePort
+            , walletOn walletPort bridgePort network
+            ]
+    sayErr $ fmt $ blockListF commands
+    (ProcessHasExited name code) <- launch commands
+    sayErr $ T.pack name <> " exited with code " <> T.pack (show code) 
     exitWith code
 
-nodeHttpBridgeOn :: Port "Node" -> Network -> Command
-nodeHttpBridgeOn port _network = Command
+nodeHttpBridgeOn :: Port "Node" -> Command
+nodeHttpBridgeOn port = Command
     "cardano-http-bridge"
-    ["start", "--port", encode port]
-
+    [ "start"
+    , "--port", encode port
+    ]
+    (return ())
 
 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]
+    [ "--wallet-server-port", encode wp
+    , "--http-bridge-port", encode np
+    , "--network", encode net
+    ]
+    (threadDelay oneSecond)
+  where
+    oneSecond = 1000000