git.iko.soy/typeable/servant
on master help sign in
Send Accept header in servant-client
a67cd56Oleg Grenrus
servant-client/CHANGELOG.md+6
@@ -1,6 +1,12 @@
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md)
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
3
3
4+0.12.0.1
5+--------
6+
7+- Send `Accept` header.
8+ ([#858](https://github.com/haskell-servant/servant/issues/858))
9+
40.12
100.12
5----
11----
6
12
servant-client/servant-client.cabal+1−1
@@ -1,5 +1,5 @@
1name: servant-client
1name: servant-client
2−version: 0.12
2+version: 0.12.0.1
3synopsis: automatical derivation of querying functions for servant webservices
3synopsis: automatical derivation of querying functions for servant webservices
4description:
4description:
5 This library lets you derive automatically Haskell functions that
5 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)
28import qualified Data.ByteString.Lazy as BSL
28import qualified Data.ByteString.Lazy as BSL
29import Data.Foldable (toList)
29import Data.Foldable (toList)
30import Data.Functor.Alt (Alt (..))
30import Data.Functor.Alt (Alt (..))
31+import Data.Maybe (maybeToList)
31import Data.Monoid ((<>))
32import Data.Monoid ((<>))
32import Data.Proxy (Proxy (..))
33import Data.Proxy (Proxy (..))
33import Data.Sequence (fromList)
34import Data.Sequence (fromList)
@@ -133,16 +134,26 @@ requestToClientRequest burl r = Client.defaultRequest
133 <> toLazyByteString (requestPath r)
134 <> toLazyByteString (requestPath r)
134 , Client.queryString = renderQuery True . toList $ requestQueryString r
135 , Client.queryString = renderQuery True . toList $ requestQueryString r
135 , Client.requestHeaders =
136 , Client.requestHeaders =
136− let orig = toList $ requestHeaders r
137+ maybeToList acceptHdr ++ maybeToList contentTypeHdr ++ headers
137− in maybe orig (: orig) contentTypeHdr
138 , Client.requestBody = body
138 , Client.requestBody = body
139 , Client.secure = isSecure
139 , Client.secure = isSecure
140 }
140 }
141 where
141 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+
142 (body, contentTypeHdr) = case requestBody r of
152 (body, contentTypeHdr) = case requestBody r of
143 Nothing -> (Client.RequestBodyLBS "", Nothing)
153 Nothing -> (Client.RequestBodyLBS "", Nothing)
144 Just (RequestBodyLBS body', typ)
154 Just (RequestBodyLBS body', typ)
145 -> (Client.RequestBodyLBS body', Just (hContentType, renderHeader typ))
155 -> (Client.RequestBodyLBS body', Just (hContentType, renderHeader typ))
156+
146 isSecure = case baseUrlScheme burl of
157 isSecure = case baseUrlScheme burl of
147 Http -> False
158 Http -> False
148 Https -> True
159 Https -> True