From c780e349a02862501aaf35ca49a8c3ecd70f52ae Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Przemys=C5=82aw=20Kopa=C5=84ski?=
Date: Sun, 11 Aug 2019 21:19:34 +0200
Subject: [PATCH] Fix Verb with headers checking content type differently
---
.../src/Servant/Client/Core/HasClient.hs | 10 ++++------
servant-client/test/Servant/ClientTestUtils.hs | 2 ++
servant-client/test/Servant/FailSpec.hs | 6 ++++++
3 files changed, 12 insertions(+), 6 deletions(-)
diff --git a/servant-client-core/src/Servant/Client/Core/HasClient.hs b/servant-client-core/src/Servant/Client/Core/HasClient.hs
index 5c78bee6..604a3405 100644
--- a/servant-client-core/src/Servant/Client/Core/HasClient.hs
+++ b/servant-client-core/src/Servant/Client/Core/HasClient.hs
@@ -253,12 +253,10 @@ instance {-# OVERLAPPING #-}
{ requestMethod = method
, requestAccept = fromList $ toList accept
}
- case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of
- Left err -> throwClientError $ DecodeFailure (pack err) response
- Right val -> return $ Headers
- { getResponse = val
- , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
- }
+ val <- response `decodedAs` (Proxy :: Proxy ct)
+ return $ Headers { getResponse = val
+ , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
+ }
where method = reflectMethod (Proxy :: Proxy method)
accept = contentTypes (Proxy :: Proxy ct)
diff --git a/servant-client/test/Servant/ClientTestUtils.hs b/servant-client/test/Servant/ClientTestUtils.hs
index a483a405..f9fa4ce3 100644
--- a/servant-client/test/Servant/ClientTestUtils.hs
+++ b/servant-client/test/Servant/ClientTestUtils.hs
@@ -168,6 +168,7 @@ type FailApi =
"get" :> Raw
:<|> "capture" :> Capture "name" String :> Raw
:<|> "body" :> Raw
+ :<|> "headers" :> Raw
failApi :: Proxy FailApi
failApi = Proxy
@@ -176,6 +177,7 @@ failServer = serve failApi (
(Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "")
:<|> (\ _capture -> Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/json")] "")
:<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
+ :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/x-www-form-urlencoded"), ("X-Example1", "1"), ("X-Example2", "foo")] "")
)
-- * basic auth stuff
diff --git a/servant-client/test/Servant/FailSpec.hs b/servant-client/test/Servant/FailSpec.hs
index c5938e40..baec72b6 100644
--- a/servant-client/test/Servant/FailSpec.hs
+++ b/servant-client/test/Servant/FailSpec.hs
@@ -67,6 +67,12 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
UnsupportedContentType "application/octet-stream" _ -> return ()
_ -> fail $ "expected UnsupportedContentType, but got " <> show res
+ it "reports UnsupportedContentType when there are response headers" $ \(_, baseUrl) -> do
+ Left res <- runClient getRespHeaders baseUrl
+ case res of
+ UnsupportedContentType "application/x-www-form-urlencoded" _ -> return ()
+ _ -> fail $ "expected UnsupportedContentType, but got " <> show res
+
it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
Left res <- runClient (getBody alice) baseUrl