@@ -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,30 +29,22 @@ 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 (..) )
72−import Data.CaseInsensitive (mk)
73−
74−import Prelude hiding (lines)
7548
7649breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
7750breakDiscard w s =
@@ -121,7 +94,7 @@ lbsBackEnd _ _ popper =
12194tempFileBackEnd :: InternalState -> ignored1 -> ignored2 -> IO S.ByteString -> IO FilePath
12295tempFileBackEnd = tempFileBackEndOpts getTemporaryDirectory "webenc.buf"
12396
124−-- | Same as 'tempFileBackEnd', but use configurable temp folders and patterns.
97+-- | Same as 'tempFileSink', but use configurable temp folders and patterns.
12598tempFileBackEndOpts :: IO FilePath -- ^ get temporary directory
12699 -> String -- ^ filename pattern
127100 -> InternalState
@@ -129,9 +102,11 @@ tempFileBackEndOpts :: IO FilePath -- ^ get temporary directory
129102 -> ignored2
130103 -> IO S.ByteString
131104 -> 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
105+tempFileBackEndOpts getTmpDir pattern internalState _ _ popper = do
106+ (key, (fp, h)) <- flip runInternalState internalState $ allocate (do
107+ tempDir <- getTmpDir
108+ openBinaryTempFile tempDir pattern) (\(_, h) -> hClose h)
109+ _ <- runInternalState (register $ removeFile fp) internalState
135110 fix $ \loop -> do
136111 bs <- popper
137112 unless (S.null bs) $ do
@@ -139,150 +114,6 @@ tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do
139114 loop
140115 release key
141116 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 }
286117
287118-- | Information on an uploaded file.
288119data FileInfo c = FileInfo
@@ -305,16 +136,8 @@ type BackEnd a = S.ByteString -- ^ parameter name
305136 -> IO S.ByteString
306137 -> IO a
307138
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
139+data RequestBodyType = UrlEncoded | Multipart S.ByteString
316140
317−-- | Get the mimetype of the body of an http request.
318141getRequestBodyType :: Request -> Maybe RequestBodyType
319142getRequestBodyType req = do
320143 ctype' <- lookup hContentType $ requestHeaders req
@@ -327,7 +150,7 @@ getRequestBodyType req = do
327150-- | Parse a content type value, turning a single @ByteString@ into the actual
328151-- content type and a list of pairs of attributes.
329152--
330−-- @since 1.3.2
153+-- Since 1.3.2
331154parseContentType :: S.ByteString -> (S.ByteString, [(S.ByteString, S.ByteString)])
332155parseContentType a = do
333156 let (ctype, b) = S.break (== semicolon) a
@@ -337,9 +160,6 @@ parseContentType a = do
337160 semicolon = 59
338161 equals = 61
339162 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
343163 goAttrs front bs
344164 | S.null bs = front []
345165 | otherwise =
@@ -348,140 +168,79 @@ parseContentType a = do
348168 goAttr bs =
349169 let (k, v') = S.break (== equals) bs
350170 v = S.drop 1 v'
351− in (strip k, dq $ strip v)
171+ in (strip k, strip v)
352172 strip = S.dropWhile (== space) . fst . S.breakEnd (/= space)
353173
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.
360174parseRequestBody :: BackEnd y
361175 -> Request
362176 -> 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 =
177+parseRequestBody s r =
376178 case getRequestBodyType r of
377179 Nothing -> return ([], [])
378− Just rbt -> sinkRequestBodyEx o s rbt (requestBody r)
180+ Just rbt -> sinkRequestBody s rbt (requestBody r)
379181
380182sinkRequestBody :: BackEnd y
381183 -> RequestBodyType
382184 -> IO S.ByteString
383185 -> 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 ([], [])
186+sinkRequestBody s r body = do
187+ ref <- newIORef (id, id)
396188 let add x = atomicModifyIORef ref $ \(y, z) ->
397189 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
190+ Left y' -> ((y . (y':), z), ())
191+ Right z' -> ((y, z . (z':)), ())
192+ conduitRequestBody s r body add
193+ (x, y) <- readIORef ref
194+ return (x [], y [])
195+
196+conduitRequestBody :: BackEnd y
197+ -> RequestBodyType
198+ -> IO S.ByteString
199+ -> (Either Param (File y) -> IO ())
200+ -> IO ()
201+conduitRequestBody _ UrlEncoded rbody add = do
410202 -- NOTE: in general, url-encoded data will be in a single chunk.
411203 -- Therefore, I'm optimizing for the usual case by sticking with
412204 -- strict byte strings here.
413− let loop size front = do
205+ let loop front = do
414206 bs <- rbody
415207 if S.null bs
416208 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
209+ else loop $ front . (bs:)
210+ bs <- loop id
425211 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−
212+conduitRequestBody backend (Multipart bound) rbody add =
213+ parsePieces backend (S8.pack "--" `S.append` bound) rbody add
429214
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 ""
215+takeLine :: Source -> IO (Maybe S.ByteString)
216+takeLine src =
217+ go id
436218 where
437219 go front = do
438220 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 ()
444221 if S.null bs
445222 then close front
446223 else push front bs
447224
448− close front = leftover src front >> return Nothing
225+ close front = leftover src (front S.empty) >> return Nothing
449226 push front bs = do
450− let (x, y) = S.break (== 10) bs -- LF
227+ let (x, y) = S.break (== 10) $ front bs -- LF
451228 in if S.null y
452− then go $ front `S.append` x
229+ then go $ S.append x
453230 else do
454231 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
232+ return $ Just $ killCR x
233+
234+takeLines :: Source -> IO [S.ByteString]
235+takeLines src = do
236+ res <- takeLine src
480237 case res of
481− Nothing -> return lines
238+ Nothing -> return []
482239 Just l
483− | S.null l -> return lines
484− | otherwise -> takeLines'' (l:lines) lineLength maxLines src
240+ | S.null l -> return []
241+ | otherwise -> do
242+ ls <- takeLines src
243+ return $ l : ls
485244
486245data Source = Source (IO S.ByteString) (IORef S.ByteString)
487246
@@ -500,20 +259,17 @@ readSource (Source f ref) = do
500259leftover :: Source -> S.ByteString -> IO ()
501260leftover (Source _ ref) bs = writeIORef ref bs
502261
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
262+parsePieces :: BackEnd y
263+ -> S.ByteString
264+ -> IO S.ByteString
265+ -> (Either Param (File y) -> IO ())
266+ -> IO ()
267+parsePieces sink bound rbody add =
268+ mkSource rbody >>= loop
511269 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
270+ loop src = do
271+ _boundLine <- takeLine src
272+ res' <- takeLines src
517273 unless (null res') $ do
518274 let ls' = map parsePair res'
519275 let x = do
@@ -524,57 +280,31 @@ parsePiecesEx o sink bound rbody add =
524280 return (ct, name, lookup "filename" attrs)
525281 case x of
526282 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 ()
536283 let ct = fromMaybe "application/octet-stream" mct
537284 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
285+ (wasFound, y) <- sinkTillBound' bound name fi0 sink src
543286 add $ Right (name, fi0 { fileContent = y })
544− when wasFound $ loop numParms (numFiles + 1) parmSize newFilesSize src
287+ when wasFound (loop src)
545288 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 ()
551289 let seed = id
552290 let iter front bs = return $ front . (:) bs
553− ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src
554− (fromIntegral <$> prboMaxParmsSize o)
291+ (wasFound, front) <- sinkTillBound bound iter seed src
555292 let bs = S.concat $ front []
556293 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 ()
562294 add $ Left x'
563− when wasFound $ loop (numParms + 1) numFiles
564− newParmSize filesSize src
295+ when wasFound (loop src)
565296 _ -> do
566297 -- ignore this part
567298 let seed = ()
568299 iter () _ = return ()
569− ((wasFound, _fileSize), ()) <- sinkTillBound bound iter seed src Nothing
570− when wasFound $ loop numParms numFiles parmSize filesSize src
300+ (wasFound, ()) <- sinkTillBound bound iter seed src
301+ when wasFound (loop src)
571302 where
572− contDisp = mk $ S8.pack "Content-Disposition"
573− contType = mk $ S8.pack "Content-Type"
303+ contDisp = S8.pack "Content-Disposition"
304+ contType = S8.pack "Content-Type"
574305 parsePair s =
575306 let (x, y) = breakDiscard 58 s -- colon
576− in (mk $ x, S.dropWhile (== 32) y) -- space
577−
307+ in (x, S.dropWhile (== 32) y) -- space
578308
579309data Bound = FoundBound S.ByteString S.ByteString
580310 | NoBound
@@ -582,7 +312,7 @@ data Bound = FoundBound S.ByteString S.ByteString
582312 deriving (Eq, Show)
583313
584314findBound :: S.ByteString -> S.ByteString -> Bound
585−findBound b bs = handleBreak $ S.breakSubstring b bs
315+findBound b bs = handleBreak $ Search.breakOn b bs
586316 where
587317 handleBreak (h, t)
588318 | S.null t = go [lowBound..S.length bs - 1]
@@ -609,10 +339,9 @@ sinkTillBound' :: S.ByteString
609339 -> FileInfo ()
610340 -> BackEnd y
611341 -> 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'
342+ -> IO (Bool, y)
343+sinkTillBound' bound name fi sink src = do
344+ (next, final) <- wrapTillBound bound src
616345 y <- sink name fi next
617346 b <- final
618347 return (b, y)
@@ -621,40 +350,30 @@ data WTB = WTBWorking (S.ByteString -> S.ByteString)
621350 | WTBDone Bool
622351wrapTillBound :: S.ByteString -- ^ bound
623352 -> 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
353+ -> IO (IO S.ByteString, IO Bool) -- ^ Bool indicates if the bound was found
354+wrapTillBound bound src = do
627355 ref <- newIORef $ WTBWorking id
628− sref <- newIORef (0 :: Int64)
629− return (go ref sref, final ref sref)
356+ return (go ref, final ref)
630357 where
631− final ref sref = do
358+ final ref = do
632359 x <- readIORef ref
633360 case x of
634361 WTBWorking _ -> error "wrapTillBound did not finish"
635− WTBDone y -> do
636− siz <- readIORef sref
637− return (y, siz)
362+ WTBDone y -> return y
638363
639− go ref sref = do
364+ go ref = do
640365 state <- readIORef ref
641366 case state of
642367 WTBDone _ -> return S.empty
643368 WTBWorking front -> do
644369 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 ()
651370 if S.null bs
652371 then do
653372 writeIORef ref $ WTBDone False
654373 return $ front bs
655374 else push $ front bs
656375 where
657− push bs = do
376+ push bs =
658377 case findBound bound bs of
659378 FoundBound before after -> do
660379 let before' = killCRLF before
@@ -670,20 +389,19 @@ wrapTillBound bound src max' = do
670389 else (bs, id)
671390 writeIORef ref $ WTBWorking front'
672391 if S.null toEmit
673− then go ref sref
392+ then go ref
674393 else return toEmit
675394 PartialBound -> do
676395 writeIORef ref $ WTBWorking $ S.append bs
677− go ref sref
396+ go ref
678397
679398sinkTillBound :: S.ByteString
680399 -> (x -> S.ByteString -> IO x)
681400 -> x
682401 -> Source
683− -> Maybe Int64
684− -> IO ((Bool, Int64), x)
685−sinkTillBound bound iter seed0 src max' = do
686− (next, final) <- wrapTillBound bound src max'
402+ -> IO (Bool, x)
403+sinkTillBound bound iter seed0 src = do
404+ (next, final) <- wrapTillBound bound src
687405 let loop seed = do
688406 bs <- next
689407 if S.null bs