Add shouldStripHeaderOnRedirect to Request

http-client/ChangeLog.md

@@ -1,5 +1,9 @@
 # Changelog for http-client
 
+## 0.6.2
+
+* Add `shouldStripHeaderOnRedirect` option to `Request` [#300](https://github.com/snoyberg/http-client/issues/300)
+
 ## 0.6.1.1
 
 * Ensure that `Int` parsing doesn't overflow [#383](https://github.com/snoyberg/http-client/issues/383)

http-client/Network/HTTP/Client.hs

@@ -159,6 +159,7 @@ module Network.HTTP.Client
     , applyBasicProxyAuth
     , decompress
     , redirectCount
+    , shouldStripHeaderOnRedirect
     , checkResponse
     , responseTimeout
     , cookieJar

http-client/Network/HTTP/Client/Request.hs

@@ -299,6 +299,7 @@ defaultRequest = Request
                 Just (_ :: IOException) -> return ()
                 Nothing -> throwIO se
         , requestManagerOverride = Nothing
+        , shouldStripHeaderOnRedirect = const False
         }
 
 -- | Parses a URL via 'parseRequest_'

http-client/Network/HTTP/Client/Response.hs

@@ -53,7 +53,11 @@ getRedirectedRequest req hs cookie_jar code
     | 300 <= code && code < 400 = do
         l' <- lookup "location" hs
         let l = escapeURIString isAllowedInURI (S8.unpack l')
-        req' <- setUriRelative req =<< parseURIReference l
+            stripHeaders r =
+              r{requestHeaders =
+                filter (not . shouldStripHeaderOnRedirect req . fst) $
+                requestHeaders r}
+        req' <- fmap stripHeaders <$> setUriRelative req =<< parseURIReference l
         return $
             if code == 302 || code == 303
                 -- According to the spec, this should *only* be for status code

http-client/Network/HTTP/Client/Types.hs

@@ -551,6 +551,12 @@ data Request = Request
     -- dealing with implicit global managers, such as in @Network.HTTP.Simple@
     --
     -- @since 0.4.28
+
+    , shouldStripHeaderOnRedirect :: HeaderName -> Bool
+    -- ^ Decide whether a header must be stripped from the request
+    -- when following a redirect. Default: keep all headers intact.
+    --
+    -- @since 0.6.2
     }
     deriving T.Typeable
 

http-client/http-client.cabal

@@ -1,5 +1,5 @@
 name:                http-client
-version:             0.6.1.1
+version:             0.6.2
 synopsis:            An HTTP client engine
 description:         Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/http-client>.
 homepage:            https://github.com/snoyberg/http-client

http-client/test-nonet/Network/HTTP/ClientSpec.hs

@@ -13,6 +13,7 @@ import           Network.HTTP.Client       hiding (port)
 import qualified Network.HTTP.Client       as NC
 import qualified Network.HTTP.Client.Internal as Internal
 import           Network.HTTP.Types        (status413)
+import           Network.HTTP.Types.Header
 import qualified Network.Socket            as NS
 import           Test.Hspec
 import qualified Data.Streaming.Network    as N
@@ -38,21 +39,28 @@ silentIOError a = a `E.catch` \e -> do
   let _ = e :: IOError
   return ()
 
-redirectServer :: (Int -> IO a) -> IO a
-redirectServer inner = bracket
+redirectServer :: Maybe Int
+               -- ^ If Just, stop redirecting after that many hops.
+               -> (Int -> IO a) -> IO a
+redirectServer maxRedirects inner = bracket
     (N.bindRandomPortTCP "*4")
     (NS.close . snd)
     $ \(port, lsocket) -> withAsync
         (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app)
         (const $ inner port)
   where
+    redirect ad = do
+        N.appWrite ad "HTTP/1.1 301 Redirect\r\nLocation: /\r\ncontent-length: 5\r\n\r\n"
+        threadDelay 10000
+        N.appWrite ad "hello\r\n"
+        threadDelay 10000
     app ad = Async.race_
         (silentIOError $ forever (N.appRead ad))
-        (silentIOError $ forever $ do
-            N.appWrite ad "HTTP/1.1 301 Redirect\r\nLocation: /\r\ncontent-length: 5\r\n\r\n"
-            threadDelay 10000
-            N.appWrite ad "hello\r\n"
-            threadDelay 10000)
+        (silentIOError $ case maxRedirects of
+            Nothing -> forever $ redirect ad
+            Just n ->
+              replicateM_ n (redirect ad) >>
+              N.appWrite ad "HTTP/1.1 200 OK\r\ncontent-length: 5\r\n\r\nhello\r\n")
 
 redirectCloseServer :: (Int -> IO a) -> IO a
 redirectCloseServer inner = bracket
@@ -158,7 +166,18 @@ spec = describe "Client" $ do
                         _ -> False
                 return ()
         mapM_ test ["http://", "https://", "http://:8000", "https://:8001"]
-    it "redirecting #41" $ redirectServer $ \port -> do
+    it "headers can be stripped on redirect" $ redirectServer (Just 5) $ \port -> do
+        req' <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
+        let req = req' { requestHeaders = [(hAuthorization, "abguvatgbfrrurer")]
+                       , redirectCount = 10
+                       , shouldStripHeaderOnRedirect = (== hAuthorization)
+                       }
+        man <- newManager defaultManagerSettings
+        withResponseHistory req man $ \hr -> do
+          print $ map (requestHeaders . fst) $ hrRedirects hr
+          mapM_ (\r -> requestHeaders r `shouldBe` []) $
+            map fst $ tail $ hrRedirects hr
+    it "redirecting #41" $ redirectServer Nothing $ \port -> do
         req' <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
         let req = req' { redirectCount = 1 }
         man <- newManager defaultManagerSettings
@@ -167,7 +186,7 @@ spec = describe "Client" $ do
                 case e of
                     HttpExceptionRequest _ (TooManyRedirects _) -> True
                     _ -> False
-    it "redirectCount=0" $ redirectServer $ \port -> do
+    it "redirectCount=0" $ redirectServer Nothing $ \port -> do
         req' <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
         let req = req' { redirectCount = 0 }
         man <- newManager defaultManagerSettings

http-conduit/Network/HTTP/Conduit.hs

@@ -158,6 +158,7 @@ module Network.HTTP.Conduit
     , rawBody
     , decompress
     , redirectCount
+    , shouldStripHeaderOnRedirect
     , checkResponse
     , responseTimeout
     , cookieJar