eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Include the request that failed in FailureResponse.

Browse source
This commit is contained in:
Stevan Andjelkovic 2017-05-05 15:31:38 +02:00
parent c84e650495
commit b8de9c8527
2 changed files with 10 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
servant-client/src/Servant/Common/Req.hs
View file

@ -48,7 +48,8 @@ import Web.HttpApiData
data ServantError data ServantError
= FailureResponse = FailureResponse
{ responseStatus :: Status { failingRequest :: Request
, responseStatus :: Status
, responseContentType :: MediaType , responseContentType :: MediaType
, responseBody :: ByteString , responseBody :: ByteString
} }
@ -71,8 +72,8 @@ 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 d == FailureResponse w x y z =
(a, b, c) == (x, y, z) (show a, b, c, d) == (show w, 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)
UnsupportedContentType a b == UnsupportedContentType x y = 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 runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm
performRequest :: Method -> Req performRequest :: Method -> Req
-> ClientM ( Int, ByteString, MediaType -> ClientM ( Int, ByteString, MediaType
, [HTTP.Header], Response ByteString) , [HTTP.Header], Response ByteString)
performRequest reqMethod req = do performRequest reqMethod req = do
@ -250,10 +251,10 @@ 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 request 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
-> ClientM ([HTTP.Header], result) -> ClientM ([HTTP.Header], result)
performRequestCT ct reqMethod req = do performRequestCT ct reqMethod req = do
let acceptCTS = contentTypes ct let acceptCTS = contentTypes ct

6
servant-client/test/Servant/ClientSpec.hs
View file

@ -122,9 +122,9 @@ getBody :: Person -> SCR.ClientM Person
getQueryParam :: Maybe String -> SCR.ClientM Person getQueryParam :: Maybe String -> SCR.ClientM Person
getQueryParams :: [String] -> SCR.ClientM [Person] getQueryParams :: [String] -> SCR.ClientM [Person]
getQueryFlag :: Bool -> SCR.ClientM Bool getQueryFlag :: Bool -> SCR.ClientM Bool
getRawSuccess :: HTTP.Method getRawSuccess :: HTTP.Method
-> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString) -> 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) -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
-> SCR.ClientM (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 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