http-client 0.4.31.1 → 0.4.31.2
raw patch · 5 files changed
+51/−19 lines, 5 files
Files
- ChangeLog.md +4/−0
- Network/HTTP/Client.hs +3/−2
- Network/HTTP/Client/Core.hs +25/−8
- http-client.cabal +1/−1
- test/Network/HTTP/ClientSpec.hs +18/−8
ChangeLog.md view
@@ -1,3 +1,7 @@+## 0.4.31.2++* Use redirectCount set through managerModifyRequest [#244](https://github.com/snoyberg/http-client/pull/244)+ ## 0.4.31.1 * The closeConnection method for tls connections should not be called multiple
Network/HTTP/Client.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}@@ -233,7 +233,8 @@ responseOpenHistory req0 man = do reqRef <- newIORef req0 historyRef <- newIORef id- let go req = do+ let go req0 = do+ (man, req) <- getModifiedRequestManager man req0 (req', res) <- httpRaw' req man case getRedirectedRequest req'
Network/HTTP/Client/Core.hs view
@@ -7,6 +7,7 @@ , httpNoBody , httpRaw , httpRaw'+ , getModifiedRequestManager , responseOpen , responseClose , applyCheckStatus@@ -17,13 +18,13 @@ #if !MIN_VERSION_base(4,6,0) import Prelude hiding (catch) #endif-import Network.HTTP.Types-import Network.HTTP.Client.Manager-import Network.HTTP.Client.Types import Network.HTTP.Client.Body+import Network.HTTP.Client.Cookies+import Network.HTTP.Client.Manager import Network.HTTP.Client.Request import Network.HTTP.Client.Response-import Network.HTTP.Client.Cookies+import Network.HTTP.Client.Types+import Network.HTTP.Types import Data.Maybe (fromMaybe, isJust) import Data.Time import Control.Exception@@ -82,13 +83,13 @@ -- | Get a 'Response' without any redirect following. ----- This extended version of 'httpRaw' also returns the Request potentially modified by @managerModifyRequest@.+-- This extended version of 'httpRaw' also returns the potentially modified Request. httpRaw' :: Request -> Manager -> IO (Request, Response BodyReader) httpRaw' req0 m = do- req' <- mModifyRequest m $ mSetProxy m req0+ let req' = mSetProxy m req0 (req, cookie_jar') <- case cookieJar req' of Just cj -> do now <- getCurrentTime@@ -132,6 +133,19 @@ where rt = responseTimeout req +-- | The used Manager can be overridden (by requestManagerOverride) and the used+-- Request can be modified (through managerModifyRequest). This function allows+-- to retrieve the possibly overridden Manager and the possibly modified+-- Request.+--+-- (In case the Manager is overridden by requestManagerOverride, the Request is+-- being modified by managerModifyRequest of the new Manager, not the old one.)+getModifiedRequestManager :: Manager -> Request -> IO (Manager, Request)+getModifiedRequestManager manager0 req0 = do+ let manager = fromMaybe manager0 (requestManagerOverride req0)+ req <- mModifyRequest manager req0+ return (manager, req)+ -- | The most low-level function for initiating an HTTP request. -- -- The first argument to this function gives a full specification@@ -177,8 +191,11 @@ go count req' = httpRedirect' count (\req -> do- (req'', res) <- httpRaw' req manager- let mreq = getRedirectedRequest req'' (responseHeaders res) (responseCookieJar res) (statusCode (responseStatus res))+ (manager, modReq) <- getModifiedRequestManager manager req+ (req'', res) <- httpRaw' modReq manager+ let mreq = if redirectCount modReq == 0+ then Nothing+ else getRedirectedRequest req'' (responseHeaders res) (responseCookieJar res) (statusCode (responseStatus res)) return (res, fromMaybe req'' mreq, isJust mreq)) req'
http-client.cabal view
@@ -1,5 +1,5 @@ name: http-client-version: 0.4.31.1+version: 0.4.31.2 synopsis: An HTTP client engine, intended as a base layer for more user-friendly packages. 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
test/Network/HTTP/ClientSpec.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} module Network.HTTP.ClientSpec where -import Control.Exception (toException)-import Network (withSocketsDo)-import Network.HTTP.Client-import Network.HTTP.Types (status200, status405)-import Test.Hspec-import Data.ByteString.Lazy.Char8 () -- orphan instance+import Control.Exception (toException)+import Network (withSocketsDo)+import Network.HTTP.Client+import Network.HTTP.Types (found302, status200, status405)+import Test.Hspec+import Data.ByteString.Lazy.Char8 () main :: IO () main = hspec spec@@ -35,15 +35,25 @@ res <- httpLbs req man responseStatus res `shouldBe` status405 - it "managerModifyRequest" $ do+ describe "managerModifyRequest" $ do++ it "can set port to 80" $ do let modify req = return req { port = 80 } settings = defaultManagerSettings { managerModifyRequest = modify } withManager settings $ \man -> do res <- httpLbs "http://httpbin.org:1234" man responseStatus res `shouldBe` status200 - it "managerModifyRequestCheckStatus" $ do+ it "can set 'checkStatus' to throw StatusCodeException" $ do let modify req = return req { checkStatus = \s hs cj -> Just $ toException $ StatusCodeException s hs cj } settings = defaultManagerSettings { managerModifyRequest = modify } withManager settings $ \man -> httpLbs "http://httpbin.org" man `shouldThrow` anyException++ it "can set redirectCount to 0 to prevent following redirects" $ do+ let modify req = return req { redirectCount = 0 }+ settings = defaultManagerSettings { managerModifyRequest = modify }+ man <- newManager settings+ httpLbs "http://httpbin.org/redirect-to?url=foo" man `shouldThrow` ( \ (StatusCodeException s _ _) -> s == found302)++