git.iko.soy/typeable/wai
on mime-types-0.1.0.9 help sign in
typeable/wai/warp/test/RequestSpec.hs
145 lines 5.4 kB history raw
1{-# OPTIONS_GHC -fno-warn-orphans #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE StandaloneDeriving #-}
5module RequestSpec (main, spec) where
7import Network.Wai.Handler.Warp.File (parseByteRanges)
8import Network.Wai.Handler.Warp.Request
9import Network.Wai.Handler.Warp.Types
10import Test.Hspec
11import Test.Hspec.QuickCheck
12import qualified Data.ByteString as S
13import qualified Data.ByteString.Char8 as S8
14import qualified Network.HTTP.Types.Header as HH
15import Data.IORef
17main :: IO ()
18main = hspec spec
20spec :: Spec
21spec = do
22 describe "headerLines" $ do
23 it "takes until blank" $
24 blankSafe >>= (`shouldBe` ("", ["foo", "bar", "baz"]))
25 it "ignored leading whitespace in bodies" $
26 whiteSafe >>= (`shouldBe` (" hi there", ["foo", "bar", "baz"]))
27 it "throws OverLargeHeader when too many" $
28 tooMany `shouldThrow` overLargeHeader
29 it "throws OverLargeHeader when too large" $
30 tooLarge `shouldThrow` overLargeHeader
31 it "known bad chunking behavior #239" $ do
32 let chunks =
33 [ "GET / HTTP/1.1\r\nConnection: Close\r"
34 , "\n\r\n"
35 ]
36 (actual, src) <- headerLinesList' chunks
37 leftover <- readLeftoverSource src
38 leftover `shouldBe` S.empty
39 actual `shouldBe` ["GET / HTTP/1.1", "Connection: Close"]
40 prop "random chunking" $ \breaks extraS -> do
41 let bsFull = "GET / HTTP/1.1\r\nConnection: Close\r\n\r\n" `S8.append` extra
42 extra = S8.pack extraS
43 chunks = loop breaks bsFull
44 loop [] bs = [bs, undefined]
45 loop (x:xs) bs =
46 bs1 : loop xs bs2
47 where
48 (bs1, bs2) = S8.splitAt ((x `mod` 10) + 1) bs
49 (actual, src) <- headerLinesList' chunks
50 leftover <- consumeLen (length extraS) src
52 actual `shouldBe` ["GET / HTTP/1.1", "Connection: Close"]
53 leftover `shouldBe` extra
54 describe "parseByteRanges" $ do
55 let test x y = it x $ parseByteRanges (S8.pack x) `shouldBe` y
56 test "bytes=0-499" $ Just [HH.ByteRangeFromTo 0 499]
57 test "bytes=500-999" $ Just [HH.ByteRangeFromTo 500 999]
58 test "bytes=-500" $ Just [HH.ByteRangeSuffix 500]
59 test "bytes=9500-" $ Just [HH.ByteRangeFrom 9500]
60 test "foobytes=9500-" Nothing
61 test "bytes=0-0,-1" $ Just [HH.ByteRangeFromTo 0 0, HH.ByteRangeSuffix 1]
63 describe "headerLines" $ do
64 it "can handle a nomarl case" $ do
65 src <- mkSourceFunc ["Status: 200\r\nContent-Type: text/plain\r\n\r\n"] >>= mkSource
66 x <- headerLines True src
67 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]
69 it "can handle a nasty case (1)" $ do
70 src <- mkSourceFunc ["Status: 200", "\r\nContent-Type: text/plain", "\r\n\r\n"] >>= mkSource
71 x <- headerLines True src
72 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]
74 it "can handle a nasty case (1)" $ do
75 src <- mkSourceFunc ["Status: 200", "\r", "\nContent-Type: text/plain", "\r", "\n\r\n"] >>= mkSource
76 x <- headerLines True src
77 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]
79 it "can handle a nasty case (1)" $ do
80 src <- mkSourceFunc ["Status: 200", "\r", "\n", "Content-Type: text/plain", "\r", "\n", "\r", "\n"] >>= mkSource
81 x <- headerLines True src
82 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]
84 it "can handle an illegal case (1)" $ do
85 src <- mkSourceFunc ["\nStatus:", "\n 200", "\nContent-Type: text/plain", "\r\n\r\n"] >>= mkSource
86 x <- headerLines True src
87 x `shouldBe` []
88 y <- headerLines True src
89 y `shouldBe` ["Status: 200", "Content-Type: text/plain"]
91 where
92 blankSafe = headerLinesList ["f", "oo\n", "bar\nbaz\n\r\n"]
93 whiteSafe = headerLinesList ["foo\r\nbar\r\nbaz\r\n\r\n hi there"]
94 tooMany = headerLinesList $ repeat "f\n"
95 tooLarge = headerLinesList $ repeat "f"
97headerLinesList :: [S8.ByteString] -> IO (S8.ByteString, [S8.ByteString])
98headerLinesList orig = do
99 (res, src) <- headerLinesList' orig
100 leftover <- readLeftoverSource src
101 return (leftover, res)
103headerLinesList' :: [S8.ByteString] -> IO ([S8.ByteString], Source)
104headerLinesList' orig = do
105 ref <- newIORef orig
106 let src = do
107 x <- readIORef ref
108 case x of
109 [] -> return S.empty
110 y:z -> do
111 writeIORef ref z
112 return y
113 src' <- mkSource src
114 res <- headerLines True src'
115 return (res, src')
117consumeLen :: Int -> Source -> IO S8.ByteString
118consumeLen len0 src =
119 loop id len0
120 where
121 loop front len
122 | len <= 0 = return $ S.concat $ front []
123 | otherwise = do
124 bs <- readSource src
125 if S.null bs
126 then loop front 0
127 else do
128 let (x, _) = S.splitAt len bs
129 loop (front . (x:)) (len - S.length x)
131overLargeHeader :: Selector InvalidRequest
132overLargeHeader e = e == OverLargeHeader
134mkSourceFunc :: [S8.ByteString] -> IO (IO S8.ByteString)
135mkSourceFunc bss = do
136 ref <- newIORef bss
137 return $ reader ref
138 where
139 reader ref = do
140 xss <- readIORef ref
141 case xss of
142 [] -> return S.empty
143 (x:xs) -> do
144 writeIORef ref xs
145 return x