on master help sign in
Tests working again
commit452c6e686078e18b09e380651837dc0a6de6f4e9 authorMichael Snoyman <michael@snoyman.com> dateMon 10 Jan 2011, 23:39 (16 years ago) parente57e2ff
1 file changed+19−14
runtests.hs+19−14
runtests.hs+19−14
@@ -9,6 +9,7 @@ import Network.Wai.Parse
99import qualified Data.ByteString as S
1010import qualified Data.ByteString.Char8 as S8
1111import qualified Data.ByteString.Lazy.Char8 as L8
12+import qualified Data.ByteString.Lazy as L
1213import Control.Arrow
1314
1415import Network.Wai.Middleware.Jsonp
@@ -17,7 +18,7 @@ import Network.Wai.Middleware.Vhost
1718import Network.Wai.Middleware.Autohead
1819import Codec.Compression.GZip (decompress)
1920
20−import Data.Enumerator (run_, enumList, ($$))
21+import Data.Enumerator (run_, enumList, ($$), Iteratee)
2122import Control.Monad.IO.Class (liftIO)
2223
2324main :: IO ()
@@ -80,6 +81,12 @@ caseParseHttpAccept = do
8081 expected = ["text/html", "text/x-c", "text/x-dvi", "text/plain"]
8182 map S8.pack expected @=? parseHttpAccept input
8283
84+parseRequestBody' :: Sink ([S8.ByteString] -> [S8.ByteString]) L.ByteString
85+ -> SRequest
86+ -> Iteratee S.ByteString IO ([(S.ByteString, S.ByteString)], [(S.ByteString, FileInfo L.ByteString)])
87+parseRequestBody' sink (SRequest req bod) =
88+ enumList 1 (L.toChunks bod) $$ parseRequestBody sink req
89+
8390caseParseRequestBody :: Assertion
8491caseParseRequestBody = run_ t where
8592 content2 = S8.pack $
@@ -102,13 +109,13 @@ caseParseRequestBody = run_ t where
102109 t = do
103110 let content1 = S8.pack "foo=bar&baz=bin"
104111 let ctype1 = S8.pack "application/x-www-form-urlencoded"
105− result1 <- parseRequestBody lbsSink $ toRequest ctype1 content1
112+ result1 <- parseRequestBody' lbsSink $ toRequest ctype1 content1
106113 liftIO $ assertEqual "parsing post x-www-form-urlencoded"
107114 (map (S8.pack *** S8.pack) [("foo", "bar"), ("baz", "bin")], [])
108115 result1
109116
110117 let ctype2 = S8.pack "multipart/form-data; boundary=AaB03x"
111− result2 <- parseRequestBody lbsSink $ toRequest ctype2 content2
118+ result2 <- parseRequestBody' lbsSink $ toRequest ctype2 content2
112119 let expectedsmap2 =
113120 [ ("title", "A File")
114121 , ("summary", "This is my file\nfile test")
@@ -123,7 +130,7 @@ caseParseRequestBody = run_ t where
123130 result2
124131
125132 let ctype3 = S8.pack "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh"
126− result3 <- parseRequestBody lbsSink $ toRequest ctype3 content3
133+ result3 <- parseRequestBody' lbsSink $ toRequest ctype3 content3
127134 let expectedsmap3 = []
128135 let expectedfile3 = [(S8.pack "yaml", FileInfo (S8.pack "README") (S8.pack "application/octet-stream") $
129136 L8.pack "Photo blog using Hack.\n")]
@@ -132,27 +139,25 @@ caseParseRequestBody = run_ t where
132139 expected3
133140 result3
134141
135− result2' <- parseRequestBody lbsSink $ toRequest' ctype2 content2
142+ result2' <- parseRequestBody' lbsSink $ toRequest' ctype2 content2
136143 liftIO $ assertEqual "parsing post multipart/form-data 2"
137144 expected2
138145 result2'
139146
140− result3' <- parseRequestBody lbsSink $ toRequest' ctype3 content3
147+ result3' <- parseRequestBody' lbsSink $ toRequest' ctype3 content3
141148 liftIO $ assertEqual "parsing actual post multipart/form-data 2"
142149 expected3
143150 result3'
144151
145−toRequest :: S8.ByteString -> S8.ByteString -> Request
146−toRequest ctype content = Request
152+toRequest :: S8.ByteString -> S8.ByteString -> SRequest
153+toRequest ctype content = SRequest (Request
147154 { requestHeaders = [("Content-Type", ctype)]
148− , requestBody = enumList 1 [content]
149− }
155+ }) (L.fromChunks [content])
150156
151−toRequest' :: S8.ByteString -> S8.ByteString -> Request
152−toRequest' ctype content = Request
157+toRequest' :: S8.ByteString -> S8.ByteString -> SRequest
158+toRequest' ctype content = SRequest (Request
153159 { requestHeaders = [("Content-Type", ctype)]
154− , requestBody = enumList 1 $ map S.singleton $ S.unpack content
155− }
160+ }) (L.fromChunks $ map S.singleton $ S.unpack content)
156161
157162caseFindBound :: Assertion
158163caseFindBound = do