on master help sign in
Tests working again
452c6e6Michael Snoyman
runtests.hs+19−14
@@ -9,6 +9,7 @@ import Network.Wai.Parse
9import qualified Data.ByteString as S
9import qualified Data.ByteString as S
10import qualified Data.ByteString.Char8 as S8
10import qualified Data.ByteString.Char8 as S8
11import qualified Data.ByteString.Lazy.Char8 as L8
11import qualified Data.ByteString.Lazy.Char8 as L8
12+import qualified Data.ByteString.Lazy as L
12import Control.Arrow
13import Control.Arrow
13
14
14import Network.Wai.Middleware.Jsonp
15import Network.Wai.Middleware.Jsonp
@@ -17,7 +18,7 @@ import Network.Wai.Middleware.Vhost
17import Network.Wai.Middleware.Autohead
18import Network.Wai.Middleware.Autohead
18import Codec.Compression.GZip (decompress)
19import Codec.Compression.GZip (decompress)
19
20
20−import Data.Enumerator (run_, enumList, ($$))
21+import Data.Enumerator (run_, enumList, ($$), Iteratee)
21import Control.Monad.IO.Class (liftIO)
22import Control.Monad.IO.Class (liftIO)
22
23
23main :: IO ()
24main :: IO ()
@@ -80,6 +81,12 @@ caseParseHttpAccept = do
80 expected = ["text/html", "text/x-c", "text/x-dvi", "text/plain"]
81 expected = ["text/html", "text/x-c", "text/x-dvi", "text/plain"]
81 map S8.pack expected @=? parseHttpAccept input
82 map S8.pack expected @=? parseHttpAccept input
82
83
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+
83caseParseRequestBody :: Assertion
90caseParseRequestBody :: Assertion
84caseParseRequestBody = run_ t where
91caseParseRequestBody = run_ t where
85 content2 = S8.pack $
92 content2 = S8.pack $
@@ -102,13 +109,13 @@ caseParseRequestBody = run_ t where
102 t = do
109 t = do
103 let content1 = S8.pack "foo=bar&baz=bin"
110 let content1 = S8.pack "foo=bar&baz=bin"
104 let ctype1 = S8.pack "application/x-www-form-urlencoded"
111 let ctype1 = S8.pack "application/x-www-form-urlencoded"
105− result1 <- parseRequestBody lbsSink $ toRequest ctype1 content1
112+ result1 <- parseRequestBody' lbsSink $ toRequest ctype1 content1
106 liftIO $ assertEqual "parsing post x-www-form-urlencoded"
113 liftIO $ assertEqual "parsing post x-www-form-urlencoded"
107 (map (S8.pack *** S8.pack) [("foo", "bar"), ("baz", "bin")], [])
114 (map (S8.pack *** S8.pack) [("foo", "bar"), ("baz", "bin")], [])
108 result1
115 result1
109
116
110 let ctype2 = S8.pack "multipart/form-data; boundary=AaB03x"
117 let ctype2 = S8.pack "multipart/form-data; boundary=AaB03x"
111− result2 <- parseRequestBody lbsSink $ toRequest ctype2 content2
118+ result2 <- parseRequestBody' lbsSink $ toRequest ctype2 content2
112 let expectedsmap2 =
119 let expectedsmap2 =
113 [ ("title", "A File")
120 [ ("title", "A File")
114 , ("summary", "This is my file\nfile test")
121 , ("summary", "This is my file\nfile test")
@@ -123,7 +130,7 @@ caseParseRequestBody = run_ t where
123 result2
130 result2
124
131
125 let ctype3 = S8.pack "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh"
132 let ctype3 = S8.pack "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh"
126− result3 <- parseRequestBody lbsSink $ toRequest ctype3 content3
133+ result3 <- parseRequestBody' lbsSink $ toRequest ctype3 content3
127 let expectedsmap3 = []
134 let expectedsmap3 = []
128 let expectedfile3 = [(S8.pack "yaml", FileInfo (S8.pack "README") (S8.pack "application/octet-stream") $
135 let expectedfile3 = [(S8.pack "yaml", FileInfo (S8.pack "README") (S8.pack "application/octet-stream") $
129 L8.pack "Photo blog using Hack.\n")]
136 L8.pack "Photo blog using Hack.\n")]
@@ -132,27 +139,25 @@ caseParseRequestBody = run_ t where
132 expected3
139 expected3
133 result3
140 result3
134
141
135− result2' <- parseRequestBody lbsSink $ toRequest' ctype2 content2
142+ result2' <- parseRequestBody' lbsSink $ toRequest' ctype2 content2
136 liftIO $ assertEqual "parsing post multipart/form-data 2"
143 liftIO $ assertEqual "parsing post multipart/form-data 2"
137 expected2
144 expected2
138 result2'
145 result2'
139
146
140− result3' <- parseRequestBody lbsSink $ toRequest' ctype3 content3
147+ result3' <- parseRequestBody' lbsSink $ toRequest' ctype3 content3
141 liftIO $ assertEqual "parsing actual post multipart/form-data 2"
148 liftIO $ assertEqual "parsing actual post multipart/form-data 2"
142 expected3
149 expected3
143 result3'
150 result3'
144
151
145−toRequest :: S8.ByteString -> S8.ByteString -> Request
152+toRequest :: S8.ByteString -> S8.ByteString -> SRequest
146−toRequest ctype content = Request
153+toRequest ctype content = SRequest (Request
147 { requestHeaders = [("Content-Type", ctype)]
154 { requestHeaders = [("Content-Type", ctype)]
148− , requestBody = enumList 1 [content]
155+ }) (L.fromChunks [content])
149− }
150
156
151−toRequest' :: S8.ByteString -> S8.ByteString -> Request
157+toRequest' :: S8.ByteString -> S8.ByteString -> SRequest
152−toRequest' ctype content = Request
158+toRequest' ctype content = SRequest (Request
153 { requestHeaders = [("Content-Type", ctype)]
159 { requestHeaders = [("Content-Type", ctype)]
154− , requestBody = enumList 1 $ map S.singleton $ S.unpack content
160+ }) (L.fromChunks $ map S.singleton $ S.unpack content)
155− }
156
161
157caseFindBound :: Assertion
162caseFindBound :: Assertion
158caseFindBound = do
163caseFindBound = do