http-conduit-browser 1.9.0.2 → 2.0.0.0
raw patch · 3 files changed
+104/−110 lines, 3 filesdep +exceptionsdep +http-clientdep +network-uridep −certificatedep −failuredep −network-conduitdep ~http-conduitdep ~resourcetdep ~wai
Dependencies added: exceptions, http-client, network-uri, transformers-base
Dependencies removed: certificate, failure, network-conduit, socks, tls
Dependency ranges changed: http-conduit, resourcet, wai
Files
- Network/HTTP/Conduit/Browser.hs +87/−87
- http-conduit-browser.cabal +15/−17
- test/main.hs +2/−6
Network/HTTP/Conduit/Browser.hs view
@@ -33,7 +33,7 @@ -- > import Network.HTTP.Conduit.Browser -- > -- > -- The web request to log in to a service--- > req1 :: IO (Request (ResourceT IO))+-- > req1 :: IO (Request) -- > req1 = do -- > req <- parseUrl "http://www.myurl.com/login.php" -- > return $ urlEncodedBody [ (TE.encodeUtf8 "name", TE.encodeUtf8 "litherum")@@ -45,7 +45,7 @@ -- > req2 = parseUrl "http://www.myurl.com/main.php" -- > -- > -- Bind two BrowserActions together--- > action :: Request (ResourceT IO) -> Request (ResourceT IO) -> BrowserAction (Response LB.ByteString)+-- > action :: Request -> Request -> BrowserAction (Response LB.ByteString) -- > action r1 r2 = do -- > _ <- makeRequestLbs r1 -- > makeRequestLbs r2@@ -69,7 +69,7 @@ , parseRelativeUrl , makeRequest , makeRequestLbs- , downloadFile+-- , downloadFile -- * Browser state -- | You can save and restore the state at will , BrowserState@@ -116,14 +116,6 @@ , 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'@@ -156,13 +148,6 @@ , getAuthorities , setAuthorities , withAuthorities- -- ** Client certificates- -- | SSL client certificates- --- -- default: @Nothing@- , getClientCertificates- , setClientCertificates- , withClientCertificates -- ** Headers -- *** Default headers -- | Specifies Headers that should be added to 'Request',@@ -215,77 +200,68 @@ ) where +import Network.HTTP.Client import Network.HTTP.Conduit-import Network.HTTP.Conduit.Internal (httpRedirect- ,getUri- ,setUri- ,generateCookie- ,insertCheckedCookie- )+import Network.HTTP.Client.Internal (setUri) import qualified Network.HTTP.Types as HT-import Network.Socks5 (SocksConf) import Network.URI (URI (..), parseRelativeReference, relativeTo) import Data.Time.Clock (getCurrentTime, UTCTime) import Web.Cookie (parseSetCookie)-import Data.Certificate.X509 (X509)-import Network.TLS (PrivateKey) import qualified Data.Conduit as C-import qualified Data.Conduit.Binary as CB import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as L +import Data.Default import Data.Function (on) import Data.List (partition ,union ) import Data.Maybe (catMaybes, fromMaybe) import Control.Monad-import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.State-import Control.Monad.Trans.Resource (MonadResource, ResourceT, liftResourceT)+import Control.Monad.Trans.Resource (ResourceT, liftResourceT, MonadResource) import Control.Monad.Trans.Control (MonadBaseControl)-import Control.Failure+import Control.Monad.IO.Class+import Control.Monad.Base+import Control.Monad.Catch (MonadThrow, throwM) import qualified Control.Exception.Lifted as LE import Control.Exception (SomeException ,toException) import qualified Data.Map as Map data BrowserState = BrowserState- { currentLocation :: Maybe URI- , maxRedirects :: Maybe Int- , maxRetryCount :: Int- , timeout :: Maybe Int- , authorities :: Request (ResourceT IO) -> Maybe (BS.ByteString, BS.ByteString)- , browserClientCertificates :: Maybe [(X509, Maybe PrivateKey)]- , cookieFilter :: Request (ResourceT IO) -> Cookie -> IO Bool- , browserCookieJar :: CookieJar- , currentProxy :: Maybe Proxy- , currentSocksProxy :: Maybe SocksConf- , overrideHeaders :: Map.Map HT.HeaderName BS.ByteString- , defaultHeaders :: Map.Map HT.HeaderName BS.ByteString- , browserCheckStatus :: Maybe (HT.Status -> HT.ResponseHeaders -> CookieJar -> Maybe SomeException)- , manager :: Manager+ { currentLocation :: Maybe URI+ , maxRedirects :: Maybe Int+ , maxRetryCount :: Int+ , timeout :: Maybe Int+ , authorities :: Request -> Maybe (BS.ByteString, BS.ByteString)+ , cookieFilter :: Request -> Cookie -> IO Bool+ , browserCookieJar :: CookieJar+ , currentProxy :: Maybe Proxy+ , overrideHeaders :: Map.Map HT.HeaderName BS.ByteString+ , defaultHeaders :: Map.Map HT.HeaderName BS.ByteString+ , browserCheckStatus :: Maybe (HT.Status -> HT.ResponseHeaders -> CookieJar -> Maybe SomeException)+ , manager :: Manager } defaultState :: Manager -> BrowserState-defaultState m = BrowserState { currentLocation = Nothing- , maxRedirects = Nothing- , maxRetryCount = 0- , timeout = Nothing- , authorities = const Nothing- , browserClientCertificates = Nothing- , cookieFilter = const $ const $ return True- , browserCookieJar = def- , currentProxy = Nothing- , currentSocksProxy = Nothing- , overrideHeaders = Map.empty- , defaultHeaders = Map.singleton HT.hUserAgent "http-conduit-browser"- , browserCheckStatus = Nothing- , manager = m- }+defaultState m = BrowserState+ { currentLocation = Nothing+ , maxRedirects = Nothing+ , maxRetryCount = 0+ , timeout = Nothing+ , authorities = const Nothing+ , cookieFilter = const $ const $ return True+ , browserCookieJar = def+ , currentProxy = Nothing+ , overrideHeaders = Map.empty+ , defaultHeaders = Map.singleton HT.hUserAgent "http-conduit-browser"+ , browserCheckStatus = Nothing+ , manager = m+ } type BrowserAction = GenericBrowserAction (ResourceT IO) @@ -298,47 +274,50 @@ -- | 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 :: MonadThrow m => String -> GenericBrowserAction m Request parseRelativeUrl url = maybe err use =<< gets currentLocation- where err = lift $ failure $ InvalidUrlException url "Invalid URL"+ where+ err = lift $ throwM $ InvalidUrlException url "Invalid URL" use loc = maybe err (setUri def) $ do uri <- parseRelativeReference url relativeTo' uri loc-#if MIN_VERSION_network(2,4,0) relativeTo' x = Just . relativeTo x-#else- relativeTo' = relativeTo-#endif -- | Make a request, using all the state in the current BrowserState-makeRequest :: (MonadBaseControl IO m, MonadResource m) => Request (ResourceT IO) -> GenericBrowserAction m (Response (C.ResumableSource (ResourceT IO) BS.ByteString))+makeRequest :: (MonadBaseControl IO m, MonadIO m, MonadResource m) => Request -> GenericBrowserAction m (Response (C.ResumableSource (ResourceT IO) BS.ByteString)) makeRequest req = do BrowserState { maxRetryCount = max_retry_count , maxRedirects = max_redirects , timeout = time_out , currentProxy = current_proxy- , currentSocksProxy = current_socks_proxy , defaultHeaders = default_headers , overrideHeaders = override_headers , browserCheckStatus = current_check_status- , browserClientCertificates = client_certificates } <- get retryHelper (applyOverrideHeaders override_headers $ applyDefaultHeaders default_headers $ req { redirectCount = 0 , proxy = maybe (proxy req) Just current_proxy- , socksProxy = maybe (socksProxy req) Just current_socks_proxy+ --, socksProxy = maybe (socksProxy req) Just current_socks_proxy , checkStatus = \ _ _ _ -> Nothing , responseTimeout = maybe (responseTimeout req) Just time_out- , clientCertificates = fromMaybe (clientCertificates req) client_certificates+ --, clientCertificates = fromMaybe (clientCertificates req) client_certificates }) max_retry_count (fromMaybe (redirectCount req) max_redirects) (fromMaybe (checkStatus req) current_check_status) Nothing where+ retryHelper+ :: (MonadBaseControl IO m, MonadIO m, MonadResource m)+ => Request+ -> Int+ -> Int+ -> (HT.Status -> HT.ResponseHeaders -> CookieJar -> Maybe SomeException)+ -> Maybe SomeException+ -> GenericBrowserAction m (Response (C.ResumableSource (ResourceT IO) BS.ByteString)) retryHelper request' retry_count max_redirects check_status e | retry_count < 0 = case e of Just e' -> LE.throwIO e'@@ -353,14 +332,17 @@ Nothing -> return res Just e' -> retryHelper request' (retry_count - 1) max_redirects check_status (Just e') runRedirectionChain request' redirect_count- = httpRedirect+ = httpRedirectBase redirect_count (\request -> do res <- performRequest request let mreq = getRedirectedRequest request (responseHeaders res) (responseCookieJar res) (HT.statusCode $ responseStatus res) return (res, mreq))- liftResourceT request'+ performRequest+ :: (MonadBaseControl IO m, MonadIO m, MonadResource m)+ => Request+ -> GenericBrowserAction m (Response (C.ResumableSource (ResourceT IO) BS.ByteString)) performRequest request'' = do s@(BrowserState { manager = manager' , authorities = auths@@ -374,7 +356,7 @@ cookie_jar' } res <- liftResourceT $ http request' manager'- (cookie_jar, _) <- liftIO $ do+ (cookie_jar, _) <- liftBase $ do now <- getCurrentTime updateMyCookieJar res request' now cookie_jar' cookie_filter put $ s { browserCookieJar = cookie_jar@@ -382,17 +364,36 @@ } return res -applyAuthorities :: (Request a -> Maybe (BS.ByteString, BS.ByteString)) -> Request a -> Request a+httpRedirectBase+ :: (MonadBaseControl IO m, MonadIO m, MonadResource m)+ => Int -- ^ 'redirectCount'+ -> (Request -> m (Response (C.ResumableSource (ResourceT IO) BS.ByteString), Maybe Request)) -- ^ function which performs a request and returns a response, and possibly another request if there's a redirect.+ -> Request+ -> m (Response (C.ResumableSource (ResourceT IO) BS.ByteString))+httpRedirectBase count0 http' req0 = go count0 req0 []+ where+ go count _ ress | count < 0 = LE.throwIO . TooManyRedirects =<< mapM (liftResourceT . lbsResponse) ress+ go count req' ress = do+ (res, mreq) <- http' req'+ case mreq of+ Just req -> do+ liftIO $ responseClose res++ -- And now perform the actual redirect+ go (count - 1) req (res:ress)+ Nothing -> return res++applyAuthorities :: (Request -> Maybe (BS.ByteString, BS.ByteString)) -> Request -> Request applyAuthorities auths request' = case auths request' of Just (user, pass) -> applyBasicAuth user pass request' Nothing -> request' -applyDefaultHeaders :: Map.Map HT.HeaderName BS.ByteString -> Request a -> Request a+applyDefaultHeaders :: Map.Map HT.HeaderName BS.ByteString -> Request -> Request applyDefaultHeaders dv request = request {requestHeaders = x $ requestHeaders request} where x r = Map.toList $ Map.union (Map.fromList r) dv -applyOverrideHeaders :: Map.Map HT.HeaderName BS.ByteString -> Request a -> Request a+applyOverrideHeaders :: Map.Map HT.HeaderName BS.ByteString -> Request -> Request applyOverrideHeaders ov request = request {requestHeaders = x $ requestHeaders request} where x r = Map.toList $ Map.union ov (Map.fromList r) @@ -402,16 +403,19 @@ -- 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 :: (MonadIO m, MonadResource m, MonadBaseControl IO m) => Request -> GenericBrowserAction m (Response L.ByteString) makeRequestLbs = liftResourceT . lbsResponse <=< makeRequest +{- -- | Make a request and sink the 'responseBody' to a file.-downloadFile :: (MonadResource m, MonadBaseControl IO m) => FilePath -> Request (ResourceT IO) -> GenericBrowserAction m ()+downloadFile :: MonadBaseControl IO m => FilePath -> Request -> GenericBrowserAction m () downloadFile file request = do res <- makeRequest request- liftResourceT $ responseBody res C.$$+- CB.sinkFile file+ liftBase $ C.runResourceT $ bodyReaderSource (responseBody res) C.$$ CB.sinkFile file+-} -updateMyCookieJar :: Response a -> Request (ResourceT IO) -> UTCTime -> CookieJar -> (Request (ResourceT IO) -> Cookie -> IO Bool) -> IO (CookieJar, Response a)+updateMyCookieJar :: Response a -> Request -> UTCTime -> CookieJar -> (Request -> Cookie -> IO Bool) -> IO (CookieJar, Response a) updateMyCookieJar response request' now cookie_jar cookie_filter = do filtered_cookies <- filterM (cookie_filter request') $ catMaybes $ map (\ sc -> generateCookie sc request' now True) set_cookies return (cookieJar' filtered_cookies, response {responseHeaders = other_headers})@@ -458,17 +462,13 @@ GENERIC_FIELD(getTimeout, setTimeout, withTimeout, timeout, Maybe Int) -GENERIC_FIELD(getAuthorities, setAuthorities, withAuthorities, authorities, Request (ResourceT IO) -> Maybe (BS.ByteString, BS.ByteString))--GENERIC_FIELD(getClientCertificates, setClientCertificates, withClientCertificates, browserClientCertificates, Maybe [(X509, Maybe PrivateKey)])+GENERIC_FIELD(getAuthorities, setAuthorities, withAuthorities, authorities, Request -> Maybe (BS.ByteString, BS.ByteString)) -GENERIC_FIELD(getCookieFilter, setCookieFilter, withCookieFilter, cookieFilter, Request (ResourceT IO) -> Cookie -> IO Bool)+GENERIC_FIELD(getCookieFilter, setCookieFilter, withCookieFilter, cookieFilter, Request -> Cookie -> IO Bool) GENERIC_FIELD(getCookieJar, setCookieJar, withCookieJar, browserCookieJar, CookieJar) GENERIC_FIELD(getCurrentProxy, setCurrentProxy, withCurrentProxy, currentProxy, Maybe Proxy)--GENERIC_FIELD(getCurrentSocksProxy, setCurrentSocksProxy, withCurrentSocksProxy, currentSocksProxy, Maybe SocksConf) GENERIC_FIELD(getCheckStatus, setCheckStatus, withCheckStatus, browserCheckStatus, Maybe (HT.Status -> HT.ResponseHeaders -> CookieJar -> Maybe SomeException))
http-conduit-browser.cabal view
@@ -1,14 +1,16 @@ name: http-conduit-browser-version: 1.9.0.2+version: 2.0.0.0 license: BSD3 license-file: LICENSE author: Myles C. Maxfield <myles.maxfield@gmail.com>-maintainer: kudah <kudahkukarek@gmail.com>+maintainer: synopsis: Browser interface to the http-conduit package description: This package creates a monad representing things that browsers do, letting you elegantly describe a browsing session. This package wraps the http-conduit package by Michael Snoyman.++ This package is abandoned and unsupported, use http://hackage.haskell.org/package/wreq category: Web, Conduit stability: Stable cabal-version: >= 1.8@@ -22,23 +24,22 @@ library build-depends: base >= 4 && < 5- , http-conduit >= 1.9 && < 1.10+ , http-client >= 0.3 && < 1+ , http-conduit >= 2.1.5 && < 3+ , exceptions , data-default , cookie- , case-insensitive , time , http-types >= 0.7 , conduit , lifted-base+ , transformers-base , transformers , bytestring , containers- , socks- , network >= 2.3- , failure >= 0.2+ , network-uri , monad-control- , resourcet >= 0.3 && < 0.5- , certificate, tls+ , resourcet >= 1 && < 2 exposed-modules: Network.HTTP.Conduit.Browser ghc-options: -Wall @@ -50,9 +51,10 @@ ghc-options: -Wall build-depends: http-conduit-browser- , base >= 4 && < 5+ , base >= 4 && < 5 , HUnit- , hspec >= 1.3+ , hspec >= 1.3+ , http-client , http-conduit , blaze-builder , bytestring@@ -63,16 +65,12 @@ , containers , transformers , resourcet- , network-conduit , lifted-base , http-types , base64-bytestring , cookie , time , warp- , wai- , socks- , network >= 2.3- , failure+ , wai == 2.*+ , network >= 2.3 , monad-control- , certificate, tls
test/main.hs view
@@ -14,10 +14,8 @@ import Network.Wai hiding (requestBody, requestHeaders) import qualified Network.Wai as Wai import Network.Wai.Handler.Warp (run)-import Network.HTTP.Conduit-#if MIN_VERSION_http_conduit(1,9,0)-import Network.HTTP.Conduit.Internal (receiveSetCookie)-#endif+import Network.HTTP.Client hiding (withManager)+import Network.HTTP.Conduit (withManager) import Network.HTTP.Conduit.Browser import Data.ByteString.Base64 (encode) import Data.Typeable (Typeable)@@ -140,7 +138,6 @@ responseBody <$> makeRequestLbs req killThread tid elbs @?= "nom-nom-nom"-#if MIN_VERSION_http_conduit(1,9,0) it "custom cookies in Request's cookie jar survive redirects" $ do tid <- forkIO $ run 3019 app req <- parseUrl "http://127.0.0.1:3019/cookie_redir2"@@ -171,7 +168,6 @@ responseBody <$> makeRequestLbs request killThread tid liftIO $ elbs @?= "nom-nom-nom"-#endif it "can save and load cookie jar" $ do tid <- forkIO $ run 3011 app request1 <- parseUrl "http://127.0.0.1:3011/cookies"