Merge pull request #740 from stevana/client/include-request-in-failure-response
Include the request that failed in FailureResponse.
This commit is contained in:
commit
4ae8b1898f
2 changed files with 10 additions and 4 deletions
servant-client
|
@ -49,7 +49,8 @@ import Web.HttpApiData
|
||||||
|
|
||||||
data ServantError
|
data ServantError
|
||||||
= FailureResponse
|
= FailureResponse
|
||||||
{ responseStatus :: Status
|
{ failingRequest :: UrlReq
|
||||||
|
, responseStatus :: Status
|
||||||
, responseContentType :: MediaType
|
, responseContentType :: MediaType
|
||||||
, responseBody :: ByteString
|
, responseBody :: ByteString
|
||||||
}
|
}
|
||||||
|
@ -72,7 +73,7 @@ data ServantError
|
||||||
deriving (Show, Typeable)
|
deriving (Show, Typeable)
|
||||||
|
|
||||||
instance Eq ServantError where
|
instance Eq ServantError where
|
||||||
FailureResponse a b c == FailureResponse x y z =
|
FailureResponse _ a b c == FailureResponse _ x y z =
|
||||||
(a, b, c) == (x, y, z)
|
(a, b, c) == (x, y, z)
|
||||||
DecodeFailure a b c == DecodeFailure x y z =
|
DecodeFailure a b c == DecodeFailure x y z =
|
||||||
(a, b, c) == (x, y, z)
|
(a, b, c) == (x, y, z)
|
||||||
|
@ -86,6 +87,11 @@ instance Eq ServantError where
|
||||||
|
|
||||||
instance Exception ServantError
|
instance Exception ServantError
|
||||||
|
|
||||||
|
data UrlReq = UrlReq BaseUrl Req
|
||||||
|
|
||||||
|
instance Show UrlReq where
|
||||||
|
show (UrlReq url req) = showBaseUrl url ++ reqPath req ++ "?" ++ show (qs req)
|
||||||
|
|
||||||
data Req = Req
|
data Req = Req
|
||||||
{ reqPath :: BS.Builder
|
{ reqPath :: BS.Builder
|
||||||
, qs :: QueryText
|
, qs :: QueryText
|
||||||
|
@ -252,7 +258,7 @@ performRequest reqMethod req = do
|
||||||
Nothing -> throwError $ InvalidContentTypeHeader (cs t) body
|
Nothing -> throwError $ InvalidContentTypeHeader (cs t) body
|
||||||
Just t' -> pure t'
|
Just t' -> pure t'
|
||||||
unless (status_code >= 200 && status_code < 300) $
|
unless (status_code >= 200 && status_code < 300) $
|
||||||
throwError $ FailureResponse status ct body
|
throwError $ FailureResponse (UrlReq reqHost req) status ct body
|
||||||
return (status_code, body, ct, hdrs, response)
|
return (status_code, body, ct, hdrs, response)
|
||||||
|
|
||||||
performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req
|
performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req
|
||||||
|
|
|
@ -372,7 +372,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
|
||||||
let (_ :<|> getDeleteEmpty :<|> _) = client api
|
let (_ :<|> getDeleteEmpty :<|> _) = client api
|
||||||
Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl)
|
Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl)
|
||||||
case res of
|
case res of
|
||||||
FailureResponse (HTTP.Status 404 "Not Found") _ _ -> return ()
|
FailureResponse _ (HTTP.Status 404 "Not Found") _ _ -> return ()
|
||||||
_ -> fail $ "expected 404 response, but got " <> show res
|
_ -> fail $ "expected 404 response, but got " <> show res
|
||||||
|
|
||||||
it "reports DecodeFailure" $ \(_, baseUrl) -> do
|
it "reports DecodeFailure" $ \(_, baseUrl) -> do
|
||||||
|
|
Loading…
Add table
Reference in a new issue