Skip to content

A
argotest
Commit 746cee22 authored by Valentin Reis's avatar Valentin Reis
Browse files
Options

[feature] Added the `cmd listen` Test.

parent c9580560
Pipeline #4784 passed with stage
    in 41 seconds
    Hide whitespace changes
    Inline Side-by-side
    Showing with 205 additions and 73 deletions
    argo/argo.cabal
    View file @ 746cee22
    ......@@ -12,6 +12,6 @@ library
    exposed-Modules: Argo.Stack
    Argo.Utils
    Argo.Args
    build-depends: base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async, process, text, optparse-applicative, extra, foldl, conduit,conduit-extra, bytestring
    build-depends: base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async, process, text, optparse-applicative, extra, foldl, conduit,conduit-extra, bytestring, stm
    hs-source-dirs: src
    default-language: Haskell2010
    argo/src/Argo/Args.hs
    View file @ 746cee22
    ......@@ -14,6 +14,7 @@ import Turtle
    import Prelude hiding ( FilePath )
    data OutputFiles = OutputFiles FilePath FilePath
    data StackArgs = StackArgs
    { app :: Text
    , args :: [Text]
    ......@@ -21,15 +22,19 @@ data StackArgs = StackArgs
    , workingDirectory :: FilePath
    , manifestDir :: FilePath
    , manifestName :: FilePath
    , cmd_out :: FilePath
    , cmd_err :: FilePath
    , cmd_run_out :: FilePath
    , cmd_run_err :: FilePath
    , cmd_listen_out :: FilePath
    , cmd_listen_err :: FilePath
    , daemon_out :: FilePath
    , daemon_err :: FilePath
    , nrm_log :: FilePath
    , messageDaemonOut :: Maybe Text
    , messageDaemonErr :: Maybe Text
    , messageCmdOut :: Maybe Text
    , messageCmdErr :: Maybe Text
    , messageCmdRunOut :: Maybe Text
    , messageCmdRunErr :: Maybe Text
    , messageCmdListenOut :: Maybe Text
    , messageCmdListenErr :: Maybe Text
    }
    instance Default StackArgs where
    ......@@ -40,15 +45,19 @@ instance Default StackArgs where
    , workingDirectory = "_output"
    , manifestDir = "manifests"
    , manifestName = "basic.json"
    , cmd_out = "cmd_out.log"
    , cmd_err = "cmd_err.log"
    , cmd_run_out = "cmd_run_out.log"
    , cmd_run_err = "cmd_run_err.log"
    , cmd_listen_out = "cmd_listen_out.log"
    , cmd_listen_err = "cmd_listen_err.log"
    , daemon_out = "daemon_out.log"
    , daemon_err = "daemon_err.log"
    , nrm_log = "nrm.log"
    , messageDaemonOut = Nothing
    , messageDaemonErr = Nothing
    , messageCmdOut = Nothing
    , messageCmdErr = Nothing
    , messageCmdRunOut = Nothing
    , messageCmdRunErr = Nothing
    , messageCmdListenOut = Nothing
    , messageCmdListenErr = Nothing
    }
    parseExtendStackArgs :: StackArgs -> Parser StackArgs
    ......@@ -88,19 +97,33 @@ parseExtendStackArgs StackArgs {..} = do
    <> showDefault
    <> value manifestName
    )
    cmd_out <- strOption
    ( long "cmd_out"
    cmd_run_out <- strOption
    ( long "cmd_run_out"
    <> metavar "FILENAME"
    <> help "Output file (relative to --output_dir), application stdout"
    <> help "Output file (relative to --output_dir), \"cmd run\" stdout"
    <> showDefault
    <> value cmd_out
    <> value cmd_run_out
    )
    cmd_err <- strOption
    ( long "cmd_err"
    cmd_run_err <- strOption
    ( long "cmd_run_err"
    <> metavar "FILENAME"
    <> help "Output file (relative to --output_dir), application stderr"
    <> help "Output file (relative to --output_dir), \"cmd run\" stderr"
    <> showDefault
    <> value cmd_err
    <> value cmd_run_err
    )
    cmd_listen_out <- strOption
    ( long "cmd_listen_out"
    <> metavar "FILENAME"
    <> help "Output file (relative to --output_dir), \"cmd listen\" stdout"
    <> showDefault
    <> value cmd_listen_out
    )
    cmd_listen_err <- strOption
    ( long "cmd_listen_err"
    <> metavar "FILENAME"
    <> help "Output file (relative to --output_dir), \"cmd listen\" stderr"
    <> showDefault
    <> value cmd_listen_err
    )
    daemon_out <- strOption
    ( long "daemon_out"
    ......@@ -143,24 +166,44 @@ parseExtendStackArgs StackArgs {..} = do
    <> showDefault
    <> maybe mempty value messageDaemonErr
    )
    messageCmdOut <- optional $ strOption
    ( long "message_cmd_stdout"
    messageCmdRunOut <- optional $ strOption
    ( long "message_cmd_run_stdout"
    <> metavar "STRING"
    <> help
    "The appearance of this character string in the daemon stdout \
    "The appearance of this character string in the cmd run stdout \
    \ will be monitored during execution. When observed, the \
    \ stack will be killed and a return code of 0 will be returned."
    <> showDefault
    <> maybe mempty value messageCmdOut
    <> maybe mempty value messageCmdRunOut
    )
    messageCmdErr <- optional $ strOption
    ( long "message_cmd_stderr"
    messageCmdRunErr <- optional $ strOption
    ( long "message_cmd_run_stderr"
    <> metavar "STRING"
    <> help
    "The appearance of this character string in the daemon stdout \
    "The appearance of this character string in the cmd run stdout \
    \ will be monitored during execution. When observed, the \
    \ stack will be killed and a return code of 0 will be returned."
    <> showDefault
    <> maybe mempty value messageCmdRunErr
    )
    messageCmdListenOut <- optional $ strOption
    ( long "message_cmd_listen_stdout"
    <> metavar "STRING"
    <> help
    "The appearance of this character string in the cmd listen stdout \
    \ will be monitored during execution. When observed, the \
    \ stack will be killed and a return code of 0 will be returned."
    <> showDefault
    <> maybe mempty value messageCmdListenOut
    )
    messageCmdListenErr <- optional $ strOption
    ( long "message_cmd_listen_stderr"
    <> metavar "STRING"
    <> help
    "The appearance of this character string in the cmd listen stdout \
    \ will be monitored during execution. When observed, the \
    \ stack will be killed and a return code of 0 will be returned."
    <> showDefault
    <> maybe mempty value messageCmdErr
    <> maybe mempty value messageCmdListenErr
    )
    pure StackArgs {..}
    argo/src/Argo/Stack.hs
    View file @ 746cee22
    ......@@ -18,7 +18,12 @@ import Prelude hiding ( FilePath )
    import System.IO ( withFile )
    import Debug.Trace
    import Filesystem.Path ( (</>) )
    import Control.Concurrent.Async
    import Control.Monad.STM ( atomically
    , orElse
    )
    import System.Console.ANSI
    import System.Console.ANSI.Types ( Color )
    import Data.Text as T
    ......@@ -62,8 +67,10 @@ cleanLeftovers StackArgs {..} = do
    cleanLog
    [ workingDirectory </> daemon_out
    , workingDirectory </> daemon_err
    , workingDirectory </> cmd_out
    , workingDirectory </> cmd_err
    , workingDirectory </> cmd_run_out
    , workingDirectory </> cmd_run_err
    , workingDirectory </> cmd_listen_out
    , workingDirectory </> cmd_listen_err
    , workingDirectory </> nrm_log
    , workingDirectory </> ".argo_nodeos_config_exit_message"
    , workingDirectory </> "argo_nodeos_config"
    ......@@ -82,8 +89,7 @@ checkFsAttributes StackArgs {..} = do
    ("The output directory, " % fp % ", must not mounted with \"nosuid\"")
    workingDirectory
    prepareDaemon
    :: StackArgs -> Shell (IO (Either PatternMatched (ExitCode, (), ())))
    prepareDaemon :: StackArgs -> Shell Instrumentation
    prepareDaemon sa@StackArgs {..} = do
    mktree workingDirectory
    checkFsAttributes sa
    ......@@ -103,7 +109,7 @@ prepareDaemon sa@StackArgs {..} = do
    ExitFailure n -> die ("Setting suid bit failed with exit code " <> repr n)
    cleanContainers confPath' 1 4
    export "ARGO_NODEOS_CONFIG" (format fp confPath')
    makeInstrumentedProcess $ Instrumentation
    return $ Instrumentation
    { process = P.proc "daemon" ["--nrm_log", encodeString nrm_log]
    , stdOutFile = daemon_out
    , stdErrFile = daemon_err
    ......@@ -160,9 +166,8 @@ prepareDaemon sa@StackArgs {..} = do
    "argo_nodeos_config successfully cleaned the container \
    \config."
    prepareCmdRun
    :: StackArgs -> Shell (IO (Either PatternMatched (ExitCode, (), ())))
    prepareCmdRun StackArgs {..} = makeInstrumentedProcess $ Instrumentation
    prepareCmdRun :: StackArgs -> Instrumentation
    prepareCmdRun StackArgs {..} = Instrumentation
    { process = P.proc "cmd"
    $ [ "run"
    , "-u"
    ......@@ -171,28 +176,77 @@ prepareCmdRun StackArgs {..} = makeInstrumentedProcess $ Instrumentation
    , T.unpack app
    ]
    ++ fmap T.unpack args
    , stdOutFile = cmd_out
    , stdErrFile = cmd_err
    , messageOut = messageCmdOut
    , messageErr = messageCmdErr
    , stdOutFile = cmd_run_out
    , stdErrFile = cmd_run_err
    , messageOut = messageCmdRunOut
    , messageErr = messageCmdRunErr
    }
    prepareCmdListen :: StackArgs -> Instrumentation
    prepareCmdListen StackArgs {..} = Instrumentation
    { process = P.proc "cmd" ["listen", "-u", T.unpack containerName]
    , stdOutFile = cmd_listen_out
    , stdErrFile = cmd_listen_err
    , messageOut = messageCmdListenOut
    , messageErr = messageCmdListenErr
    }
    data StackOutput = FoundMessage | DaemonDied | CmdDied
    runSimpleStack :: StackArgs -> Shell StackOutput
    runSimpleStack a@StackArgs {..} = do
    cleanLeftovers a
    instrumentedDaemon <- prepareDaemon a
    instrumentedCmd <- prepareCmdRun a
    iDaemon <- prepareDaemon a
    let iRun = prepareCmdRun a
    printInfo "Running the daemon.."
    liftIO $ withAsync instrumentedDaemon $ \daemon -> do
    liftIO $ withAsync (runI iDaemon) $ \daemon -> do
    kbInstallHandler $ cancel daemon
    sh $ printInfo "Daemon running.\n"
    sh $ printInfo "Running cmd.."
    withAsync instrumentedCmd $ \cmd -> do
    sh $ printInfo "cmd running.\n"
    sh $ printInfo "Running 'cmd run'.."
    withAsync (runI iRun) $ \cmd -> do
    sh $ printInfo "'cmd run' running.\n"
    kbInstallHandler $ cancel daemon >> cancel cmd
    waitEitherCancel daemon cmd >>= \case
    Left (Left PatternMatched) -> return FoundMessage
    Left (Right _ ) -> return DaemonDied
    Right (Left PatternMatched) -> return FoundMessage
    Right (Right _ ) -> return CmdDied
    data ListenAsyncConclusion a = Daemon a | Listen a | Run a
    data ListenStackOutput = LSFoundMessage | LSMessageNotFound | LSDaemonDied ExitCode | LSRunDied ExitCode | LSListenDied ExitCode
    runListenStack :: StackArgs -> Shell ListenStackOutput
    runListenStack a@StackArgs {..} = do
    cleanLeftovers a
    iDaemon <- prepareDaemon a
    let iRun = prepareCmdRun a
    let iListen = prepareCmdListen a
    printInfo "Running the daemon.."
    liftIO $ withAsync (runI iDaemon) $ \daemon -> do
    kbInstallHandler $ cancel daemon
    sh $ printInfo "Daemon running.\n"
    sh $ printInfo "Running 'cmd run'.."
    withAsync (runI iRun) $ \run -> do
    sh $ printInfo "'cmd run' running.\n"
    kbInstallHandler $ cancel daemon >> cancel run
    sh $ printInfo "Running 'cmd listen'.."
    withAsync (runI iListen) $ \listen -> do
    sh $ printInfo "'cmd listen' running.\n"
    kbInstallHandler $ cancel daemon >> cancel run >> cancel listen
    waitStackCancel daemon run listen >>= \case
    Daemon (Left PatternMatched) -> return LSFoundMessage
    Daemon (Right (e, _, _) ) -> return $ LSDaemonDied e
    Run (Left PatternMatched) -> return LSFoundMessage
    Run (Right (e, _, _) ) -> return $ LSRunDied e
    Listen (Left PatternMatched) -> return LSFoundMessage
    Listen (Right (e, _, _) ) -> return $ LSListenDied e
    where
    waitStackCancel daemon run listen =
    waitStack daemon run listen
    `finally` (cancel daemon >> cancel run >> cancel listen)
    waitStack daemon run listen =
    atomically
    $ (Daemon <$> waitSTM daemon)
    `orElse` (Run <$> waitSTM run)
    `orElse` (Listen <$> waitSTM listen)
    argo/src/Argo/Utils.hs
    View file @ 746cee22
    ......@@ -76,7 +76,8 @@ verboseShell :: Text -> Shell Line -> Shell ExitCode
    verboseShell command input = printCommand command >> shell command input
    verboseShell' :: Text -> Shell Line -> Shell (ExitCode, Text, Text)
    verboseShell' command input = printCommand command >> shellStrictWithErr command input
    verboseShell' command input =
    printCommand command >> shellStrictWithErr command input
    cleanSocket = sudoRemoveFile printError "socket"
    cleanLog = sudoRemoveFile printWarning "log file"
    ......@@ -95,12 +96,8 @@ data Instrumentation = Instrumentation
    , messageOut :: Maybe Text
    , messageErr :: Maybe Text } deriving (Show)
    makeInstrumentedProcess
    :: Instrumentation -> Shell (IO (Either PatternMatched (ExitCode, (), ())))
    makeInstrumentedProcess instrumentation@Instrumentation {..} = do
    printInfo "Prepared a process with full configuration: \n"
    liftIO $ Prelude.print instrumentation
    return $ try (reroutedDaemon process)
    runI :: Instrumentation -> IO (Either PatternMatched (ExitCode, (), ()))
    runI Instrumentation {..} = try (reroutedDaemon process)
    where
    reroutedDaemon process =
    withSinkFile (encodeString stdOutFile) $ \outSink ->
    ......
    argotk/argotk.hs
    View file @ 746cee22
    ......@@ -21,11 +21,11 @@ import Data.Maybe
    opts :: StackArgs -> Parser (IO ())
    opts sa = hsubparser
    ( command "clean"
    (info (pure $ runClean sa) (progDesc "Clean sockets, logfiles."))
    (info (pure $ clean sa) (progDesc "Clean sockets, logfiles."))
    <> command
    "daemon-only"
    (info
    (runDaemon <$> parseExtendStackArgs sa)
    (daemon <$> parseExtendStackArgs sa)
    (progDesc
    "Set up and launch the daemon in synchronous mode, \
    \with properly cleaned sockets, logfiles."
    ......@@ -33,18 +33,18 @@ opts sa = hsubparser
    )
    <> command
    "full-stack"
    (info (runStack <$> parseExtendStackArgs sa)
    (info (simpleStack <$> parseExtendStackArgs sa)
    (progDesc "Setup stack and run a command in a container.")
    )
    <> command
    "helloworld"
    (info
    (runStack <$> parseExtendStackArgs
    (simpleStack <$> parseExtendStackArgs
    (let msg = "Hello-Moto"
    in sa { app = "echo"
    , args = [msg]
    , messageCmdOut = Just msg
    , messageCmdErr = Just msg
    in sa { app = "echo"
    , args = [msg]
    , messageCmdRunOut = Just msg
    , messageCmdRunErr = Just msg
    }
    )
    )
    ......@@ -56,7 +56,7 @@ opts sa = hsubparser
    <> command
    "perfwrapper"
    (info
    (runStack <$> parseExtendStackArgs
    (simpleStack <$> parseExtendStackArgs
    (sa { manifestName = "perfwrap.json"
    , app = "sleep"
    , args = ["15"]
    ......@@ -67,7 +67,25 @@ opts sa = hsubparser
    )
    (progDesc
    "Test 2: Setup stack and check that argo-perf-wrapper sends \
    \ at least one progress message up."
    \ at least one progress message to the daemon."
    )
    )
    <> command
    "listen"
    (info
    (listenStack <$> parseExtendStackArgs
    (sa { manifestName = "perfwrap.json"
    , app = "sleep"
    , args = ["15"]
    , messageCmdListenOut = Just "progress"
    , messageCmdListenErr = Just "progress"
    }
    )
    )
    (progDesc
    "Test 3: Setup stack and check that argo-perf-wrapper sends \
    \ at least one progress message to cmd listen through the \
    \ daemon."
    )
    )
    <> help
    ......@@ -76,14 +94,8 @@ opts sa = hsubparser
    \ values are printed when you call --help on these actions."
    )
    main :: IO ()
    main = do
    manifests <- getEnv "MANIFESTS"
    let a = def { manifestDir = decodeString manifests }
    join $ execParser (info (opts a <**> helper) idm)
    runStack :: StackArgs -> IO ()
    runStack a@StackArgs {..} = sh $ runSimpleStack a >>= \case
    simpleStack :: StackArgs -> IO ()
    simpleStack a@StackArgs {..} = sh $ runSimpleStack a >>= \case
    FoundMessage -> printSuccess "Found message!\n" >> exit ExitSuccess
    DaemonDied ->
    printError "Daemon died unexpectedly.\n" >> exit (ExitFailure 1)
    ......@@ -91,13 +103,39 @@ runStack a@StackArgs {..} = sh $ runSimpleStack a >>= \case
    when
    ( or
    $ isJust
    <$> [messageDaemonOut, messageDaemonErr, messageCmdOut, messageCmdErr]
    <$> [ messageDaemonOut
    , messageDaemonErr
    , messageCmdRunOut
    , messageCmdRunErr
    ]
    )
    $ printError "Did not find message.\n"
    exit (ExitFailure 1)
    runClean :: StackArgs -> IO ()
    runClean = sh . cleanLeftovers
    runDaemon :: StackArgs -> IO ()
    runDaemon a = sh $ cleanLeftovers a >> prepareDaemon a >>= liftIO
    listenStack :: StackArgs -> IO ()
    listenStack a@StackArgs {..} = sh $ runListenStack a >>= \case
    LSFoundMessage -> printSuccess "Found message!\n" >> exit ExitSuccess
    LSMessageNotFound ->
    printError "Message not found.\n" >> exit (ExitFailure 1)
    LSDaemonDied exitcode ->
    printError "`daemon` died unexpectedly.\n" >> exit (ExitFailure 1)
    LSRunDied exitcode ->
    printError "`cmd run` unexpectedly.\n" >> exit (ExitFailure 1)
    LSListenDied exitcode ->
    printError "`cmd listen` died unexpectedly.\n" >> exit (ExitFailure 1)
    clean :: StackArgs -> IO ()
    clean = sh . cleanLeftovers
    daemon :: StackArgs -> IO ()
    daemon a = sh $ do
    cleanLeftovers a
    iDaemon <- prepareDaemon a
    liftIO $ runI iDaemon
    main :: IO ()
    main = do
    manifests <- getEnv "MANIFESTS"
    let a = def { manifestDir = decodeString manifests }
    join $ execParser (info (opts a <**> helper) idm)
    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