Commit 50ffa445 authored by Valentin Reis's avatar Valentin Reis

Making the refactor work.

parent be0e5b41
Pipeline #4861 passed with stage
in 42 seconds
......@@ -47,9 +47,9 @@ import Control.Foldl as Fold
cleanLeftovers :: WorkingDirectory -> Shell ()
cleanLeftovers (WorkingDirectory wd) = do
printInfo "Cleaning leftover files.\n"
printInfo "Cleaning working(output) directory.\n"
cleanLog wd
printInfo "Cleaning leftover sockets.\n"
printInfo "Cleaning sockets.\n"
CM.mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]
checkFsAttributes :: FilePath -> Shell ()
......@@ -64,15 +64,8 @@ checkFsAttributes workingDirectory = do
workingDirectory
prepareDaemon
:: StdOutLog
-> StdErrLog
-> Maybe TestText
-> WorkingDirectory
-> Shell Instrumentation
prepareDaemon (StdOutLog out) (StdErrLog err) test (WorkingDirectory wd) = do
mktree wd
checkFsAttributes wd
cd wd
:: StdOutLog -> StdErrLog -> Maybe TestText -> Shell Instrumentation
prepareDaemon (StdOutLog out) (StdErrLog err) test = do
myWhich "daemon"
confPath <- myWhich "argo_nodeos_config"
let confPath' = "./argo_nodeos_config"
......@@ -188,18 +181,21 @@ data StackOutput =
data StackI = Daemon | Run | Listen | Progress | Power deriving (Show)
runListenStack :: StackArgs -> Shell StackOutput
runListenStack a@StackArgs {..} = do
cleanLeftovers workingDirectory
runStack :: StackArgs -> Shell StackOutput
runStack a@StackArgs {..} = do
CM.mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]
let (WorkingDirectory wd) = workingDirectory
Turtle.shell (format ("rm -rf " % fp) wd) Turtle.empty
mktree wd
checkFsAttributes wd
cd wd
iDaemon <- case daemon of
DontRun -> return Nothing
JustRun out err ->
(\x -> Just (Daemon, x))
<$> prepareDaemon out err Nothing workingDirectory
(\x -> Just (Daemon, x)) <$> prepareDaemon out err Nothing
SucceedTestOnMessage t out err ->
(\x -> Just (Daemon, x))
<$> prepareDaemon out err (Just t) workingDirectory
(\x -> Just (Daemon, x)) <$> prepareDaemon out err (Just t)
let milist =
[ iDaemon
......@@ -221,4 +217,4 @@ runListenStack a@StackArgs {..} = do
tupleToAsync
:: (StackI, Instrumentation)
-> IO (Async (StackI, Either PatternMatched (ExitCode, (), ())))
tupleToAsync (stacki, instrum) = async $ (stacki,) <$> runI instrum
tupleToAsync (stacki, instrum) = async $ (stacki, ) <$> runI instrum
......@@ -83,12 +83,11 @@ verboseShell' command input =
printCommand command >> shellStrictWithErr command input
cleanSocket = sudoRemoveFile printError "socket"
cleanLog = sudoRemoveFile printWarning "log file"
cleanLog = sudoRemoveFile printWarning "log folder"
kbInstallHandler :: IO () -> IO Handler
kbInstallHandler h = installHandler keyboardSignal (Catch h) Nothing
data PatternMatched = PatternMatched deriving (Show, Typeable)
instance Exception PatternMatched
......@@ -125,7 +124,6 @@ runI (Instrumentation cp outlog@(StdOutLog out) errlog@(StdErrLog err) t) = try
untilMatch message
_ -> return ()
processBehaviorToI :: CreateProcess -> ProcessBehavior -> Maybe Instrumentation
processBehaviorToI cp = \case
DontRun -> Nothing
......
......@@ -17,12 +17,8 @@ opts :: StackArgs -> Parser (Shell ())
opts sa = hsubparser
( command "clean"
(info (pure $ clean sa) (progDesc "Clean sockets, logfiles."))
<> command
"full-stack"
(info (fullStack <$> parseExtendStackArgs sa)
(progDesc "Setup stack and run a command in a container.")
)
<> commandTest DaemonOnly
<> commandTest DaemonAndApp
<> commandTest TestHello
<> commandTest TestListen
<> commandTest TestPerfwrapper
......@@ -39,12 +35,12 @@ opts sa = hsubparser
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)
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 = DaemonOnly | DaemonApp | TestHello | TestListen | TestPerfwrapper | TestPower deriving Show
data TestType = DaemonOnly | DaemonAndApp | TestHello | TestListen | TestPerfwrapper | TestPower deriving Show
data TestSpec = TestSpec
{ stackArgsUpdate :: StackArgs -> StackArgs
......@@ -64,26 +60,25 @@ doSpec spec stackArgs = do
fullStack stackArgs
printSuccess "Test Successful."
configureTest :: TestType -> TestSpec
configureTest = \case
DaemonOnly -> TestSpec
{ stackArgsUpdate = \sa -> sa { daemon = daemonBehavior }
, description = "Set up and launch the daemon in synchronous mode."
}
DaemonApp -> TestSpec
DaemonAndApp -> TestSpec
{ stackArgsUpdate = \sa ->
sa { daemon = daemonBehavior, cmdrun = runBehavior }
, description = "Set up and start daemon, run a command in a container."
}
TestHello -> TestSpec
{ stackArgsUpdate = \sa -> sa
{ app = AppName "echo"
, args = AppArgs [msg]
, cmdlisten = SucceedTestOnMessage
(TestText msg)
(StdOutLog "monitored-cmdrun-out.log")
(StdErrLog "monitored-cmdrun-err.log")
{ app = AppName "echo"
, args = AppArgs [msg]
, daemon = daemonBehavior
, cmdrun = SucceedTestOnMessage (TestText msg)
(StdOutLog "monitored-cmdrun-out.log")
(StdErrLog "monitored-cmdrun-err.log")
}
, description = "1: Setup stack and check that a hello world app sends \
\message back to cmd."
......@@ -92,6 +87,8 @@ configureTest = \case
{ stackArgsUpdate = \sa -> sa
{ app = AppName "sleep"
, args = AppArgs ["15"]
, daemon = daemonBehavior
, cmdrun = runBehavior
, cmdlisten = listentestBehavior (TestText "pub message")
}
, description = "2: Setup stack and check that argo-perf-wrapper sends\
......@@ -102,7 +99,9 @@ configureTest = \case
{ manifestName = "perfwrap.json"
, app = AppName "sleep"
, args = AppArgs ["15"]
, cmdlisten = listentestBehavior (TestText "progress")
, daemon = daemonBehavior
, cmdrun = runBehavior
, cmdlisten = listentestBehavior (TestText "performance")
}
, description = "3: Setup stack and check that argo-perf-wrapper sends\
\ at least one *performance* message to cmd listen through the\
......@@ -112,6 +111,8 @@ configureTest = \case
{ stackArgsUpdate = \sa -> sa
{ app = AppName "sleep"
, args = AppArgs ["15"]
, daemon = daemonBehavior
, cmdrun = runBehavior
, cmdlisten = listentestBehavior (TestText "power")
}
, description = "4: Setup stack and check that argo-perf-wrapper sends\
......@@ -120,17 +121,15 @@ configureTest = \case
}
where
msg = "someComplicatedMessage"
daemonBehavior =
JustRun (StdOutLog "daemon_out.log") (StdErrLog "daemon_err.log")
runBehavior =
JustRun (StdOutLog "cmd_run_out.log") (StdErrLog "cmd_run_err.log")
daemonBehavior = JustRun (StdOutLog "daemon_out.log") (StdErrLog "daemon_err.log")
runBehavior = JustRun (StdOutLog "cmd_run_out.log") (StdErrLog "cmd_run_err.log")
listentestBehavior t = SucceedTestOnMessage
t
(StdOutLog "cmd_listen_out.log")
(StdErrLog "cmd_listen_err.log")
fullStack :: StackArgs -> Shell ()
fullStack a@StackArgs {..} = runListenStack a >>= \case
fullStack a@StackArgs {..} = runStack a >>= \case
FoundMessage -> printSuccess "Found message!\n"
MessageNotFound -> printError "Message not found.\n" >> exit (ExitFailure 1)
Died stacki ExitSuccess ->
......
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