@@ -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
142+ -- Content-Type and Accept are specified by requestBody and requestAccept
143+ headers = filter (\(h, _) -> h /= "Accept" && h /= "Content-Type") $
144+ toList $requestHeaders r
148+ | otherwise = Just ("Accept", renderHeader hs)
150+ hs = toList $ requestAccept r
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))
146 isSecure = case baseUrlScheme burl of
157 isSecure = case baseUrlScheme burl of
147 Http -> False
158 Http -> False
148 Https -> True
159 Https -> True