http-conduit-browser 1.6.1 → 1.6.2

raw patch · 4 files changed

+85/−13 lines, 4 filesdep +socksdep ~http-conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: socks

Dependency ranges changed: http-conduit

API changes (from Hackage documentation)

Files

• Network/HTTP/Conduit/Browser.hs +5/−0
• Network/HTTP/Conduit/Browser2.hs +49/−7
• http-conduit-browser.cabal +12/−6
• test/main.hs +19/−0

@@ -0,0 +1,5 @@+module Network.HTTP.Conduit.Browser+    ( module Network.HTTP.Conduit.Browser2+    ) where++import Network.HTTP.Conduit.Browser2

@@ -90,6 +90,9 @@     , getCurrentProxy     , setCurrentProxy     , withCurrentProxy+    , getCurrentSocksProxy+    , setCurrentSocksProxy+    , withCurrentSocksProxy     , getOverrideHeaders     , setOverrideHeaders     , withOverrideHeaders@@ -99,6 +102,9 @@     , getUserAgent     , setUserAgent     , withUserAgent+    , getCheckStatus+    , setCheckStatus+    , withCheckStatus     , getManager     , setManager     )@@ -115,6 +121,7 @@ #endif import qualified Network.HTTP.Types as HT import qualified Network.HTTP.Types.Header as HT+import Network.Socks5 (SocksConf) import Data.Time.Clock (getCurrentTime, UTCTime) import Data.CaseInsensitive (mk) import Data.ByteString.UTF8 (fromString)@@ -133,7 +140,9 @@   , cookieFilter        :: Request (ResourceT IO) -> Cookie -> IO Bool   , cookieJar           :: CookieJar   , currentProxy        :: Maybe Proxy+  , currentSocksProxy   :: Maybe SocksConf   , overrideHeaders     :: Map.Map HT.HeaderName BS.ByteString+  , browserCheckStatus  :: Maybe (HT.Status -> HT.ResponseHeaders -> Maybe SomeException)   , manager             :: Manager   }  @@ -145,7 +154,9 @@                               , cookieFilter = \ _ _ -> return True                               , cookieJar = def                               , currentProxy = Nothing+                              , currentSocksProxy = Nothing                               , overrideHeaders = Map.singleton HT.hUserAgent (fromString "http-conduit")+                              , browserCheckStatus = Nothing                               , manager = m                               } @@ -163,15 +174,21 @@     , maxRedirects = max_redirects     , timeout = time_out     , currentProxy  = current_proxy+    , currentSocksProxy  = current_socks_proxy     , overrideHeaders = override_headers+    , browserCheckStatus = current_check_status     } <- get   retryHelper (applyOverrideHeaders override_headers $     request { redirectCount = 0             , proxy = maybe (proxy request) Just current_proxy+            , socksProxy = maybe (socksProxy request) Just current_socks_proxy             , checkStatus = \ _ _ -> Nothing             , responseTimeout = maybe (responseTimeout request) Just time_out-            }) max_retry_count (fromMaybe (redirectCount request) max_redirects) Nothing-  where retryHelper request' retry_count max_redirects e+            }) max_retry_count+               (fromMaybe (redirectCount request) max_redirects)+               (fromMaybe (checkStatus request) current_check_status)+               Nothing+  where retryHelper request' retry_count max_redirects check_status e           | retry_count == 0 = case e of             Just e' -> throw e'             Nothing -> throw TooManyRetries@@ -179,11 +196,10 @@               resp <- LE.catch (if max_redirects==0                                   then (\(_,a,_) -> a) `fmap` performRequest request'                                   else runRedirectionChain request' max_redirects [])-                (\ e' -> retryHelper request' (retry_count - 1) max_redirects (Just (e' :: HttpException)))-              let code = HT.statusCode $ responseStatus resp-              if code < 200 || code >= 300-                then retryHelper request' (retry_count - 1) max_redirects (Just $ StatusCodeException (responseStatus resp) (responseHeaders resp))-                else return resp+                (\ e' -> retryHelper request' (retry_count - 1) max_redirects check_status (Just 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')         performRequest request' = do               s@(BrowserState { manager = manager'                               , authorities = auths@@ -332,6 +348,19 @@   out <- b   setCurrentProxy current   return out+-- | An optional SOCKS proxy to send all requests through+-- if Nothing uses Request's 'socksProxy'+getCurrentSocksProxy    :: BrowserAction (Maybe SocksConf)+getCurrentSocksProxy    = get >>= \ a -> return $ currentSocksProxy a+setCurrentSocksProxy    :: Maybe SocksConf -> BrowserAction ()+setCurrentSocksProxy  b = get >>= \ a -> put a {currentSocksProxy = b}+withCurrentSocksProxy   :: Maybe SocksConf -> BrowserAction a -> BrowserAction a+withCurrentSocksProxy a b = do+  current <- getCurrentSocksProxy+  setCurrentSocksProxy a+  out <- b+  setCurrentSocksProxy current+  return out -- | Specifies Headers that should be added to 'Request', -- these will override Headers already specified in 'requestHeaders'. --@@ -354,6 +383,19 @@   setOverrideHeaders a   out <- b   setOverrideHeaders current+  return out+-- | Function to check the status code. Note that this will run after all redirects are performed.+-- if Nothing uses Request's 'checkStatus'+getCheckStatus    :: BrowserAction (Maybe (HT.Status -> HT.ResponseHeaders -> Maybe SomeException))+getCheckStatus    = get >>= \ a -> return $ browserCheckStatus a+setCheckStatus    :: Maybe (HT.Status -> HT.ResponseHeaders -> Maybe SomeException) -> BrowserAction ()+setCheckStatus  b = get >>= \ a -> put a {browserCheckStatus = b}+withCheckStatus   :: Maybe (HT.Status -> HT.ResponseHeaders -> Maybe SomeException) -> BrowserAction a -> BrowserAction a+withCheckStatus a b = do+  current <- getCheckStatus+  setCheckStatus a+  out <- b+  setCheckStatus current   return out insertOverrideHeader :: HT.Header -> BrowserAction () insertOverrideHeader (b, c) = get >>= \ a -> put a {overrideHeaders = Map.insert b c (overrideHeaders a)}

@@ -1,5 +1,5 @@ name:            http-conduit-browser-version:         1.6.1+version:         1.6.2 license:         BSD3 license-file:    LICENSE author:          Myles C. Maxfield <myles.maxfield@gmail.com>@@ -15,15 +15,14 @@ stability:       Stable cabal-version:   >= 1.8 build-type:      Simple-homepage:        https://github.com/litherum/http-conduit/tree/http-conduit-browser+homepage:        https://github.com/litherum/http-conduit-browser extra-source-files: test/main.hs -flag network-bytestring-  default: False+flag new-http-conduit+  default: True  library     build-depends: base                  >= 4       && < 5-                 , http-conduit          >= 1.6.1   && < 1.7                  , data-default                  , cookie                  , utf8-string@@ -35,6 +34,12 @@                  , mtl                  , bytestring                  , containers+                 , socks+    if flag(new-http-conduit)+        build-depends: http-conduit          >= 1.7     && < 1.8+        exposed-modules: Network.HTTP.Conduit.Browser+    else+        build-depends: http-conduit          >= 1.6.1   && < 1.7     exposed-modules: Network.HTTP.Conduit.Browser2     ghc-options:     -Wall @@ -67,7 +72,8 @@                  , mtl                  , warp                  , wai+                 , socks  source-repository head   type:     git-  location: git://github.com/litherum/http-conduit.git+  location: git://github.com/litherum/http-conduit-browser.git

@@ -1,12 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable #-} import Test.Hspec+import Control.Exception (Exception, toException) import qualified Data.ByteString as S import Network.Wai hiding (requestBody) import Network.Wai.Handler.Warp (run) import Network.HTTP.Conduit import Network.HTTP.Conduit.Browser2 import Data.ByteString.Base64 (encode)+import Data.Typeable (Typeable) import Control.Concurrent (forkIO, killThread) import Network.HTTP.Types import Control.Exception.Lifted (try)@@ -18,6 +21,11 @@  -- TODO tests for responseTimeout/Browser.timeout. +data TestException = TestException+    deriving (Show, Typeable)++instance Exception TestException+ strictToLazy :: S.ByteString -> L.ByteString strictToLazy = L.fromChunks . replicate 1 @@ -267,3 +275,14 @@                 case elbs of                      Left StatusCodeException{} -> return ()                      _ -> error "redirectCount should be 0!"+            it "uses checkStatus correctly" $ do+                tid <- forkIO $ run 3012 app+                request <- parseUrl "http://127.0.0.1:3012/useragent"+                elbs <- try $ withManager $ \manager -> do+                    browse manager $ do+                        setCheckStatus $ Just $  \ _ _ -> Just $ toException TestException+                        makeRequestLbs request+                killThread tid+                case elbs of+                    Left TestException -> return ()+                    _ -> error "Should have thrown an exception!"