http-conduit 1.9.4 → 1.9.4.1

raw patch · 7 files changed

+92/−15 lines, 7 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• Network/HTTP/Conduit/Chunk.hs +10/−7
• Network/HTTP/Conduit/ConnInfo.hs +1/−2
• Network/HTTP/Conduit/MultipartFormData.hs +5/−3
• Network/HTTP/Conduit/Request.hs +1/−2
• Network/HTTP/Conduit/Types.hs +4/−0
• http-conduit.cabal +1/−1
• test/main.hs +70/−0

@@ -17,20 +17,23 @@  import Control.Monad (when, unless) import Control.Exception (assert)+import Data.Maybe (fromMaybe)+import Network.HTTP.Conduit.Types (HttpException (InvalidChunkHeaders))  chunkedConduit :: MonadThrow m                => Bool -- ^ send the headers as well, necessary for a proxy                -> Conduit S.ByteString m S.ByteString chunkedConduit sendHeaders = do-    i <- getLen+    mi <- getLen+    i <- maybe (monadThrow InvalidChunkHeaders) return mi     when sendHeaders $ yield $ S8.pack $ showHex i "\r\n"-    unless (i == 0) $ do-        CB.isolate i-        CB.drop 2-        chunkedConduit sendHeaders+    CB.isolate i+    CB.drop 2+    when sendHeaders $ yield $ S8.pack "\r\n"+    unless (i == 0) $ chunkedConduit sendHeaders   where     getLen =-        start 0+        start Nothing       where         start i = await >>= maybe (return i) (go i) @@ -39,7 +42,7 @@                 Nothing -> start i                 Just (w, bs') ->                     case toI w of-                        Just i' -> go (i * 16 + i') bs'+                        Just i' -> go (Just $ fromMaybe 0 i * 16 + i') bs'                         Nothing -> do                             stripNewLine bs                             return i

@@ -146,8 +146,7 @@ #if DEBUG             removeSocket i #endif-            bye istate-            hClose h+            bye istate `E.finally` hClose h         }   where     recvD istate = do

@@ -11,13 +11,15 @@ -- > import Control.Monad -- > -- > main = withSocketsDo $ withManager $ \m -> do--- >     Response{responseBody=cat} <- flip httpLbs m $ fromJust $ parseUrl "http://random-cat-photo.net/cat.jpg"+-- >     req1 <- parseUrl "http://random-cat-photo.net/cat.jpg"+-- >     res <- httpLbs req1 m+-- >     req2 <- parseUrl "http://example.org/~friedrich/blog/addPost.hs" -- >     flip httpLbs m =<< -- >         (formDataBody [partBS "title" "Bleaurgh" -- >                       ,partBS "text" $ TE.encodeUtf8 "矢田矢田矢田矢田矢田" -- >                       ,partFileSource "file1" "/home/friedrich/Photos/MyLittlePony.jpg"--- >                       ,partFileRequestBody "file2" "cat.jpg" $ RequestBodyLBS cat]--- >             $ fromJust $ parseUrl "http://example.org/~friedrich/blog/addPost.hs")+-- >                       ,partFileRequestBody "file2" "cat.jpg" $ RequestBodyLBS $ responseBody res]+-- >             req2) module Network.HTTP.Conduit.MultipartFormData     (     -- * Part type

@@ -44,7 +44,6 @@ import Control.Monad.IO.Class (liftIO) import Control.Exception.Lifted (Exception, toException, throwIO) import Control.Failure (Failure (failure))-import Codec.Binary.UTF8.String (encodeString) import qualified Data.CaseInsensitive as CI import qualified Data.ByteString.Base64 as B64 @@ -68,7 +67,7 @@         Just uri -> setUri def uri         Nothing  -> failure $ InvalidUrlException s "Invalid URL"   where-    encode = escapeURIString isAllowedInURI . encodeString+    encode = escapeURIString isAllowedInURI  -- | Add a 'URI' to the request. If it is absolute (includes a host name), add -- it as per 'setUri'; if it is relative, merge it with the existing request.

@@ -198,6 +198,10 @@                    -- ^ Expected size/actual size.                    --                    -- Since 1.9.4+                   | InvalidChunkHeaders+                   -- ^+                   --+                   -- Since 1.9.4     deriving (Show, Typeable) instance Exception HttpException 

@@ -1,5 +1,5 @@ name:            http-conduit-version:         1.9.4+version:         1.9.4.1 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>

@@ -251,6 +251,44 @@                 liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres                  `shouldBe` Left (show $ ResponseBodyTooShort 50 18) +    describe "chunked response body" $ do+        it "no chunk terminator" $ wrongLengthChunk1 $ \port -> do+            req <- parseUrl $ "http://127.0.0.1:" ++ show port+            withManager $ \manager -> do+                eres <- try $ httpLbs req manager+                liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres+                 `shouldBe` Left (show InvalidChunkHeaders)+        it "incomplete chunk" $ wrongLengthChunk2 $ \port -> do+            req <- parseUrl $ "http://127.0.0.1:" ++ show port+            withManager $ \manager -> do+                eres <- try $ httpLbs req manager+                liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres+                 `shouldBe` Left (show InvalidChunkHeaders)+        it "invalid chunk" $ invalidChunk $ \port -> do+            req <- parseUrl $ "http://127.0.0.1:" ++ show port+            withManager $ \manager -> do+                eres <- try $ httpLbs req manager+                liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres+                 `shouldBe` Left (show InvalidChunkHeaders)++        it "missing header" $ rawApp+          "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n4\r\nabcd\r\n\r\n\r\n"+          $ \port -> do+            req <- parseUrl $ "http://127.0.0.1:" ++ show port+            withManager $ \manager -> do+                eres <- try $ httpLbs req manager+                liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres+                 `shouldBe` Left (show InvalidChunkHeaders)++        it "junk header" $ rawApp+          "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n4\r\nabcd\r\njunk\r\n\r\n"+          $ \port -> do+            req <- parseUrl $ "http://127.0.0.1:" ++ show port+            withManager $ \manager -> do+                eres <- try $ httpLbs req manager+                liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres+                 `shouldBe` Left (show InvalidChunkHeaders)+     describe "redirect" $ do         it "ignores large response bodies" $ do             let app' port req =@@ -395,3 +433,35 @@     src = do         yield "HTTP/1.0 200 OK\r\nContent-Length: 50\r\n\r\n"         yield "Not quite 50 bytes"++wrongLengthChunk1 :: (Int -> IO ()) -> IO ()+wrongLengthChunk1 =+    withCApp $ \app' -> do+        _ <- appSource app' $$ await+        src $$ appSink app'+  where+    src = yield "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n4\r\nWiki\r\n"++wrongLengthChunk2 :: (Int -> IO ()) -> IO ()+wrongLengthChunk2 =+    withCApp $ \app' -> do+        _ <- appSource app' $$ await+        src $$ appSink app'+  where+    src = yield "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n4\r\nWiki\r\n5\r\npedia\r\nE\r\nin\r\n\r\nch\r\n"++invalidChunk :: (Int -> IO ()) -> IO ()+invalidChunk =+    withCApp $ \app' -> do+        _ <- appSource app' $$ await+        src $$ appSink app'+  where+    src = yield "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n4\r\nabcd\r\ngarbage\r\nef\r\n0\r\n\r\n"++rawApp :: S8.ByteString -> (Int -> IO ()) -> IO ()+rawApp bs =+    withCApp $ \app' -> do+        _ <- appSource app' $$ await+        src $$ appSink app'+  where+    src = yield bs