argotk.hs 6.14 KB
Newer Older
1 2
#! /usr/bin/env runhaskell

3
{-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-}
4 5 6

import           Argo.Stack
import           Argo.Utils
7
import           Argo.Args
8 9 10 11
import           Turtle
import           Prelude                 hiding ( FilePath )
import           Data.Default
import           System.Environment
Valentin Reis's avatar
Valentin Reis committed
12
import           Options.Applicative     hiding ( action )
13 14
import           Data.Text                     as T
                                                ( pack )
15

16
opts :: StackArgs -> Parser (Shell ())
17 18
opts sa = hsubparser
  (  command "clean"
19
             (info (pure $ clean sa) (progDesc "Clean sockets, logfiles."))
20
  <> (mconcat $ fmap commandTest [(minBound :: TestType) ..])
21 22
  <> commandTests [TestHello, TestListen, TestPerfwrapper]
                  "tests"
23
                  "Run hardware-independent CI tests"
24 25 26 27
  <> 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."
28
  )
29 30 31 32
 where
  action ttype = doOverridenTest ttype
    <$> parseExtendStackArgs ((stackArgsUpdate $ configureTest ttype) sa)
  descTest ttype = "test" ++ description (configureTest ttype)
33 34
  commandTest ttype =
    command (show ttype) $ info (action ttype) (progDesc $ descTest ttype)
Valentin Reis's avatar
Valentin Reis committed
35 36
  commandTests ttypes cmdStr descStr =
    command cmdStr $ info (pure $ mapM_ (doTest sa) ttypes) (progDesc descStr)
37

38 39 40 41 42 43 44 45
data TestType =
    DaemonOnly
  | DaemonAndApp
  | CsvLogs
  | TestHello
  | TestListen
  | TestPerfwrapper
  | TestPower deriving (Enum,Bounded,Show)
46

Valentin Reis's avatar
Valentin Reis committed
47 48
data TestSpec = TestSpec
  { stackArgsUpdate :: StackArgs -> StackArgs
49
  , isTest :: IsTest
Valentin Reis's avatar
Valentin Reis committed
50 51 52 53 54
  , description :: String }

doTest :: StackArgs -> TestType -> Shell ()
doTest stackArgs ttype = doSpec spec
  $ (stackArgsUpdate $ configureTest ttype) stackArgs
55 56 57
  where spec = configureTest ttype

doOverridenTest :: TestType -> StackArgs -> Shell ()
Valentin Reis's avatar
Valentin Reis committed
58
doOverridenTest ttype = doSpec spec where spec = configureTest ttype
59

Valentin Reis's avatar
Valentin Reis committed
60
doSpec :: TestSpec -> StackArgs -> Shell ()
61 62
doSpec spec stackArgs = do
  printTest $ T.pack $ description spec
63
  fullStack (isTest spec) stackArgs
64 65 66 67
  printSuccess "Test Successful."

configureTest :: TestType -> TestSpec
configureTest = \case
Valentin Reis's avatar
Valentin Reis committed
68 69 70
  DaemonOnly -> TestSpec
    { stackArgsUpdate = \sa -> sa { daemon = daemonBehavior }
    , description     = "Set up and launch the daemon in synchronous mode."
71
    , isTest          = IsTest False
Valentin Reis's avatar
Valentin Reis committed
72
    }
73
  DaemonAndApp -> TestSpec
74 75 76 77 78 79 80 81 82 83 84
    { stackArgsUpdate = \sa -> sa
      { daemon            = daemonBehavior
      , cmdrun            = runBehavior
      , cmdlistenprogress = JustRun (StdOutLog "progress.csv")
                                    (StdErrLog "progress.log")
      , cmdlistenpower = JustRun (StdOutLog "power.csv") (StdErrLog "power.log")
      }
    , description     = "Set up and start daemon, run a command in a container."
    , isTest          = IsTest False
    }
  CsvLogs -> TestSpec
Valentin Reis's avatar
Valentin Reis committed
85 86 87
    { stackArgsUpdate = \sa ->
      sa { daemon = daemonBehavior, cmdrun = runBehavior }
    , description     = "Set up and start daemon, run a command in a container."
88
    , isTest          = IsTest False
Valentin Reis's avatar
Valentin Reis committed
89
    }
90
  TestHello -> TestSpec
Valentin Reis's avatar
Valentin Reis committed
91
    { stackArgsUpdate = \sa -> sa
92 93 94 95 96 97
      { app    = AppName "echo"
      , args   = AppArgs [msg]
      , daemon = daemonBehavior
      , cmdrun = SucceedTestOnMessage (TestText msg)
                                      (StdOutLog "monitored-cmdrun-out.log")
                                      (StdErrLog "monitored-cmdrun-err.log")
Valentin Reis's avatar
Valentin Reis committed
98
      }
99 100
    , description = "1: Setup stack and check that a hello world app sends \
                    \message back to cmd."
101
    , isTest = IsTest True
102 103
    }
  TestListen -> TestSpec
Valentin Reis's avatar
Valentin Reis committed
104 105 106
    { stackArgsUpdate = \sa -> sa
      { app       = AppName "sleep"
      , args      = AppArgs ["15"]
107 108
      , daemon    = daemonBehavior
      , cmdrun    = runBehavior
Valentin Reis's avatar
Valentin Reis committed
109 110
      , cmdlisten = listentestBehavior (TestText "pub message")
      }
111 112
    , description = "2: Setup stack and check that argo-perf-wrapper sends\
                    \ at least one message to the daemon."
113
    , isTest = IsTest True
114 115
    }
  TestPerfwrapper -> TestSpec
Valentin Reis's avatar
Valentin Reis committed
116 117 118 119
    { stackArgsUpdate = \sa -> sa
      { manifestName = "perfwrap.json"
      , app          = AppName "sleep"
      , args         = AppArgs ["15"]
120 121 122
      , daemon       = daemonBehavior
      , cmdrun       = runBehavior
      , cmdlisten    = listentestBehavior (TestText "performance")
Valentin Reis's avatar
Valentin Reis committed
123
      }
124 125 126
    , description = "3: Setup stack and check that argo-perf-wrapper sends\
                    \ at least one *performance* message to cmd listen through the\
                    \ daemon."
127
    , isTest = IsTest True
128
    }
Valentin Reis's avatar
Valentin Reis committed
129
  TestPower -> TestSpec
Valentin Reis's avatar
Valentin Reis committed
130 131 132
    { stackArgsUpdate = \sa -> sa
      { app       = AppName "sleep"
      , args      = AppArgs ["15"]
133 134
      , daemon    = daemonBehavior
      , cmdrun    = runBehavior
Valentin Reis's avatar
Valentin Reis committed
135 136
      , cmdlisten = listentestBehavior (TestText "power")
      }
Valentin Reis's avatar
Valentin Reis committed
137 138 139
    , description = "4: Setup stack and check that argo-perf-wrapper sends\
                    \ at least one *power* message to cmd listen through the\
                    \ daemon."
140
    , isTest = IsTest True
Valentin Reis's avatar
Valentin Reis committed
141
    }
Valentin Reis's avatar
Valentin Reis committed
142 143
 where
  msg = "someComplicatedMessage"
144 145 146 147
  daemonBehavior =
    JustRun (StdOutLog "daemon_out.log") (StdErrLog "daemon_err.log")
  runBehavior =
    JustRun (StdOutLog "cmd_run_out.log") (StdErrLog "cmd_run_err.log")
Valentin Reis's avatar
Valentin Reis committed
148 149 150 151
  listentestBehavior t = SucceedTestOnMessage
    t
    (StdOutLog "cmd_listen_out.log")
    (StdErrLog "cmd_listen_err.log")
152

153 154 155 156 157 158 159 160 161 162 163 164 165 166 167
newtype IsTest = IsTest Bool

fullStack :: IsTest -> StackArgs -> Shell ()
fullStack (IsTest b) a@StackArgs {..} = runStack a >>= \case
  FoundMessage          -> printSuccess "Found message!\n"
  Died stacki errorcode -> if b
    then
      printError
          (  repr stacki
          <> " died before a message could be found:"
          <> repr errorcode
          <> "\n"
          )
        >> exit (ExitFailure 1)
    else exit (ExitSuccess)
168

169
clean :: StackArgs -> Shell ()
Valentin Reis's avatar
Valentin Reis committed
170
clean StackArgs {..} = cleanLeftovers workingDirectory
171 172 173 174

main :: IO ()
main = do
  manifests <- getEnv "MANIFESTS"
Valentin Reis's avatar
Valentin Reis committed
175
  let a = def { manifestDir = ManifestDir $ decodeString manifests }
176 177
  turtle <- execParser (info (opts a <**> helper) idm)
  sh turtle