http-conduit-browser 1.7.2 → 1.7.2.1
raw patch · 3 files changed
+50/−8 lines, 3 filesdep ~http-conduitPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: http-conduit
API changes (from Hackage documentation)
Files
- Network/HTTP/Conduit/Browser.hs +10/−6
- http-conduit-browser.cabal +2/−2
- test/main.hs +38/−0
Network/HTTP/Conduit/Browser.hs view
@@ -304,15 +304,18 @@ (fromMaybe (redirectCount request) max_redirects) (fromMaybe (checkStatus request) current_check_status) Nothing- where retryHelper request' retry_count max_redirects check_status e+ where snd3 (_, a, _) = a+ retryHelper request' retry_count max_redirects check_status e | retry_count < 0 = case e of Just e' -> LE.throwIO e' Nothing -> LE.throwIO TooManyRetries | otherwise = do- resp <- LE.catch (if max_redirects==0- then (\(_,a,_) -> a) `fmap` performRequest request'+ resp <- LE.catches (if max_redirects==0+ then snd3 `fmap` performRequest request' else runRedirectionChain request' max_redirects [])- (\ (e'::HttpException) -> retryHelper request' (retry_count - 1) max_redirects check_status $ Just $ toException e')+ [ LE.Handler $ \(e'::HttpException) -> retryHelper request' (retry_count - 1) max_redirects check_status $ Just $ toException e'+ , LE.Handler $ \(e'::IOException) -> retryHelper request' (retry_count - 1) max_redirects check_status $ Just $ toException e'+ ] case check_status (responseStatus resp) (responseHeaders resp) of Nothing -> return resp Just e' -> retryHelper request' (retry_count - 1) max_redirects check_status (Just e')@@ -340,6 +343,7 @@ = httpRedirect redirect_count (\request' -> do+ -- res is the original, response doesn't contain setCookie headers. (request'', res, response) <- performRequest request' let mreq = getRedirectedRequest request'' (responseHeaders response) (HT.statusCode (responseStatus response)) return (res, mreq))@@ -353,7 +357,7 @@ case getRedirectedRequest request'' (responseHeaders response) (HT.statusCode (responseStatus response)) of Nothing -> return res Just request''' -> do- -- Canibalised from Network.HTTP.Conduit, should be made visible there.+ -- Canibalised from Network.HTTP.Conduit for http-conduit < 1.8.5 -- Allow the original connection to return to the -- connection pool immediately by flushing the body. -- If the response body is too large, don't flush, but@@ -583,8 +587,8 @@ setManager b = get >>= \ a -> put a {manager = b} #if !MIN_VERSION_http_conduit(1,8,5)+-- Canibalised from Network.HTTP.Conduit.Request for http-conduit < 1.8.5 -- | Extract a 'URI' from the request.--- Canibalised from Network.HTTP.Conduit.Request, should be made visible there. getUri :: Request m' -> URI getUri req = URI { uriScheme = if secure req
http-conduit-browser.cabal view
@@ -1,5 +1,5 @@ name: http-conduit-browser-version: 1.7.2+version: 1.7.2.1 license: BSD3 license-file: LICENSE author: Myles C. Maxfield <myles.maxfield@gmail.com>@@ -22,7 +22,7 @@ library build-depends: base >= 4 && < 5- , http-conduit >= 1.7.0+ , http-conduit >= 1.7 && < 1.9 , data-default , cookie , case-insensitive
test/main.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable #-} import Test.Hspec+import Test.HUnit import Control.Applicative import Control.Monad import Control.Exception (Exception, toException)@@ -21,6 +22,9 @@ import qualified Data.ByteString.Lazy as L import Data.IORef import Control.Monad.IO.Class (liftIO)+import Data.Time.Clock+import Data.Time.Calendar+import Web.Cookie -- TODO tests for responseTimeout/Browser.timeout. @@ -73,6 +77,11 @@ ["redir1"] -> return $ responseLBS temporaryRedirect307 [redir2] L.empty ["redir2"] -> return $ responseLBS temporaryRedirect307 [redir3] L.empty ["redir3"] -> return $ responseLBS status200 [] $ strictToLazy dummy+ ["cookie_redir2"] -> return $ responseLBS status303 [("Set-Cookie", "baka=baka;"), (hLocation, "/checkcookie")] ""+ ["checkcookie"] -> return $+ if "flavor=chocolate-chip;baka=baka" == getHeader hCookie+ then responseLBS status200 [] "nom-nom-nom"+ else responseLBS status200 [] $ getHeader "Cookie" _ -> return $ responseLBS status404 [] "not found" where tastyCookie = (mk (utf8String "Set-Cookie"), utf8String "flavor=chocolate-chip;")@@ -112,6 +121,35 @@ if (lazyToStrict $ responseBody elbs) /= S.empty then error "Shouldn't have gotten the cookie back!" else return ()+ it "user-defined cookies survive redirects" $ do+ tid <- forkIO $ run 3019 app+ req <- parseUrl "http://127.0.0.1:3019/cookie_redir2"+ let setCookie = def+ { setCookieName = "flavor"+ , setCookieValue = "chocolate-chip" }+ default_time = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0)+ elbs <- withManager $ \manager -> do+ browse manager $ do+ setCookieJar =<< receiveSetCookie setCookie req default_time True <$> getCookieJar+ responseBody <$> makeRequestLbs req+ killThread tid+ liftIO $ elbs @?= "nom-nom-nom"+{- http-conduit-1.9+ cookieJar+ it "user-defined cookies in req survive redirects" $ do+ tid <- forkIO $ run 3019 app+ req <- parseUrl "http://127.0.0.1:3019/cookie_redir2"+ let setCookie = def+ { setCookieName = "flavor"+ , setCookieValue = "chocolate-chip" }+ default_time = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0)+ elbs <- withManager $ \manager -> do+ browse manager $ do+ cjar <- receiveSetCookie setCookie req default_time True <$> getCookieJar+ let request = fst $ insertCookiesIntoRequest req cjar default_time+ responseBody <$> makeRequestLbs request+ killThread tid+ liftIO $ elbs @?= "nom-nom-nom"+-} it "can save and load cookie jar" $ do tid <- forkIO $ run 3011 app request1 <- parseUrl "http://127.0.0.1:3011/cookies"