git.iko.soy/typeable/wai
on master help sign in
Tests all pass
commit37c2cc68e949b4f1ce3a04f4dfb9c1695c163ee3 authorMichael Snoyman <michael@snoyman.com> dateThu 10 Mar 2011, 11:01 (16 years ago) parent1c4a41d
3 files changed+29−53
compare with master
unifiedsplit
Network/Wai/Parse.hs+6−32 Network/Wai/Zlib.hs+2−1 runtests.hs+21−20
Network/Wai/Parse.hs+6−32
@@ -3,8 +3,7 @@
33-- | Some helpers for parsing data out of a raw WAI 'Request'.
44
55module Network.Wai.Parse
6− ( parseQueryString
7− , parseHttpAccept
6+ ( parseHttpAccept
87 , parseRequestBody
98 , Sink (..)
109 , lbsSink
@@ -36,6 +35,7 @@ import qualified Data.Enumerator as E
3635import qualified Data.Enumerator.List as EL
3736import Control.Monad.IO.Class (liftIO)
3837import qualified Data.Ascii as A
38+import qualified Network.HTTP.Types as H
3939
4040uncons :: S.ByteString -> Maybe (Word8, S.ByteString)
4141uncons s
@@ -47,33 +47,6 @@ breakDiscard w s =
4747 let (x, y) = S.break (== w) s
4848 in (x, S.drop 1 y)
4949
50−-- | Split out the query string into a list of keys and values. A few
51−-- importants points:
52−--
53−-- * There is no way to distinguish between a parameter with no value and a
54−-- parameter with an empty value. Eg, "foo=" and "foo" are the same.
55−--
56−-- * The result returned is still bytestrings, since we perform no character
57−-- decoding here. Most likely, you will want to use UTF-8 decoding, but this is
58−-- left to the user of the library.
59−--
60−-- * Percent decoding errors are ignored. In particular, "%Q" will be output as
61−-- "%Q".
62−parseQueryString :: S.ByteString -> [(S.ByteString, S.ByteString)]
63−parseQueryString = parseQueryString' . dropQuestion
64− where
65− dropQuestion q | S.null q || S.head q /= 63 = q
66− dropQuestion q | otherwise = S.tail q
67− parseQueryString' q | S.null q = []
68− parseQueryString' q =
69− let (x, xs) = breakDiscard 38 q -- ampersand
70− in parsePair x : parseQueryString' xs
71− where
72− parsePair x =
73− let (k, v) = breakDiscard 61 x -- equal sign
74− in (qsDecode k, qsDecode v)
75−
76−
7750qsDecode :: S.ByteString -> S.ByteString
7851qsDecode z = fst $ S.unfoldrN (S.length z) go z
7952 where
@@ -97,11 +70,12 @@ qsDecode z = fst $ S.unfoldrN (S.length z) go z
9770 combine a b = shiftL a 4 .|. b
9871
9972-- | Parse the HTTP accept string to determine supported content types.
100−parseHttpAccept :: S.ByteString -> [S.ByteString]
101−parseHttpAccept = map fst
73+parseHttpAccept :: A.Ascii -> [A.Ascii]
74+parseHttpAccept = map (A.unsafeFromByteString . fst)
10275 . sortBy (rcompare `on` snd)
10376 . map grabQ
10477 . S.split 44 -- comma
78+ . A.toByteString
10579 where
10680 rcompare :: Double -> Double -> Ordering
10781 rcompare = flip compare
@@ -164,7 +138,7 @@ parseRequestBody sink req = do
164138 -- Therefore, I'm optimizing for the usual case by sticking with
165139 -- strict byte strings here.
166140 bs <- EL.consume
167− return (parseQueryString $ S.concat bs, [])
141+ return (H.parseSimpleQuery $ S.concat bs, [])
168142 Just (Just bound) -> -- multi-part
169143 let bound'' = S8.pack "--" `S.append` bound
170144 in parsePieces sink bound''
Network/Wai/Zlib.hs+2−1
@@ -3,8 +3,9 @@ module Network.Wai.Zlib (compress) where
33import Prelude hiding (head)
44import Data.Enumerator
55 ( Enumeratee, checkDone, Stream (..)
6− , (>>==), head, ($$), joinI
6+ , (>>==), ($$), joinI
77 )
8+import Data.Enumerator.List (head)
89import Blaze.ByteString.Builder (Builder, fromByteString)
910import Blaze.ByteString.Builder.Enumerator (builderToByteString)
1011import Control.Monad.IO.Class (liftIO)
runtests.hs+21−20
@@ -24,6 +24,8 @@ import Data.Enumerator (run_, enumList, ($$), Iteratee)
2424import Data.Enumerator.Binary (enumFile)
2525import Control.Monad.IO.Class (liftIO)
2626import Data.Maybe (fromMaybe)
27+import Network.HTTP.Types (parseSimpleQuery, status200)
28+import qualified Data.Ascii as A
2729
2830main :: IO ()
2931main = defaultMain [testSuite]
@@ -51,7 +53,7 @@ testSuite = testGroup "Network.Wai.Parse"
5153caseParseQueryString :: Assertion
5254caseParseQueryString = do
5355 let go l r =
54− map (S8.pack *** S8.pack) l @=? parseQueryString (S8.pack r)
56+ map (S8.pack *** S8.pack) l @=? parseSimpleQuery (S8.pack r)
5557
5658 go [] ""
5759 go [("foo", "")] "foo"
@@ -68,7 +70,7 @@ caseParseQueryStringQM :: Assertion
6870caseParseQueryStringQM = do
6971 let go l r =
7072 map (S8.pack *** S8.pack) l
71− @=? parseQueryString (S8.pack $ '?' : r)
73+ @=? parseSimpleQuery (S8.pack $ '?' : r)
7274
7375 go [] ""
7476 go [("foo", "")] "foo"
@@ -83,10 +85,9 @@ caseParseQueryStringQM = do
8385
8486caseParseHttpAccept :: Assertion
8587caseParseHttpAccept = do
86− let input =
87− S8.pack "text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c"
88+ let input = "text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c"
8889 expected = ["text/html", "text/x-c", "text/x-dvi", "text/plain"]
89− map S8.pack expected @=? parseHttpAccept input
90+ expected @=? parseHttpAccept input
9091
9192parseRequestBody' :: Sink ([S8.ByteString] -> [S8.ByteString]) L.ByteString
9293 -> SRequest
@@ -114,14 +115,14 @@ caseParseRequestBody = run_ t where
114115 "--AaB03x--"
115116 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"
116117 t = do
117− let content1 = S8.pack "foo=bar&baz=bin"
118− let ctype1 = S8.pack "application/x-www-form-urlencoded"
118+ let content1 = "foo=bar&baz=bin"
119+ let ctype1 = "application/x-www-form-urlencoded"
119120 result1 <- parseRequestBody' lbsSink $ toRequest ctype1 content1
120121 liftIO $ assertEqual "parsing post x-www-form-urlencoded"
121122 (map (S8.pack *** S8.pack) [("foo", "bar"), ("baz", "bin")], [])
122123 result1
123124
124− let ctype2 = S8.pack "multipart/form-data; boundary=AaB03x"
125+ let ctype2 = "multipart/form-data; boundary=AaB03x"
125126 result2 <- parseRequestBody' lbsSink $ toRequest ctype2 content2
126127 let expectedsmap2 =
127128 [ ("title", "A File")
@@ -136,7 +137,7 @@ caseParseRequestBody = run_ t where
136137 expected2
137138 result2
138139
139− let ctype3 = S8.pack "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh"
140+ let ctype3 = "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh"
140141 result3 <- parseRequestBody' lbsSink $ toRequest ctype3 content3
141142 let expectedsmap3 = []
142143 let expectedfile3 = [(S8.pack "yaml", FileInfo (S8.pack "README") (S8.pack "application/octet-stream") $
@@ -156,12 +157,12 @@ caseParseRequestBody = run_ t where
156157 expected3
157158 result3'
158159
159−toRequest :: S8.ByteString -> S8.ByteString -> SRequest
160+toRequest :: A.Ascii -> S8.ByteString -> SRequest
160161toRequest ctype content = SRequest (Request
161162 { requestHeaders = [("Content-Type", ctype)]
162163 }) (L.fromChunks [content])
163164
164−toRequest' :: S8.ByteString -> S8.ByteString -> SRequest
165+toRequest' :: A.Ascii -> S8.ByteString -> SRequest
165166toRequest' ctype content = SRequest (Request
166167 { requestHeaders = [("Content-Type", ctype)]
167168 }) (L.fromChunks $ map S.singleton $ S.unpack content)
@@ -223,21 +224,21 @@ jsonpApp = jsonp $ const $ return $ responseLBS
223224caseJsonp :: Assertion
224225caseJsonp = flip runSession jsonpApp $ do
225226 sres1 <- request Request
226− { queryString = "callback=test"
227+ { queryString = [("callback", Just "test")]
227228 , requestHeaders = [("Accept", "text/javascript")]
228229 }
229230 assertContentType "text/javascript" sres1
230231 assertBody "test({\"foo\":\"bar\"})" sres1
231232
232233 sres2 <- request Request
233− { queryString = "call_back=test"
234+ { queryString = [("call_back", Just "test")]
234235 , requestHeaders = [("Accept", "text/javascript")]
235236 }
236237 assertContentType "application/json" sres2
237238 assertBody "{\"foo\":\"bar\"}" sres2
238239
239240 sres3 <- request Request
240− { queryString = "callback=test"
241+ { queryString = [("callback", Just "test")]
241242 , requestHeaders = [("Accept", "text/html")]
242243 }
243244 assertContentType "application/json" sres3
@@ -299,19 +300,19 @@ moApp = methodOverride $ \req -> return $ responseLBS status200
299300caseMethodOverride = flip runSession moApp $ do
300301 sres1 <- request Request
301302 { requestMethod = "GET"
302− , queryString = ""
303+ , queryString = []
303304 }
304305 assertHeader "Method" "GET" sres1
305306
306307 sres2 <- request Request
307308 { requestMethod = "POST"
308− , queryString = ""
309+ , queryString = []
309310 }
310311 assertHeader "Method" "POST" sres2
311312
312313 sres3 <- request Request
313314 { requestMethod = "POST"
314− , queryString = "_method=PUT"
315+ , queryString = [("_method", Just "PUT")]
315316 }
316317 assertHeader "Method" "PUT" sres3
317318
@@ -320,19 +321,19 @@ aoApp = acceptOverride $ \req -> return $ responseLBS status200
320321
321322caseAcceptOverride = flip runSession aoApp $ do
322323 sres1 <- request Request
323− { queryString = ""
324+ { queryString = []
324325 , requestHeaders = [("Accept", "foo")]
325326 }
326327 assertHeader "Accept" "foo" sres1
327328
328329 sres2 <- request Request
329− { queryString = ""
330+ { queryString = []
330331 , requestHeaders = [("Accept", "bar")]
331332 }
332333 assertHeader "Accept" "bar" sres2
333334
334335 sres3 <- request Request
335− { queryString = "_accept=baz"
336+ { queryString = [("_accept", Just "baz")]
336337 , requestHeaders = [("Accept", "bar")]
337338 }
338339 assertHeader "Accept" "baz" sres3