Send Accept header in servant-client

Fixes #858. The bug was introduced in servant-client-core refactor
(servant-client-0.12).

See 8973cf56f1/servant-client/src/Servant/Common/Req.hs (L151-L179)
for the unbroken variant in servant-client-0.11
This commit is contained in:
Oleg Grenrus 2017-11-10 23:22:05 +02:00
parent a3ce2c3ed8
commit a67cd56c1f
3 changed files with 20 additions and 3 deletions

View File

@ -1,6 +1,12 @@
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md)
[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
0.12.0.1
--------
- Send `Accept` header.
([#858](https://github.com/haskell-servant/servant/issues/858))
0.12
----

View File

@ -1,5 +1,5 @@
name: servant-client
version: 0.12
version: 0.12.0.1
synopsis: automatical derivation of querying functions for servant webservices
description:
This library lets you derive automatically Haskell functions that

View File

@ -28,6 +28,7 @@ import Data.ByteString.Builder (toLazyByteString)
import qualified Data.ByteString.Lazy as BSL
import Data.Foldable (toList)
import Data.Functor.Alt (Alt (..))
import Data.Maybe (maybeToList)
import Data.Monoid ((<>))
import Data.Proxy (Proxy (..))
import Data.Sequence (fromList)
@ -133,16 +134,26 @@ requestToClientRequest burl r = Client.defaultRequest
<> toLazyByteString (requestPath r)
, Client.queryString = renderQuery True . toList $ requestQueryString r
, Client.requestHeaders =
let orig = toList $ requestHeaders r
in maybe orig (: orig) contentTypeHdr
maybeToList acceptHdr ++ maybeToList contentTypeHdr ++ headers
, Client.requestBody = body
, Client.secure = isSecure
}
where
-- Content-Type and Accept are specified by requestBody and requestAccept
headers = filter (\(h, _) -> h /= "Accept" && h /= "Content-Type") $
toList $requestHeaders r
acceptHdr
| null hs = Nothing
| otherwise = Just ("Accept", renderHeader hs)
where
hs = toList $ requestAccept r
(body, contentTypeHdr) = case requestBody r of
Nothing -> (Client.RequestBodyLBS "", Nothing)
Just (RequestBodyLBS body', typ)
-> (Client.RequestBodyLBS body', Just (hContentType, renderHeader typ))
isSecure = case baseUrlScheme burl of
Http -> False
Https -> True