@@ -5,6 +5,7 @@
55module Network.Wai.Parse
66 ( parseHttpAccept
77 , parseRequestBody
8+ , conduitRequestBody
89 , Sink (..)
910 , lbsSink
1011 , tempFileSink
@@ -36,6 +37,7 @@ import qualified Data.Conduit as C
3637import qualified Data.Conduit.List as CL
3738import Control.Monad.IO.Class (liftIO)
3839import qualified Network.HTTP.Types as H
40+import Data.Either (partitionEithers)
3941
4042uncons :: S.ByteString -> Maybe (Word8, S.ByteString)
4143uncons s
@@ -129,15 +131,23 @@ type File y = (S.ByteString, FileInfo y)
129131parseRequestBody :: Sink x y
130132 -> Request
131133 -> C.Sink S.ByteString IO ([Param], [File y])
132−parseRequestBody sink req = do
134+parseRequestBody s r = fmap partitionEithers $ conduitRequestBody s r C.=$ CL.consume
135+
136+conduitRequestBody :: Sink x y
137+ -> Request
138+ -> C.Conduit S.ByteString IO (Either Param (File y))
139+conduitRequestBody sink req = do
133140 case ctype of
134− Nothing -> return ([], [])
135− Just Nothing -> do -- url-encoded
141+ Nothing -> C.Conduit $ return $ C.PreparedConduit
142+ { C.conduitPush = \bs -> return $ C.Finished (Just bs) []
143+ , C.conduitClose = return []
144+ }
145+ Just Nothing -> C.sequenceSink () $ \() -> do -- url-encoded
136146 -- NOTE: in general, url-encoded data will be in a single chunk.
137147 -- Therefore, I'm optimizing for the usual case by sticking with
138148 -- strict byte strings here.
139149 bs <- CL.consume
140− return (H.parseSimpleQuery $ S.concat bs, [])
150+ return $ C.Emit () $ map Left $ H.parseSimpleQuery $ S.concat bs
141151 Just (Just bound) -> -- multi-part
142152 let bound'' = S8.pack "--" `S.append` bound
143153 in parsePieces sink bound''
@@ -186,12 +196,18 @@ takeLines = do
186196 return $ l : ls
187197
188198parsePieces :: Sink x y -> S.ByteString
189− -> C.Sink S.ByteString IO ([Param], [File y])
190−parsePieces sink bound = do
199+ -> C.Conduit S.ByteString IO (Either Param (File y))
200+parsePieces sink bound = C.sequenceSink True (parsePiecesSink sink bound)
201+
202+parsePiecesSink :: Sink x y
203+ -> S.ByteString
204+ -> C.SequencedSink Bool S.ByteString IO (Either Param (File y))
205+parsePiecesSink _ _ False = return C.Stop
206+parsePiecesSink sink bound True = do
191207 _boundLine <- takeLine
192208 res' <- takeLines
193209 case res' of
194− [] -> return ([], [])
210+ [] -> return C.Stop
195211 _ -> do
196212 let ls' = map parsePair res'
197213 let x = do
@@ -209,11 +225,7 @@ parsePieces sink bound = do
209225 y <- liftIO $ sinkClose sink seed'
210226 let fi = FileInfo filename ct y
211227 let y' = (name, fi)
212− (xs, ys) <-
213− if wasFound
214− then parsePieces sink bound
215− else return ([], [])
216− return (xs, y' : ys)
228+ return $ C.Emit wasFound [Right y']
217229 Just (_ct, name, Nothing) -> do
218230 let seed = id
219231 let iter front bs = return $ front . (:) bs
@@ -221,19 +233,13 @@ parsePieces sink bound = do
221233 sinkTillBound bound iter seed
222234 let bs = S.concat $ front []
223235 let x' = (name, qsDecode bs)
224− (xs, ys) <-
225− if wasFound
226− then parsePieces sink bound
227− else return ([], [])
228− return (x' : xs, ys)
236+ return $ C.Emit wasFound [Left x']
229237 _ -> do
230238 -- ignore this part
231239 let seed = ()
232240 iter () _ = return ()
233241 ((), wasFound) <- sinkTillBound bound iter seed
234− if wasFound
235− then parsePieces sink bound
236− else return ([], [])
242+ return $ C.Emit wasFound []
237243 where
238244 contDisp = S8.pack "Content-Disposition"
239245 contType = S8.pack "Content-Type"