git.iko.soy/typeable/wai
on wai-app-static-3.1.6.3 help sign in
typeable/wai/warp/test/ResponseSpec.hs
117 lines 4.4 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
3module ResponseSpec (main, spec) where
5import Control.Concurrent (threadDelay)
6import qualified Data.ByteString as S
7import qualified Data.ByteString.Char8 as S8
8import Data.Maybe (mapMaybe)
9import Network.HTTP.Types
10import Network.Wai hiding (responseHeaders)
11import Network.Wai.Handler.Warp
12import Network.Wai.Handler.Warp.Response
13import RunSpec (withApp)
14import System.IO (hClose, hFlush)
15import Test.Hspec
17-- import HTTP
18import RunSpec (connectTo)
20main :: IO ()
21main = hspec spec
23testRange :: S.ByteString -- ^ range value
24 -> String -- ^ expected output
25 -> Maybe String -- ^ expected content-range value
26 -> Spec
27testRange range out crange = it title $ withApp defaultSettings app $ \port -> do
28 handle <- connectTo "127.0.0.1" port
29 S.hPutStr handle "GET / HTTP/1.0\r\n"
30 S.hPutStr handle "Range: bytes="
31 S.hPutStr handle range
32 S.hPutStr handle "\r\n\r\n"
33 hFlush handle
34 threadDelay 10000
35 bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ S.hGetSome handle 1024
36 hClose handle
37 last bss `shouldBe` out
38 let hs = mapMaybe toHeader bss
39 lookup "Content-Range" hs `shouldBe` fmap ("bytes " ++) crange
40 lookup "Content-Length" hs `shouldBe` Just (show $ length $ last bss)
41 where
42 app _ = ($ responseFile status200 [] "attic/hex" Nothing)
43 title = show (range, out, crange)
44 toHeader s =
45 case break (== ':') s of
46 (x, ':':y) -> Just (x, dropWhile (== ' ') y)
47 _ -> Nothing
49testPartial :: Integer -- ^ file size
50 -> Integer -- ^ offset
51 -> Integer -- ^ byte count
52 -> String -- ^ expected output
53 -> Spec
54testPartial size offset count out = it title $ withApp defaultSettings app $ \port -> do
55 handle <- connectTo "127.0.0.1" port
56 S.hPutStr handle "GET / HTTP/1.0\r\n\r\n"
57 hFlush handle
58 threadDelay 10000
59 bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ S.hGetSome handle 1024
60 hClose handle
61 out `shouldBe` last bss
62 let hs = mapMaybe toHeader bss
63 lookup "Content-Length" hs `shouldBe` Just (show $ length $ last bss)
64 lookup "Content-Range" hs `shouldBe` Just range
65 where
66 app _ = ($ responseFile status200 [] "attic/hex" $ Just $ FilePart offset count size)
67 title = show (offset, count, out)
68 toHeader s =
69 case break (== ':') s of
70 (x, ':':y) -> Just (x, dropWhile (== ' ') y)
71 _ -> Nothing
72 range = "bytes " ++ show offset ++ "-" ++ show (offset + count - 1) ++ "/" ++ show size
74spec :: Spec
75spec = do
76{- http-client does not support this.
77 describe "preventing response splitting attack" $ do
78 it "sanitizes header values" $ do
79 let app _ respond = respond $ responseLBS status200 [("foo", "foo\r\nbar")] "Hello"
80 withApp defaultSettings app $ \port -> do
81 res <- sendGET $ "http://127.0.0.1:" ++ show port
82 getHeaderValue "foo" (responseHeaders res) `shouldBe`
83 Just "foo bar" -- HTTP inserts two spaces for \r\n.
84-}
86 describe "sanitizeHeaderValue" $ do
87 it "doesn't alter valid multiline header values" $ do
88 sanitizeHeaderValue "foo\r\n bar" `shouldBe` "foo\r\n bar"
90 it "adds missing spaces after \r\n" $ do
91 sanitizeHeaderValue "foo\r\nbar" `shouldBe` "foo\r\n bar"
93 it "discards empty lines" $ do
94 sanitizeHeaderValue "foo\r\n\r\nbar" `shouldBe` "foo\r\n bar"
96 context "when sanitizing single occurences of \n" $ do
97 it "replaces \n with \r\n" $ do
98 sanitizeHeaderValue "foo\n bar" `shouldBe` "foo\r\n bar"
100 it "adds missing spaces after \n" $ do
101 sanitizeHeaderValue "foo\nbar" `shouldBe` "foo\r\n bar"
103 it "discards single occurrences of \r" $ do
104 sanitizeHeaderValue "foo\rbar" `shouldBe` "foobar"
106 describe "range requests" $ do
107 testRange "2-3" "23" $ Just "2-3/16"
108 testRange "5-" "56789abcdef" $ Just "5-15/16"
109 testRange "5-8" "5678" $ Just "5-8/16"
110 testRange "-3" "def" $ Just "13-15/16"
111 testRange "16-" "" $ Just "*/16"
112 testRange "-17" "0123456789abcdef" Nothing
114 describe "partial files" $ do
115 testPartial 16 2 2 "23"
116 testPartial 16 0 2 "01"
117 testPartial 16 3 8 "3456789a"