0d7d5db · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Better parseRequestBody

0d7d5dbMichael Snoyman15 years ago

wai-extra/Network/Wai/Middleware/RequestLogger.hs+6−3

compare with master

unifiedsplit

@@ -17,7 +17,7 @@ import Network.Wai (Request(..), Middleware)

17import System.Log.FastLogger

18import Network.HTTP.Types as H

20−import Network.Wai.Parse (parseRequestBody, lbsBackEnd, fileName, Param, File)

20+import Network.Wai.Parse (sinkRequestBody, lbsBackEnd, fileName, Param, File, getRequestBodyType)

21import qualified Data.ByteString.Lazy as LBS

23import qualified Data.Conduit as C

@@ -77,7 +77,7 @@ logCallbackDev cb app req = do

77 body <- requestBody req C.$$ CL.consume

78 postParams <- if any (requestMethod req ==) ["GET", "HEAD"]

79 then return []

80− else do postParams <- liftIO $ allPostParams req body

80+ else do postParams <- liftIO $ allPostParams body

81 return $ collectPostParams postParams

82 let getParams = map emptyGetParam $ queryString req

@@ -99,7 +99,10 @@ logCallbackDev cb app req = do

99 if null params then ""

100 else BS.concat ["\n", prefix, pack (show params)]

101

102+ allPostParams body =

103+ case getRequestBodyType req of

104+ Nothing -> return ([], [])

102− allPostParams req' body = C.runResourceT $ CL.sourceList body C.$$ parseRequestBody lbsBackEnd req'

105+ Just rbt -> C.runResourceT $ CL.sourceList body C.$$ sinkRequestBody lbsBackEnd rbt

103

106

104 emptyGetParam :: (BS.ByteString, Maybe BS.ByteString) -> (BS.ByteString, BS.ByteString)

107 emptyGetParam :: (BS.ByteString, Maybe BS.ByteString) -> (BS.ByteString, BS.ByteString)

105 emptyGetParam (k, Just v) = (k,v)

108 emptyGetParam (k, Just v) = (k,v)

wai-extra/Network/Wai/Parse.hs+37−29

@@ -6,6 +6,9 @@

6module Network.Wai.Parse

7 ( parseHttpAccept

8 , parseRequestBody

9+ , RequestBodyType (..)

10+ , getRequestBodyType

11+ , sinkRequestBody

9 , conduitRequestBody

12 , conduitRequestBody

10 , lbsBackEnd

13 , lbsBackEnd

11 , tempFileBackEnd

14 , tempFileBackEnd

@@ -146,29 +149,16 @@ data FileInfo c = FileInfo

146type Param = (S.ByteString, S.ByteString)

149type Param = (S.ByteString, S.ByteString)

147type File y = (S.ByteString, FileInfo y)

150type File y = (S.ByteString, FileInfo y)

148

151

149−parseRequestBody :: BackEnd y

152+data RequestBodyType = UrlEncoded | Multipart S.ByteString

150− -> Request

151− -> C.Sink S.ByteString IO ([Param], [File y])

152−parseRequestBody s r = fmap partitionEithers $ conduitRequestBody s r C.=$ CL.consume

153

154−conduitRequestBody :: BackEnd y

154+getRequestBodyType :: Request -> Maybe RequestBodyType

155− -> Request

155+getRequestBodyType req = do

156− -> C.Conduit S.ByteString IO (Either Param (File y))

156+ ctype <- lookup "Content-Type" $ requestHeaders req

157−conduitRequestBody sink req = do

157+ if urlenc `S.isPrefixOf` ctype

158+ then Just UrlEncoded

158− case ctype of

159+ else case boundary ctype of

159− Nothing -> C.Conduit

160+ Just x -> Just $ Multipart x

160− { C.conduitPush = \bs -> return $ C.Finished (Just bs) []

161+ Nothing -> Nothing

161− , C.conduitClose = return []

162− }

163− Just Nothing -> C.sequenceSink () $ \() -> do -- url-encoded

164− -- NOTE: in general, url-encoded data will be in a single chunk.

165− -- Therefore, I'm optimizing for the usual case by sticking with

166− -- strict byte strings here.

167− bs <- CL.consume

168− return $ C.Emit () $ map Left $ H.parseSimpleQuery $ S.concat bs

169− Just (Just bound) -> -- multi-part

170− let bound'' = S8.pack "--" `S.append` bound

171− in parsePieces sink bound''

172 where

162 where

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

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

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

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

@@ -181,13 +171,31 @@ conduitRequestBody sink req = do

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

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

182 else Nothing

172 else Nothing

183 else Nothing

173 else Nothing

184− ctype = do

174+

185− ctype' <- lookup "Content-Type" $ requestHeaders req

175+parseRequestBody :: BackEnd y

186− if urlenc `S.isPrefixOf` ctype'

176+ -> Request

187− then Just Nothing

177+ -> C.ResourceT IO ([Param], [File y])

188− else case boundary ctype' of

178+parseRequestBody s r =

189− Just x -> Just $ Just x

179+ case getRequestBodyType r of

190− Nothing -> Nothing

180+ Nothing -> return ([], [])

181+ Just rbt -> fmap partitionEithers $ requestBody r C.$$ conduitRequestBody s rbt C.=$ CL.consume

182+

183+sinkRequestBody :: BackEnd y

184+ -> RequestBodyType

185+ -> C.Sink S.ByteString IO ([Param], [File y])

186+sinkRequestBody s r = fmap partitionEithers $ conduitRequestBody s r C.=$ CL.consume

187+

188+conduitRequestBody :: BackEnd y

189+ -> RequestBodyType

190+ -> C.Conduit S.ByteString IO (Either Param (File y))

191+conduitRequestBody _ UrlEncoded = C.sequenceSink () $ \() -> do -- url-encoded

192+ -- NOTE: in general, url-encoded data will be in a single chunk.

193+ -- Therefore, I'm optimizing for the usual case by sticking with

194+ -- strict byte strings here.

195+ bs <- CL.consume

196+ return $ C.Emit () $ map Left $ H.parseSimpleQuery $ S.concat bs

197+conduitRequestBody backend (Multipart bound) =

198+ parsePieces backend $ S8.pack "--" `S.append` bound

191

199

192takeLine :: C.Sink S.ByteString IO (Maybe S.ByteString)

200takeLine :: C.Sink S.ByteString IO (Maybe S.ByteString)

193takeLine =

201takeLine =

wai-extra/test/WaiExtraTest.hs+8−3

@@ -100,7 +100,9 @@ parseRequestBody' :: BackEnd L.ByteString

100 -> SRequest

101 -> C.ResourceT IO ([(S.ByteString, S.ByteString)], [(S.ByteString, FileInfo L.ByteString)])

102parseRequestBody' sink (SRequest req bod) =

103+ case getRequestBodyType req of

104+ Nothing -> return ([], [])

103− CL.sourceList (L.toChunks bod) C.$$ parseRequestBody sink req

105+ Just rbt -> CL.sourceList (L.toChunks bod) C.$$ sinkRequestBody sink rbt

104

106

105caseParseRequestBody :: Assertion

107caseParseRequestBody :: Assertion

106caseParseRequestBody =

108caseParseRequestBody =

@@ -399,8 +401,11 @@ caseDalvikMultipart = do

399 let request' = defaultRequest

401 let request' = defaultRequest

400 { requestHeaders = headers

402 { requestHeaders = headers

401 }

403 }

404+ (params, files) <-

405+ case getRequestBodyType request' of

406+ Nothing -> return ([], [])

402− (params, files) <- C.runResourceT $ sourceFile "test/requests/dalvik-request"

407+ Just rbt -> C.runResourceT $ sourceFile "test/requests/dalvik-request"

403− C.$$ parseRequestBody lbsBackEnd request'

408+ C.$$ sinkRequestBody lbsBackEnd rbt

404 lookup "scannedTime" params @?= Just "1.298590056748E9"

409 lookup "scannedTime" params @?= Just "1.298590056748E9"

405 lookup "geoLong" params @?= Just "0"

410 lookup "geoLong" params @?= Just "0"

406 lookup "geoLat" params @?= Just "0"

411 lookup "geoLat" params @?= Just "0"