argotk.hs 13.2 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 15
import           Argo.Stack
import           Argo.Utils
import           Argo.Args
Valentin Reis's avatar
Valentin Reis committed
16
import           Turtle
Valentin Reis's avatar
Valentin Reis committed
17 18 19 20 21
import           Prelude                 hiding ( FilePath )
import           Data.Default
import           System.Environment
import           Options.Applicative     hiding ( action )
import           Data.Text                     as T
22 23 24
                                                ( unpack
                                                , Text
                                                )
Valentin Reis's avatar
Valentin Reis committed
25
import           System.IO
Valentin Reis's avatar
Valentin Reis committed
26

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

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

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

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

Valentin Reis's avatar
Valentin Reis committed
63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81

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

mkRun :: (StackArgs -> StackArgs) -> Text -> TestSpec
mkRun stackArgsUpdate description = TestSpec
  { stackArgsUpdate = stackArgsUpdate . runAppSA
  , ..
  }
 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
82
                                   (StdErrLog $ identifier <> ".log")
Valentin Reis's avatar
Valentin Reis committed
83 84 85 86 87 88 89 90 91 92

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
93
--------------------------------------------------------------------------------
Valentin Reis's avatar
Valentin Reis committed
94

Valentin Reis's avatar
Valentin Reis committed
95 96
configureTest :: TestName -> TestSpec

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

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

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

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

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

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

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

Valentin Reis's avatar
Valentin Reis committed
204 205
configureTest CsvLogs =
  mkRun id "get all logs from a command running in the stack"
Valentin Reis's avatar
Valentin Reis committed
206

Valentin Reis's avatar
Valentin Reis committed
207 208 209 210 211 212 213 214
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
215

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

Valentin Reis's avatar
Valentin Reis committed
226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246
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"
                   , "8"
                   , repr $ quot tc 8
                   , "1"
                   ]
Valentin Reis's avatar
Valentin Reis committed
247
    }
Valentin Reis's avatar
Valentin Reis committed
248

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

Valentin Reis's avatar
Valentin Reis committed
268

Valentin Reis's avatar
Valentin Reis committed
269 270 271 272 273 274 275 276 277 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
    { cmdlistenprogress = Test
                            (TestText
                              (TextBehaviorStdout (WaitFor "progress"))
                              (TextBehaviorStderr ExpectClean)
                            )
                            (StdOutLog "progress_stdout.csv")
                            (StdErrLog "progress_stderr.log")
    }

Valentin Reis's avatar
Valentin Reis committed
294
-- parsing and building the shell monad
Valentin Reis's avatar
Valentin Reis committed
295 296
--------------------------------------------------------------------------------

Valentin Reis's avatar
Valentin Reis committed
297 298 299 300 301
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
302 303 304 305
  <> commandTests [TestQMCPack, TestLAMMPS, TestOpenMC, TestAMG, TestSTREAM]
                  "testApplications"
                  "Run application CI tests"
  <> commandTests [TestHello, TestListen]
Valentin Reis's avatar
Valentin Reis committed
306 307 308 309 310 311 312 313
                  "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
314
 where
Valentin Reis's avatar
Valentin Reis committed
315 316 317 318 319 320 321
  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
322

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

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

Valentin Reis's avatar
Valentin Reis committed
331 332 333 334 335
  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
336

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

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)
358
    Died stacki errorcode _ _ tsl -> case isTest of
Valentin Reis's avatar
Valentin Reis committed
359 360
      IsTest -> do
        printError
361 362 363 364
          (  repr stacki
          <> " died before a message could be found with error code "
          <> repr errorcode
          )
Valentin Reis's avatar
Valentin Reis committed
365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381
        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

Valentin Reis's avatar
Valentin Reis committed
382 383
-- the entry point with dirty setup IO and env. var fuckery, and finally
-- executing the shell monad.
Valentin Reis's avatar
Valentin Reis committed
384
--------------------------------------------------------------------------------
Valentin Reis's avatar
Valentin Reis committed
385 386
main :: IO ()
main = do
Valentin Reis's avatar
Valentin Reis committed
387
  hSetBuffering System.IO.stdout NoBuffering
Valentin Reis's avatar
Valentin Reis committed
388
  argonixShare <- getEnv "ARGOTK_SHARE"
Valentin Reis's avatar
Valentin Reis committed
389 390 391 392 393
  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
394 395
  turtle <- execParser (info (opts a <**> helper) idm)
  sh turtle