git.iko.soy/typeable/wai
on master help sign in
Better content-type parsing
commit382ed3a6e97b6701576f5ec64dbd13c00c21d056 authorMichael Snoyman <michael@snoyman.com> dateThu 10 Jan 2013, 09:46 (14 years ago) parent354c8ef
3 files changed+54−18
compare with master
unifiedsplit
wai-extra/Network/Wai/Parse.hs+31−17 wai-extra/test/WaiExtraTest.hs+22 wai-extra/wai-extra.cabal+1−1
wai-extra/Network/Wai/Parse.hs+31−17
@@ -1,6 +1,7 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE OverloadedStrings #-}
33{-# LANGUAGE ExistentialQuantification #-}
4+{-# LANGUAGE PatternGuards #-}
45-- | Some helpers for parsing data out of a raw WAI 'Request'.
56
67module Network.Wai.Parse
@@ -17,6 +18,7 @@ module Network.Wai.Parse
1718 , Param
1819 , File
1920 , FileInfo (..)
21+ , parseContentType
2022#if TEST
2123 , Bound (..)
2224 , findBound
@@ -126,24 +128,36 @@ data RequestBodyType = UrlEncoded | Multipart S.ByteString
126128
127129getRequestBodyType :: Request -> Maybe RequestBodyType
128130getRequestBodyType req = do
129− ctype <- lookup "Content-Type" $ requestHeaders req
130− if urlenc `S.isPrefixOf` ctype
131− then Just UrlEncoded
132− else case boundary ctype of
133− Just x -> Just $ Multipart x
134− Nothing -> Nothing
131+ ctype' <- lookup "Content-Type" $ requestHeaders req
132+ let (ctype, attrs) = parseContentType ctype'
133+ case ctype of
134+ "application/x-www-form-urlencoded" -> return UrlEncoded
135+ "multipart/form-data" | Just bound <- lookup "boundary" attrs -> return $ Multipart bound
136+ _ -> Nothing
137+
138+-- | Parse a content type value, turning a single @ByteString@ into the actual
139+-- content type and a list of pairs of attributes.
140+--
141+-- Since 1.3.2
142+parseContentType :: S.ByteString -> (S.ByteString, [(S.ByteString, S.ByteString)])
143+parseContentType a = do
144+ let (ctype, b) = S.break (== semicolon) a
145+ attrs = goAttrs id $ S.drop 1 b
146+ in (ctype, attrs)
135147 where
136− urlenc = S8.pack "application/x-www-form-urlencoded"
137− formBound = S8.pack "multipart/form-data;"
138− bound' = "boundary="
139− boundary s =
140− if "multipart/form-data;" `S.isPrefixOf` s
141− then
142− let s' = S.dropWhile (== 32) $ S.drop (S.length formBound) s
143− in if bound' `S.isPrefixOf` s'
144− then Just $ S.drop (S.length bound') s'
145− else Nothing
146− else Nothing
148+ semicolon = 59
149+ equals = 61
150+ space = 32
151+ goAttrs front bs
152+ | S.null bs = front []
153+ | otherwise =
154+ let (x, rest) = S.break (== semicolon) bs
155+ in goAttrs (front . (goAttr x:)) $ S.drop 1 rest
156+ goAttr bs =
157+ let (k, v') = S.break (== equals) bs
158+ v = S.drop 1 v'
159+ in (strip k, strip v)
160+ strip = S.dropWhile (== space) . fst . S.breakEnd (/= space)
147161
148162parseRequestBody :: BackEnd y
149163 -> Request
wai-extra/test/WaiExtraTest.hs+22
@@ -12,6 +12,7 @@ import qualified Data.ByteString.Char8 as S8
1212import qualified Data.ByteString.Lazy.Char8 as L8
1313import qualified Data.ByteString.Lazy as L
1414import qualified Data.Text.Lazy as T
15+import qualified Data.Text as TS
1516import qualified Data.Text.Encoding as TE
1617import Control.Arrow
1718
@@ -38,11 +39,19 @@ import qualified Data.IORef as I
3839specs :: Spec
3940specs = do
4041 describe "Network.Wai.Parse" $ do
42+ describe "parseContentType" $ do
43+ let go (x, y, z) = it (TS.unpack $ TE.decodeUtf8 x) $ parseContentType x `shouldBe` (y, z)
44+ mapM_ go
45+ [ ("text/plain", "text/plain", [])
46+ , ("text/plain; charset=UTF-8 ", "text/plain", [("charset", "UTF-8")])
47+ , ("text/plain; charset=UTF-8 ; boundary = foo", "text/plain", [("charset", "UTF-8"), ("boundary", "foo")])
48+ ]
4149 it "parseQueryString" caseParseQueryString
4250 it "parseQueryString with question mark" caseParseQueryStringQM
4351 it "parseHttpAccept" caseParseHttpAccept
4452 it "parseRequestBody" caseParseRequestBody
4553 it "multipart with plus" caseMultipartPlus
54+ it "multipart with multiple attributes" caseMultipartAttrs
4655 it "urlencoded with plus" caseUrlEncPlus
4756 {-
4857 , it "findBound" caseFindBound
@@ -188,6 +197,19 @@ caseMultipartPlus = do
188197 "--AaB03x--"
189198 ctype = "multipart/form-data; boundary=AaB03x"
190199
200+caseMultipartAttrs :: Assertion
201+caseMultipartAttrs = do
202+ result <- C.runResourceT $ parseRequestBody' lbsBackEnd $ toRequest ctype content
203+ liftIO $ result @?= ([("email", "has+plus")], [])
204+ where
205+ content = S8.pack $
206+ "--AaB03x\n" ++
207+ "Content-Disposition: form-data; name=\"email\"\n" ++
208+ "Content-Type: text/plain; charset=iso-8859-1\n\n" ++
209+ "has+plus\n" ++
210+ "--AaB03x--"
211+ ctype = "multipart/form-data; charset=UTF-8; boundary=AaB03x"
212+
191213caseUrlEncPlus :: Assertion
192214caseUrlEncPlus = do
193215 result <- C.runResourceT $ parseRequestBody' lbsBackEnd $ toRequest ctype content
wai-extra/wai-extra.cabal+1−1
@@ -1,5 +1,5 @@
11Name: wai-extra
2−Version: 1.3.1.1
2+Version: 1.3.2
33Synopsis: Provides some basic WAI handlers and middleware.
44Description: The goal here is to provide common features without many dependencies.
55License: MIT