git.iko.soy/typeable/wai
on wai-extra/0.2.2 help sign in
typeable/wai/runtests.hs
196 lines 7.4 kB history raw
1import Test.Framework (defaultMain, testGroup, Test)
2import Test.Framework.Providers.HUnit
3import Test.HUnit hiding (Test)
5import Network.Wai
6import Network.Wai.Parse
7import qualified Data.ByteString.Char8 as S8
8import qualified Data.ByteString.Lazy.Char8 as L8
9import Control.Arrow
11main :: IO ()
12main = defaultMain [testSuite]
14testSuite :: Test
15testSuite = testGroup "Network.Wai.Parse"
16 [ testCase "parseQueryString" caseParseQueryString
17 , testCase "parseQueryString with question mark" caseParseQueryStringQM
18 , testCase "parseCookies" caseParseCookies
19 , testCase "parseHttpAccept" caseParseHttpAccept
20 , testCase "parseRequestBody" caseParseRequestBody
21 , testCase "findBound" caseFindBound
22 , testCase "sinkTillBound" caseSinkTillBound
23 ]
25caseParseQueryString :: Assertion
26caseParseQueryString = do
27 let go l r =
28 map (S8.pack *** S8.pack) l @=? parseQueryString (S8.pack r)
30 go [] ""
31 go [("foo", "")] "foo"
32 go [("foo", "bar")] "foo=bar"
33 go [("foo", "bar"), ("baz", "bin")] "foo=bar&baz=bin"
34 go [("%Q", "")] "%Q"
35 go [("%1Q", "")] "%1Q"
36 go [("%1", "")] "%1"
37 go [("/", "")] "%2F"
38 go [("/", "")] "%2f"
39 go [("foo bar", "")] "foo+bar"
41caseParseQueryStringQM :: Assertion
42caseParseQueryStringQM = do
43 let go l r =
44 map (S8.pack *** S8.pack) l
45 @=? parseQueryString (S8.pack $ '?' : r)
47 go [] ""
48 go [("foo", "")] "foo"
49 go [("foo", "bar")] "foo=bar"
50 go [("foo", "bar"), ("baz", "bin")] "foo=bar&baz=bin"
51 go [("%Q", "")] "%Q"
52 go [("%1Q", "")] "%1Q"
53 go [("%1", "")] "%1"
54 go [("/", "")] "%2F"
55 go [("/", "")] "%2f"
56 go [("foo bar", "")] "foo+bar"
58caseParseCookies :: Assertion
59caseParseCookies = do
60 let input = S8.pack "a=a1;b=b2; c=c3"
61 expected = [("a", "a1"), ("b", "b2"), ("c", "c3")]
62 map (S8.pack *** S8.pack) expected @=? parseCookies input
64caseParseHttpAccept :: Assertion
65caseParseHttpAccept = do
66 let input =
67 S8.pack "text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c"
68 expected = ["text/html", "text/x-c", "text/x-dvi", "text/plain"]
69 map S8.pack expected @=? parseHttpAccept input
71caseParseRequestBody :: Assertion
72caseParseRequestBody = t where
73 content2 = S8.pack $
74 "--AaB03x\n" ++
75 "Content-Disposition: form-data; name=\"document\"; filename=\"b.txt\"\n" ++
76 "Content-Type: text/plain; charset=iso-8859-1\n\n" ++
77 "This is a file.\n" ++
78 "It has two lines.\n" ++
79 "--AaB03x\n" ++
80 "Content-Disposition: form-data; name=\"title\"\n" ++
81 "Content-Type: text/plain; charset=iso-8859-1\n\n" ++
82 "A File\n" ++
83 "--AaB03x\n" ++
84 "Content-Disposition: form-data; name=\"summary\"\n" ++
85 "Content-Type: text/plain; charset=iso-8859-1\n\n" ++
86 "This is my file\n" ++
87 "file test\n" ++
88 "--AaB03x--"
89 content3 = S8.pack "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\nContent-Disposition: form-data; name=\"yaml\"; filename=\"README\"\r\nContent-Type: application/octet-stream\r\n\r\nPhoto blog using Hack.\n\r\n------WebKitFormBoundaryB1pWXPZ6lNr8RiLh--\r\n"
90 t = do
91 let content1 = S8.pack "foo=bar&baz=bin"
92 let ctype1 = S8.pack "application/x-www-form-urlencoded"
93 result1 <- parseRequestBody lbsSink $ toRequest ctype1 content1
94 assertEqual "parsing post x-www-form-urlencoded"
95 (map (S8.pack *** S8.pack) [("foo", "bar"), ("baz", "bin")], [])
96 result1
98 let ctype2 = S8.pack "multipart/form-data; boundary=AaB03x"
99 result2 <- parseRequestBody lbsSink $ toRequest ctype2 content2
100 let expectedsmap2 =
101 [ ("title", "A File")
102 , ("summary", "This is my file\nfile test")
103 ]
104 let textPlain = S8.pack $ "text/plain; charset=iso-8859-1"
105 let expectedfile2 =
106 [(S8.pack "document", FileInfo (S8.pack "b.txt") textPlain $ L8.pack
107 "This is a file.\nIt has two lines.")]
108 let expected2 = (map (S8.pack *** S8.pack) expectedsmap2, expectedfile2)
109 assertEqual "parsing post multipart/form-data"
110 expected2
111 result2
113 let ctype3 = S8.pack "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh"
114 result3 <- parseRequestBody lbsSink $ toRequest ctype3 content3
115 let expectedsmap3 = []
116 let expectedfile3 = [(S8.pack "yaml", FileInfo (S8.pack "README") (S8.pack "application/octet-stream") $
117 L8.pack "Photo blog using Hack.\n")]
118 let expected3 = (expectedsmap3, expectedfile3)
119 assertEqual "parsing actual post multipart/form-data"
120 expected3
121 result3
123 result2' <- parseRequestBody lbsSink $ toRequest' ctype2 content2
124 assertEqual "parsing post multipart/form-data 2"
125 expected2
126 result2'
128 result3' <- parseRequestBody lbsSink $ toRequest' ctype3 content3
129 assertEqual "parsing actual post multipart/form-data 2"
130 expected3
131 result3'
133toRequest :: S8.ByteString -> S8.ByteString -> Request
134toRequest ctype content = Request
135 { requestHeaders = [(ReqContentType, ctype)]
136 , requestBody = toSource content
137 , requestMethod = undefined
138 , httpVersion = undefined
139 , pathInfo = undefined
140 , queryString = undefined
141 , serverName = undefined
142 , serverPort = undefined
143 , urlScheme = undefined
144 , errorHandler = undefined
145 , remoteHost = undefined
146 }
148toRequest' :: S8.ByteString -> S8.ByteString -> Request
149toRequest' ctype content = Request
150 { requestHeaders = [(ReqContentType, ctype)]
151 , requestBody = toSource' content
152 , requestMethod = undefined
153 , httpVersion = undefined
154 , pathInfo = undefined
155 , queryString = undefined
156 , serverName = undefined
157 , serverPort = undefined
158 , urlScheme = undefined
159 , errorHandler = undefined
160 , remoteHost = undefined
161 }
163toSource :: S8.ByteString -> Source
164toSource bs = Source $
165 case S8.uncons bs of
166 Nothing -> return Nothing
167 Just (x, xs) -> return $ Just (S8.singleton x, toSource xs)
169toSource' :: S8.ByteString -> Source
170toSource' bs = Source $ return $ Just (bs, Source $ return Nothing)
172caseFindBound :: Assertion
173caseFindBound = do
174 findBound (S8.pack "def") (S8.pack "abcdefghi") @?=
175 FoundBound (S8.pack "abc") (S8.pack "ghi")
176 findBound (S8.pack "def") (S8.pack "ABC") @?= NoBound
177 findBound (S8.pack "def") (S8.pack "abcd") @?= PartialBound
178 findBound (S8.pack "def") (S8.pack "abcdE") @?= NoBound
179 findBound (S8.pack "def") (S8.pack "abcdEdef") @?=
180 FoundBound (S8.pack "abcdE") (S8.pack "")
182caseSinkTillBound :: Assertion
183caseSinkTillBound = do
184 caseSinkTillBoundHelper $ Just . toSource
185 caseSinkTillBoundHelper $ Just . toSource'
187caseSinkTillBoundHelper :: (S8.ByteString -> Maybe Source) -> Assertion
188caseSinkTillBoundHelper tosrc = do
189 let iter () _ = return ()
190 let src = S8.pack "this is some text"
191 bound1 = S8.pack "some"
192 bound2 = S8.pack "some!"
193 (_, res1, _) <- sinkTillBound bound1 (S8.empty, tosrc src) iter ()
194 res1 @?= True
195 (_, res2, _) <- sinkTillBound bound2 (S8.empty, tosrc src) iter ()
196 res2 @?= False