Merge pull request #1204 from przembot/fix/issue-1200

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

Author: alpmestan

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)
 

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

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