on master help sign in
Make headers with same names overwrite each other
commit9c5715e6c740000b599d84b8f5392d344694e80a authormrkkrp <markkarpov@opmbx.org> dateThu 3 Nov 2016, 22:08 (10 years ago) parent0cc36ee
1 file changed+17−10
Network/HTTP/Req.hs+17−10
Network/HTTP/Req.hs+17−10
@@ -172,7 +172,9 @@ import Data.Aeson
172172import Data.ByteString (ByteString)
173173import Data.Data (Data)
174174import Data.Default.Class
175+import Data.Function (on)
175176import Data.IORef
177+import Data.List (nubBy)
176178import Data.List.NonEmpty (NonEmpty (..))
177179import Data.Proxy
178180import Data.Semigroup hiding (Option, option)
@@ -221,16 +223,21 @@ req
221223req method url body options = do
222224 config <- getHttpConfig
223225 manager <- liftIO (readIORef globalManager)
224− let request = flip appEndo L.defaultRequest $
225− -- NOTE Order of 'mappend's matters, here method is overwritten
226− -- first and 'options' take effect last. In particular, this means
227− -- that 'options' can overwrite things set by other request
228− -- components, which is useful for setting port number,
229− -- "Content-Type" header, etc.
230− getRequestMod options <>
231− getRequestMod config <>
232− getRequestMod (Womb body :: Womb "body" body) <>
233− getRequestMod url <>
226+ let -- NOTE First appearance of any given header wins. This allows to
227+ -- “overwrite” headers when we construct a request by cons-ing.
228+ nubHeaders = Endo $ \x ->
229+ x { L.requestHeaders = nubBy ((==) `on` fst) (L.requestHeaders x) }
230+ request = flip appEndo L.defaultRequest $
231+ -- NOTE Order of 'mappend's matters, here method is overwritten first
232+ -- and 'options' take effect last. In particular, this means that
233+ -- 'options' can overwrite things set by other request components,
234+ -- which is useful for setting port number, "Content-Type" header,
235+ -- etc.
236+ nubHeaders <>
237+ getRequestMod options <>
238+ getRequestMod config <>
239+ getRequestMod (Womb body :: Womb "body" body) <>
240+ getRequestMod url <>
234241 getRequestMod (Womb method :: Womb "method" method)
235242 liftIO (try $ getHttpResponse manager request)
236243 >>= either handleHttpException return