Skip to content

A
argotest
Commit 7e7c66e4 authored by Valentin Reis's avatar Valentin Reis
Browse files
Options

Added daemon log file parsing to the perf-wrapper test. This waits for 

"payload" to appear in the daemon stdouts and exits with success.
parent 772f8098
Pipeline #4716 passed with stage
    in 30 seconds
    Hide whitespace changes
    Inline Side-by-side
    Showing with 188 additions and 103 deletions
    argo/argo.cabal
    View file @ 7e7c66e4
    ......@@ -11,6 +11,6 @@ cabal-version: >=1.10
    library
    exposed-Modules: Argo.Stack
    Argo.Utils
    build-depends: base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async, process, text
    build-depends: base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async, process, text, optparse-applicative
    hs-source-dirs: src
    default-language: Haskell2010
    argo/src/Argo/Stack.hs
    View file @ 7e7c66e4
    {-# LANGUAGE ScopedTypeVariables, LambdaCase , RecordWildCards , OverloadedStrings ,
    DataKinds , FlexibleInstances , TypeOperators #-}
    {-# LANGUAGE ScopedTypeVariables,
    LambdaCase,
    RecordWildCards,
    OverloadedStrings,
    DataKinds,
    FlexibleInstances,
    TypeOperators,
    ApplicativeDo #-}
    module Argo.Stack where
    ......@@ -19,24 +25,23 @@ import Data.Text.IO as Text
    import Argo.Utils
    import System.Process as P
    hiding ( shell )
    import Options.Applicative as OA
    data StackArgs = StackArgs
    { dargs :: [Text] --"Daemon arguments. Properly quote this."
    , app :: Text --"Target application call, sh+path valid"
    , workingDirectory :: FilePath --"Working directory."
    , manifestDir :: FilePath --"Manifest lookup directory"
    , manifestName :: FilePath --"Manifest file name"
    , cmd_out :: FilePath --"Output file, application stdout"
    , cmd_err :: FilePath --"Output file, application stderr"
    , daemon_out :: FilePath --"Output file, daemon stdout"
    , daemon_err :: FilePath --"Output file, daemon stderr"
    , nrm_log :: FilePath --"Output file, daemon log"
    , time_file :: FilePath } --"Output file, application runtime"
    { app :: Text
    , workingDirectory :: FilePath
    , manifestDir :: FilePath
    , manifestName :: FilePath
    , cmd_out :: FilePath
    , cmd_err :: FilePath
    , daemon_out :: FilePath
    , daemon_err :: FilePath
    , nrm_log :: FilePath
    , time_file :: FilePath }
    instance Default StackArgs where
    def = StackArgs
    { dargs = []
    , app = "echo \"HelloWorld\""
    { app = "echo foobar"
    , workingDirectory = "_output"
    , manifestDir = "manifests"
    , manifestName = "basic.json"
    ......@@ -48,35 +53,106 @@ instance Default StackArgs where
    , time_file = "time.log"
    }
    cleanLeftovers
    :: FilePath
    -> FilePath
    -> FilePath
    -> FilePath
    -> FilePath
    -> FilePath
    -> FilePath
    -> Shell ()
    cleanLeftovers wd daemon_out daemon_err cmd_out cmd_err time_file nrm_log = do
    parseExtendStackArgs :: StackArgs -> Parser StackArgs
    parseExtendStackArgs StackArgs {..} = do
    app <- strOption
    ( long "application"
    <> metavar "FILE"
    <> help "Target application call, sh+path valid"
    <> showDefault
    <> value app
    )
    workingDirectory <- strOption
    ( long "output"
    <> metavar "FILE"
    <> help "Working directory."
    <> showDefault
    <> value workingDirectory
    )
    manifestDir <- strOption
    ( long "manifest_directory"
    <> metavar "FILE"
    <> help "Manifest lookup directory"
    <> showDefault
    <> value manifestDir
    )
    manifestName <- strOption
    ( long "manifest_name"
    <> metavar "FILE"
    <> help "Manifest basename"
    <> showDefault
    <> value manifestName
    )
    cmd_out <- strOption
    ( long "cmd_out"
    <> metavar "FILE"
    <> help "Output file, application stdout"
    <> showDefault
    <> value cmd_out
    )
    cmd_err <- strOption
    ( long "cmd_err"
    <> metavar "FILE"
    <> help "Output file, application stderr"
    <> showDefault
    <> value cmd_err
    )
    daemon_out <- strOption
    ( long "daemon_out"
    <> metavar "FILE"
    <> help "Output file, daemon stdout"
    <> showDefault
    <> value daemon_out
    )
    daemon_err <- strOption
    ( long "daemon_err"
    <> metavar "FILE"
    <> help "Output file, daemon stderr"
    <> showDefault
    <> value daemon_err
    )
    nrm_log <- strOption
    ( long "nrm_log"
    <> metavar "FILE"
    <> help "Output file, daemon log"
    <> showDefault
    <> value nrm_log
    )
    time_file <- strOption
    ( long "time_file"
    <> metavar "FILE"
    <> help "Output file, application runtime"
    <> showDefault
    <> value time_file
    )
    pure StackArgs {..}
    cleanLeftovers :: StackArgs -> Shell ()
    cleanLeftovers StackArgs {..} = do
    printInfo "Cleaning leftovers..\n"
    mapM_
    cleanLog
    [ wd </> daemon_out
    , wd </> daemon_err
    , wd </> cmd_out
    , wd </> cmd_err
    , wd </> time_file
    , wd </> nrm_log
    , wd </> ".argo_nodeos_config_exit_message"
    , wd </> "argo_nodeos_config"
    [ workingDirectory </> daemon_out
    , workingDirectory </> daemon_err
    , workingDirectory </> cmd_out
    , workingDirectory </> cmd_err
    , workingDirectory </> time_file
    , workingDirectory </> nrm_log
    , workingDirectory </> ".argo_nodeos_config_exit_message"
    , workingDirectory </> "argo_nodeos_config"
    ]
    mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]
    prepareDaemonShell
    :: FilePath -> [Text] -> FilePath -> FilePath -> FilePath -> Shell (IO ())
    prepareDaemonShell wd dargs daemon_out daemon_err nrm_log = do
    mktree wd
    cd wd
    prepareDaemonShell :: StackArgs -> Shell (IO ())
    prepareDaemonShell = prepareDaemonShellWithStoppingCriterion id
    prepareDaemonShellWithStoppingCriterion
    :: (Shell (Either Line Line) -> Shell (Either Line Line))
    -> StackArgs
    -> Shell (IO ())
    prepareDaemonShellWithStoppingCriterion waitCondition StackArgs {..} = do
    mktree workingDirectory
    cd workingDirectory
    myWhich "daemon"
    confPath <- myWhich "argo_nodeos_config"
    let confPath' = "./argo_nodeos_config"
    ......@@ -116,17 +192,17 @@ prepareDaemonShell wd dargs daemon_out daemon_err nrm_log = do
    daemon_out
    daemon_err
    export "ARGO_NODEOS_CONFIG" (format fp confPath')
    return $ twoWayPrint daemon_out daemon_err $ inprocWithErr
    return $ twoWayPrint daemon_out daemon_err $ waitCondition $ inprocWithErr
    "daemon"
    (dargs ++ ["--nrm_log", Text.pack $ encodeString nrm_log])
    ["--nrm_log", Text.pack $ encodeString nrm_log]
    empty
    -- | See at the bottom of this file for discussion of this function. (1)
    cmdShell :: FilePath -> Text -> FilePath -> FilePath -> Shell ()
    cmdShell manifest app cmd_out cmd_err =
    cmdShell :: StackArgs -> Shell ()
    cmdShell StackArgs {..} =
    shell
    (format ("cmd run -u toto " % fp % " " % s % " > " % fp % " 2>" % fp)
    manifest
    (manifestDir </> manifestName)
    app
    cmd_out
    cmd_err
    ......@@ -152,29 +228,22 @@ twoWayPrint outPath errPath s = sh $ do
    Right err -> liftIO $ Text.hPutStrLn handleErr (lineToText err)
    runSimpleStack :: StackArgs -> IO ()
    runSimpleStack a@StackArgs {..} = sh $ do
    cleanLeftovers workingDirectory
    daemon_out
    daemon_err
    cmd_out
    cmd_err
    time_file
    nrm_log
    daemonShell <- prepareDaemonShell workingDirectory
    dargs
    daemon_out
    daemon_err
    nrm_log
    runSimpleStack = runSimpleStackWithCriterion id
    runSimpleStackWithCriterion
    :: (Shell (Either Line Line) -> Shell (Either Line Line))
    -> StackArgs
    -> IO ()
    runSimpleStackWithCriterion stoppingCriterion a@StackArgs {..} = sh $ do
    cleanLeftovers a
    daemonShell <- prepareDaemonShellWithStoppingCriterion stoppingCriterion a
    liftIO $ withAsync daemonShell $ \daemon -> do
    kbInstallHandler $ cancel daemon
    withAsync
    (time $ sh $ cmdShell (manifestDir </> manifestName) app cmd_out cmd_err
    )
    $ \cmd -> do
    kbInstallHandler $ cancel daemon >> cancel cmd
    waitEitherCancel daemon cmd >>= \case
    Left _ -> die "Daemon died."
    Right (_, t) -> writeTextFile time_file (repr t)
    withAsync (time $ sh $ cmdShell a) $ \cmd -> do
    kbInstallHandler $ cancel daemon >> cancel cmd
    waitEitherCancel daemon cmd >>= \case
    Left _ -> die "Daemon died."
    Right (_, t) -> writeTextFile time_file (repr t)
    -- | (1)
    --
    ......
    argotk/argotk.cabal
    View file @ 7e7c66e4
    ......@@ -16,7 +16,7 @@ executable argotk
    main-is: argotk.hs
    -- other-modules:
    -- other-extensions:
    build-depends: base >=4.10 && <4.11, shake, FindBin
    build-depends: base, shake
    --hs-source-dirs: src
    default-language: Haskell2010
    GHC-Options: -Wall
    argotk/argotk.hs
    View file @ 7e7c66e4
    #! /usr/bin/env runhaskell
    {-# LANGUAGE
    OverloadedStrings
    , RecordWildCards #-}
    OverloadedStrings,
    LambdaCase,
    RecordWildCards #-}
    import Argo.Stack
    import Argo.Utils
    ......@@ -16,6 +17,9 @@ import System.Console.ANSI.Types ( Color )
    import Options.Applicative
    import System.Posix.Signals
    import Control.Monad
    import Data.Either
    helloWorldText = "HelloWorldFromApp"
    opts :: StackArgs -> Parser (IO ())
    opts sa = hsubparser
    ......@@ -24,26 +28,24 @@ opts sa = hsubparser
    <> command
    "daemon"
    (info
    (pure $ runDaemon sa)
    (runDaemon <$> parseExtendStackArgs sa)
    (progDesc
    "Set up and launch the daemon in synchronous mode, \
    \with properly cleaned sockets, logfiles."
    )
    )
    <> command
    "application"
    "stack"
    (info
    (runApp sa <$> strArgument
    ( metavar "COMMAND"
    <> help "Application to run inside the container"
    )
    )
    (runSimpleStack <$> parseExtendStackArgs sa)
    (progDesc "Setup stack and run an arbitrary command in a container.")
    )
    <> command
    "helloworld"
    (info
    (pure $ runHelloWorld sa)
    (runCheckCmdOutput "helloworld" <$> parseExtendStackArgs
    (sa { app = format ("echo " % s) "helloworld" })
    )
    (progDesc
    "Test 1: Setup stack and check that a hello world app sends \
    \message back to cmd."
    ......@@ -52,47 +54,61 @@ opts sa = hsubparser
    <> command
    "perfwrapper"
    (info
    (pure $ runHelloWorld (sa { manifestName = "perfwrap.json" }))
    (runWaitForMessage "payload" <$> parseExtendStackArgs
    (sa { manifestName = "perfwrap.json"
    , app = format ("sleep " % s) "5"
    }
    )
    )
    (progDesc
    "Test 2: Setup stack and check that a hello world app sends \
    \message back to cmd. Uses argo-perf-wrapper."
    )
    )
    <> help "Type of action to run"
    <> help
    "Type of test to run. There are extensive options under each action,\
    \ but be careful, these do not all have the same defaults. The default\
    \ values are printed when you call --help on these actions."
    )
    main :: IO ()
    main = do
    manifests <- getEnv "MANIFESTS"
    let sa = def { manifestDir = decodeString manifests }
    join $ execParser (info (opts sa <**> helper) idm)
    runApp :: StackArgs -> Text -> IO ()
    runApp sa myApp = runSimpleStack $ sa { app = myApp }
    let a = def { manifestDir = decodeString manifests }
    join $ execParser (info (opts a <**> helper) idm)
    runHelloWorld :: StackArgs -> IO ()
    runHelloWorld a@StackArgs {..} = do
    let passText = "HelloWorldFromApp"
    let passPattern = text passText
    runSimpleStack $ a { app = format ("echo " % s) passText }
    readTextFile cmd_err >>= \x -> case match (has passPattern) x of
    [] -> die "Hello world app failed to run."
    runCheckCmdOutput :: Text -> StackArgs -> IO ()
    runCheckCmdOutput message a@StackArgs {..} = do
    runSimpleStack a
    readTextFile cmd_err >>= \x -> case match (has (text message)) x of
    [] ->
    die $ "Test failure: Cmd did not recieve the '" <> message <> "' message."
    _ ->
    sh
    $ printInfo
    "The hello world app executed properly in a \
    \container and its message was received by `cmd`.\n"
    "Test success: The hello world app executed properly in a \
    \ container and its message was received by `cmd`.\n"
    runWaitForMessage :: Text -> StackArgs -> IO ()
    runWaitForMessage message a@StackArgs {..} = do
    runSimpleStackWithCriterion criteria a
    die
    ("Test failure: did not find string '" <> message <> "' in daemon stdout.")
    where
    criteria :: (Shell (Either Line Line) -> Shell (Either Line Line))
    criteria s = s >>= \case
    Left out -> case match (has (text "payload")) (lineToText out) of
    [] -> return $ Left out
    _ -> do
    printInfo
    $ "Test success: Found line containing '"
    <> message
    <> "' in daemon stdout."
    exit ExitSuccess
    Right err -> return $ Right err
    runClean :: StackArgs -> IO ()
    runClean StackArgs {..} = sh $ cleanLeftovers workingDirectory
    daemon_out
    daemon_err
    cmd_out
    cmd_err
    time_file
    nrm_log
    runClean = sh . cleanLeftovers
    runDaemon :: StackArgs -> IO ()
    runDaemon StackArgs {..} =
    sh
    $ prepareDaemonShell workingDirectory dargs daemon_out daemon_err nrm_log
    >>= liftIO
    runDaemon a = sh $ prepareDaemonShell a >>= 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