http-conduit 1.3.0.1 → 1.4.0
raw patch · 6 files changed
+58/−46 lines, 6 filesdep +voiddep ~attoparsec-conduitdep ~blaze-builder-conduitdep ~conduitPVP ok
version bump matches the API change (PVP)
Dependencies added: void
Dependency ranges changed: attoparsec-conduit, blaze-builder-conduit, conduit, data-default, transformers, zlib-conduit
API changes (from Hackage documentation)
Files
- Network/HTTP/Conduit.hs +6/−5
- Network/HTTP/Conduit/Chunk.hs +1/−1
- Network/HTTP/Conduit/ConnInfo.hs +7/−5
- Network/HTTP/Conduit/Response.hs +27/−19
- http-conduit.cabal +9/−7
- test/main.hs +8/−9
Network/HTTP/Conduit.hs view
@@ -23,8 +23,8 @@ -- > main = do -- > request <- parseUrl "http://google.com/" -- > withManager $ \manager -> do--- > Response _ _ bsrc <- http request manager--- > bsrc C.$$ sinkFile "google.html"+-- > Response _ _ src <- http request manager+-- > src C.$$ sinkFile "google.html" -- -- The following headers are automatically set by this module, and should not -- be added to 'requestHeaders':@@ -128,6 +128,7 @@ import Control.Monad.Trans.Control (MonadBaseControl) import qualified Data.Conduit as C+import qualified Data.Conduit.Internal as CI import Data.Conduit.Blaze (builderToByteString) import Data.Conduit (MonadResource) import Control.Exception.Lifted (try, SomeException)@@ -172,7 +173,7 @@ case checkStatus req0 status hs of Nothing -> return res Just exc -> do- C.sourceClose body+ CI.pipeClose body liftIO $ throwIO exc where go 0 _ _ = liftIO $ throwIO TooManyRedirects@@ -193,7 +194,7 @@ -> m (Response (C.Source m S.ByteString)) httpRaw req m = do (connRelease, ci, isManaged) <- getConn req m- bsrc <- C.bufferSource $ connSource ci+ let src = connSource ci ex <- try $ requestBuilder req C.$$ builderToByteString C.=$ connSink ci case (ex :: Either SomeException (), isManaged) of -- Connection was reused, and might be been closed. Try again@@ -204,7 +205,7 @@ (Left e, Fresh) -> liftIO $ throwIO e -- Everything went ok, so the connection is good. If any exceptions get -- thrown in the rest of the code, just throw them as normal.- (Right (), _) -> getResponse connRelease req bsrc+ (Right (), _) -> getResponse connRelease req src -- | Download the specified 'Request', returning the results as a 'Response'. --
Network/HTTP/Conduit/Chunk.hs view
@@ -78,4 +78,4 @@ where conduit = C.NeedInput push close push xs = C.HaveOutput conduit (return ()) (chunkedTransferEncoding xs)- close = C.Open C.Closed (return ()) chunkedTransferTerminator+ close = C.HaveOutput (return ()) (return ()) chunkedTransferTerminator
Network/HTTP/Conduit/ConnInfo.hs view
@@ -57,21 +57,23 @@ connSink :: C.MonadResource m => ConnInfo -> C.Sink ByteString m () connSink ConnInfo { connWrite = write } =- C.Processing push close+ C.NeedInput push close where- push bss = C.SinkM $ liftIO (write bss) >> return (C.Processing push close)+ push bss = C.PipeM+ (liftIO (write bss) >> return (C.NeedInput push close))+ (return ()) close = return () connSource :: C.MonadResource m => ConnInfo -> C.Source m ByteString connSource ConnInfo { connRead = read' } = src where- src = C.SourceM pull close+ src = C.PipeM pull close pull = do bs <- liftIO read' if S.null bs- then return C.Closed- else return $ C.Open src close bs+ then return (return ())+ else return $ C.HaveOutput src close bs close = return () #if DEBUG
Network/HTTP/Conduit/Response.hs view
@@ -36,6 +36,8 @@ import Network.HTTP.Conduit.Parser import Network.HTTP.Conduit.Chunk +import Data.Void (absurd)+ -- | A simple representation of the HTTP response created by 'lbsConsumer'. data Response body = Response { responseStatus :: W.Status@@ -113,22 +115,25 @@ => Int -> C.Sink S8.ByteString m a -> C.Sink S8.ByteString m a-checkHeaderLength len C.Processing{}- | len <= 0 = C.SinkM $ liftIO $ throwIO OverlongHeaders-checkHeaderLength len (C.Processing pushI closeI) = C.Processing+checkHeaderLength len C.NeedInput{}+ | len <= 0 =+ let x = liftIO $ throwIO OverlongHeaders+ in C.PipeM x x+checkHeaderLength len (C.NeedInput pushI closeI) = C.NeedInput (\bs -> checkHeaderLength (len - S8.length bs) (pushI bs)) closeI-checkHeaderLength len (C.SinkM msink) = C.SinkM $ liftM (checkHeaderLength len) msink+checkHeaderLength len (C.PipeM msink close) = C.PipeM (liftM (checkHeaderLength len) msink) close checkHeaderLength _ s@C.Done{} = s+checkHeaderLength _ (C.HaveOutput _ _ o) = absurd o getResponse :: MonadResource m => ConnRelease m -> Request m- -> C.BufferedSource m S8.ByteString+ -> C.Source m S8.ByteString -> m (Response (C.Source m S8.ByteString))-getResponse connRelease req@(Request {..}) bsrc = do- ((vbs, sc, sm), hs) <- bsrc C.$$ checkHeaderLength 4096 sinkHeaders+getResponse connRelease req@(Request {..}) src1 = do+ (src2, ((vbs, sc, sm), hs)) <- src1 C.$$+ 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@@ -145,18 +150,18 @@ cleanup True return mempty else do- let bsrc' =+ let src3 = if ("transfer-encoding", "chunked") `elem` hs'- then bsrc C.$= chunkedConduit rawBody+ then src2 C.$= chunkedConduit rawBody else case mcl of- Just len -> bsrc C.$= CB.isolate len- Nothing -> C.unbufferSource bsrc- let bsrc'' =+ Just len -> src2 C.$= CB.isolate len+ Nothing -> src2+ let src4 = if needsGunzip req hs'- then bsrc' C.$= CZ.ungzip- else bsrc'- return $ addCleanup cleanup bsrc''+ then src3 C.$= CZ.ungzip+ else src3+ return $ addCleanup cleanup src4 return $ Response s version hs' body @@ -166,13 +171,16 @@ => (Bool -> m ()) -> C.Source m a -> C.Source m a-addCleanup cleanup C.Closed = C.SourceM- (cleanup True >> return C.Closed)+addCleanup cleanup (C.Done leftover ()) = C.PipeM+ (cleanup True >> return (C.Done leftover ())) (cleanup True)-addCleanup cleanup (C.Open src close x) = C.Open+addCleanup cleanup (C.HaveOutput src close x) = C.HaveOutput (addCleanup cleanup src) (cleanup False >> close) x-addCleanup cleanup (C.SourceM msrc close) = C.SourceM+addCleanup cleanup (C.PipeM msrc close) = C.PipeM (liftM (addCleanup cleanup) msrc) (cleanup False >> close)+addCleanup cleanup (C.NeedInput p c) = C.NeedInput+ (addCleanup cleanup . p)+ (addCleanup cleanup c)
http-conduit.cabal view
@@ -1,5 +1,5 @@ name: http-conduit-version: 1.3.0.1+version: 1.4.0 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -20,13 +20,13 @@ library build-depends: base >= 4 && < 5 , bytestring >= 0.9.1.4 && < 0.10- , transformers >= 0.2 && < 0.3+ , transformers >= 0.2 && < 0.4 , failure >= 0.1 , resourcet >= 0.3 && < 0.4- , conduit >= 0.3 && < 0.4- , zlib-conduit >= 0.3 && < 0.4- , blaze-builder-conduit >= 0.3 && < 0.4- , attoparsec-conduit >= 0.3 && < 0.4+ , conduit >= 0.4 && < 0.5+ , zlib-conduit >= 0.4 && < 0.5+ , blaze-builder-conduit >= 0.4 && < 0.5+ , attoparsec-conduit >= 0.4 && < 0.5 , attoparsec >= 0.8.0.2 && < 0.11 , utf8-string >= 0.3.4 && < 0.4 , blaze-builder >= 0.2.1 && < 0.4@@ -40,13 +40,14 @@ , case-insensitive >= 0.2 , base64-bytestring >= 0.1 && < 0.2 , asn1-data >= 0.5.1 && < 0.7- , data-default >= 0.3 && < 0.4+ , data-default >= 0.3 && < 0.5 , text , transformers-base >= 0.4 && < 0.5 , lifted-base >= 0.1 && < 0.2 , socks >= 0.4 && < 0.5 , time , cookie >= 0.4 && < 0.5+ , void >= 0.5.5 && < 0.6 , regex-compat , mtl if flag(network-bytestring)@@ -111,6 +112,7 @@ , regex-compat , network-conduit , resourcet+ , void source-repository head type: git
test/main.hs view
@@ -17,11 +17,10 @@ import Control.Monad.Trans.Resource (register) import Control.Monad.IO.Class (liftIO) import Data.ByteString.UTF8 (fromString)-import Data.Conduit.List (sourceList, sinkNull)+import Data.Conduit.List (sourceList) import Data.CaseInsensitive (mk) import Data.List (partition) import qualified Data.Conduit.List as CL-import qualified Data.Conduit.Binary as CB app :: Application app req =@@ -38,12 +37,12 @@ describe "simpleHttp" $ do it "gets homepage" $ do tid <- forkIO $ run 3000 app- lbs <- simpleHttp "http://localhost:3000/"+ lbs <- simpleHttp "http://127.0.0.1:3000/" killThread tid lbs @?= "homepage" it "throws exception on 404" $ do tid <- forkIO $ run 3001 app- elbs <- try $ simpleHttp "http://localhost:3001/404"+ elbs <- try $ simpleHttp "http://127.0.0.1:3001/404" killThread tid case elbs of Left (_ :: SomeException) -> return ()@@ -51,7 +50,7 @@ describe "httpLbs" $ do it "preserves 'set-cookie' headers" $ do tid <- forkIO $ run 3010 app- request <- parseUrl "http://localhost:3010/cookies"+ request <- parseUrl "http://127.0.0.1:3010/cookies" withManager $ \manager -> do Response _ _ headers _ <- httpLbs request manager let setCookie = mk (fromString "Set-Cookie")@@ -65,8 +64,8 @@ tid2 <- forkIO $ run 3003 app threadDelay 1000 withManager $ \manager -> do- let Just req1 = parseUrl "http://localhost:3002/"- let Just req2 = parseUrl "http://localhost:3003/"+ let Just req1 = parseUrl "http://127.0.0.1:3002/"+ let Just req2 = parseUrl "http://127.0.0.1:3003/" _res1a <- http req1 manager _res1b <- http req1 manager _res2 <- http req2 manager@@ -80,7 +79,7 @@ threadDelay 1000 withManager $ \manager -> do _ <- register $ killThread tid1- let Just req1 = parseUrl "http://localhost:3004/"+ let Just req1 = parseUrl "http://127.0.0.1:3004/" res1 <- try $ http req1 manager case res1 of Left e -> liftIO $ show (e :: SomeException) @?= show OverlongHeaders@@ -90,7 +89,7 @@ threadDelay 1000 withManager $ \manager -> do _ <- register $ killThread tid1- let Just req1 = parseUrl "http://localhost:3005/"+ let Just req1 = parseUrl "http://127.0.0.1:3005/" _ <- httpLbs req1 manager return ()