module Buffet.Test.TestDish
  ( get
  ) where

import qualified Buffet.Ir.Ir as Ir
import qualified Buffet.Test.TestResult as TestResult
import qualified Buffet.Test.TestSetup as TestSetup
import qualified Data.Text as T
import Prelude (Bool, IO, Maybe, ($), (.), (==), pure, traverse)
import qualified System.Exit as Exit
import qualified System.Process.Typed as Process

get :: TestSetup.TestSetup -> IO TestResult.TestResult
get :: TestSetup -> IO TestResult
get TestSetup
testSetup = do
  Maybe Bool
healthCheckPassed <- TestSetup -> IO (Maybe Bool)
checkHealth TestSetup
testSetup
  TestResult -> IO TestResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    TestResult :: Text -> Maybe Bool -> TestResult
TestResult.TestResult
      { optionValue :: Text
TestResult.optionValue = TestSetup -> Text
TestSetup.optionValue TestSetup
testSetup
      , healthCheckPassed :: Maybe Bool
TestResult.healthCheckPassed = Maybe Bool
healthCheckPassed
      }

checkHealth :: TestSetup.TestSetup -> IO (Maybe Bool)
checkHealth :: TestSetup -> IO (Maybe Bool)
checkHealth TestSetup
testSetup = (Text -> IO Bool) -> Maybe Text -> IO (Maybe Bool)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> IO Bool
forall (m :: * -> *). MonadIO m => Text -> m Bool
run (Maybe Text -> IO (Maybe Bool))
-> (Dish -> Maybe Text) -> Dish -> IO (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dish -> Maybe Text
Ir.healthCheck (Dish -> IO (Maybe Bool)) -> Dish -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ TestSetup -> Dish
TestSetup.dish TestSetup
testSetup
  where
    run :: Text -> m Bool
run Text
command = do
      ExitCode
exitCode <-
        ProcessConfig () () () -> m ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
Process.runProcess (ProcessConfig () () () -> m ExitCode)
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> m ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
Process.setStderr (Handle -> StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType).
Handle -> StreamSpec anyStreamType ()
Process.useHandleOpen Handle
log) (ProcessConfig () () () -> ProcessConfig () () ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
Process.setStdout (Handle -> StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType).
Handle -> StreamSpec anyStreamType ()
Process.useHandleOpen Handle
log) (ProcessConfig () () () -> m ExitCode)
-> ProcessConfig () () () -> m ExitCode
forall a b. (a -> b) -> a -> b
$
        FilePath -> [FilePath] -> ProcessConfig () () ()
Process.proc
          FilePath
"docker"
          [ FilePath
"run"
          , FilePath
"--rm"
          , Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ TestSetup -> Text
TestSetup.image TestSetup
testSetup
          , FilePath
"sh"
          , FilePath
"-c"
          , Text -> FilePath
T.unpack Text
command
          ]
      Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
Exit.ExitSuccess
    log :: Handle
log = TestSetup -> Handle
TestSetup.log TestSetup
testSetup