git.iko.soy/typeable/wai
on master help sign in
wai-extra: Move specs for Network.Wai.Parse to Network.Wai.ParseSpec
4603f5dSimon Hengel
wai-extra/test/Network/Wai/ParseSpec.hsnew file+198
compare with master
unifiedsplit
@@ -0,0 +1,198 @@
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+ it "parseRequestBody" caseParseRequestBody
36+ it "multipart with plus" caseMultipartPlus
37+ it "multipart with multiple attributes" caseMultipartAttrs
38+ it "urlencoded with plus" caseUrlEncPlus
39+ describe "dalvik multipart" $ do
40+ it "non-chunked" $ dalvikHelper True
41+ it "chunked" $ dalvikHelper False
42+
43+caseParseHttpAccept :: Assertion
44+caseParseHttpAccept = do
45+ 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"
46+ expected = ["text/html;charset=utf-8", "text/x-c", "text/x-dvi", "text/*", "text/plain"]
47+ expected @=? parseHttpAccept input
48+
49+parseRequestBody' :: BackEnd file
50+ -> SRequest
51+ -> IO ([(S.ByteString, S.ByteString)], [(S.ByteString, FileInfo file)])
52+parseRequestBody' sink (SRequest req bod) =
53+ case getRequestBodyType req of
54+ Nothing -> return ([], [])
55+ Just rbt -> do
56+ ref <- I.newIORef $ L.toChunks bod
57+ let rb = I.atomicModifyIORef ref $ \chunks ->
58+ case chunks of
59+ [] -> ([], S.empty)
60+ x:y -> (y, x)
61+ sinkRequestBody sink rbt rb
62+
63+caseParseRequestBody :: Assertion
64+caseParseRequestBody =
65+ t
66+ where
67+ content2 =
68+ "--AaB03x\n" <>
69+ "Content-Disposition: form-data; name=\"document\"; filename=\"b.txt\"\n" <>
70+ "Content-Type: text/plain; charset=iso-8859-1\n\n" <>
71+ "This is a file.\n" <>
72+ "It has two lines.\n" <>
73+ "--AaB03x\n" <>
74+ "Content-Disposition: form-data; name=\"title\"\n" <>
75+ "Content-Type: text/plain; charset=iso-8859-1\n\n" <>
76+ "A File\n" <>
77+ "--AaB03x\n" <>
78+ "Content-Disposition: form-data; name=\"summary\"\n" <>
79+ "Content-Type: text/plain; charset=iso-8859-1\n\n" <>
80+ "This is my file\n" <>
81+ "file test\n" <>
82+ "--AaB03x--"
83+ content3 = "------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"
84+ t = do
85+ let content1 = "foo=bar&baz=bin"
86+ let ctype1 = "application/x-www-form-urlencoded"
87+ result1 <- parseRequestBody' lbsBackEnd $ toRequest ctype1 content1
88+ assertEqual "parsing post x-www-form-urlencoded"
89+ ([("foo", "bar"), ("baz", "bin")], [])
90+ result1
91+
92+ let ctype2 = "multipart/form-data; boundary=AaB03x"
93+ result2 <- parseRequestBody' lbsBackEnd $ toRequest ctype2 content2
94+ let expectedsmap2 =
95+ [ ("title", "A File")
96+ , ("summary", "This is my file\nfile test")
97+ ]
98+ let textPlain = "text/plain; charset=iso-8859-1"
99+ let expectedfile2 =
100+ [("document", FileInfo "b.txt" textPlain "This is a file.\nIt has two lines.")]
101+ let expected2 = (expectedsmap2, expectedfile2)
102+ assertEqual "parsing post multipart/form-data"
103+ expected2
104+ result2
105+
106+ let ctype3 = "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh"
107+ result3 <- parseRequestBody' lbsBackEnd $ toRequest ctype3 content3
108+ let expectedsmap3 = []
109+ let expectedfile3 = [("yaml", FileInfo "README" "application/octet-stream" "Photo blog using Hack.\n")]
110+ let expected3 = (expectedsmap3, expectedfile3)
111+ assertEqual "parsing actual post multipart/form-data"
112+ expected3
113+ result3
114+
115+ result2' <- parseRequestBody' lbsBackEnd $ toRequest' ctype2 content2
116+ assertEqual "parsing post multipart/form-data 2"
117+ expected2
118+ result2'
119+
120+ result3' <- parseRequestBody' lbsBackEnd $ toRequest' ctype3 content3
121+ assertEqual "parsing actual post multipart/form-data 2"
122+ expected3
123+ result3'
124+
125+caseMultipartPlus :: Assertion
126+caseMultipartPlus = do
127+ result <- parseRequestBody' lbsBackEnd $ toRequest ctype content
128+ result @?= ([("email", "has+plus")], [])
129+ where
130+ content =
131+ "--AaB03x\n" <>
132+ "Content-Disposition: form-data; name=\"email\"\n" <>
133+ "Content-Type: text/plain; charset=iso-8859-1\n\n" <>
134+ "has+plus\n" <>
135+ "--AaB03x--"
136+ ctype = "multipart/form-data; boundary=AaB03x"
137+
138+caseMultipartAttrs :: Assertion
139+caseMultipartAttrs = do
140+ result <- parseRequestBody' lbsBackEnd $ toRequest ctype content
141+ result @?= ([("email", "has+plus")], [])
142+ where
143+ content =
144+ "--AaB03x\n" <>
145+ "Content-Disposition: form-data; name=\"email\"\n" <>
146+ "Content-Type: text/plain; charset=iso-8859-1\n\n" <>
147+ "has+plus\n" <>
148+ "--AaB03x--"
149+ ctype = "multipart/form-data; charset=UTF-8; boundary=AaB03x"
150+
151+caseUrlEncPlus :: Assertion
152+caseUrlEncPlus = do
153+ result <- runResourceT $ withInternalState $ \state ->
154+ parseRequestBody' (tempFileBackEnd state) $ toRequest ctype content
155+ result @?= ([("email", "has+plus")], [])
156+ where
157+ content = "email=has%2Bplus"
158+ ctype = "application/x-www-form-urlencoded"
159+
160+dalvikHelper :: Bool -> Assertion
161+dalvikHelper includeLength = do
162+ let headers' =
163+ [ ("content-type", "multipart/form-data;boundary=*****")
164+ , ("GATEWAY_INTERFACE", "CGI/1.1")
165+ , ("PATH_INFO", "/")
166+ , ("QUERY_STRING", "")
167+ , ("REMOTE_ADDR", "192.168.1.115")
168+ , ("REMOTE_HOST", "ganjizza")
169+ , ("REQUEST_URI", "http://192.168.1.115:3000/")
170+ , ("REQUEST_METHOD", "POST")
171+ , ("HTTP_CONNECTION", "Keep-Alive")
172+ , ("HTTP_COOKIE", "_SESSION=fgUGM5J/k6mGAAW+MMXIJZCJHobw/oEbb6T17KQN0p9yNqiXn/m/ACrsnRjiCEgqtG4fogMUDI+jikoFGcwmPjvuD5d+MDz32iXvDdDJsFdsFMfivuey2H+n6IF6yFGD")
173+ , ("HTTP_USER_AGENT", "Dalvik/1.1.0 (Linux; U; Android 2.1-update1; sdk Build/ECLAIR)")
174+ , ("HTTP_HOST", "192.168.1.115:3000")
175+ , ("HTTP_ACCEPT", "*, */*")
176+ , ("HTTP_VERSION", "HTTP/1.1")
177+ , ("REQUEST_PATH", "/")
178+ ]
179+ headers
180+ | includeLength = ("content-length", "12098") : headers'
181+ | otherwise = headers'
182+ let request' = defaultRequest
183+ { requestHeaders = headers
184+ }
185+ (params, files) <-
186+ case getRequestBodyType request' of
187+ Nothing -> return ([], [])
188+ Just rbt -> withFile "test/requests/dalvik-request" ReadMode $ \h ->
189+ sinkRequestBody lbsBackEnd rbt $ S.hGetSome h 2048
190+ lookup "scannedTime" params @?= Just "1.298590056748E9"
191+ lookup "geoLong" params @?= Just "0"
192+ lookup "geoLat" params @?= Just "0"
193+ length files @?= 1
194+
195+toRequest' :: S8.ByteString -> S8.ByteString -> SRequest
196+toRequest' ctype content = SRequest defaultRequest
197+ { requestHeaders = [("Content-Type", ctype)]
198+ } (L.fromChunks $ map S.singleton $ S.unpack content)
wai-extra/test/WaiExtraSpec.hs+2−177
@@ -1,5 +1,5 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2−module WaiExtraSpec 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,7 +7,6 @@ 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
@@ -16,7 +15,6 @@ import qualified Data.Text.Lazy as T
16import qualified Data.Text as TS
15import qualified Data.Text as TS
17import qualified Data.Text.Encoding as TE
16import qualified Data.Text.Encoding as TE
18import Control.Applicative
17import Control.Applicative
19−import Control.Monad.Trans.Resource (withInternalState, runResourceT)
20
18
21import Network.Wai.Middleware.Jsonp
19import Network.Wai.Middleware.Jsonp
22import Network.Wai.Middleware.Gzip
20import Network.Wai.Middleware.Gzip
@@ -32,7 +30,6 @@ import Control.Monad.IO.Class (liftIO)
32import Data.Maybe (fromMaybe)
30import Data.Maybe (fromMaybe)
33import Network.HTTP.Types (parseSimpleQuery, status200)
31import Network.HTTP.Types (parseSimpleQuery, status200)
34import System.Log.FastLogger
32import System.Log.FastLogger
35−import System.IO (withFile, IOMode (ReadMode))
36
33
37import qualified Data.IORef as I
34import qualified Data.IORef as I
38
35
@@ -41,21 +38,9 @@ spec = do
41 describe "Network.Wai.UrlMap" $ do
38 describe "Network.Wai.UrlMap" $ do
42 mapM_ (uncurry it) casesUrlMap
39 mapM_ (uncurry it) casesUrlMap
43
40
44− describe "Network.Wai.Parse" $ do
41+ describe "Network.Wai" $ do
45− describe "parseContentType" $ do
46− let go (x, y, z) = it (TS.unpack $ TE.decodeUtf8 x) $ parseContentType x `shouldBe` (y, z)
47− mapM_ go
48− [ ("text/plain", "text/plain", [])
49− , ("text/plain; charset=UTF-8 ", "text/plain", [("charset", "UTF-8")])
50− , ("text/plain; charset=UTF-8 ; boundary = foo", "text/plain", [("charset", "UTF-8"), ("boundary", "foo")])
51− ]
52 it "parseQueryString" caseParseQueryString
42 it "parseQueryString" caseParseQueryString
53 it "parseQueryString with question mark" caseParseQueryStringQM
43 it "parseQueryString with question mark" caseParseQueryStringQM
54− it "parseHttpAccept" caseParseHttpAccept
55− it "parseRequestBody" caseParseRequestBody
56− it "multipart with plus" caseMultipartPlus
57− it "multipart with multiple attributes" caseMultipartAttrs
58− it "urlencoded with plus" caseUrlEncPlus
59 {-
44 {-
60 , it "findBound" caseFindBound
45 , it "findBound" caseFindBound
61 , it "sinkTillBound" caseSinkTillBound
46 , it "sinkTillBound" caseSinkTillBound
@@ -73,9 +58,6 @@ spec = do
73 it "method override" caseMethodOverride
58 it "method override" caseMethodOverride
74 it "method override post" caseMethodOverridePost
59 it "method override post" caseMethodOverridePost
75 it "accept override" caseAcceptOverride
60 it "accept override" caseAcceptOverride
76− describe "dalvik multipart" $ do
77− it "non-chunked" $ dalvikHelper True
78− it "chunked" $ dalvikHelper False
79 it "debug request body" caseDebugRequestBody
61 it "debug request body" caseDebugRequestBody
80
62
81caseParseQueryString :: Assertion
63caseParseQueryString :: Assertion
@@ -108,123 +90,6 @@ caseParseQueryStringQM = do
108 go [("/", "")] "%2f"
90 go [("/", "")] "%2f"
109 go [("foo bar", "")] "foo+bar"
91 go [("foo bar", "")] "foo+bar"
110
92
111−caseParseHttpAccept :: Assertion
112−caseParseHttpAccept = do
113− 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"
114− expected = ["text/html;charset=utf-8", "text/x-c", "text/x-dvi", "text/*", "text/plain"]
115− expected @=? parseHttpAccept input
116−
117−parseRequestBody' :: BackEnd file
118− -> SRequest
119− -> IO ([(S.ByteString, S.ByteString)], [(S.ByteString, FileInfo file)])
120−parseRequestBody' sink (SRequest req bod) =
121− case getRequestBodyType req of
122− Nothing -> return ([], [])
123− Just rbt -> do
124− ref <- I.newIORef $ L.toChunks bod
125− let rb = I.atomicModifyIORef ref $ \chunks ->
126− case chunks of
127− [] -> ([], S.empty)
128− x:y -> (y, x)
129− sinkRequestBody sink rbt rb
130−
131−caseParseRequestBody :: Assertion
132−caseParseRequestBody =
133− t
134− where
135− content2 =
136− "--AaB03x\n" <>
137− "Content-Disposition: form-data; name=\"document\"; filename=\"b.txt\"\n" <>
138− "Content-Type: text/plain; charset=iso-8859-1\n\n" <>
139− "This is a file.\n" <>
140− "It has two lines.\n" <>
141− "--AaB03x\n" <>
142− "Content-Disposition: form-data; name=\"title\"\n" <>
143− "Content-Type: text/plain; charset=iso-8859-1\n\n" <>
144− "A File\n" <>
145− "--AaB03x\n" <>
146− "Content-Disposition: form-data; name=\"summary\"\n" <>
147− "Content-Type: text/plain; charset=iso-8859-1\n\n" <>
148− "This is my file\n" <>
149− "file test\n" <>
150− "--AaB03x--"
151− content3 = "------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"
152− t = do
153− let content1 = "foo=bar&baz=bin"
154− let ctype1 = "application/x-www-form-urlencoded"
155− result1 <- parseRequestBody' lbsBackEnd $ toRequest ctype1 content1
156− assertEqual "parsing post x-www-form-urlencoded"
157− ([("foo", "bar"), ("baz", "bin")], [])
158− result1
159−
160− let ctype2 = "multipart/form-data; boundary=AaB03x"
161− result2 <- parseRequestBody' lbsBackEnd $ toRequest ctype2 content2
162− let expectedsmap2 =
163− [ ("title", "A File")
164− , ("summary", "This is my file\nfile test")
165− ]
166− let textPlain = "text/plain; charset=iso-8859-1"
167− let expectedfile2 =
168− [("document", FileInfo "b.txt" textPlain "This is a file.\nIt has two lines.")]
169− let expected2 = (expectedsmap2, expectedfile2)
170− assertEqual "parsing post multipart/form-data"
171− expected2
172− result2
173−
174− let ctype3 = "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh"
175− result3 <- parseRequestBody' lbsBackEnd $ toRequest ctype3 content3
176− let expectedsmap3 = []
177− let expectedfile3 = [("yaml", FileInfo "README" "application/octet-stream" "Photo blog using Hack.\n")]
178− let expected3 = (expectedsmap3, expectedfile3)
179− assertEqual "parsing actual post multipart/form-data"
180− expected3
181− result3
182−
183− result2' <- parseRequestBody' lbsBackEnd $ toRequest' ctype2 content2
184− assertEqual "parsing post multipart/form-data 2"
185− expected2
186− result2'
187−
188− result3' <- parseRequestBody' lbsBackEnd $ toRequest' ctype3 content3
189− assertEqual "parsing actual post multipart/form-data 2"
190− expected3
191− result3'
192−
193−caseMultipartPlus :: Assertion
194−caseMultipartPlus = do
195− result <- parseRequestBody' lbsBackEnd $ toRequest ctype content
196− result @?= ([("email", "has+plus")], [])
197− where
198− content =
199− "--AaB03x\n" <>
200− "Content-Disposition: form-data; name=\"email\"\n" <>
201− "Content-Type: text/plain; charset=iso-8859-1\n\n" <>
202− "has+plus\n" <>
203− "--AaB03x--"
204− ctype = "multipart/form-data; boundary=AaB03x"
205−
206−caseMultipartAttrs :: Assertion
207−caseMultipartAttrs = do
208− result <- parseRequestBody' lbsBackEnd $ toRequest ctype content
209− result @?= ([("email", "has+plus")], [])
210− where
211− content =
212− "--AaB03x\n" <>
213− "Content-Disposition: form-data; name=\"email\"\n" <>
214− "Content-Type: text/plain; charset=iso-8859-1\n\n" <>
215− "has+plus\n" <>
216− "--AaB03x--"
217− ctype = "multipart/form-data; charset=UTF-8; boundary=AaB03x"
218−
219−caseUrlEncPlus :: Assertion
220−caseUrlEncPlus = do
221− result <- runResourceT $ withInternalState $ \state ->
222− parseRequestBody' (tempFileBackEnd state) $ toRequest ctype content
223− result @?= ([("email", "has+plus")], [])
224− where
225− content = "email=has%2Bplus"
226− ctype = "application/x-www-form-urlencoded"
227−
228toRequest :: S8.ByteString -> S8.ByteString -> SRequest
93toRequest :: S8.ByteString -> S8.ByteString -> SRequest
229toRequest ctype content = SRequest defaultRequest
94toRequest ctype content = SRequest defaultRequest
230 { requestHeaders = [("Content-Type", ctype)]
95 { requestHeaders = [("Content-Type", ctype)]
@@ -234,11 +99,6 @@ toRequest ctype content = SRequest defaultRequest
234 , queryString = []
99 , queryString = []
235 } (L.fromChunks [content])
100 } (L.fromChunks [content])
236
101
237−toRequest' :: S8.ByteString -> S8.ByteString -> SRequest
238−toRequest' ctype content = SRequest defaultRequest
239− { requestHeaders = [("Content-Type", ctype)]
240− } (L.fromChunks $ map S.singleton $ S.unpack content)
241−
242{-
102{-
243caseFindBound :: Assertion
103caseFindBound :: Assertion
244caseFindBound = do
104caseFindBound = do
@@ -487,41 +347,6 @@ caseAcceptOverride = flip runSession aoApp $ do
487 }
347 }
488 assertHeader "Accept" "baz" sres3
348 assertHeader "Accept" "baz" sres3
489
349
490−dalvikHelper :: Bool -> Assertion
491−dalvikHelper includeLength = do
492− let headers' =
493− [ ("content-type", "multipart/form-data;boundary=*****")
494− , ("GATEWAY_INTERFACE", "CGI/1.1")
495− , ("PATH_INFO", "/")
496− , ("QUERY_STRING", "")
497− , ("REMOTE_ADDR", "192.168.1.115")
498− , ("REMOTE_HOST", "ganjizza")
499− , ("REQUEST_URI", "http://192.168.1.115:3000/")
500− , ("REQUEST_METHOD", "POST")
501− , ("HTTP_CONNECTION", "Keep-Alive")
502− , ("HTTP_COOKIE", "_SESSION=fgUGM5J/k6mGAAW+MMXIJZCJHobw/oEbb6T17KQN0p9yNqiXn/m/ACrsnRjiCEgqtG4fogMUDI+jikoFGcwmPjvuD5d+MDz32iXvDdDJsFdsFMfivuey2H+n6IF6yFGD")
503− , ("HTTP_USER_AGENT", "Dalvik/1.1.0 (Linux; U; Android 2.1-update1; sdk Build/ECLAIR)")
504− , ("HTTP_HOST", "192.168.1.115:3000")
505− , ("HTTP_ACCEPT", "*, */*")
506− , ("HTTP_VERSION", "HTTP/1.1")
507− , ("REQUEST_PATH", "/")
508− ]
509− headers
510− | includeLength = ("content-length", "12098") : headers'
511− | otherwise = headers'
512− let request' = defaultRequest
513− { requestHeaders = headers
514− }
515− (params, files) <-
516− case getRequestBodyType request' of
517− Nothing -> return ([], [])
518− Just rbt -> withFile "test/requests/dalvik-request" ReadMode $ \h ->
519− sinkRequestBody lbsBackEnd rbt $ S.hGetSome h 2048
520− lookup "scannedTime" params @?= Just "1.298590056748E9"
521− lookup "geoLong" params @?= Just "0"
522− lookup "geoLat" params @?= Just "0"
523− length files @?= 1
524−
525caseDebugRequestBody :: Assertion
350caseDebugRequestBody :: Assertion
526caseDebugRequestBody = do
351caseDebugRequestBody = do
527 flip runSession (debugApp postOutput) $ do
352 flip runSession (debugApp postOutput) $ do
wai-extra/wai-extra.cabal+1
@@ -78,6 +78,7 @@ test-suite spec
78 hs-source-dirs: test
78 hs-source-dirs: test
79 main-is: Spec.hs
79 main-is: Spec.hs
80 other-modules: Network.Wai.TestSpec
80 other-modules: Network.Wai.TestSpec
81+ Network.Wai.ParseSpec
81 WaiExtraSpec
82 WaiExtraSpec
82 build-depends: base >= 4 && < 5
83 build-depends: base >= 4 && < 5
83 , wai-extra
84 , wai-extra