argotk.hs 12.4 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
Style.  
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
Style.  
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 39
    DaemonOnly
  | DaemonAndApp
  | CsvLogs
  | TestHello
  | TestListen
  | TestPerfwrapper
  | TestPower
  | TestSTREAM
  | RunAMG
Valentin Reis's avatar
Valentin Reis committed
40
  | RunQMCPack
Valentin Reis's avatar
Valentin Reis committed
41
  | RunOpenMC
Valentin Reis's avatar
Valentin Reis committed
42 43
  | RunSTREAM
  | RunLAMMPS deriving (Enum,Bounded,Show)
Valentin Reis's avatar
Valentin Reis committed
44

Valentin Reis's avatar
Valentin Reis committed
45 46 47
-- test specification datatype
--------------------------------------------------------------------------------

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

Valentin Reis's avatar
Valentin Reis committed
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88

-- 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")
                                   (StdErrLog $ identifier <> "progress.log")

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
89
--------------------------------------------------------------------------------
Valentin Reis's avatar
Valentin Reis committed
90

Valentin Reis's avatar
Valentin Reis committed
91 92
configureTest :: TestName -> TestSpec

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

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

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

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

Valentin Reis's avatar
Valentin Reis committed
175
configureTest TestSTREAM = TestSpec
Valentin Reis's avatar
Valentin Reis committed
176
  { description     = " Setup stack, run STREAM and check that it sends"
Valentin Reis's avatar
Valentin Reis committed
177
    <> "at least one progress message to the daemon."
Valentin Reis's avatar
Valentin Reis committed
178
  , stackArgsUpdate = updater
Valentin Reis's avatar
Style.  
Valentin Reis committed
179 180
  , isTest          = IsTest
  }
Valentin Reis's avatar
Valentin Reis committed
181 182
 where
  updater sa = sa
Valentin Reis's avatar
Style.  
Valentin Reis committed
183 184 185 186
    { app               = AppName "stream_c"
    , args              = []
    , daemon            = daemonBehavior
    , cmdrun            = runBehavior
Valentin Reis's avatar
Valentin Reis committed
187
    , cmdlistenprogress = Test
Valentin Reis's avatar
Style.  
Valentin Reis committed
188 189 190 191
                            (TestText
                              (TextBehaviorStdout (WaitFor "progress"))
                              (TextBehaviorStderr ExpectClean)
                            )
Valentin Reis's avatar
Valentin Reis committed
192 193
                            (StdOutLog "progress_stdout.csv")
                            (StdErrLog "progress_stderr.log")
Valentin Reis's avatar
Valentin Reis committed
194
    }
Valentin Reis's avatar
Valentin Reis committed
195

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

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

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

Valentin Reis's avatar
Valentin Reis committed
213 214 215 216 217 218 219 220
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
221

Valentin Reis's avatar
Valentin Reis committed
222 223 224 225
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
226 227 228
    , 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
229
             in  fmap AppArg ["-n", repr tc, "qmcpack", inpath]
Valentin Reis's avatar
Style.  
Valentin Reis committed
230
    }
Valentin Reis's avatar
Valentin Reis committed
231

Valentin Reis's avatar
Valentin Reis committed
232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252
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
Style.  
Valentin Reis committed
253
    }
Valentin Reis's avatar
Valentin Reis committed
254

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

Valentin Reis's avatar
Valentin Reis committed
274

Valentin Reis's avatar
Valentin Reis committed
275
-- parsing and building the shell monad
Valentin Reis's avatar
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
opts :: StackArgs -> Parser (Shell ())
opts sa = hsubparser
  (  command "clean"
             (info (pure $ clean sa) (progDesc "Clean sockets, logfiles."))
  <> mconcat (fmap commandTest [(minBound :: TestName) ..])
  <> commandTests [TestHello, TestListen, TestPerfwrapper, TestSTREAM]
                  "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
292
 where
Valentin Reis's avatar
Valentin Reis committed
293 294 295 296 297 298 299
  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
Style.  
Valentin Reis committed
300

Valentin Reis's avatar
Valentin Reis committed
301 302 303 304
  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
305

Valentin Reis's avatar
Valentin Reis committed
306 307
  doOverridenTest :: TestName -> StackArgs -> Shell ()
  doOverridenTest ttype = doSpec spec where spec = configureTest ttype
Valentin Reis's avatar
Style.  
Valentin Reis committed
308

Valentin Reis's avatar
Valentin Reis committed
309 310 311 312 313
  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
314

Valentin Reis's avatar
Valentin Reis committed
315 316
-- executors
--------------------------------------------------------------------------------
Valentin Reis's avatar
Valentin Reis committed
317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335

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)
336
    Died stacki errorcode _ _ tsl -> case isTest of
Valentin Reis's avatar
Valentin Reis committed
337 338
      IsTest -> do
        printError
339 340 341 342
          (  repr stacki
          <> " died before a message could be found with error code "
          <> repr errorcode
          )
Valentin Reis's avatar
Valentin Reis committed
343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359
        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
360 361
-- the entry point with dirty setup IO and env. var fuckery, and finally
-- executing the shell monad.
Valentin Reis's avatar
Valentin Reis committed
362
--------------------------------------------------------------------------------
Valentin Reis's avatar
Valentin Reis committed
363 364
main :: IO ()
main = do
Valentin Reis's avatar
Valentin Reis committed
365
  hSetBuffering System.IO.stdout NoBuffering
Valentin Reis's avatar
Valentin Reis committed
366
  argonixShare <- getEnv "ARGOTK_SHARE"
Valentin Reis's avatar
Style.  
Valentin Reis committed
367 368 369 370 371
  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
372 373
  turtle <- execParser (info (opts a <**> helper) idm)
  sh turtle