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

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

Valentin Reis's avatar
Valentin Reis committed
34 35 36
-- test library
--------------------------------------------------------------------------------

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

Valentin Reis's avatar
Valentin Reis committed
56 57 58
-- test specification datatype
--------------------------------------------------------------------------------

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

Valentin Reis's avatar
Valentin Reis committed
70 71 72 73 74

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

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

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

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

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

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

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

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

Valentin Reis's avatar
Valentin Reis committed
183 184
configureTest TestSTREAM =
  testProgressFromRun RunSTREAM "Test STREAM progress reports."
185
configureTest TestAMG = testProgressFromRun RunAMG "Test AMG progress reports."
Valentin Reis's avatar
Valentin Reis committed
186 187 188 189 190 191
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
192

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

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

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

Valentin Reis's avatar
Valentin Reis committed
210 211 212 213 214 215 216 217
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"]
    }
Valentin Reis's avatar
Valentin Reis committed
218

Valentin Reis's avatar
Valentin Reis committed
219 220 221 222
configureTest RunQMCPack = mkRun updater "run QMCPack in the Argo stack."
 where
  updater sa = sa
    { app  = AppName "mpirun"
Valentin Reis's avatar
Style.  
Valentin Reis committed
223 224 225
    , 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
226
             in  fmap AppArg ["-n", repr tc, "qmcpack", inpath]
Valentin Reis's avatar
Style.  
Valentin Reis committed
227
    }
Valentin Reis's avatar
Valentin Reis committed
228

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

Valentin Reis's avatar
Valentin Reis committed
253 254 255 256 257 258 259
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
Style.  
Valentin Reis committed
260 261
    , args = let (ShareDir dirn) = shareDir sa
                 Right inpath    = toText (dirn </> "modified.lj")
Valentin Reis's avatar
Valentin Reis committed
262 263 264 265 266 267 268 269
             in  fmap
                   AppArg
                   [ "-n"
                   , repr (coerce (hwThreadCount sa) :: Int)
                   , "lmp_mpi"
                   , "-i"
                   , inpath
                   ]
Valentin Reis's avatar
Style.  
Valentin Reis committed
270 271
    }

Valentin Reis's avatar
Valentin Reis committed
272

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

Valentin Reis's avatar
Valentin Reis committed
303
-- parsing and building the shell monad
Valentin Reis's avatar
Valentin Reis committed
304 305
--------------------------------------------------------------------------------

Valentin Reis's avatar
Valentin Reis committed
306 307 308 309 310
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
311 312 313 314
  <> commandTests [TestQMCPack, TestLAMMPS, TestOpenMC, TestAMG, TestSTREAM]
                  "testApplications"
                  "Run application CI tests"
  <> commandTests [TestHello, TestListen]
Valentin Reis's avatar
Valentin Reis committed
315 316 317 318 319 320 321 322
                  "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
323
 where
Valentin Reis's avatar
Valentin Reis committed
324 325 326 327 328 329
  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
Valentin Reis's avatar
Valentin Reis committed
330
    $ info (pure $ for_ ttypes (doTest sa)) (progDesc $ T.unpack descStr)
Valentin Reis's avatar
Style.  
Valentin Reis committed
331

Valentin Reis's avatar
Valentin Reis committed
332 333 334 335
  doTest :: StackArgs -> TestName -> Shell ()
  doTest stackArgs ttype = doSpec spec
    $ (stackArgsUpdate $ configureTest ttype) stackArgs
    where spec = configureTest ttype
Valentin Reis's avatar
Style.  
Valentin Reis committed
336

Valentin Reis's avatar
Valentin Reis committed
337 338
  doOverridenTest :: TestName -> StackArgs -> Shell ()
  doOverridenTest ttype = doSpec spec where spec = configureTest ttype
Valentin Reis's avatar
Style.  
Valentin Reis committed
339

Valentin Reis's avatar
Valentin Reis committed
340 341 342 343 344
  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
345

Valentin Reis's avatar
Valentin Reis committed
346 347
-- executors
--------------------------------------------------------------------------------
Valentin Reis's avatar
Valentin Reis committed
348 349 350 351 352 353 354

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
Valentin Reis's avatar
Valentin Reis committed
355 356 357 358 359 360 361 362
      for_ tsl $ \(stacki, fout, ferr) ->
        printError
          $  "Found Python Traceback when executing "
          <> repr stacki
          <> ". Files for this command: "
          <> repr fout
          <> " "
          <> repr ferr
Valentin Reis's avatar
Valentin Reis committed
363
      exit (ExitFailure 1)
364
    Died stacki errorcode _ _ tsl -> case isTest of
Valentin Reis's avatar
Valentin Reis committed
365 366
      IsTest -> do
        printError
367 368 369 370
          (  repr stacki
          <> " died before a message could be found with error code "
          <> repr errorcode
          )
Valentin Reis's avatar
Valentin Reis committed
371 372
        for_
          tsl
Valentin Reis's avatar
Valentin Reis committed
373 374 375 376 377 378 379 380 381 382 383 384 385 386 387
          (\(stacki', fout, ferr) ->
            printError
              $  "Found Python Traceback when executing "
              <> repr stacki'
              <> ". Files for this command: "
              <> repr fout
              <> " "
              <> repr ferr
          )
        exit (ExitFailure 1)
      NotTest -> exit ExitSuccess

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

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