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:
integration.test:
stage: test
script:
- nix-shell -A test --run "argotk.hs helloworld"
- nix-shell -A test --run "argotk.hs tests"
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
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/*.log
- _output/.argo_nodeos_config_exit_message
tags:
- integration
......@@ -107,7 +107,7 @@ prepareDaemon sa@StackArgs {..} = do
verboseShell (format ("sudo chmod u+sw " % fp) confPath') empty >>= \case
ExitSuccess -> printInfo "Set the suid bit.\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')
return $ Instrumentation
{ process = P.proc "daemon" ["--nrm_log", encodeString nrm_log]
......@@ -212,9 +212,17 @@ runSimpleStack a@StackArgs {..} = do
Right (Left PatternMatched) -> return FoundMessage
Right (Right _ ) -> return CmdDied
data ListenAsyncConclusion a =
Daemon a
| Listen a
| Run a
data ListenAsyncConclusion a = Daemon a | Listen a | Run a
data ListenStackOutput = LSFoundMessage | LSMessageNotFound | LSDaemonDied ExitCode | LSRunDied ExitCode | LSListenDied ExitCode
data ListenStackOutput =
LSFoundMessage
| LSMessageNotFound
| LSDaemonDied ExitCode
| LSRunDied ExitCode
| LSListenDied ExitCode
runListenStack :: StackArgs -> Shell ListenStackOutput
runListenStack a@StackArgs {..} = do
......
......@@ -29,6 +29,7 @@ printCommand :: Text -> Shell ()
printError :: Text -> Shell ()
printWarning :: Text -> Shell ()
printSuccess :: Text -> Shell ()
printTest :: Text -> Shell ()
dieRed :: Text -> Shell ()
printInfo = printf ("Info: " % s)
......@@ -36,6 +37,7 @@ printCommand = printf ("Running: " % s % "\n")
printWarning = colorShell Yellow . printf ("Warning: " % s)
printError = colorShell Red . printf ("Error: " % s)
printSuccess = colorShell Green . printf ("Success: " % s)
printTest = colorShell Green . printf ("RUNNING TEST: " % s%"\n")
dieRed str =
colorShell Red (printf ("Failure: " % s) str) >> exit (ExitFailure 1)
......
......@@ -17,8 +17,11 @@ import System.Posix.Signals
import Control.Monad
import Data.Either
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
( command "clean"
(info (pure $ clean sa) (progDesc "Clean sockets, logfiles."))
......@@ -33,109 +36,133 @@ opts sa = hsubparser
)
<> command
"full-stack"
(info (simpleStack <$> parseExtendStackArgs sa)
(info (simpleStack False <$> parseExtendStackArgs sa)
(progDesc "Setup stack and run a command in a container.")
)
<> command
"helloworld"
(info
(simpleStack <$> parseExtendStackArgs
(let msg = "Hello-Moto"
in sa { app = "echo"
<> commandTest TestHello
<> commandTest TestListen
<> commandTest TestPerfwrapper
<> commandTests [TestHello, TestListen, TestPerfwrapper]
"tests"
"Run all tests"
<> 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."
)
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)
data TestType = TestHello | TestListen | TestPerfwrapper deriving Show
data TestSpec = TestSpec {
stackAction :: StackArgs -> Shell ()
, stackArgsUpdate :: StackArgs -> StackArgs
, description :: String
}
doTest :: StackArgs -> TestType -> Shell ()
doTest stackArgs ttype = doSpec spec $ (stackArgsUpdate $ configureTest ttype) stackArgs
where spec = configureTest ttype
doOverridenTest :: TestType -> StackArgs -> Shell ()
doOverridenTest ttype stackArgs = doSpec spec stackArgs
where spec = configureTest ttype
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
}
)
)
(progDesc
"Test 1: Setup stack and check that a hello world app sends \
, description = "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"
}
TestListen -> TestSpec
{ stackAction = listenStack
, stackArgsUpdate = \sa -> sa { app = "sleep"
, args = ["15"]
, messageDaemonOut = Just "progress"
, messageDaemonErr = Just "progress"
, messageCmdListenOut = Just "pub message"
, messageCmdListenErr = Just "pub message"
}
)
)
(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"
, 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 "progress"
, messageCmdListenErr = Just "progress"
, messageCmdListenOut = Just "performance"
, messageCmdListenErr = Just "performance"
}
)
)
(progDesc
"Test 3: Setup stack and check that argo-perf-wrapper sends \
\ at least one progress message to cmd listen through the \
, description = "3: Setup stack and check that argo-perf-wrapper sends\
\ at least one *performance* message to cmd listen through the\
\ daemon."
)
)
<> 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."
)
}
where msg = "someComplicatedMessage"
simpleStack :: StackArgs -> IO ()
simpleStack a@StackArgs {..} = sh $ runSimpleStack a >>= \case
FoundMessage -> printSuccess "Found message!\n" >> exit ExitSuccess
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 -> do
when
( or
$ isJust
<$> [ messageDaemonOut
, messageDaemonErr
, messageCmdRunOut
, messageCmdRunErr
]
)
$ printError "Did not find message.\n"
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 a@StackArgs {..} = sh $ runListenStack a >>= \case
LSFoundMessage -> printSuccess "Found message!\n" >> exit ExitSuccess
listenStack :: StackArgs -> Shell ()
listenStack a@StackArgs {..} = runListenStack a >>= \case
LSFoundMessage -> printSuccess "Found message!\n"
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)
LSDaemonDied ExitSuccess ->
printError "`daemon` died before a message could be found.\n"
>> exit (ExitFailure 1)
LSDaemonDied (ExitFailure e) ->
printError (format ("`daemon` died unexpectedly with error code.\n" % d) e)
>> 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 = sh . cleanLeftovers
clean :: StackArgs -> Shell ()
clean = cleanLeftovers
daemon :: StackArgs -> IO ()
daemon a = sh $ do
daemon :: StackArgs -> Shell ()
daemon a = do
cleanLeftovers a
iDaemon <- prepareDaemon a
liftIO $ runI iDaemon
void $ liftIO $ runI iDaemon
main :: IO ()
main = do
manifests <- getEnv "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