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

Send Accept header in servant-client

.travis.yml

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

servant-client/CHANGELOG.md

@@ -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
 ----
 

servant-client/servant-client.cabal

@@ -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

servant-client/src/Servant/Client/Internal/HttpClient.hs

@@ -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
+    maybeToList acceptHdr ++ maybeToList contentTypeHdr ++ headers
-      in maybe orig (: orig) contentTypeHdr
   , 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