http-conduit-browser 1.6.5 → 1.6.6
raw patch · 3 files changed
+257/−112 lines, 3 filesdep +failuredep +monad-controldep +networkdep ~resourcet
Dependencies added: failure, monad-control, network
Dependency ranges changed: resourcet
Files
- Network/HTTP/Conduit/Browser2.hs +213/−111
- http-conduit-browser.cabal +8/−1
- test/main.hs +36/−0
Network/HTTP/Conduit/Browser2.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, ScopedTypeVariables #-}+{-# LANGUAGE CPP, ScopedTypeVariables, FlexibleContexts #-} -- | This module is designed to work similarly to the Network.Browser module in the HTTP package. -- The idea is that there are two new types defined: 'BrowserState' and 'BrowserAction'. The -- purpose of this module is to make it easy to describe a browsing session, including navigating@@ -14,7 +14,7 @@ -- -- A special kind of modification of the current browser state is the action of making a HTTP -- request. This will do the request according to the params in the current BrowserState, as well--- as modifying the current state with, for example, an updated cookie jar.+-- as modifying the current state with, for example, an updated cookie jar and location. -- -- To use this module, you would bind together a series of BrowserActions (This simulates the user -- clicking on links or using a settings dialogue etc.) to describe your browsing session. When@@ -60,39 +60,106 @@ -- > putStrLn $ UB.toString $ B.concat $ LB.toChunks $ responseBody out module Network.HTTP.Conduit.Browser2- ( BrowserState- , BrowserAction+ (+ -- * Main+ BrowserAction+ , GenericBrowserAction , browse+ , parseRelativeUrl , makeRequest , makeRequestLbs+ -- * Browser state+ , BrowserState , defaultState , getBrowserState , setBrowserState , withBrowserState+ -- ** Manager+ , Manager+ , getManager+ , setManager+ -- ** Location+ -- | The last visited url (similar to the location bar in mainstream browsers).+ -- Location is updated on every request.+ --+ -- default: @Nothing@+ , getLocation+ , setLocation+ , withLocation+ -- ** Cookies+ -- *** Cookie jar+ -- | All the cookies!+ , getCookieJar+ , setCookieJar+ , withCookieJar+ -- *** Cookie filter+ -- | Each new Set-Cookie the browser encounters will pass through this filter.+ -- Only cookies that pass the filter (and are already valid) will be allowed into the cookie jar+ --+ -- default: @const $ const $ return True@+ , getCookieFilter+ , setCookieFilter+ , withCookieFilter+ -- ** Proxies+ -- *** HTTP+ -- | An optional proxy to send all requests through+ -- if Nothing uses Request's 'proxy'+ --+ -- default: @Nothing@+ , getCurrentProxy+ , setCurrentProxy+ , withCurrentProxy+ -- *** SOCKS+ -- | An optional SOCKS proxy to send all requests through+ -- if Nothing uses Request's 'socksProxy'+ --+ -- default: @Nothing@+ , getCurrentSocksProxy+ , setCurrentSocksProxy+ , withCurrentSocksProxy+ -- ** Redirects+ -- | The number of redirects to allow.+ -- if Nothing uses Request's 'redirectCount'+ --+ -- default: @Nothing@ , getMaxRedirects , setMaxRedirects , withMaxRedirects+ -- ** Retries+ -- | The number of times to retry a failed connection+ --+ -- default: @0@ , getMaxRetryCount , setMaxRetryCount , withMaxRetryCount+ -- ** Timeout+ -- | Number of microseconds to wait for a response.+ -- if Nothing uses Request's 'responseTimeout'+ --+ -- default: @Nothing@ , getTimeout , setTimeout , withTimeout+ -- ** Authorities+ -- | A user-provided function that provides optional authorities.+ -- This function gets run on all requests before they get sent out.+ -- The output of this function is applied to the request.+ --+ -- default: @const Nothing@ , getAuthorities , setAuthorities , withAuthorities- , getCookieFilter- , setCookieFilter- , withCookieFilter- , getCookieJar- , setCookieJar- , withCookieJar- , getCurrentProxy- , setCurrentProxy- , withCurrentProxy- , getCurrentSocksProxy- , setCurrentSocksProxy- , withCurrentSocksProxy+ -- ** Headers+ -- *** Override headers+ -- | Specifies Headers that should be added to 'Request',+ -- these will override Headers already specified in 'requestHeaders'.+ --+ -- > do insertOverrideHeader ("User-Agent", "rat")+ -- > insertOverrideHeader ("Connection", "keep-alive")+ -- > makeRequest def{requestHeaders = [("User-Agent", "kitten"), ("Accept", "everything/digestible")]}+ -- > > User-Agent: rat+ -- > > Accept: everything/digestible+ -- > > Connection: keep-alive , getOverrideHeaders , setOverrideHeaders , withOverrideHeaders@@ -101,18 +168,30 @@ , insertOverrideHeader , deleteOverrideHeader , withOverrideHeader+ -- *** User agent+ -- | What string to report our user-agent as.+ -- if Nothing will not send user-agent unless one is specified in 'Request'+ --+ -- > getUserAgent = lookup "User-Agent" overrideHeaders+ -- > setUserAgent a = insertOverrideHeader ("User-Agent", a)+ --+ -- default: @Just \"http-conduit\"@ , getUserAgent , setUserAgent , withUserAgent+ -- ** Error handling+ -- | Function to check the status code. Note that this will run after all redirects are performed.+ -- if Nothing uses Request's 'checkStatus'+ --+ -- default: @Nothing@ , getCheckStatus , setCheckStatus , withCheckStatus- , getManager- , setManager ) where import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as S8 (unpack) import qualified Data.ByteString.Lazy as L import Control.Monad.State import Control.Exception@@ -124,6 +203,7 @@ import qualified Network.HTTP.Types as HT import qualified Network.HTTP.Types.Header as HT import Network.Socks5 (SocksConf)+import Network.URI (URI (..), URIAuth (..), parseRelativeReference, relativeTo, uriToString) import Data.Time.Clock (getCurrentTime, UTCTime) import Data.CaseInsensitive (mk) import Data.ByteString.UTF8 (fromString)@@ -133,9 +213,13 @@ import qualified Data.Map as Map import Network.HTTP.Conduit+import Control.Monad.Trans.Resource (liftResourceT)+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Failure (Failure) data BrowserState = BrowserState- { maxRedirects :: Maybe Int+ { currentLocation :: Maybe URI+ , maxRedirects :: Maybe Int , maxRetryCount :: Int , timeout :: Maybe Int , authorities :: Request (ResourceT IO) -> Maybe (BS.ByteString, BS.ByteString)@@ -149,7 +233,8 @@ } defaultState :: Manager -> BrowserState-defaultState m = BrowserState { maxRedirects = Nothing+defaultState m = BrowserState { currentLocation = Nothing+ , maxRedirects = Nothing , maxRetryCount = 0 , timeout = Nothing , authorities = const Nothing@@ -162,14 +247,25 @@ , manager = m } -type BrowserAction = StateT BrowserState (ResourceT IO)+type BrowserAction = GenericBrowserAction (ResourceT IO) +type GenericBrowserAction m = StateT BrowserState m+ -- | Do the browser action with the given manager-browse :: Manager -> BrowserAction a -> ResourceT IO a+browse :: Monad m => Manager -> GenericBrowserAction m a -> m a browse m act = evalStateT act (defaultState m) +-- | Convert an URL relative to current Location into a 'Request'+--+-- Will throw 'InvalidUrlException' on parse failures or if your Location is 'Nothing' (e.g. you haven't made any requests before)+parseRelativeUrl :: Failure HttpException m => String -> GenericBrowserAction m (Request m')+parseRelativeUrl url = maybe err (parseUrl . use) . currentLocation =<< get+ where err = throw $ InvalidUrlException url "Invalid URL"+ uri = fromMaybe err $ parseRelativeReference url+ use = flip (uriToString id) "" . fromMaybe err . relativeTo uri+ -- | Make a request, using all the state in the current BrowserState-makeRequest :: Request (ResourceT IO) -> BrowserAction (Response (ResumableSource (ResourceT IO) BS.ByteString))+makeRequest :: (MonadBaseControl IO m, MonadResource m) => Request (ResourceT IO) -> GenericBrowserAction m (Response (ResumableSource (ResourceT IO) BS.ByteString)) makeRequest request = do BrowserState { maxRetryCount = max_retry_count@@ -212,9 +308,11 @@ let (request'', cookie_jar') = insertCookiesIntoRequest (applyAuthorities auths request') (evictExpiredCookies cookie_jar now) now- res <- lift $ http request'' manager'+ res <- liftResourceT $ http request'' manager' (cookie_jar'', response) <- liftIO $ updateMyCookieJar res request'' now cookie_jar' cookie_filter- put $ s {cookieJar = cookie_jar''}+ put $ s { cookieJar = cookie_jar''+ , currentLocation = Just $ getUri request''+ } return (request'', res, response) runRedirectionChain request' redirect_count ress | redirect_count == (-1) = throw . TooManyRedirects =<< mapM (liftIO . runResourceT . lbsResponse) ress@@ -231,7 +329,13 @@ Just (user, pass) -> applyBasicAuth user pass request' Nothing -> request' -makeRequestLbs :: Request (ResourceT IO) -> BrowserAction (Response L.ByteString)+-- | Make a request and pack the result as a lazy bytestring.+--+-- Note: Even though this function returns a lazy bytestring, it does not+-- utilize lazy I/O, and therefore the entire response body will live in memory.+-- If you want constant memory usage, you'll need to use the conduit package and+-- 'makeRequest' directly. +makeRequestLbs :: (MonadBaseControl IO m, MonadResource m) => Request (ResourceT IO) -> GenericBrowserAction m (Response L.ByteString) makeRequestLbs = liftIO . runResourceT . lbsResponse <=< makeRequest applyOverrideHeaders :: Map.Map HT.HeaderName BS.ByteString -> Request a -> Request a@@ -248,11 +352,11 @@ cookieJar' = foldl (\ cj c -> insertCheckedCookie c cj True) cookie_jar -- | You can save and restore the state at will-getBrowserState :: BrowserAction BrowserState+getBrowserState :: Monad m => GenericBrowserAction m BrowserState getBrowserState = get-setBrowserState :: BrowserState -> BrowserAction ()+setBrowserState :: Monad m => BrowserState -> GenericBrowserAction m () setBrowserState = put-withBrowserState :: BrowserState -> BrowserAction a -> BrowserAction a+withBrowserState :: Monad m => BrowserState -> GenericBrowserAction m a -> GenericBrowserAction m a withBrowserState s a = do current <- get put s@@ -260,190 +364,188 @@ put current return out --- | The number of redirects to allow.--- if Nothing uses Request's 'redirectCount'--- default: Nothing-getMaxRedirects :: BrowserAction (Maybe Int)+getLocation :: Monad m => GenericBrowserAction m (Maybe URI)+getLocation = get >>= \ a -> return $ currentLocation a+setLocation :: Monad m => Maybe URI -> GenericBrowserAction m ()+setLocation b = get >>= \ a -> put a {currentLocation = b}+withLocation :: Monad m => Maybe URI -> GenericBrowserAction m a -> GenericBrowserAction m a+withLocation a b = do+ current <- getLocation+ setLocation a+ out <- b+ setLocation current+ return out++getMaxRedirects :: Monad m => GenericBrowserAction m (Maybe Int) getMaxRedirects = get >>= \ a -> return $ maxRedirects a-setMaxRedirects :: Maybe Int -> BrowserAction ()+setMaxRedirects :: Monad m => Maybe Int -> GenericBrowserAction m () setMaxRedirects b = get >>= \ a -> put a {maxRedirects = b}-withMaxRedirects :: Maybe Int -> BrowserAction a -> BrowserAction a+withMaxRedirects :: Monad m => Maybe Int -> GenericBrowserAction m a -> GenericBrowserAction m a withMaxRedirects a b = do current <- getMaxRedirects setMaxRedirects a out <- b setMaxRedirects current return out--- | The number of times to retry a failed connection--- default: 0-getMaxRetryCount :: BrowserAction Int++getMaxRetryCount :: Monad m => GenericBrowserAction m Int getMaxRetryCount = get >>= \ a -> return $ maxRetryCount a-setMaxRetryCount :: Int -> BrowserAction ()+setMaxRetryCount :: Monad m => Int -> GenericBrowserAction m () setMaxRetryCount b = get >>= \ a -> put a {maxRetryCount = b}-withMaxRetryCount :: Int -> BrowserAction a -> BrowserAction a+withMaxRetryCount :: Monad m => Int -> GenericBrowserAction m a -> GenericBrowserAction m a withMaxRetryCount a b = do current <- getMaxRetryCount setMaxRetryCount a out <- b setMaxRetryCount current return out--- | Number of microseconds to wait for a response.--- if Nothing uses Request's 'responseTimeout'--- default: Nothing-getTimeout :: BrowserAction (Maybe Int)++getTimeout :: Monad m => GenericBrowserAction m (Maybe Int) getTimeout = get >>= \ a -> return $ timeout a-setTimeout :: Maybe Int -> BrowserAction ()+setTimeout :: Monad m => Maybe Int -> GenericBrowserAction m () setTimeout b = get >>= \ a -> put a {timeout = b}-withTimeout :: Maybe Int -> BrowserAction a -> BrowserAction a+withTimeout :: Monad m => Maybe Int -> GenericBrowserAction m a -> GenericBrowserAction m a withTimeout a b = do current <- getTimeout setTimeout a out <- b setTimeout current return out--- | A user-provided function that provides optional authorities.--- This function gets run on all requests before they get sent out.--- The output of this function is applied to the request.--- default: const Nothing-getAuthorities :: BrowserAction (Request (ResourceT IO) -> Maybe (BS.ByteString, BS.ByteString))++getAuthorities :: Monad m => GenericBrowserAction m (Request (ResourceT IO) -> Maybe (BS.ByteString, BS.ByteString)) getAuthorities = get >>= \ a -> return $ authorities a-setAuthorities :: (Request (ResourceT IO) -> Maybe (BS.ByteString, BS.ByteString)) -> BrowserAction ()+setAuthorities :: Monad m => (Request (ResourceT IO) -> Maybe (BS.ByteString, BS.ByteString)) -> GenericBrowserAction m () setAuthorities b = get >>= \ a -> put a {authorities = b}-withAuthorities :: (Request (ResourceT IO) -> Maybe (BS.ByteString, BS.ByteString)) -> BrowserAction a -> BrowserAction a+withAuthorities :: Monad m => (Request (ResourceT IO) -> Maybe (BS.ByteString, BS.ByteString)) -> GenericBrowserAction m a -> GenericBrowserAction m a withAuthorities a b = do current <- getAuthorities setAuthorities a out <- b setAuthorities current return out--- | Each new Set-Cookie the browser encounters will pass through this filter.--- Only cookies that pass the filter (and are already valid) will be allowed into the cookie jar--- default: const $ const $ return True-getCookieFilter :: BrowserAction (Request (ResourceT IO) -> Cookie -> IO Bool)++getCookieFilter :: Monad m => GenericBrowserAction m (Request (ResourceT IO) -> Cookie -> IO Bool) getCookieFilter = get >>= \ a -> return $ cookieFilter a-setCookieFilter :: (Request (ResourceT IO) -> Cookie -> IO Bool) -> BrowserAction ()+setCookieFilter :: Monad m => (Request (ResourceT IO) -> Cookie -> IO Bool) -> GenericBrowserAction m () setCookieFilter b = get >>= \ a -> put a {cookieFilter = b}-withCookieFilter :: (Request (ResourceT IO) -> Cookie -> IO Bool) -> BrowserAction a -> BrowserAction a+withCookieFilter :: Monad m => (Request (ResourceT IO) -> Cookie -> IO Bool) -> GenericBrowserAction m a -> GenericBrowserAction m a withCookieFilter a b = do current <- getCookieFilter setCookieFilter a out <- b setCookieFilter current return out--- | All the cookies!-getCookieJar :: BrowserAction CookieJar++getCookieJar :: Monad m => GenericBrowserAction m CookieJar getCookieJar = get >>= \ a -> return $ cookieJar a-setCookieJar :: CookieJar -> BrowserAction ()+setCookieJar :: Monad m => CookieJar -> GenericBrowserAction m () setCookieJar b = get >>= \ a -> put a {cookieJar = b}-withCookieJar :: CookieJar -> BrowserAction a -> BrowserAction a+withCookieJar :: Monad m => CookieJar -> GenericBrowserAction m a -> GenericBrowserAction m a withCookieJar a b = do current <- getCookieJar setCookieJar a out <- b setCookieJar current return out--- | An optional proxy to send all requests through--- if Nothing uses Request's 'proxy'--- default: Nothing-getCurrentProxy :: BrowserAction (Maybe Proxy)++getCurrentProxy :: Monad m => GenericBrowserAction m (Maybe Proxy) getCurrentProxy = get >>= \ a -> return $ currentProxy a-setCurrentProxy :: Maybe Proxy -> BrowserAction ()+setCurrentProxy :: Monad m => Maybe Proxy -> GenericBrowserAction m () setCurrentProxy b = get >>= \ a -> put a {currentProxy = b}-withCurrentProxy :: Maybe Proxy -> BrowserAction a -> BrowserAction a+withCurrentProxy :: Monad m => Maybe Proxy -> GenericBrowserAction m a -> GenericBrowserAction m a withCurrentProxy a b = do current <- getCurrentProxy setCurrentProxy a out <- b setCurrentProxy current return out--- | An optional SOCKS proxy to send all requests through--- if Nothing uses Request's 'socksProxy'--- default: Nothing-getCurrentSocksProxy :: BrowserAction (Maybe SocksConf)++getCurrentSocksProxy :: Monad m => GenericBrowserAction m (Maybe SocksConf) getCurrentSocksProxy = get >>= \ a -> return $ currentSocksProxy a-setCurrentSocksProxy :: Maybe SocksConf -> BrowserAction ()+setCurrentSocksProxy :: Monad m => Maybe SocksConf -> GenericBrowserAction m () setCurrentSocksProxy b = get >>= \ a -> put a {currentSocksProxy = b}-withCurrentSocksProxy :: Maybe SocksConf -> BrowserAction a -> BrowserAction a+withCurrentSocksProxy :: Monad m => Maybe SocksConf -> GenericBrowserAction m a -> GenericBrowserAction m 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'.------ > do insertOverrideHeader ("User-Agent", "rat")--- > insertOverrideHeader ("Connection", "keep-alive")--- > makeRequest def{requestHeaders = [("User-Agent", "kitten"), ("Accept", "everything/digestible")]}--- > > User-Agent: rat--- > > Accept: everything/digestible--- > > Connection: keep-alive-getOverrideHeaders :: BrowserAction HT.RequestHeaders++getOverrideHeaders :: Monad m => GenericBrowserAction m HT.RequestHeaders getOverrideHeaders = get >>= \ a -> return $ Map.toList $ overrideHeaders a-setOverrideHeaders :: HT.RequestHeaders -> BrowserAction ()+setOverrideHeaders :: Monad m => HT.RequestHeaders -> GenericBrowserAction m () setOverrideHeaders b = do current_user_agent <- getUserAgent get >>= \ a -> put a {overrideHeaders = Map.fromList b} setUserAgent current_user_agent-withOverrideHeaders:: HT.RequestHeaders -> BrowserAction a -> BrowserAction a+withOverrideHeaders:: Monad m => HT.RequestHeaders -> GenericBrowserAction m a -> GenericBrowserAction m a withOverrideHeaders a b = do current <- getOverrideHeaders setOverrideHeaders a out <- b setOverrideHeaders current return out-getOverrideHeader :: HT.HeaderName -> BrowserAction (Maybe BS.ByteString)+getOverrideHeader :: Monad m => HT.HeaderName -> GenericBrowserAction m (Maybe BS.ByteString) getOverrideHeader b = get >>= \ a -> return $ Map.lookup b (overrideHeaders a)-setOverrideHeader :: HT.HeaderName -> Maybe BS.ByteString -> BrowserAction ()+setOverrideHeader :: Monad m => HT.HeaderName -> Maybe BS.ByteString -> GenericBrowserAction m () setOverrideHeader b Nothing = deleteOverrideHeader b setOverrideHeader b (Just c) = insertOverrideHeader (b, c)-insertOverrideHeader :: HT.Header -> BrowserAction ()+insertOverrideHeader :: Monad m => HT.Header -> GenericBrowserAction m () insertOverrideHeader (b, c) = get >>= \ a -> put a {overrideHeaders = Map.insert b c (overrideHeaders a)}-deleteOverrideHeader :: HT.HeaderName -> BrowserAction ()+deleteOverrideHeader :: Monad m => HT.HeaderName -> GenericBrowserAction m () deleteOverrideHeader b = get >>= \ a -> put a {overrideHeaders = Map.delete b (overrideHeaders a)}-withOverrideHeader :: HT.Header -> BrowserAction a -> BrowserAction a+withOverrideHeader :: Monad m => HT.Header -> GenericBrowserAction m a -> GenericBrowserAction m a withOverrideHeader (a,b) c = do current <- getOverrideHeader a insertOverrideHeader (a,b) out <- c setOverrideHeader a current return out--- | What string to report our user-agent as.--- if Nothing will not send user-agent unless one is specified in 'Request'------ > getUserAgent = lookup hUserAgent overrideHeaders--- > setUserAgent a = insertOverrideHeader (hUserAgent, a)------ default: Just "http-conduit"-getUserAgent :: BrowserAction (Maybe BS.ByteString)++getUserAgent :: Monad m => GenericBrowserAction m (Maybe BS.ByteString) getUserAgent = get >>= \ a -> return $ Map.lookup HT.hUserAgent (overrideHeaders a)-setUserAgent :: Maybe BS.ByteString -> BrowserAction ()+setUserAgent :: Monad m => Maybe BS.ByteString -> GenericBrowserAction m () setUserAgent Nothing = deleteOverrideHeader HT.hUserAgent setUserAgent (Just b) = insertOverrideHeader (HT.hUserAgent, b)-withUserAgent :: Maybe BS.ByteString -> BrowserAction a -> BrowserAction a+withUserAgent :: Monad m => Maybe BS.ByteString -> GenericBrowserAction m a -> GenericBrowserAction m a withUserAgent a b = do current <- getUserAgent setUserAgent a out <- b setUserAgent 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'--- default: Nothing-getCheckStatus :: BrowserAction (Maybe (HT.Status -> HT.ResponseHeaders -> Maybe SomeException))++getCheckStatus :: Monad m => GenericBrowserAction m (Maybe (HT.Status -> HT.ResponseHeaders -> Maybe SomeException)) getCheckStatus = get >>= \ a -> return $ browserCheckStatus a-setCheckStatus :: Maybe (HT.Status -> HT.ResponseHeaders -> Maybe SomeException) -> BrowserAction ()+setCheckStatus :: Monad m => Maybe (HT.Status -> HT.ResponseHeaders -> Maybe SomeException) -> GenericBrowserAction m () setCheckStatus b = get >>= \ a -> put a {browserCheckStatus = b}-withCheckStatus :: Maybe (HT.Status -> HT.ResponseHeaders -> Maybe SomeException) -> BrowserAction a -> BrowserAction a+withCheckStatus :: Monad m => Maybe (HT.Status -> HT.ResponseHeaders -> Maybe SomeException) -> GenericBrowserAction m a -> GenericBrowserAction m a withCheckStatus a b = do current <- getCheckStatus setCheckStatus a out <- b setCheckStatus current return out--- | The active manager, managing the connection pool-getManager :: BrowserAction Manager++getManager :: Monad m => GenericBrowserAction m Manager getManager = get >>= \ a -> return $ manager a-setManager :: Manager -> BrowserAction ()+setManager :: Monad m => Manager -> GenericBrowserAction m () setManager b = get >>= \ a -> put a {manager = b}++-- | 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+ then "https:"+ else "http:"+ , uriAuthority = Just URIAuth+ { uriUserInfo = ""+ , uriRegName = S8.unpack $ host req+ , uriPort = ':' : show (port req)+ }+ , uriPath = S8.unpack $ path req+ , uriQuery = S8.unpack $ queryString req+ , uriFragment = ""+ }
http-conduit-browser.cabal view
@@ -1,5 +1,5 @@ name: http-conduit-browser-version: 1.6.5+version: 1.6.6 license: BSD3 license-file: LICENSE author: Myles C. Maxfield <myles.maxfield@gmail.com>@@ -39,6 +39,10 @@ , bytestring , containers , socks+ , network >= 2.3+ , failure+ , monad-control+ , resourcet >= 0.3 && < 0.5 if flag(new-http-conduit) build-depends: http-conduit >= 1.7 && < 1.9 exposed-modules: Network.HTTP.Conduit.Browser@@ -77,3 +81,6 @@ , warp , wai , socks+ , network >= 2.3+ , failure+ , monad-control
test/main.hs view
@@ -318,3 +318,39 @@ case elbs of Left TestException -> return () _ -> error "Should have thrown an exception!"+ it "updates location" $ do+ tid <- forkIO $ run 3014 app+ request <- parseUrl "http://127.0.0.1:3014/"+ loc <- withManager $ \manager -> do+ browse manager $ do+ _ <- makeRequestLbs request+ getLocation+ killThread tid+ if (maybe "" show loc) /= "http://127.0.0.1:3014/"+ then error "Should have set the location"+ else return ()+ it "updates location while following redirections" $ do+ tid <- forkIO $ run 3014 app+ request <- parseUrl "http://127.0.0.1:3014/redir1"+ loc <- withManager $ \manager -> do+ browse manager $ do+ setMaxRedirects $ Just 2+ _ <- makeRequestLbs request+ getLocation+ killThread tid+ if (maybe "" show loc) /= "http://127.0.0.1:3014/redir3"+ then error "Should have updated the location when following 2 redirects"+ else return ()+ it "follows relative references" $ do+ tid <- forkIO $ run 3014 app+ request1 <- parseUrl "http://127.0.0.1:3014/"+ (elbs1, elbs2) <- withManager $ \manager -> do+ browse manager $ do+ lbs1 <- makeRequestLbs request1+ request2 <- parseRelativeUrl "redir3"+ lbs2 <- makeRequestLbs request2+ return (lbs1, lbs2)+ killThread tid+ if (lazyToStrict $ responseBody elbs1) /= fromString "homepage" || (lazyToStrict $ responseBody elbs2) /= dummy+ then error "Should have followed the relative reference"+ else return ()