382ed3a · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Better content-type parsing

382ed3aMichael Snoyman14 years ago

wai-extra/Network/Wai/Parse.hs+31−17

compare with master

unifiedsplit

@@ -1,6 +1,7 @@

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE ExistentialQuantification #-}

4+{-# LANGUAGE PatternGuards #-}

4-- | Some helpers for parsing data out of a raw WAI 'Request'.

5-- | Some helpers for parsing data out of a raw WAI 'Request'.

6module Network.Wai.Parse

7module Network.Wai.Parse

@@ -17,6 +18,7 @@ module Network.Wai.Parse

17 , Param

18 , Param

18 , File

19 , File

19 , FileInfo (..)

20 , FileInfo (..)

21+ , parseContentType

20#if TEST

22#if TEST

21 , Bound (..)

23 , Bound (..)

22 , findBound

24 , findBound

@@ -126,24 +128,36 @@ data RequestBodyType = UrlEncoded | Multipart S.ByteString

126

128

127getRequestBodyType :: Request -> Maybe RequestBodyType

129getRequestBodyType :: Request -> Maybe RequestBodyType

128getRequestBodyType req = do

130getRequestBodyType req = do

129− ctype <- lookup "Content-Type" $ requestHeaders req

131+ ctype' <- lookup "Content-Type" $ requestHeaders req

130− if urlenc `S.isPrefixOf` ctype

132+ let (ctype, attrs) = parseContentType ctype'

131− then Just UrlEncoded

133+ case ctype of

132− else case boundary ctype of

134+ "application/x-www-form-urlencoded" -> return UrlEncoded

133− Just x -> Just $ Multipart x

135+ "multipart/form-data" | Just bound <- lookup "boundary" attrs -> return $ Multipart bound

134− Nothing -> Nothing

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)

135 where

147 where

136− urlenc = S8.pack "application/x-www-form-urlencoded"

148+ semicolon = 59

137− formBound = S8.pack "multipart/form-data;"

149+ equals = 61

138− bound' = "boundary="

150+ space = 32

139− boundary s =

151+ goAttrs front bs

140− if "multipart/form-data;" `S.isPrefixOf` s

152+ | S.null bs = front []

141− then

153+ | otherwise =

142− let s' = S.dropWhile (== 32) $ S.drop (S.length formBound) s

154+ let (x, rest) = S.break (== semicolon) bs

143− in if bound' `S.isPrefixOf` s'

155+ in goAttrs (front . (goAttr x:)) $ S.drop 1 rest

144− then Just $ S.drop (S.length bound') s'

156+ goAttr bs =

145− else Nothing

157+ let (k, v') = S.break (== equals) bs

146− else Nothing

158+ v = S.drop 1 v'

159+ in (strip k, strip v)

160+ strip = S.dropWhile (== space) . fst . S.breakEnd (/= space)

147

161

148parseRequestBody :: BackEnd y

162parseRequestBody :: BackEnd y

149 -> Request

163 -> Request

wai-extra/test/WaiExtraTest.hs+22

@@ -12,6 +12,7 @@ import qualified Data.ByteString.Char8 as S8

12import qualified Data.ByteString.Lazy.Char8 as L8

13import qualified Data.ByteString.Lazy as L

14import qualified Data.Text.Lazy as T

15+import qualified Data.Text as TS

15import qualified Data.Text.Encoding as TE

16import qualified Data.Text.Encoding as TE

16import Control.Arrow

17import Control.Arrow

@@ -38,11 +39,19 @@ import qualified Data.IORef as I

38specs :: Spec

39specs :: Spec

39specs = do

40specs = do

40 describe "Network.Wai.Parse" $ do

41 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+ ]

41 it "parseQueryString" caseParseQueryString

49 it "parseQueryString" caseParseQueryString

42 it "parseQueryString with question mark" caseParseQueryStringQM

50 it "parseQueryString with question mark" caseParseQueryStringQM

43 it "parseHttpAccept" caseParseHttpAccept

51 it "parseHttpAccept" caseParseHttpAccept

44 it "parseRequestBody" caseParseRequestBody

52 it "parseRequestBody" caseParseRequestBody

45 it "multipart with plus" caseMultipartPlus

53 it "multipart with plus" caseMultipartPlus

54+ it "multipart with multiple attributes" caseMultipartAttrs

46 it "urlencoded with plus" caseUrlEncPlus

55 it "urlencoded with plus" caseUrlEncPlus

47 {-

56 {-

48 , it "findBound" caseFindBound

57 , it "findBound" caseFindBound

@@ -188,6 +197,19 @@ caseMultipartPlus = do

188 "--AaB03x--"

197 "--AaB03x--"

189 ctype = "multipart/form-data; boundary=AaB03x"

198 ctype = "multipart/form-data; boundary=AaB03x"

190

199

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+

191caseUrlEncPlus :: Assertion

213caseUrlEncPlus :: Assertion

192caseUrlEncPlus = do

214caseUrlEncPlus = do

193 result <- C.runResourceT $ parseRequestBody' lbsBackEnd $ toRequest ctype content

215 result <- C.runResourceT $ parseRequestBody' lbsBackEnd $ toRequest ctype content

wai-extra/wai-extra.cabal+1−1

@@ -1,5 +1,5 @@

1Name: wai-extra

2−Version: 1.3.1.1

2+Version: 1.3.2

3Synopsis: Provides some basic WAI handlers and middleware.

4Description: The goal here is to provide common features without many dependencies.

5License: MIT