    {-# LANGUAGE BangPatterns              #-}
    {-# LANGUAGE CPP                       #-}
    {-# LANGUAGE DeriveDataTypeable        #-}
    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE FlexibleContexts          #-}
    {-# LANGUAGE OverloadedStrings         #-}
    {-# LANGUAGE ScopedTypeVariables       #-}

    module Snap.Internal.Util.FileUploads
      ( -- * Functions
        handleFormUploads
      , foldMultipart
      , PartFold
      , FormParam
      , FormFile (..)
      , storeAsLazyByteString
      , withTemporaryStore
        -- ** Backwards compatible API
      , handleFileUploads
      , handleMultipart
      , PartProcessor

        -- * Uploaded parts
      , PartInfo(..)
      , PartDisposition(..)
      , toPartDisposition

        -- ** Policy
        -- *** General upload policy
      , UploadPolicy(..)
      , defaultUploadPolicy
      , doProcessFormInputs
      , setProcessFormInputs
      , getMaximumFormInputSize
      , setMaximumFormInputSize
      , getMaximumNumberOfFormInputs
      , setMaximumNumberOfFormInputs
      , getMinimumUploadRate
      , setMinimumUploadRate
      , getMinimumUploadSeconds
      , setMinimumUploadSeconds
      , getUploadTimeout
      , setUploadTimeout

        -- *** File upload policy
      , FileUploadPolicy(..)
      , defaultFileUploadPolicy
      , setMaximumFileSize
      , setMaximumNumberOfFiles
      , setSkipFilesWithoutNames
      , setMaximumSkippedFileSize

        -- *** Per-file upload policy
      , PartUploadPolicy(..)
      , disallow
      , allowWithMaximumSize

        -- * Exceptions
      , FileUploadException(..)
      , fileUploadExceptionReason
      , BadPartException(..)
      , PolicyViolationException(..)
      ) where

    ------------------------------------------------------------------------------
    import           Control.Applicative              (Alternative ((<|>)), Applicative (pure, (*>), (<*)))
    import           Control.Arrow                    (Arrow (first))
    import           Control.Exception.Lifted         (Exception, SomeException (..), bracket, catch, finally, fromException, mask, throwIO, toException)
    import qualified Control.Exception.Lifted         as E (try)
    import           Control.Monad                    (Functor (fmap), Monad (return, (>>=)), MonadPlus (mzero), forM_, guard, liftM, sequence, unless, void, when, (>=>))
    import           Control.Monad.IO.Class           (liftIO)
    import           Data.Attoparsec.ByteString.Char8 (Parser, isEndOfLine, string, takeWhile)
    import qualified Data.Attoparsec.ByteString.Char8 as Atto (try)
    import           Data.ByteString.Char8            (ByteString)
    import qualified Data.ByteString.Char8            as S
    import           Data.ByteString.Internal         (c2w)
    import qualified Data.ByteString.Lazy.Internal    as LB (ByteString (Empty), chunk)
    import qualified Data.CaseInsensitive             as CI (mk)
    import           Data.Int                         (Int, Int64)
    import qualified Data.IORef                       as IORef
    import           Data.List                        (find, map, (++))
    import qualified Data.Map                         as Map (insertWith)
    import           Data.Maybe                       (Maybe (..), fromMaybe, isJust, maybe)
    import           Data.Text                        (Text)
    import qualified Data.Text                        as T (concat, pack, unpack)
    import qualified Data.Text.Encoding               as TE (decodeUtf8)
    import           Data.Typeable                    (Typeable, cast)
    import           Prelude                          (Bool (..), Double, Either (..), Eq (..), FilePath, IO, Ord (..), Show (..), String, const, either, foldr, fst, id, max, not, otherwise, seq, snd, succ, ($), ($!), (.), (^), (||))
    import           Snap.Core                        (HasHeaders (headers), Headers, MonadSnap, Request (rqParams, rqPostParams), getHeader, getRequest, getTimeoutModifier, putRequest, runRequestBody)
    import           Snap.Internal.Parsing            (crlf, fullyParse, pContentTypeWithParameters, pHeaders, pValueWithParameters')
    import qualified Snap.Types.Headers               as H (fromList)
    import           System.Directory                 (removeFile)
    import           System.FilePath                  ((</>))
    import           System.IO                        (BufferMode (NoBuffering), Handle, hClose, hSetBuffering, openBinaryTempFile)
    import           System.IO.Error                  (isDoesNotExistError)
    import           System.IO.Streams                (InputStream, MatchInfo (..), TooManyBytesReadException, search)
    import qualified System.IO.Streams                as Streams
    import           System.IO.Streams.Attoparsec     (parseFromStream)
    import           System.PosixCompat.Temp          (mkstemp)
    ------------------------------------------------------------------------------

    ------------------------------------------------------------------------------
    -- | Reads uploaded files into a temporary directory and calls a user handler
    -- to process them.
    --
    -- Note: /THE REQUEST MUST BE CORRECTLY ENCODED/. If the request's
    -- @Content-type@ is not \"@multipart/formdata@\", this function skips
    -- processing using 'pass'.
    --
    -- Given a temporary directory, global and file-specific upload policies, and a
    -- user handler, this function consumes a request body uploaded with
    -- @Content-type: multipart/form-data@. Each file is read into the temporary
    -- directory, and is then passed to the user handler. After the user handler
    -- runs (but before the 'Response' body is streamed to the client), the files
    -- are deleted from disk; so if you want to retain or use the uploaded files in
    -- the generated response, you need to move or otherwise process them.
    --
    -- The argument passed to the user handler is a tuple:
    --
    -- > (PartInfo, Either PolicyViolationException FilePath)
    --
    -- The first half of this tuple is a 'PartInfo', which contains the
    -- information the client browser sent about the given upload part (like
    -- filename, content-type, etc). The second half of this tuple is an 'Either'
    -- stipulating that either:
    --
    -- 1. the file was rejected on a policy basis because of the provided
    --    'PartUploadPolicy' handler
    --
    -- 2. the file was accepted and exists at the given path.
    --
    -- /Exceptions/
    --
    -- If the client's upload rate passes below the configured minimum (see
    -- 'setMinimumUploadRate' and 'setMinimumUploadSeconds'), this function
    -- terminates the connection. This setting is there to protect the server
    -- against slowloris-style denial of service attacks.
    --
    -- If the given 'UploadPolicy' stipulates that you wish form inputs to be
    -- placed in the 'rqParams' parameter map (using 'setProcessFormInputs'), and
    -- a form input exceeds the maximum allowable size, this function will throw a
    -- 'PolicyViolationException'.
    --
    -- If an uploaded part contains MIME headers longer than a fixed internal
    -- threshold (currently 32KB), this function will throw a 'BadPartException'.

    handleFileUploads ::
           (MonadSnap m) =>
           FilePath                       -- ^ temporary directory
        -> UploadPolicy                   -- ^ general upload policy
        -> (PartInfo -> PartUploadPolicy) -- ^ per-part upload policy
        -> (PartInfo -> Either PolicyViolationException FilePath -> IO a)
                                          -- ^ user handler (see function
                                          -- description)
        -> m [a]
    handleFileUploads :: forall (m :: * -> *) a.
    MonadSnap m =>
    FilePath
    -> UploadPolicy
    -> (PartInfo -> PartUploadPolicy)
    -> (PartInfo -> Either PolicyViolationException FilePath -> IO a)
    -> m [a]
    handleFileUploads FilePath
    tmpdir UploadPolicy
    uploadPolicy PartInfo -> PartUploadPolicy
    partPolicy PartInfo -> Either PolicyViolationException FilePath -> IO a
    partHandler =
        UploadPolicy -> PartProcessor a -> m [a]
    forall (m :: * -> *) a.
    MonadSnap m =>
    UploadPolicy -> PartProcessor a -> m [a]
    handleMultipart UploadPolicy
    uploadPolicy PartProcessor a
    go

      where
        go :: PartProcessor a
    go PartInfo
    partInfo InputStream ByteString
    stream = IO a -> (Int64 -> IO a) -> Maybe Int64 -> IO a
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO a
    disallowed Int64 -> IO a
    takeIt Maybe Int64
    mbFs
          where
            ctText :: ByteString
    ctText = PartInfo -> ByteString
    partContentType PartInfo
    partInfo
            fnText :: ByteString
    fnText = ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe ByteString
    "" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ PartInfo -> Maybe ByteString
    partFileName PartInfo
    partInfo

            ct :: Text
    ct = ByteString -> Text
    TE.decodeUtf8 ByteString
    ctText
            fn :: Text
    fn = ByteString -> Text
    TE.decodeUtf8 ByteString
    fnText

            (PartUploadPolicy Maybe Int64
    mbFs) = PartInfo -> PartUploadPolicy
    partPolicy PartInfo
    partInfo

            takeIt :: Int64 -> IO a
    takeIt Int64
    maxSize = do
                str' <- Int64 -> InputStream ByteString -> IO (InputStream ByteString)
    Streams.throwIfProducesMoreThan Int64
    maxSize InputStream ByteString
    stream
                fileReader tmpdir partHandler partInfo str' `catch` tooMany maxSize

            tooMany :: a -> TooManyBytesReadException -> IO a
    tooMany a
    maxSize (TooManyBytesReadException
    _ :: TooManyBytesReadException) =
                PartInfo -> Either PolicyViolationException FilePath -> IO a
    partHandler PartInfo
    partInfo
                            (PolicyViolationException
    -> Either PolicyViolationException FilePath
    forall a b. a -> Either a b
    Left (PolicyViolationException
     -> Either PolicyViolationException FilePath)
    -> PolicyViolationException
    -> Either PolicyViolationException FilePath
    forall a b. (a -> b) -> a -> b
    $
                             Text -> PolicyViolationException
    PolicyViolationException (Text -> PolicyViolationException)
    -> Text -> PolicyViolationException
    forall a b. (a -> b) -> a -> b
    $
                             [Text] -> Text
    T.concat [ Text
    "File \""
                                      , Text
    fn
                                      , Text
    "\" exceeded maximum allowable size "
                                      , FilePath -> Text
    T.pack (FilePath -> Text) -> FilePath -> Text
    forall a b. (a -> b) -> a -> b
    $ a -> FilePath
    forall a. Show a => a -> FilePath
    show a
    maxSize ])

            disallowed :: IO a
    disallowed =
                PartInfo -> Either PolicyViolationException FilePath -> IO a
    partHandler PartInfo
    partInfo
                            (PolicyViolationException
    -> Either PolicyViolationException FilePath
    forall a b. a -> Either a b
    Left (PolicyViolationException
     -> Either PolicyViolationException FilePath)
    -> PolicyViolationException
    -> Either PolicyViolationException FilePath
    forall a b. (a -> b) -> a -> b
    $
                             Text -> PolicyViolationException
    PolicyViolationException (Text -> PolicyViolationException)
    -> Text -> PolicyViolationException
    forall a b. (a -> b) -> a -> b
    $
                             [Text] -> Text
    T.concat [ Text
    "Policy disallowed upload of file \""
                                      , Text
    fn
                                      , Text
    "\" with content-type \""
                                      , Text
    ct
                                      , Text
    "\"" ] )

    ------------------------------------------------------------------------------
    -- | Contents of form field of type @file@
    data FormFile a = FormFile
        { forall a. FormFile a -> ByteString
    formFileName  :: !ByteString
             -- ^ Name of a field
        , forall a. FormFile a -> a
    formFileValue :: a
             -- ^ Result of storing file
        } deriving (FormFile a -> FormFile a -> Bool
    (FormFile a -> FormFile a -> Bool)
    -> (FormFile a -> FormFile a -> Bool) -> Eq (FormFile a)
    forall a. Eq a => FormFile a -> FormFile a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => FormFile a -> FormFile a -> Bool
    == :: FormFile a -> FormFile a -> Bool
    $c/= :: forall a. Eq a => FormFile a -> FormFile a -> Bool
    /= :: FormFile a -> FormFile a -> Bool
    Eq, Eq (FormFile a)
    Eq (FormFile a) =>
    (FormFile a -> FormFile a -> Ordering)
    -> (FormFile a -> FormFile a -> Bool)
    -> (FormFile a -> FormFile a -> Bool)
    -> (FormFile a -> FormFile a -> Bool)
    -> (FormFile a -> FormFile a -> Bool)
    -> (FormFile a -> FormFile a -> FormFile a)
    -> (FormFile a -> FormFile a -> FormFile a)
    -> Ord (FormFile a)
    FormFile a -> FormFile a -> Bool
    FormFile a -> FormFile a -> Ordering
    FormFile a -> FormFile a -> FormFile a
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall a. Ord a => Eq (FormFile a)
    forall a. Ord a => FormFile a -> FormFile a -> Bool
    forall a. Ord a => FormFile a -> FormFile a -> Ordering
    forall a. Ord a => FormFile a -> FormFile a -> FormFile a
    $ccompare :: forall a. Ord a => FormFile a -> FormFile a -> Ordering
    compare :: FormFile a -> FormFile a -> Ordering
    $c< :: forall a. Ord a => FormFile a -> FormFile a -> Bool
    < :: FormFile a -> FormFile a -> Bool
    $c<= :: forall a. Ord a => FormFile a -> FormFile a -> Bool
    <= :: FormFile a -> FormFile a -> Bool
    $c> :: forall a. Ord a => FormFile a -> FormFile a -> Bool
    > :: FormFile a -> FormFile a -> Bool
    $c>= :: forall a. Ord a => FormFile a -> FormFile a -> Bool
    >= :: FormFile a -> FormFile a -> Bool
    $cmax :: forall a. Ord a => FormFile a -> FormFile a -> FormFile a
    max :: FormFile a -> FormFile a -> FormFile a
    $cmin :: forall a. Ord a => FormFile a -> FormFile a -> FormFile a
    min :: FormFile a -> FormFile a -> FormFile a
    Ord, Int -> FormFile a -> ShowS
    [FormFile a] -> ShowS
    FormFile a -> FilePath
    (Int -> FormFile a -> ShowS)
    -> (FormFile a -> FilePath)
    -> ([FormFile a] -> ShowS)
    -> Show (FormFile a)
    forall a. Show a => Int -> FormFile a -> ShowS
    forall a. Show a => [FormFile a] -> ShowS
    forall a. Show a => FormFile a -> FilePath
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> FormFile a -> ShowS
    showsPrec :: Int -> FormFile a -> ShowS
    $cshow :: forall a. Show a => FormFile a -> FilePath
    show :: FormFile a -> FilePath
    $cshowList :: forall a. Show a => [FormFile a] -> ShowS
    showList :: [FormFile a] -> ShowS
    Show)

    data UploadState a = UploadState
         { forall a. UploadState a -> Int
    numUploadedFiles :: !Int
         , forall a. UploadState a -> [FormFile a] -> [FormFile a]
    uploadedFiles :: !([FormFile a] -> [FormFile a])
         }

    -- | Processes form data and calls provided storage function on
    -- file parts.
    --
    -- You can use this together with 'withTemporaryStore', 'storeAsLazyByteString'
    -- or provide your own callback to store uploaded files.
    --
    -- If you need to process uploaded file mime type or file name, do it in the
    -- store callback function.
    --
    -- See also 'foldMultipart'.
    --
    -- Example using with small files which can safely be stored in memory.
    --
    -- @
    --
    -- import qualified Data.ByteString.Lazy as Lazy
    --
    -- handleSmallFiles :: MonadSnap m => [(ByteString, ByteString, Lazy.ByteString)]
    -- handleSmallFiles = handleFormUploads uploadPolicy filePolicy store
    --
    --   where
    --     uploadPolicy = defaultUploadPolicy
    --     filePolicy = setMaximumFileSize (64*1024)
    --                  $ setMaximumNumberOfFiles 5
    --                    defaultUploadPolicy
    --     store partInfo stream = do
    --        content <- storeAsLazyByteString partInfo stream
    --        let
    --          fileName = partFileName partInfo
    --          fileMime = partContentType partInfo
    --        in (fileName, fileMime, content)
    -- @
    --
    handleFormUploads ::
           (MonadSnap m) =>
           UploadPolicy                   -- ^ general upload policy
        -> FileUploadPolicy               -- ^ Upload policy for files
        -> (PartInfo -> InputStream ByteString -> IO a)
                                          -- ^ A file storage function
        -> m ([FormParam], [FormFile a])
    handleFormUploads :: forall (m :: * -> *) a.
    MonadSnap m =>
    UploadPolicy
    -> FileUploadPolicy
    -> (PartInfo -> InputStream ByteString -> IO a)
    -> m ([FormParam], [FormFile a])
    handleFormUploads UploadPolicy
    uploadPolicy FileUploadPolicy
    filePolicy PartInfo -> InputStream ByteString -> IO a
    partHandler = do
        (params, !st) <- UploadPolicy
    -> PartFold (UploadState a)
    -> UploadState a
    -> m ([FormParam], UploadState a)
    forall (m :: * -> *) a.
    MonadSnap m =>
    UploadPolicy -> PartFold a -> a -> m ([FormParam], a)
    foldMultipart UploadPolicy
    uploadPolicy PartFold (UploadState a)
    go (Int -> ([FormFile a] -> [FormFile a]) -> UploadState a
    forall a. Int -> ([FormFile a] -> [FormFile a]) -> UploadState a
    UploadState Int
    0 [FormFile a] -> [FormFile a]
    forall a. a -> a
    id)
        return (params, uploadedFiles st [])
      where
        go :: PartFold (UploadState a)
    go !PartInfo
    partInfo InputStream ByteString
    stream !UploadState a
    st = do
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    numUploads Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    maxFiles) IO ()
    forall {a}. IO a
    throwTooManyFiles

            case PartInfo -> Maybe ByteString
    partFileName PartInfo
    partInfo of
              Maybe ByteString
    Nothing -> IO (UploadState a)
    onEmptyName
              Just ByteString
    _ -> IO (UploadState a)
    takeIt

          where
            numUploads :: Int
    numUploads = UploadState a -> Int
    forall a. UploadState a -> Int
    numUploadedFiles UploadState a
    st
            files :: [FormFile a] -> [FormFile a]
    files = UploadState a -> [FormFile a] -> [FormFile a]
    forall a. UploadState a -> [FormFile a] -> [FormFile a]
    uploadedFiles UploadState a
    st
            maxFiles :: Int
    maxFiles = FileUploadPolicy -> Int
    maxNumberOfFiles FileUploadPolicy
    filePolicy
            maxFileSize :: Int64
    maxFileSize = FileUploadPolicy -> Int64
    maxFileUploadSize FileUploadPolicy
    filePolicy
            fnText :: ByteString
    fnText = ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe ByteString
    "" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ PartInfo -> Maybe ByteString
    partFileName PartInfo
    partInfo

            fn :: Text
    fn = ByteString -> Text
    TE.decodeUtf8 ByteString
    fnText

            takeIt :: IO (UploadState a)
    takeIt = do
                str' <- Int64 -> InputStream ByteString -> IO (InputStream ByteString)
    Streams.throwIfProducesMoreThan Int64
    maxFileSize InputStream ByteString
    stream
                r <- partHandler partInfo str' `catch` tooMany maxFileSize
                let f = ByteString -> a -> FormFile a
    forall a. ByteString -> a -> FormFile a
    FormFile (PartInfo -> ByteString
    partFieldName PartInfo
    partInfo) a
    r
                return $! UploadState (succ numUploads) (files . ([f] ++) )

            skipIt :: Int64 -> IO (UploadState a)
    skipIt Int64
    maxSize = do
                str' <- Int64 -> InputStream ByteString -> IO (InputStream ByteString)
    Streams.throwIfProducesMoreThan Int64
    maxSize InputStream ByteString
    stream
                !_ <- Streams.skipToEof str' `catch` tooMany maxSize
                return $! UploadState (succ numUploads) files

            onEmptyName :: IO (UploadState a)
    onEmptyName = if FileUploadPolicy -> Bool
    skipEmptyFileName FileUploadPolicy
    filePolicy
                          then Int64 -> IO (UploadState a)
    skipIt (FileUploadPolicy -> Int64
    maxEmptyFileNameSize FileUploadPolicy
    filePolicy)
                          else IO (UploadState a)
    takeIt

            throwTooManyFiles :: IO a
    throwTooManyFiles = PolicyViolationException -> IO a
    forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
    throwIO (PolicyViolationException -> IO a)
    -> (Text -> PolicyViolationException) -> Text -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> PolicyViolationException
    PolicyViolationException (Text -> IO a) -> Text -> IO a
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    T.concat
                                [Text
    "number of files exceeded the maximum of "
                                ,FilePath -> Text
    T.pack (Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    maxFiles) ]

            tooMany :: a -> TooManyBytesReadException -> m a
    tooMany a
    maxSize (TooManyBytesReadException
    _ :: TooManyBytesReadException) =
                PolicyViolationException -> m a
    forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
    throwIO (PolicyViolationException -> m a)
    -> (Text -> PolicyViolationException) -> Text -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> PolicyViolationException
    PolicyViolationException (Text -> m a) -> Text -> m a
    forall a b. (a -> b) -> a -> b
    $
                        [Text] -> Text
    T.concat [ Text
    "File \""
                                 , Text
    fn
                                 , Text
    "\" exceeded maximum allowable size "
                                 , FilePath -> Text
    T.pack (FilePath -> Text) -> FilePath -> Text
    forall a b. (a -> b) -> a -> b
    $ a -> FilePath
    forall a. Show a => a -> FilePath
    show a
    maxSize ]

    ------------------------------------------------------------------------------
    -- | A type alias for a function that will process one of the parts of a
    -- @multipart/form-data@ HTTP request body with accumulator.
    type PartFold a = PartInfo -> InputStream ByteString -> a -> IO a

    ------------------------------------------------------------------------------
    -- | Given an upload policy and a function to consume uploaded \"parts\",
    -- consume a request body uploaded with @Content-type: multipart/form-data@.
    --
    -- If 'setProcessFormInputs' is 'True', then parts with disposition @form-data@
    -- (a form parameter) will be processed and returned as first element of
    -- resulting pair. Parts with other disposition will be fed to 'PartFold'
    -- handler.
    --
    -- If 'setProcessFormInputs' is 'False', then parts with any disposition will
    -- be fed to 'PartFold' handler and first element of returned pair will be
    -- empty. In this case it is important that you limit number of form inputs
    -- and sizes of inputs in your 'PartFold' handler to avoid common DOS attacks.
    --
    -- Note: /THE REQUEST MUST BE CORRECTLY ENCODED/. If the request's
    -- @Content-type@ is not \"@multipart/formdata@\", this function skips
    -- processing using 'pass'.
    --
    -- Most users will opt for the higher-level 'handleFileUploads', which writes
    -- to temporary files, rather than 'handleMultipart'. This function should be
    -- chosen, however, if you need to stream uploaded files directly to your own
    -- processing function: e.g. to a database or a remote service via RPC.
    --
    -- If the client's upload rate passes below the configured minimum (see
    -- 'setMinimumUploadRate' and 'setMinimumUploadSeconds'), this function
    -- terminates the connection. This setting is there to protect the server
    -- against slowloris-style denial of service attacks.
    --
    -- /Exceptions/
    --
    -- If the given 'UploadPolicy' stipulates that you wish form inputs to be
    -- processed (using 'setProcessFormInputs'), and a form input exceeds the
    -- maximum allowable size or the form exceeds maximum number of inputs, this
    -- function will throw a 'PolicyViolationException'.
    --
    -- If an uploaded part contains MIME headers longer than a fixed internal
    -- threshold (currently 32KB), this function will throw a 'BadPartException'.
    --
    -- /Since: 1.0.3.0/
    foldMultipart ::
           (MonadSnap m) =>
           UploadPolicy        -- ^ global upload policy
        -> PartFold a          -- ^ part processor
        -> a                   -- ^ seed accumulator
        -> m ([FormParam], a)
    foldMultipart :: forall (m :: * -> *) a.
    MonadSnap m =>
    UploadPolicy -> PartFold a -> a -> m ([FormParam], a)
    foldMultipart UploadPolicy
    uploadPolicy PartFold a
    origPartHandler a
    zero = do
        hdrs <- (Request -> Headers) -> m Request -> m Headers
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Request -> Headers
    forall a. HasHeaders a => a -> Headers
    headers m Request
    forall (m :: * -> *). MonadSnap m => m Request
    getRequest
        let (ct, mbBoundary) = getContentType hdrs

        tickleTimeout <- liftM (. max) getTimeoutModifier
        let bumpTimeout = Int -> IO ()
    tickleTimeout (Int -> IO ()) -> Int -> IO ()
    forall a b. (a -> b) -> a -> b
    $ UploadPolicy -> Int
    uploadTimeout UploadPolicy
    uploadPolicy

        let partHandler = if UploadPolicy -> Bool
    doProcessFormInputs UploadPolicy
    uploadPolicy
                            then Int64
    -> PartFold a
    -> PartInfo
    -> InputStream ByteString
    -> a
    -> IO (Capture a)
    forall a.
    Int64
    -> PartFold a
    -> PartInfo
    -> InputStream ByteString
    -> a
    -> IO (Capture a)
    captureVariableOrReadFile
                                     (UploadPolicy -> Int64
    getMaximumFormInputSize UploadPolicy
    uploadPolicy)
                                     PartFold a
    origPartHandler
                            else \PartInfo
    x InputStream ByteString
    y a
    acc -> (a -> Capture a) -> IO a -> IO (Capture a)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM a -> Capture a
    forall a. a -> Capture a
    File (IO a -> IO (Capture a)) -> IO a -> IO (Capture a)
    forall a b. (a -> b) -> a -> b
    $ PartFold a
    origPartHandler PartInfo
    x InputStream ByteString
    y a
    acc

        -- not well-formed multipart? bomb out.
        guard (ct == "multipart/form-data")

        boundary <- maybe (throwIO $ BadPartException
                           "got multipart/form-data without boundary")
                          return
                          mbBoundary

        -- RateTooSlowException will be caught and properly dealt with by
        -- runRequestBody
        runRequestBody (proc bumpTimeout boundary partHandler)

      where
        --------------------------------------------------------------------------
        uploadRate :: Double
    uploadRate  = UploadPolicy -> Double
    minimumUploadRate UploadPolicy
    uploadPolicy
        uploadSecs :: Int
    uploadSecs  = UploadPolicy -> Int
    minimumUploadSeconds UploadPolicy
    uploadPolicy
        maxFormVars :: Int
    maxFormVars = UploadPolicy -> Int
    maximumNumberOfFormInputs UploadPolicy
    uploadPolicy

        --------------------------------------------------------------------------
        proc :: IO ()
    -> ByteString
    -> (PartInfo -> InputStream ByteString -> a -> IO (Capture a))
    -> InputStream ByteString
    -> IO ([FormParam], a)
    proc IO ()
    bumpTimeout ByteString
    boundary PartInfo -> InputStream ByteString -> a -> IO (Capture a)
    partHandler =
            IO ()
    -> Double
    -> Int
    -> InputStream ByteString
    -> IO (InputStream ByteString)
    Streams.throwIfTooSlow IO ()
    bumpTimeout Double
    uploadRate Int
    uploadSecs (InputStream ByteString -> IO (InputStream ByteString))
    -> (InputStream ByteString -> IO ([FormParam], a))
    -> InputStream ByteString
    -> IO ([FormParam], a)
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=>
            Int
    -> ByteString
    -> (PartInfo -> InputStream ByteString -> a -> IO (Capture a))
    -> a
    -> InputStream ByteString
    -> IO ([FormParam], a)
    forall a.
    Int
    -> ByteString
    -> (PartInfo -> InputStream ByteString -> a -> IO (Capture a))
    -> a
    -> InputStream ByteString
    -> IO ([FormParam], a)
    internalFoldMultipart Int
    maxFormVars ByteString
    boundary PartInfo -> InputStream ByteString -> a -> IO (Capture a)
    partHandler a
    zero

    ------------------------------------------------------------------------------
    -- | A type alias for a function that will process one of the parts of a
    -- @multipart/form-data@ HTTP request body without usinc accumulator.
    type PartProcessor a = PartInfo -> InputStream ByteString -> IO a

    ------------------------------------------------------------------------------
    -- | A variant of 'foldMultipart' accumulating results into a list.
    -- Also puts captured 'FormParam's into rqPostParams and rqParams maps.
    --
    handleMultipart ::
           (MonadSnap m) =>
           UploadPolicy        -- ^ global upload policy
        -> PartProcessor a     -- ^ part processor
        -> m [a]
    handleMultipart :: forall (m :: * -> *) a.
    MonadSnap m =>
    UploadPolicy -> PartProcessor a -> m [a]
    handleMultipart UploadPolicy
    uploadPolicy PartProcessor a
    origPartHandler = do
        (captures, files) <- UploadPolicy
    -> PartFold ([a] -> [a])
    -> ([a] -> [a])
    -> m ([FormParam], [a] -> [a])
    forall (m :: * -> *) a.
    MonadSnap m =>
    UploadPolicy -> PartFold a -> a -> m ([FormParam], a)
    foldMultipart UploadPolicy
    uploadPolicy PartFold ([a] -> [a])
    forall {c}.
    PartInfo -> InputStream ByteString -> ([a] -> c) -> IO ([a] -> c)
    partFold [a] -> [a]
    forall a. a -> a
    id
        procCaptures captures
        return $! files []

      where
        partFold :: PartInfo -> InputStream ByteString -> ([a] -> c) -> IO ([a] -> c)
    partFold PartInfo
    info InputStream ByteString
    input [a] -> c
    acc = do
          x <- PartProcessor a
    origPartHandler PartInfo
    info InputStream ByteString
    input
          return $ acc . ([x]++)
        --------------------------------------------------------------------------
        procCaptures :: [FormParam] -> f ()
    procCaptures []          = () -> f ()
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
        procCaptures [FormParam]
    params = do
            rq <- f Request
    forall (m :: * -> *). MonadSnap m => m Request
    getRequest
            putRequest $ modifyParams (\Params
    m -> (FormParam -> Params -> Params) -> Params -> [FormParam] -> Params
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr FormParam -> Params -> Params
    forall {k} {a}. Ord k => (k, a) -> Map k [a] -> Map k [a]
    ins Params
    m [FormParam]
    params) rq

        --------------------------------------------------------------------------
        ins :: (k, a) -> Map k [a] -> Map k [a]
    ins (!k
    k, !a
    v) = ([a] -> [a] -> [a]) -> k -> [a] -> Map k [a] -> Map k [a]
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    Map.insertWith (\[a]
    _ [a]
    ex -> (a
    va -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ex)) k
    k [a
    v]
             -- prepend value if key exists, since we are folding from right

        --------------------------------------------------------------------------
        modifyParams :: (Params -> Params) -> Request -> Request
    modifyParams Params -> Params
    f Request
    r = Request
    r { rqPostParams = f $ rqPostParams r
                             , rqParams     = f $ rqParams r
                             }

    ------------------------------------------------------------------------------
    -- | Represents the disposition type specified via the @Content-Disposition@
    -- header field. See <https://www.ietf.org/rfc/rfc1806.txt RFC 1806>.
    data PartDisposition =
        DispositionAttachment       -- ^ @Content-Disposition: attachment@.
      | DispositionFile             -- ^ @Content-Disposition: file@.
      | DispositionFormData         -- ^ @Content-Disposition: form-data@.
      | DispositionOther ByteString -- ^ Any other value.
      deriving (PartDisposition -> PartDisposition -> Bool
    (PartDisposition -> PartDisposition -> Bool)
    -> (PartDisposition -> PartDisposition -> Bool)
    -> Eq PartDisposition
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PartDisposition -> PartDisposition -> Bool
    == :: PartDisposition -> PartDisposition -> Bool
    $c/= :: PartDisposition -> PartDisposition -> Bool
    /= :: PartDisposition -> PartDisposition -> Bool
    Eq, Int -> PartDisposition -> ShowS
    [PartDisposition] -> ShowS
    PartDisposition -> FilePath
    (Int -> PartDisposition -> ShowS)
    -> (PartDisposition -> FilePath)
    -> ([PartDisposition] -> ShowS)
    -> Show PartDisposition
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PartDisposition -> ShowS
    showsPrec :: Int -> PartDisposition -> ShowS
    $cshow :: PartDisposition -> FilePath
    show :: PartDisposition -> FilePath
    $cshowList :: [PartDisposition] -> ShowS
    showList :: [PartDisposition] -> ShowS
    Show)

    ------------------------------------------------------------------------------
    -- | 'PartInfo' contains information about a \"part\" in a request uploaded
    -- with @Content-type: multipart/form-data@.
    data PartInfo =
      PartInfo
      { PartInfo -> ByteString
    partFieldName   :: !ByteString
        -- ^ Field name associated with this part (i.e., the name specified with
        -- @\<input name=\"partFieldName\" ...@).
      , PartInfo -> Maybe ByteString
    partFileName    :: !(Maybe ByteString)
        -- ^ Name of the uploaded file.
      , PartInfo -> ByteString
    partContentType :: !ByteString
        -- ^ Content type of this part.
      , PartInfo -> PartDisposition
    partDisposition :: !PartDisposition
        -- ^ Disposition type of this part. See 'PartDisposition'.
      , PartInfo -> Headers
    partHeaders     :: !Headers
        -- ^ Remaining headers associated with this part.
      }
      deriving (Int -> PartInfo -> ShowS
    [PartInfo] -> ShowS
    PartInfo -> FilePath
    (Int -> PartInfo -> ShowS)
    -> (PartInfo -> FilePath) -> ([PartInfo] -> ShowS) -> Show PartInfo
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PartInfo -> ShowS
    showsPrec :: Int -> PartInfo -> ShowS
    $cshow :: PartInfo -> FilePath
    show :: PartInfo -> FilePath
    $cshowList :: [PartInfo] -> ShowS
    showList :: [PartInfo] -> ShowS
    Show)

    ------------------------------------------------------------------------------
    toPartDisposition :: ByteString -> PartDisposition
    toPartDisposition :: ByteString -> PartDisposition
    toPartDisposition ByteString
    s | ByteString
    s ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "attachment" = PartDisposition
    DispositionAttachment
                        | ByteString
    s ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "file"       = PartDisposition
    DispositionFile
                        | ByteString
    s ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "form-data"  = PartDisposition
    DispositionFormData
                        | Bool
    otherwise         = ByteString -> PartDisposition
    DispositionOther ByteString
    s

    ------------------------------------------------------------------------------
    -- | All of the exceptions defined in this package inherit from
    -- 'FileUploadException', so if you write
    --
    -- > foo `catch` \(e :: FileUploadException) -> ...
    --
    -- you can catch a 'BadPartException', a 'PolicyViolationException', etc.
    data FileUploadException = forall e . (ExceptionWithReason e, Show e) =>
                               WrappedFileUploadException e
      deriving (Typeable)

    ------------------------------------------------------------------------------
    class Exception e => ExceptionWithReason e where
        exceptionReason :: e -> Text

    ------------------------------------------------------------------------------
    instance Show FileUploadException where
        show :: FileUploadException -> FilePath
    show (WrappedFileUploadException e
    e) = e -> FilePath
    forall a. Show a => a -> FilePath
    show e
    e

    ------------------------------------------------------------------------------
    instance Exception FileUploadException

    ------------------------------------------------------------------------------
    -- | Human-readable error message corresponding to the 'FileUploadException'.
    fileUploadExceptionReason :: FileUploadException -> Text
    fileUploadExceptionReason :: FileUploadException -> Text
    fileUploadExceptionReason (WrappedFileUploadException e
    e) = e -> Text
    forall e. ExceptionWithReason e => e -> Text
    exceptionReason e
    e

    ------------------------------------------------------------------------------
    uploadExceptionToException :: ExceptionWithReason e => e -> SomeException
    uploadExceptionToException :: forall e. ExceptionWithReason e => e -> SomeException
    uploadExceptionToException = FileUploadException -> SomeException
    forall e. Exception e => e -> SomeException
    toException (FileUploadException -> SomeException)
    -> (e -> FileUploadException) -> e -> SomeException
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> FileUploadException
    forall e.
    (ExceptionWithReason e, Show e) =>
    e -> FileUploadException
    WrappedFileUploadException

    ------------------------------------------------------------------------------
    uploadExceptionFromException :: ExceptionWithReason e => SomeException -> Maybe e
    uploadExceptionFromException :: forall e. ExceptionWithReason e => SomeException -> Maybe e
    uploadExceptionFromException SomeException
    x = do
        WrappedFileUploadException e <- SomeException -> Maybe FileUploadException
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    x
        cast e

    ------------------------------------------------------------------------------
    -- | Thrown when a part is invalid in some way (e.g. the headers are too large).
    data BadPartException = BadPartException {
      -- | Human-readable error message corresponding to the 'BadPartException'.
      BadPartException -> Text
    badPartExceptionReason :: Text
      }
      deriving (Typeable)

    instance Exception BadPartException where
        toException :: BadPartException -> SomeException
    toException = BadPartException -> SomeException
    forall e. ExceptionWithReason e => e -> SomeException
    uploadExceptionToException
        fromException :: SomeException -> Maybe BadPartException
    fromException = SomeException -> Maybe BadPartException
    forall e. ExceptionWithReason e => SomeException -> Maybe e
    uploadExceptionFromException

    instance ExceptionWithReason BadPartException where
        exceptionReason :: BadPartException -> Text
    exceptionReason (BadPartException Text
    e) = [Text] -> Text
    T.concat [Text
    "Bad part: ", Text
    e]

    instance Show BadPartException where
      show :: BadPartException -> FilePath
    show = Text -> FilePath
    T.unpack (Text -> FilePath)
    -> (BadPartException -> Text) -> BadPartException -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BadPartException -> Text
    forall e. ExceptionWithReason e => e -> Text
    exceptionReason

    ------------------------------------------------------------------------------
    -- | Thrown when an 'UploadPolicy' or 'PartUploadPolicy' is violated.
    data PolicyViolationException = PolicyViolationException {
          -- | Human-readable error message corresponding to the
          -- 'PolicyViolationException'.
          PolicyViolationException -> Text
    policyViolationExceptionReason :: Text
        } deriving (Typeable)

    instance Exception PolicyViolationException where
        toException :: PolicyViolationException -> SomeException
    toException e :: PolicyViolationException
    e@(PolicyViolationException Text
    _) =
            PolicyViolationException -> SomeException
    forall e. ExceptionWithReason e => e -> SomeException
    uploadExceptionToException PolicyViolationException
    e
        fromException :: SomeException -> Maybe PolicyViolationException
    fromException = SomeException -> Maybe PolicyViolationException
    forall e. ExceptionWithReason e => SomeException -> Maybe e
    uploadExceptionFromException

    instance ExceptionWithReason PolicyViolationException where
        exceptionReason :: PolicyViolationException -> Text
    exceptionReason (PolicyViolationException Text
    r) =
            [Text] -> Text
    T.concat [Text
    "File upload policy violation: ", Text
    r]

    instance Show PolicyViolationException where
      show :: PolicyViolationException -> FilePath
    show (PolicyViolationException Text
    s) = FilePath
    "File upload policy violation: "
                                                FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> FilePath
    T.unpack Text
    s

    ------------------------------------------------------------------------------
    -- | 'UploadPolicy' controls overall policy decisions relating to
    -- @multipart/form-data@ uploads, specifically:
    --
    -- * whether to treat parts without filenames as form input (reading them into
    --   the 'rqParams' map)
    --
    -- * because form input is read into memory, the maximum size of a form input
    --   read in this manner, and the maximum number of form inputs
    --
    -- * the minimum upload rate a client must maintain before we kill the
    --   connection; if very low-bitrate uploads were allowed then a Snap server
    --   would be vulnerable to a trivial denial-of-service using a
    --   \"slowloris\"-type attack
    --
    -- * the minimum number of seconds which must elapse before we start killing
    --   uploads for having too low an upload rate.
    --
    -- * the amount of time we should wait before timing out the connection
    --   whenever we receive input from the client.
    data UploadPolicy = UploadPolicy {
          UploadPolicy -> Bool
    processFormInputs         :: Bool
        , UploadPolicy -> Int64
    maximumFormInputSize      :: Int64
        , UploadPolicy -> Int
    maximumNumberOfFormInputs :: Int
        , UploadPolicy -> Double
    minimumUploadRate         :: Double
        , UploadPolicy -> Int
    minimumUploadSeconds      :: Int
        , UploadPolicy -> Int
    uploadTimeout             :: Int
    }

    ------------------------------------------------------------------------------
    -- | A reasonable set of defaults for upload policy. The default policy is:
    --
    --   [@maximum form input size@]                128kB
    --
    --   [@maximum number of form inputs@]          10
    --
    --   [@minimum upload rate@]                    1kB/s
    --
    --   [@seconds before rate limiting kicks in@]  10
    --
    --   [@inactivity timeout@]                     20 seconds
    --
    defaultUploadPolicy :: UploadPolicy
    defaultUploadPolicy :: UploadPolicy
    defaultUploadPolicy = Bool -> Int64 -> Int -> Double -> Int -> Int -> UploadPolicy
    UploadPolicy Bool
    True Int64
    maxSize Int
    maxNum Double
    minRate Int
    minSeconds Int
    tout
      where
        maxSize :: Int64
    maxSize    = Int64
    2Int64 -> Int -> Int64
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    17::Int)
        maxNum :: Int
    maxNum     = Int
    10
        minRate :: Double
    minRate    = Double
    1000
        minSeconds :: Int
    minSeconds = Int
    10
        tout :: Int
    tout       = Int
    20

    ------------------------------------------------------------------------------
    -- | Does this upload policy stipulate that we want to treat parts without
    -- filenames as form input?
    doProcessFormInputs :: UploadPolicy -> Bool
    doProcessFormInputs :: UploadPolicy -> Bool
    doProcessFormInputs = UploadPolicy -> Bool
    processFormInputs

    ------------------------------------------------------------------------------
    -- | Set the upload policy for treating parts without filenames as form input.
    setProcessFormInputs :: Bool -> UploadPolicy -> UploadPolicy
    setProcessFormInputs :: Bool -> UploadPolicy -> UploadPolicy
    setProcessFormInputs Bool
    b UploadPolicy
    u = UploadPolicy
    u { processFormInputs = b }

    ------------------------------------------------------------------------------
    -- | Get the maximum size of a form input which will be read into our
    --   'rqParams' map.
    getMaximumFormInputSize :: UploadPolicy -> Int64
    getMaximumFormInputSize :: UploadPolicy -> Int64
    getMaximumFormInputSize = UploadPolicy -> Int64
    maximumFormInputSize

    ------------------------------------------------------------------------------
    -- | Set the maximum size of a form input which will be read into our
    --   'rqParams' map.
    setMaximumFormInputSize :: Int64 -> UploadPolicy -> UploadPolicy
    setMaximumFormInputSize :: Int64 -> UploadPolicy -> UploadPolicy
    setMaximumFormInputSize Int64
    s UploadPolicy
    u = UploadPolicy
    u { maximumFormInputSize = s }

    ------------------------------------------------------------------------------
    -- | Get the maximum size of a form input which will be read into our
    --   'rqParams' map.
    getMaximumNumberOfFormInputs :: UploadPolicy -> Int
    getMaximumNumberOfFormInputs :: UploadPolicy -> Int
    getMaximumNumberOfFormInputs = UploadPolicy -> Int
    maximumNumberOfFormInputs

    ------------------------------------------------------------------------------
    -- | Set the maximum size of a form input which will be read into our
    --   'rqParams' map.
    setMaximumNumberOfFormInputs :: Int -> UploadPolicy -> UploadPolicy
    setMaximumNumberOfFormInputs :: Int -> UploadPolicy -> UploadPolicy
    setMaximumNumberOfFormInputs Int
    s UploadPolicy
    u = UploadPolicy
    u { maximumNumberOfFormInputs = s }

    ------------------------------------------------------------------------------
    -- | Get the minimum rate (in /bytes\/second/) a client must maintain before
    --   we kill the connection.
    getMinimumUploadRate :: UploadPolicy -> Double
    getMinimumUploadRate :: UploadPolicy -> Double
    getMinimumUploadRate = UploadPolicy -> Double
    minimumUploadRate

    ------------------------------------------------------------------------------
    -- | Set the minimum rate (in /bytes\/second/) a client must maintain before
    --   we kill the connection.
    setMinimumUploadRate :: Double -> UploadPolicy -> UploadPolicy
    setMinimumUploadRate :: Double -> UploadPolicy -> UploadPolicy
    setMinimumUploadRate Double
    s UploadPolicy
    u = UploadPolicy
    u { minimumUploadRate = s }

    ------------------------------------------------------------------------------
    -- | Get the amount of time which must elapse before we begin enforcing the
    --   upload rate minimum
    getMinimumUploadSeconds :: UploadPolicy -> Int
    getMinimumUploadSeconds :: UploadPolicy -> Int
    getMinimumUploadSeconds = UploadPolicy -> Int
    minimumUploadSeconds

    ------------------------------------------------------------------------------
    -- | Set the amount of time which must elapse before we begin enforcing the
    --   upload rate minimum
    setMinimumUploadSeconds :: Int -> UploadPolicy -> UploadPolicy
    setMinimumUploadSeconds :: Int -> UploadPolicy -> UploadPolicy
    setMinimumUploadSeconds Int
    s UploadPolicy
    u = UploadPolicy
    u { minimumUploadSeconds = s }

    ------------------------------------------------------------------------------
    -- | Get the \"upload timeout\". Whenever input is received from the client,
    --   the connection timeout is set this many seconds in the future.
    getUploadTimeout :: UploadPolicy -> Int
    getUploadTimeout :: UploadPolicy -> Int
    getUploadTimeout = UploadPolicy -> Int
    uploadTimeout

    ------------------------------------------------------------------------------
    -- | Set the upload timeout.
    setUploadTimeout :: Int -> UploadPolicy -> UploadPolicy
    setUploadTimeout :: Int -> UploadPolicy -> UploadPolicy
    setUploadTimeout Int
    s UploadPolicy
    u = UploadPolicy
    u { uploadTimeout = s }

    ------------------------------------------------------------------------------

    -- | File upload policy, if any policy is violated then
    -- 'PolicyViolationException' is thrown
    data FileUploadPolicy = FileUploadPolicy
        { FileUploadPolicy -> Int64
    maxFileUploadSize    :: !Int64
        , FileUploadPolicy -> Int
    maxNumberOfFiles     :: !Int
        , FileUploadPolicy -> Bool
    skipEmptyFileName    :: !Bool
        , FileUploadPolicy -> Int64
    maxEmptyFileNameSize :: !Int64
        }

    -- | A default 'FileUploadPolicy'
    --
    --   [@maximum file size@]             1MB
    --
    --   [@maximum number of files@]       10
    --
    --   [@skip files without name@]       yes
    --
    --   [@maximum size of skipped file@]  0
    --
    --
    defaultFileUploadPolicy :: FileUploadPolicy
    defaultFileUploadPolicy :: FileUploadPolicy
    defaultFileUploadPolicy = Int64 -> Int -> Bool -> Int64 -> FileUploadPolicy
    FileUploadPolicy Int64
    maxFileSize Int
    maxFiles
                                               Bool
    skipEmptyName Int64
    maxEmptySize
      where
        maxFileSize :: Int64
    maxFileSize = Int64
    1048576 -- 1MB
        maxFiles :: Int
    maxFiles    = Int
    10
        skipEmptyName :: Bool
    skipEmptyName = Bool
    True
        maxEmptySize :: Int64
    maxEmptySize = Int64
    0

    -- | Maximum size of single uploaded file.
    setMaximumFileSize :: Int64 -> FileUploadPolicy -> FileUploadPolicy
    setMaximumFileSize :: Int64 -> FileUploadPolicy -> FileUploadPolicy
    setMaximumFileSize Int64
    maxSize FileUploadPolicy
    s =
        FileUploadPolicy
    s { maxFileUploadSize = maxSize }

    -- | Maximum number of uploaded files.
    setMaximumNumberOfFiles :: Int -> FileUploadPolicy -> FileUploadPolicy
    setMaximumNumberOfFiles :: Int -> FileUploadPolicy -> FileUploadPolicy
    setMaximumNumberOfFiles Int
    maxFiles FileUploadPolicy
    s =
        FileUploadPolicy
    s { maxNumberOfFiles = maxFiles }

    -- | Skip files with empty file names.
    --
    -- If set, parts without filenames will not be fed to storage function.
    --
    -- HTML5 form data encoding standard states that form input fields of type
    -- file, without value set, are encoded same way as if file with empty body,
    -- empty file name, and type @application/octet-stream@ was set as value.
    --
    -- You most likely want to use this with zero bytes allowed to avoid storing
    -- such fields (see 'setMaximumSkippedFileSize').
    --
    -- By default files without names are skipped.
    --
    -- /Since: 1.0.3.0/
    setSkipFilesWithoutNames :: Bool -> FileUploadPolicy -> FileUploadPolicy
    setSkipFilesWithoutNames :: Bool -> FileUploadPolicy -> FileUploadPolicy
    setSkipFilesWithoutNames Bool
    shouldSkip FileUploadPolicy
    s =
        FileUploadPolicy
    s { skipEmptyFileName = shouldSkip }

    -- | Maximum size of file without name which can be skipped.
    --
    -- Ignored if 'setSkipFilesWithoutNames' is @False@.
    --
    -- If skipped file is larger than this setting then 'FileUploadException'
    -- is thrown.
    --
    -- By default maximum file size is 0.
    --
    -- /Since: 1.0.3.0/
    setMaximumSkippedFileSize :: Int64 -> FileUploadPolicy -> FileUploadPolicy
    setMaximumSkippedFileSize :: Int64 -> FileUploadPolicy -> FileUploadPolicy
    setMaximumSkippedFileSize Int64
    maxSize FileUploadPolicy
    s =
        FileUploadPolicy
    s { maxEmptyFileNameSize = maxSize }

    ------------------------------------------------------------------------------
    -- | Upload policy can be set on an \"general\" basis (using 'UploadPolicy'),
    --   but handlers can also make policy decisions on individual files\/parts
    --   uploaded. For each part uploaded, handlers can decide:
    --
    -- * whether to allow the file upload at all
    --
    -- * the maximum size of uploaded files, if allowed
    data PartUploadPolicy = PartUploadPolicy (Maybe Int64)

    ------------------------------------------------------------------------------
    -- | Disallows the file to be uploaded.
    disallow :: PartUploadPolicy
    disallow :: PartUploadPolicy
    disallow = Maybe Int64 -> PartUploadPolicy
    PartUploadPolicy Maybe Int64
    forall a. Maybe a
    Nothing

    ------------------------------------------------------------------------------
    -- | Allows the file to be uploaded, with maximum size /n/ in bytes.
    allowWithMaximumSize :: Int64 -> PartUploadPolicy
    allowWithMaximumSize :: Int64 -> PartUploadPolicy
    allowWithMaximumSize = Maybe Int64 -> PartUploadPolicy
    PartUploadPolicy (Maybe Int64 -> PartUploadPolicy)
    -> (Int64 -> Maybe Int64) -> Int64 -> PartUploadPolicy
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int64 -> Maybe Int64
    forall a. a -> Maybe a
    Just

    ------------------------------------------------------------------------------
    -- | Stores file body in memory as Lazy ByteString.
    storeAsLazyByteString :: InputStream ByteString -> IO LB.ByteString
    storeAsLazyByteString :: InputStream ByteString -> IO ByteString
    storeAsLazyByteString !InputStream ByteString
    str = do
       f <- ((ByteString -> ByteString)
     -> ByteString -> ByteString -> ByteString)
    -> (ByteString -> ByteString)
    -> InputStream ByteString
    -> IO (ByteString -> ByteString)
    forall s a. (s -> a -> s) -> s -> InputStream a -> IO s
    Streams.fold (\ByteString -> ByteString
    f ByteString
    c -> ByteString -> ByteString
    f (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString -> ByteString
    LB.chunk ByteString
    c) ByteString -> ByteString
    forall a. a -> a
    id InputStream ByteString
    str
       return $! f LB.Empty

    ------------------------------------------------------------------------------
    -- | Store files in a temporary directory, and clean up on function exit.
    --
    -- Files are safe to move until function exists.
    --
    -- If asynchronous exception is thrown during cleanup, temporary files may
    -- remain.
    --
    -- @
    -- uploadsHandler = withTemporaryStore "/var/tmp" "upload-" $ \store -> do
    --     (inputs, files) <- handleFormUploads defaultUploadpolicy
    --                                          defaultFileUploadPolicy
    --                                          (const store)
    --     saveFiles files
    --
    -- @
    --
    withTemporaryStore ::
        MonadSnap m
        => FilePath -- ^ temporary directory
        -> String   -- ^ file name pattern
        -> ((InputStream ByteString -> IO FilePath) -> m a)
          -- ^ Action taking store function
        -> m a
    withTemporaryStore :: forall (m :: * -> *) a.
    MonadSnap m =>
    FilePath
    -> FilePath
    -> ((InputStream ByteString -> IO FilePath) -> m a)
    -> m a
    withTemporaryStore FilePath
    tempdir FilePath
    pat (InputStream ByteString -> IO FilePath) -> m a
    act = do
        ioref <- IO (IORef [FilePath]) -> m (IORef [FilePath])
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (IORef [FilePath]) -> m (IORef [FilePath]))
    -> IO (IORef [FilePath]) -> m (IORef [FilePath])
    forall a b. (a -> b) -> a -> b
    $ [FilePath] -> IO (IORef [FilePath])
    forall a. a -> IO (IORef a)
    IORef.newIORef []
        let
          modifyIORef' IORef a
    ref a -> a
    f = do -- ghc 7.4 does not have modifyIORef'
              x <- IORef a -> IO a
    forall a. IORef a -> IO a
    IORef.readIORef IORef a
    ref
              let x' = a -> a
    f a
    x
              x' `seq` IORef.writeIORef ref x'

          go InputStream ByteString
    input = do
              (fn, h) <- FilePath -> FilePath -> IO (FilePath, Handle)
    openBinaryTempFile FilePath
    tempdir FilePath
    pat
              modifyIORef' ioref (fn:)
              hSetBuffering h NoBuffering
              output <- Streams.handleToOutputStream h
              Streams.connect input output
              hClose h
              pure fn

          cleanup = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
              files <- IORef [FilePath] -> IO [FilePath]
    forall a. IORef a -> IO a
    IORef.readIORef IORef [FilePath]
    ioref
              forM_ files $ \FilePath
    fn ->
                 FilePath -> IO ()
    removeFile FilePath
    fn IO () -> (IOError -> IO ()) -> IO ()
    forall (m :: * -> *) e a.
    (MonadBaseControl IO m, Exception e) =>
    m a -> (e -> m a) -> m a
    `catch` IOError -> IO ()
    forall {f :: * -> *}. MonadBase IO f => IOError -> f ()
    handleExists
          handleExists IOError
    e = Bool -> f () -> f ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (IOError -> Bool
    isDoesNotExistError IOError
    e) (f () -> f ()) -> f () -> f ()
    forall a b. (a -> b) -> a -> b
    $ IOError -> f ()
    forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
    throwIO IOError
    e

        act go `finally` cleanup

    ------------------------------------------------------------------------------
    -- private exports follow. FIXME: organize
    ------------------------------------------------------------------------------

    ------------------------------------------------------------------------------
    captureVariableOrReadFile ::
           Int64                                   -- ^ maximum size of form input
        -> PartFold a                              -- ^ file reading code
        -> PartInfo -> InputStream ByteString
        -> a
        -> IO (Capture a)
    captureVariableOrReadFile :: forall a.
    Int64
    -> PartFold a
    -> PartInfo
    -> InputStream ByteString
    -> a
    -> IO (Capture a)
    captureVariableOrReadFile Int64
    maxSize PartFold a
    fileHandler PartInfo
    partInfo InputStream ByteString
    stream a
    acc =
        if Bool
    isFile
          then (a -> Capture a) -> IO a -> IO (Capture a)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM a -> Capture a
    forall a. a -> Capture a
    File (IO a -> IO (Capture a)) -> IO a -> IO (Capture a)
    forall a b. (a -> b) -> a -> b
    $ PartFold a
    fileHandler PartInfo
    partInfo InputStream ByteString
    stream a
    acc
          else IO (Capture a)
    forall {a}. IO (Capture a)
    variable IO (Capture a)
    -> (TooManyBytesReadException -> IO (Capture a)) -> IO (Capture a)
    forall (m :: * -> *) e a.
    (MonadBaseControl IO m, Exception e) =>
    m a -> (e -> m a) -> m a
    `catch` TooManyBytesReadException -> IO (Capture a)
    forall {m :: * -> *} {a}.
    MonadBase IO m =>
    TooManyBytesReadException -> m a
    handler

      where
        isFile :: Bool
    isFile = Maybe ByteString -> Bool
    forall a. Maybe a -> Bool
    isJust (PartInfo -> Maybe ByteString
    partFileName PartInfo
    partInfo) Bool -> Bool -> Bool
    ||
                 PartInfo -> PartDisposition
    partDisposition PartInfo
    partInfo PartDisposition -> PartDisposition -> Bool
    forall a. Eq a => a -> a -> Bool
    == PartDisposition
    DispositionFile

        variable :: IO (Capture a)
    variable = do
            !x <- ([ByteString] -> ByteString) -> IO [ByteString] -> IO ByteString
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM [ByteString] -> ByteString
    S.concat (IO [ByteString] -> IO ByteString)
    -> IO [ByteString] -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $
                 Int64 -> InputStream ByteString -> IO (InputStream ByteString)
    Streams.throwIfProducesMoreThan Int64
    maxSize InputStream ByteString
    stream IO (InputStream ByteString)
    -> (InputStream ByteString -> IO [ByteString]) -> IO [ByteString]
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= InputStream ByteString -> IO [ByteString]
    forall a. InputStream a -> IO [a]
    Streams.toList
            return $! Capture fieldName x

        fieldName :: ByteString
    fieldName = PartInfo -> ByteString
    partFieldName PartInfo
    partInfo

        handler :: TooManyBytesReadException -> m a
    handler (TooManyBytesReadException
    _ :: TooManyBytesReadException) =
            PolicyViolationException -> m a
    forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
    throwIO (PolicyViolationException -> m a)
    -> PolicyViolationException -> m a
    forall a b. (a -> b) -> a -> b
    $ Text -> PolicyViolationException
    PolicyViolationException (Text -> PolicyViolationException)
    -> Text -> PolicyViolationException
    forall a b. (a -> b) -> a -> b
    $
                    [Text] -> Text
    T.concat [ Text
    "form input '"
                             , ByteString -> Text
    TE.decodeUtf8 ByteString
    fieldName
                             , Text
    "' exceeded maximum permissible size ("
                             , FilePath -> Text
    T.pack (FilePath -> Text) -> FilePath -> Text
    forall a b. (a -> b) -> a -> b
    $ Int64 -> FilePath
    forall a. Show a => a -> FilePath
    show Int64
    maxSize
                             , Text
    " bytes)" ]

    ------------------------------------------------------------------------------
    data Capture a = Capture !ByteString !ByteString
                   | File a

    ------------------------------------------------------------------------------
    fileReader :: FilePath
               -> (PartInfo -> Either PolicyViolationException FilePath -> IO a)
               -> PartProcessor a
    fileReader :: forall a.
    FilePath
    -> (PartInfo -> Either PolicyViolationException FilePath -> IO a)
    -> PartProcessor a
    fileReader FilePath
    tmpdir PartInfo -> Either PolicyViolationException FilePath -> IO a
    partProc PartInfo
    partInfo InputStream ByteString
    input =
        FilePath -> FilePath -> ((FilePath, Handle) -> IO a) -> IO a
    forall a.
    FilePath -> FilePath -> ((FilePath, Handle) -> IO a) -> IO a
    withTempFile FilePath
    tmpdir FilePath
    "snap-upload-" (((FilePath, Handle) -> IO a) -> IO a)
    -> ((FilePath, Handle) -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \(FilePath
    fn, Handle
    h) -> do
            Handle -> BufferMode -> IO ()
    hSetBuffering Handle
    h BufferMode
    NoBuffering
            output <- Handle -> IO (OutputStream ByteString)
    Streams.handleToOutputStream Handle
    h
            Streams.connect input output
            hClose h
            partProc partInfo $ Right fn

    ------------------------------------------------------------------------------
    data MultipartState a = MultipartState
      { forall a. MultipartState a -> Int
    numFormVars       :: {-# UNPACK #-} !Int
      , forall a. MultipartState a -> Int
    numFormFiles      :: {-# UNPACK #-} !Int
      , forall a. MultipartState a -> [FormParam] -> [FormParam]
    capturedFields    :: !([FormParam] -> [FormParam])
      , forall a. MultipartState a -> a
    accumulator       :: !a
      }

    ------------------------------------------------------------------------------
    -- | A form parameter name-value pair
    type FormParam = (ByteString, ByteString)

    ------------------------------------------------------------------------------
    addCapture :: ByteString -> ByteString -> MultipartState a -> MultipartState a
    addCapture :: forall a.
    ByteString -> ByteString -> MultipartState a -> MultipartState a
    addCapture !ByteString
    k !ByteString
    v !MultipartState a
    ms =
      let !kv :: FormParam
    kv = (ByteString
    k,ByteString
    v)
          f :: [FormParam] -> [FormParam]
    f = MultipartState a -> [FormParam] -> [FormParam]
    forall a. MultipartState a -> [FormParam] -> [FormParam]
    capturedFields MultipartState a
    ms ([FormParam] -> [FormParam])
    -> ([FormParam] -> [FormParam]) -> [FormParam] -> [FormParam]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([FormParam
    kv][FormParam] -> [FormParam] -> [FormParam]
    forall a. [a] -> [a] -> [a]
    ++)
          !ms' :: MultipartState a
    ms' = MultipartState a
    ms { capturedFields = f
                    , numFormVars = succ (numFormVars ms) }
      in MultipartState a
    ms'

    ------------------------------------------------------------------------------
    internalFoldMultipart ::
           Int           -- ^ max num fields
        -> ByteString                                     -- ^ boundary value
        -> (PartInfo -> InputStream ByteString -> a -> IO (Capture a))  -- ^ part processor
        -> a
        -> InputStream ByteString
        -> IO ([FormParam], a)
    internalFoldMultipart :: forall a.
    Int
    -> ByteString
    -> (PartInfo -> InputStream ByteString -> a -> IO (Capture a))
    -> a
    -> InputStream ByteString
    -> IO ([FormParam], a)
    internalFoldMultipart !Int
    maxFormVars !ByteString
    boundary PartInfo -> InputStream ByteString -> a -> IO (Capture a)
    clientHandler !a
    zeroAcc !InputStream ByteString
    stream = IO ([FormParam], a)
    go
      where
        --------------------------------------------------------------------------
        initialState :: MultipartState a
    initialState = Int -> Int -> ([FormParam] -> [FormParam]) -> a -> MultipartState a
    forall a.
    Int -> Int -> ([FormParam] -> [FormParam]) -> a -> MultipartState a
    MultipartState Int
    0 Int
    0 [FormParam] -> [FormParam]
    forall a. a -> a
    id a
    zeroAcc

        --------------------------------------------------------------------------
        go :: IO ([FormParam], a)
    go = do
            -- swallow the first boundary
            _        <- Parser ByteString -> InputStream ByteString -> IO ByteString
    forall r. Parser r -> InputStream ByteString -> IO r
    parseFromStream (ByteString -> Parser ByteString
    parseFirstBoundary ByteString
    boundary) InputStream ByteString
    stream
            bmstream <- search (fullBoundary boundary) stream
            ms <- foldParts goPart bmstream initialState
            return $ (capturedFields ms [], accumulator ms)

        --------------------------------------------------------------------------
        pBoundary :: ByteString -> Parser ByteString
    pBoundary !ByteString
    b = Parser ByteString -> Parser ByteString
    forall i a. Parser i a -> Parser i a
    Atto.try (Parser ByteString -> Parser ByteString)
    -> Parser ByteString -> Parser ByteString
    forall a b. (a -> b) -> a -> b
    $ do
          _ <- ByteString -> Parser ByteString
    string ByteString
    "--"
          string b

        --------------------------------------------------------------------------
        fullBoundary :: ByteString -> ByteString
    fullBoundary !ByteString
    b       = [ByteString] -> ByteString
    S.concat [ByteString
    "\r\n", ByteString
    "--", ByteString
    b]
        pLine :: Parser ByteString
    pLine                 = (Char -> Bool) -> Parser ByteString
    takeWhile (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> Bool
    isEndOfLine (Word8 -> Bool) -> (Char -> Word8) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Word8
    c2w) Parser ByteString -> Parser ByteString -> Parser ByteString
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser ByteString
    eol
        parseFirstBoundary :: ByteString -> Parser ByteString
    parseFirstBoundary !ByteString
    b = ByteString -> Parser ByteString
    pBoundary ByteString
    b Parser ByteString -> Parser ByteString -> Parser ByteString
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Parser ByteString
    pLine Parser ByteString -> Parser ByteString -> Parser ByteString
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ByteString -> Parser ByteString
    parseFirstBoundary ByteString
    b)

        --------------------------------------------------------------------------
        takeHeaders :: InputStream ByteString -> IO Headers
    takeHeaders !InputStream ByteString
    str = IO Headers
    hdrs IO Headers
    -> (TooManyBytesReadException -> IO Headers) -> IO Headers
    forall (m :: * -> *) e a.
    (MonadBaseControl IO m, Exception e) =>
    m a -> (e -> m a) -> m a
    `catch` TooManyBytesReadException -> IO Headers
    forall {m :: * -> *} {a}.
    MonadBase IO m =>
    TooManyBytesReadException -> m a
    handler
          where
            hdrs :: IO Headers
    hdrs = do
                str' <- Int64 -> InputStream ByteString -> IO (InputStream ByteString)
    Streams.throwIfProducesMoreThan Int64
    mAX_HDRS_SIZE InputStream ByteString
    str
                liftM toHeaders $ parseFromStream pHeadersWithSeparator str'

            handler :: TooManyBytesReadException -> m a
    handler (TooManyBytesReadException
    _ :: TooManyBytesReadException) =
                BadPartException -> m a
    forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
    throwIO (BadPartException -> m a) -> BadPartException -> m a
    forall a b. (a -> b) -> a -> b
    $ Text -> BadPartException
    BadPartException Text
    "headers exceeded maximum size"

        --------------------------------------------------------------------------
        goPart :: InputStream ByteString -> MultipartState a -> IO (MultipartState a)
    goPart !InputStream ByteString
    str !MultipartState a
    state = do
            hdrs <- InputStream ByteString -> IO Headers
    takeHeaders InputStream ByteString
    str

            -- are we using mixed?
            let (contentType, mboundary) = getContentType hdrs
            let (fieldName, fileName, disposition) = getFieldHeaderInfo hdrs

            if contentType == "multipart/mixed"
              then maybe (throwIO $ BadPartException $
                          "got multipart/mixed without boundary")
                         (processMixed fieldName str state)
                         mboundary
              else do
                  let info = ByteString
    -> Maybe ByteString
    -> ByteString
    -> PartDisposition
    -> Headers
    -> PartInfo
    PartInfo ByteString
    fieldName Maybe ByteString
    fileName ByteString
    contentType PartDisposition
    disposition Headers
    hdrs
                  handlePart info str state

        --------------------------------------------------------------------------
        handlePart :: PartInfo
    -> InputStream ByteString
    -> MultipartState a
    -> IO (MultipartState a)
    handlePart !PartInfo
    info !InputStream ByteString
    str !MultipartState a
    ms = do
          r <- PartInfo -> InputStream ByteString -> a -> IO (Capture a)
    clientHandler PartInfo
    info InputStream ByteString
    str (MultipartState a -> a
    forall a. MultipartState a -> a
    accumulator MultipartState a
    ms)
          case r of
            Capture !ByteString
    k !ByteString
    v -> do
               Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    maxFormVars Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= MultipartState a -> Int
    forall a. MultipartState a -> Int
    numFormVars MultipartState a
    ms) IO ()
    forall {a}. IO a
    throwTooMuchVars
               MultipartState a -> IO (MultipartState a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MultipartState a -> IO (MultipartState a))
    -> MultipartState a -> IO (MultipartState a)
    forall a b. (a -> b) -> a -> b
    $! ByteString -> ByteString -> MultipartState a -> MultipartState a
    forall a.
    ByteString -> ByteString -> MultipartState a -> MultipartState a
    addCapture ByteString
    k ByteString
    v MultipartState a
    ms
            File !a
    newAcc -> MultipartState a -> IO (MultipartState a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MultipartState a -> IO (MultipartState a))
    -> MultipartState a -> IO (MultipartState a)
    forall a b. (a -> b) -> a -> b
    $! MultipartState a
    ms { accumulator = newAcc
                                         , numFormFiles = succ (numFormFiles ms)
                                         }

        throwTooMuchVars :: IO a
    throwTooMuchVars =
            PolicyViolationException -> IO a
    forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
    throwIO (PolicyViolationException -> IO a)
    -> (Text -> PolicyViolationException) -> Text -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> PolicyViolationException
    PolicyViolationException
            (Text -> IO a) -> Text -> IO a
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    T.concat [ Text
    "number of form inputs exceeded maximum of "
                       , FilePath -> Text
    T.pack (FilePath -> Text) -> FilePath -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    maxFormVars ]

        --------------------------------------------------------------------------
        processMixed :: ByteString
    -> InputStream ByteString
    -> MultipartState a
    -> ByteString
    -> IO (MultipartState a)
    processMixed !ByteString
    fieldName !InputStream ByteString
    str !MultipartState a
    state !ByteString
    mixedBoundary = do
            -- swallow the first boundary
            _  <- Parser ByteString -> InputStream ByteString -> IO ByteString
    forall r. Parser r -> InputStream ByteString -> IO r
    parseFromStream (ByteString -> Parser ByteString
    parseFirstBoundary ByteString
    mixedBoundary) InputStream ByteString
    str
            bm <- search (fullBoundary mixedBoundary) str
            foldParts (mixedStream fieldName) bm state

        --------------------------------------------------------------------------
        mixedStream :: ByteString
    -> InputStream ByteString
    -> MultipartState a
    -> IO (MultipartState a)
    mixedStream !ByteString
    fieldName !InputStream ByteString
    str !MultipartState a
    acc = do
            hdrs <- InputStream ByteString -> IO Headers
    takeHeaders InputStream ByteString
    str

            let (contentType, _)           = getContentType hdrs
            let (_, fileName, disposition) = getFieldHeaderInfo hdrs

            let info = ByteString
    -> Maybe ByteString
    -> ByteString
    -> PartDisposition
    -> Headers
    -> PartInfo
    PartInfo ByteString
    fieldName Maybe ByteString
    fileName ByteString
    contentType PartDisposition
    disposition Headers
    hdrs
            handlePart info str acc

    ------------------------------------------------------------------------------
    getContentType :: Headers
                   -> (ByteString, Maybe ByteString)
    getContentType :: Headers -> (ByteString, Maybe ByteString)
    getContentType Headers
    hdrs = (ByteString
    contentType, Maybe ByteString
    boundary)
      where
        contentTypeValue :: ByteString
    contentTypeValue = ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe ByteString
    "text/plain" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $
                           CI ByteString -> Headers -> Maybe ByteString
    forall a. HasHeaders a => CI ByteString -> a -> Maybe ByteString
    getHeader CI ByteString
    "content-type" Headers
    hdrs

        eCT :: Either FilePath (ByteString, [(CI ByteString, ByteString)])
    eCT = ByteString
    -> Parser (ByteString, [(CI ByteString, ByteString)])
    -> Either FilePath (ByteString, [(CI ByteString, ByteString)])
    forall a. ByteString -> Parser a -> Either FilePath a
    fullyParse ByteString
    contentTypeValue Parser (ByteString, [(CI ByteString, ByteString)])
    pContentTypeWithParameters
        (!ByteString
    contentType, ![(CI ByteString, ByteString)]
    params) = (FilePath -> (ByteString, [(CI ByteString, ByteString)]))
    -> ((ByteString, [(CI ByteString, ByteString)])
        -> (ByteString, [(CI ByteString, ByteString)]))
    -> Either FilePath (ByteString, [(CI ByteString, ByteString)])
    -> (ByteString, [(CI ByteString, ByteString)])
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ((ByteString, [(CI ByteString, ByteString)])
    -> FilePath -> (ByteString, [(CI ByteString, ByteString)])
    forall a b. a -> b -> a
    const (ByteString
    "text/plain", [])) (ByteString, [(CI ByteString, ByteString)])
    -> (ByteString, [(CI ByteString, ByteString)])
    forall a. a -> a
    id Either FilePath (ByteString, [(CI ByteString, ByteString)])
    eCT

        boundary :: Maybe ByteString
    boundary = CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    findParam CI ByteString
    "boundary" [(CI ByteString, ByteString)]
    params

    ------------------------------------------------------------------------------
    getFieldHeaderInfo :: Headers -> (ByteString, Maybe ByteString, PartDisposition)
    getFieldHeaderInfo :: Headers -> (ByteString, Maybe ByteString, PartDisposition)
    getFieldHeaderInfo Headers
    hdrs = (ByteString
    fieldName, Maybe ByteString
    fileName, PartDisposition
    disposition)
      where
        contentDispositionValue :: ByteString
    contentDispositionValue = ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe ByteString
    "unknown" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $
                                  CI ByteString -> Headers -> Maybe ByteString
    forall a. HasHeaders a => CI ByteString -> a -> Maybe ByteString
    getHeader CI ByteString
    "content-disposition" Headers
    hdrs

        eDisposition :: Either FilePath (ByteString, [(CI ByteString, ByteString)])
    eDisposition = ByteString
    -> Parser (ByteString, [(CI ByteString, ByteString)])
    -> Either FilePath (ByteString, [(CI ByteString, ByteString)])
    forall a. ByteString -> Parser a -> Either FilePath a
    fullyParse ByteString
    contentDispositionValue (Parser (ByteString, [(CI ByteString, ByteString)])
     -> Either FilePath (ByteString, [(CI ByteString, ByteString)]))
    -> Parser (ByteString, [(CI ByteString, ByteString)])
    -> Either FilePath (ByteString, [(CI ByteString, ByteString)])
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool)
    -> Parser (ByteString, [(CI ByteString, ByteString)])
    pValueWithParameters' (Bool -> Char -> Bool
    forall a b. a -> b -> a
    const Bool
    True)

        (!ByteString
    dispositionType, [(CI ByteString, ByteString)]
    dispositionParameters) =
            (FilePath -> (ByteString, [(CI ByteString, ByteString)]))
    -> ((ByteString, [(CI ByteString, ByteString)])
        -> (ByteString, [(CI ByteString, ByteString)]))
    -> Either FilePath (ByteString, [(CI ByteString, ByteString)])
    -> (ByteString, [(CI ByteString, ByteString)])
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ((ByteString, [(CI ByteString, ByteString)])
    -> FilePath -> (ByteString, [(CI ByteString, ByteString)])
    forall a b. a -> b -> a
    const (ByteString
    "unknown", [])) (ByteString, [(CI ByteString, ByteString)])
    -> (ByteString, [(CI ByteString, ByteString)])
    forall a. a -> a
    id Either FilePath (ByteString, [(CI ByteString, ByteString)])
    eDisposition

        disposition :: PartDisposition
    disposition = ByteString -> PartDisposition
    toPartDisposition ByteString
    dispositionType

        fieldName :: ByteString
    fieldName = ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe ByteString
    "" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    findParam CI ByteString
    "name" [(CI ByteString, ByteString)]
    dispositionParameters

        fileName :: Maybe ByteString
    fileName = CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    findParam CI ByteString
    "filename" [(CI ByteString, ByteString)]
    dispositionParameters

    ------------------------------------------------------------------------------
    findParam :: (Eq a) => a -> [(a, b)] -> Maybe b
    findParam :: forall a b. Eq a => a -> [(a, b)] -> Maybe b
    findParam a
    p = ((a, b) -> b) -> Maybe (a, b) -> Maybe b
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a, b) -> b
    forall a b. (a, b) -> b
    snd (Maybe (a, b) -> Maybe b)
    -> ([(a, b)] -> Maybe (a, b)) -> [(a, b)] -> Maybe b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a, b) -> Bool) -> [(a, b)] -> Maybe (a, b)
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find ((a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    p) (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, b) -> a
    forall a b. (a, b) -> a
    fst)

    ------------------------------------------------------------------------------
    partStream :: InputStream MatchInfo -> IO (InputStream ByteString)
    partStream :: InputStream MatchInfo -> IO (InputStream ByteString)
    partStream InputStream MatchInfo
    st = IO (Maybe ByteString) -> IO (InputStream ByteString)
    forall a. IO (Maybe a) -> IO (InputStream a)
    Streams.makeInputStream IO (Maybe ByteString)
    go

      where
        go :: IO (Maybe ByteString)
    go = do
            s <- InputStream MatchInfo -> IO (Maybe MatchInfo)
    forall a. InputStream a -> IO (Maybe a)
    Streams.read InputStream MatchInfo
    st
            return $! s >>= f

        f :: MatchInfo -> m ByteString
    f (NoMatch ByteString
    s) = ByteString -> m ByteString
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    s
        f MatchInfo
    _           = m ByteString
    forall a. m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    ------------------------------------------------------------------------------
    -- | Assuming we've already identified the boundary value and split the input
    -- up into parts which match and parts which don't, run the given 'ByteString'
    -- InputStream over each part and grab a list of the resulting values.
    --
    -- TODO/FIXME: fix description
    foldParts :: (InputStream ByteString -> MultipartState a -> IO (MultipartState a))
                 -> InputStream MatchInfo
                 -> (MultipartState a)
                 -> IO (MultipartState a)
    foldParts :: forall a.
    (InputStream ByteString
     -> MultipartState a -> IO (MultipartState a))
    -> InputStream MatchInfo
    -> MultipartState a
    -> IO (MultipartState a)
    foldParts InputStream ByteString -> MultipartState a -> IO (MultipartState a)
    partFunc InputStream MatchInfo
    stream = MultipartState a -> IO (MultipartState a)
    go
      where
        part :: MultipartState a
    -> InputStream ByteString -> IO (Maybe (MultipartState a))
    part MultipartState a
    acc InputStream ByteString
    pStream = do
            isLast <- Parser Bool -> InputStream ByteString -> IO Bool
    forall r. Parser r -> InputStream ByteString -> IO r
    parseFromStream Parser Bool
    pBoundaryEnd InputStream ByteString
    pStream

            if isLast
              then return Nothing
              else do
                  !x <- partFunc pStream acc
                  Streams.skipToEof pStream
                  return $! Just x

        go :: MultipartState a -> IO (MultipartState a)
    go !MultipartState a
    acc = do
          cap <- InputStream MatchInfo -> IO (InputStream ByteString)
    partStream InputStream MatchInfo
    stream IO (InputStream ByteString)
    -> (InputStream ByteString -> IO (Maybe (MultipartState a)))
    -> IO (Maybe (MultipartState a))
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= MultipartState a
    -> InputStream ByteString -> IO (Maybe (MultipartState a))
    part MultipartState a
    acc
          maybe (return acc) go cap

        pBoundaryEnd :: Parser Bool
    pBoundaryEnd = (Parser ByteString
    eol Parser ByteString -> Parser Bool -> Parser Bool
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Bool -> Parser Bool
    forall a. a -> Parser ByteString a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False) Parser Bool -> Parser Bool -> Parser Bool
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (ByteString -> Parser ByteString
    string ByteString
    "--" Parser ByteString -> Parser Bool -> Parser Bool
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Bool -> Parser Bool
    forall a. a -> Parser ByteString a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True)

    ------------------------------------------------------------------------------
    eol :: Parser ByteString
    eol :: Parser ByteString
    eol = (ByteString -> Parser ByteString
    string ByteString
    "\n") Parser ByteString -> Parser ByteString -> Parser ByteString
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (ByteString -> Parser ByteString
    string ByteString
    "\r\n")

    ------------------------------------------------------------------------------
    pHeadersWithSeparator :: Parser [(ByteString,ByteString)]
    pHeadersWithSeparator :: Parser [FormParam]
    pHeadersWithSeparator = Parser [FormParam]
    pHeaders Parser [FormParam] -> Parser ByteString -> Parser [FormParam]
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser ByteString
    crlf

    ------------------------------------------------------------------------------
    toHeaders :: [(ByteString,ByteString)] -> Headers
    toHeaders :: [FormParam] -> Headers
    toHeaders [FormParam]
    kvps = [(CI ByteString, ByteString)] -> Headers
    H.fromList [(CI ByteString, ByteString)]
    kvps'
      where
        kvps' :: [(CI ByteString, ByteString)]
    kvps'     = (FormParam -> (CI ByteString, ByteString))
    -> [FormParam] -> [(CI ByteString, ByteString)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((ByteString -> CI ByteString)
    -> FormParam -> (CI ByteString, ByteString)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ByteString -> CI ByteString
    forall s. FoldCase s => s -> CI s
    CI.mk) [FormParam]
    kvps

    ------------------------------------------------------------------------------
    mAX_HDRS_SIZE :: Int64
    mAX_HDRS_SIZE :: Int64
    mAX_HDRS_SIZE = Int64
    32768

    ------------------------------------------------------------------------------
    withTempFile :: FilePath
                 -> String
                 -> ((FilePath, Handle) -> IO a)
                 -> IO a
    withTempFile :: forall a.
    FilePath -> FilePath -> ((FilePath, Handle) -> IO a) -> IO a
    withTempFile FilePath
    tmpl FilePath
    temp (FilePath, Handle) -> IO a
    handler =
        ((forall a. IO a -> IO a) -> IO a) -> IO a
    forall (m :: * -> *) b.
    MonadBaseControl IO m =>
    ((forall a. m a -> m a) -> m b) -> m b
    mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
    -> ((forall a. IO a -> IO a) -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \forall a. IO a -> IO a
    restore -> IO (FilePath, Handle)
    -> ((FilePath, Handle) -> IO [()])
    -> ((FilePath, Handle) -> IO a)
    -> IO a
    forall (m :: * -> *) a b c.
    MonadBaseControl IO m =>
    m a -> (a -> m b) -> (a -> m c) -> m c
    bracket IO (FilePath, Handle)
    make (FilePath, Handle) -> IO [()]
    cleanup (IO a -> IO a
    forall a. IO a -> IO a
    restore (IO a -> IO a)
    -> ((FilePath, Handle) -> IO a) -> (FilePath, Handle) -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FilePath, Handle) -> IO a
    handler)

      where
        make :: IO (FilePath, Handle)
    make           = FilePath -> IO (FilePath, Handle)
    mkstemp (FilePath -> IO (FilePath, Handle))
    -> FilePath -> IO (FilePath, Handle)
    forall a b. (a -> b) -> a -> b
    $ FilePath
    tmpl FilePath -> ShowS
    </> (FilePath
    temp FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "XXXXXXX")
        cleanup :: (FilePath, Handle) -> IO [()]
    cleanup (FilePath
    fp,Handle
    h) = [IO ()] -> IO [()]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence ([IO ()] -> IO [()]) -> [IO ()] -> IO [()]
    forall a b. (a -> b) -> a -> b
    $ (IO () -> IO ()) -> [IO ()] -> [IO ()]
    forall a b. (a -> b) -> [a] -> [b]
    map IO () -> IO ()
    forall {z}. IO z -> IO ()
    gobble [Handle -> IO ()
    hClose Handle
    h, FilePath -> IO ()
    removeFile FilePath
    fp]

        t :: IO z -> IO (Either SomeException z)
        t :: forall z. IO z -> IO (Either SomeException z)
    t = IO z -> IO (Either SomeException z)
    forall (m :: * -> *) e a.
    (MonadBaseControl IO m, Exception e) =>
    m a -> m (Either e a)
    E.try

        gobble :: IO z -> IO ()
    gobble = IO (Either SomeException z) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Either SomeException z) -> IO ())
    -> (IO z -> IO (Either SomeException z)) -> IO z -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO z -> IO (Either SomeException z)
    forall z. IO z -> IO (Either SomeException z)
    t