argotk.hs 13.5 KB
Newer Older
1 2
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
Valentin Reis's avatar
Valentin Reis committed
3

Valentin Reis's avatar
Valentin Reis committed
4 5 6 7 8
{-|
Module      : argotk.hs
Description : argo provisioner/executor
Copyright   : (c) Valentin Reis, 2018
License     : MIT
Valentin Reis's avatar
Valentin Reis committed
9 10
Maintainer  : fre@freux.fr
-}
Valentin Reis's avatar
Valentin Reis committed
11

Valentin Reis's avatar
Valentin Reis committed
12
import           Data.Coerce                    ( coerce )
Valentin Reis's avatar
Valentin Reis committed
13 14
import           Argo.Stack
import           Argo.Utils
15
import           Argo.Types
Valentin Reis's avatar
Valentin Reis committed
16
import           Argo.Args
Valentin Reis's avatar
Valentin Reis committed
17
import           Turtle
Valentin Reis's avatar
Valentin Reis committed
18 19 20 21 22
import           Prelude                 hiding ( FilePath )
import           Data.Default
import           System.Environment
import           Options.Applicative     hiding ( action )
import           Data.Text                     as T
23 24 25
                                                ( unpack
                                                , Text
                                                )
Valentin Reis's avatar
Valentin Reis committed
26
import           System.IO
Valentin Reis's avatar
Valentin Reis committed
27

Valentin Reis's avatar
Valentin Reis committed
28 29 30
-- test library
--------------------------------------------------------------------------------

31
data TestName =
Valentin Reis's avatar
Valentin Reis committed
32 33 34 35 36 37 38 39
    DaemonOnly
  | DaemonAndApp
  | CsvLogs
  | TestHello
  | TestListen
  | TestPerfwrapper
  | TestPower
  | TestSTREAM
Valentin Reis's avatar
Valentin Reis committed
40 41 42 43
  | TestAMG
  | TestQMCPack
  | TestOpenMC
  | TestLAMMPS
Valentin Reis's avatar
Valentin Reis committed
44
  | RunAMG
Valentin Reis's avatar
Valentin Reis committed
45
  | RunQMCPack
Valentin Reis's avatar
Valentin Reis committed
46
  | RunOpenMC
Valentin Reis's avatar
Valentin Reis committed
47 48
  | RunSTREAM
  | RunLAMMPS deriving (Enum,Bounded,Show)
Valentin Reis's avatar
Valentin Reis committed
49

Valentin Reis's avatar
Valentin Reis committed
50 51 52
-- test specification datatype
--------------------------------------------------------------------------------

Valentin Reis's avatar
Valentin Reis committed
53 54 55
data TestSpec = TestSpec
  { stackArgsUpdate :: StackArgs -> StackArgs
  , isTest :: IsTest
56
  , description :: Text }
Valentin Reis's avatar
Valentin Reis committed
57
data IsTest = IsTest | NotTest
Valentin Reis's avatar
Valentin Reis committed
58 59 60 61 62 63
instance Default TestSpec where
  def = TestSpec { stackArgsUpdate = id
                 , isTest = NotTest
                 , description = ""
                 }

64 65 66 67 68

-- helpers for building test specifications
--------------------------------------------------------------------------------

mkRun :: (StackArgs -> StackArgs) -> Text -> TestSpec
69
mkRun updater description = TestSpec {stackArgsUpdate = updater . runAppSA, ..}
70 71 72 73 74 75 76 77 78 79
 where
  isTest = NotTest
  runAppSA sa = sa { manifestName         = "parallel.json"
                   , daemon               = daemonBehavior
                   , cmdrun               = runBehavior
                   , cmdlistenperformance = csvBehavior "performance"
                   , cmdlistenpower       = csvBehavior "power"
                   , cmdlistenprogress    = csvBehavior "progress"
                   }
  csvBehavior identifier = JustRun (StdOutLog $identifier <> ".csv")
Valentin Reis's avatar
Valentin Reis committed
80
                                   (StdErrLog $ identifier <> ".log")
81 82 83 84 85 86 87 88 89 90

daemonBehavior :: ProcessBehavior
daemonBehavior =
  JustRun (StdOutLog "daemon_out.log") (StdErrLog "daemon_err.log")

runBehavior :: ProcessBehavior
runBehavior =
  JustRun (StdOutLog "cmd_run_out.log") (StdErrLog "cmd_run_err.log")

-- the interesting part, mapping test name to test specification
Valentin Reis's avatar
Valentin Reis committed
91
--------------------------------------------------------------------------------
Valentin Reis's avatar
Valentin Reis committed
92

93 94
configureTest :: TestName -> TestSpec

Valentin Reis's avatar
Valentin Reis committed
95
configureTest TestHello = TestSpec
Valentin Reis's avatar
Valentin Reis committed
96
  { description     = " Setup stack and check that a hello world app sends"
Valentin Reis's avatar
Valentin Reis committed
97
    <> "message back to cmd's stdout."
Valentin Reis's avatar
Valentin Reis committed
98
  , stackArgsUpdate = updater
Valentin Reis's avatar
Valentin Reis committed
99 100 101 102 103
  , isTest          = IsTest
  }
 where
  msg = "someComplexTextMessage12349"
  updater sa = sa
Valentin Reis's avatar
Valentin Reis committed
104 105 106 107 108 109 110 111 112
    { app    = AppName "echo"
    , args   = [AppArg msg]
    , daemon = daemonBehavior
    , cmdrun = Test
                 (TestText (TextBehaviorStdout (WaitFor msg))
                           (TextBehaviorStderr ExpectClean)
                 )
                 (StdOutLog "monitored-cmdrun-out.log")
                 (StdErrLog "monitored-cmdrun-err.log")
Valentin Reis's avatar
Valentin Reis committed
113
    }
114

Valentin Reis's avatar
Valentin Reis committed
115
configureTest TestListen = TestSpec
Valentin Reis's avatar
Valentin Reis committed
116
  { description = " Setup stack, run command and check that cmd listen receives"
Valentin Reis's avatar
Valentin Reis committed
117
    <> "at least the container_exit message from the daemon."
Valentin Reis's avatar
Valentin Reis committed
118
  , stackArgsUpdate = updater
Valentin Reis's avatar
Valentin Reis committed
119 120 121 122
  , isTest = IsTest
  }
 where
  updater sa = sa
Valentin Reis's avatar
Valentin Reis committed
123 124 125 126
    { app       = AppName "sleep"
    , args      = [AppArg "1"]
    , daemon    = daemonBehavior
    , cmdrun    = runBehavior
Valentin Reis's avatar
Valentin Reis committed
127
    , cmdlisten = Test
Valentin Reis's avatar
Valentin Reis committed
128 129 130
                    (TestText (TextBehaviorStdout (WaitFor "container_exit"))
                              (TextBehaviorStderr ExpectClean)
                    )
Valentin Reis's avatar
Valentin Reis committed
131 132
                    (StdOutLog "cmd_listen_stdout.log")
                    (StdErrLog "cmd_listen_stderr.log")
Valentin Reis's avatar
Valentin Reis committed
133
    }
134

Valentin Reis's avatar
Valentin Reis committed
135
configureTest TestPerfwrapper = TestSpec
Valentin Reis's avatar
Valentin Reis committed
136
  { description     = " Setup stack and check that argo-perf-wrapper sends"
Valentin Reis's avatar
Valentin Reis committed
137
    <> "at least one *performance* message to cmd listen through the"
Valentin Reis's avatar
Valentin Reis committed
138
  , stackArgsUpdate = updater
Valentin Reis's avatar
Valentin Reis committed
139 140 141 142
  , isTest          = IsTest
  }
 where
  updater sa = sa
Valentin Reis's avatar
Valentin Reis committed
143 144 145 146 147
    { manifestName         = "perfwrap.json"
    , app                  = AppName "sleep"
    , args                 = [AppArg "15"]
    , daemon               = daemonBehavior
    , cmdrun               = runBehavior
Valentin Reis's avatar
Valentin Reis committed
148
    , cmdlistenperformance = Test
Valentin Reis's avatar
Valentin Reis committed
149 150 151 152
                               (TestText
                                 (TextBehaviorStdout (WaitFor "performance"))
                                 (TextBehaviorStderr ExpectClean)
                               )
Valentin Reis's avatar
Valentin Reis committed
153 154
                               (StdOutLog "cmd_listen_performance_stdout.csv")
                               (StdErrLog "cmd_listen_performance_stderr.log")
Valentin Reis's avatar
Valentin Reis committed
155
    }
156

Valentin Reis's avatar
Valentin Reis committed
157
configureTest TestPower = TestSpec
Valentin Reis's avatar
Valentin Reis committed
158
  { description     = " Setup stack and check that the daemon sends"
Valentin Reis's avatar
Valentin Reis committed
159
    <> "at least one *power* message to cmd listen."
Valentin Reis's avatar
Valentin Reis committed
160
  , stackArgsUpdate = updater
Valentin Reis's avatar
Valentin Reis committed
161 162
  , isTest          = IsTest
  }
Valentin Reis's avatar
Valentin Reis committed
163 164
 where
  updater sa = sa
Valentin Reis's avatar
Valentin Reis committed
165 166 167 168
    { app            = AppName "sleep"
    , args           = [AppArg "15"]
    , daemon         = daemonBehavior
    , cmdrun         = runBehavior
Valentin Reis's avatar
Valentin Reis committed
169
    , cmdlistenpower = Test
Valentin Reis's avatar
Valentin Reis committed
170
                         (TestText (TextBehaviorStdout (WaitFor "power"))
171
                                   (TextBehaviorStderr ExpectClean)
Valentin Reis's avatar
Valentin Reis committed
172
                         )
Valentin Reis's avatar
Valentin Reis committed
173 174
                         (StdOutLog "power_stdout.csv")
                         (StdErrLog "power_stderr.log")
Valentin Reis's avatar
Valentin Reis committed
175
    }
176

Valentin Reis's avatar
Valentin Reis committed
177 178
configureTest TestSTREAM =
  testProgressFromRun RunSTREAM "Test STREAM progress reports."
179
configureTest TestAMG = testProgressFromRun RunAMG "Test AMG progress reports."
Valentin Reis's avatar
Valentin Reis committed
180 181 182 183 184 185
configureTest TestQMCPack =
  testProgressFromRun RunQMCPack "Test QMCPack progress reports."
configureTest TestOpenMC =
  testProgressFromRun RunOpenMC "Test OpenMC progress reports."
configureTest TestLAMMPS =
  testProgressFromRun RunLAMMPS "Test LAMMPS progress reports."
186

Valentin Reis's avatar
Valentin Reis committed
187
configureTest DaemonOnly = TestSpec
Valentin Reis's avatar
Valentin Reis committed
188 189
  { description     = "Set up and launch the daemon in synchronous mode."
  , stackArgsUpdate = updater
Valentin Reis's avatar
Valentin Reis committed
190
  , isTest          = NotTest
Valentin Reis's avatar
Valentin Reis committed
191
  }
Valentin Reis's avatar
Valentin Reis committed
192
  where updater sa = sa { daemon = daemonBehavior }
193

Valentin Reis's avatar
Valentin Reis committed
194
configureTest DaemonAndApp = TestSpec
Valentin Reis's avatar
Valentin Reis committed
195 196
  { description     = "Set up and start daemon, run a command in a container."
  , stackArgsUpdate = updater
Valentin Reis's avatar
Valentin Reis committed
197 198
  , isTest          = NotTest
  }
Valentin Reis's avatar
Valentin Reis committed
199
  where updater sa = sa { daemon = daemonBehavior, cmdrun = runBehavior }
200

Valentin Reis's avatar
Valentin Reis committed
201 202
configureTest CsvLogs =
  mkRun id "get all logs from a command running in the stack"
203

Valentin Reis's avatar
Valentin Reis committed
204 205 206 207 208 209 210 211
configureTest RunOpenMC = mkRun updater "run OpenMC in the Argo stack."
 where
  updater sa = sa
    { preludeCommand = PreludeCommand "cp -r $OPENMC_PWD/* ."
    , app            = AppName "mpiexec"
    , args           = let tc = coerce (hwThreadCount sa) :: Int
                       in  fmap AppArg ["-n", repr tc, "openmc"]
    }
212

Valentin Reis's avatar
Valentin Reis committed
213 214 215 216
configureTest RunQMCPack = mkRun updater "run QMCPack in the Argo stack."
 where
  updater sa = sa
    { app  = AppName "mpirun"
Valentin Reis's avatar
Valentin Reis committed
217 218 219
    , args = let tc              = coerce (hwThreadCount sa) :: Int
                 (ShareDir dirn) = shareDir sa
                 Right inpath    = toText (dirn </> "simple-H2O.xml")
Valentin Reis's avatar
Valentin Reis committed
220
             in  fmap AppArg ["-n", repr tc, "qmcpack", inpath]
Valentin Reis's avatar
Valentin Reis committed
221
    }
222

Valentin Reis's avatar
Valentin Reis committed
223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
configureTest RunAMG = mkRun updater "run AMG in the Argo stack."
 where
  updater sa = sa
    { app  = AppName "mpiexec"
    , args = let tc = coerce (hwThreadCount sa) :: Int
             in  fmap
                   AppArg
                   [ "-n"
                   , repr tc
                   , "amg"
                   , "-problem"
                   , "2"
                   , "-n"
                   , "3"
                   , "3"
                   , "3"
                   , "-P"
240 241
                   , "2"
                   , repr $ quot tc 2
Valentin Reis's avatar
Valentin Reis committed
242 243
                   , "1"
                   ]
Valentin Reis's avatar
Valentin Reis committed
244
    }
245

Valentin Reis's avatar
Valentin Reis committed
246 247 248 249 250 251 252
configureTest RunSTREAM = mkRun updater "run STREAM in the Argo stack."
  where updater sa = sa { app = AppName "stream_c" }

configureTest RunLAMMPS = mkRun updater "run LAMMPS in the argo stack."
 where
  updater sa = sa
    { app  = AppName "mpirun"
Valentin Reis's avatar
Valentin Reis committed
253 254
    , args = let (ShareDir dirn) = shareDir sa
                 Right inpath    = toText (dirn </> "modified.lj")
Valentin Reis's avatar
Valentin Reis committed
255 256 257 258 259 260 261 262
             in  fmap
                   AppArg
                   [ "-n"
                   , repr (coerce (hwThreadCount sa) :: Int)
                   , "lmp_mpi"
                   , "-i"
                   , inpath
                   ]
Valentin Reis's avatar
Valentin Reis committed
263 264
    }

Valentin Reis's avatar
Valentin Reis committed
265

Valentin Reis's avatar
Valentin Reis committed
266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281
-- converting a run to a test.
--------------------------------------------------------------------------------

testFromRun :: (StackArgs -> StackArgs) -> TestName -> Text -> TestSpec
testFromRun oldUpdater testName desc = ts { isTest          = IsTest
                                          , description     = desc
                                          , stackArgsUpdate = updater
                                          }
 where
  ts = configureTest testName
  updater sa = oldUpdater $ stackArgsUpdate ts sa

testProgressFromRun :: TestName -> Text -> TestSpec
testProgressFromRun = testFromRun updater
 where
  updater sa = sa
282 283 284 285 286 287 288 289 290
    { cmdlistenprogress    = Test
                               (TestText
                                 (TextBehaviorStdout (WaitFor "progress"))
                                 (TextBehaviorStderr ExpectClean)
                               )
                               (StdOutLog "progress_stdout.csv")
                               (StdErrLog "progress_stderr.log")
    , cmdlistenpower       = DontRun
    , cmdlisten            = DontRun
291
    , cmdlistenperformance = DontRun
292 293
    , manifestName         = "basic.json"
    , hwThreadCount        = HwThreadCount 2
Valentin Reis's avatar
Valentin Reis committed
294 295
    }

296
-- parsing and building the shell monad
Valentin Reis's avatar
Valentin Reis committed
297 298
--------------------------------------------------------------------------------

299 300 301 302 303
opts :: StackArgs -> Parser (Shell ())
opts sa = hsubparser
  (  command "clean"
             (info (pure $ clean sa) (progDesc "Clean sockets, logfiles."))
  <> mconcat (fmap commandTest [(minBound :: TestName) ..])
Valentin Reis's avatar
Valentin Reis committed
304 305 306 307
  <> commandTests [TestQMCPack, TestLAMMPS, TestOpenMC, TestAMG, TestSTREAM]
                  "testApplications"
                  "Run application CI tests"
  <> commandTests [TestHello, TestListen]
308 309 310 311 312 313 314 315
                  "tests"
                  "Run hardware-independent CI tests"
  <> help
       ("Type of test/stack setup 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."
       )
  )
Valentin Reis's avatar
Valentin Reis committed
316
 where
317 318 319 320 321 322 323
  action ttype = doOverridenTest ttype
    <$> parseExtendStackArgs ((stackArgsUpdate $ configureTest ttype) sa)
  descTest ttype = description (configureTest ttype)
  commandTest ttype = command (show ttype)
    $ info (action ttype) (progDesc $ T.unpack $ descTest ttype)
  commandTests ttypes cmdStr descStr = command cmdStr
    $ info (pure $ mapM_ (doTest sa) ttypes) (progDesc $ T.unpack descStr)
Valentin Reis's avatar
Valentin Reis committed
324

325 326 327 328
  doTest :: StackArgs -> TestName -> Shell ()
  doTest stackArgs ttype = doSpec spec
    $ (stackArgsUpdate $ configureTest ttype) stackArgs
    where spec = configureTest ttype
Valentin Reis's avatar
Valentin Reis committed
329

330 331
  doOverridenTest :: TestName -> StackArgs -> Shell ()
  doOverridenTest ttype = doSpec spec where spec = configureTest ttype
Valentin Reis's avatar
Valentin Reis committed
332

333 334 335 336 337
  doSpec :: TestSpec -> StackArgs -> Shell ()
  doSpec spec stackArgs = do
    printTest $ description spec
    fullStack (isTest spec) stackArgs
    printSuccess "Test Successful.\n"
Valentin Reis's avatar
Valentin Reis committed
338

Valentin Reis's avatar
Valentin Reis committed
339 340
-- executors
--------------------------------------------------------------------------------
Valentin Reis's avatar
Valentin Reis committed
341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359

fullStack :: IsTest -> StackArgs -> Shell ()
fullStack isTest a@StackArgs {..} = do
  stackOutput <- runStack a
  case stackOutput of
    FoundMessage    msg -> printSuccess $ "Found string in message:" <> repr msg
    FoundTracebacks tsl -> do
      mapM_
        (\(stacki, fout, ferr) ->
          printError
            $  "Found Python Traceback when executing "
            <> repr stacki
            <> ". Files for this command: "
            <> repr fout
            <> " "
            <> repr ferr
        )
        tsl
      exit (ExitFailure 1)
360
    Died stacki errorcode _ _ tsl -> case isTest of
Valentin Reis's avatar
Valentin Reis committed
361 362
      IsTest -> do
        printError
363 364 365 366
          (  repr stacki
          <> " died before a message could be found with error code "
          <> repr errorcode
          )
Valentin Reis's avatar
Valentin Reis committed
367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383
        mapM_
          (\(stacki', fout, ferr) ->
            printError
              $  "Found Python Traceback when executing "
              <> repr stacki'
              <> ". Files for this command: "
              <> repr fout
              <> " "
              <> repr ferr
          )
          tsl
        exit (ExitFailure 1)
      NotTest -> exit ExitSuccess

clean :: StackArgs -> Shell ()
clean StackArgs {..} = cleanLeftovers workingDirectory

384 385
-- the entry point with dirty setup IO and env. var fuckery, and finally
-- executing the shell monad.
Valentin Reis's avatar
Valentin Reis committed
386
--------------------------------------------------------------------------------
Valentin Reis's avatar
Valentin Reis committed
387 388
main :: IO ()
main = do
Valentin Reis's avatar
Valentin Reis committed
389
  hSetBuffering System.IO.stdout NoBuffering
Valentin Reis's avatar
Valentin Reis committed
390
  argonixShare <- getEnv "ARGOTK_SHARE"
Valentin Reis's avatar
Valentin Reis committed
391 392 393 394 395
  hwlocTC      <- single $ inshell "hwloc-calc machine:0 -N PU" empty
  let a = def
        { shareDir      = ShareDir $ decodeString argonixShare
        , hwThreadCount = HwThreadCount (read $ unpack $ lineToText hwlocTC)
        }
Valentin Reis's avatar
Valentin Reis committed
396 397
  turtle <- execParser (info (opts a <**> helper) idm)
  sh turtle