mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 20:41:49 +03:00
ccea1da1d5
### Description This is it! This PR enables the Metadata API for remote relationships from remote schemas, adds tests, ~~adds documentation~~, adds an entry to the Changelog. This is the release PR that enables the feature. ### Checklist - [ ] Tests: - [x] RS-to-Postgres (high level) - [x] RS-to-RS (high level) - [x] From RS specifically (testing for edge cases) - [x] Metadata API tests - [ ] Unit testing the actual engine? - [x] Changelog entry - [ ] Documentation? PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3974 Co-authored-by: Vamshi Surabhi <6562944+0x777@users.noreply.github.com> Co-authored-by: Vishnu Bharathi <4211715+scriptnull@users.noreply.github.com> Co-authored-by: jkachmar <8461423+jkachmar@users.noreply.github.com> GitOrigin-RevId: c9aebf12e6eebef8d264ea831a327b968d4be9d2
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)
|
|
)
|