graphql-engine/server/src-lib/Hasura/HTTP.hs
Rakesh Emmadi 6f100e0009
improve debug information in actions errors response (close #4031) (#4432)
* config options for internal errors for non-admin role, close #4031

More detailed action debug info is added in response 'internal' field

* add docs

* update CHANGELOG.md

* set admin graphql errors option in ci tests, minor changes to docs

* fix tests

Don't use any auth for sync actions error tests. The request body
changes based on auth type in session_variables (x-hasura-auth-mode)

* Apply suggestions from code review

Co-Authored-By: Marion Schleifer <marion@hasura.io>

* use a new sum type to represent the inclusion of internal errors

As suggested in review by @0x777
-> Move around few modules in to specific API folder
-> Saperate types from Init.hs

* fix tests

Don't use any auth for sync actions error tests. The request body
changes based on auth type in session_variables (x-hasura-auth-mode)

* move 'HttpResponse' to 'Hasura.HTTP' module

* update change log with breaking change warning

* Update CHANGELOG.md

Co-authored-by: Marion Schleifer <marion@hasura.io>
Co-authored-by: Tirumarai Selvan <tiru@hasura.io>
2020-04-24 13:25:51 +05:30

73 lines
2.2 KiB
Haskell

module Hasura.HTTP
( wreqOptions
, HttpException(..)
, hdrsToText
, addDefaultHeaders
, HttpResponse(..)
) where
import Hasura.Prelude
import Control.Lens hiding ((.=))
import Data.CaseInsensitive (original)
import Data.Text.Conversions (UTF8 (..), convertText)
import qualified Data.Aeson as J
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wreq as Wreq
import Hasura.Server.Version (HasVersion, currentVersion)
hdrsToText :: [HTTP.Header] -> [(Text, Text)]
hdrsToText hdrs =
[ (bsToTxt $ original hdrName, bsToTxt hdrVal)
| (hdrName, hdrVal) <- hdrs
]
wreqOptions :: HasVersion => HTTP.Manager -> [HTTP.Header] -> Wreq.Options
wreqOptions manager hdrs =
Wreq.defaults
& Wreq.headers .~ addDefaultHeaders hdrs
& Wreq.checkResponse ?~ (\_ _ -> return ())
& Wreq.manager .~ Right manager
-- Adds defaults headers overwriting any existing ones
addDefaultHeaders :: HasVersion => [HTTP.Header] -> [HTTP.Header]
addDefaultHeaders hdrs = defaultHeaders <> rmDefaultHeaders hdrs
where
rmDefaultHeaders = filter (not . isDefaultHeader)
isDefaultHeader :: HasVersion => HTTP.Header -> Bool
isDefaultHeader (hdrName, _) = hdrName `elem` map fst defaultHeaders
defaultHeaders :: HasVersion => [HTTP.Header]
defaultHeaders = [contentType, userAgent]
where
contentType = ("Content-Type", "application/json")
userAgent = ( "User-Agent"
, "hasura-graphql-engine/" <> unUTF8 (convertText currentVersion)
)
newtype HttpException
= HttpException
{ unHttpException :: HTTP.HttpException }
deriving (Show)
instance J.ToJSON HttpException where
toJSON = \case
(HttpException (HTTP.InvalidUrlException _ e)) ->
J.object [ "type" J..= ("invalid_url" :: Text)
, "message" J..= e
]
(HttpException (HTTP.HttpExceptionRequest _ cont)) ->
J.object [ "type" J..= ("http_exception" :: Text)
, "message" J..= show cont
]
data HttpResponse a
= HttpResponse
{ _hrBody :: !a
, _hrHeaders :: !HTTP.ResponseHeaders
} deriving (Functor, Foldable, Traversable)