@@ -6,6 +6,9 @@
66module Network.Wai.Parse
77 ( parseHttpAccept
88 , parseRequestBody
9+ , RequestBodyType (..)
10+ , getRequestBodyType
11+ , sinkRequestBody
912 , conduitRequestBody
1013 , lbsBackEnd
1114 , tempFileBackEnd
@@ -146,29 +149,16 @@ data FileInfo c = FileInfo
146149type Param = (S.ByteString, S.ByteString)
147150type File y = (S.ByteString, FileInfo y)
148151
149−parseRequestBody :: BackEnd y
150− -> Request
151− -> C.Sink S.ByteString IO ([Param], [File y])
152−parseRequestBody s r = fmap partitionEithers $ conduitRequestBody s r C.=$ CL.consume
152+data RequestBodyType = UrlEncoded | Multipart S.ByteString
153153
154−conduitRequestBody :: BackEnd y
155− -> Request
156− -> C.Conduit S.ByteString IO (Either Param (File y))
157−conduitRequestBody sink req = do
158− case ctype of
159− Nothing -> C.Conduit
160− { C.conduitPush = \bs -> return $ C.Finished (Just bs) []
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''
154+getRequestBodyType :: Request -> Maybe RequestBodyType
155+getRequestBodyType req = do
156+ ctype <- lookup "Content-Type" $ requestHeaders req
157+ if urlenc `S.isPrefixOf` ctype
158+ then Just UrlEncoded
159+ else case boundary ctype of
160+ Just x -> Just $ Multipart x
161+ Nothing -> Nothing
172162 where
173163 urlenc = S8.pack "application/x-www-form-urlencoded"
174164 formBound = S8.pack "multipart/form-data;"
@@ -181,13 +171,31 @@ conduitRequestBody sink req = do
181171 then Just $ S.drop (S.length bound') s'
182172 else Nothing
183173 else Nothing
184− ctype = do
185− ctype' <- lookup "Content-Type" $ requestHeaders req
186− if urlenc `S.isPrefixOf` ctype'
187− then Just Nothing
188− else case boundary ctype' of
189− Just x -> Just $ Just x
190− Nothing -> Nothing
174+
175+parseRequestBody :: BackEnd y
176+ -> Request
177+ -> C.ResourceT IO ([Param], [File y])
178+parseRequestBody s r =
179+ case getRequestBodyType r of
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
191199
192200takeLine :: C.Sink S.ByteString IO (Maybe S.ByteString)
193201takeLine =