    {-# LANGUAGE OverloadedStrings #-}
    -- #hide

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Network.CGI.Multipart
    -- Copyright   :  (c) Peter Thiemann 2001,2002
    --                (c) Bjorn Bringert 2005-2006
    -- License     :  BSD-style
    --
    -- Maintainer  :  Anders Kaseorg <andersk@mit.edu>
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    -- Parsing of the multipart format from RFC2046.
    -- Partly based on code from WASHMail.
    --
    -----------------------------------------------------------------------------
    module Network.Multipart
        (
         -- * Multi-part messages
         MultiPart(..), BodyPart(..)
        , parseMultipartBody, hGetMultipartBody
        , showMultipartBody
         -- * Headers
        , Headers , HeaderName(..)
        , ContentType(..), ContentTransferEncoding(..)
        , ContentDisposition(..)
        , parseContentType
        , getContentType
        , getContentTransferEncoding
        , getContentDisposition
        ) where

    import Control.Monad
    import Data.List (intersperse)
    import Data.Maybe
    import System.IO (Handle)

    import Network.Multipart.Header

    import qualified Data.ByteString.Lazy.Char8 as BS
    import Data.ByteString.Lazy.Char8 (ByteString)
    import Data.ByteString.Lazy.Search (breakOn)

    --
    -- * Multi-part stuff.
    --

    data MultiPart = MultiPart [BodyPart]
                   deriving (Int -> MultiPart -> ShowS
    [MultiPart] -> ShowS
    MultiPart -> [Char]
    (Int -> MultiPart -> ShowS)
    -> (MultiPart -> [Char])
    -> ([MultiPart] -> ShowS)
    -> Show MultiPart
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> MultiPart -> ShowS
    showsPrec :: Int -> MultiPart -> ShowS
    $cshow :: MultiPart -> [Char]
    show :: MultiPart -> [Char]
    $cshowList :: [MultiPart] -> ShowS
    showList :: [MultiPart] -> ShowS
    Show, MultiPart -> MultiPart -> Bool
    (MultiPart -> MultiPart -> Bool)
    -> (MultiPart -> MultiPart -> Bool) -> Eq MultiPart
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: MultiPart -> MultiPart -> Bool
    == :: MultiPart -> MultiPart -> Bool
    $c/= :: MultiPart -> MultiPart -> Bool
    /= :: MultiPart -> MultiPart -> Bool
    Eq, Eq MultiPart
    Eq MultiPart =>
    (MultiPart -> MultiPart -> Ordering)
    -> (MultiPart -> MultiPart -> Bool)
    -> (MultiPart -> MultiPart -> Bool)
    -> (MultiPart -> MultiPart -> Bool)
    -> (MultiPart -> MultiPart -> Bool)
    -> (MultiPart -> MultiPart -> MultiPart)
    -> (MultiPart -> MultiPart -> MultiPart)
    -> Ord MultiPart
    MultiPart -> MultiPart -> Bool
    MultiPart -> MultiPart -> Ordering
    MultiPart -> MultiPart -> MultiPart
    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
    $ccompare :: MultiPart -> MultiPart -> Ordering
    compare :: MultiPart -> MultiPart -> Ordering
    $c< :: MultiPart -> MultiPart -> Bool
    < :: MultiPart -> MultiPart -> Bool
    $c<= :: MultiPart -> MultiPart -> Bool
    <= :: MultiPart -> MultiPart -> Bool
    $c> :: MultiPart -> MultiPart -> Bool
    > :: MultiPart -> MultiPart -> Bool
    $c>= :: MultiPart -> MultiPart -> Bool
    >= :: MultiPart -> MultiPart -> Bool
    $cmax :: MultiPart -> MultiPart -> MultiPart
    max :: MultiPart -> MultiPart -> MultiPart
    $cmin :: MultiPart -> MultiPart -> MultiPart
    min :: MultiPart -> MultiPart -> MultiPart
    Ord)

    data BodyPart = BodyPart Headers ByteString
                    deriving (Int -> BodyPart -> ShowS
    [BodyPart] -> ShowS
    BodyPart -> [Char]
    (Int -> BodyPart -> ShowS)
    -> (BodyPart -> [Char]) -> ([BodyPart] -> ShowS) -> Show BodyPart
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> BodyPart -> ShowS
    showsPrec :: Int -> BodyPart -> ShowS
    $cshow :: BodyPart -> [Char]
    show :: BodyPart -> [Char]
    $cshowList :: [BodyPart] -> ShowS
    showList :: [BodyPart] -> ShowS
    Show, BodyPart -> BodyPart -> Bool
    (BodyPart -> BodyPart -> Bool)
    -> (BodyPart -> BodyPart -> Bool) -> Eq BodyPart
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: BodyPart -> BodyPart -> Bool
    == :: BodyPart -> BodyPart -> Bool
    $c/= :: BodyPart -> BodyPart -> Bool
    /= :: BodyPart -> BodyPart -> Bool
    Eq, Eq BodyPart
    Eq BodyPart =>
    (BodyPart -> BodyPart -> Ordering)
    -> (BodyPart -> BodyPart -> Bool)
    -> (BodyPart -> BodyPart -> Bool)
    -> (BodyPart -> BodyPart -> Bool)
    -> (BodyPart -> BodyPart -> Bool)
    -> (BodyPart -> BodyPart -> BodyPart)
    -> (BodyPart -> BodyPart -> BodyPart)
    -> Ord BodyPart
    BodyPart -> BodyPart -> Bool
    BodyPart -> BodyPart -> Ordering
    BodyPart -> BodyPart -> BodyPart
    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
    $ccompare :: BodyPart -> BodyPart -> Ordering
    compare :: BodyPart -> BodyPart -> Ordering
    $c< :: BodyPart -> BodyPart -> Bool
    < :: BodyPart -> BodyPart -> Bool
    $c<= :: BodyPart -> BodyPart -> Bool
    <= :: BodyPart -> BodyPart -> Bool
    $c> :: BodyPart -> BodyPart -> Bool
    > :: BodyPart -> BodyPart -> Bool
    $c>= :: BodyPart -> BodyPart -> Bool
    >= :: BodyPart -> BodyPart -> Bool
    $cmax :: BodyPart -> BodyPart -> BodyPart
    max :: BodyPart -> BodyPart -> BodyPart
    $cmin :: BodyPart -> BodyPart -> BodyPart
    min :: BodyPart -> BodyPart -> BodyPart
    Ord)

    -- | Read a multi-part message from a 'ByteString'.
    parseMultipartBody :: String -- ^ Boundary
                       -> ByteString -> MultiPart
    parseMultipartBody :: [Char] -> ByteString -> MultiPart
    parseMultipartBody [Char]
    b =
        [BodyPart] -> MultiPart
    MultiPart ([BodyPart] -> MultiPart)
    -> (ByteString -> [BodyPart]) -> ByteString -> MultiPart
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> Maybe BodyPart) -> [ByteString] -> [BodyPart]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ByteString -> Maybe BodyPart
    parseBodyPart ([ByteString] -> [BodyPart])
    -> (ByteString -> [ByteString]) -> ByteString -> [BodyPart]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString -> [ByteString]
    splitParts ([Char] -> ByteString
    BS.pack [Char]
    b)

    -- | Read a multi-part message from a 'Handle'.
    --   Fails on parse errors.
    hGetMultipartBody :: String -- ^ Boundary
                      -> Handle
                      -> IO MultiPart
    hGetMultipartBody :: [Char] -> Handle -> IO MultiPart
    hGetMultipartBody [Char]
    b = (ByteString -> MultiPart) -> IO ByteString -> IO MultiPart
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ([Char] -> ByteString -> MultiPart
    parseMultipartBody [Char]
    b) (IO ByteString -> IO MultiPart)
    -> (Handle -> IO ByteString) -> Handle -> IO MultiPart
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Handle -> IO ByteString
    BS.hGetContents

    parseBodyPart :: ByteString -> Maybe BodyPart
    parseBodyPart :: ByteString -> Maybe BodyPart
    parseBodyPart ByteString
    s = do
      let (ByteString
    hdr,ByteString
    bdy) = ByteString -> (ByteString, ByteString)
    splitAtEmptyLine ByteString
    s
      hs <- Parser Headers -> [Char] -> [Char] -> Maybe Headers
    forall (m :: * -> *) a.
    MonadFail m =>
    Parser a -> [Char] -> [Char] -> m a
    parseM Parser Headers
    pHeaders [Char]
    "<input>" (ByteString -> [Char]
    BS.unpack ByteString
    hdr)
      return $ BodyPart hs bdy

    showMultipartBody :: String -> MultiPart -> ByteString
    showMultipartBody :: [Char] -> MultiPart -> ByteString
    showMultipartBody [Char]
    b (MultiPart [BodyPart]
    bs) =
        [ByteString] -> ByteString
    unlinesCRLF ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (BodyPart -> [ByteString] -> [ByteString])
    -> [ByteString] -> [BodyPart] -> [ByteString]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\BodyPart
    x [ByteString]
    xs -> ByteString
    dByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :BodyPart -> ByteString
    showBodyPart BodyPart
    xByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    xs) [ByteString
    c,ByteString
    BS.empty] [BodyPart]
    bs
     where d :: ByteString
    d = [Char] -> ByteString
    BS.pack ([Char]
    "--" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    b)
           c :: ByteString
    c = [Char] -> ByteString
    BS.pack ([Char]
    "--" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    b [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "--")

    showBodyPart :: BodyPart -> ByteString
    showBodyPart :: BodyPart -> ByteString
    showBodyPart (BodyPart Headers
    hs ByteString
    c) =
        [ByteString] -> ByteString
    unlinesCRLF ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [[Char] -> ByteString
    BS.pack ([Char]
    n[Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++[Char]
    ": "[Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++[Char]
    v) | (HeaderName [Char]
    n,[Char]
    v) <- Headers
    hs] [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    ++ [ByteString
    BS.empty,ByteString
    c]

    --
    -- * Splitting into multipart parts.
    --

    -- | Split a multipart message into the multipart parts.
    splitParts :: ByteString -- ^ The boundary, without the initial dashes
               -> ByteString
               -> [ByteString]
    splitParts :: ByteString -> ByteString -> [ByteString]
    splitParts ByteString
    b = ByteString -> [ByteString]
    spl (ByteString -> [ByteString])
    -> (ByteString -> ByteString) -> ByteString -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString -> ByteString
    dropPreamble ByteString
    b
      where
      spl :: ByteString -> [ByteString]
    spl ByteString
    x = case ByteString
    -> ByteString -> Maybe (ByteString, ByteString, ByteString)
    splitAtBoundary ByteString
    b ByteString
    x of
                Maybe (ByteString, ByteString, ByteString)
    Nothing -> []
                Just (ByteString
    s1,ByteString
    d,ByteString
    s2) | ByteString -> ByteString -> Bool
    isClose ByteString
    b ByteString
    d -> [ByteString
    s1]
                               | Bool
    otherwise -> ByteString
    s1ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :ByteString -> [ByteString]
    spl ByteString
    s2

    -- | Drop everything up to and including the first line starting
    --   with the boundary.
    dropPreamble :: ByteString -- ^ The boundary, without the initial dashes
                 -> ByteString
                 -> ByteString
    dropPreamble :: ByteString -> ByteString -> ByteString
    dropPreamble ByteString
    b ByteString
    s = case ByteString
    -> ByteString -> Maybe (ByteString, ByteString, ByteString)
    splitAtBoundary ByteString
    b ByteString
    s of
      Maybe (ByteString, ByteString, ByteString)
    Nothing -> ByteString
    BS.empty
      Just (ByteString
    _,ByteString
    _,ByteString
    v) -> ByteString
    v

    -- | Split a string at the first boundary line.
    splitAtBoundary :: ByteString -- ^ The boundary, without the initial dashes
                    -> ByteString -- ^ String to split.
                    -> Maybe (ByteString,ByteString,ByteString)
                       -- ^ The part before the boundary, the boundary line,
                       --   and the part after the boundary line. The CRLF
                       --   before and the CRLF (if any) after the boundary line
                       --   are not included in any of the strings returned.
                       --   Returns 'Nothing' if there is no boundary.
    splitAtBoundary :: ByteString
    -> ByteString -> Maybe (ByteString, ByteString, ByteString)
    splitAtBoundary ByteString
    b ByteString
    s =
      let b' :: ByteString
    b' = ByteString -> ByteString -> ByteString
    BS.append ByteString
    "--" ByteString
    b
          bcrlf :: ByteString
    bcrlf = ByteString -> ByteString -> ByteString
    BS.append ByteString
    "\r\n" ByteString
    b'

          -- check if we are at the beginning of a boundary, if so, we
          -- won’t have a \r\n
          prefix :: ByteString
    prefix = if ByteString -> ByteString -> Bool
    BS.isPrefixOf ByteString
    b' ByteString
    s then ByteString
    b'
                   else ByteString
    bcrlf

          (ByteString
    before, ByteString
    t) = ByteString -> ByteString -> (ByteString, ByteString)
    breakOn (ByteString -> ByteString
    BS.toStrict ByteString
    prefix) ByteString
    s
      in case ByteString -> ByteString -> Maybe ByteString
    BS.stripPrefix ByteString
    prefix ByteString
    t of
           Maybe ByteString
    Nothing -> Maybe (ByteString, ByteString, ByteString)
    forall a. Maybe a
    Nothing
           Just ByteString
    t' ->
             let after :: ByteString
    after = case ByteString -> ByteString -> Maybe ByteString
    BS.stripPrefix ByteString
    "\r\n" ByteString
    t' of
                   Maybe ByteString
    Nothing -> ByteString
    t'
                   Just ByteString
    t'' -> ByteString
    t''
             in  (ByteString, ByteString, ByteString)
    -> Maybe (ByteString, ByteString, ByteString)
    forall a. a -> Maybe a
    Just (ByteString
    before, ByteString
    prefix, ByteString
    after)

    -- | Check whether a string for which 'isBoundary' returns true
    --   has two dashes after the boudary string.
    isClose :: ByteString -- ^ The boundary, without the initial dashes
            -> ByteString
            -> Bool
    isClose :: ByteString -> ByteString -> Bool
    isClose ByteString
    b ByteString
    s = ByteString -> ByteString -> Bool
    BS.isPrefixOf (ByteString -> ByteString -> ByteString
    BS.append ByteString
    "--" (ByteString -> ByteString -> ByteString
    BS.append ByteString
    b ByteString
    "--")) ByteString
    s

    --
    -- * RFC 2046 CRLF
    --

    crlf :: ByteString
    crlf :: ByteString
    crlf = [Char] -> ByteString
    BS.pack [Char]
    "\r\n"

    unlinesCRLF :: [ByteString] -> ByteString
    unlinesCRLF :: [ByteString] -> ByteString
    unlinesCRLF = [ByteString] -> ByteString
    BS.concat ([ByteString] -> ByteString)
    -> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    intersperse ByteString
    crlf

    -- | Split a string at the first empty line. The CRLF (if any) before the
    --   empty line is included in the first result. The CRLF after the
    --   empty line is not included in the result.
    --   If there is no empty line, the entire input is returned
    --   as the first result.
    splitAtEmptyLine :: ByteString -> (ByteString, ByteString)
    splitAtEmptyLine :: ByteString -> (ByteString, ByteString)
    splitAtEmptyLine ByteString
    s =
      let blank :: ByteString
    blank = ByteString
    "\r\n\r\n"
          (ByteString
    before, ByteString
    after) = ByteString -> ByteString -> (ByteString, ByteString)
    breakOn (ByteString -> ByteString
    BS.toStrict ByteString
    blank) ByteString
    s
      in case ByteString -> ByteString -> Maybe ByteString
    BS.stripPrefix ByteString
    blank ByteString
    after of
           Maybe ByteString
    Nothing -> (ByteString
    before, ByteString
    after)
           Just ByteString
    after' -> (ByteString -> ByteString -> ByteString
    BS.append ByteString
    before ByteString
    "\r\n", ByteString
    after')