mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
cda117a4a9
Example:
```
server/src-lib/Hasura/RQL/DDL/Schema/Table.hs:(200,15)-(205,28): Warning: Use when
Found:
if tnGQL `elem` ns then
throw400 RemoteSchemaConflicts
$ "node " <> tnGQL <> " already exists in current graphql schema"
else
pure ()
Perhaps:
when
(tnGQL `elem` ns)
(throw400 RemoteSchemaConflicts
$ "node " <> tnGQL <> " already exists in current graphql schema")
```
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4570
GitOrigin-RevId: 1b04e5e39d20c99643220154c03dae82a025f0f1
102 lines
3.1 KiB
Haskell
102 lines
3.1 KiB
Haskell
-- | Helper functions for HTTP requests.
|
|
module Harness.Http
|
|
( get_,
|
|
post,
|
|
postValue,
|
|
postValueWithStatus,
|
|
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)
|
|
unless (Http.getResponseStatusCode response == 200) $
|
|
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 = postValueWithStatus 200
|
|
|
|
post :: String -> Http.RequestHeaders -> Value -> IO (Http.Response L8.ByteString)
|
|
post url headers value = do
|
|
let request =
|
|
Http.setRequestHeaders headers $
|
|
Http.setRequestMethod Http.methodPost $
|
|
Http.setRequestBodyJSON value (fromString url)
|
|
Http.httpLbs request
|
|
|
|
-- | Post the JSON to the given URL and expected HTTP response code.
|
|
-- Produces a very descriptive exception or failure.
|
|
postValueWithStatus :: HasCallStack => Int -> String -> Http.RequestHeaders -> Value -> IO Value
|
|
postValueWithStatus statusCode url headers value = do
|
|
response <- post url headers value
|
|
let requestBodyString = L8.unpack $ encode value
|
|
responseBodyString = L8.unpack $ Http.getResponseBody response
|
|
responseStatusCode = Http.getResponseStatusCode response
|
|
if responseStatusCode == statusCode
|
|
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
|
|
[ "Expecting reponse code ",
|
|
show statusCode,
|
|
" but got ",
|
|
show responseStatusCode,
|
|
" 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)
|
|
)
|