http-conduit 1.9.3 → 1.9.4
raw patch · 4 files changed
+64/−7 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Network.HTTP.Conduit: ResponseBodyTooShort :: Word64 -> Word64 -> HttpException
Files
- Network/HTTP/Conduit/Response.hs +27/−4
- Network/HTTP/Conduit/Types.hs +5/−0
- http-conduit.cabal +1/−1
- test/main.hs +31/−2
Network/HTTP/Conduit/Response.hs view
@@ -13,7 +13,7 @@ import Control.Monad (liftM) import Control.Exception (throwIO)-import Control.Monad.IO.Class (liftIO)+import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8@@ -23,10 +23,9 @@ import Data.Default (def) -import Data.Conduit hiding (Conduit)+import Data.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 Network.HTTP.Types as W@@ -160,7 +159,7 @@ then fmapResume ($= chunkedConduit rawBody) src2 else case mcl of- Just len -> fmapResume ($= CB.isolate len) src2+ Just len -> fmapResume ($= requireLength len) src2 Nothing -> src2 let src4 = if needsGunzip req hs'@@ -172,3 +171,27 @@ where fmapResume f (ResumableSource src m) = ResumableSource (f src) m addCleanup' f (ResumableSource src m) = ResumableSource (addCleanup f src) (m >> f False)++-- | Ensure that the stream has exactly the given length.+requireLength :: MonadIO m => Int -> Conduit S.ByteString m S.ByteString+requireLength total =+ loop total+ where+ loop 0 = return ()+ loop i =+ await >>= maybe+ (liftIO $ throwIO $ ResponseBodyTooShort+ (fromIntegral total)+ (fromIntegral $ total - i))+ go+ where+ go bs =+ case compare i l of+ EQ -> yield bs+ LT -> do+ let (x, y) = S.splitAt i bs+ leftover y+ yield x+ GT -> yield bs >> loop (i - l)+ where+ l = S.length bs
Network/HTTP/Conduit/Types.hs view
@@ -16,6 +16,7 @@ ) where import Data.Int (Int64)+import Data.Word (Word64) import Data.Typeable (Typeable) import Blaze.ByteString.Builder@@ -193,6 +194,10 @@ | ProxyConnectException S.ByteString Int (Either S.ByteString HttpException) -- ^ host/port | NoResponseDataReceived | TlsException SomeException+ | ResponseBodyTooShort Word64 Word64+ -- ^ Expected size/actual size.+ --+ -- Since 1.9.4 deriving (Show, Typeable) instance Exception HttpException
http-conduit.cabal view
@@ -1,5 +1,5 @@ name: http-conduit-version: 1.9.3+version: 1.9.4 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>
test/main.hs view
@@ -11,7 +11,7 @@ import Network.HTTP.Conduit hiding (port) import qualified Network.HTTP.Conduit as NHC import Network.HTTP.Conduit.MultipartFormData-import Control.Concurrent (forkIO, killThread, putMVar, takeMVar, newEmptyMVar)+import Control.Concurrent (forkIO, killThread, putMVar, takeMVar, newEmptyMVar, threadDelay) import Network.HTTP.Types import Control.Exception.Lifted (try, SomeException, bracket, onException, IOException) import qualified Data.IORef as I@@ -24,7 +24,7 @@ import Data.Conduit.Network (runTCPServer, serverSettings, HostPreference (..), appSink, appSource, bindPort, serverAfterBind, ServerSettings) import qualified Data.Conduit.Network import System.IO.Unsafe (unsafePerformIO)-import Data.Conduit (($$), yield, Flush (Chunk), runResourceT, await)+import Data.Conduit (($$), yield, Flush (Chunk, Flush), runResourceT, await) import Control.Monad (void, forever) import Control.Monad.IO.Class (liftIO) import Data.ByteString.UTF8 (fromString)@@ -82,6 +82,10 @@ [(hLocation, S.append "/infredir/" $ S8.pack $ show $ i+1)] (L8.pack $ show i) ["dump_cookies"] -> return $ responseLBS status200 [] $ L.fromChunks $ return $ maybe "" id $ lookup hCookie $ Wai.requestHeaders req+ ["delayed"] -> return $ ResponseSource status200 [("foo", "bar")] $ do+ yield Flush+ liftIO $ threadDelay 30000000+ yield $ Chunk $ fromByteString "Hello World!" _ -> return $ responseLBS status404 [] "not found" where tastyCookie = (mk (fromString "Set-Cookie"), fromString "flavor=chocolate-chip;")@@ -239,6 +243,14 @@ Network.HTTP.Conduit.responseStatus res `shouldBe` status200 responseBody res `shouldBe` "foo" + describe "response body too short" $ do+ it "throws an exception" $ wrongLength $ \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 $ ResponseBodyTooShort 50 18)+ describe "redirect" $ do it "ignores large response bodies" $ do let app' port req =@@ -297,6 +309,13 @@ _ <- httpLbs req2 man return () + describe "delayed body" $ do+ it "works" $ withApp app $ \port -> do+ req <- parseUrl $ "http://localhost:" ++ show port ++ "/delayed"+ withManager $ \man -> do+ _ <- http req man+ return ()+ withCApp :: Data.Conduit.Network.Application IO -> (Int -> IO ()) -> IO () withCApp app' f = do port <- getPort@@ -366,3 +385,13 @@ withCApp $ \app' -> src $$ appSink app' where src = yield "HTTP/1.0 200\r\nContent-Length: 3\r\n\r\nfoo: barbazbin"++wrongLength :: (Int -> IO ()) -> IO ()+wrongLength =+ withCApp $ \app' -> do+ _ <- appSource app' $$ await+ src $$ appSink app'+ where+ src = do+ yield "HTTP/1.0 200 OK\r\nContent-Length: 50\r\n\r\n"+ yield "Not quite 50 bytes"