@@ -11,7 +11,6 @@ module Network.Wai.Parse
1111 , RequestBodyType (..)
1212 , getRequestBodyType
1313 , sinkRequestBody
14− , sinkRequestBodyEx
1514 , BackEnd
1615 , lbsBackEnd
1716 , tempFileBackEnd
@@ -20,24 +19,6 @@ module Network.Wai.Parse
2019 , File
2120 , FileInfo (..)
2221 , parseContentType
23− , ParseRequestBodyOptions
24− , defaultParseRequestBodyOptions
25− , noLimitParseRequestBodyOptions
26− , parseRequestBodyEx
27− , setMaxRequestKeyLength
28− , clearMaxRequestKeyLength
29− , setMaxRequestNumFiles
30− , clearMaxRequestNumFiles
31− , setMaxRequestFileSize
32− , clearMaxRequestFileSize
33− , setMaxRequestFilesSize
34− , clearMaxRequestFilesSize
35− , setMaxRequestParmsSize
36− , clearMaxRequestParmsSize
37− , setMaxHeaderLines
38− , clearMaxHeaderLines
39− , setMaxHeaderLineLength
40− , clearMaxHeaderLineLength
4122#if TEST
4223 , Bound (..)
4324 , findBound
@@ -48,31 +29,24 @@ module Network.Wai.Parse
4829#endif
4930 ) where
5031
51−import qualified Control.Exception as E
32+import qualified Data.ByteString.Search as Search
5233import qualified Data.ByteString as S
5334import qualified Data.ByteString.Lazy as L
5435import qualified Data.ByteString.Char8 as S8
5536import Data.Word (Word8)
56−import Data.Int (Int64)
57−import Data.Maybe (catMaybes, fromMaybe)
37+import Data.Maybe (fromMaybe)
5838import Data.List (sortBy)
5939import Data.Function (on, fix)
6040import System.Directory (removeFile, getTemporaryDirectory)
6141import System.IO (hClose, openBinaryTempFile)
62−import System.IO.Error (isDoesNotExistError)
6342import Network.Wai
6443import qualified Network.HTTP.Types as H
65−import Control.Applicative ((<$>))
66−import Control.Exception (catchJust)
67−import Control.Monad (when, unless, guard)
44+import Control.Monad (when, unless)
6845import Control.Monad.Trans.Resource (allocate, release, register, InternalState, runInternalState)
6946import Data.IORef
7047import Network.HTTP.Types (hContentType)
71−import Network.HTTP2( HTTP2Error (..), ErrorCodeId (..) )
7248import Data.CaseInsensitive (mk)
7349
74−import Prelude hiding (lines)
75−
7650breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
7751breakDiscard w s =
7852 let (x, y) = S.break (== w) s
@@ -129,9 +103,11 @@ tempFileBackEndOpts :: IO FilePath -- ^ get temporary directory
129103 -> ignored2
130104 -> IO S.ByteString
131105 -> IO FilePath
132−tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do
133− (key, (fp, h)) <- flip runInternalState internalState $ allocate it (hClose . snd)
134− _ <- runInternalState (register $ removeFileQuiet fp) internalState
106+tempFileBackEndOpts getTmpDir pattern internalState _ _ popper = do
107+ (key, (fp, h)) <- flip runInternalState internalState $ allocate (do
108+ tempDir <- getTmpDir
109+ openBinaryTempFile tempDir pattern) (\(_, h) -> hClose h)
110+ _ <- runInternalState (register $ removeFile fp) internalState
135111 fix $ \loop -> do
136112 bs <- popper
137113 unless (S.null bs) $ do
@@ -139,150 +115,6 @@ tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do
139115 loop
140116 release key
141117 return fp
142− where
143− it = do
144− tempDir <- getTmpDir
145− openBinaryTempFile tempDir pattrn
146− removeFileQuiet fp = catchJust (guard . isDoesNotExistError)
147− (removeFile fp)
148− (const $ return ())
149−
150−-- | A data structure that describes the behavior of
151−-- the parseRequestBodyEx function.
152−--
153−-- @since 3.0.16.0
154−data ParseRequestBodyOptions = ParseRequestBodyOptions
155− { -- | The maximum length of a filename
156− prboKeyLength :: Maybe Int
157− , -- | The maximum number of files.
158− prboMaxNumFiles :: Maybe Int
159− , -- | The maximum filesize per file.
160− prboMaxFileSize :: Maybe Int64
161− , -- | The maximum total filesize.
162− prboMaxFilesSize :: Maybe Int64
163− , -- | The maximum size of the sum of all parameters
164− prboMaxParmsSize :: Maybe Int
165− , -- | The maximum header lines per mime/multipart entry
166− prboMaxHeaderLines :: Maybe Int
167− , -- | The maximum header line length per mime/multipart entry
168− prboMaxHeaderLineLength :: Maybe Int }
169−
170−-- | Set the maximum length of a filename.
171−--
172−-- @since 3.0.16.0
173−setMaxRequestKeyLength :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
174−setMaxRequestKeyLength l p = p { prboKeyLength=Just l }
175−
176−-- | Do not limit the length of filenames.
177−--
178−-- @since 3.0.16.0
179−clearMaxRequestKeyLength :: ParseRequestBodyOptions -> ParseRequestBodyOptions
180−clearMaxRequestKeyLength p = p { prboKeyLength=Nothing }
181−
182−-- | Set the maximum number of files per request.
183−--
184−-- @since 3.0.16.0
185−setMaxRequestNumFiles :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
186−setMaxRequestNumFiles l p = p { prboMaxNumFiles=Just l }
187−
188−-- | Do not limit the maximum number of files per request.
189−--
190−-- @since 3.0.16.0
191−clearMaxRequestNumFiles :: ParseRequestBodyOptions -> ParseRequestBodyOptions
192−clearMaxRequestNumFiles p = p { prboMaxNumFiles=Nothing }
193−
194−-- | Set the maximum filesize per file (in bytes).
195−--
196−-- @since 3.0.16.0
197−setMaxRequestFileSize :: Int64 -> ParseRequestBodyOptions -> ParseRequestBodyOptions
198−setMaxRequestFileSize l p = p { prboMaxFileSize=Just l }
199−
200−-- | Do not limit the maximum filesize per file.
201−--
202−-- @since 3.0.16.0
203−clearMaxRequestFileSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
204−clearMaxRequestFileSize p = p { prboMaxFileSize=Nothing }
205−
206−-- | Set the maximum size of all files per request.
207−--
208−-- @since 3.0.16.0
209−setMaxRequestFilesSize :: Int64 -> ParseRequestBodyOptions -> ParseRequestBodyOptions
210−setMaxRequestFilesSize l p = p { prboMaxFilesSize=Just l }
211−
212−-- | Do not limit the maximum size of all files per request.
213−--
214−-- @since 3.0.16.0
215−clearMaxRequestFilesSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
216−clearMaxRequestFilesSize p = p { prboMaxFilesSize=Nothing }
217−
218−-- | Set the maximum size of the sum of all parameters.
219−--
220−-- @since 3.0.16.0
221−setMaxRequestParmsSize :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
222−setMaxRequestParmsSize l p = p { prboMaxParmsSize=Just l }
223−
224−-- | Do not limit the maximum size of the sum of all parameters.
225−--
226−-- @since 3.0.16.0
227−clearMaxRequestParmsSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
228−clearMaxRequestParmsSize p = p { prboMaxParmsSize=Nothing }
229−
230−-- | Set the maximum header lines per mime/multipart entry.
231−--
232−-- @since 3.0.16.0
233−setMaxHeaderLines :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
234−setMaxHeaderLines l p = p { prboMaxHeaderLines=Just l }
235−
236−-- | Do not limit the maximum header lines per mime/multipart entry.
237−--
238−-- @since 3.0.16.0
239−clearMaxHeaderLines:: ParseRequestBodyOptions -> ParseRequestBodyOptions
240−clearMaxHeaderLines p = p { prboMaxHeaderLines=Nothing }
241−
242−-- | Set the maximum header line length per mime/multipart entry.
243−--
244−-- @since 3.0.16.0
245−setMaxHeaderLineLength :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
246−setMaxHeaderLineLength l p = p { prboMaxHeaderLineLength=Just l }
247−
248−-- | Do not limit the maximum header lines per mime/multipart entry.
249−--
250−-- @since 3.0.16.0
251−clearMaxHeaderLineLength :: ParseRequestBodyOptions -> ParseRequestBodyOptions
252−clearMaxHeaderLineLength p = p { prboMaxHeaderLineLength=Nothing }
253−
254−-- | A reasonable default set of parsing options.
255−-- Maximum key/filename length: 32 bytes;
256−-- maximum files: 10; filesize unlimited; maximum
257−-- size for parameters: 64kbytes; maximum number of header
258−-- lines: 32 bytes (applies only to headers of a mime/multipart message);
259−-- maximum header line length: Apache's default for that is 8190 bytes
260−-- (http://httpd.apache.org/docs/2.2/mod/core.html#limitrequestline)
261−-- so we're using that here as well.
262−--
263−-- @since 3.0.16.0
264−defaultParseRequestBodyOptions :: ParseRequestBodyOptions
265−defaultParseRequestBodyOptions = ParseRequestBodyOptions
266− { prboKeyLength=Just 32
267− , prboMaxNumFiles=Just 10
268− , prboMaxFileSize=Nothing
269− , prboMaxFilesSize=Nothing
270− , prboMaxParmsSize=Just 65336
271− , prboMaxHeaderLines=Just 32
272− , prboMaxHeaderLineLength=Just 8190 }
273−
274−-- | Do not impose any memory limits.
275−--
276−-- @since 3.0.21.0
277−noLimitParseRequestBodyOptions :: ParseRequestBodyOptions
278−noLimitParseRequestBodyOptions = ParseRequestBodyOptions
279− { prboKeyLength=Nothing
280− , prboMaxNumFiles=Nothing
281− , prboMaxFileSize=Nothing
282− , prboMaxFilesSize=Nothing
283− , prboMaxParmsSize=Nothing
284− , prboMaxHeaderLines=Nothing
285− , prboMaxHeaderLineLength=Nothing }
286118
287119-- | Information on an uploaded file.
288120data FileInfo c = FileInfo
@@ -305,16 +137,8 @@ type BackEnd a = S.ByteString -- ^ parameter name
305137 -> IO S.ByteString
306138 -> IO a
307139
308−-- | The mimetype of the http body.
309−-- Depending on whether just parameters or parameters and files
310−-- are passed, one or the other mimetype should be used.
311−data RequestBodyType
312− = -- | application/x-www-form-urlencoded (parameters only)
313− UrlEncoded
314− | -- | multipart/form-data (parameters and files)
315− Multipart S.ByteString
140+data RequestBodyType = UrlEncoded | Multipart S.ByteString
316141
317−-- | Get the mimetype of the body of an http request.
318142getRequestBodyType :: Request -> Maybe RequestBodyType
319143getRequestBodyType req = do
320144 ctype' <- lookup hContentType $ requestHeaders req
@@ -327,7 +151,7 @@ getRequestBodyType req = do
327151-- | Parse a content type value, turning a single @ByteString@ into the actual
328152-- content type and a list of pairs of attributes.
329153--
330−-- @since 1.3.2
154+-- Since 1.3.2
331155parseContentType :: S.ByteString -> (S.ByteString, [(S.ByteString, S.ByteString)])
332156parseContentType a = do
333157 let (ctype, b) = S.break (== semicolon) a
@@ -337,9 +161,6 @@ parseContentType a = do
337161 semicolon = 59
338162 equals = 61
339163 space = 32
340− dq s = if S.length s > 2 && S.head s == 34 && S.last s == 34 -- quote
341− then S.tail $ S.init s
342− else s
343164 goAttrs front bs
344165 | S.null bs = front []
345166 | otherwise =
@@ -348,140 +169,79 @@ parseContentType a = do
348169 goAttr bs =
349170 let (k, v') = S.break (== equals) bs
350171 v = S.drop 1 v'
351− in (strip k, dq $ strip v)
172+ in (strip k, strip v)
352173 strip = S.dropWhile (== space) . fst . S.breakEnd (/= space)
353174
354−-- | Parse the body of an HTTP request.
355−-- See parseRequestBodyEx for details.
356−-- Note: This function does not limit the memory it allocates.
357−-- When dealing with untrusted data (as is usually the case when
358−-- receiving input from the internet), it is recommended to
359−-- use the 'parseRequestBodyEx' function instead.
360175parseRequestBody :: BackEnd y
361176 -> Request
362177 -> IO ([Param], [File y])
363−parseRequestBody = parseRequestBodyEx noLimitParseRequestBodyOptions
364−
365−-- | Parse the body of an HTTP request, limit resource usage.
366−-- The HTTP body can contain both parameters and files.
367−-- This function will return a list of key,value pairs
368−-- for all parameters, and a list of key,a pairs
369−-- for filenames. The a depends on the used backend that
370−-- is responsible for storing the received files.
371−parseRequestBodyEx :: ParseRequestBodyOptions
372− -> BackEnd y
373− -> Request
374− -> IO ([Param], [File y])
375−parseRequestBodyEx o s r =
178+parseRequestBody s r =
376179 case getRequestBodyType r of
377180 Nothing -> return ([], [])
378− Just rbt -> sinkRequestBodyEx o s rbt (requestBody r)
181+ Just rbt -> sinkRequestBody s rbt (requestBody r)
379182
380183sinkRequestBody :: BackEnd y
381184 -> RequestBodyType
382185 -> IO S.ByteString
383186 -> IO ([Param], [File y])
384−sinkRequestBody = sinkRequestBodyEx noLimitParseRequestBodyOptions
385−
386−-- |
387−--
388−-- @since 3.0.16.0
389−sinkRequestBodyEx :: ParseRequestBodyOptions
390− -> BackEnd y
391− -> RequestBodyType
392− -> IO S.ByteString
393− -> IO ([Param], [File y])
394−sinkRequestBodyEx o s r body = do
395− ref <- newIORef ([], [])
187+sinkRequestBody s r body = do
188+ ref <- newIORef (id, id)
396189 let add x = atomicModifyIORef ref $ \(y, z) ->
397190 case x of
398− Left y' -> ((y':y, z), ())
399− Right z' -> ((y, z':z), ())
400− conduitRequestBodyEx o s r body add
401− (\(a, b) -> (reverse a, reverse b)) <$> readIORef ref
402−
403−conduitRequestBodyEx :: ParseRequestBodyOptions
404− -> BackEnd y
405− -> RequestBodyType
406− -> IO S.ByteString
407− -> (Either Param (File y) -> IO ())
408− -> IO ()
409−conduitRequestBodyEx o _ UrlEncoded rbody add = do
191+ Left y' -> ((y . (y':), z), ())
192+ Right z' -> ((y, z . (z':)), ())
193+ conduitRequestBody s r body add
194+ (x, y) <- readIORef ref
195+ return (x [], y [])
196+
197+conduitRequestBody :: BackEnd y
198+ -> RequestBodyType
199+ -> IO S.ByteString
200+ -> (Either Param (File y) -> IO ())
201+ -> IO ()
202+conduitRequestBody _ UrlEncoded rbody add = do
410203 -- NOTE: in general, url-encoded data will be in a single chunk.
411204 -- Therefore, I'm optimizing for the usual case by sticking with
412205 -- strict byte strings here.
413− let loop size front = do
206+ let loop front = do
414207 bs <- rbody
415208 if S.null bs
416209 then return $ S.concat $ front []
417− else do
418− let newsize = size + S.length bs
419− case prboMaxParmsSize o of
420− Just maxSize -> when (newsize > maxSize) $
421− error "Maximum size of parameters exceeded"
422− Nothing -> return ()
423− loop newsize $ front . (bs:)
424− bs <- loop 0 id
210+ else loop $ front . (bs:)
211+ bs <- loop id
425212 mapM_ (add . Left) $ H.parseSimpleQuery bs
426−conduitRequestBodyEx o backend (Multipart bound) rbody add =
427− parsePiecesEx o backend (S8.pack "--" `S.append` bound) rbody add
428−
213+conduitRequestBody backend (Multipart bound) rbody add =
214+ parsePieces backend (S8.pack "--" `S.append` bound) rbody add
429215
430−-- | Take one header or subheader line.
431−-- Since: 3.0.26
432−-- Throw 431 if headers too large.
433−takeLine :: Maybe Int -> Source -> IO (Maybe S.ByteString)
434−takeLine maxlen src =
435− go ""
216+takeLine :: Source -> IO (Maybe S.ByteString)
217+takeLine src =
218+ go id
436219 where
437220 go front = do
438221 bs <- readSource src
439− case maxlen of
440− Just maxlen' -> when (S.length front > maxlen') $
441− E.throwIO $ ConnectionError (UnknownErrorCode 431)
442− "Request Header Fields Too Large"
443− Nothing -> return ()
444222 if S.null bs
445223 then close front
446224 else push front bs
447225
448− close front = leftover src front >> return Nothing
226+ close front = leftover src (front S.empty) >> return Nothing
449227 push front bs = do
450− let (x, y) = S.break (== 10) bs -- LF
228+ let (x, y) = S.break (== 10) $ front bs -- LF
451229 in if S.null y
452− then go $ front `S.append` x
230+ then go $ S.append x
453231 else do
454232 when (S.length y > 1) $ leftover src $ S.drop 1 y
455− let res = front `S.append` x
456− case maxlen of
457− Just maxlen' -> when (S.length res > maxlen') $
458− E.throwIO $ ConnectionError (UnknownErrorCode 431)
459− "Request Header Fields Too Large"
460− Nothing -> return ()
461− return $ Just $ killCR $ res
462−
463−takeLines' :: Maybe Int -> Maybe Int -> Source -> IO [S.ByteString]
464−takeLines' lineLength maxLines source =
465− reverse <$> takeLines'' [] lineLength maxLines source
466−
467−takeLines''
468− :: [S.ByteString]
469− -> Maybe Int
470− -> Maybe Int
471− -> Source
472− -> IO [S.ByteString]
473−takeLines'' lines lineLength maxLines src = do
474− case maxLines of
475− Just maxLines' ->
476− when (length lines > maxLines') $
477− error "Too many lines in mime/multipart header"
478− Nothing -> return ()
479− res <- takeLine lineLength src
233+ return $ Just $ killCR x
234+
235+takeLines :: Source -> IO [S.ByteString]
236+takeLines src = do
237+ res <- takeLine src
480238 case res of
481− Nothing -> return lines
239+ Nothing -> return []
482240 Just l
483− | S.null l -> return lines
484− | otherwise -> takeLines'' (l:lines) lineLength maxLines src
241+ | S.null l -> return []
242+ | otherwise -> do
243+ ls <- takeLines src
244+ return $ l : ls
485245
486246data Source = Source (IO S.ByteString) (IORef S.ByteString)
487247
@@ -500,20 +260,17 @@ readSource (Source f ref) = do
500260leftover :: Source -> S.ByteString -> IO ()
501261leftover (Source _ ref) bs = writeIORef ref bs
502262
503−parsePiecesEx :: ParseRequestBodyOptions
504− -> BackEnd y
505− -> S.ByteString
506− -> IO S.ByteString
507− -> (Either Param (File y) -> IO ())
508− -> IO ()
509−parsePiecesEx o sink bound rbody add =
510− mkSource rbody >>= loop 0 0 0 0
263+parsePieces :: BackEnd y
264+ -> S.ByteString
265+ -> IO S.ByteString
266+ -> (Either Param (File y) -> IO ())
267+ -> IO ()
268+parsePieces sink bound rbody add =
269+ mkSource rbody >>= loop
511270 where
512− loop :: Int -> Int -> Int -> Int64 -> Source -> IO ()
513− loop numParms numFiles parmSize filesSize src = do
514− _boundLine <- takeLine (prboMaxHeaderLineLength o) src
515− res' <- takeLines' (prboMaxHeaderLineLength o)
516− (prboMaxHeaderLines o) src
271+ loop src = do
272+ _boundLine <- takeLine src
273+ res' <- takeLines src
517274 unless (null res') $ do
518275 let ls' = map parsePair res'
519276 let x = do
@@ -524,50 +281,25 @@ parsePiecesEx o sink bound rbody add =
524281 return (ct, name, lookup "filename" attrs)
525282 case x of
526283 Just (mct, name, Just filename) -> do
527− case prboKeyLength o of
528− Just maxKeyLength ->
529− when (S.length name > maxKeyLength) $
530− error "Filename is too long"
531− Nothing -> return ()
532− case prboMaxNumFiles o of
533− Just maxFiles -> when (numFiles >= maxFiles) $
534− error "Maximum number of files exceeded"
535− Nothing -> return ()
536284 let ct = fromMaybe "application/octet-stream" mct
537285 fi0 = FileInfo filename ct ()
538− fs = catMaybes [ prboMaxFileSize o
539− , subtract filesSize <$> prboMaxFilesSize o ]
540− mfs = if fs == [] then Nothing else Just $ minimum fs
541− ((wasFound, fileSize), y) <- sinkTillBound' bound name fi0 sink src mfs
542− let newFilesSize = filesSize + fileSize
286+ (wasFound, y) <- sinkTillBound' bound name fi0 sink src
543287 add $ Right (name, fi0 { fileContent = y })
544− when wasFound $ loop numParms (numFiles + 1) parmSize newFilesSize src
288+ when wasFound (loop src)
545289 Just (_ct, name, Nothing) -> do
546− case prboKeyLength o of
547− Just maxKeyLength ->
548− when (S.length name > maxKeyLength) $
549− error "Parameter name is too long"
550− Nothing -> return ()
551290 let seed = id
552291 let iter front bs = return $ front . (:) bs
553− ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src
554− (fromIntegral <$> prboMaxParmsSize o)
292+ (wasFound, front) <- sinkTillBound bound iter seed src
555293 let bs = S.concat $ front []
556294 let x' = (name, bs)
557− let newParmSize = parmSize + S.length name + S.length bs
558− case prboMaxParmsSize o of
559− Just maxParmSize -> when (newParmSize > maxParmSize) $
560− error "Maximum size of parameters exceeded"
561− Nothing -> return ()
562295 add $ Left x'
563− when wasFound $ loop (numParms + 1) numFiles
564− newParmSize filesSize src
296+ when wasFound (loop src)
565297 _ -> do
566298 -- ignore this part
567299 let seed = ()
568300 iter () _ = return ()
569− ((wasFound, _fileSize), ()) <- sinkTillBound bound iter seed src Nothing
570− when wasFound $ loop numParms numFiles parmSize filesSize src
301+ (wasFound, ()) <- sinkTillBound bound iter seed src
302+ when wasFound (loop src)
571303 where
572304 contDisp = mk $ S8.pack "Content-Disposition"
573305 contType = mk $ S8.pack "Content-Type"
@@ -575,14 +307,13 @@ parsePiecesEx o sink bound rbody add =
575307 let (x, y) = breakDiscard 58 s -- colon
576308 in (mk $ x, S.dropWhile (== 32) y) -- space
577309
578−
579310data Bound = FoundBound S.ByteString S.ByteString
580311 | NoBound
581312 | PartialBound
582313 deriving (Eq, Show)
583314
584315findBound :: S.ByteString -> S.ByteString -> Bound
585−findBound b bs = handleBreak $ S.breakSubstring b bs
316+findBound b bs = handleBreak $ Search.breakOn b bs
586317 where
587318 handleBreak (h, t)
588319 | S.null t = go [lowBound..S.length bs - 1]
@@ -609,10 +340,9 @@ sinkTillBound' :: S.ByteString
609340 -> FileInfo ()
610341 -> BackEnd y
611342 -> Source
612− -> Maybe Int64
613− -> IO ((Bool, Int64), y)
614−sinkTillBound' bound name fi sink src max' = do
615− (next, final) <- wrapTillBound bound src max'
343+ -> IO (Bool, y)
344+sinkTillBound' bound name fi sink src = do
345+ (next, final) <- wrapTillBound bound src
616346 y <- sink name fi next
617347 b <- final
618348 return (b, y)
@@ -621,40 +351,30 @@ data WTB = WTBWorking (S.ByteString -> S.ByteString)
621351 | WTBDone Bool
622352wrapTillBound :: S.ByteString -- ^ bound
623353 -> Source
624− -> Maybe Int64
625− -> IO (IO S.ByteString, IO (Bool, Int64)) -- ^ Bool indicates if the bound was found
626−wrapTillBound bound src max' = do
354+ -> IO (IO S.ByteString, IO Bool) -- ^ Bool indicates if the bound was found
355+wrapTillBound bound src = do
627356 ref <- newIORef $ WTBWorking id
628− sref <- newIORef (0 :: Int64)
629− return (go ref sref, final ref sref)
357+ return (go ref, final ref)
630358 where
631− final ref sref = do
359+ final ref = do
632360 x <- readIORef ref
633361 case x of
634362 WTBWorking _ -> error "wrapTillBound did not finish"
635− WTBDone y -> do
636− siz <- readIORef sref
637− return (y, siz)
363+ WTBDone y -> return y
638364
639− go ref sref = do
365+ go ref = do
640366 state <- readIORef ref
641367 case state of
642368 WTBDone _ -> return S.empty
643369 WTBWorking front -> do
644370 bs <- readSource src
645− cur <- atomicModifyIORef' sref $ \ cur ->
646− let new = cur + fromIntegral (S.length bs) in (new, new)
647− case max' of
648− Just max'' | cur > max'' ->
649− E.throwIO $ ConnectionError (UnknownErrorCode 413) "Payload Too Large"
650− _ -> return ()
651371 if S.null bs
652372 then do
653373 writeIORef ref $ WTBDone False
654374 return $ front bs
655375 else push $ front bs
656376 where
657− push bs = do
377+ push bs =
658378 case findBound bound bs of
659379 FoundBound before after -> do
660380 let before' = killCRLF before
@@ -670,20 +390,19 @@ wrapTillBound bound src max' = do
670390 else (bs, id)
671391 writeIORef ref $ WTBWorking front'
672392 if S.null toEmit
673− then go ref sref
393+ then go ref
674394 else return toEmit
675395 PartialBound -> do
676396 writeIORef ref $ WTBWorking $ S.append bs
677− go ref sref
397+ go ref
678398
679399sinkTillBound :: S.ByteString
680400 -> (x -> S.ByteString -> IO x)
681401 -> x
682402 -> Source
683− -> Maybe Int64
684− -> IO ((Bool, Int64), x)
685−sinkTillBound bound iter seed0 src max' = do
686− (next, final) <- wrapTillBound bound src max'
403+ -> IO (Bool, x)
404+sinkTillBound bound iter seed0 src = do
405+ (next, final) <- wrapTillBound bound src
687406 let loop seed = do
688407 bs <- next
689408 if S.null bs