Include the request that failed in FailureResponse.
This commit is contained in:
parent
c84e650495
commit
b8de9c8527
2 changed files with 10 additions and 9 deletions
|
@ -48,7 +48,8 @@ import Web.HttpApiData
|
|||
|
||||
data ServantError
|
||||
= FailureResponse
|
||||
{ responseStatus :: Status
|
||||
{ failingRequest :: Request
|
||||
, responseStatus :: Status
|
||||
, responseContentType :: MediaType
|
||||
, responseBody :: ByteString
|
||||
}
|
||||
|
@ -71,8 +72,8 @@ data ServantError
|
|||
deriving (Show, Typeable)
|
||||
|
||||
instance Eq ServantError where
|
||||
FailureResponse a b c == FailureResponse x y z =
|
||||
(a, b, c) == (x, y, z)
|
||||
FailureResponse a b c d == FailureResponse w x y z =
|
||||
(show a, b, c, d) == (show w, x, y, z)
|
||||
DecodeFailure a b c == DecodeFailure x y z =
|
||||
(a, b, c) == (x, y, z)
|
||||
UnsupportedContentType a b == UnsupportedContentType x y =
|
||||
|
@ -224,7 +225,7 @@ runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
|
|||
runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm
|
||||
|
||||
|
||||
performRequest :: Method -> Req
|
||||
performRequest :: Method -> Req
|
||||
-> ClientM ( Int, ByteString, MediaType
|
||||
, [HTTP.Header], Response ByteString)
|
||||
performRequest reqMethod req = do
|
||||
|
@ -250,10 +251,10 @@ performRequest reqMethod req = do
|
|||
Nothing -> throwError $ InvalidContentTypeHeader (cs t) body
|
||||
Just t' -> pure t'
|
||||
unless (status_code >= 200 && status_code < 300) $
|
||||
throwError $ FailureResponse status ct body
|
||||
throwError $ FailureResponse request status ct body
|
||||
return (status_code, body, ct, hdrs, response)
|
||||
|
||||
performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req
|
||||
performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req
|
||||
-> ClientM ([HTTP.Header], result)
|
||||
performRequestCT ct reqMethod req = do
|
||||
let acceptCTS = contentTypes ct
|
||||
|
|
|
@ -122,9 +122,9 @@ getBody :: Person -> SCR.ClientM Person
|
|||
getQueryParam :: Maybe String -> SCR.ClientM Person
|
||||
getQueryParams :: [String] -> SCR.ClientM [Person]
|
||||
getQueryFlag :: Bool -> SCR.ClientM Bool
|
||||
getRawSuccess :: HTTP.Method
|
||||
getRawSuccess :: HTTP.Method
|
||||
-> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
|
||||
getRawFailure :: HTTP.Method
|
||||
getRawFailure :: HTTP.Method
|
||||
-> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
|
||||
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
|
||||
-> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])])
|
||||
|
@ -372,7 +372,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
|
|||
let (_ :<|> getDeleteEmpty :<|> _) = client api
|
||||
Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl)
|
||||
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
|
||||
|
||||
it "reports DecodeFailure" $ \(_, baseUrl) -> do
|
||||
|
|
Loading…
Reference in a new issue