Commit 9d854fec authored by Valentin Reis's avatar Valentin Reis

Refactoring the library and adding withAsyng use.

parent 49d75195
Pipeline #4650 passed with stage
in 27 seconds
......@@ -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
......@@ -18,9 +18,11 @@ 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 hiding (empty)
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 +34,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 +85,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 +104,20 @@ 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 $ sh $ view $ inprocWithErr "daemon" (dargs ++ ["--nrm_log", Data.Text.pack $ (encodeString nrm_log)]) empty
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 )
......@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment