git.iko.soy/typeable/servant
on master help sign in
Merge pull request #1204 from przembot/fix/issue-1200

Fix Verb with headers checking content type differently (and add test for it)

commit7de93f9a51307cfdba62e3f1038f0053d6fa58fb authorAlp Mestanogullari <alpmestan@gmail.com> dateFri 16 Aug 2019, 20:41 (7 years ago) parent35cae91c780e34
3 files changed+12−6
servant-client-core/src/Servant/Client/Core/HasClient.hs+4−6 servant-client/test/Servant/ClientTestUtils.hs+2 servant-client/test/Servant/FailSpec.hs+6
servant-client-core/src/Servant/Client/Core/HasClient.hs+4−6
@@ -253,12 +253,10 @@ instance {-# OVERLAPPING #-}
253253 { requestMethod = method
254254 , requestAccept = fromList $ toList accept
255255 }
256− case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of
257− Left err -> throwClientError $ DecodeFailure (pack err) response
258− Right val -> return $ Headers
259− { getResponse = val
260− , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
261− }
256+ val <- response `decodedAs` (Proxy :: Proxy ct)
257+ return $ Headers { getResponse = val
258+ , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
259+ }
262260 where method = reflectMethod (Proxy :: Proxy method)
263261 accept = contentTypes (Proxy :: Proxy ct)
264262
servant-client/test/Servant/ClientTestUtils.hs+2
@@ -168,6 +168,7 @@ type FailApi =
168168 "get" :> Raw
169169 :<|> "capture" :> Capture "name" String :> Raw
170170 :<|> "body" :> Raw
171+ :<|> "headers" :> Raw
171172failApi :: Proxy FailApi
172173failApi = Proxy
173174
@@ -176,6 +177,7 @@ failServer = serve failApi (
176177 (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "")
177178 :<|> (\ _capture -> Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/json")] "")
178179 :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
180+ :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/x-www-form-urlencoded"), ("X-Example1", "1"), ("X-Example2", "foo")] "")
179181 )
180182
181183-- * basic auth stuff
servant-client/test/Servant/FailSpec.hs+6
@@ -67,6 +67,12 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
6767 UnsupportedContentType "application/octet-stream" _ -> return ()
6868 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
6969
70+ it "reports UnsupportedContentType when there are response headers" $ \(_, baseUrl) -> do
71+ Left res <- runClient getRespHeaders baseUrl
72+ case res of
73+ UnsupportedContentType "application/x-www-form-urlencoded" _ -> return ()
74+ _ -> fail $ "expected UnsupportedContentType, but got " <> show res
75+
7076 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
7177 let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
7278 Left res <- runClient (getBody alice) baseUrl