module Hasura.HTTP
  ( wreqOptions,
    HttpException (..),
    hdrsToText,
    addDefaultHeaders,
    defaultHeaders,
    HttpResponse (..),
    addHttpResponseHeaders,
    getHTTPExceptionStatus,
    serializeHTTPExceptionMessage,
    serializeHTTPExceptionMessageForDebugging,
    serializeServantClientErrorMessage,
    serializeServantClientErrorMessageForDebugging,
  )
where

import Control.Exception (Exception (..), fromException)
import Control.Lens hiding ((.=))
import Data.Aeson qualified as J
import Data.Aeson.KeyMap qualified as KM
import Data.CaseInsensitive (original)
import Data.HashMap.Strict qualified as M
import Data.Text qualified as T
import Data.Text.Conversions (UTF8 (..), convertText)
import Data.Text.Encoding qualified as TE
import Data.Text.Encoding.Error qualified as TE
import Hasura.Prelude
import Hasura.Server.Utils (redactSensitiveHeader)
import Hasura.Server.Version (currentVersion)
import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Client.Restricted qualified as Restricted
import Network.HTTP.Media qualified as HTTP
import Network.HTTP.Types qualified as HTTP
import Network.Wreq qualified as Wreq
import Servant.Client qualified as Servant

hdrsToText :: [HTTP.Header] -> [(Text, Text)]
hdrsToText :: [Header] -> [(Text, Text)]
hdrsToText [Header]
hdrs =
  [ (ByteString -> Text
bsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString
forall s. CI s -> s
original CI ByteString
hdrName, ByteString -> Text
bsToTxt ByteString
hdrVal)
    | (CI ByteString
hdrName, ByteString
hdrVal) <- [Header]
hdrs
  ]

wreqOptions :: HTTP.Manager -> [HTTP.Header] -> Wreq.Options
wreqOptions :: Manager -> [Header] -> Options
wreqOptions Manager
manager [Header]
hdrs =
  Options
Wreq.defaults
    Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& ([Header] -> Identity [Header]) -> Options -> Identity Options
Lens' Options [Header]
Wreq.headers (([Header] -> Identity [Header]) -> Options -> Identity Options)
-> [Header] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Header] -> [Header]
addDefaultHeaders [Header]
hdrs
    Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& (Maybe ResponseChecker -> Identity (Maybe ResponseChecker))
-> Options -> Identity Options
Lens' Options (Maybe ResponseChecker)
Wreq.checkResponse ((Maybe ResponseChecker -> Identity (Maybe ResponseChecker))
 -> Options -> Identity Options)
-> ResponseChecker -> Options -> Options
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (\Request
_ Response BodyReader
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& (Either ManagerSettings Manager
 -> Identity (Either ManagerSettings Manager))
-> Options -> Identity Options
Lens' Options (Either ManagerSettings Manager)
Wreq.manager ((Either ManagerSettings Manager
  -> Identity (Either ManagerSettings Manager))
 -> Options -> Identity Options)
-> Either ManagerSettings Manager -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Manager -> Either ManagerSettings Manager
forall a b. b -> Either a b
Right Manager
manager

-- Adds defaults headers overwriting any existing ones
addDefaultHeaders :: [HTTP.Header] -> [HTTP.Header]
addDefaultHeaders :: [Header] -> [Header]
addDefaultHeaders [Header]
hdrs = [Header]
defaultHeaders [Header] -> [Header] -> [Header]
forall a. Semigroup a => a -> a -> a
<> [Header] -> [Header]
rmDefaultHeaders [Header]
hdrs
  where
    rmDefaultHeaders :: [Header] -> [Header]
rmDefaultHeaders = (Header -> Bool) -> [Header] -> [Header]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Header -> Bool) -> Header -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> Bool
isDefaultHeader)

isDefaultHeader :: HTTP.Header -> Bool
isDefaultHeader :: Header -> Bool
isDefaultHeader (CI ByteString
hdrName, ByteString
_) = CI ByteString
hdrName CI ByteString -> [CI ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Header -> CI ByteString) -> [Header] -> [CI ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Header -> CI ByteString
forall a b. (a, b) -> a
fst [Header]
defaultHeaders

defaultHeaders :: [HTTP.Header]
defaultHeaders :: [Header]
defaultHeaders = [Header
contentType, Header
userAgent]
  where
    contentType :: Header
contentType = (CI ByteString
"Content-Type", ByteString
"application/json")
    userAgent :: Header
userAgent =
      ( CI ByteString
"User-Agent",
        ByteString
"hasura-graphql-engine/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> UTF8 ByteString -> ByteString
forall a. UTF8 a -> a
unUTF8 (Version -> UTF8 ByteString
forall a b. (ToText a, FromText b) => a -> b
convertText Version
currentVersion)
      )

newtype HttpException = HttpException
  {HttpException -> HttpException
unHttpException :: HTTP.HttpException}
  deriving (Int -> HttpException -> ShowS
[HttpException] -> ShowS
HttpException -> String
(Int -> HttpException -> ShowS)
-> (HttpException -> String)
-> ([HttpException] -> ShowS)
-> Show HttpException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HttpException] -> ShowS
$cshowList :: [HttpException] -> ShowS
show :: HttpException -> String
$cshow :: HttpException -> String
showsPrec :: Int -> HttpException -> ShowS
$cshowsPrec :: Int -> HttpException -> ShowS
Show)

getHTTPExceptionStatus :: HttpException -> Maybe Int
getHTTPExceptionStatus :: HttpException -> Maybe Int
getHTTPExceptionStatus = \case
  (HttpException (HTTP.HttpExceptionRequest Request
_ HttpExceptionContent
httpExceptionContent)) ->
    case HttpExceptionContent
httpExceptionContent of
      HTTP.StatusCodeException Response ()
response ByteString
_ -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Status -> Int
HTTP.statusCode (Status -> Int) -> Status -> Int
forall a b. (a -> b) -> a -> b
$ Response () -> Status
forall body. Response body -> Status
HTTP.responseStatus Response ()
response
      HTTP.ProxyConnectException ByteString
_ Int
_ Status
status -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Status -> Int
HTTP.statusCode Status
status
      HttpExceptionContent
_ -> Maybe Int
forall a. Maybe a
Nothing
  (HttpException (HTTP.InvalidUrlException String
_ String
_)) -> Maybe Int
forall a. Maybe a
Nothing

serializeHTTPExceptionMessage :: HttpException -> Text
serializeHTTPExceptionMessage :: HttpException -> Text
serializeHTTPExceptionMessage (HttpException (HTTP.HttpExceptionRequest Request
_ HttpExceptionContent
httpExceptionContent)) =
  case HttpExceptionContent
httpExceptionContent of
    HTTP.StatusCodeException Response ()
_ ByteString
_ -> Text
"unexpected"
    HTTP.TooManyRedirects [Response ByteString]
_ -> Text
"Too many redirects"
    HttpExceptionContent
HTTP.OverlongHeaders -> Text
"Overlong headers"
    HttpExceptionContent
HTTP.ResponseTimeout -> Text
"Response timeout"
    HttpExceptionContent
HTTP.ConnectionTimeout -> Text
"Connection timeout"
    HTTP.ConnectionFailure SomeException
_ -> Text
"Connection failure"
    HTTP.InvalidStatusLine ByteString
_ -> Text
"Invalid HTTP Status Line"
    HTTP.InternalException SomeException
err -> case SomeException -> Maybe ConnectionRestricted
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err of
      Just (Restricted.ConnectionRestricted String
_ AddrInfo
_) -> Text
"Blocked connection to private IP address"
      Maybe ConnectionRestricted
Nothing -> Text
"Internal Exception"
    HTTP.ProxyConnectException {} -> Text
"Proxy connection exception"
    HttpExceptionContent
HTTP.NoResponseDataReceived -> Text
"No response data received"
    HttpExceptionContent
HTTP.TlsNotSupported -> Text
"TLS not supported"
    HTTP.InvalidDestinationHost ByteString
_ -> Text
"Invalid destination host"
    HTTP.InvalidHeader ByteString
_ -> Text
"Invalid Header"
    HTTP.InvalidRequestHeader ByteString
_ -> Text
"Invalid Request Header"
    HTTP.WrongRequestBodyStreamSize Word64
_ Word64
_ -> Text
"Wrong request body stream size"
    HTTP.ResponseBodyTooShort Word64
_ Word64
_ -> Text
"Response body too short"
    HttpExceptionContent
HTTP.InvalidChunkHeaders -> Text
"Invalid chunk headers"
    HttpExceptionContent
HTTP.IncompleteHeaders -> Text
"Incomplete headers"
    HttpExceptionContent
_ -> Text
"unexpected"
serializeHTTPExceptionMessage (HttpException (HTTP.InvalidUrlException String
url String
reason)) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"URL: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
url String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is invalid because " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
reason

serializeHTTPExceptionMessageForDebugging :: HTTP.HttpException -> Text
serializeHTTPExceptionMessageForDebugging :: HttpException -> Text
serializeHTTPExceptionMessageForDebugging = \case
  HTTP.HttpExceptionRequest Request
_ HttpExceptionContent
err -> case HttpExceptionContent
err of
    HTTP.StatusCodeException Response ()
response ByteString
_ -> Text
"response status code indicated failure" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> (Status -> Int) -> Status -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Int
HTTP.statusCode (Status -> Text) -> Status -> Text
forall a b. (a -> b) -> a -> b
$ Response () -> Status
forall body. Response body -> Status
HTTP.responseStatus Response ()
response)
    HTTP.TooManyRedirects [Response ByteString]
redirects -> Text
"too many redirects: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow ([Response ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Response ByteString]
redirects) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" redirects"
    HttpExceptionContent
HTTP.OverlongHeaders -> Text
"overlong headers"
    HttpExceptionContent
HTTP.ResponseTimeout -> Text
"response timeout"
    HttpExceptionContent
HTTP.ConnectionTimeout -> Text
"connection timeout"
    HTTP.ConnectionFailure SomeException
exn -> Text
"connection failure: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeException -> Text
forall e. Exception e => e -> Text
serializeExceptionForDebugging SomeException
exn
    HTTP.InvalidStatusLine ByteString
statusLine -> Text
"invalid status line: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
fromUtf8 ByteString
statusLine
    HTTP.InvalidHeader ByteString
header -> Text
"invalid header: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
fromUtf8 ByteString
header
    HTTP.InvalidRequestHeader ByteString
requestHeader -> Text
"invalid request header: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
fromUtf8 ByteString
requestHeader
    HTTP.InternalException SomeException
exn -> Text
"internal error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeException -> Text
forall e. Exception e => e -> Text
serializeExceptionForDebugging SomeException
exn
    HTTP.ProxyConnectException ByteString
proxyHost Int
port Status
status -> Text
"proxy connection to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
fromUtf8 ByteString
proxyHost Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
port Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" returned response with status code that indicated failure: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Status -> Int
HTTP.statusCode Status
status)
    HttpExceptionContent
HTTP.NoResponseDataReceived -> Text
"no response data received"
    HttpExceptionContent
HTTP.TlsNotSupported -> Text
"TLS not supported"
    HTTP.WrongRequestBodyStreamSize Word64
expected Word64
actual -> Text
"wrong request body stream size. expected: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
tshow Word64
expected Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", actual: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
tshow Word64
actual
    HTTP.ResponseBodyTooShort Word64
expected Word64
actual -> Text
"response body too short. expected: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
tshow Word64
expected Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", actual: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
tshow Word64
actual
    HttpExceptionContent
HTTP.InvalidChunkHeaders -> Text
"invalid chunk headers"
    HttpExceptionContent
HTTP.IncompleteHeaders -> Text
"incomplete headers"
    HTTP.InvalidDestinationHost ByteString
host -> Text
"invalid destination host: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
fromUtf8 ByteString
host
    HTTP.HttpZlibException ZlibException
exn -> Text
"HTTP zlib error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ZlibException -> Text
forall e. Exception e => e -> Text
serializeExceptionForDebugging ZlibException
exn
    HTTP.InvalidProxyEnvironmentVariable Text
name Text
value -> Text
"invalid proxy environment variable: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value
    HttpExceptionContent
HTTP.ConnectionClosed -> Text
"connection closed"
    HTTP.InvalidProxySettings Text
err' -> Text
"invalid proxy settings: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err'
  HTTP.InvalidUrlException String
url' String
reason -> Text
"invalid url: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
url' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"; reason: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
reason
  where
    fromUtf8 :: ByteString -> Text
fromUtf8 = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TE.lenientDecode

encodeHTTPRequestJSON :: HTTP.Request -> J.Value
encodeHTTPRequestJSON :: Request -> Value
encodeHTTPRequestJSON Request
request =
  Object -> Value
J.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$
    [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList
      [ (Key
"host", Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
HTTP.host Request
request),
        (Key
"port", Int -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Int -> Value) -> Int -> Value
forall a b. (a -> b) -> a -> b
$ Request -> Int
HTTP.port Request
request),
        (Key
"secure", Bool -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Bool -> Value) -> Bool -> Value
forall a b. (a -> b) -> a -> b
$ Request -> Bool
HTTP.secure Request
request),
        (Key
"requestHeaders", HashMap Text Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON (HashMap Text Text -> Value) -> HashMap Text Text -> Value
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(Text, Text)] -> HashMap Text Text)
-> [(Text, Text)] -> HashMap Text Text
forall a b. (a -> b) -> a -> b
$ [Header] -> [(Text, Text)]
hdrsToText ([Header] -> [(Text, Text)]) -> [Header] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (Header -> Header) -> [Header] -> [Header]
forall a b. (a -> b) -> [a] -> [b]
map Header -> Header
redactSensitiveHeader ([Header] -> [Header]) -> [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ Request -> [Header]
HTTP.requestHeaders Request
request),
        (Key
"path", Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
HTTP.path Request
request),
        (Key
"queryString", Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
HTTP.queryString Request
request),
        (Key
"method", Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
HTTP.method Request
request),
        (Key
"responseTimeout", Text -> Value
J.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ResponseTimeout -> Text
forall a. Show a => a -> Text
tshow (ResponseTimeout -> Text) -> ResponseTimeout -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ResponseTimeout
HTTP.responseTimeout Request
request)
      ]

instance J.ToJSON HttpException where
  toJSON :: HttpException -> Value
toJSON HttpException
httpException =
    case HttpException
httpException of
      (HttpException (HTTP.InvalidUrlException String
_ String
e)) ->
        [(Key, Value)] -> Value
J.object
          [ Key
"type" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= (Text
"invalid_url" :: Text),
            Key
"message" Key -> String -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= String
e
          ]
      (HttpException (HTTP.HttpExceptionRequest Request
req HttpExceptionContent
_)) ->
        let statusMaybe :: Maybe Int
statusMaybe = HttpException -> Maybe Int
getHTTPExceptionStatus HttpException
httpException
            exceptionContent :: Text
exceptionContent = HttpException -> Text
serializeHTTPExceptionMessage HttpException
httpException
            reqJSON :: Value
reqJSON = Request -> Value
encodeHTTPRequestJSON Request
req
         in [(Key, Value)] -> Value
J.object ([(Key, Value)] -> Value) -> [(Key, Value)] -> Value
forall a b. (a -> b) -> a -> b
$
              [ Key
"type" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= (Text
"http_exception" :: Text),
                Key
"message" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Text
exceptionContent,
                Key
"request" Key -> Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Value
reqJSON
              ]
                [(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
<> [(Key, Value)]
-> (Int -> [(Key, Value)]) -> Maybe Int -> [(Key, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Key, Value)]
forall a. Monoid a => a
mempty (\Int
status -> [Key
"status" Key -> Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Int
status]) Maybe Int
statusMaybe

data HttpResponse a = HttpResponse
  { HttpResponse a -> a
_hrBody :: !a,
    HttpResponse a -> [Header]
_hrHeaders :: !HTTP.ResponseHeaders
  }
  deriving (a -> HttpResponse b -> HttpResponse a
(a -> b) -> HttpResponse a -> HttpResponse b
(forall a b. (a -> b) -> HttpResponse a -> HttpResponse b)
-> (forall a b. a -> HttpResponse b -> HttpResponse a)
-> Functor HttpResponse
forall a b. a -> HttpResponse b -> HttpResponse a
forall a b. (a -> b) -> HttpResponse a -> HttpResponse b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> HttpResponse b -> HttpResponse a
$c<$ :: forall a b. a -> HttpResponse b -> HttpResponse a
fmap :: (a -> b) -> HttpResponse a -> HttpResponse b
$cfmap :: forall a b. (a -> b) -> HttpResponse a -> HttpResponse b
Functor, HttpResponse a -> Bool
(a -> m) -> HttpResponse a -> m
(a -> b -> b) -> b -> HttpResponse a -> b
(forall m. Monoid m => HttpResponse m -> m)
-> (forall m a. Monoid m => (a -> m) -> HttpResponse a -> m)
-> (forall m a. Monoid m => (a -> m) -> HttpResponse a -> m)
-> (forall a b. (a -> b -> b) -> b -> HttpResponse a -> b)
-> (forall a b. (a -> b -> b) -> b -> HttpResponse a -> b)
-> (forall b a. (b -> a -> b) -> b -> HttpResponse a -> b)
-> (forall b a. (b -> a -> b) -> b -> HttpResponse a -> b)
-> (forall a. (a -> a -> a) -> HttpResponse a -> a)
-> (forall a. (a -> a -> a) -> HttpResponse a -> a)
-> (forall a. HttpResponse a -> [a])
-> (forall a. HttpResponse a -> Bool)
-> (forall a. HttpResponse a -> Int)
-> (forall a. Eq a => a -> HttpResponse a -> Bool)
-> (forall a. Ord a => HttpResponse a -> a)
-> (forall a. Ord a => HttpResponse a -> a)
-> (forall a. Num a => HttpResponse a -> a)
-> (forall a. Num a => HttpResponse a -> a)
-> Foldable HttpResponse
forall a. Eq a => a -> HttpResponse a -> Bool
forall a. Num a => HttpResponse a -> a
forall a. Ord a => HttpResponse a -> a
forall m. Monoid m => HttpResponse m -> m
forall a. HttpResponse a -> Bool
forall a. HttpResponse a -> Int
forall a. HttpResponse a -> [a]
forall a. (a -> a -> a) -> HttpResponse a -> a
forall m a. Monoid m => (a -> m) -> HttpResponse a -> m
forall b a. (b -> a -> b) -> b -> HttpResponse a -> b
forall a b. (a -> b -> b) -> b -> HttpResponse a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: HttpResponse a -> a
$cproduct :: forall a. Num a => HttpResponse a -> a
sum :: HttpResponse a -> a
$csum :: forall a. Num a => HttpResponse a -> a
minimum :: HttpResponse a -> a
$cminimum :: forall a. Ord a => HttpResponse a -> a
maximum :: HttpResponse a -> a
$cmaximum :: forall a. Ord a => HttpResponse a -> a
elem :: a -> HttpResponse a -> Bool
$celem :: forall a. Eq a => a -> HttpResponse a -> Bool
length :: HttpResponse a -> Int
$clength :: forall a. HttpResponse a -> Int
null :: HttpResponse a -> Bool
$cnull :: forall a. HttpResponse a -> Bool
toList :: HttpResponse a -> [a]
$ctoList :: forall a. HttpResponse a -> [a]
foldl1 :: (a -> a -> a) -> HttpResponse a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> HttpResponse a -> a
foldr1 :: (a -> a -> a) -> HttpResponse a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> HttpResponse a -> a
foldl' :: (b -> a -> b) -> b -> HttpResponse a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> HttpResponse a -> b
foldl :: (b -> a -> b) -> b -> HttpResponse a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> HttpResponse a -> b
foldr' :: (a -> b -> b) -> b -> HttpResponse a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> HttpResponse a -> b
foldr :: (a -> b -> b) -> b -> HttpResponse a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> HttpResponse a -> b
foldMap' :: (a -> m) -> HttpResponse a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> HttpResponse a -> m
foldMap :: (a -> m) -> HttpResponse a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> HttpResponse a -> m
fold :: HttpResponse m -> m
$cfold :: forall m. Monoid m => HttpResponse m -> m
Foldable, Functor HttpResponse
Foldable HttpResponse
Functor HttpResponse
-> Foldable HttpResponse
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> HttpResponse a -> f (HttpResponse b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    HttpResponse (f a) -> f (HttpResponse a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> HttpResponse a -> m (HttpResponse b))
-> (forall (m :: * -> *) a.
    Monad m =>
    HttpResponse (m a) -> m (HttpResponse a))
-> Traversable HttpResponse
(a -> f b) -> HttpResponse a -> f (HttpResponse b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
HttpResponse (m a) -> m (HttpResponse a)
forall (f :: * -> *) a.
Applicative f =>
HttpResponse (f a) -> f (HttpResponse a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HttpResponse a -> m (HttpResponse b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HttpResponse a -> f (HttpResponse b)
sequence :: HttpResponse (m a) -> m (HttpResponse a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
HttpResponse (m a) -> m (HttpResponse a)
mapM :: (a -> m b) -> HttpResponse a -> m (HttpResponse b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HttpResponse a -> m (HttpResponse b)
sequenceA :: HttpResponse (f a) -> f (HttpResponse a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
HttpResponse (f a) -> f (HttpResponse a)
traverse :: (a -> f b) -> HttpResponse a -> f (HttpResponse b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HttpResponse a -> f (HttpResponse b)
$cp2Traversable :: Foldable HttpResponse
$cp1Traversable :: Functor HttpResponse
Traversable)

addHttpResponseHeaders :: HTTP.ResponseHeaders -> HttpResponse a -> HttpResponse a
addHttpResponseHeaders :: [Header] -> HttpResponse a -> HttpResponse a
addHttpResponseHeaders [Header]
newHeaders (HttpResponse a
b [Header]
h) = a -> [Header] -> HttpResponse a
forall a. a -> [Header] -> HttpResponse a
HttpResponse a
b ([Header]
newHeaders [Header] -> [Header] -> [Header]
forall a. Semigroup a => a -> a -> a
<> [Header]
h)

serializeServantClientErrorMessage :: Servant.ClientError -> Text
serializeServantClientErrorMessage :: ClientError -> Text
serializeServantClientErrorMessage = \case
  Servant.FailureResponse RequestF () (BaseUrl, ByteString)
_ Response
response -> Text
"response status code indicated failure: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> (Status -> Int) -> Status -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Int
HTTP.statusCode (Status -> Text) -> Status -> Text
forall a b. (a -> b) -> a -> b
$ Response -> Status
forall a. ResponseF a -> Status
Servant.responseStatusCode Response
response)
  Servant.DecodeFailure Text
decodeErrorText Response
_ -> Text
"unable to decode the response, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
decodeErrorText
  Servant.UnsupportedContentType MediaType
mediaType Response
_ -> Text
"unsupported content type in response: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TE.lenientDecode (MediaType -> ByteString
forall h. RenderHeader h => h -> ByteString
HTTP.renderHeader MediaType
mediaType)
  Servant.InvalidContentTypeHeader Response
_ -> Text
"invalid content type in response"
  Servant.ConnectionError SomeException
_ -> Text
"connection error"

serializeServantClientErrorMessageForDebugging :: Servant.ClientError -> Text
serializeServantClientErrorMessageForDebugging :: ClientError -> Text
serializeServantClientErrorMessageForDebugging = \case
  Servant.ConnectionError SomeException
exn -> case SomeException -> Maybe HttpException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
exn of
    Just HttpException
httpException -> HttpException -> Text
serializeHTTPExceptionMessageForDebugging HttpException
httpException
    Maybe HttpException
Nothing -> Text
"error in the connection: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeException -> Text
forall e. Exception e => e -> Text
serializeExceptionForDebugging SomeException
exn
  ClientError
other -> ClientError -> Text
serializeServantClientErrorMessage ClientError
other

serializeExceptionForDebugging :: Exception e => e -> Text
serializeExceptionForDebugging :: e -> Text
serializeExceptionForDebugging = String -> Text
T.pack (String -> Text) -> (e -> String) -> e -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
forall e. Exception e => e -> String
displayException