http-client 0.5.0.1 → 0.5.1

raw patch · 5 files changed

+72/−28 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Network/HTTP/Client.hs +3/−2
• Network/HTTP/Client/Core.hs +29/−13
• http-client.cabal +1/−1
• test/Network/HTTP/ClientSpec.hs +35/−12

@@ -1,3 +1,7 @@+## 0.5.1++* Enable managerModifyRequest to modify redirectCount [#208](https://github.com/snoyberg/http-client/pull/208)+ ## 0.5.0.1  * Doc fix

@@ -229,10 +229,11 @@ -- -- Since 0.4.1 responseOpenHistory :: Request -> Manager -> IO (HistoriedResponse BodyReader)-responseOpenHistory req0 man = handle (throwIO . toHttpException req0) $ do+responseOpenHistory req0 man0 = handle (throwIO . toHttpException req0) $ do     reqRef <- newIORef req0     historyRef <- newIORef id-    let go req = do+    let go req0 = do+            (man, req) <- getModifiedRequestManager man0 req0             (req', res') <- httpRaw' req man             let res = res'                     { responseBody = handle (throwIO . toHttpException req0)

@@ -7,6 +7,7 @@     , httpNoBody     , httpRaw     , httpRaw'+    , getModifiedRequestManager     , responseOpen     , responseClose     , httpRedirect@@ -80,13 +81,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@@ -147,6 +148,19 @@             ResponseTimeoutNone -> Nothing             ResponseTimeoutMicro u -> Just u +-- | 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,24 +191,26 @@ -- -- Since 0.1.0 responseOpen :: Request -> Manager -> IO (Response BodyReader)-responseOpen req0 manager' = wrapExc $ mWrapException manager req0 $ do-    (req, res) <--        if redirectCount req0 == 0-            then httpRaw' req0 manager-            else go (redirectCount req0) req0+responseOpen inputReq manager' = do+  (manager, req0) <- getModifiedRequestManager manager' inputReq+  wrapExc req0 $ mWrapException manager req0 $ do+    (req, res) <- go manager (redirectCount req0) req0     checkResponse req req res     return res-        { responseBody = wrapExc (responseBody res)+        { responseBody = wrapExc req0 (responseBody res)         }   where-    wrapExc = handle $ throwIO . toHttpException req0-    manager = fromMaybe manager' (requestManagerOverride req0)+    wrapExc :: Request -> IO a -> IO a+    wrapExc req0 = handle $ throwIO . toHttpException req0 -    go count req' = httpRedirect'+    go manager0 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 manager0 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' 

@@ -1,5 +1,5 @@ name:                http-client-version:             0.5.0.1+version:             0.5.1 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

@@ -3,8 +3,9 @@  import           Network                   (withSocketsDo) import           Network.HTTP.Client-import           Network.HTTP.Types        (status200, status405)+import           Network.HTTP.Types        (status200, found302, status405) import           Test.Hspec+import           Control.Applicative       ((<$>)) import           Data.ByteString.Lazy.Char8 () -- orphan instance  main :: IO ()@@ -31,15 +32,37 @@             res <- httpLbs req man             responseStatus res `shouldBe` status405 -    it "managerModifyRequest" $ do-        let modify req = return req { port = 80 }-            settings = defaultManagerSettings { managerModifyRequest = modify }-        man <- newManager settings-        res <- httpLbs "http://httpbin.org:1234" man-        responseStatus res `shouldBe` status200+    describe "redirects" $ do+        it "follows redirects" $ do+            req <- parseRequest "http://httpbin.org/redirect-to?url=http://httpbin.org"+            man <- newManager defaultManagerSettings+            res <- httpLbs req man+            responseStatus res `shouldBe` status200 -    it "managerModifyRequestCheckStatus" $ do-        let modify req = return req { checkResponse = \_ _ -> error "some exception" }-            settings = defaultManagerSettings { managerModifyRequest = modify }-        man <- newManager settings-        httpLbs "http://httpbin.org" man `shouldThrow` anyException+        it "allows to disable redirect following" $ do+            req <- (\ r -> r{ redirectCount = 0 }) <$>+              parseRequest "http://httpbin.org/redirect-to?url=http://httpbin.org"+            man <- newManager defaultManagerSettings+            res <- httpLbs req man+            responseStatus res `shouldBe` found302++    context "managerModifyRequest" $ do+        it "port" $ do+            let modify req = return req { port = 80 }+                settings = defaultManagerSettings { managerModifyRequest = modify }+            man <- newManager settings+            res <- httpLbs "http://httpbin.org:1234" man+            responseStatus res `shouldBe` status200++        it "checkResponse" $ do+            let modify req = return req { checkResponse = \_ _ -> error "some exception" }+                settings = defaultManagerSettings { managerModifyRequest = modify }+            man <- newManager settings+            httpLbs "http://httpbin.org" man `shouldThrow` anyException++        it "redirectCount" $ do+            let modify req = return req { redirectCount = 0 }+                settings = defaultManagerSettings { managerModifyRequest = modify }+            man <- newManager settings+            response <- httpLbs "http://httpbin.org/redirect-to?url=foo" man+            responseStatus response `shouldBe` found302