@@ -1,5 +1,5 @@
11{-# LANGUAGE OverloadedStrings #-}
2−module WaiExtraSpec where
2+module WaiExtraSpec (spec, toRequest) where
33
44import Test.Hspec
55import Test.HUnit hiding (Test)
@@ -7,7 +7,6 @@ import Data.Monoid (mappend, mempty, (<>))
77
88import Network.Wai
99import Network.Wai.Test
10−import Network.Wai.Parse
1110import Network.Wai.UrlMap
1211import qualified Data.ByteString as S
1312import qualified Data.ByteString.Char8 as S8
@@ -16,7 +15,6 @@ import qualified Data.Text.Lazy as T
1615import qualified Data.Text as TS
1716import qualified Data.Text.Encoding as TE
1817import Control.Applicative
19−import Control.Monad.Trans.Resource (withInternalState, runResourceT)
2018
2119import Network.Wai.Middleware.Jsonp
2220import Network.Wai.Middleware.Gzip
@@ -32,7 +30,6 @@ import Control.Monad.IO.Class (liftIO)
3230import Data.Maybe (fromMaybe)
3331import Network.HTTP.Types (parseSimpleQuery, status200)
3432import System.Log.FastLogger
35−import System.IO (withFile, IOMode (ReadMode))
3633
3734import qualified Data.IORef as I
3835
@@ -41,21 +38,9 @@ spec = do
4138 describe "Network.Wai.UrlMap" $ do
4239 mapM_ (uncurry it) casesUrlMap
4340
44− describe "Network.Wai.Parse" $ 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− ]
41+ describe "Network.Wai" $ do
5242 it "parseQueryString" caseParseQueryString
5343 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
5944 {-
6045 , it "findBound" caseFindBound
6146 , it "sinkTillBound" caseSinkTillBound
@@ -73,9 +58,6 @@ spec = do
7358 it "method override" caseMethodOverride
7459 it "method override post" caseMethodOverridePost
7560 it "accept override" caseAcceptOverride
76− describe "dalvik multipart" $ do
77− it "non-chunked" $ dalvikHelper True
78− it "chunked" $ dalvikHelper False
7961 it "debug request body" caseDebugRequestBody
8062
8163caseParseQueryString :: Assertion
@@ -108,123 +90,6 @@ caseParseQueryStringQM = do
10890 go [("/", "")] "%2f"
10991 go [("foo bar", "")] "foo+bar"
11092
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−
22893toRequest :: S8.ByteString -> S8.ByteString -> SRequest
22994toRequest ctype content = SRequest defaultRequest
23095 { requestHeaders = [("Content-Type", ctype)]
@@ -234,11 +99,6 @@ toRequest ctype content = SRequest defaultRequest
23499 , queryString = []
235100 } (L.fromChunks [content])
236101
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−
242102{-
243103caseFindBound :: Assertion
244104caseFindBound = do
@@ -487,41 +347,6 @@ caseAcceptOverride = flip runSession aoApp $ do
487347 }
488348 assertHeader "Accept" "baz" sres3
489349
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−
525350caseDebugRequestBody :: Assertion
526351caseDebugRequestBody = do
527352 flip runSession (debugApp postOutput) $ do