[refactor] Refactored the codebase.

Tests are now simpler, more extensible, don't leave hanging processes,
do not wrap in cmd, and allow ad-hoc monitoring of all stdout and stderr
redirections.

.gitignore

 .argo_nodeos_config_exit_message
+_output
 result
 .shake
 *.log

argo/argo.cabal

@@ -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, optparse-applicative, extra
+  build-depends:       base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async, process, text, optparse-applicative, extra, foldl, conduit,conduit-extra, bytestring
   hs-source-dirs:      src
   default-language:    Haskell2010

argo/src/Argo/Utils.hs

 {-# LANGUAGE LambdaCase, OverloadedStrings, DataKinds,
-  FlexibleInstances, TypeOperators #-}
+  FlexibleInstances, TypeOperators, RecordWildCards #-}
 
 module Argo.Utils where
 
@@ -9,6 +9,15 @@ import           System.Console.ANSI
 import           System.Console.ANSI.Types      ( Color )
 import           System.Posix.Signals
 import           System.Process          hiding ( shell )
+import           Data.Conduit
+import           Data.Conduit.Process    hiding ( shell )
+import           Data.ByteString               as B
+                                         hiding ( empty )
+import           Data.Text.Encoding            as TE
+import           Data.Conduit.Combinators      as CC
+import           Control.Exception.Base
+import           Data.Typeable
+import           Data.Text                     as T
 
 -- | Miscellaneous printing utilities
 colorShell :: Color -> Shell () -> Shell ()
@@ -50,7 +59,7 @@ sudoRemoveFile printer desc filePath = do
     printer $ format ("found stale " % s % " at " % fp % ".. ") desc filePath
     shell
         (format ((if useSudo then "sudo " else "") % "rm -f " % fp) filePath)
-        empty
+        Turtle.empty
       >>= \case
             ExitSuccess -> colorShell Green $ printf " Successfully removed.\n"
             ExitFailure n -> if useSudo
@@ -71,3 +80,43 @@ cleanLog = sudoRemoveFile printWarning "log file"
 
 kbInstallHandler :: IO () -> IO Handler
 kbInstallHandler h = installHandler keyboardSignal (Catch h) Nothing
+
+
+data PatternMatched = PatternMatched deriving (Show, Typeable)
+instance Exception PatternMatched
+
+data Instrumentation = Instrumentation
+  { process    :: CreateProcess
+  , stdOutFile :: FilePath
+  , stdErrFile :: FilePath
+  , messageOut :: Maybe Text
+  , messageErr :: Maybe Text } deriving (Show)
+
+makeInstrumentedProcess
+  :: Instrumentation -> Shell (IO (Either PatternMatched (ExitCode, (), ())))
+makeInstrumentedProcess instrumentation@Instrumentation {..} = do
+  printInfo "Prepared a process with full configuration: \n"
+  liftIO $ Prelude.print instrumentation
+  return $ try (reroutedDaemon process)
+ where
+  reroutedDaemon process =
+    withSinkFile (encodeString stdOutFile) $ \outSink ->
+      withSinkFile (encodeString stdErrFile)
+        $ \errSink -> sourceProcessWithStreams
+            process
+            mempty
+            (makeMatcher messageOut .| outSink)
+            (makeMatcher messageErr .| errSink)
+  makeMatcher maybeMessage = case maybeMessage of
+    Just msg -> untilMatch msg
+    Nothing  -> awaitForever yield
+  untilMatch :: Text -> ConduitT ByteString ByteString IO ()
+  untilMatch message = do
+    inb <- await
+    case inb of
+      Just b -> if B.isInfixOf (TE.encodeUtf8 message) b
+        then throw PatternMatched
+        else do
+          yield b
+          untilMatch message
+      _ -> return ()

argotk/argotk.hs

 #! /usr/bin/env runhaskell
 
-{-# LANGUAGE
-  OverloadedStrings,
-  LambdaCase,
-  RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-}
 
 import           Argo.Stack
 import           Argo.Utils
@@ -19,19 +16,12 @@ import           System.Posix.Signals
 import           Control.Monad
 import           Data.Either
 
-messageOption = strOption
-  (  long "message"
-  <> metavar "MESSAGE"
-  <> help "String to look for in the NRM daemon standard output."
-  <> value "progress"
-  )
-
 opts :: StackArgs -> Parser (IO ())
 opts sa = hsubparser
   (  command "clean"
              (info (pure $ runClean sa) (progDesc "Clean sockets, logfiles."))
   <> command
-       "daemon"
+       "daemon-only"
        (info
          (runDaemon <$> parseExtendStackArgs sa)
          (progDesc
@@ -40,26 +30,21 @@ opts sa = hsubparser
          )
        )
   <> command
-       "stack"
-       (info (runSimpleStack <$> parseExtendStackArgs sa)
+       "full-stack"
+       (info (runStack <$> parseExtendStackArgs sa)
              (progDesc "Setup stack and run a command in a container.")
        )
-  <> command
-       "grep"
-       (info
-         (runWaitForMessage <$> messageOption <*> parseExtendStackArgs
-           (sa { app = "echo foobar" })
-         )
-         (progDesc
-           "Setup stack and look for a message in the daemon's \
-           \standard output."
-         )
-       )
   <> command
        "helloworld"
        (info
-         (runCheckCmdOutput "helloworld" <$> parseExtendStackArgs
-           (sa { app = format ("echo " % s) "helloworld" })
+         (runStack <$> parseExtendStackArgs
+           (let msg = "Hello-Moto"
+            in  sa { app           = "echo"
+                   , args          = [msg]
+                   , messageCmdOut = Just msg
+                   , messageCmdErr = Just msg
+                   }
+           )
          )
          (progDesc
            "Test 1: Setup stack and check that a hello world app sends \
@@ -69,9 +54,12 @@ opts sa = hsubparser
   <> command
        "perfwrapper"
        (info
-         (runWaitForMessage "progress" <$> parseExtendStackArgs
-           (sa { manifestName = "perfwrap.json"
-               , app          = format ("sleep " % s) "5"
+         (runStack <$> parseExtendStackArgs
+           (sa { manifestName     = "perfwrap.json"
+               , app              = "sleep"
+               , args             = ["5"]
+               , messageDaemonOut = Just "progress"
+               , messageDaemonErr = Just "progress"
                }
            )
          )
@@ -92,40 +80,15 @@ main = do
   let a = def { manifestDir = decodeString manifests }
   join $ execParser (info (opts a <**> helper) idm)
 
-runCheckCmdOutput :: Text -> StackArgs -> IO ()
-runCheckCmdOutput message a@StackArgs {..} = do
-  sh cleanLeftoverProcesses
-  runSimpleStack a
-  readTextFile cmd_err >>= \x -> case match (has (text message)) x of
-    [] ->
-      sh $ dieRed $ "Cmd did not recieve the '" <> message <> "' message.\n"
-    _ ->
-      sh
-        $ printSuccess
-            "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
-  sh $ printError "WARNING: TODO: DEBUG. THIS TEST CURRENTLY FAILS ONCE PER TWO RUNS AND REPORTS BAD EXIT CODES.\n"
-  runSimpleStackWithCriterion criteria a
-  sh $ dieRed ("Did not find string '" <> message <> "' in daemon stdout.\n")
- where
-  criteria :: (Shell (Either Line Line) -> Shell (Either Line Line))
-  criteria s = s >>= \case
-    Left out -> case match (has (text message)) (lineToText out) of
-      [] -> return $ Left out
-      _  -> do
-        printSuccess
-          $  "Found line containing '"
-          <> message
-          <> "' in daemon stdout.\n"
-        cleanLeftoverProcesses
-        exit ExitSuccess
-    Right err -> return $ Right err
+runStack :: StackArgs -> IO ()
+runStack a@StackArgs {..} = sh $ runSimpleStack a >>= \case
+  FoundMessage -> printSuccess "Found message!\n" >> exit ExitSuccess
+  DaemonDied ->
+    printError "Daemon died unexpectedly.\n" >> exit (ExitFailure 1)
+  CmdDied -> printError "Did not find message.\n" >> exit (ExitFailure 1)
 
 runClean :: StackArgs -> IO ()
 runClean = sh . cleanLeftovers
 
 runDaemon :: StackArgs -> IO ()
-runDaemon a = sh $ prepareDaemonShell a >>= liftIO
+runDaemon a = sh $ cleanLeftovers a >> prepareDaemon a >>= liftIO