git.iko.soy/typeable/wai
on wai-extra/2.1.1.3 help sign in
typeable/wai/warp/test/RequestSpec.hs
72 lines 2.9 kB history raw
1{-# OPTIONS_GHC -fno-warn-orphans #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE StandaloneDeriving #-}
5module RequestSpec (main, spec) where
7import Data.Conduit
8import qualified Data.Conduit.Binary as CB
9import Data.Conduit.List (sourceList)
10import Network.Wai.Handler.Warp.Request
11import Network.Wai.Handler.Warp.RequestHeader (parseByteRanges)
12import Network.Wai.Handler.Warp.Types
13import Test.Hspec
14import Test.Hspec.QuickCheck
15import qualified Data.ByteString.Char8 as S8
16import qualified Data.ByteString.Lazy as L
17import qualified Network.HTTP.Types.Header as HH
19main :: IO ()
20main = hspec spec
22spec :: Spec
23spec = do
24 describe "headerLines" $ do
25 it "takes until blank" $
26 blankSafe >>= (`shouldBe` (Nothing, ["foo", "bar", "baz"]))
27 it "ignored leading whitespace in bodies" $
28 whiteSafe >>= (`shouldBe` (Just " hi there", ["foo", "bar", "baz"]))
29 it "throws OverLargeHeader when too many" $
30 tooMany `shouldThrow` overLargeHeader
31 it "throws OverLargeHeader when too large" $
32 tooLarge `shouldThrow` overLargeHeader
33 it "known bad chunking behavior #239" $ do
34 let chunks =
35 [ "GET / HTTP/1.1\r\nConnection: Close\r"
36 , "\n\r\n"
37 ]
38 (mleftover, actual) <- mapM_ yield chunks $$ headerLines
39 mleftover `shouldBe` Nothing
40 actual `shouldBe` ["GET / HTTP/1.1", "Connection: Close"]
41 prop "random chunking" $ \breaks extraS -> do
42 let bsFull = "GET / HTTP/1.1\r\nConnection: Close\r\n\r\n" `S8.append` extra
43 extra = S8.pack extraS
44 chunks = loop breaks bsFull
45 loop [] bs = [bs, undefined]
46 loop (x:xs) bs =
47 bs1 : loop xs bs2
48 where
49 (bs1, bs2) = S8.splitAt ((x `mod` 10) + 1) bs
50 (leftover, actual) <- mapM_ yield chunks $$ do
51 (_, actual) <- headerLines
52 x' <- CB.take (length extraS)
53 let x = S8.concat $ L.toChunks x'
54 return (x, actual)
55 actual `shouldBe` ["GET / HTTP/1.1", "Connection: Close"]
56 leftover `shouldBe` extra
57 describe "parseByteRanges" $ do
58 let test x y = it x $ parseByteRanges (S8.pack x) `shouldBe` y
59 test "bytes=0-499" $ Just [HH.ByteRangeFromTo 0 499]
60 test "bytes=500-999" $ Just [HH.ByteRangeFromTo 500 999]
61 test "bytes=-500" $ Just [HH.ByteRangeSuffix 500]
62 test "bytes=9500-" $ Just [HH.ByteRangeFrom 9500]
63 test "foobytes=9500-" Nothing
64 test "bytes=0-0,-1" $ Just [HH.ByteRangeFromTo 0 0, HH.ByteRangeSuffix 1]
65 where
66 blankSafe = (sourceList ["f", "oo\n", "bar\nbaz\n\r\n"]) $$ headerLines
67 whiteSafe = (sourceList ["foo\r\nbar\r\nbaz\r\n\r\n hi there"]) $$ headerLines
68 tooMany = (sourceList $ repeat "f\n") $$ headerLines
69 tooLarge = (sourceList $ repeat "f") $$ headerLines
71overLargeHeader :: Selector InvalidRequest
72overLargeHeader e = e == OverLargeHeader