Skip to content

GitLab

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

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