http-conduit 1.4.1.10 → 1.5.0

raw patch · 6 files changed

+70/−106 lines, 6 filesdep ~attoparsec-conduitdep ~blaze-builder-conduitdep ~conduitPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: attoparsec-conduit, blaze-builder-conduit, conduit, data-default, zlib-conduit

API changes (from Hackage documentation)

Files

• Network/HTTP/Conduit.hs +4/−3
• Network/HTTP/Conduit/Browser.hs +1/−1
• Network/HTTP/Conduit/Chunk.hs +21/−54
• Network/HTTP/Conduit/ConnInfo.hs +9/−14
• Network/HTTP/Conduit/Response.hs +29/−28
• http-conduit.cabal +6/−6

@@ -180,7 +180,7 @@     :: (MonadResource m, MonadBaseControl IO m)     => Request m     -> Manager-    -> m (Response (C.Source m S.ByteString))+    -> m (Response (C.ResumableSource m S.ByteString)) http req0 manager = do     res@(Response status _version hs body) <-         if redirectCount req0 == 0@@ -189,7 +189,8 @@     case checkStatus req0 status hs of         Nothing -> return res         Just exc -> do-            CI.runFinalize $ CI.pipeClose body+            let CI.ResumableSource _ final = body+            final             liftIO $ throwIO exc   where     go 0 _ _ = liftIO $ throwIO TooManyRedirects@@ -207,7 +208,7 @@      :: (MonadBaseControl IO m, MonadResource m)      => Request m      -> Manager-     -> m (Response (C.Source m S.ByteString))+     -> m (Response (C.ResumableSource m S.ByteString)) httpRaw req m = do     (connRelease, ci, isManaged) <- getConn req m     let src = connSource ci

@@ -76,7 +76,7 @@ browse m act = evalStateT act (defaultState m)  -- | Make a request, using all the state in the current BrowserState-makeRequest :: Request (ResourceT IO) -> BrowserAction (Response (Source (ResourceT IO) BS.ByteString))+makeRequest :: Request (ResourceT IO) -> BrowserAction (Response (ResumableSource (ResourceT IO) BS.ByteString)) makeRequest request = do   BrowserState     { maxRetryCount = max_retry_count

@@ -4,7 +4,6 @@     , chunkIt     ) where -import Control.Exception (assert) import Numeric (showHex)  import qualified Data.ByteString as S@@ -15,67 +14,35 @@  import qualified Data.Attoparsec.ByteString as A -import qualified Data.Conduit as C-import Data.Conduit.Attoparsec (ParseError (ParseError))+import Data.Conduit hiding (Source, Sink, Conduit)+import qualified Data.Conduit.Binary as CB+import Data.Conduit.Attoparsec (ParseError (ParseError), Position (..))  import Network.HTTP.Conduit.Parser---data CState = NeedHeader (S.ByteString -> A.Result Int)-            | Isolate Int-            | NeedNewline (S.ByteString -> A.Result ())-            | Complete+import Control.Monad (when, unless)+import Control.Monad.Trans.Class (lift) -chunkedConduit :: C.MonadThrow m+chunkedConduit :: MonadThrow m                => Bool -- ^ send the headers as well, necessary for a proxy-               -> C.Conduit S.ByteString m S.ByteString-chunkedConduit sendHeaders = C.conduitState-    (NeedHeader $ A.parse parseChunkHeader)-    (push id)-    close+               -> Pipe S.ByteString S.ByteString S.ByteString u m ()+chunkedConduit sendHeaders =+    await >>= maybe (return ()) (needHeader $ A.parse parseChunkHeader)   where-    push front (NeedHeader f) x =+    needHeader f x =         case f x of             A.Done x' i-                | i == 0 -> push front Complete x'+                | i == 0 -> unless (S.null x') (leftover x') >> complete                 | otherwise -> do                     let header = S8.pack $ showHex i "\r\n"-                    let addHeader = if sendHeaders then (header:) else id-                    push (front . addHeader) (Isolate i) x'-            A.Partial f' -> return $ C.StateProducing (NeedHeader f') $ front []-            A.Fail _ contexts msg -> C.monadThrow $ ParseError contexts msg-    push front (Isolate i) x = do-        let (a, b) = S.splitAt i x-            i' = i - S.length a-        if i' == 0-            then push-                    (front . (a:))-                    (NeedNewline $ A.parse newline)-                    b-            else assert (S.null b) $ return $ C.StateProducing-                (Isolate i')-                (front [a])-    push front (NeedNewline f) x =-        case f x of-            A.Done x' () -> do-                let header = S8.pack "\r\n"-                let addHeader = if sendHeaders then (header:) else id-                push-                    (front . addHeader)-                    (NeedHeader $ A.parse parseChunkHeader)-                    x'-            A.Partial f' -> return $ C.StateProducing (NeedNewline f') $ front []-            A.Fail _ contexts msg -> C.monadThrow $ ParseError contexts msg-    push front Complete leftover = do-        let end = if sendHeaders then [S8.pack "0\r\n"] else []-            lo = if S.null leftover then Nothing else Just leftover-        return $ C.StateFinished lo $ front end-    close _ = return []+                    when sendHeaders $ yield header+                    unless (S.null x') $ leftover x'+                    CB.isolate i+            A.Partial f' -> await >>= maybe (return ()) (needHeader f')+            A.Fail _ contexts msg -> lift $ monadThrow $ ParseError contexts msg $ Position 0 0+    complete = when sendHeaders $ yield $ S8.pack "0\r\n" -chunkIt :: Monad m => C.Conduit Blaze.Builder m Blaze.Builder+chunkIt :: Monad m => Pipe l Blaze.Builder Blaze.Builder r m r chunkIt =-    conduit-  where-    conduit = C.NeedInput push close-    push xs = C.HaveOutput conduit (return ()) (chunkedTransferEncoding xs)-    close = C.HaveOutput (return ()) (return ()) chunkedTransferTerminator+    awaitE >>= either+        (\u -> yield chunkedTransferTerminator >> return u)+        (\x -> yield (chunkedTransferEncoding x) >> chunkIt)

@@ -41,7 +41,7 @@  import Crypto.Random.AESCtr (makeSystem) -import qualified Data.Conduit as C+import Data.Conduit hiding (Source, Sink, Conduit)  #if DEBUG import qualified Data.IntMap as IntMap@@ -55,26 +55,21 @@     , connClose :: IO ()     } -connSink :: C.MonadResource m => ConnInfo -> C.Sink ByteString m ()+connSink :: MonadResource m => ConnInfo -> Pipe l ByteString o r m r connSink ConnInfo { connWrite = write } =-    C.NeedInput push close+    self   where-    push bss = C.PipeM-        (liftIO (write bss) >> return (C.NeedInput push close))-        (return ())-    close = return ()+    self = awaitE >>= either return (\x -> liftIO (write x) >> self) -connSource :: C.MonadResource m => ConnInfo -> C.Source m ByteString+connSource :: MonadResource m => ConnInfo -> Pipe l i ByteString u m () connSource ConnInfo { connRead = read' } =-    src+    self   where-    src = C.PipeM pull close-    pull = do+    self = do         bs <- liftIO read'         if S.null bs-            then return (return ())-            else return $ C.HaveOutput src close bs-    close = return ()+            then return ()+            else yield bs >> self  #if DEBUG allOpenSockets :: I.IORef (Int, IntMap.IntMap String)

@@ -11,7 +11,6 @@  import Control.Arrow (first) import Data.Typeable (Typeable)-import Data.Monoid (mempty) import Control.Monad (liftM)  import Control.Exception (throwIO)@@ -22,13 +21,11 @@  import qualified Data.CaseInsensitive as CI -import Control.Monad.Trans.Resource (MonadResource)-import Control.Monad.Trans.Class (lift)-import qualified Data.Conduit as C+import Data.Conduit hiding (Sink, Conduit)+import Data.Conduit.Internal (ResumableSource (..), Pipe (..)) import qualified Data.Conduit.Zlib as CZ import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL-import qualified Data.Conduit.Internal  import qualified Network.HTTP.Types as W import Network.URI (parseURIReference)@@ -39,7 +36,7 @@ import Network.HTTP.Conduit.Parser import Network.HTTP.Conduit.Chunk -import Data.Void (absurd)+import Data.Void (Void, absurd)  -- | A simple representation of the HTTP response created by 'lbsConsumer'. data Response body = Response@@ -64,7 +61,7 @@ -- specific request, that user has to re-implement the redirect-following logic -- themselves. An example of that might look like this: ----- > myHttp req man = E.catch (C.runResourceT $ http req' man >> return [req'])+-- > myHttp req man = E.catch (runResourceT $ http req' man >> return [req']) -- >                    (\ (StatusCodeException status headers) -> do -- >                        l <- myHttp (fromJust $ nextRequest status headers) man -- >                        return $ req' : l)@@ -87,41 +84,41 @@                 else req'     | otherwise = Nothing --- | Convert a 'Response' that has a 'C.Source' body to one with a lazy+-- | Convert a 'Response' that has a 'Source' body to one with a lazy -- 'L.ByteString' body. lbsResponse :: Monad m-            => m (Response (C.Source m S8.ByteString))+            => m (Response (ResumableSource m S8.ByteString))             -> m (Response L.ByteString) lbsResponse mres = do     res <- mres-    bss <- responseBody res C.$$ CL.consume+    bss <- responseBody res $$+- CL.consume     return res         { responseBody = L.fromChunks bss         } +-- | This function can\'t be a Conduit, since it would lose leftovers. checkHeaderLength :: MonadResource m                   => Int-                  -> C.Sink S8.ByteString m a-                  -> C.Sink S8.ByteString m a-checkHeaderLength len C.NeedInput{}-    | len <= 0 =-        let x = liftIO $ throwIO OverlongHeaders-         in C.PipeM x (lift x)-checkHeaderLength len (C.NeedInput pushI closeI) = C.NeedInput+                  -> Pipe S8.ByteString S8.ByteString Void u m r+                  -> Pipe S8.ByteString S8.ByteString Void u m r+checkHeaderLength len NeedInput{}+    | len <= 0 = liftIO $ throwIO OverlongHeaders+checkHeaderLength len (NeedInput pushI closeI) = NeedInput     (\bs -> checkHeaderLength         (len - S8.length bs)         (pushI bs)) closeI-checkHeaderLength len (C.PipeM msink close) = C.PipeM (liftM (checkHeaderLength len) msink) close-checkHeaderLength _ s@C.Done{} = s-checkHeaderLength _ (C.HaveOutput _ _ o) = absurd o+checkHeaderLength len (PipeM msink) = PipeM (liftM (checkHeaderLength len) msink)+checkHeaderLength _ s@Done{} = s+checkHeaderLength _ (HaveOutput _ _ o) = absurd o+checkHeaderLength len (Leftover p i) = Leftover (checkHeaderLength len p) i  getResponse :: MonadResource m             => ConnRelease m             -> Request m-            -> C.Source m S8.ByteString-            -> m (Response (C.Source m S8.ByteString))+            -> Source m S8.ByteString+            -> m (Response (ResumableSource m S8.ByteString)) getResponse connRelease req@(Request {..}) src1 = do-    (src2, ((vbs, sc, sm), hs)) <- src1 C.$$+ checkHeaderLength 4096 sinkHeaders+    (src2, ((vbs, sc, sm), hs)) <- src1 $$+ checkHeaderLength 4096 sinkHeaders     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@@ -136,19 +133,23 @@         if hasNoBody method sc || mcl == Just 0             then do                 cleanup True-                return mempty+                (rsrc, ()) <- return () $$+ return ()+                return rsrc             else do                 let src3 =                         if ("transfer-encoding", "chunked") `elem` hs'-                            then src2 C.$= chunkedConduit rawBody+                            then fmapResume ($= chunkedConduit rawBody) src2                             else                                 case mcl of-                                    Just len -> src2 C.$= CB.isolate len+                                    Just len -> fmapResume ($= CB.isolate len) src2                                     Nothing  -> src2                 let src4 =                         if needsGunzip req hs'-                            then src3 C.$= CZ.ungzip+                            then fmapResume ($= CZ.ungzip) src3                             else src3-                return $ Data.Conduit.Internal.addCleanup cleanup src4+                return $ addCleanup' cleanup src4      return $ Response s version hs' body+  where+    fmapResume f (ResumableSource src m) = ResumableSource (f src) m+    addCleanup' f (ResumableSource src m) = ResumableSource (addCleanup f src) (m >> f False)

@@ -1,5 +1,5 @@ name:            http-conduit-version:         1.4.1.10+version:         1.5.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -23,10 +23,10 @@                  , transformers          >= 0.2     && < 0.4                  , failure               >= 0.1                  , resourcet             >= 0.3     && < 0.4-                 , conduit               >= 0.4.1   && < 0.5-                 , zlib-conduit          >= 0.4     && < 0.5-                 , blaze-builder-conduit >= 0.4     && < 0.5-                 , attoparsec-conduit    >= 0.4     && < 0.5+                 , conduit               >= 0.5     && < 0.6+                 , zlib-conduit          >= 0.5     && < 0.6+                 , blaze-builder-conduit >= 0.5     && < 0.6+                 , attoparsec-conduit    >= 0.5     && < 0.6                  , attoparsec            >= 0.8.0.2 && < 0.11                  , utf8-string           >= 0.3.4   && < 0.4                  , blaze-builder         >= 0.2.1   && < 0.4@@ -40,7 +40,7 @@                  , case-insensitive      >= 0.2                  , base64-bytestring     >= 0.1     && < 0.2                  , asn1-data             >= 0.5.1   && < 0.7-                 , data-default          >= 0.3     && < 0.5+                 , data-default                  , text                  , transformers-base     >= 0.4     && < 0.5                  , lifted-base           >= 0.1     && < 0.2