@@ -51,13 +51,9 @@ import qualified Network.HTTP.Types as H
5151import Data.Either (partitionEithers)
5252import Control.Monad (when, unless)
5353import Control.Monad.Trans.Class (lift)
54−import Control.Monad.Trans.Resource (allocate, release, register)
55−#if MIN_VERSION_conduit(1, 0, 0)
54+import Control.Monad.Trans.Resource (allocate, release, register, InternalState, runInternalState)
5655import Data.Conduit.Internal (Pipe (NeedInput, HaveOutput), (>+>), withUpstream, injectLeftovers, ConduitM (..))
5756import Data.Void (Void)
58−#else
59−import Data.Conduit.Internal (sinkToPipe)
60−#endif
6157
6258breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
6359breakDiscard w s =
@@ -130,7 +126,7 @@ type File y = (S.ByteString, FileInfo y)
130126-- type, and returns a `Sink` for storing the contents.
131127type BackEnd a = S.ByteString -- ^ parameter name
132128 -> FileInfo ()
133− -> Sink S.ByteString IO a
129+ -> Sink S.ByteString (ResourceT IO) a
134130
135131data RequestBodyType = UrlEncoded | Multipart S.ByteString
136132
@@ -173,30 +169,28 @@ parseRequestBody :: BackEnd y
173169parseRequestBody s r =
174170 case getRequestBodyType r of
175171 Nothing -> return ([], [])
176− Just rbt -> fmap partitionEithers $ requestBody r $$ conduitRequestBody s rbt =$ CL.consume
172+ Just rbt -> fmap partitionEithers $ requestBody r $$ conduitRequestBody (resourceInternalState r) s rbt =$ CL.consume
177173
178−sinkRequestBody :: BackEnd y
174+sinkRequestBody :: InternalState
175+ -> BackEnd y
179176 -> RequestBodyType
180177 -> Sink S.ByteString IO ([Param], [File y])
181−sinkRequestBody s r = fmap partitionEithers $ conduitRequestBody s r =$ CL.consume
178+sinkRequestBody internalState s r = fmap partitionEithers $ conduitRequestBody internalState s r =$ CL.consume
182179
183−conduitRequestBody :: BackEnd y
180+conduitRequestBody :: InternalState
181+ -> BackEnd y
184182 -> RequestBodyType
185183 -> Conduit S.ByteString IO (Either Param (File y))
186−conduitRequestBody _ UrlEncoded = do
184+conduitRequestBody _ _ UrlEncoded = do
187185 -- NOTE: in general, url-encoded data will be in a single chunk.
188186 -- Therefore, I'm optimizing for the usual case by sticking with
189187 -- strict byte strings here.
190188 bs <- CL.consume
191189 mapM_ yield $ map Left $ H.parseSimpleQuery $ S.concat bs
192−conduitRequestBody backend (Multipart bound) =
193− parsePieces backend $ S8.pack "--" `S.append` bound
190+conduitRequestBody internalState backend (Multipart bound) =
191+ parsePieces internalState backend $ S8.pack "--" `S.append` bound
194192
195−#if MIN_VERSION_conduit(1, 0, 0)
196193takeLine :: Monad m => Consumer S.ByteString m (Maybe S.ByteString)
197−#else
198−takeLine :: Monad m => Pipe S.ByteString S.ByteString o u m (Maybe S.ByteString)
199−#endif
200194takeLine =
201195 go id
202196 where
@@ -211,11 +205,7 @@ takeLine =
211205 when (S.length y > 1) $ leftover $ S.drop 1 y
212206 return $ Just $ killCR x
213207
214−#if MIN_VERSION_conduit(1, 0, 0)
215208takeLines :: Consumer S.ByteString IO [S.ByteString]
216−#else
217−takeLines :: Pipe S.ByteString S.ByteString o u IO [S.ByteString]
218−#endif
219209takeLines = do
220210 res <- takeLine
221211 case res of
@@ -226,14 +216,11 @@ takeLines = do
226216 ls <- takeLines
227217 return $ l : ls
228218
229−parsePieces :: BackEnd y
219+parsePieces :: InternalState
220+ -> BackEnd y
230221 -> S.ByteString
231−#if MIN_VERSION_conduit(1, 0, 0)
232222 -> ConduitM S.ByteString (Either Param (File y)) IO ()
233−#else
234− -> Pipe S.ByteString S.ByteString (Either Param (File y)) u IO ()
235−#endif
236−parsePieces sink bound =
223+parsePieces internalState sink bound =
237224 loop
238225 where
239226 loop = do
@@ -251,7 +238,7 @@ parsePieces sink bound =
251238 Just (mct, name, Just filename) -> do
252239 let ct = fromMaybe "application/octet-stream" mct
253240 fi0 = FileInfo filename ct ()
254− (wasFound, y) <- sinkTillBound' bound name fi0 sink
241+ (wasFound, y) <- sinkTillBound' internalState bound name fi0 sink
255242 yield $ Right (name, fi0 { fileContent = y })
256243 when wasFound loop
257244 Just (_ct, name, Nothing) -> do
@@ -303,45 +290,30 @@ findBound b bs = handleBreak $ Search.breakOn b bs
303290 | S.index b x == S.index bs y = mismatch xs ys
304291 | otherwise = True
305292
306−sinkTillBound' :: S.ByteString
293+sinkTillBound' :: InternalState
294+ -> S.ByteString
307295 -> S.ByteString
308296 -> FileInfo ()
309297 -> BackEnd y
310−#if MIN_VERSION_conduit(1, 0, 0)
311298 -> ConduitM S.ByteString o IO (Bool, y)
312−#else
313− -> Pipe S.ByteString S.ByteString o u IO (Bool, y)
314−#endif
315−sinkTillBound' bound name fi sink =
316−#if MIN_VERSION_conduit(1, 0, 0)
299+sinkTillBound' internalState bound name fi sink =
317300 ConduitM $ anyOutput $
318−#endif
319301 conduitTillBound bound >+> withUpstream (fix $ sink name fi)
320302 where
321−#if MIN_VERSION_conduit(1, 0, 0)
322− fix :: Sink S8.ByteString IO y -> Pipe Void S8.ByteString Void Bool IO y
323− fix (ConduitM p) = ignoreTerm >+> injectLeftovers p
303+ fix :: Sink S8.ByteString (ResourceT IO) y -> Pipe Void S8.ByteString Void Bool IO y
304+ fix p = ignoreTerm >+> injectLeftovers (unConduitM $ transPipe (flip runInternalState internalState) p)
324305 ignoreTerm = await' >>= maybe (return ()) (\x -> yield' x >> ignoreTerm)
325306 await' = NeedInput (return . Just) (const $ return Nothing)
326307 yield' = HaveOutput (return ()) (return ())
327308
328309 anyOutput p = p >+> dropInput
329310 dropInput = NeedInput (const dropInput) return
330−#else
331− fix = sinkToPipe
332−#endif
333311
334312conduitTillBound :: Monad m
335313 => S.ByteString -- bound
336−#if MIN_VERSION_conduit(1, 0, 0)
337314 -> Pipe S.ByteString S.ByteString S.ByteString () m Bool
338−#else
339− -> Pipe S.ByteString S.ByteString S.ByteString u m Bool
340−#endif
341315conduitTillBound bound =
342−#if MIN_VERSION_conduit(1, 0, 0)
343316 unConduitM $
344−#endif
345317 go id
346318 where
347319 go front = await >>= maybe (close front) (push front)
@@ -371,26 +343,16 @@ conduitTillBound bound =
371343sinkTillBound :: S.ByteString
372344 -> (x -> S.ByteString -> IO x)
373345 -> x
374−#if MIN_VERSION_conduit(1, 0, 0)
375346 -> Consumer S.ByteString IO (Bool, x)
376−#else
377− -> Pipe S.ByteString S.ByteString o u IO (Bool, x)
378−#endif
379347sinkTillBound bound iter seed0 =
380−#if MIN_VERSION_conduit(1, 0, 0)
381348 ConduitM $
382−#endif
383349 (conduitTillBound bound >+> (withUpstream $ ij $ CL.foldM iter' seed0))
384350 where
385351 iter' a b = liftIO $ iter a b
386−#if MIN_VERSION_conduit(1, 0, 0)
387352 ij (ConduitM p) = ignoreTerm >+> injectLeftovers p
388353 ignoreTerm = await' >>= maybe (return ()) (\x -> yield' x >> ignoreTerm)
389354 await' = NeedInput (return . Just) (const $ return Nothing)
390355 yield' = HaveOutput (return ()) (return ())
391−#else
392− ij = id
393−#endif
394356
395357parseAttrs :: S.ByteString -> [(S.ByteString, S.ByteString)]
396358parseAttrs = map go . S.split 59 -- semicolon