Merge branch '1-base-features-stop-if-daemon-dies' into 'master'

Resolve "Base features"

Closes #1

See merge request argo/argotest!8

argotest/argotest.cabal

@@ -19,6 +19,6 @@ library
   exposed-modules: Argotest
   -- other-modules:
   -- other-extensions:
-  build-depends:       base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async
+  build-depends:       base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async, process, text
   hs-source-dirs:      src
   default-language:    Haskell2010

argotest/src/Argotest.hs

@@ -18,9 +18,12 @@ import Control.Concurrent.Async
 import System.Console.ANSI
 import System.Console.ANSI.Types (Color)
 import System.Posix.Signals
+import System.Process hiding (shell)
+import Data.Text as Text hiding (empty)
+import Data.Text.IO as Text
 
 data StackArgs = StackArgs
-  { dargs                :: Text        --"Daemon arguments. Properly quote this."
+  { dargs                :: [Text]        --"Daemon arguments. Properly quote this."
   , app                  :: Text        --"Target application call, sh+path valid"
   , manifest             :: FilePath    --"Input file, manifest."
   , cmd_out              :: FilePath    --"Output file, application stdout"
@@ -32,7 +35,7 @@ data StackArgs = StackArgs
 
 instance Default StackArgs where
   def = StackArgs
-    { dargs = ""
+    { dargs = []
     , app = "echo \"HelloWorld\""
     , manifest = "manifests/basic.json"
     , cmd_out = "cmd_out.log"
@@ -83,10 +86,10 @@ cleanLeftovers daemon_out daemon_err cmd_out cmd_err time_file nrm_log = do
   mapM_ cleanLog [daemon_out, daemon_err, cmd_out, cmd_err, time_file, nrm_log, ".argo_nodeos_config_exit_message"]
   mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]
 
-prepareDaemonShell :: Text -> FilePath -> FilePath -> FilePath -> Shell (Shell ())
+prepareDaemonShell :: [Text] -> FilePath -> FilePath -> FilePath -> Shell (IO ())
 prepareDaemonShell dargs daemon_out daemon_err nrm_log = do
   confPath      <- myWhich "argo_nodeos_config"
-  daemonPath    <- myWhich "daemon"
+  myWhich "daemon"
   tempDirPath   <- mktempdir "/tmp" "argo-expe"
   let confPath' = tempDirPath </> "argo_nodeos_config"
   cp confPath confPath'
@@ -102,9 +105,29 @@ prepareDaemonShell dargs daemon_out daemon_err nrm_log = do
   --Cleaning the config, running the daemon
   shell (format (fp%" --clean_config=kill_content:true") confPath') empty >>= \case
     ExitSuccess   -> printInfo "Cleaned the argo config.\n"
-    ExitFailure n -> do printInfo "Contents of .argo_nodeos_config_exit_message: \n"
-                        view $ cat  ["./argo_nodeos_config_exit_message"]
-                        die ("Clean config failed with exit code " <> repr n)
+    ExitFailure n -> do
+      printError ("argo_nodeos_config failed with exit code :" <> repr n <> "\n" )
+      testfile ".argo_nodeos_config_exit_message" >>= \case
+        True -> do printInfo "Contents of .argo_nodeos_config_exit_message: \n"
+                   view $ input "./argo_nodeos_config_exit_message"
+        False ->  die ("Clean config failed with exit code " <> repr n)
   printInfo $ format ("Running the daemon, main log at "%fp%", stdout at "%fp%", stderr at "%fp%"\n") nrm_log daemon_out daemon_err
   export "ARGO_NODEOS_CONFIG" (format fp confPath')
-  return $ sh $ inshell (format (fp%" "%s%" --nrm_log="%fp%" >"%fp%" 2>"%fp) daemonPath dargs nrm_log daemon_out daemon_err) empty
+  return $ twoWayPrint daemon_out daemon_err $ inprocWithErr "daemon"
+          (dargs ++ ["--nrm_log", Text.pack $ encodeString nrm_log])
+          empty
+
+twoWayPrint :: FilePath -> FilePath -> Shell (Either Line Line) -> IO ()
+twoWayPrint outPath errPath s = sh $ do
+    handleOut <- using (writeonly outPath)
+    handleErr <- using (writeonly errPath)
+    s >>= \case
+      Left out  -> liftIO $ Text.hPutStrLn handleOut (lineToText out)
+      Right err  -> liftIO $ Text.hPutStrLn handleOut (lineToText err)
+
+cmdShell :: FilePath -> Text -> FilePath -> FilePath -> Shell ()
+cmdShell manifest app cmd_out cmd_err =
+  shell (format ("cmd run -u toto "%fp%"  "%s%" > "%fp%" 2>"%fp) manifest app cmd_out cmd_err) empty >>= \case
+  ExitSuccess   -> printInfo "cmd has exited successfuly.\n"
+  ExitFailure n -> die ("cmd failed with exit code " <> repr n <>
+    " . The application logs are at " <> repr cmd_out <> " " <> repr cmd_err )

argotk.hs

@@ -48,31 +48,36 @@ runHelloWorld a@StackArgs{..} = do
 runSimpleStack :: StackArgs -> IO ()
 runSimpleStack a@StackArgs{..} = sh $ do
   cleanLeftovers daemon_out daemon_err cmd_out cmd_err time_file nrm_log
-
   daemonShell <- prepareDaemonShell dargs daemon_out daemon_err nrm_log
-  daemonAsync <- fork $ sh $ daemonShell
-  let handler = do
-                sh $ printInfo "Interrupted. Killing daemon..."
-                cancel daemonAsync
-                sh $ colorShell Green $ printf "Killed daemon.\n"
-  liftIO $ installHandler keyboardSignal (Catch handler) Nothing
+  liftIO $ do
+    withAsync daemonShell $ \daemon -> do
+    let handler = do
+                  sh $ printInfo "Interrupted. Killing daemon..."
+                  cancel daemon
+                  sh $ colorShell Green $ printf "Killed daemon.\n"
+    liftIO $ installHandler keyboardSignal (Catch handler) Nothing
+    withAsync (time $ sh $ cmdShell manifest app cmd_out cmd_err ) $ \cmd -> do
+    let handler = do
+                  sh $ printInfo "Interrupted. Killing daemon..."
+                  cancel daemon
+                  sh $ colorShell Green $ printf "Killed daemon.\n"
+                  sh $ printInfo "Interrupted. Killing cmd..."
+                  cancel cmd
+                  sh $ colorShell Green $ printf "Killed cmd.\n"
+    liftIO $ installHandler keyboardSignal (Catch handler) Nothing
+    (waitEitherCancel daemon cmd >>= \case
+      Left _ -> die "Daemon died"
+      Right (_,t) -> writeTextFile time_file (repr t))
+
 
-  printInfo "Launching the application through cmd.\n"
-  (_,t) <- time $
-    shell (format ("cmd run -u toto "%fp%"  "%s%" > "%fp%" 2>"%fp) manifest app cmd_out cmd_err) empty >>= \case
-      ExitSuccess   -> printInfo "cmd has exited successfuly.\n"
-      ExitFailure n -> die ("cmd failed with exit code " <> repr n <>
-        " . The application logs are at " <> repr cmd_out <> " " <> repr cmd_err )
-  liftIO $ writeTextFile time_file (repr t)
+  -- printInfo "Killing the daemon.\n"
+  -- liftIO $ cancel daemon
+  -- printInfo "Daemon killed.\n"
 
-  printInfo "Killing the daemon.\n"
-  liftIO $ cancel daemonAsync
-  printInfo "Daemon killed.\n"
 
 runClean :: StackArgs -> IO ()
 runClean StackArgs{..} = sh $
   cleanLeftovers daemon_out daemon_err cmd_out cmd_err time_file nrm_log
 
 runDaemon :: StackArgs -> IO ()
-runDaemon StackArgs{..} = sh $
-  prepareDaemonShell dargs daemon_out daemon_err nrm_log >>= id
+runDaemon StackArgs{..} = sh $ prepareDaemonShell dargs daemon_out daemon_err nrm_log >>= liftIO