mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
dc4a286c64
## Description This PR adds all the scaffolding for tests that require remote servers. It is mostly a refactor of `Feature`; where we listed for each test a list of individual backends, we now provide a list of `Context`s, that allows for tests to specify not only how it should be setup, but also what state needs to be carried around throughout the test. This will be useful when launching custom remote servers. Additionally, this PR: - cleans the way we generate logs in the engine as part of the tests - cleans the cabal file - introduce a few more helpers for sending commands to the engine (such as `postMetadata_`) - allows for headers in queries sent to the engine (to support permissions tests) - adds basic code to start / stop a "remote" server This PR is a pre-requisite of #3567. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3573 Co-authored-by: jkachmar <8461423+jkachmar@users.noreply.github.com> GitOrigin-RevId: 05f808c6b85729dbb3ea6648c3e10a3c16b641ef
87 lines
2.6 KiB
Haskell
87 lines
2.6 KiB
Haskell
-- | Helper functions for HTTP requests.
|
|
module Harness.Http
|
|
( get_,
|
|
postValue_,
|
|
healthCheck,
|
|
Http.RequestHeaders,
|
|
)
|
|
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 Hasura.Prelude
|
|
import Network.HTTP.Simple qualified as Http
|
|
import Network.HTTP.Types qualified as Http
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- 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 -> Http.RequestHeaders -> Value -> IO Value
|
|
postValue_ url headers value = do
|
|
let request =
|
|
Http.setRequestHeaders headers $
|
|
Http.setRequestMethod Http.methodPost $
|
|
Http.setRequestBodyJSON value (fromString url)
|
|
response <- Http.httpLbs request
|
|
let requestBodyString = L8.unpack $ encode value
|
|
responseBodyString = L8.unpack $ Http.getResponseBody response
|
|
if Http.getResponseStatusCode response == 200
|
|
then
|
|
eitherDecode (Http.getResponseBody response)
|
|
`onLeft` \err ->
|
|
reportError
|
|
[ "In request: " ++ url,
|
|
"With body:",
|
|
requestBodyString,
|
|
"Couldn't decode JSON body:",
|
|
err,
|
|
"Body was:",
|
|
responseBodyString
|
|
]
|
|
else
|
|
reportError
|
|
[ "Non-200 response code from HTTP request: ",
|
|
url,
|
|
"With body:",
|
|
requestBodyString,
|
|
"Response body is:",
|
|
responseBodyString
|
|
]
|
|
where
|
|
reportError = error . unlines
|
|
|
|
-- | 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)
|
|
)
|