graphql-engine/server/tests-hspec/Harness/Http.hs

-- | Helper functions for HTTP requests.
module Harness.Http
  ( get_,
    postValue_,
    healthCheck,
  )
where

import Control.Concurrent
import Control.Exception
import Data.Aeson
import Data.ByteString.Lazy.Char8 qualified as L8
import Data.String
import GHC.Stack
import Harness.Constants qualified as Constants
import Network.HTTP.Simple qualified as Http
import Network.HTTP.Types qualified as Http
import Prelude

--------------------------------------------------------------------------------
-- API

-- | Performs get, doesn't return the result. Simply throws if there's
-- not a 200 response.
get_ :: HasCallStack => String -> IO ()
get_ url = do
  response <- Http.httpNoBody (fromString url)
  if Http.getResponseStatusCode response == 200
    then pure ()
    else error ("Non-200 response code from HTTP request: " ++ url)

-- | Post the JSON to the given URL, and produces a very descriptive
-- exception on failure.
postValue_ :: HasCallStack => String -> Value -> IO Value
postValue_ url value = do
  let request =
        Http.setRequestMethod
          Http.methodPost
          (Http.setRequestBodyJSON value (fromString url))
  response <- Http.httpLbs request
  if Http.getResponseStatusCode response == 200
    then case eitherDecode (Http.getResponseBody response) of
      Left err ->
        error
          ( unlines
              [ "In request: " ++ url,
                "With body:",
                L8.unpack (encode value),
                "Couldn't decode JSON body:",
                err,
                "Body was:",
                L8.unpack (Http.getResponseBody response)
              ]
          )
      Right val -> pure val
    else
      error
        ( unlines
            [ "Non-200 response code from HTTP request: ",
              url,
              "With body:",
              L8.unpack (encode value),
              "Response body is:",
              L8.unpack (Http.getResponseBody response)
            ]
        )

-- | Wait for a service to become healthy.
healthCheck :: HasCallStack => String -> IO ()
healthCheck url = loop [] Constants.httpHealthCheckAttempts
  where
    loop failures 0 =
      error
        ( "Health check failed for URL: "
            ++ url
            ++ ", with failures: "
            ++ show failures
        )
    loop failures attempts =
      catch
        (get_ url)
        ( \(failure :: Http.HttpException) -> do
            threadDelay Constants.httpHealthCheckIntervalMicroseconds
            loop (failure : failures) (attempts - 1)
        )