git.iko.soy/typeable/servant
on master help sign in
Merge pull request #740 from stevana/client/include-request-in-failure-response
4ae8b18Oleg Grenrus
servant-client/src/Servant/Common/Req.hs+9−3
compare with master
unifiedsplit
@@ -49,7 +49,8 @@ import Web.HttpApiData
49
49
50data ServantError
50data ServantError
51 = FailureResponse
51 = FailureResponse
52+ { failingRequest :: UrlReq
52− { responseStatus :: Status
53+ , responseStatus :: Status
53 , responseContentType :: MediaType
54 , responseContentType :: MediaType
54 , responseBody :: ByteString
55 , responseBody :: ByteString
55 }
56 }
@@ -72,7 +73,7 @@ data ServantError
72 deriving (Show, Typeable)
73 deriving (Show, Typeable)
73
74
74instance Eq ServantError where
75instance Eq ServantError where
75− FailureResponse a b c == FailureResponse x y z =
76+ FailureResponse _ a b c == FailureResponse _ x y z =
76 (a, b, c) == (x, y, z)
77 (a, b, c) == (x, y, z)
77 DecodeFailure a b c == DecodeFailure x y z =
78 DecodeFailure a b c == DecodeFailure x y z =
78 (a, b, c) == (x, y, z)
79 (a, b, c) == (x, y, z)
@@ -86,6 +87,11 @@ instance Eq ServantError where
86
87
87instance Exception ServantError
88instance Exception ServantError
88
89
90+data UrlReq = UrlReq BaseUrl Req
91+
92+instance Show UrlReq where
93+ show (UrlReq url req) = showBaseUrl url ++ reqPath req ++ "?" ++ show (qs req)
94+
89data Req = Req
95data Req = Req
90 { reqPath :: BS.Builder
96 { reqPath :: BS.Builder
91 , qs :: QueryText
97 , qs :: QueryText
@@ -252,7 +258,7 @@ performRequest reqMethod req = do
252 Nothing -> throwError $ InvalidContentTypeHeader (cs t) body
258 Nothing -> throwError $ InvalidContentTypeHeader (cs t) body
253 Just t' -> pure t'
259 Just t' -> pure t'
254 unless (status_code >= 200 && status_code < 300) $
260 unless (status_code >= 200 && status_code < 300) $
255− throwError $ FailureResponse status ct body
261+ throwError $ FailureResponse (UrlReq reqHost req) status ct body
256 return (status_code, body, ct, hdrs, response)
262 return (status_code, body, ct, hdrs, response)
257
263
258performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req
264performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req
servant-client/test/Servant/ClientSpec.hs+1−1
@@ -372,7 +372,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
372 let (_ :<|> getDeleteEmpty :<|> _) = client api
372 let (_ :<|> getDeleteEmpty :<|> _) = client api
373 Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl)
373 Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl)
374 case res of
374 case res of
375− FailureResponse (HTTP.Status 404 "Not Found") _ _ -> return ()
375+ FailureResponse _ (HTTP.Status 404 "Not Found") _ _ -> return ()
376 _ -> fail $ "expected 404 response, but got " <> show res
376 _ -> fail $ "expected 404 response, but got " <> show res
377
377
378 it "reports DecodeFailure" $ \(_, baseUrl) -> do
378 it "reports DecodeFailure" $ \(_, baseUrl) -> do