@@ -89,21 +89,24 @@ lbsBackEnd :: Monad m => ignored1 -> ignored2 -> Sink S.ByteString m L.ByteStrin
8989lbsBackEnd _ _ = fmap L.fromChunks CL.consume
9090
9191-- | Save uploaded files on disk as temporary files
92−tempFileBackEnd :: MonadResource m => ignored1 -> ignored2 -> Sink S.ByteString m FilePath
92+--
93+-- Note: starting with version 2.0, it is the responsibility of the caller to
94+-- remove any temp files created by using this backend.
95+tempFileBackEnd :: InternalState -> ignored1 -> ignored2 -> Sink S.ByteString IO FilePath
9396tempFileBackEnd = tempFileBackEndOpts getTemporaryDirectory "webenc.buf"
9497
9598-- | Same as 'tempFileSink', but use configurable temp folders and patterns.
96−tempFileBackEndOpts :: MonadResource m
97− => IO FilePath -- ^ get temporary directory
99+tempFileBackEndOpts :: IO FilePath -- ^ get temporary directory
98100 -> String -- ^ filename pattern
101+ -> InternalState
99102 -> ignored1
100103 -> ignored2
101− -> Sink S.ByteString m FilePath
102−tempFileBackEndOpts getTmpDir pattern _ _ = do
103− (key, (fp, h)) <- lift $ allocate (do
104+ -> Sink S.ByteString IO FilePath
105+tempFileBackEndOpts getTmpDir pattern internalState _ _ = do
106+ (key, (fp, h)) <- flip runInternalState internalState $ allocate (do
104107 tempDir <- getTmpDir
105108 openBinaryTempFile tempDir pattern) (\(_, h) -> hClose h)
106− _ <- lift $ register $ removeFile fp
109+ _ <- runInternalState (register $ removeFile fp) internalState
107110 CB.sinkHandle h
108111 lift $ release key
109112 return fp
@@ -126,7 +129,7 @@ type File y = (S.ByteString, FileInfo y)
126129-- type, and returns a `Sink` for storing the contents.
127130type BackEnd a = S.ByteString -- ^ parameter name
128131 -> FileInfo ()
129− -> Sink S.ByteString (ResourceT IO) a
132+ -> Sink S.ByteString IO a
130133
131134data RequestBodyType = UrlEncoded | Multipart S.ByteString
132135
@@ -169,27 +172,24 @@ parseRequestBody :: BackEnd y
169172parseRequestBody s r =
170173 case getRequestBodyType r of
171174 Nothing -> return ([], [])
172− Just rbt -> runResourceT $ withInternalState $ \internalState ->
173− fmap partitionEithers $ requestBody r $$ conduitRequestBody internalState s rbt =$ CL.consume
175+ Just rbt -> fmap partitionEithers $ requestBody r $$ conduitRequestBody s rbt =$ CL.consume
174176
175−sinkRequestBody :: InternalState
176− -> BackEnd y
177+sinkRequestBody :: BackEnd y
177178 -> RequestBodyType
178179 -> Sink S.ByteString IO ([Param], [File y])
179−sinkRequestBody internalState s r = fmap partitionEithers $ conduitRequestBody internalState s r =$ CL.consume
180+sinkRequestBody s r = fmap partitionEithers $ conduitRequestBody s r =$ CL.consume
180181
181−conduitRequestBody :: InternalState
182− -> BackEnd y
182+conduitRequestBody :: BackEnd y
183183 -> RequestBodyType
184184 -> Conduit S.ByteString IO (Either Param (File y))
185−conduitRequestBody _ _ UrlEncoded = do
185+conduitRequestBody _ UrlEncoded = do
186186 -- NOTE: in general, url-encoded data will be in a single chunk.
187187 -- Therefore, I'm optimizing for the usual case by sticking with
188188 -- strict byte strings here.
189189 bs <- CL.consume
190190 mapM_ yield $ map Left $ H.parseSimpleQuery $ S.concat bs
191−conduitRequestBody internalState backend (Multipart bound) =
192− parsePieces internalState backend $ S8.pack "--" `S.append` bound
191+conduitRequestBody backend (Multipart bound) =
192+ parsePieces backend $ S8.pack "--" `S.append` bound
193193
194194takeLine :: Monad m => Consumer S.ByteString m (Maybe S.ByteString)
195195takeLine =
@@ -217,11 +217,10 @@ takeLines = do
217217 ls <- takeLines
218218 return $ l : ls
219219
220−parsePieces :: InternalState
221− -> BackEnd y
220+parsePieces :: BackEnd y
222221 -> S.ByteString
223222 -> ConduitM S.ByteString (Either Param (File y)) IO ()
224−parsePieces internalState sink bound =
223+parsePieces sink bound =
225224 loop
226225 where
227226 loop = do
@@ -239,7 +238,7 @@ parsePieces internalState sink bound =
239238 Just (mct, name, Just filename) -> do
240239 let ct = fromMaybe "application/octet-stream" mct
241240 fi0 = FileInfo filename ct ()
242− (wasFound, y) <- sinkTillBound' internalState bound name fi0 sink
241+ (wasFound, y) <- sinkTillBound' bound name fi0 sink
243242 yield $ Right (name, fi0 { fileContent = y })
244243 when wasFound loop
245244 Just (_ct, name, Nothing) -> do
@@ -291,18 +290,17 @@ findBound b bs = handleBreak $ Search.breakOn b bs
291290 | S.index b x == S.index bs y = mismatch xs ys
292291 | otherwise = True
293292
294−sinkTillBound' :: InternalState
295− -> S.ByteString
293+sinkTillBound' :: S.ByteString
296294 -> S.ByteString
297295 -> FileInfo ()
298296 -> BackEnd y
299297 -> ConduitM S.ByteString o IO (Bool, y)
300−sinkTillBound' internalState bound name fi sink =
298+sinkTillBound' bound name fi sink =
301299 ConduitM $ anyOutput $
302300 conduitTillBound bound >+> withUpstream (fix $ sink name fi)
303301 where
304− fix :: Sink S8.ByteString (ResourceT IO) y -> Pipe Void S8.ByteString Void Bool IO y
305− fix p = ignoreTerm >+> injectLeftovers (unConduitM $ transPipe (flip runInternalState internalState) p)
302+ fix :: Sink S8.ByteString IO y -> Pipe Void S8.ByteString Void Bool IO y
303+ fix p = ignoreTerm >+> injectLeftovers (unConduitM p)
306304 ignoreTerm = await' >>= maybe (return ()) (\x -> yield' x >> ignoreTerm)
307305 await' = NeedInput (return . Just) (const $ return Nothing)
308306 yield' = HaveOutput (return ()) (return ())