git.iko.soy/typeable/servant
on master help sign in
Send Accept header in servant-client

Fixes #858. The bug was introduced in servant-client-core refactor (servant-client-0.12). See https://github.com/haskell-servant/servant/blob/8973cf56f1feea8830212c05ca2c2682e398499e/servant-client/src/Servant/Common/Req.hs#L151-L179 for the unbroken variant in servant-client-0.11

commit8574d8d2a9ec3041efbc2459810bb9e363d1a036 authorOleg Grenrus <oleg.grenrus@iki.fi> dateFri 10 Nov 2017, 23:22 (9 years ago) parent83aea36
3 files changed+20−3
compare with master
unifiedsplit
servant-client/CHANGELOG.md+6 servant-client/servant-client.cabal+1−1 servant-client/src/Servant/Client/Internal/HttpClient.hs+13−2
servant-client/CHANGELOG.md+6
@@ -1,6 +1,12 @@
11[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md)
22[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
33
4+0.12.0.1
5+--------
6+
7+- Send `Accept` header.
8+ ([#858](https://github.com/haskell-servant/servant/issues/858))
9+
4100.12
511----
612
servant-client/servant-client.cabal+1−1
@@ -1,5 +1,5 @@
11name: servant-client
2−version: 0.12
2+version: 0.12.0.1
33synopsis: automatical derivation of querying functions for servant webservices
44description:
55 This library lets you derive automatically Haskell functions that
servant-client/src/Servant/Client/Internal/HttpClient.hs+13−2
@@ -28,6 +28,7 @@ import Data.ByteString.Builder (toLazyByteString)
2828import qualified Data.ByteString.Lazy as BSL
2929import Data.Foldable (toList)
3030import Data.Functor.Alt (Alt (..))
31+import Data.Maybe (maybeToList)
3132import Data.Monoid ((<>))
3233import Data.Proxy (Proxy (..))
3334import Data.Sequence (fromList)
@@ -133,16 +134,26 @@ requestToClientRequest burl r = Client.defaultRequest
133134 <> toLazyByteString (requestPath r)
134135 , Client.queryString = renderQuery True . toList $ requestQueryString r
135136 , Client.requestHeaders =
136− let orig = toList $ requestHeaders r
137− in maybe orig (: orig) contentTypeHdr
137+ maybeToList acceptHdr ++ maybeToList contentTypeHdr ++ headers
138138 , Client.requestBody = body
139139 , Client.secure = isSecure
140140 }
141141 where
142+ -- Content-Type and Accept are specified by requestBody and requestAccept
143+ headers = filter (\(h, _) -> h /= "Accept" && h /= "Content-Type") $
144+ toList $requestHeaders r
145+
146+ acceptHdr
147+ | null hs = Nothing
148+ | otherwise = Just ("Accept", renderHeader hs)
149+ where
150+ hs = toList $ requestAccept r
151+
142152 (body, contentTypeHdr) = case requestBody r of
143153 Nothing -> (Client.RequestBodyLBS "", Nothing)
144154 Just (RequestBodyLBS body', typ)
145155 -> (Client.RequestBodyLBS body', Just (hContentType, renderHeader typ))
156+
146157 isSecure = case baseUrlScheme burl of
147158 Http -> False
148159 Https -> True