argotk.hs 12.3 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 27 28 29 30 31 32 33 34 35

opts :: StackArgs -> Parser (Shell ())
opts sa = hsubparser
  (  command "clean"
             (info (pure $ clean sa) (progDesc "Clean sockets, logfiles."))
  <> mconcat (fmap commandTest [(minBound :: TestType) ..])
  <> commandTests [TestHello, TestListen, TestPerfwrapper, TestSTREAM]
                  "tests"
                  "Run hardware-independent CI tests"
  <> help
Valentin Reis's avatar
Valentin Reis committed
36
       ("Type of test/stack setup to run. There are extensive options under each action, "
Valentin Reis's avatar
Style.  
Valentin Reis committed
37 38 39
       <> "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
40 41 42 43
  )
 where
  action ttype = doOverridenTest ttype
    <$> parseExtendStackArgs ((stackArgsUpdate $ configureTest ttype) sa)
Valentin Reis's avatar
Valentin Reis committed
44
  descTest ttype = description (configureTest ttype)
Valentin Reis's avatar
Style.  
Valentin Reis committed
45 46 47 48
  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
49

Valentin Reis's avatar
Valentin Reis committed
50 51 52
-- test library
--------------------------------------------------------------------------------

Valentin Reis's avatar
Valentin Reis committed
53 54 55 56 57 58 59 60 61 62
data TestType =
    DaemonOnly
  | DaemonAndApp
  | CsvLogs
  | TestHello
  | TestListen
  | TestPerfwrapper
  | TestPower
  | TestSTREAM
  | RunAMG
Valentin Reis's avatar
Valentin Reis committed
63
  | RunQMCPack
Valentin Reis's avatar
Valentin Reis committed
64
  | RunOpenMC
Valentin Reis's avatar
Valentin Reis committed
65 66
  | RunSTREAM
  | RunLAMMPS deriving (Enum,Bounded,Show)
Valentin Reis's avatar
Valentin Reis committed
67

Valentin Reis's avatar
Valentin Reis committed
68 69 70 71

-- test specification datatype
--------------------------------------------------------------------------------

Valentin Reis's avatar
Valentin Reis committed
72 73 74
data TestSpec = TestSpec
  { stackArgsUpdate :: StackArgs -> StackArgs
  , isTest :: IsTest
75
  , description :: Text }
Valentin Reis's avatar
Valentin Reis committed
76
data IsTest = IsTest | NotTest
Valentin Reis's avatar
Valentin Reis committed
77 78 79 80 81 82
instance Default TestSpec where
  def = TestSpec { stackArgsUpdate = id
                 , isTest = NotTest
                 , description = ""
                 }

Valentin Reis's avatar
Valentin Reis committed
83 84
-- the interesting part, test configurations
--------------------------------------------------------------------------------
Valentin Reis's avatar
Valentin Reis committed
85 86

configureTest :: TestType -> TestSpec
Valentin Reis's avatar
Style.  
Valentin Reis committed
87
configureTest TestHello = TestSpec
Valentin Reis's avatar
Valentin Reis committed
88
  { description     = " Setup stack and check that a hello world app sends"
Valentin Reis's avatar
Valentin Reis committed
89
    <> "message back to cmd's stdout."
Valentin Reis's avatar
Valentin Reis committed
90
  , stackArgsUpdate = updater
Valentin Reis's avatar
Valentin Reis committed
91 92 93 94 95
  , isTest          = IsTest
  }
 where
  msg = "someComplexTextMessage12349"
  updater sa = sa
Valentin Reis's avatar
Style.  
Valentin Reis committed
96 97 98 99 100 101 102 103 104
    { 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
105
    }
Valentin Reis's avatar
Style.  
Valentin Reis committed
106
configureTest TestListen = TestSpec
Valentin Reis's avatar
Valentin Reis committed
107
  { description = " Setup stack, run command and check that cmd listen receives"
Valentin Reis's avatar
Valentin Reis committed
108
    <> "at least the container_exit message from the daemon."
Valentin Reis's avatar
Valentin Reis committed
109
  , stackArgsUpdate = updater
Valentin Reis's avatar
Valentin Reis committed
110 111 112 113
  , isTest = IsTest
  }
 where
  updater sa = sa
Valentin Reis's avatar
Style.  
Valentin Reis committed
114 115 116 117
    { app       = AppName "sleep"
    , args      = [AppArg "1"]
    , daemon    = daemonBehavior
    , cmdrun    = runBehavior
Valentin Reis's avatar
Valentin Reis committed
118
    , cmdlisten = Test
Valentin Reis's avatar
Style.  
Valentin Reis committed
119 120 121
                    (TestText (TextBehaviorStdout (WaitFor "container_exit"))
                              (TextBehaviorStderr ExpectClean)
                    )
Valentin Reis's avatar
Valentin Reis committed
122 123
                    (StdOutLog "cmd_listen_stdout.log")
                    (StdErrLog "cmd_listen_stderr.log")
Valentin Reis's avatar
Valentin Reis committed
124
    }
Valentin Reis's avatar
Style.  
Valentin Reis committed
125
configureTest TestPerfwrapper = TestSpec
Valentin Reis's avatar
Valentin Reis committed
126
  { description     = " Setup stack and check that argo-perf-wrapper sends"
Valentin Reis's avatar
Valentin Reis committed
127
    <> "at least one *performance* message to cmd listen through the"
Valentin Reis's avatar
Valentin Reis committed
128
  , stackArgsUpdate = updater
Valentin Reis's avatar
Valentin Reis committed
129 130 131 132
  , isTest          = IsTest
  }
 where
  updater sa = sa
Valentin Reis's avatar
Style.  
Valentin Reis committed
133 134 135 136 137
    { manifestName         = "perfwrap.json"
    , app                  = AppName "sleep"
    , args                 = [AppArg "15"]
    , daemon               = daemonBehavior
    , cmdrun               = runBehavior
Valentin Reis's avatar
Valentin Reis committed
138
    , cmdlistenperformance = Test
Valentin Reis's avatar
Style.  
Valentin Reis committed
139 140 141 142
                               (TestText
                                 (TextBehaviorStdout (WaitFor "performance"))
                                 (TextBehaviorStderr ExpectClean)
                               )
Valentin Reis's avatar
Valentin Reis committed
143 144
                               (StdOutLog "cmd_listen_performance_stdout.csv")
                               (StdErrLog "cmd_listen_performance_stderr.log")
Valentin Reis's avatar
Valentin Reis committed
145
    }
Valentin Reis's avatar
Valentin Reis committed
146
configureTest TestPower = TestSpec
Valentin Reis's avatar
Valentin Reis committed
147
  { description     = " Setup stack and check that the daemon sends"
Valentin Reis's avatar
Valentin Reis committed
148
    <> "at least one *power* message to cmd listen."
Valentin Reis's avatar
Valentin Reis committed
149
  , stackArgsUpdate = updater
Valentin Reis's avatar
Style.  
Valentin Reis committed
150 151
  , isTest          = IsTest
  }
Valentin Reis's avatar
Valentin Reis committed
152 153
 where
  updater sa = sa
Valentin Reis's avatar
Style.  
Valentin Reis committed
154 155 156 157
    { app            = AppName "sleep"
    , args           = [AppArg "15"]
    , daemon         = daemonBehavior
    , cmdrun         = runBehavior
Valentin Reis's avatar
Valentin Reis committed
158
    , cmdlistenpower = Test
Valentin Reis's avatar
Style.  
Valentin Reis committed
159
                         (TestText (TextBehaviorStdout (WaitFor "power"))
160
                                   (TextBehaviorStderr ExpectClean)
Valentin Reis's avatar
Style.  
Valentin Reis committed
161
                         )
Valentin Reis's avatar
Valentin Reis committed
162 163
                         (StdOutLog "power_stdout.csv")
                         (StdErrLog "power_stderr.log")
Valentin Reis's avatar
Valentin Reis committed
164
    }
Valentin Reis's avatar
Valentin Reis committed
165
configureTest TestSTREAM = TestSpec
Valentin Reis's avatar
Valentin Reis committed
166
  { description     = " Setup stack, run STREAM and check that it sends"
Valentin Reis's avatar
Valentin Reis committed
167
    <> "at least one progress message to the daemon."
Valentin Reis's avatar
Valentin Reis committed
168
  , stackArgsUpdate = updater
Valentin Reis's avatar
Style.  
Valentin Reis committed
169 170
  , isTest          = IsTest
  }
Valentin Reis's avatar
Valentin Reis committed
171 172
 where
  updater sa = sa
Valentin Reis's avatar
Style.  
Valentin Reis committed
173 174 175 176
    { app               = AppName "stream_c"
    , args              = []
    , daemon            = daemonBehavior
    , cmdrun            = runBehavior
Valentin Reis's avatar
Valentin Reis committed
177
    , cmdlistenprogress = Test
Valentin Reis's avatar
Style.  
Valentin Reis committed
178 179 180 181
                            (TestText
                              (TextBehaviorStdout (WaitFor "progress"))
                              (TextBehaviorStderr ExpectClean)
                            )
Valentin Reis's avatar
Valentin Reis committed
182 183
                            (StdOutLog "progress_stdout.csv")
                            (StdErrLog "progress_stderr.log")
Valentin Reis's avatar
Valentin Reis committed
184
    }
Valentin Reis's avatar
Valentin Reis committed
185
configureTest DaemonOnly = TestSpec
Valentin Reis's avatar
Valentin Reis committed
186 187
  { description     = "Set up and launch the daemon in synchronous mode."
  , stackArgsUpdate = updater
Valentin Reis's avatar
Valentin Reis committed
188
  , isTest          = NotTest
Valentin Reis's avatar
Style.  
Valentin Reis committed
189
  }
Valentin Reis's avatar
Valentin Reis committed
190 191
  where updater sa = sa { daemon = daemonBehavior }
configureTest DaemonAndApp = TestSpec
Valentin Reis's avatar
Valentin Reis committed
192 193
  { description     = "Set up and start daemon, run a command in a container."
  , stackArgsUpdate = updater
Valentin Reis's avatar
Style.  
Valentin Reis committed
194 195
  , isTest          = NotTest
  }
Valentin Reis's avatar
Valentin Reis committed
196 197 198 199 200 201 202 203 204 205 206 207 208 209 210
  where updater sa = sa { daemon = daemonBehavior, cmdrun = runBehavior }
configureTest CsvLogs =
  mkRun id "get all logs from a command running in the stack"
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"]
    }
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
211 212 213
    , 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
214
             in  fmap AppArg ["-n", repr tc, "qmcpack", inpath]
Valentin Reis's avatar
Style.  
Valentin Reis committed
215
    }
Valentin Reis's avatar
Valentin Reis committed
216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236
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
237
    }
Valentin Reis's avatar
Valentin Reis committed
238 239 240 241 242 243 244
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
245 246
    , args = let (ShareDir dirn) = shareDir sa
                 Right inpath    = toText (dirn </> "modified.lj")
Valentin Reis's avatar
Valentin Reis committed
247 248 249 250 251 252 253 254
             in  fmap
                   AppArg
                   [ "-n"
                   , repr (coerce (hwThreadCount sa) :: Int)
                   , "lmp_mpi"
                   , "-i"
                   , inpath
                   ]
Valentin Reis's avatar
Style.  
Valentin Reis committed
255 256
    }

Valentin Reis's avatar
Valentin Reis committed
257 258 259 260

-- helpers for test configurations
--------------------------------------------------------------------------------

Valentin Reis's avatar
Valentin Reis committed
261 262 263 264
mkRun :: (StackArgs -> StackArgs) -> Text -> TestSpec
mkRun stackArgsUpdate description = TestSpec
  { stackArgsUpdate = stackArgsUpdate . runAppSA
  , ..
Valentin Reis's avatar
Style.  
Valentin Reis committed
265
  }
Valentin Reis's avatar
Valentin Reis committed
266 267 268 269 270 271 272 273 274
 where
  isTest = NotTest
  runAppSA sa = sa { manifestName         = "parallel.json"
                   , daemon               = daemonBehavior
                   , cmdrun               = runBehavior
                   , cmdlistenperformance = csvBehavior "performance"
                   , cmdlistenpower       = csvBehavior "power"
                   , cmdlistenprogress    = csvBehavior "progress"
                   }
Valentin Reis's avatar
Valentin Reis committed
275 276
  csvBehavior identifier = JustRun (StdOutLog $identifier <> ".csv")
                                   (StdErrLog $ identifier <> "progress.log")
Valentin Reis's avatar
Style.  
Valentin Reis committed
277 278 279 280 281 282 283 284 285 286

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")


Valentin Reis's avatar
Valentin Reis committed
287 288 289 290 291 292
-- helpers for this file
--------------------------------------------------------------------------------
doTest :: StackArgs -> TestType -> Shell ()
doTest stackArgs ttype = doSpec spec
  $ (stackArgsUpdate $ configureTest ttype) stackArgs
  where spec = configureTest ttype
Valentin Reis's avatar
Style.  
Valentin Reis committed
293

Valentin Reis's avatar
Valentin Reis committed
294 295
doOverridenTest :: TestType -> StackArgs -> Shell ()
doOverridenTest ttype = doSpec spec where spec = configureTest ttype
Valentin Reis's avatar
Style.  
Valentin Reis committed
296

Valentin Reis's avatar
Valentin Reis committed
297 298 299 300 301
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
302

Valentin Reis's avatar
Valentin Reis committed
303 304
-- executors
--------------------------------------------------------------------------------
Valentin Reis's avatar
Valentin Reis committed
305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323

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)
324
    Died stacki errorcode _ _ tsl -> case isTest of
Valentin Reis's avatar
Valentin Reis committed
325 326
      IsTest -> do
        printError
327 328 329 330
          (  repr stacki
          <> " died before a message could be found with error code "
          <> repr errorcode
          )
Valentin Reis's avatar
Valentin Reis committed
331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347
        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
348 349
-- the entry point with dirty setup IO and env. var fuckery
--------------------------------------------------------------------------------
Valentin Reis's avatar
Valentin Reis committed
350 351
main :: IO ()
main = do
Valentin Reis's avatar
Valentin Reis committed
352
  hSetBuffering System.IO.stdout NoBuffering
Valentin Reis's avatar
Valentin Reis committed
353
  argonixShare <- getEnv "ARGOTK_SHARE"
Valentin Reis's avatar
Style.  
Valentin Reis committed
354 355 356 357 358
  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
359 360
  turtle <- execParser (info (opts a <**> helper) idm)
  sh turtle