Slave.hs

{-| @benchmark@ contains the logic to be executed on slave nodes.
-}


module FeedGipeda.Slave
  ( benchmark
  ) where


import           Control.Logging     as Logging
import qualified Data.Text           as Text
import           FeedGipeda.GitShell (SHA)
import           FeedGipeda.Repo     (Repo)
import qualified FeedGipeda.Repo     as Repo
import           System.Exit         (ExitCode (..))
import           System.IO.Temp      (withSystemTempDirectory)
import           System.Process      (cwd, proc, readCreateProcessWithExitCode,
                                      shell, showCommandForUser)


procReportingError :: Repo -> SHA -> Maybe FilePath -> FilePath -> [String] -> IO String
procReportingError repo commit cwd cmd args = do
  (exitCode, stdout, stderr) <-
    readCreateProcessWithExitCode (proc cmd args) { cwd = cwd } ""
  reportError repo commit (showCommandForUser cmd args) exitCode stderr
  return stdout


shellReportingError :: Repo -> SHA -> Maybe FilePath -> FilePath -> IO String
shellReportingError repo commit cwd cmd = do
  (exitCode, stdout, stderr) <-
    readCreateProcessWithExitCode (shell cmd) { cwd = cwd } ""
  reportError repo commit cmd exitCode stderr
  return stdout


reportError :: Repo -> SHA -> String -> ExitCode -> String -> IO ()
reportError repo commit cmd code stderr =
  case code of
    ExitSuccess -> return ()
    ExitFailure c ->
      Logging.warn . Text.pack . unlines $
        [ "Benchmark script error"
        , "At commit " ++ Repo.uri repo ++ "@" ++ commit ++ ":"
        , cmd ++ ": exit code " ++ show c
        , stderr
        ]


cloneRecursiveAndCheckout :: Repo -> SHA -> FilePath -> IO ()
cloneRecursiveAndCheckout repo commit cloneDir = do
  procReportingError repo commit Nothing "git" ["clone", "--quiet", Repo.uri repo, cloneDir]
  procReportingError repo commit (Just cloneDir) "git" ["reset", "--hard", commit]
  shellReportingError repo commit (Just cloneDir) "git submodule update --init --recursive --quiet"
  return ()


{-| Clones the given @repo@ at a specific @commit@ into a temporary directory.
    Then calls the @benchmarkScript@ within that directory and returns its output.

    Will be executed on slave nodes.
-}
benchmark :: String -> Repo -> SHA -> IO String
benchmark benchmarkScript repo commit = do
  clone <- Repo.cloneDir repo
  Logging.log (Text.pack ("Benchmarking " ++ Repo.uri repo ++ "@" ++ commit))
  withSystemTempDirectory "feed-gipeda" $ \cloneDir -> do
    cloneRecursiveAndCheckout repo commit cloneDir
    shellReportingError repo commit (Just cloneDir) benchmarkScript