Commit 7bfb82a8 authored by Valentin Reis's avatar Valentin Reis

Added grouping to the commands and broughts the tests at the type level.

`argotk.hs tests` runs all the tests.
parent 3473ba52
Pipeline #4821 failed with stage
in 35 seconds
...@@ -4,39 +4,14 @@ stages: ...@@ -4,39 +4,14 @@ stages:
integration.test: integration.test:
stage: test stage: test
script: script:
- nix-shell -A test --run "argotk.hs helloworld" - nix-shell -A test --run "argotk.hs tests"
except: except:
- /^wip\/.*/ - /^wip\/.*/
- /^WIP\/.*/ - /^WIP\/.*/
artifacts: artifacts:
when: always when: always
paths: paths:
- _output/cmd_out.log - _output/*.log
- _output/cmd_err.log
- _output/daemon_out.log
- _output/daemon_err.log
- _output/nrm_log.log
- _output/time.log
- _output/.argo_nodeos_config_exit_message
tags:
- integration
argo-perf-wrapper.test:
stage: test
script:
- nix-shell -A test --run "argotk.hs perfwrapper"
except:
- /^wip\/.*/
- /^WIP\/.*/
artifacts:
when: always
paths:
- _output/cmd_out.log
- _output/cmd_err.log
- _output/daemon_out.log
- _output/daemon_err.log
- _output/nrm_log.log
- _output/time.log
- _output/.argo_nodeos_config_exit_message - _output/.argo_nodeos_config_exit_message
tags: tags:
- integration - integration
...@@ -107,7 +107,7 @@ prepareDaemon sa@StackArgs {..} = do ...@@ -107,7 +107,7 @@ prepareDaemon sa@StackArgs {..} = do
verboseShell (format ("sudo chmod u+sw " % fp) confPath') empty >>= \case verboseShell (format ("sudo chmod u+sw " % fp) confPath') empty >>= \case
ExitSuccess -> printInfo "Set the suid bit.\n" ExitSuccess -> printInfo "Set the suid bit.\n"
ExitFailure n -> die ("Setting suid bit failed with exit code " <> repr n) ExitFailure n -> die ("Setting suid bit failed with exit code " <> repr n)
cleanContainers confPath' 1 4 cleanContainers confPath' 1 2
export "ARGO_NODEOS_CONFIG" (format fp confPath') export "ARGO_NODEOS_CONFIG" (format fp confPath')
return $ Instrumentation return $ Instrumentation
{ process = P.proc "daemon" ["--nrm_log", encodeString nrm_log] { process = P.proc "daemon" ["--nrm_log", encodeString nrm_log]
...@@ -212,9 +212,17 @@ runSimpleStack a@StackArgs {..} = do ...@@ -212,9 +212,17 @@ runSimpleStack a@StackArgs {..} = do
Right (Left PatternMatched) -> return FoundMessage Right (Left PatternMatched) -> return FoundMessage
Right (Right _ ) -> return CmdDied Right (Right _ ) -> return CmdDied
data ListenAsyncConclusion a =
Daemon a
| Listen a
| Run a
data ListenAsyncConclusion a = Daemon a | Listen a | Run a data ListenStackOutput =
data ListenStackOutput = LSFoundMessage | LSMessageNotFound | LSDaemonDied ExitCode | LSRunDied ExitCode | LSListenDied ExitCode LSFoundMessage
| LSMessageNotFound
| LSDaemonDied ExitCode
| LSRunDied ExitCode
| LSListenDied ExitCode
runListenStack :: StackArgs -> Shell ListenStackOutput runListenStack :: StackArgs -> Shell ListenStackOutput
runListenStack a@StackArgs {..} = do runListenStack a@StackArgs {..} = do
......
...@@ -29,6 +29,7 @@ printCommand :: Text -> Shell () ...@@ -29,6 +29,7 @@ printCommand :: Text -> Shell ()
printError :: Text -> Shell () printError :: Text -> Shell ()
printWarning :: Text -> Shell () printWarning :: Text -> Shell ()
printSuccess :: Text -> Shell () printSuccess :: Text -> Shell ()
printTest :: Text -> Shell ()
dieRed :: Text -> Shell () dieRed :: Text -> Shell ()
printInfo = printf ("Info: " % s) printInfo = printf ("Info: " % s)
...@@ -36,6 +37,7 @@ printCommand = printf ("Running: " % s % "\n") ...@@ -36,6 +37,7 @@ printCommand = printf ("Running: " % s % "\n")
printWarning = colorShell Yellow . printf ("Warning: " % s) printWarning = colorShell Yellow . printf ("Warning: " % s)
printError = colorShell Red . printf ("Error: " % s) printError = colorShell Red . printf ("Error: " % s)
printSuccess = colorShell Green . printf ("Success: " % s) printSuccess = colorShell Green . printf ("Success: " % s)
printTest = colorShell Green . printf ("RUNNING TEST: " % s%"\n")
dieRed str = dieRed str =
colorShell Red (printf ("Failure: " % s) str) >> exit (ExitFailure 1) colorShell Red (printf ("Failure: " % s) str) >> exit (ExitFailure 1)
......
...@@ -17,8 +17,11 @@ import System.Posix.Signals ...@@ -17,8 +17,11 @@ import System.Posix.Signals
import Control.Monad import Control.Monad
import Data.Either import Data.Either
import Data.Maybe import Data.Maybe
import qualified Control.Foldl as Fold
import Data.Text as T
( pack )
opts :: StackArgs -> Parser (IO ()) opts :: StackArgs -> Parser (Shell ())
opts sa = hsubparser opts sa = hsubparser
( command "clean" ( command "clean"
(info (pure $ clean sa) (progDesc "Clean sockets, logfiles.")) (info (pure $ clean sa) (progDesc "Clean sockets, logfiles."))
...@@ -33,109 +36,133 @@ opts sa = hsubparser ...@@ -33,109 +36,133 @@ opts sa = hsubparser
) )
<> command <> command
"full-stack" "full-stack"
(info (simpleStack <$> parseExtendStackArgs sa) (info (simpleStack False <$> parseExtendStackArgs sa)
(progDesc "Setup stack and run a command in a container.") (progDesc "Setup stack and run a command in a container.")
) )
<> command <> commandTest TestHello
"helloworld" <> commandTest TestListen
(info <> commandTest TestPerfwrapper
(simpleStack <$> parseExtendStackArgs <> commandTests [TestHello, TestListen, TestPerfwrapper]
(let msg = "Hello-Moto" "tests"
in sa { app = "echo" "Run all tests"
, args = [msg]
, messageCmdRunOut = Just msg
, messageCmdRunErr = Just msg
}
)
)
(progDesc
"Test 1: Setup stack and check that a hello world app sends \
\message back to cmd."
)
)
<> command
"perfwrapper"
(info
(simpleStack <$> parseExtendStackArgs
(sa { manifestName = "perfwrap.json"
, app = "sleep"
, args = ["15"]
, messageDaemonOut = Just "progress"
, messageDaemonErr = Just "progress"
}
)
)
(progDesc
"Test 2: Setup stack and check that argo-perf-wrapper sends \
\ 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 <> help
"Type of test to run. There are extensive options under each action,\ "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\ \ but be careful, these do not all have the same defaults. The default\
\ values are printed when you call --help on these actions." \ values are printed when you call --help on these actions."
) )
where
action ttype = doOverridenTest ttype
<$> parseExtendStackArgs ((stackArgsUpdate $ configureTest ttype) sa)
descTest ttype = "test" ++ description (configureTest ttype)
commandTest ttype =
command (show ttype) $ info (action ttype) (progDesc $ descTest ttype)
commandTests ttypes cmdStr descStr = command cmdStr $ info (pure $ mapM_ (doTest sa) ttypes) (progDesc descStr)
simpleStack :: StackArgs -> IO () data TestType = TestHello | TestListen | TestPerfwrapper deriving Show
simpleStack a@StackArgs {..} = sh $ runSimpleStack a >>= \case data TestSpec = TestSpec {
FoundMessage -> printSuccess "Found message!\n" >> exit ExitSuccess stackAction :: StackArgs -> Shell ()
DaemonDied -> , stackArgsUpdate :: StackArgs -> StackArgs
printError "Daemon died unexpectedly.\n" >> exit (ExitFailure 1) , description :: String
CmdDied -> do }
when
( or doTest :: StackArgs -> TestType -> Shell ()
$ isJust doTest stackArgs ttype = doSpec spec $ (stackArgsUpdate $ configureTest ttype) stackArgs
<$> [ messageDaemonOut where spec = configureTest ttype
, messageDaemonErr
, messageCmdRunOut doOverridenTest :: TestType -> StackArgs -> Shell ()
, messageCmdRunErr doOverridenTest ttype stackArgs = doSpec spec stackArgs
] where spec = configureTest ttype
)
$ printError "Did not find message.\n"
exit (ExitFailure 1)
doSpec :: TestSpec -> StackArgs -> Shell()
doSpec spec stackArgs = do
printTest $ T.pack $ description spec
stackAction spec stackArgs
printSuccess "Test Successful."
configureTest :: TestType -> TestSpec
configureTest = \case
TestHello -> TestSpec
{ stackAction = simpleStack True
, stackArgsUpdate = \sa -> sa { app = "echo"
, args = [msg]
, messageCmdRunOut = Just msg
, messageCmdRunErr = Just msg
}
, description = "1: Setup stack and check that a hello world app sends \
\message back to cmd."
}
TestListen -> TestSpec
{ stackAction = listenStack
, stackArgsUpdate = \sa -> sa { app = "sleep"
, args = ["15"]
, messageCmdListenOut = Just "pub message"
, messageCmdListenErr = Just "pub message"
}
, description = "2: Setup stack and check that argo-perf-wrapper sends\
\ at least one message to the daemon."
}
TestPerfwrapper -> TestSpec
{ stackAction = listenStack
, stackArgsUpdate = \sa -> sa { manifestName = "perfwrap.json"
, app = "sleep"
, args = ["15"]
, messageCmdListenOut = Just "performance"
, messageCmdListenErr = Just "performance"
}
, description = "3: Setup stack and check that argo-perf-wrapper sends\
\ at least one *performance* message to cmd listen through the\
\ daemon."
}
where msg = "someComplicatedMessage"
simpleStack :: Bool -> StackArgs -> Shell ()
simpleStack dieIfNoMessage a@StackArgs {..} = runSimpleStack a >>= \case
FoundMessage -> printSuccess "Found message!\n"
DaemonDied ->
printError "`daemon` died (unexpectedly).\n" >> exit (ExitFailure 1)
CmdDied -> if dieIfNoMessage
then do
printError "`cmd run` died before a message could be found.\n"
exit (ExitFailure 1)
else printInfo "`cmd run` died.\n"
listenStack :: StackArgs -> IO () listenStack :: StackArgs -> Shell ()
listenStack a@StackArgs {..} = sh $ runListenStack a >>= \case listenStack a@StackArgs {..} = runListenStack a >>= \case
LSFoundMessage -> printSuccess "Found message!\n" >> exit ExitSuccess LSFoundMessage -> printSuccess "Found message!\n"
LSMessageNotFound -> LSMessageNotFound ->
printError "Message not found.\n" >> exit (ExitFailure 1) printError "Message not found.\n" >> exit (ExitFailure 1)
LSDaemonDied exitcode -> LSDaemonDied ExitSuccess ->
printError "`daemon` died unexpectedly.\n" >> exit (ExitFailure 1) printError "`daemon` died before a message could be found.\n"
LSRunDied exitcode -> >> exit (ExitFailure 1)
printError "`cmd run` unexpectedly.\n" >> exit (ExitFailure 1) LSDaemonDied (ExitFailure e) ->
LSListenDied exitcode -> printError (format ("`daemon` died unexpectedly with error code.\n" % d) e)
printError "`cmd listen` died unexpectedly.\n" >> exit (ExitFailure 1) >> exit (ExitFailure 1)
LSRunDied ExitSuccess ->
printError "`cmd run` died before a message could be found.\n"
>> exit (ExitFailure 1)
LSRunDied (ExitFailure e) ->
printError (format ("`cmd run` died unexpectedly with error code.\n" % d) e)
>> exit (ExitFailure 1)
LSListenDied ExitSuccess ->
printError "`cmd listen` died before a message could be found.\n"
>> exit (ExitFailure 1)
LSListenDied (ExitFailure e)
-> printError
(format ("`cmd listen` died unexpectedly with error code.\n" % d) e)
>> exit (ExitFailure 1)
clean :: StackArgs -> IO () clean :: StackArgs -> Shell ()
clean = sh . cleanLeftovers clean = cleanLeftovers
daemon :: StackArgs -> IO () daemon :: StackArgs -> Shell ()
daemon a = sh $ do daemon a = do
cleanLeftovers a cleanLeftovers a
iDaemon <- prepareDaemon a iDaemon <- prepareDaemon a
liftIO $ runI iDaemon void $ liftIO $ runI iDaemon
main :: IO () main :: IO ()
main = do main = do
manifests <- getEnv "MANIFESTS" manifests <- getEnv "MANIFESTS"
let a = def { manifestDir = decodeString manifests } let a = def { manifestDir = decodeString manifests }
join $ execParser (info (opts a <**> helper) idm) turtle <- execParser (info (opts a <**> helper) idm)
sh turtle
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