http-conduit 1.8.7.1 → 1.8.8
raw patch · 7 files changed
+123/−52 lines, 7 filesdep ~conduitdep ~cookiedep ~zlib-conduit
Dependency ranges changed: conduit, cookie, zlib-conduit
Files
- Network/HTTP/Conduit.hs +37/−5
- Network/HTTP/Conduit/Chunk.hs +28/−29
- Network/HTTP/Conduit/ConnInfo.hs +4/−4
- Network/HTTP/Conduit/Request.hs +32/−3
- Network/HTTP/Conduit/Response.hs +13/−3
- Network/HTTP/Conduit/Types.hs +6/−5
- http-conduit.cabal +3/−3
Network/HTTP/Conduit.hs view
@@ -30,6 +30,7 @@ -- be added to 'requestHeaders': -- -- * Content-Length+-- * Transfer-Encoding -- -- Note: In previous versions, the Host header would be set by this module in -- all cases. Starting from 1.6.1, if a Host header is present in@@ -95,6 +96,7 @@ , redirectCount , checkStatus , responseTimeout+ , getConnectionWrapper -- * Manager , Manager , newManager@@ -147,7 +149,7 @@ import qualified Network.HTTP.Types as W import Data.Default (def) -import Control.Exception.Lifted (throwIO)+import Control.Exception.Lifted (throwIO, handle) import Control.Monad ((<=<)) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Resource@@ -187,6 +189,33 @@ -- You may also directly connect the returned 'C.Source' -- into a 'C.Sink', perhaps a file or another socket. --+-- An important note: the response body returned by this function represents a+-- live HTTP connection. As such, if you do not use the response body, an open+-- socket will be retained until the containing @ResourceT@ block exits. If you+-- do not need the response body, it is recommended that you explicitly shut+-- down the connection immediately, using the pattern:+--+-- > responseBody res $$+- return ()+--+-- As a more thorough example, consider the following program. Without the+-- explicit response body closing, the program will run out of file descriptors+-- around the 1000th request (depending on the operating system limits).+--+-- > import Control.Monad (replicateM_)+-- > import Control.Monad.IO.Class (liftIO)+-- > import Data.Conduit (($$+-))+-- > import Network (withSocketsDo)+-- > import Network.HTTP.Conduit+-- >+-- > main = withSocketsDo $ withManager $ \manager -> do+-- > req <- parseUrl "http://localhost/"+-- > mapM_ (worker manager req) [1..5000]+-- >+-- > worker manager req i = do+-- > res <- http req manager+-- > responseBody res $$+- return () -- The important line+-- > liftIO $ print (i, responseStatus res)+-- -- Note: Unlike previous versions, this function will perform redirects, as -- specified by the 'redirectCount' setting. http@@ -194,7 +223,7 @@ => Request m -> Manager -> m (Response (C.ResumableSource m S.ByteString))-http req0 manager = do+http req0 manager = wrapIOException $ do res@(Response status _version hs body) <- if redirectCount req0 == 0 then httpRaw req0 manager@@ -236,7 +265,7 @@ -> Manager -> m (Response (C.ResumableSource m S.ByteString)) httpRaw req m = do- (connRelease, ci, isManaged) <- getConnectionWrapper+ (timeout', (connRelease, ci, isManaged)) <- getConnectionWrapper req (responseTimeout req) (failedConnectionException req)@@ -249,7 +278,7 @@ -- exceptions in both. ex <- try' $ do requestBuilder req C.$$ builderToByteString C.=$ connSink ci- getResponse connRelease req src+ getResponse connRelease timeout' req src case (ex, isManaged) of -- Connection was reused, and might be been closed. Try again@@ -283,7 +312,10 @@ -- 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 = wrapIOException . (lbsResponse <=< http r)++wrapIOException :: MonadBaseControl IO m => m a -> m a+wrapIOException = handle $ throwIO . InternalIOException -- | Download the specified URL, following any redirects, and -- return the response body.
Network/HTTP/Conduit/Chunk.hs view
@@ -12,7 +12,7 @@ import Blaze.ByteString.Builder.HTTP import qualified Blaze.ByteString.Builder as Blaze -import Data.Conduit hiding (Source, Sink, Conduit)+import Data.Conduit import qualified Data.Conduit.Binary as CB import Control.Monad (when, unless)@@ -20,7 +20,7 @@ chunkedConduit :: MonadThrow m => Bool -- ^ send the headers as well, necessary for a proxy- -> Pipe S.ByteString S.ByteString S.ByteString u m ()+ -> Conduit S.ByteString m S.ByteString chunkedConduit sendHeaders = do i <- getLen when sendHeaders $ yield $ S8.pack $ showHex i "\r\n"@@ -28,37 +28,36 @@ CB.isolate i CB.drop 2 chunkedConduit sendHeaders--getLen :: Monad m => Pipe S.ByteString S.ByteString o u m Int-getLen =- start 0 where- start i = await >>= maybe (return i) (go i)+ getLen =+ start 0+ where+ start i = await >>= maybe (return i) (go i) - go i bs =- case S.uncons bs of- Nothing -> start i- Just (w, bs') ->- case toI w of- Just i' -> go (i * 16 + i') bs'- Nothing -> do- stripNewLine bs- return i+ go i bs =+ case S.uncons bs of+ Nothing -> start i+ Just (w, bs') ->+ case toI w of+ Just i' -> go (i * 16 + i') bs'+ Nothing -> do+ stripNewLine bs+ return i - stripNewLine bs =- case S.uncons $ S.dropWhile (/= 10) bs of- Just (10, bs') -> leftover bs'- Just _ -> assert False $ await >>= maybe (return ()) stripNewLine- Nothing -> await >>= maybe (return ()) stripNewLine+ stripNewLine bs =+ case S.uncons $ S.dropWhile (/= 10) bs of+ Just (10, bs') -> leftover bs'+ Just _ -> assert False $ await >>= maybe (return ()) stripNewLine+ Nothing -> await >>= maybe (return ()) stripNewLine - toI w- | 48 <= w && w <= 57 = Just $ fromIntegral w - 48- | 65 <= w && w <= 70 = Just $ fromIntegral w - 55- | 97 <= w && w <= 102 = Just $ fromIntegral w - 87- | otherwise = Nothing+ toI w+ | 48 <= w && w <= 57 = Just $ fromIntegral w - 48+ | 65 <= w && w <= 70 = Just $ fromIntegral w - 55+ | 97 <= w && w <= 102 = Just $ fromIntegral w - 87+ | otherwise = Nothing -chunkIt :: Monad m => Pipe l Blaze.Builder Blaze.Builder r m r+chunkIt :: Monad m => Conduit Blaze.Builder m Blaze.Builder chunkIt =- awaitE >>= either- (\u -> yield chunkedTransferTerminator >> return u)+ await >>= maybe+ (yield chunkedTransferTerminator) (\x -> yield (chunkedTransferEncoding x) >> chunkIt)
Network/HTTP/Conduit/ConnInfo.hs view
@@ -42,7 +42,7 @@ import Crypto.Random.AESCtr (makeSystem) -import Data.Conduit hiding (Source, Sink, Conduit)+import Data.Conduit #if DEBUG import qualified Data.IntMap as IntMap@@ -56,13 +56,13 @@ , connClose :: IO () } -connSink :: MonadResource m => ConnInfo -> Pipe l ByteString o r m r+connSink :: MonadResource m => ConnInfo -> Sink ByteString m () connSink ConnInfo { connWrite = write } = self where- self = awaitE >>= either return (\x -> liftIO (write x) >> self)+ self = await >>= maybe (return ()) (\x -> liftIO (write x) >> self) -connSource :: MonadResource m => ConnInfo -> Pipe l i ByteString u m ()+connSource :: MonadResource m => ConnInfo -> Source m ByteString connSource ConnInfo { connRead = read' } = self where
Network/HTTP/Conduit/Request.hs view
@@ -41,6 +41,7 @@ import qualified Network.HTTP.Types as W import Network.URI (URI (..), URIAuth (..), parseURI, relativeTo, escapeURIString, isAllowedInURI) +import Control.Monad.IO.Class (liftIO) import Control.Exception.Lifted (Exception, toException, throwIO) import Control.Failure (Failure (failure)) import Codec.Binary.UTF8.String (encodeString)@@ -52,6 +53,7 @@ import Network.HTTP.Conduit.Chunk (chunkIt) import Network.HTTP.Conduit.Util (readDec, (<>)) import System.Timeout.Lifted (timeout)+import Data.Time.Clock -- | Convert a URL into a 'Request'. --@@ -116,6 +118,7 @@ , queryString = S8.pack $ uriQuery uri } where+ failUri :: Failure HttpException m => String -> m a failUri = failure . InvalidUrlException (show uri) parseScheme URI{uriScheme = scheme} =@@ -136,6 +139,25 @@ False {- HTTP -} -> return 80 True {- HTTPS -} -> return 443 +instance Show (Request m) where+ show x = unlines+ [ "Request {"+ , " host = " ++ show (host x)+ , " port = " ++ show (port x)+ , " secure = " ++ show (secure x)+ , " clientCertificates = " ++ show (clientCertificates x)+ , " requestHeaders = " ++ show (requestHeaders x)+ , " path = " ++ show (path x)+ , " queryString = " ++ show (queryString x)+ , " requestBody = " ++ show (requestBody x)+ , " method = " ++ show (method x)+ , " proxy = " ++ show (proxy x)+ , " rawBody = " ++ show (rawBody x)+ , " redirectCount = " ++ show (redirectCount x)+ , " responseTimeout = " ++ show (responseTimeout x)+ , "}"+ ]+ instance Default (Request m) where def = Request { host = "localhost"@@ -159,12 +181,19 @@ , responseTimeout = Just 5000000 , getConnectionWrapper = \mtimeout exc f -> case mtimeout of- Nothing -> f+ Nothing -> fmap ((,) Nothing) f Just timeout' -> do- mres <- timeout (timeout' `div` 2) f+ before <- liftIO getCurrentTime+ mres <- timeout timeout' f case mres of Nothing -> throwIO exc- Just res -> return res+ Just res -> do+ now <- liftIO getCurrentTime+ let timeSpentMicro = diffUTCTime now before * 1000000+ remainingTime = round $ fromIntegral timeout' - timeSpentMicro+ if remainingTime <= 0+ then throwIO exc+ else return (Just remainingTime, res) } -- | Always decompress a compressed stream.
Network/HTTP/Conduit/Response.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} module Network.HTTP.Conduit.Response ( Response (..) , getRedirectedRequest@@ -40,6 +41,9 @@ import Data.Void (Void, absurd) import System.Timeout.Lifted (timeout)+#if MIN_VERSION_conduit(1, 0, 0)+import Data.Conduit.Internal (ConduitM (..))+#endif -- | 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@@ -103,19 +107,25 @@ getResponse :: (MonadResource m, MonadBaseControl IO m) => ConnRelease m+ -> Maybe Int -> Request m -> Source m S8.ByteString -> m (Response (ResumableSource m S8.ByteString))-getResponse connRelease req@(Request {..}) src1 = do+getResponse connRelease timeout'' req@(Request {..}) src1 = do let timeout' =- case responseTimeout of+ case timeout'' of Nothing -> id Just useconds -> \ma -> do x <- timeout useconds ma case x of Nothing -> liftIO $ throwIO ResponseTimeout Just y -> return y- (src2, ((vbs, sc, sm), hs)) <- timeout' $ src1 $$+ checkHeaderLength 4096 sinkHeaders'+ (src2, ((vbs, sc, sm), hs)) <- timeout' $ src1 $$++#if MIN_VERSION_conduit(1, 0, 0)+ ConduitM (checkHeaderLength 4096 $ unConduitM sinkHeaders')+#else+ (checkHeaderLength 4096 sinkHeaders')+#endif let version = if vbs == "1.1" then W.http11 else W.http10 let s = W.Status sc sm let hs' = map (first CI.mk) hs
Network/HTTP/Conduit/Types.hs view
@@ -26,7 +26,7 @@ import qualified Network.HTTP.Types as W import Network.Socks5 (SocksConf) -import Control.Exception (Exception, SomeException)+import Control.Exception (Exception, SomeException, IOException) import Data.Certificate.X509 (X509) import Network.TLS (PrivateKey)@@ -115,16 +115,16 @@ => Maybe Int -> HttpException -> n (ConnRelease n, ConnInfo, ManagedConn)- -> n (ConnRelease n, ConnInfo, ManagedConn)+ -> n (Maybe Int, (ConnRelease n, ConnInfo, ManagedConn)) -- ^ Wraps the calls for getting new connections. This can be useful for -- instituting some kind of timeouts. The first argument is the value of -- @responseTimeout@. Second argument is the exception to be thrown on -- failure. -- -- Default: If @responseTimeout@ is @Nothing@, does nothing. Otherwise,- -- institutes a timeout half of the length of @responseTimeout@.+ -- institutes timeout, and returns remaining time for @responseTimeout@. --- -- Since 1.8.6+ -- Exported since 1.8.8 } data ConnReuse = Reuse | DontReuse@@ -156,7 +156,7 @@ { proxyHost :: S.ByteString -- ^ The host name of the HTTP proxy. , proxyPort :: Int -- ^ The port number of the HTTP proxy. }- deriving (Show, Read, Eq, Typeable)+ deriving (Show, Read, Eq, Ord, Typeable) data HttpException = StatusCodeException W.Status W.ResponseHeaders | InvalidUrlException String String@@ -171,6 +171,7 @@ | ExpectedBlankAfter100Continue | InvalidStatusLine S.ByteString | InvalidHeader S.ByteString+ | InternalIOException IOException deriving (Show, Typeable) instance Exception HttpException
http-conduit.cabal view
@@ -1,5 +1,5 @@ name: http-conduit-version: 1.8.7.1+version: 1.8.8 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -28,8 +28,8 @@ , transformers >= 0.2 , failure >= 0.1 , resourcet >= 0.3 && < 0.5- , conduit >= 0.5.5 && < 0.6- , zlib-conduit >= 0.5 && < 0.6+ , conduit >= 0.5.5 && < 1.1+ , zlib-conduit >= 0.5 && < 1.1 , blaze-builder-conduit >= 0.5 , attoparsec-conduit >= 0.5 , attoparsec >= 0.8.0.2