@@ -5,12 +5,15 @@
55module RequestSpec (main, spec) where
66
77import Data.Conduit
8−import Data.Conduit.List
8+import qualified Data.Conduit.Binary as CB
9+import Data.Conduit.List (sourceList)
910import Network.Wai.Handler.Warp.Request
1011import Network.Wai.Handler.Warp.RequestHeader (parseByteRanges)
1112import Network.Wai.Handler.Warp.Types
1213import Test.Hspec
14+import Test.Hspec.QuickCheck
1315import qualified Data.ByteString.Char8 as S8
16+import qualified Data.ByteString.Lazy as L
1417import qualified Network.HTTP.Types.Header as HH
1518
1619deriving instance Show HH.ByteRange
@@ -30,6 +33,30 @@ spec = do
3033 tooMany `shouldThrow` overLargeHeader
3134 it "throws OverLargeHeader when too large" $
3235 tooLarge `shouldThrow` overLargeHeader
36+ it "known bad chunking behavior #239" $ do
37+ let chunks =
38+ [ "GET / HTTP/1.1\r\nConnection: Close\r"
39+ , "\n\r\n"
40+ ]
41+ (mleftover, actual) <- mapM_ yield chunks $$ headerLines
42+ mleftover `shouldBe` Nothing
43+ actual `shouldBe` ["GET / HTTP/1.1", "Connection: Close"]
44+ prop "random chunking" $ \breaks extraS -> do
45+ let bsFull = "GET / HTTP/1.1\r\nConnection: Close\r\n\r\n" `S8.append` extra
46+ extra = S8.pack extraS
47+ chunks = loop breaks bsFull
48+ loop [] bs = [bs, undefined]
49+ loop (x:xs) bs =
50+ bs1 : loop xs bs2
51+ where
52+ (bs1, bs2) = S8.splitAt ((x `mod` 10) + 1) bs
53+ (leftover, actual) <- mapM_ yield chunks $$ do
54+ (_, actual) <- headerLines
55+ x' <- CB.take (length extraS)
56+ let x = S8.concat $ L.toChunks x'
57+ return (x, actual)
58+ actual `shouldBe` ["GET / HTTP/1.1", "Connection: Close"]
59+ leftover `shouldBe` extra
3360 describe "parseByteRanges" $ do
3461 let test x y = it x $ parseByteRanges (S8.pack x) `shouldBe` y
3562 test "bytes=0-499" $ Just [HH.ByteRangeFromTo 0 499]