git.iko.soy/typeable/wai
on master help sign in
Merge pull request #304 from sol/spec-cleanup
d362d3eMichael Snoyman
wai-extra/test/Network/Wai/ParseSpec.hsnew file+200
compare with master
unifiedsplit
@@ -0,0 +1,200 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Network.Wai.ParseSpec (main, spec) where
3+
4+import Test.Hspec
5+import Test.HUnit
6+
7+import System.IO
8+import Data.Monoid
9+import qualified Data.IORef as I
10+import qualified Data.ByteString as S
11+import qualified Data.ByteString.Char8 as S8
12+import qualified Data.ByteString.Lazy as L
13+import qualified Data.Text as TS
14+import qualified Data.Text.Encoding as TE
15+import Control.Monad.Trans.Resource (withInternalState, runResourceT)
16+
17+import Network.Wai
18+import Network.Wai.Test
19+import Network.Wai.Parse
20+import WaiExtraSpec (toRequest)
21+
22+main :: IO ()
23+main = hspec spec
24+
25+spec :: Spec
26+spec = do
27+ describe "parseContentType" $ do
28+ let go (x, y, z) = it (TS.unpack $ TE.decodeUtf8 x) $ parseContentType x `shouldBe` (y, z)
29+ mapM_ go
30+ [ ("text/plain", "text/plain", [])
31+ , ("text/plain; charset=UTF-8 ", "text/plain", [("charset", "UTF-8")])
32+ , ("text/plain; charset=UTF-8 ; boundary = foo", "text/plain", [("charset", "UTF-8"), ("boundary", "foo")])
33+ ]
34+ it "parseHttpAccept" caseParseHttpAccept
35+ describe "parseRequestBody" $ do
36+ caseParseRequestBody
37+ it "multipart with plus" caseMultipartPlus
38+ it "multipart with multiple attributes" caseMultipartAttrs
39+ it "urlencoded with plus" caseUrlEncPlus
40+ describe "dalvik multipart" $ do
41+ it "non-chunked" $ dalvikHelper True
42+ it "chunked" $ dalvikHelper False
43+
44+caseParseHttpAccept :: Assertion
45+caseParseHttpAccept = do
46+ let input = "text/plain; q=0.5, text/html;charset=utf-8, text/*;q=0.8;ext=blah, text/x-dvi; q=0.8, text/x-c"
47+ expected = ["text/html;charset=utf-8", "text/x-c", "text/x-dvi", "text/*", "text/plain"]
48+ expected @=? parseHttpAccept input
49+
50+parseRequestBody' :: BackEnd file
51+ -> SRequest
52+ -> IO ([(S.ByteString, S.ByteString)], [(S.ByteString, FileInfo file)])
53+parseRequestBody' sink (SRequest req bod) =
54+ case getRequestBodyType req of
55+ Nothing -> return ([], [])
56+ Just rbt -> do
57+ ref <- I.newIORef $ L.toChunks bod
58+ let rb = I.atomicModifyIORef ref $ \chunks ->
59+ case chunks of
60+ [] -> ([], S.empty)
61+ x:y -> (y, x)
62+ sinkRequestBody sink rbt rb
63+
64+caseParseRequestBody :: Spec
65+caseParseRequestBody = do
66+ it "parsing post x-www-form-urlencoded" $ do
67+ let content1 = "foo=bar&baz=bin"
68+ let ctype1 = "application/x-www-form-urlencoded"
69+ result1 <- parseRequestBody' lbsBackEnd $ toRequest ctype1 content1
70+ result1 `shouldBe` ([("foo", "bar"), ("baz", "bin")], [])
71+
72+ let ctype2 = "multipart/form-data; boundary=AaB03x"
73+ let expectedsmap2 =
74+ [ ("title", "A File")
75+ , ("summary", "This is my file\nfile test")
76+ ]
77+ let textPlain = "text/plain; charset=iso-8859-1"
78+ let expectedfile2 =
79+ [("document", FileInfo "b.txt" textPlain "This is a file.\nIt has two lines.")]
80+ let expected2 = (expectedsmap2, expectedfile2)
81+
82+ it "parsing post multipart/form-data" $ do
83+ result2 <- parseRequestBody' lbsBackEnd $ toRequest ctype2 content2
84+ result2 `shouldBe` expected2
85+
86+ it "parsing post multipart/form-data 2" $ do
87+ result2' <- parseRequestBody' lbsBackEnd $ toRequest' ctype2 content2
88+ result2' `shouldBe` expected2
89+
90+
91+ let ctype3 = "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh"
92+ let expectedsmap3 = []
93+ let expectedfile3 = [("yaml", FileInfo "README" "application/octet-stream" "Photo blog using Hack.\n")]
94+ let expected3 = (expectedsmap3, expectedfile3)
95+
96+ it "parsing actual post multipart/form-data" $ do
97+ result3 <- parseRequestBody' lbsBackEnd $ toRequest ctype3 content3
98+ result3 `shouldBe` expected3
99+
100+ it "parsing actual post multipart/form-data 2" $ do
101+ result3' <- parseRequestBody' lbsBackEnd $ toRequest' ctype3 content3
102+ result3' `shouldBe` expected3
103+ where
104+ content2 =
105+ "--AaB03x\n"
106+ <> "Content-Disposition: form-data; name=\"document\"; filename=\"b.txt\"\n"
107+ <> "Content-Type: text/plain; charset=iso-8859-1\n\n"
108+ <> "This is a file.\n"
109+ <> "It has two lines.\n"
110+ <> "--AaB03x\n"
111+ <> "Content-Disposition: form-data; name=\"title\"\n"
112+ <> "Content-Type: text/plain; charset=iso-8859-1\n\n"
113+ <> "A File\n"
114+ <> "--AaB03x\n"
115+ <> "Content-Disposition: form-data; name=\"summary\"\n"
116+ <> "Content-Type: text/plain; charset=iso-8859-1\n\n"
117+ <> "This is my file\n"
118+ <> "file test\n"
119+ <> "--AaB03x--"
120+ content3 =
121+ "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\n"
122+ <> "Content-Disposition: form-data; name=\"yaml\"; filename=\"README\"\r\n"
123+ <> "Content-Type: application/octet-stream\r\n\r\n"
124+ <> "Photo blog using Hack.\n\r\n"
125+ <> "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh--\r\n"
126+
127+caseMultipartPlus :: Assertion
128+caseMultipartPlus = do
129+ result <- parseRequestBody' lbsBackEnd $ toRequest ctype content
130+ result @?= ([("email", "has+plus")], [])
131+ where
132+ content =
133+ "--AaB03x\n" <>
134+ "Content-Disposition: form-data; name=\"email\"\n" <>
135+ "Content-Type: text/plain; charset=iso-8859-1\n\n" <>
136+ "has+plus\n" <>
137+ "--AaB03x--"
138+ ctype = "multipart/form-data; boundary=AaB03x"
139+
140+caseMultipartAttrs :: Assertion
141+caseMultipartAttrs = do
142+ result <- parseRequestBody' lbsBackEnd $ toRequest ctype content
143+ result @?= ([("email", "has+plus")], [])
144+ where
145+ content =
146+ "--AaB03x\n" <>
147+ "Content-Disposition: form-data; name=\"email\"\n" <>
148+ "Content-Type: text/plain; charset=iso-8859-1\n\n" <>
149+ "has+plus\n" <>
150+ "--AaB03x--"
151+ ctype = "multipart/form-data; charset=UTF-8; boundary=AaB03x"
152+
153+caseUrlEncPlus :: Assertion
154+caseUrlEncPlus = do
155+ result <- runResourceT $ withInternalState $ \state ->
156+ parseRequestBody' (tempFileBackEnd state) $ toRequest ctype content
157+ result @?= ([("email", "has+plus")], [])
158+ where
159+ content = "email=has%2Bplus"
160+ ctype = "application/x-www-form-urlencoded"
161+
162+dalvikHelper :: Bool -> Assertion
163+dalvikHelper includeLength = do
164+ let headers' =
165+ [ ("content-type", "multipart/form-data;boundary=*****")
166+ , ("GATEWAY_INTERFACE", "CGI/1.1")
167+ , ("PATH_INFO", "/")
168+ , ("QUERY_STRING", "")
169+ , ("REMOTE_ADDR", "192.168.1.115")
170+ , ("REMOTE_HOST", "ganjizza")
171+ , ("REQUEST_URI", "http://192.168.1.115:3000/")
172+ , ("REQUEST_METHOD", "POST")
173+ , ("HTTP_CONNECTION", "Keep-Alive")
174+ , ("HTTP_COOKIE", "_SESSION=fgUGM5J/k6mGAAW+MMXIJZCJHobw/oEbb6T17KQN0p9yNqiXn/m/ACrsnRjiCEgqtG4fogMUDI+jikoFGcwmPjvuD5d+MDz32iXvDdDJsFdsFMfivuey2H+n6IF6yFGD")
175+ , ("HTTP_USER_AGENT", "Dalvik/1.1.0 (Linux; U; Android 2.1-update1; sdk Build/ECLAIR)")
176+ , ("HTTP_HOST", "192.168.1.115:3000")
177+ , ("HTTP_ACCEPT", "*, */*")
178+ , ("HTTP_VERSION", "HTTP/1.1")
179+ , ("REQUEST_PATH", "/")
180+ ]
181+ headers
182+ | includeLength = ("content-length", "12098") : headers'
183+ | otherwise = headers'
184+ let request' = defaultRequest
185+ { requestHeaders = headers
186+ }
187+ (params, files) <-
188+ case getRequestBodyType request' of
189+ Nothing -> return ([], [])
190+ Just rbt -> withFile "test/requests/dalvik-request" ReadMode $ \h ->
191+ sinkRequestBody lbsBackEnd rbt $ S.hGetSome h 2048
192+ lookup "scannedTime" params @?= Just "1.298590056748E9"
193+ lookup "geoLong" params @?= Just "0"
194+ lookup "geoLat" params @?= Just "0"
195+ length files @?= 1
196+
197+toRequest' :: S8.ByteString -> S8.ByteString -> SRequest
198+toRequest' ctype content = SRequest defaultRequest
199+ { requestHeaders = [("Content-Type", ctype)]
200+ } (L.fromChunks $ map S.singleton $ S.unpack content)
wai-extra/test/WaiExtraTest.hs → wai-extra/test/WaiExtraSpec.hsrenamed+15−229
@@ -1,5 +1,5 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2−module WaiExtraTest (specs) where
2+module WaiExtraSpec (spec, toRequest) where
3
3
4import Test.Hspec
4import Test.Hspec
5import Test.HUnit hiding (Test)
5import Test.HUnit hiding (Test)
@@ -7,18 +7,14 @@ import Data.Monoid (mappend, mempty, (<>))
7
7
8import Network.Wai
8import Network.Wai
9import Network.Wai.Test
9import Network.Wai.Test
10−import Network.Wai.Parse
11import Network.Wai.UrlMap
10import Network.Wai.UrlMap
12import qualified Data.ByteString as S
11import qualified Data.ByteString as S
13import qualified Data.ByteString.Char8 as S8
12import qualified Data.ByteString.Char8 as S8
14−import qualified Data.ByteString.Lazy.Char8 as L8
15import qualified Data.ByteString.Lazy as L
13import qualified Data.ByteString.Lazy as L
16import qualified Data.Text.Lazy as T
14import qualified Data.Text.Lazy as T
17import qualified Data.Text as TS
15import qualified Data.Text as TS
18import qualified Data.Text.Encoding as TE
16import qualified Data.Text.Encoding as TE
19−import Control.Arrow
20import Control.Applicative
17import Control.Applicative
21−import Control.Monad.Trans.Resource (withInternalState, runResourceT)
22
18
23import Network.Wai.Middleware.Jsonp
19import Network.Wai.Middleware.Jsonp
24import Network.Wai.Middleware.Gzip
20import Network.Wai.Middleware.Gzip
@@ -32,32 +28,17 @@ import Codec.Compression.GZip (decompress)
32
28
33import Control.Monad.IO.Class (liftIO)
29import Control.Monad.IO.Class (liftIO)
34import Data.Maybe (fromMaybe)
30import Data.Maybe (fromMaybe)
35−import Network.HTTP.Types (parseSimpleQuery, status200)
31+import Network.HTTP.Types (status200)
36import System.Log.FastLogger
32import System.Log.FastLogger
37−import System.IO (withFile, IOMode (ReadMode))
38
33
39import qualified Data.IORef as I
34import qualified Data.IORef as I
40
35
41−specs :: Spec
36+spec :: Spec
42−specs = do
37+spec = do
43 describe "Network.Wai.UrlMap" $ do
38 describe "Network.Wai.UrlMap" $ do
44 mapM_ (uncurry it) casesUrlMap
39 mapM_ (uncurry it) casesUrlMap
45
40
46− describe "Network.Wai.Parse" $ do
41+ describe "Network.Wai" $ do
47− describe "parseContentType" $ do
48− let go (x, y, z) = it (TS.unpack $ TE.decodeUtf8 x) $ parseContentType x `shouldBe` (y, z)
49− mapM_ go
50− [ ("text/plain", "text/plain", [])
51− , ("text/plain; charset=UTF-8 ", "text/plain", [("charset", "UTF-8")])
52− , ("text/plain; charset=UTF-8 ; boundary = foo", "text/plain", [("charset", "UTF-8"), ("boundary", "foo")])
53− ]
54− it "parseQueryString" caseParseQueryString
55− it "parseQueryString with question mark" caseParseQueryStringQM
56− it "parseHttpAccept" caseParseHttpAccept
57− it "parseRequestBody" caseParseRequestBody
58− it "multipart with plus" caseMultipartPlus
59− it "multipart with multiple attributes" caseMultipartAttrs
60− it "urlencoded with plus" caseUrlEncPlus
61 {-
42 {-
62 , it "findBound" caseFindBound
43 , it "findBound" caseFindBound
63 , it "sinkTillBound" caseSinkTillBound
44 , it "sinkTillBound" caseSinkTillBound
@@ -75,163 +56,8 @@ specs = do
75 it "method override" caseMethodOverride
56 it "method override" caseMethodOverride
76 it "method override post" caseMethodOverridePost
57 it "method override post" caseMethodOverridePost
77 it "accept override" caseAcceptOverride
58 it "accept override" caseAcceptOverride
78− describe "dalvik multipart" $ do
79− it "non-chunked" $ dalvikHelper True
80− it "chunked" $ dalvikHelper False
81 it "debug request body" caseDebugRequestBody
59 it "debug request body" caseDebugRequestBody
82
60
83−caseParseQueryString :: Assertion
84−caseParseQueryString = do
85− let go l r =
86− map (S8.pack *** S8.pack) l @=? parseSimpleQuery (S8.pack r)
87−
88− go [] ""
89− go [("foo", "")] "foo"
90− go [("foo", "bar")] "foo=bar"
91− go [("foo", "bar"), ("baz", "bin")] "foo=bar&baz=bin"
92− go [("%Q", "")] "%Q"
93− go [("%1Q", "")] "%1Q"
94− go [("%1", "")] "%1"
95− go [("/", "")] "%2F"
96− go [("/", "")] "%2f"
97− go [("foo bar", "")] "foo+bar"
98−
99−caseParseQueryStringQM :: Assertion
100−caseParseQueryStringQM = do
101− let go l r =
102− map (S8.pack *** S8.pack) l
103− @=? parseSimpleQuery (S8.pack $ '?' : r)
104−
105− go [] ""
106− go [("foo", "")] "foo"
107− go [("foo", "bar")] "foo=bar"
108− go [("foo", "bar"), ("baz", "bin")] "foo=bar&baz=bin"
109− go [("%Q", "")] "%Q"
110− go [("%1Q", "")] "%1Q"
111− go [("%1", "")] "%1"
112− go [("/", "")] "%2F"
113− go [("/", "")] "%2f"
114− go [("foo bar", "")] "foo+bar"
115−
116−caseParseHttpAccept :: Assertion
117−caseParseHttpAccept = do
118− let input = "text/plain; q=0.5, text/html;charset=utf-8, text/*;q=0.8;ext=blah, text/x-dvi; q=0.8, text/x-c"
119− expected = ["text/html;charset=utf-8", "text/x-c", "text/x-dvi", "text/*", "text/plain"]
120− expected @=? parseHttpAccept input
121−
122−parseRequestBody' :: BackEnd file
123− -> SRequest
124− -> IO ([(S.ByteString, S.ByteString)], [(S.ByteString, FileInfo file)])
125−parseRequestBody' sink (SRequest req bod) =
126− case getRequestBodyType req of
127− Nothing -> return ([], [])
128− Just rbt -> do
129− ref <- I.newIORef $ L.toChunks bod
130− let rb = I.atomicModifyIORef ref $ \chunks ->
131− case chunks of
132− [] -> ([], S.empty)
133− x:y -> (y, x)
134− sinkRequestBody sink rbt rb
135−
136−caseParseRequestBody :: Assertion
137−caseParseRequestBody =
138− t
139− where
140− content2 = S8.pack $
141− "--AaB03x\n" ++
142− "Content-Disposition: form-data; name=\"document\"; filename=\"b.txt\"\n" ++
143− "Content-Type: text/plain; charset=iso-8859-1\n\n" ++
144− "This is a file.\n" ++
145− "It has two lines.\n" ++
146− "--AaB03x\n" ++
147− "Content-Disposition: form-data; name=\"title\"\n" ++
148− "Content-Type: text/plain; charset=iso-8859-1\n\n" ++
149− "A File\n" ++
150− "--AaB03x\n" ++
151− "Content-Disposition: form-data; name=\"summary\"\n" ++
152− "Content-Type: text/plain; charset=iso-8859-1\n\n" ++
153− "This is my file\n" ++
154− "file test\n" ++
155− "--AaB03x--"
156− 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"
157− t = do
158− let content1 = "foo=bar&baz=bin"
159− let ctype1 = "application/x-www-form-urlencoded"
160− result1 <- parseRequestBody' lbsBackEnd $ toRequest ctype1 content1
161− liftIO $ assertEqual "parsing post x-www-form-urlencoded"
162− (map (S8.pack *** S8.pack) [("foo", "bar"), ("baz", "bin")], [])
163− result1
164−
165− let ctype2 = "multipart/form-data; boundary=AaB03x"
166− result2 <- parseRequestBody' lbsBackEnd $ toRequest ctype2 content2
167− let expectedsmap2 =
168− [ ("title", "A File")
169− , ("summary", "This is my file\nfile test")
170− ]
171− let textPlain = S8.pack $ "text/plain; charset=iso-8859-1"
172− let expectedfile2 =
173− [(S8.pack "document", FileInfo (S8.pack "b.txt") textPlain $ L8.pack
174− "This is a file.\nIt has two lines.")]
175− let expected2 = (map (S8.pack *** S8.pack) expectedsmap2, expectedfile2)
176− liftIO $ assertEqual "parsing post multipart/form-data"
177− expected2
178− result2
179−
180− let ctype3 = "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh"
181− result3 <- parseRequestBody' lbsBackEnd $ toRequest ctype3 content3
182− let expectedsmap3 = []
183− let expectedfile3 = [(S8.pack "yaml", FileInfo (S8.pack "README") (S8.pack "application/octet-stream") $
184− L8.pack "Photo blog using Hack.\n")]
185− let expected3 = (expectedsmap3, expectedfile3)
186− liftIO $ assertEqual "parsing actual post multipart/form-data"
187− expected3
188− result3
189−
190− result2' <- parseRequestBody' lbsBackEnd $ toRequest' ctype2 content2
191− liftIO $ assertEqual "parsing post multipart/form-data 2"
192− expected2
193− result2'
194−
195− result3' <- parseRequestBody' lbsBackEnd $ toRequest' ctype3 content3
196− liftIO $ assertEqual "parsing actual post multipart/form-data 2"
197− expected3
198− result3'
199−
200−caseMultipartPlus :: Assertion
201−caseMultipartPlus = do
202− result <- parseRequestBody' lbsBackEnd $ toRequest ctype content
203− liftIO $ result @?= ([("email", "has+plus")], [])
204− where
205− content = S8.pack $
206− "--AaB03x\n" ++
207− "Content-Disposition: form-data; name=\"email\"\n" ++
208− "Content-Type: text/plain; charset=iso-8859-1\n\n" ++
209− "has+plus\n" ++
210− "--AaB03x--"
211− ctype = "multipart/form-data; boundary=AaB03x"
212−
213−caseMultipartAttrs :: Assertion
214−caseMultipartAttrs = do
215− result <- parseRequestBody' lbsBackEnd $ toRequest ctype content
216− liftIO $ result @?= ([("email", "has+plus")], [])
217− where
218− content = S8.pack $
219− "--AaB03x\n" ++
220− "Content-Disposition: form-data; name=\"email\"\n" ++
221− "Content-Type: text/plain; charset=iso-8859-1\n\n" ++
222− "has+plus\n" ++
223− "--AaB03x--"
224− ctype = "multipart/form-data; charset=UTF-8; boundary=AaB03x"
225−
226−caseUrlEncPlus :: Assertion
227−caseUrlEncPlus = do
228− result <- runResourceT $ withInternalState $ \state ->
229− parseRequestBody' (tempFileBackEnd state) $ toRequest ctype content
230− liftIO $ result @?= ([("email", "has+plus")], [])
231− where
232− content = S8.pack $ "email=has%2Bplus"
233− ctype = "application/x-www-form-urlencoded"
234−
235toRequest :: S8.ByteString -> S8.ByteString -> SRequest
61toRequest :: S8.ByteString -> S8.ByteString -> SRequest
236toRequest ctype content = SRequest defaultRequest
62toRequest ctype content = SRequest defaultRequest
237 { requestHeaders = [("Content-Type", ctype)]
63 { requestHeaders = [("Content-Type", ctype)]
@@ -241,28 +67,23 @@ toRequest ctype content = SRequest defaultRequest
241 , queryString = []
67 , queryString = []
242 } (L.fromChunks [content])
68 } (L.fromChunks [content])
243
69
244−toRequest' :: S8.ByteString -> S8.ByteString -> SRequest
245−toRequest' ctype content = SRequest defaultRequest
246− { requestHeaders = [("Content-Type", ctype)]
247− } (L.fromChunks $ map S.singleton $ S.unpack content)
248−
249{-
70{-
250caseFindBound :: Assertion
71caseFindBound :: Assertion
251caseFindBound = do
72caseFindBound = do
252− findBound (S8.pack "def") (S8.pack "abcdefghi") @?=
73+ findBound "def" "abcdefghi" @?=
253− FoundBound (S8.pack "abc") (S8.pack "ghi")
74+ FoundBound "abc" "ghi"
254− findBound (S8.pack "def") (S8.pack "ABC") @?= NoBound
75+ findBound "def" "ABC" @?= NoBound
255− findBound (S8.pack "def") (S8.pack "abcd") @?= PartialBound
76+ findBound "def" "abcd" @?= PartialBound
256− findBound (S8.pack "def") (S8.pack "abcdE") @?= NoBound
77+ findBound "def" "abcdE" @?= NoBound
257− findBound (S8.pack "def") (S8.pack "abcdEdef") @?=
78+ findBound "def" "abcdEdef" @?=
258− FoundBound (S8.pack "abcdE") (S8.pack "")
79+ FoundBound "abcdE" ""
259
80
260caseSinkTillBound :: Assertion
81caseSinkTillBound :: Assertion
261caseSinkTillBound = do
82caseSinkTillBound = do
262 let iter () _ = return ()
83 let iter () _ = return ()
263− let src = S8.pack "this is some text"
84+ let src = "this is some text"
264− bound1 = S8.pack "some"
85+ bound1 = "some"
265− bound2 = S8.pack "some!"
86+ bound2 = "some!"
266 let enum = enumList 1 [src]
87 let enum = enumList 1 [src]
267 let helper _ _ = return ()
88 let helper _ _ = return ()
268 (_, res1) <- run_ $ enum $$ sinkTillBound bound1 helper ()
89 (_, res1) <- run_ $ enum $$ sinkTillBound bound1 helper ()
@@ -494,41 +315,6 @@ caseAcceptOverride = flip runSession aoApp $ do
494 }
315 }
495 assertHeader "Accept" "baz" sres3
316 assertHeader "Accept" "baz" sres3
496
317
497−dalvikHelper :: Bool -> Assertion
498−dalvikHelper includeLength = do
499− let headers' =
500− [ ("content-type", "multipart/form-data;boundary=*****")
501− , ("GATEWAY_INTERFACE", "CGI/1.1")
502− , ("PATH_INFO", "/")
503− , ("QUERY_STRING", "")
504− , ("REMOTE_ADDR", "192.168.1.115")
505− , ("REMOTE_HOST", "ganjizza")
506− , ("REQUEST_URI", "http://192.168.1.115:3000/")
507− , ("REQUEST_METHOD", "POST")
508− , ("HTTP_CONNECTION", "Keep-Alive")
509− , ("HTTP_COOKIE", "_SESSION=fgUGM5J/k6mGAAW+MMXIJZCJHobw/oEbb6T17KQN0p9yNqiXn/m/ACrsnRjiCEgqtG4fogMUDI+jikoFGcwmPjvuD5d+MDz32iXvDdDJsFdsFMfivuey2H+n6IF6yFGD")
510− , ("HTTP_USER_AGENT", "Dalvik/1.1.0 (Linux; U; Android 2.1-update1; sdk Build/ECLAIR)")
511− , ("HTTP_HOST", "192.168.1.115:3000")
512− , ("HTTP_ACCEPT", "*, */*")
513− , ("HTTP_VERSION", "HTTP/1.1")
514− , ("REQUEST_PATH", "/")
515− ]
516− headers
517− | includeLength = ("content-length", "12098") : headers'
518− | otherwise = headers'
519− let request' = defaultRequest
520− { requestHeaders = headers
521− }
522− (params, files) <-
523− case getRequestBodyType request' of
524− Nothing -> return ([], [])
525− Just rbt -> withFile "test/requests/dalvik-request" ReadMode $ \h ->
526− sinkRequestBody lbsBackEnd rbt $ S.hGetSome h 2048
527− lookup "scannedTime" params @?= Just "1.298590056748E9"
528− lookup "geoLong" params @?= Just "0"
529− lookup "geoLat" params @?= Just "0"
530− length files @?= 1
531−
532caseDebugRequestBody :: Assertion
318caseDebugRequestBody :: Assertion
533caseDebugRequestBody = do
319caseDebugRequestBody = do
534 flip runSession (debugApp postOutput) $ do
320 flip runSession (debugApp postOutput) $ do
wai-extra/tests.hsdeleted−5
@@ -1,5 +0,0 @@
1−import Test.Hspec
2−import qualified WaiExtraTest
3−
4−main :: IO ()
5−main = hspec WaiExtraTest.specs
wai-extra/wai-extra.cabal+10−24
@@ -73,39 +73,25 @@ Library
73 other-modules: Network.Wai.Middleware.RequestLogger.Internal
73 other-modules: Network.Wai.Middleware.RequestLogger.Internal
74 ghc-options: -Wall
74 ghc-options: -Wall
75
75
76−
77−test-suite tests
78− hs-source-dirs: test
79− main-is: ../tests.hs
80− type: exitcode-stdio-1.0
81−
82− build-depends: base >= 4 && < 5
83− , wai-extra
84− , hspec >= 1.3
85− , HUnit
86−
87− , wai
88− , http-types
89− , transformers
90− , zlib
91− , text
92− , bytestring
93− , directory
94− , blaze-builder >= 0.2.1.4 && < 0.4
95− , data-default
96− , fast-logger >= 2.1
97− , resourcet
98− ghc-options: -Wall
99−
100test-suite spec
76test-suite spec
101 type: exitcode-stdio-1.0
77 type: exitcode-stdio-1.0
102 hs-source-dirs: test
78 hs-source-dirs: test
103 main-is: Spec.hs
79 main-is: Spec.hs
104 other-modules: Network.Wai.TestSpec
80 other-modules: Network.Wai.TestSpec
81+ Network.Wai.ParseSpec
82+ WaiExtraSpec
105 build-depends: base >= 4 && < 5
83 build-depends: base >= 4 && < 5
106 , wai-extra
84 , wai-extra
107 , wai
85 , wai
108 , hspec >= 1.3
86 , hspec >= 1.3
87+ , transformers
88+ , fast-logger
89+ , http-types
90+ , zlib
91+ , text
92+ , resourcet
93+ , bytestring
94+ , HUnit
109 ghc-options: -Wall -Werror
95 ghc-options: -Wall -Werror
110
96
111source-repository head
97source-repository head