Merge pull request #860 from haskell-servant/issue-858-accept-hdr

Send Accept header in servant-client
This commit is contained in:
Oleg Grenrus 2017-11-11 00:05:11 +02:00 committed by GitHub
commit e886ab83ab
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
4 changed files with 25 additions and 3 deletions

View file

@ -10,6 +10,11 @@ sudo: false
git: git:
submodules: false # whether to recursively clone submodules submodules: false # whether to recursively clone submodules
branches:
only:
- master
- release-0.12
cache: cache:
directories: directories:
- $HOME/.cabal/packages - $HOME/.cabal/packages

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