@@ -32,9 +32,8 @@ import Data.Function (on)
3232import System.Directory (removeFile, getTemporaryDirectory)
3333import System.IO (hClose, openBinaryTempFile, Handle)
3434import Network.Wai
35−import Data.Enumerator (Iteratee, yield)
36−import qualified Data.Enumerator as E
37−import qualified Data.Enumerator.List as EL
35+import qualified Data.Conduit as C
36+import qualified Data.Conduit.List as CL
3837import Control.Monad.IO.Class (liftIO)
3938import qualified Network.HTTP.Types as H
4039
@@ -129,7 +128,7 @@ type File y = (S.ByteString, FileInfo y)
129128
130129parseRequestBody :: Sink x y
131130 -> Request
132− -> Iteratee S.ByteString IO ([Param], [File y])
131+ -> C.Sink S.ByteString IO ([Param], [File y])
133132parseRequestBody sink req = do
134133 case ctype of
135134 Nothing -> return ([], [])
@@ -137,7 +136,7 @@ parseRequestBody sink req = do
137136 -- NOTE: in general, url-encoded data will be in a single chunk.
138137 -- Therefore, I'm optimizing for the usual case by sticking with
139138 -- strict byte strings here.
140− bs <- EL.consume
139+ bs <- CL.consume
141140 return (H.parseSimpleQuery $ S.concat bs, [])
142141 Just (Just bound) -> -- multi-part
143142 let bound'' = S8.pack "--" `S.append` bound
@@ -162,24 +161,20 @@ parseRequestBody sink req = do
162161 Just x -> Just $ Just x
163162 Nothing -> Nothing
164163
165−takeLine :: Iteratee S.ByteString IO (Maybe S.ByteString)
166−takeLine = do
167− mbs <- EL.head
168− case mbs of
169− Nothing -> return Nothing
170− Just bs ->
171− let (x, y) = S.break (== 10) bs -- LF
172− in if S.null y
173− then do
174− x' <- takeLine
175− case x' of
176− Nothing -> return $ Just $ killCR x
177− Just x'' -> return $ Just $ killCR $ S.append x x''
178− else do
179− E.yield () $ E.Chunks [S.drop 1 y]
180− return $ Just $ killCR x
164+takeLine :: C.Sink S.ByteString IO (Maybe S.ByteString)
165+takeLine =
166+ C.sinkState id push close
167+ where
168+ close _ = return Nothing
169+ push front bs = do
170+ let (x, y) = S.break (== 10) $ front bs -- LF
171+ in if S.null y
172+ then return (S.append x, C.Processing)
173+ else do
174+ let lo = if S.length y > 1 then Just (S.drop 1 y) else Nothing
175+ return (error "takeLine", C.Done lo $ Just $ killCR x)
181176
182−takeLines :: Iteratee S.ByteString IO [S.ByteString]
177+takeLines :: C.Sink S.ByteString IO [S.ByteString]
183178takeLines = do
184179 res <- takeLine
185180 case res of
@@ -191,7 +186,7 @@ takeLines = do
191186 return $ l : ls
192187
193188parsePieces :: Sink x y -> S.ByteString
194− -> Iteratee S.ByteString IO ([Param], [File y])
189+ -> C.Sink S.ByteString IO ([Param], [File y])
195190parsePieces sink bound = do
196191 _boundLine <- takeLine
197192 res' <- takeLines
@@ -271,56 +266,32 @@ findBound b bs = go [0..S.length bs - 1]
271266sinkTillBound :: S.ByteString
272267 -> (x -> S.ByteString -> IO x)
273268 -> x
274− -> Iteratee S.ByteString IO (x, Bool)
275−sinkTillBound bound iter seed = do
276− mbs <- EL.head
277− case mbs of
278− Nothing -> return (seed, False)
279− Just bs -> go bs
269+ -> C.Sink S.ByteString IO (x, Bool)
270+sinkTillBound bound iter seed0 = C.sinkState
271+ (id, seed0)
272+ push
273+ close
280274 where
281− go bs =
275+ close (front, seed) = do
276+ seed' <- liftIO $ iter seed $ front S.empty
277+ return (seed', False)
278+ push (front, seed) bs' = do
279+ let bs = front bs'
282280 case findBound bound bs of
283281 FoundBound before after -> do
284282 let before' = killCRLF before
285283 seed' <- liftIO $ iter seed before'
286− yield () $ E.Chunks [after]
287− return (seed', True)
288− PartialBound -> do
289− mbs <- EL.head
290− case mbs of
291− Nothing -> do
292− seed' <- liftIO $ iter seed bs
293− return (seed', False)
294− Just bs2 -> do
295− let bs' = bs `S.append` bs2
296− yield () $ E.Chunks [bs']
297− sinkTillBound bound iter seed
284+ return (undefined, C.Done (Just after) (seed', True))
298285 NoBound -> do
299− mbs <- EL.head
300− case mbs of
301− Nothing -> do
302− seed' <- liftIO $ iter seed bs
303− sinkTillBound bound iter seed'
304− Just bs' -> do
305− -- this funny bit is to catch when there's a
306− -- newline at the end of the previous chunk
307− (seed', bs'') <-
308− if not (S8.null bs) && S8.last bs `elem` "\n\r"
309− then do
310− let (front, back) =
311− S.splitAt (S.length bs - 2) bs
312− seed' <- liftIO $ iter seed front
313− return (seed', back `S.append` bs')
314− else do
315− seed' <- liftIO $ iter seed bs
316− return (seed', bs')
317− yield () $ E.Chunks [bs'']
318− sinkTillBound bound iter seed'
319− {-
320− NoBound -> do
321− case msrc of
322− Just (bs', src') -> do
323− -}
286+ -- don't emit newlines, in case it's part of a bound
287+ let (toEmit, front') =
288+ if not (S8.null bs) && S8.last bs `elem` "\r\n"
289+ then let (x, y) = S.splitAt (S.length bs - 2) bs
290+ in (x, S.append y)
291+ else (bs, id)
292+ seed' <- liftIO $ iter seed toEmit
293+ return ((front', seed'), C.Processing)
294+ PartialBound -> return ((S.append bs, seed), C.Processing)
324295
325296parseAttrs :: S.ByteString -> [(S.ByteString, S.ByteString)]
326297parseAttrs = map go . S.split 59 -- semicolon