argotk.hs 11.8 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 9 10
{-|
Module      : argotk.hs
Description : argo provisioner/executor
Copyright   : (c) Valentin Reis, 2018
License     : MIT
Maintainer  : fre@freux.fr -}

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

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
Style.  
Valentin Reis committed
35 36 37 38
       ("Type of test 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
39 40 41 42
  )
 where
  action ttype = doOverridenTest ttype
    <$> parseExtendStackArgs ((stackArgsUpdate $ configureTest ttype) sa)
Valentin Reis's avatar
Valentin Reis committed
43
  descTest ttype = description (configureTest ttype)
Valentin Reis's avatar
Style.  
Valentin Reis committed
44 45 46 47
  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
48 49 50 51 52 53 54 55 56 57 58

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

data TestSpec = TestSpec
  { stackArgsUpdate :: StackArgs -> StackArgs
  , isTest :: IsTest
67
  , description :: Text }
Valentin Reis's avatar
Valentin Reis committed
68

Valentin Reis's avatar
Valentin Reis committed
69 70 71 72 73 74
instance Default TestSpec where
  def = TestSpec { stackArgsUpdate = id
                 , isTest = NotTest
                 , description = ""
                 }

Valentin Reis's avatar
Valentin Reis committed
75 76 77 78 79 80 81 82 83 84
doTest :: StackArgs -> TestType -> Shell ()
doTest stackArgs ttype = doSpec spec
  $ (stackArgsUpdate $ configureTest ttype) stackArgs
  where spec = configureTest ttype

doOverridenTest :: TestType -> StackArgs -> Shell ()
doOverridenTest ttype = doSpec spec where spec = configureTest ttype

doSpec :: TestSpec -> StackArgs -> Shell ()
doSpec spec stackArgs = do
85
  printTest $ description spec
Valentin Reis's avatar
Valentin Reis committed
86 87 88 89
  fullStack (isTest spec) stackArgs
  printSuccess "Test Successful.\n"

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

Valentin Reis's avatar
Valentin Reis committed
252 253 254 255
mkRun :: (StackArgs -> StackArgs) -> Text -> TestSpec
mkRun stackArgsUpdate description = TestSpec
  { stackArgsUpdate = stackArgsUpdate . runAppSA
  , ..
Valentin Reis's avatar
Style.  
Valentin Reis committed
256
  }
Valentin Reis's avatar
Valentin Reis committed
257 258 259 260 261 262 263 264 265 266 267 268 269
 where
  isTest = NotTest
  runAppSA sa = sa { manifestName         = "parallel.json"
                   , daemon               = daemonBehavior
                   , cmdrun               = runBehavior
                   , cmdlistenperformance = csvBehavior "performance"
                   , cmdlistenpower       = csvBehavior "power"
                   , cmdlistenprogress    = csvBehavior "progress"
                   }

csvBehavior :: Text -> ProcessBehavior
csvBehavior identifier = JustRun (StdOutLog $identifier <> ".csv")
                                 (StdErrLog $ identifier <> "progress.log")
Valentin Reis's avatar
Style.  
Valentin Reis committed
270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295

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

listentestBehavior :: TestText -> ProcessBehavior
listentestBehavior t =
  Test t (StdOutLog "cmd_listen_stdout.log") (StdErrLog "cmd_listen_stderr.log")

listenprogresstestBehavior :: TestText -> ProcessBehavior
listenprogresstestBehavior t =
  Test t (StdOutLog "progress_stdout.csv") (StdErrLog "progress_stderr.log")

listenperformancetestBehavior :: TestText -> ProcessBehavior
listenperformancetestBehavior t = Test t
                                       (StdOutLog "performance_stdout.csv")
                                       (StdErrLog "performance_stderr.log")

listenpowertestBehavior :: TestText -> ProcessBehavior

listenpowertestBehavior t =
  Test t (StdOutLog "power_stdout.csv") (StdErrLog "power_stderr.log")
Valentin Reis's avatar
Valentin Reis committed
296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316

data IsTest = IsTest | NotTest

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)
317
    Died stacki errorcode _ _ tsl -> case isTest of
Valentin Reis's avatar
Valentin Reis committed
318 319
      IsTest -> do
        printError
320 321 322 323
          (  repr stacki
          <> " died before a message could be found with error code "
          <> repr errorcode
          )
Valentin Reis's avatar
Valentin Reis committed
324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342
        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

main :: IO ()
main = do
Valentin Reis's avatar
Valentin Reis committed
343
  hSetBuffering System.IO.stdout NoBuffering
Valentin Reis's avatar
Valentin Reis committed
344
  argonixShare <- getEnv "ARGOTK_SHARE"
Valentin Reis's avatar
Style.  
Valentin Reis committed
345 346 347 348 349
  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
350 351
  turtle <- execParser (info (opts a <**> helper) idm)
  sh turtle