http-client 0.7.14 → 0.7.15
raw patch · 8 files changed
+98/−10 lines, 8 files
Files
- ChangeLog.md +4/−0
- Network/HTTP/Client.hs +2/−0
- Network/HTTP/Client/Core.hs +1/−1
- Network/HTTP/Client/Request.hs +1/−0
- Network/HTTP/Client/Response.hs +36/−7
- Network/HTTP/Client/Types.hs +7/−0
- http-client.cabal +2/−2
- test-nonet/Network/HTTP/ClientSpec.hs +45/−0
ChangeLog.md view
@@ -1,5 +1,9 @@ # Changelog for http-client +## 0.7.15++* Adds `shouldStripHeaderOnRedirectIfOnDifferentHostOnly` option to `Request` [#520](https://github.com/snoyberg/http-client/pull/520)+ ## 0.7.14 * Allow customizing max header length [#514](https://github.com/snoyberg/http-client/pull/514)
Network/HTTP/Client.hs view
@@ -162,6 +162,7 @@ , decompress , redirectCount , shouldStripHeaderOnRedirect+ , shouldStripHeaderOnRedirectIfOnDifferentHostOnly , checkResponse , responseTimeout , cookieJar@@ -264,6 +265,7 @@ (responseBody res') } case getRedirectedRequest+ req req' (responseHeaders res) (responseCookieJar res)
Network/HTTP/Client/Core.hs view
@@ -220,7 +220,7 @@ (req'', res) <- httpRaw' modReq manager let mreq = if redirectCount modReq == 0 then Nothing- else getRedirectedRequest req'' (responseHeaders res) (responseCookieJar res) (statusCode (responseStatus res))+ else getRedirectedRequest req' req'' (responseHeaders res) (responseCookieJar res) (statusCode (responseStatus res)) return (res, fromMaybe req'' mreq, isJust mreq)) req'
Network/HTTP/Client/Request.hs view
@@ -303,6 +303,7 @@ Nothing -> throwIO se , requestManagerOverride = Nothing , shouldStripHeaderOnRedirect = const False+ , shouldStripHeaderOnRedirectIfOnDifferentHostOnly = False , proxySecureMode = ProxySecureWithConnect , redactHeaders = Set.singleton "Authorization" }
Network/HTTP/Client/Response.hs view
@@ -14,6 +14,7 @@ import Control.Arrow (second) import Data.Monoid (mempty)+import Data.List (nubBy) import qualified Network.HTTP.Types as W import Network.URI (parseURIReference, escapeURIString, isAllowedInURI)@@ -43,21 +44,17 @@ -- > (\req' -> do -- > res <- http req'{redirectCount=0} man -- > modify (\rqs -> req' : rqs)--- > return (res, getRedirectedRequest req' (responseHeaders res) (responseCookieJar res) (W.statusCode (responseStatus res))+-- > return (res, getRedirectedRequest req req' (responseHeaders res) (responseCookieJar res) (W.statusCode (responseStatus res)) -- > ) -- > 'lift' -- > req -- > applyCheckStatus (checkStatus req) res -- > return redirectRequests-getRedirectedRequest :: Request -> W.ResponseHeaders -> CookieJar -> Int -> Maybe Request-getRedirectedRequest req hs cookie_jar code+getRedirectedRequest :: Request -> Request -> W.ResponseHeaders -> CookieJar -> Int -> Maybe Request+getRedirectedRequest origReq req hs cookie_jar code | 300 <= code && code < 400 = do l' <- lookup "location" hs let l = escapeURIString isAllowedInURI (S8.unpack 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@@ -73,7 +70,39 @@ else req' {cookieJar = cookie_jar'} | otherwise = Nothing where+ cookie_jar' :: Maybe CookieJar cookie_jar' = fmap (const cookie_jar) $ cookieJar req++ hostDiffer :: Request -> Bool+ hostDiffer req = host origReq /= host req++ shouldStripOnlyIfHostDiffer :: Bool+ shouldStripOnlyIfHostDiffer = shouldStripHeaderOnRedirectIfOnDifferentHostOnly req++ mergeHeaders :: W.RequestHeaders -> W.RequestHeaders -> W.RequestHeaders+ mergeHeaders lhs rhs = nubBy (\(a, _) (a', _) -> a == a') (lhs ++ rhs)+ + stripHeaders :: Request -> Request+ stripHeaders r = do+ case (hostDiffer r, shouldStripOnlyIfHostDiffer) of + (True, True) -> stripHeaders' r+ (True, False) -> stripHeaders' r+ (False, False) -> stripHeaders' r+ (False, True) -> do+ -- We need to check if we have omitted headers in previous+ -- request chain. Consider request chain:+ --+ -- 1. example-1.com + -- 2. example-2.com (we may have removed some headers here from 1)+ -- 3. example-1.com (since we are back at same host as 1, we need re-add stripped headers)+ --+ let strippedHeaders = filter (shouldStripHeaderOnRedirect r . fst) (requestHeaders origReq)+ r{requestHeaders = mergeHeaders (requestHeaders r) strippedHeaders}++ stripHeaders' :: Request -> Request+ stripHeaders' r = r{requestHeaders =+ filter (not . shouldStripHeaderOnRedirect req . fst) $+ requestHeaders r} -- | Convert a 'Response' that has a 'Source' body to one with a lazy -- 'L.ByteString' body.
Network/HTTP/Client/Types.hs view
@@ -616,6 +616,13 @@ -- -- @since 0.6.2 + , shouldStripHeaderOnRedirectIfOnDifferentHostOnly :: Bool+ -- ^ Decide whether a header must be stripped from the request+ -- when following a redirect, if host differs from previous request+ -- in redirect chain. Default: false (always strip regardless of host change)+ --+ -- @since 0.7.15+ , proxySecureMode :: ProxySecureMode -- ^ How to proxy an HTTPS request. --
http-client.cabal view
@@ -1,5 +1,5 @@ name: http-client-version: 0.7.14+version: 0.7.15 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@@ -47,7 +47,7 @@ , streaming-commons >= 0.1.0.2 && < 0.3 , containers >= 0.5 , transformers- , deepseq >= 1.3 && <1.5+ , deepseq >= 1.3 && <1.6 , case-insensitive >= 1.0 , base64-bytestring >= 1.0 , cookie
test-nonet/Network/HTTP/ClientSpec.hs view
@@ -39,6 +39,27 @@ let _ = e :: IOError return () +redirectServerToDifferentHost :: Maybe Int -> (Int -> IO a) -> IO a+redirectServerToDifferentHost 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: http://example.com\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 $ 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")+ redirectServer :: Maybe Int -- ^ If Just, stop redirecting after that many hops. -> (Int -> IO a) -> IO a@@ -176,6 +197,30 @@ withResponseHistory req man $ \hr -> do print $ map (requestHeaders . fst) $ hrRedirects hr mapM_ (\r -> requestHeaders r `shouldBe` []) $+ map fst $ tail $ hrRedirects hr+ it "does strips header on redirect, if hosts are different and set to strip them if host differ" $ redirectServerToDifferentHost (Just 1) $ \port -> do+ req' <- parseUrlThrow $ "http://127.0.0.1:" ++ show port+ let req = req' { requestHeaders = [(hAuthorization, "abguvatgbfrrurer")]+ , redirectCount = 10+ , shouldStripHeaderOnRedirect = (== hAuthorization)+ , shouldStripHeaderOnRedirectIfOnDifferentHostOnly = True+ }+ 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 "does NOT strips header on redirect, if hosts are same and set to strip them if host differ" $ redirectServerToDifferentHost (Just 1) $ \port -> do+ req' <- parseUrlThrow $ "http://127.0.0.1:" ++ show port+ let req = req' { requestHeaders = [(hAuthorization, "abguvatgbfrrurer")]+ , redirectCount = 10+ , shouldStripHeaderOnRedirect = (== hAuthorization)+ , shouldStripHeaderOnRedirectIfOnDifferentHostOnly = True+ }+ man <- newManager defaultManagerSettings+ withResponseHistory req man $ \hr -> do+ print $ map (requestHeaders . fst) $ hrRedirects hr+ mapM_ (\r -> requestHeaders r `shouldBe` [("Authorization","abguvatgbfrrurer")]) $ map fst $ tail $ hrRedirects hr it "redirecting #41" $ redirectServer Nothing $ \port -> do req' <- parseUrlThrow $ "http://127.0.0.1:" ++ show port