#! /usr/bin/env runhaskell {-# LANGUAGE OverloadedStrings, LambdaCase, RecordWildCards #-} import Argo.Stack import Argo.Utils import Turtle import Prelude hiding ( FilePath ) import Data.Default import Control.Concurrent.Async import System.Environment import System.Console.ANSI import System.Console.ANSI.Types ( Color ) import Options.Applicative 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" (info (runDaemon <$> parseExtendStackArgs sa) (progDesc "Set up and launch the daemon in synchronous mode, \ \with properly cleaned sockets, logfiles." ) ) <> command "stack" (info (runSimpleStack <$> 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" }) ) (progDesc "Test 1: Setup stack and check that a hello world app sends \ \message back to cmd." ) ) <> command "perfwrapper" (info (runWaitForMessage "progress" <$> parseExtendStackArgs (sa { manifestName = "perfwrap.json" , app = format ("sleep " % s) "5" } ) ) (progDesc "Test 2: Setup stack and check that argo-perf-wrapper sends \ \ at least one progress message up." ) ) <> 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." ) main :: IO () main = do manifests <- getEnv "MANIFESTS" 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 runClean :: StackArgs -> IO () runClean = sh . cleanLeftovers runDaemon :: StackArgs -> IO () runDaemon a = sh $ prepareDaemonShell a >>= liftIO