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

`argotk.hs tests` runs all the tests.

.gitlab-ci.yml

@@ -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

argo/src/Argo/Stack.hs

@@ -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

argo/src/Argo/Utils.hs

@@ -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)
 

argotk/argotk.hs

@@ -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"
-                   , 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."
-         )
-       )
+  <> 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)
 
-simpleStack :: StackArgs -> IO ()
-simpleStack a@StackArgs {..} = sh $ runSimpleStack a >>= \case
-  FoundMessage -> printSuccess "Found message!\n" >> exit ExitSuccess
-  DaemonDied ->
-    printError "Daemon died unexpectedly.\n" >> exit (ExitFailure 1)
-  CmdDied -> do
-    when
-        (   or
-        $   isJust
-        <$> [ messageDaemonOut
-            , messageDaemonErr
-            , messageCmdRunOut
-            , messageCmdRunErr
-            ]
-        )
-      $ printError "Did not find message.\n"
-    exit (ExitFailure 1)
+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
+                                  }
+    , 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 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