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

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

Valentin Reis's avatar
Valentin Reis committed
17
import           Protolude
Valentin Reis's avatar
Valentin Reis committed
18
import           Data.Foldable                  ( for_ )
Valentin Reis's avatar
Valentin Reis committed
19
import           Argo.Stack
20
import           Argo.Types
Valentin Reis's avatar
Valentin Reis committed
21
import           Argo.Args
Valentin Reis's avatar
Valentin Reis committed
22 23 24 25
import           Turtle                  hiding ( repr )
import           Prelude                 hiding ( FilePath
                                                , show
                                                )
Valentin Reis's avatar
Valentin Reis committed
26 27 28 29
import           Data.Default
import           System.Environment
import           Options.Applicative     hiding ( action )
import           Data.Text                     as T
30
                                                ( unpack
31
                                                , pack
32 33
                                                , Text
                                                )
Valentin Reis's avatar
Valentin Reis committed
34
import           System.IO
Valentin Reis's avatar
Valentin Reis committed
35

Valentin Reis's avatar
Valentin Reis committed
36 37 38
-- test library
--------------------------------------------------------------------------------

Valentin Reis's avatar
Valentin Reis committed
39
data TestName =
Valentin Reis's avatar
Valentin Reis committed
40 41 42 43 44 45 46 47
    DaemonOnly
  | DaemonAndApp
  | CsvLogs
  | TestHello
  | TestListen
  | TestPerfwrapper
  | TestPower
  | TestSTREAM
Valentin Reis's avatar
Valentin Reis committed
48 49 50 51
  | TestAMG
  | TestQMCPack
  | TestOpenMC
  | TestLAMMPS
Valentin Reis's avatar
Valentin Reis committed
52
  | RunAMG
Valentin Reis's avatar
Valentin Reis committed
53
  | RunQMCPack
Valentin Reis's avatar
Valentin Reis committed
54
  | RunOpenMC
Valentin Reis's avatar
Valentin Reis committed
55 56
  | RunSTREAM
  | RunLAMMPS deriving (Enum,Bounded,Show)
Valentin Reis's avatar
Valentin Reis committed
57

Valentin Reis's avatar
Valentin Reis committed
58 59 60
-- test specification datatype
--------------------------------------------------------------------------------

Valentin Reis's avatar
Valentin Reis committed
61 62 63
data TestSpec = TestSpec
  { stackArgsUpdate :: StackArgs -> StackArgs
  , isTest :: IsTest
64
  , description :: Text }
Valentin Reis's avatar
Valentin Reis committed
65
data IsTest = IsTest | NotTest
Valentin Reis's avatar
Valentin Reis committed
66 67 68 69 70 71
instance Default TestSpec where
  def = TestSpec { stackArgsUpdate = id
                 , isTest = NotTest
                 , description = ""
                 }

Valentin Reis's avatar
Valentin Reis committed
72 73 74 75
-- helpers for building test specifications
--------------------------------------------------------------------------------

mkRun :: (StackArgs -> StackArgs) -> Text -> TestSpec
76
mkRun updater description = TestSpec {stackArgsUpdate = updater . runAppSA, ..}
Valentin Reis's avatar
Valentin Reis committed
77 78 79 80 81 82 83 84 85 86
 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
87
                                   (StdErrLog $ identifier <> ".log")
Valentin Reis's avatar
Valentin Reis committed
88 89 90 91 92 93 94 95 96 97

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
98
--------------------------------------------------------------------------------
Valentin Reis's avatar
Valentin Reis committed
99

Valentin Reis's avatar
Valentin Reis committed
100 101
configureTest :: TestName -> TestSpec

Valentin Reis's avatar
Style.  
Valentin Reis committed
102
configureTest TestHello = TestSpec
Valentin Reis's avatar
Valentin Reis committed
103
  { description     = " Setup stack and check that a hello world app sends"
Valentin Reis's avatar
Valentin Reis committed
104
    <> "message back to cmd's stdout."
Valentin Reis's avatar
Valentin Reis committed
105
  , stackArgsUpdate = updater
Valentin Reis's avatar
Valentin Reis committed
106 107 108 109 110
  , isTest          = IsTest
  }
 where
  msg = "someComplexTextMessage12349"
  updater sa = sa
Valentin Reis's avatar
Style.  
Valentin Reis committed
111 112 113 114 115 116 117 118 119
    { 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
120
    }
Valentin Reis's avatar
Valentin Reis committed
121

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

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

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

Valentin Reis's avatar
Valentin Reis committed
184 185
configureTest TestSTREAM =
  testProgressFromRun RunSTREAM "Test STREAM progress reports."
186
configureTest TestAMG = testProgressFromRun RunAMG "Test AMG progress reports."
Valentin Reis's avatar
Valentin Reis committed
187 188 189 190 191 192
configureTest TestQMCPack =
  testProgressFromRun RunQMCPack "Test QMCPack progress reports."
configureTest TestOpenMC =
  testProgressFromRun RunOpenMC "Test OpenMC progress reports."
configureTest TestLAMMPS =
  testProgressFromRun RunLAMMPS "Test LAMMPS progress reports."
Valentin Reis's avatar
Valentin Reis committed
193

Valentin Reis's avatar
Valentin Reis committed
194
configureTest DaemonOnly = TestSpec
Valentin Reis's avatar
Valentin Reis committed
195 196
  { description     = "Set up and launch the daemon in synchronous mode."
  , stackArgsUpdate = updater
Valentin Reis's avatar
Valentin Reis committed
197
  , isTest          = NotTest
Valentin Reis's avatar
Style.  
Valentin Reis committed
198
  }
Valentin Reis's avatar
Valentin Reis committed
199
  where updater sa = sa { daemon = daemonBehavior }
Valentin Reis's avatar
Valentin Reis committed
200

Valentin Reis's avatar
Valentin Reis committed
201
configureTest DaemonAndApp = TestSpec
Valentin Reis's avatar
Valentin Reis committed
202 203
  { description     = "Set up and start daemon, run a command in a container."
  , stackArgsUpdate = updater
Valentin Reis's avatar
Style.  
Valentin Reis committed
204 205
  , isTest          = NotTest
  }
Valentin Reis's avatar
Valentin Reis committed
206
  where updater sa = sa { daemon = daemonBehavior, cmdrun = runBehavior }
Valentin Reis's avatar
Valentin Reis committed
207

Valentin Reis's avatar
Valentin Reis committed
208 209
configureTest CsvLogs =
  mkRun id "get all logs from a command running in the stack"
Valentin Reis's avatar
Valentin Reis committed
210

Valentin Reis's avatar
Valentin Reis committed
211 212 213
configureTest RunOpenMC = mkRun updater "run OpenMC in the Argo stack."
 where
  updater sa = sa
Valentin Reis's avatar
Valentin Reis committed
214
    { preludeCommand = PreludeCommand $ "cp -r $OPENMC_PWD/* " <> wd
Valentin Reis's avatar
Valentin Reis committed
215
    , app            = AppName "mpiexec"
216
    , args           = fmap AppArg ["-n", "24", "openmc"]
Valentin Reis's avatar
Valentin Reis committed
217
    }
Valentin Reis's avatar
Valentin Reis committed
218
    where (WorkingDirectory wd) = workingDirectory sa
Valentin Reis's avatar
Valentin Reis committed
219

Valentin Reis's avatar
Valentin Reis committed
220 221 222 223
configureTest RunQMCPack = mkRun updater "run QMCPack in the Argo stack."
 where
  updater sa = sa
    { app  = AppName "mpirun"
224 225
    , args = let (ShareDir dirn) = shareDir sa
             in  fmap AppArg ["-n", "24", "qmcpack", dirn <> "/simple-H2O.xml"]
Valentin Reis's avatar
Style.  
Valentin Reis committed
226
    }
Valentin Reis's avatar
Valentin Reis committed
227

Valentin Reis's avatar
Valentin Reis committed
228 229 230 231
configureTest RunAMG = mkRun updater "run AMG in the Argo stack."
 where
  updater sa = sa
    { app  = AppName "mpiexec"
232
    , vars = vars sa ++ [(EnvVar "OMP_NUM_THREADS", "1")]
233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248
    , args = fmap
               AppArg
               [ "-n"
               , "24"
               , "amg"
               , "-problem"
               , "2"
               , "-n"
               , "90"
               , "90"
               , "90"
               , "-P"
               , "2"
               , "24"
               , "1"
               ]
Valentin Reis's avatar
Style.  
Valentin Reis committed
249
    }
Valentin Reis's avatar
Valentin Reis committed
250

Valentin Reis's avatar
Valentin Reis committed
251
configureTest RunSTREAM = mkRun updater "run STREAM in the Argo stack."
Valentin Reis's avatar
Valentin Reis committed
252 253 254 255 256 257 258 259
 where
  updater sa = sa
    { app  = AppName "stream_c"
    , vars = vars sa
               ++ [ (EnvVar "OMP_NUM_THREADS", "24")
                  , (EnvVar "OMP_PLACES"     , "cores")
                  ]
    }
Valentin Reis's avatar
Valentin Reis committed
260 261 262 263 264

configureTest RunLAMMPS = mkRun updater "run LAMMPS in the argo stack."
 where
  updater sa = sa
    { app  = AppName "mpirun"
Valentin Reis's avatar
Valentin Reis committed
265 266 267 268 269 270 271 272 273 274 275
    , args = let (ShareDir dirn) = shareDir sa
             in  fmap
                   AppArg
                   [ "-n"
                   , "24"
                   , "-bind-to"
                   , "core"
                   , "lmp_mpi"
                   , "-i"
                   , dirn <> "/modified.lj"
                   ]
Valentin Reis's avatar
Style.  
Valentin Reis committed
276 277
    }

Valentin Reis's avatar
Valentin Reis committed
278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293
-- 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
294 295 296 297 298 299 300 301 302
    { cmdlistenprogress    = Test
                               (TestText
                                 (TextBehaviorStdout (WaitFor "progress"))
                                 (TextBehaviorStderr ExpectClean)
                               )
                               (StdOutLog "progress_stdout.csv")
                               (StdErrLog "progress_stderr.log")
    , cmdlistenpower       = DontRun
    , cmdlisten            = DontRun
303
    , cmdlistenperformance = DontRun
304 305
    , manifestName         = "basic.json"
    , hwThreadCount        = HwThreadCount 2
Valentin Reis's avatar
Valentin Reis committed
306 307
    }

Valentin Reis's avatar
Valentin Reis committed
308
-- parsing and building the shell monad
Valentin Reis's avatar
Valentin Reis committed
309 310
--------------------------------------------------------------------------------

Valentin Reis's avatar
Valentin Reis committed
311
opts :: StackArgs -> Parser (IO ())
Valentin Reis's avatar
Valentin Reis committed
312 313 314
opts sa = hsubparser
  (  command "clean"
             (info (pure $ clean sa) (progDesc "Clean sockets, logfiles."))
Valentin Reis's avatar
Valentin Reis committed
315 316 317
  <> mconcat (fmap (commandTest sa) [(minBound :: TestName) ..])
  <> commandTests sa
                  [TestQMCPack, TestLAMMPS, TestOpenMC, TestAMG, TestSTREAM]
Valentin Reis's avatar
Valentin Reis committed
318 319
                  "testApplications"
                  "Run application CI tests"
Valentin Reis's avatar
Valentin Reis committed
320 321
  <> commandTests sa
                  [TestHello, TestListen]
Valentin Reis's avatar
Valentin Reis committed
322 323 324 325 326 327 328 329
                  "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
330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359

action :: StackArgs -> TestName -> Parser (IO ())
action sa testName = doOverridenTest testName
  <$> parseExtendStackArgs ((stackArgsUpdate $ configureTest testName) sa)

commandTests
  :: StackArgs -> [TestName] -> String -> Text -> Mod CommandFields (IO ())
commandTests sa testNames cmdStr descStr = command cmdStr
  $ info (pure $ for_ testNames (doTest sa)) (progDesc $ T.unpack descStr)

commandTest :: StackArgs -> TestName -> Mod CommandFields (IO ())
commandTest sa testName = command (show testName)
  $ info (action sa testName) (progDesc $ T.unpack $ descTest testName)

descTest :: TestName -> Text
descTest testName = description (configureTest testName)

doTest :: StackArgs -> TestName -> IO ()
doTest stackArgs testName = doSpec spec
  $ (stackArgsUpdate $ configureTest testName) stackArgs
  where spec = configureTest testName

doOverridenTest :: TestName -> StackArgs -> IO ()
doOverridenTest testName = doSpec spec where spec = configureTest testName

doSpec :: TestSpec -> StackArgs -> IO ()
doSpec spec stackArgs = do
  putText $ description spec
  fullStack (isTest spec) stackArgs
  putText "Test Successful.\n"
Valentin Reis's avatar
Valentin Reis committed
360

Valentin Reis's avatar
Valentin Reis committed
361 362
-- executors
--------------------------------------------------------------------------------
Valentin Reis's avatar
Valentin Reis committed
363

Valentin Reis's avatar
Valentin Reis committed
364
fullStack :: IsTest -> StackArgs -> IO ()
Valentin Reis's avatar
Valentin Reis committed
365 366 367
fullStack isTest a@StackArgs {..} = do
  stackOutput <- runStack a
  case stackOutput of
Valentin Reis's avatar
Valentin Reis committed
368
    FoundMessage    msg -> putText $ "Found string in message:" <> toS msg
Valentin Reis's avatar
Valentin Reis committed
369
    FoundTracebacks tsl -> do
Valentin Reis's avatar
Valentin Reis committed
370
      for_ tsl $ \(stacki, fout, ferr) ->
Valentin Reis's avatar
Valentin Reis committed
371
        putText
Valentin Reis's avatar
Valentin Reis committed
372
          $  "Found Python Traceback when executing "
Valentin Reis's avatar
Valentin Reis committed
373
          <> show stacki
Valentin Reis's avatar
Valentin Reis committed
374
          <> ". Files for this command: "
Valentin Reis's avatar
Valentin Reis committed
375
          <> toS fout
Valentin Reis's avatar
Valentin Reis committed
376
          <> " "
Valentin Reis's avatar
Valentin Reis committed
377
          <> toS ferr
Valentin Reis's avatar
Valentin Reis committed
378
      exit (ExitFailure 1)
379
    Died stacki errorcode _ _ tsl -> case isTest of
Valentin Reis's avatar
Valentin Reis committed
380
      IsTest -> do
Valentin Reis's avatar
Valentin Reis committed
381 382
        putText
          (  show stacki
383
          <> " died before a message could be found with error code "
Valentin Reis's avatar
Valentin Reis committed
384
          <> show errorcode
385
          )
Valentin Reis's avatar
Valentin Reis committed
386 387
        for_
          tsl
Valentin Reis's avatar
Valentin Reis committed
388
          (\(stacki', fout, ferr) ->
Valentin Reis's avatar
Valentin Reis committed
389
            putText
Valentin Reis's avatar
Valentin Reis committed
390
              $  "Found Python Traceback when executing "
Valentin Reis's avatar
Valentin Reis committed
391
              <> show stacki'
Valentin Reis's avatar
Valentin Reis committed
392
              <> ". Files for this command: "
Valentin Reis's avatar
Valentin Reis committed
393
              <> toS fout
Valentin Reis's avatar
Valentin Reis committed
394
              <> " "
Valentin Reis's avatar
Valentin Reis committed
395
              <> toS ferr
Valentin Reis's avatar
Valentin Reis committed
396 397 398 399
          )
        exit (ExitFailure 1)
      NotTest -> exit ExitSuccess

Valentin Reis's avatar
Valentin Reis committed
400
clean :: StackArgs -> IO ()
Valentin Reis's avatar
Valentin Reis committed
401 402
clean StackArgs {..} = cleanLeftovers workingDirectory

Valentin Reis's avatar
Valentin Reis committed
403 404
-- the entry point with dirty setup IO and env. var fuckery, and finally
-- executing the shell monad.
Valentin Reis's avatar
Valentin Reis committed
405
--------------------------------------------------------------------------------
Valentin Reis's avatar
Valentin Reis committed
406 407
main :: IO ()
main = do
Valentin Reis's avatar
Valentin Reis committed
408
  hSetBuffering System.IO.stdout NoBuffering
Valentin Reis's avatar
Valentin Reis committed
409
  argonixShare <- getEnv "ARGOTK_SHARE"
410
  outputDir    <- getEnv "ARGOTK_BASEWD"
411
  vars <- fmap (\(v, y) -> (EnvVar $ T.pack v, T.pack y)) <$> getEnvironment
412
  hwlocTC      <- single $ inshell "hwloc-calc machine:0 -N PU" empty
Valentin Reis's avatar
Style.  
Valentin Reis committed
413
  let a = def
414 415 416 417
        { shareDir         = ShareDir $ toS argonixShare
        , vars             = vars
        , workingDirectory = WorkingDirectory $ toS outputDir
        , hwThreadCount    = HwThreadCount (read $ unpack $ lineToText hwlocTC)
Valentin Reis's avatar
Style.  
Valentin Reis committed
418
        }
Valentin Reis's avatar
Valentin Reis committed
419
  join $ execParser (info (opts a <**> helper) idm)