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) [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) [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 0.12
---- ----

View file

@ -1,5 +1,5 @@
name: servant-client name: servant-client
version: 0.12 version: 0.12.0.1
synopsis: automatical derivation of querying functions for servant webservices synopsis: automatical derivation of querying functions for servant webservices
description: description:
This library lets you derive automatically Haskell functions that 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 qualified Data.ByteString.Lazy as BSL
import Data.Foldable (toList) import Data.Foldable (toList)
import Data.Functor.Alt (Alt (..)) import Data.Functor.Alt (Alt (..))
import Data.Maybe (maybeToList)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.Proxy (Proxy (..)) import Data.Proxy (Proxy (..))
import Data.Sequence (fromList) import Data.Sequence (fromList)
@ -133,16 +134,26 @@ requestToClientRequest burl r = Client.defaultRequest
<> toLazyByteString (requestPath r) <> toLazyByteString (requestPath r)
, Client.queryString = renderQuery True . toList $ requestQueryString r , Client.queryString = renderQuery True . toList $ requestQueryString r
, Client.requestHeaders = , Client.requestHeaders =
let orig = toList $ requestHeaders r maybeToList acceptHdr ++ maybeToList contentTypeHdr ++ headers
in maybe orig (: orig) contentTypeHdr
, Client.requestBody = body , Client.requestBody = body
, Client.secure = isSecure , Client.secure = isSecure
} }
where 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 (body, contentTypeHdr) = case requestBody r of
Nothing -> (Client.RequestBodyLBS "", Nothing) Nothing -> (Client.RequestBodyLBS "", Nothing)
Just (RequestBodyLBS body', typ) Just (RequestBodyLBS body', typ)
-> (Client.RequestBodyLBS body', Just (hContentType, renderHeader typ)) -> (Client.RequestBodyLBS body', Just (hContentType, renderHeader typ))
isSecure = case baseUrlScheme burl of isSecure = case baseUrlScheme burl of
Http -> False Http -> False
Https -> True Https -> True