1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
module RequestSpec (main, spec) where
import Network.Wai.Handler.Warp.Request
import Network.Wai.Handler.Warp.RequestHeader (parseByteRanges)
import Network.Wai.Handler.Warp.Types
import Test.Hspec
import Test.Hspec.QuickCheck
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Network.HTTP.Types.Header as HH
import Data.IORef
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
describe "headerLines" $ do
it "takes until blank" $
blankSafe >>= (`shouldBe` ("", ["foo", "bar", "baz"]))
it "ignored leading whitespace in bodies" $
whiteSafe >>= (`shouldBe` (" hi there", ["foo", "bar", "baz"]))
it "throws OverLargeHeader when too many" $
tooMany `shouldThrow` overLargeHeader
it "throws OverLargeHeader when too large" $
tooLarge `shouldThrow` overLargeHeader
it "known bad chunking behavior #239" $ do
let chunks =
[ "GET / HTTP/1.1\r\nConnection: Close\r"
, "\n\r\n"
]
(actual, src) <- headerLinesList' chunks
leftover <- readLeftoverSource src
leftover `shouldBe` S.empty
actual `shouldBe` ["GET / HTTP/1.1", "Connection: Close"]
prop "random chunking" $ \breaks extraS -> do
let bsFull = "GET / HTTP/1.1\r\nConnection: Close\r\n\r\n" `S8.append` extra
extra = S8.pack extraS
chunks = loop breaks bsFull
loop [] bs = [bs, undefined]
loop (x:xs) bs =
bs1 : loop xs bs2
where
(bs1, bs2) = S8.splitAt ((x `mod` 10) + 1) bs
(actual, src) <- headerLinesList' chunks
leftover <- consumeLen (length extraS) src
actual `shouldBe` ["GET / HTTP/1.1", "Connection: Close"]
leftover `shouldBe` extra
describe "parseByteRanges" $ do
let test x y = it x $ parseByteRanges (S8.pack x) `shouldBe` y
test "bytes=0-499" $ Just [HH.ByteRangeFromTo 0 499]
test "bytes=500-999" $ Just [HH.ByteRangeFromTo 500 999]
test "bytes=-500" $ Just [HH.ByteRangeSuffix 500]
test "bytes=9500-" $ Just [HH.ByteRangeFrom 9500]
test "foobytes=9500-" Nothing
test "bytes=0-0,-1" $ Just [HH.ByteRangeFromTo 0 0, HH.ByteRangeSuffix 1]
where
blankSafe = headerLinesList ["f", "oo\n", "bar\nbaz\n\r\n"]
whiteSafe = headerLinesList ["foo\r\nbar\r\nbaz\r\n\r\n hi there"]
tooMany = headerLinesList $ repeat "f\n"
tooLarge = headerLinesList $ repeat "f"
headerLinesList :: [S8.ByteString] -> IO (S8.ByteString, [S8.ByteString])
headerLinesList orig = do
(res, src) <- headerLinesList' orig
leftover <- readLeftoverSource src
return (leftover, res)
headerLinesList' :: [S8.ByteString] -> IO ([S8.ByteString], Source)
headerLinesList' orig = do
ref <- newIORef orig
let src = do
x <- readIORef ref
case x of
[] -> return S.empty
y:z -> do
writeIORef ref z
return y
src' <- mkSource src
res <- headerLines src'
return (res, src')
consumeLen :: Int -> Source -> IO S8.ByteString
consumeLen len0 src =
loop id len0
where
loop front len
| len <= 0 = return $ S.concat $ front []
| otherwise = do
bs <- readSource src
if S.null bs
then loop front 0
else do
let (x, _) = S.splitAt len bs
loop (front . (x:)) (len - S.length x)
overLargeHeader :: Selector InvalidRequest
overLargeHeader e = e == OverLargeHeader
|
