http-conduit 1.5.0.3 → 1.6.0
raw patch · 7 files changed
+191/−148 lines, 7 files
Files
- Network/HTTP/Conduit.hs +7/−6
- Network/HTTP/Conduit/Browser.hs +19/−8
- Network/HTTP/Conduit/Request.hs +13/−114
- Network/HTTP/Conduit/Response.hs +4/−18
- Network/HTTP/Conduit/Types.hs +145/−0
- Network/HTTP/Conduit/Util.hs +1/−1
- http-conduit.cabal +2/−1
Network/HTTP/Conduit.hs view
@@ -138,6 +138,7 @@ import Data.Default (def) import Control.Exception.Lifted (throwIO)+import Control.Monad ((<=<)) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Control (MonadBaseControl) @@ -183,7 +184,7 @@ res@(Response status _version hs body) <- if redirectCount req0 == 0 then httpRaw req0 manager- else go (redirectCount req0) req0 def+ else go (redirectCount req0) req0 def [] case checkStatus req0 status hs of Nothing -> return res Just exc -> do@@ -191,14 +192,14 @@ final liftIO $ throwIO exc where- go 0 _ _ = liftIO $ throwIO TooManyRedirects- go count req'' cookie_jar'' = do+ go (-1) _ _ ress = liftIO . throwIO . TooManyRedirects =<< mapM lbsResponse ress+ go count req'' cookie_jar'' ress = do now <- liftIO getCurrentTime let (req', cookie_jar') = insertCookiesIntoRequest req'' (evictExpiredCookies cookie_jar'' now) now res <- httpRaw req' manager let (cookie_jar, _) = updateCookieJar res req' now cookie_jar' case getRedirectedRequest req' (responseHeaders res) (W.statusCode (responseStatus res)) of- Just req -> go (count - 1) req cookie_jar+ Just req -> go (count - 1) req cookie_jar (res:ress) Nothing -> return res -- | Get a 'Response' without any redirect following.@@ -240,7 +241,7 @@ -- interleaved actions on the response body during download, you'll need to use -- 'http' directly. This function is defined as: ----- @httpLbs = 'lbsResponse' . 'http'@+-- @httpLbs = 'lbsResponse' <=< 'http'@ -- -- Even though the 'Response' contains a lazy bytestring, this -- function does /not/ utilize lazy I/O, and therefore the entire@@ -251,7 +252,7 @@ -- Note: Unlike previous versions, this function will perform redirects, as -- specified by the 'redirectCount' setting. httpLbs :: (MonadBaseControl IO m, MonadResource m) => Request m -> Manager -> m (Response L.ByteString)-httpLbs r = lbsResponse . http r+httpLbs r = lbsResponse <=< http r -- | Download the specified URL, following any redirects, and -- return the response body.
Network/HTTP/Conduit/Browser.hs view
@@ -3,6 +3,7 @@ , BrowserAction , browse , makeRequest+ , makeRequestLbs , defaultState , getBrowserState , setBrowserState@@ -27,6 +28,7 @@ where import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as L import Control.Monad.State import Control.Exception import qualified Control.Exception.Lifted as LE@@ -91,18 +93,18 @@ where retryHelper request' retry_count e | retry_count == 0 = case e of Just e' -> throw e'- Nothing -> throw TooManyRedirects+ Nothing -> throw TooManyRetries | otherwise = do BrowserState {maxRedirects = max_redirects} <- get- resp <- LE.catch (runRedirectionChain request' max_redirects)+ resp <- LE.catch (if max_redirects==0+ then (\(_,a,_) -> a) `fmap` performRequest request'+ else runRedirectionChain request' max_redirects []) (\ e' -> retryHelper request' (retry_count - 1) (Just (e' :: HttpException))) let code = HT.statusCode $ HC.responseStatus resp if code < 200 || code >= 300 then retryHelper request' (retry_count - 1) (Just $ HC.StatusCodeException (HC.responseStatus resp) (HC.responseHeaders resp)) else return resp- runRedirectionChain request' redirect_count- | redirect_count == 0 = throw TooManyRedirects- | otherwise = do+ performRequest request' = do s@(BrowserState { manager = manager' , authorities = auths , cookieJar = cookie_jar@@ -115,11 +117,17 @@ res <- lift $ HC.http request'' manager' (cookie_jar'', response) <- liftIO $ updateCookieJar res request'' now cookie_jar' cookie_filter put $ s {cookieJar = cookie_jar''}+ return (request'', res, response)+ runRedirectionChain request' redirect_count ress+ | redirect_count == (-1) = throw . TooManyRedirects =<< mapM (liftIO . runResourceT . lbsResponse) ress+ | otherwise = do+ (request'', res, response) <- performRequest request' let code = HT.statusCode (HC.responseStatus response) if code >= 300 && code < 400- then runRedirectionChain (case HC.getRedirectedRequest request'' (responseHeaders response) code of- Just a -> a- Nothing -> throw HC.UnparseableRedirect) (redirect_count - 1)+ then do request''' <- case HC.getRedirectedRequest request'' (responseHeaders response) code of+ Just a -> return a+ Nothing -> throw . HC.UnparseableRedirect =<< (liftIO $ runResourceT $ lbsResponse response)+ runRedirectionChain request''' (redirect_count - 1) (res:ress) else return res applyAuthorities auths request' = case auths request' of Just (user, pass) -> applyBasicAuth user pass request'@@ -127,6 +135,9 @@ applyUserAgent ua request' = request' {requestHeaders = (k, ua) : hs} where hs = filter ((/= k) . fst) $ requestHeaders request' k = mk $ fromString "User-Agent"++makeRequestLbs :: Request (ResourceT IO) -> BrowserAction (Response L.ByteString)+makeRequestLbs = liftIO . runResourceT . lbsResponse <=< makeRequest updateCookieJar :: Response a -> Request (ResourceT IO) -> UTCTime -> CookieJar -> (Request (ResourceT IO) -> Cookie -> IO Bool) -> IO (CookieJar, Response a) updateCookieJar response request' now cookie_jar cookie_filter = do
Network/HTTP/Conduit/Request.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Conduit.Request@@ -18,16 +17,13 @@ , requestBuilder ) where -import Data.Int (Int64)-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, isJust) import Data.Monoid (mempty, mappend)-import Data.Typeable (Typeable) import Data.Default (Default (def)) import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString) import Blaze.ByteString.Builder.Char8 (fromChar)-import qualified Blaze.ByteString.Builder as Blaze import qualified Data.Conduit as C import qualified Data.Conduit.List as CL@@ -37,115 +33,20 @@ import qualified Data.ByteString.Lazy as L import qualified Network.HTTP.Types as W-import Network.Socks5 (SocksConf) import Network.URI (URI (..), URIAuth (..), parseURI, relativeTo, escapeURIString, isAllowedInURI) -import Control.Exception (Exception, SomeException, toException)+import Control.Exception (Exception, toException) import Control.Failure (Failure (failure)) import Codec.Binary.UTF8.String (encodeString) import qualified Data.CaseInsensitive as CI import qualified Data.ByteString.Base64 as B64 +import Network.HTTP.Conduit.Types (Request (..), RequestBody (..), ContentType, Proxy (..), HttpException (..))+ import Network.HTTP.Conduit.Chunk (chunkIt) import Network.HTTP.Conduit.Util (readDec, (<>)) -type ContentType = S.ByteString --- | All information on how to connect to a host and what should be sent in the--- HTTP request.------ If you simply wish to download from a URL, see 'parseUrl'.------ The constructor for this data type is not exposed. Instead, you should use--- either the 'def' method to retrieve a default instance, or 'parseUrl' to--- construct from a URL, and then use the records below to make modifications.--- This approach allows http-conduit to add configuration options without--- breaking backwards compatibility.------ For example, to construct a POST request, you could do something like:------ > initReq <- parseUrl "http://www.example.com/path"--- > let req = initReq--- > { method = "POST"--- > }------ For more information, please see--- <http://www.yesodweb.com/book/settings-types>.-data Request m = Request- { method :: W.Method- -- ^ HTTP request method, eg GET, POST.- , secure :: Bool- -- ^ Whether to use HTTPS (ie, SSL).- , host :: S.ByteString- , port :: Int- , path :: S.ByteString- -- ^ Everything from the host to the query string.- , queryString :: S.ByteString- , requestHeaders :: W.RequestHeaders- -- ^ Custom HTTP request headers- --- -- As already stated in the introduction, the Content-Length and Host- -- headers are set automatically by this module, and shall not be added to- -- requestHeaders.- --- -- Moreover, the Accept-Encoding header is set implicitly to gzip for- -- convenience by default. This behaviour can be overridden if needed, by- -- setting the header explicitly to a different value. In order to omit the- -- Accept-Header altogether, set it to the empty string \"\". If you need an- -- empty Accept-Header (i.e. requesting the identity encoding), set it to a- -- non-empty white-space string, e.g. \" \". See RFC 2616 section 14.3 for- -- details about the semantics of the Accept-Header field. If you request a- -- content-encoding not supported by this module, you will have to decode- -- it yourself (see also the 'decompress' field).- --- -- Note: Multiple header fields with the same field-name will result in- -- multiple header fields being sent and therefore it\'s the responsibility- -- of the client code to ensure that the rules from RFC 2616 section 4.2- -- are honoured.- , requestBody :: RequestBody m- , proxy :: Maybe Proxy- -- ^ Optional HTTP proxy.- , socksProxy :: Maybe SocksConf- -- ^ Optional SOCKS proxy.- , rawBody :: Bool- -- ^ If @True@, a chunked and\/or gzipped body will not be- -- decoded. Use with caution.- , decompress :: ContentType -> Bool- -- ^ Predicate to specify whether gzipped data should be- -- decompressed on the fly (see 'alwaysDecompress' and- -- 'browserDecompress'). Default: browserDecompress.- , redirectCount :: Int- -- ^ How many redirects to follow when getting a resource. 0 means follow- -- no redirects. Default value: 10.- , checkStatus :: W.Status -> W.ResponseHeaders -> Maybe SomeException- -- ^ Check the status code. Note that this will run after all redirects are- -- performed. Default: return a @StatusCodeException@ on non-2XX responses.- }---- | When using one of the--- 'RequestBodySource' \/ 'RequestBodySourceChunked' constructors,--- you must ensure--- that the 'Source' can be called multiple times. Usually this--- is not a problem.------ The 'RequestBodySourceChunked' will send a chunked request--- body, note that not all servers support this. Only use--- 'RequestBodySourceChunked' if you know the server you're--- sending to supports chunked request bodies.-data RequestBody m- = RequestBodyLBS L.ByteString- | RequestBodyBS S.ByteString- | RequestBodyBuilder Int64 Blaze.Builder- | RequestBodySource Int64 (C.Source m Blaze.Builder)- | RequestBodySourceChunked (C.Source m Blaze.Builder)---- | Define a HTTP proxy, consisting of a hostname and port number.--data Proxy = Proxy- { proxyHost :: S.ByteString -- ^ The host name of the HTTP proxy.- , proxyPort :: Int -- ^ The port number of the HTTP proxy.- }- -- | Convert a URL into a 'Request'. -- -- This defaults some of the values in 'Request', such as setting 'method' to@@ -246,17 +147,6 @@ else Just $ toException $ StatusCodeException s hs } -data HttpException = StatusCodeException W.Status W.ResponseHeaders- | InvalidUrlException String String- | TooManyRedirects- | UnparseableRedirect- | TooManyRetries- | HttpParserException String- | HandshakeFailed- | OverlongHeaders- deriving (Show, Typeable)-instance Exception HttpException- -- | Always decompress a compressed stream. alwaysDecompress :: ContentType -> Bool alwaysDecompress = const True@@ -332,6 +222,14 @@ | port req == 443 && secure req = host req | otherwise = host req <> S8.pack (':' : show (port req)) + requestProtocol+ | secure req = fromByteString "https://"+ | otherwise = fromByteString "http://"++ requestHostname+ | isJust (proxy req) = requestProtocol <> fromByteString hh+ | otherwise = mempty+ contentLengthHeader (Just contentLength') = if method req `elem` ["GET", "HEAD"] && contentLength' == 0 then id@@ -356,6 +254,7 @@ builder = fromByteString (method req) <> fromByteString " "+ <> requestHostname <> (case S8.uncons $ path req of Just ('/', _) -> fromByteString $ path req _ -> fromChar '/' <> fromByteString (path req))
Network/HTTP/Conduit/Response.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Conduit.Response@@ -10,7 +9,6 @@ ) where import Control.Arrow (first)-import Data.Typeable (Typeable) import Control.Monad (liftM) import Control.Exception (throwIO)@@ -30,6 +28,8 @@ import qualified Network.HTTP.Types as W import Network.URI (parseURIReference) +import Network.HTTP.Conduit.Types (Response (..))+ import Network.HTTP.Conduit.Manager import Network.HTTP.Conduit.Request import Network.HTTP.Conduit.Util@@ -38,19 +38,6 @@ import Data.Void (Void, absurd) --- | A simple representation of the HTTP response created by 'lbsConsumer'.-data Response body = Response- { responseStatus :: W.Status- , responseVersion :: W.HttpVersion- , responseHeaders :: W.ResponseHeaders- , responseBody :: body- }- deriving (Show, Eq, Typeable)---- | Since 1.1.2.-instance Functor Response where- fmap f (Response status v headers body) = Response status v headers (f body)- -- | If a request is a redirection (status code 3xx) this function will create -- a new request from the old request, the server headers returned with the -- redirection, and the redirection code itself. This function returns 'Nothing'@@ -87,10 +74,9 @@ -- | Convert a 'Response' that has a 'Source' body to one with a lazy -- 'L.ByteString' body. lbsResponse :: Monad m- => m (Response (ResumableSource m S8.ByteString))+ => Response (ResumableSource m S8.ByteString) -> m (Response L.ByteString)-lbsResponse mres = do- res <- mres+lbsResponse res = do bss <- responseBody res $$+- CL.consume return res { responseBody = L.fromChunks bss
+ Network/HTTP/Conduit/Types.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Network.HTTP.Conduit.Types+ ( Request (..)+ , RequestBody (..)+ , ContentType+ , Proxy (..)+ , HttpException (..)+ , Response (..)+ ) where++import Data.Int (Int64)+import Data.Typeable (Typeable)++import qualified Blaze.ByteString.Builder as Blaze++import qualified Data.Conduit as C++import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L++import qualified Network.HTTP.Types as W+import Network.Socks5 (SocksConf)++import Control.Exception (Exception, SomeException)++type ContentType = S.ByteString++-- | All information on how to connect to a host and what should be sent in the+-- HTTP request.+--+-- If you simply wish to download from a URL, see 'parseUrl'.+--+-- The constructor for this data type is not exposed. Instead, you should use+-- either the 'def' method to retrieve a default instance, or 'parseUrl' to+-- construct from a URL, and then use the records below to make modifications.+-- This approach allows http-conduit to add configuration options without+-- breaking backwards compatibility.+--+-- For example, to construct a POST request, you could do something like:+--+-- > initReq <- parseUrl "http://www.example.com/path"+-- > let req = initReq+-- > { method = "POST"+-- > }+--+-- For more information, please see+-- <http://www.yesodweb.com/book/settings-types>.+data Request m = Request+ { method :: W.Method+ -- ^ HTTP request method, eg GET, POST.+ , secure :: Bool+ -- ^ Whether to use HTTPS (ie, SSL).+ , host :: S.ByteString+ , port :: Int+ , path :: S.ByteString+ -- ^ Everything from the host to the query string.+ , queryString :: S.ByteString+ , requestHeaders :: W.RequestHeaders+ -- ^ Custom HTTP request headers+ --+ -- As already stated in the introduction, the Content-Length and Host+ -- headers are set automatically by this module, and shall not be added to+ -- requestHeaders.+ --+ -- Moreover, the Accept-Encoding header is set implicitly to gzip for+ -- convenience by default. This behaviour can be overridden if needed, by+ -- setting the header explicitly to a different value. In order to omit the+ -- Accept-Header altogether, set it to the empty string \"\". If you need an+ -- empty Accept-Header (i.e. requesting the identity encoding), set it to a+ -- non-empty white-space string, e.g. \" \". See RFC 2616 section 14.3 for+ -- details about the semantics of the Accept-Header field. If you request a+ -- content-encoding not supported by this module, you will have to decode+ -- it yourself (see also the 'decompress' field).+ --+ -- Note: Multiple header fields with the same field-name will result in+ -- multiple header fields being sent and therefore it\'s the responsibility+ -- of the client code to ensure that the rules from RFC 2616 section 4.2+ -- are honoured.+ , requestBody :: RequestBody m+ , proxy :: Maybe Proxy+ -- ^ Optional HTTP proxy.+ , socksProxy :: Maybe SocksConf+ -- ^ Optional SOCKS proxy.+ , rawBody :: Bool+ -- ^ If @True@, a chunked and\/or gzipped body will not be+ -- decoded. Use with caution.+ , decompress :: ContentType -> Bool+ -- ^ Predicate to specify whether gzipped data should be+ -- decompressed on the fly (see 'alwaysDecompress' and+ -- 'browserDecompress'). Default: browserDecompress.+ , redirectCount :: Int+ -- ^ How many redirects to follow when getting a resource. 0 means follow+ -- no redirects. Default value: 10.+ , checkStatus :: W.Status -> W.ResponseHeaders -> Maybe SomeException+ -- ^ Check the status code. Note that this will run after all redirects are+ -- performed. Default: return a @StatusCodeException@ on non-2XX responses.+ }++-- | When using one of the+-- 'RequestBodySource' \/ 'RequestBodySourceChunked' constructors,+-- you must ensure+-- that the 'Source' can be called multiple times. Usually this+-- is not a problem.+--+-- The 'RequestBodySourceChunked' will send a chunked request+-- body, note that not all servers support this. Only use+-- 'RequestBodySourceChunked' if you know the server you're+-- sending to supports chunked request bodies.+data RequestBody m+ = RequestBodyLBS L.ByteString+ | RequestBodyBS S.ByteString+ | RequestBodyBuilder Int64 Blaze.Builder+ | RequestBodySource Int64 (C.Source m Blaze.Builder)+ | RequestBodySourceChunked (C.Source m Blaze.Builder)++-- | Define a HTTP proxy, consisting of a hostname and port number.++data Proxy = Proxy+ { proxyHost :: S.ByteString -- ^ The host name of the HTTP proxy.+ , proxyPort :: Int -- ^ The port number of the HTTP proxy.+ }++data HttpException = StatusCodeException W.Status W.ResponseHeaders+ | InvalidUrlException String String+ | TooManyRedirects [Response L.ByteString] -- ^ List of encountered responses containing redirects in reverse chronological order; including last redirect, which triggered the exception and was not followed.+ | UnparseableRedirect (Response L.ByteString) -- ^ Response containing unparseable redirect.+ | TooManyRetries+ | HttpParserException String+ | HandshakeFailed+ | OverlongHeaders+ deriving (Show, Typeable)+instance Exception HttpException++-- | A simple representation of the HTTP response created by 'lbsConsumer'.+data Response body = Response+ { responseStatus :: W.Status+ , responseVersion :: W.HttpVersion+ , responseHeaders :: W.ResponseHeaders+ , responseBody :: body+ }+ deriving (Show, Eq, Typeable)++-- | Since 1.1.2.+instance Functor Response where+ fmap f (Response status v headers body) = Response status v headers (f body)
Network/HTTP/Conduit/Util.hs view
@@ -15,7 +15,7 @@ import qualified Data.Text as T import qualified Data.Text.Read -#if MIN_VERSION_base(4,3,0)+#if 1 import Data.ByteString (hGetSome) #else import GHC.IO.Handle.Types
http-conduit.cabal view
@@ -1,5 +1,5 @@ name: http-conduit-version: 1.5.0.3+version: 1.6.0 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -67,6 +67,7 @@ Network.HTTP.Conduit.Chunk Network.HTTP.Conduit.Response Network.HTTP.Conduit.Cookies+ Network.HTTP.Conduit.Types ghc-options: -Wall test-suite test