diff --git a/argotest/argotest.cabal b/argotest/argotest.cabal index 78ab96fa3eb4ebe8fe312c27ae9c1c79fe88be88..c8ebab3c1d527ab889df9eca08b75c98ac5adede 100644 --- a/argotest/argotest.cabal +++ b/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 diff --git a/argotest/src/Argotest.hs b/argotest/src/Argotest.hs index d98ccdfd68332feaa3043821af45168e387579a4..3a650738f9faf3dbda384c8821804f337f807cf6 100644 --- a/argotest/src/Argotest.hs +++ b/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 ) diff --git a/argotk.hs b/argotk.hs index dd6cec13b3773fe0ffebe6fec4d259ab82f8ffde..9f3a234cb7ee01aa9f02cff7f980e3522e53be6c 100755 --- a/argotk.hs +++ b/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