    {-# LANGUAGE OverloadedStrings #-}
    --------------------------------------------------------------------
    -- |
    -- Module    : Codec.MIME.Pare
    -- Copyright : (c) 2006-2009, Galois, Inc.
    -- License   : BSD3
    --
    -- Maintainer: Sigbjorn Finne <sigbjorn.finne@gmail.com>
    -- Stability : provisional
    -- Portability: portable
    --
    -- Parsing MIME content.
    --
    --------------------------------------------------------------------
    module Codec.MIME.Parse
      ( parseMIMEBody    -- :: [(T.Text,T.Text)] -> T.Text -> MIMEValue
      , parseMIMEType    -- :: T.Text -> Maybe Type
      , parseMIMEMessage -- :: T.Text -> MIMEValue

      , parseHeaders     -- :: T.Text -> ([(T.Text,T.Text)], T.Text)
      , parseMultipart   -- :: Type -> T.Text -> (MIMEValue, T.Text)
      , parseContentType -- :: T.Text -> Maybe Type
      , splitMulti       -- :: T.Text -> T.Text -> ([MIMEValue], T.Text)
      , normalizeCRLF
      ) where

    import Codec.MIME.Type
    import Codec.MIME.Decode
    import Control.Arrow(second)

    import Data.Char
    import Data.Maybe
    import qualified Data.List as L
    import Debug.Trace ( trace )
    import qualified Data.Text as T
    import Data.Monoid(Monoid(..), (<>))

    enableTrace :: Bool
    enableTrace :: Bool
    enableTrace = Bool
    False

    doTrace :: String -> b -> b
    doTrace :: forall b. [Char] -> b -> b
    doTrace | Bool
    enableTrace = [Char] -> b -> b
    forall b. [Char] -> b -> b
    trace
            | Bool
    otherwise   = \[Char]
    _ b
    x -> b
    x

    parseMIMEBody :: [MIMEParam] -> T.Text -> MIMEValue
    parseMIMEBody :: [MIMEParam] -> Text -> MIMEValue
    parseMIMEBody [MIMEParam]
    headers_in Text
    body = MIMEValue
    result { mime_val_headers = headers }
      where
      result :: MIMEValue
    result = case Type -> MIMEType
    mimeType Type
    mty of
        Multipart{} -> (MIMEValue, Text) -> MIMEValue
    forall a b. (a, b) -> a
    fst (Type -> Text -> (MIMEValue, Text)
    parseMultipart Type
    mty Text
    body)
        Message{}   -> (MIMEValue, Text) -> MIMEValue
    forall a b. (a, b) -> a
    fst (Type -> Text -> (MIMEValue, Text)
    parseMultipart Type
    mty Text
    body)
        MIMEType
    _           -> MIMEValue
    nullMIMEValue { mime_val_type    = mty
                                     , mime_val_disp    = parseContentDisp headers
                                     , mime_val_content = Single (processBody headers body)
                                     }
      headers :: [MIMEParam]
    headers = [ Text -> Text -> MIMEParam
    MIMEParam (Text -> Text
    T.toLower Text
    k) Text
    v | (MIMEParam Text
    k Text
    v) <- [MIMEParam]
    headers_in ]
      mty :: Type
    mty = Type -> Maybe Type -> Type
    forall a. a -> Maybe a -> a
    fromMaybe Type
    defaultType
                           (Text -> Maybe Type
    parseContentType (Text -> Maybe Type) -> Maybe Text -> Maybe Type
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Text -> [(Text, Text)] -> Maybe Text
    forall a. Text -> [(Text, a)] -> Maybe a
    lookupField Text
    "content-type" ([MIMEParam] -> [(Text, Text)]
    paramPairs [MIMEParam]
    headers))
    defaultType :: Type
    defaultType :: Type
    defaultType = Type { mimeType :: MIMEType
    mimeType   = Text -> MIMEType
    Text Text
    "plain"
                       , mimeParams :: [MIMEParam]
    mimeParams = [Text -> Text -> MIMEParam
    MIMEParam Text
    "charset" Text
    "us-ascii"]
                       }

    parseContentDisp :: [MIMEParam] -> Maybe Disposition
    parseContentDisp :: [MIMEParam] -> Maybe Disposition
    parseContentDisp [MIMEParam]
    headers =
        (Text -> Maybe Disposition
    processDisp (Text -> Maybe Disposition)
    -> (Text -> Text) -> Text -> Maybe Disposition
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    dropFoldingWSP) (Text -> Maybe Disposition) -> Maybe Text -> Maybe Disposition
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Text -> [(Text, Text)] -> Maybe Text
    forall a. Text -> [(Text, a)] -> Maybe a
    lookupField Text
    "content-disposition" ([MIMEParam] -> [(Text, Text)]
    paramPairs [MIMEParam]
    headers)
      where
        processDisp :: Text -> Maybe Disposition
    processDisp Text
    t | Text -> Bool
    T.null Text
    t  = Maybe Disposition
    forall a. Maybe a
    Nothing
                      | Text -> Bool
    T.null Text
    bs = Disposition -> Maybe Disposition
    forall a. a -> Maybe a
    Just (Disposition -> Maybe Disposition)
    -> Disposition -> Maybe Disposition
    forall a b. (a -> b) -> a -> b
    $ Disposition { dispType :: DispType
    dispType = Text -> DispType
    toDispType (Text -> Text
    T.toLower Text
    as)
                                                       , dispParams :: [DispParam]
    dispParams = []
                                                       }
                      | Bool
    otherwise = Disposition -> Maybe Disposition
    forall a. a -> Maybe a
    Just (Disposition -> Maybe Disposition)
    -> Disposition -> Maybe Disposition
    forall a b. (a -> b) -> a -> b
    $ Disposition { dispType :: DispType
    dispType = Text -> DispType
    toDispType (Text -> Text
    T.toLower Text
    as)
                                                       , dispParams :: [DispParam]
    dispParams = [MIMEParam] -> [DispParam]
    processParams (Text -> [MIMEParam]
    parseParams Text
    bs)
                                                       }
          where (Text
    as,Text
    bs) = (Char -> Bool) -> Text -> (Text, Text)
    T.break (\Char
    ch -> Char -> Bool
    isSpace Char
    ch Bool -> Bool -> Bool
    || Char
    ch Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ';') Text
    t

        processParams :: [MIMEParam] -> [DispParam]
    processParams = (MIMEParam -> DispParam) -> [MIMEParam] -> [DispParam]
    forall a b. (a -> b) -> [a] -> [b]
    map MIMEParam -> DispParam
    procP
          where
            procP :: MIMEParam -> DispParam
    procP (MIMEParam Text
    as Text
    val)
                | Text
    "name" Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    asl              = Text -> DispParam
    Name Text
    val
                | Text
    "filename" Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    asl          = Text -> DispParam
    Filename Text
    val
                | Text
    "creation-date" Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    asl     = Text -> DispParam
    CreationDate Text
    val
                | Text
    "modification-date" Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    asl = Text -> DispParam
    ModDate Text
    val
                | Text
    "read-date" Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    asl         = Text -> DispParam
    ReadDate Text
    val
                | Text
    "size" Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    asl              = Text -> DispParam
    Size Text
    val
                | Bool
    otherwise                  = Text -> Text -> DispParam
    OtherParam Text
    asl Text
    val
              where asl :: Text
    asl = Text -> Text
    T.toLower Text
    as

        toDispType :: Text -> DispType
    toDispType Text
    t = if Text
    t Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "inline" then DispType
    DispInline
                       else if Text
    t Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "attachment" then DispType
    DispAttachment
                       else if Text
    t Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "form-data"  then DispType
    DispFormData
                       else  Text -> DispType
    DispOther Text
    t

    paramPairs :: [MIMEParam] -> [(T.Text, T.Text)]
    paramPairs :: [MIMEParam] -> [(Text, Text)]
    paramPairs = (MIMEParam -> (Text, Text)) -> [MIMEParam] -> [(Text, Text)]
    forall a b. (a -> b) -> [a] -> [b]
    map MIMEParam -> (Text, Text)
    paramPair
      where
        paramPair :: MIMEParam -> (Text, Text)
    paramPair (MIMEParam Text
    a Text
    b) = (Text
    a,Text
    b)

    processBody :: [MIMEParam] -> T.Text -> T.Text
    processBody :: [MIMEParam] -> Text -> Text
    processBody [MIMEParam]
    headers Text
    body =
      case Text -> [(Text, Text)] -> Maybe Text
    forall a. Text -> [(Text, a)] -> Maybe a
    lookupField Text
    "content-transfer-encoding" ([(Text, Text)] -> Maybe Text) -> [(Text, Text)] -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ [MIMEParam] -> [(Text, Text)]
    paramPairs [MIMEParam]
    headers of
        Maybe Text
    Nothing -> Text
    body
        Just Text
    v  -> [Char] -> Text
    T.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char] -> [Char]
    decodeBody (Text -> [Char]
    T.unpack Text
    v) ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Text -> [Char]
    T.unpack Text
    body

    normalizeCRLF :: T.Text -> T.Text
    normalizeCRLF :: Text -> Text
    normalizeCRLF Text
    t
        | Text -> Bool
    T.null Text
    t = Text
    ""
        | Text
    "\r\n" Text -> Text -> Bool
    `T.isPrefixOf` Text
    t = Text
    "\r\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    normalizeCRLF (Int -> Text -> Text
    T.drop Int
    2 Text
    t)
        | (Text -> Bool) -> [Text] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Text -> Text -> Bool
    `T.isPrefixOf` Text
    t) [Text
    "\r", Text
    "\n"] = Text
    "\r\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    normalizeCRLF (Int -> Text -> Text
    T.drop Int
    1 Text
    t)
        | Bool
    otherwise = let (Text
    a,Text
    b) = (Char -> Bool) -> Text -> (Text, Text)
    T.break (Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Char
    '\r',Char
    '\n']) Text
    t in Text
    a Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    normalizeCRLF Text
    b

    parseMIMEMessage :: T.Text -> MIMEValue
    parseMIMEMessage :: Text -> MIMEValue
    parseMIMEMessage Text
    entity =
      case Text -> ([MIMEParam], Text)
    parseHeaders (Text -> Text
    normalizeCRLF Text
    entity) of
       ([MIMEParam]
    as,Text
    bs) -> [MIMEParam] -> Text -> MIMEValue
    parseMIMEBody [MIMEParam]
    as Text
    bs

    parseHeaders :: T.Text -> ([MIMEParam], T.Text)
    parseHeaders :: Text -> ([MIMEParam], Text)
    parseHeaders Text
    str =
      case Text -> Text -> Either (Text, Text) Text
    findFieldName Text
    "" Text
    str of
        Left (Text
    nm, Text
    rs) -> Text -> Text -> ([MIMEParam], Text)
    parseFieldValue Text
    nm (Text -> Text
    dropFoldingWSP Text
    rs)
        Right Text
    body    -> ([],Text
    body)
     where
      findFieldName :: Text -> Text -> Either (Text, Text) Text
    findFieldName Text
    acc Text
    t
        | Text -> Bool
    T.null Text
    t = Text -> Either (Text, Text) Text
    forall a b. b -> Either a b
    Right Text
    ""
        | Text
    "\r\n" Text -> Text -> Bool
    `T.isPrefixOf` Text
    t = Text -> Either (Text, Text) Text
    forall a b. b -> Either a b
    Right (Text -> Either (Text, Text) Text)
    -> Text -> Either (Text, Text) Text
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    T.drop Int
    2 Text
    t
        | Text
    ":" Text -> Text -> Bool
    `T.isPrefixOf` Text
    t = (Text, Text) -> Either (Text, Text) Text
    forall a b. a -> Either a b
    Left (Text -> Text
    T.reverse (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> Text -> Text
    T.dropWhile Char -> Bool
    isHSpace Text
    acc, Int -> Text -> Text
    T.drop Int
    1 Text
    t)
        | Bool
    otherwise = Text -> Text -> Either (Text, Text) Text
    findFieldName (Int -> Text -> Text
    T.take Int
    1 Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    acc) (Text -> Either (Text, Text) Text)
    -> Text -> Either (Text, Text) Text
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    T.drop Int
    1 Text
    t

      parseFieldValue :: Text -> Text -> ([MIMEParam], Text)
    parseFieldValue Text
    nm Text
    xs
          | Text -> Bool
    T.null Text
    bs = ([Text -> Text -> MIMEParam
    MIMEParam Text
    nm Text
    as], Text
    "")
          | Bool
    otherwise = let ([MIMEParam]
    zs,Text
    ys) = Text -> ([MIMEParam], Text)
    parseHeaders Text
    bs in (Text -> Text -> MIMEParam
    MIMEParam Text
    nm Text
    as MIMEParam -> [MIMEParam] -> [MIMEParam]
    forall a. a -> [a] -> [a]
    :[MIMEParam]
    zs, Text
    ys)
        where
          (Text
    as,Text
    bs) = Text -> (Text, Text)
    takeUntilCRLF Text
    xs

    parseMultipart :: Type -> T.Text -> (MIMEValue, T.Text)
    parseMultipart :: Type -> Text -> (MIMEValue, Text)
    parseMultipart Type
    mty Text
    body =
      case Text -> [(Text, Text)] -> Maybe Text
    forall a. Text -> [(Text, a)] -> Maybe a
    lookupField Text
    "boundary" ([MIMEParam] -> [(Text, Text)]
    paramPairs ([MIMEParam] -> [(Text, Text)]) -> [MIMEParam] -> [(Text, Text)]
    forall a b. (a -> b) -> a -> b
    $ Type -> [MIMEParam]
    mimeParams Type
    mty) of
        Maybe Text
    Nothing -> [Char] -> (MIMEValue, Text) -> (MIMEValue, Text)
    forall b. [Char] -> b -> b
    doTrace ([Char]
    "Multipart mime type, " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    T.unpack (Type -> Text
    showType Type
    mty) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
          [Char]
    ", has no required boundary parameter. Defaulting to text/plain") ((MIMEValue, Text) -> (MIMEValue, Text))
    -> (MIMEValue, Text) -> (MIMEValue, Text)
    forall a b. (a -> b) -> a -> b
    $
          (MIMEValue
    nullMIMEValue{ mime_val_type = defaultType
                        , mime_val_disp = Nothing
    		    , mime_val_content = Single body
    		    }, Text
    "")
        Just Text
    bnd -> (MIMEValue
    nullMIMEValue { mime_val_type = mty
                                   , mime_val_disp = Nothing
    			       , mime_val_content = Multi vals
    			       }, Text
    rs)
          where ([MIMEValue]
    vals,Text
    rs) = Text -> Text -> ([MIMEValue], Text)
    splitMulti Text
    bnd Text
    body

    splitMulti :: T.Text -> T.Text -> ([MIMEValue], T.Text)
    splitMulti :: Text -> Text -> ([MIMEValue], Text)
    splitMulti Text
    bnd Text
    body_in =
      -- Note: we insert a CRLF if it looks as if the boundary string starts
      -- right off the bat.  No harm done if this turns out to be incorrect.
      let body :: Text
    body | Text
    "--" Text -> Text -> Bool
    `T.isPrefixOf` Text
    body_in = Text
    "\r\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    body_in
               | Bool
    otherwise  = Text
    body_in
      in case Text -> Text -> Maybe Text
    untilMatch Text
    dashBoundary Text
    body of
           Maybe Text
    Nothing           -> ([MIMEValue], Text)
    forall a. Monoid a => a
    mempty
           Just Text
    xs  | Text
    "--" Text -> Text -> Bool
    `T.isPrefixOf` Text
    xs    -> ([], Int -> Text -> Text
    T.drop Int
    2 Text
    xs)
                    | Bool
    otherwise                 -> Text -> ([MIMEValue], Text)
    splitMulti1 (Text -> Text
    dropTrailer Text
    xs)

     where
      dashBoundary :: Text
    dashBoundary = (Text
    "\r\n--" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    bnd)

      splitMulti1 :: Text -> ([MIMEValue], Text)
    splitMulti1 Text
    xs
          | Text -> Bool
    T.null Text
    as Bool -> Bool -> Bool
    && Text -> Bool
    T.null Text
    bs = ([], Text
    "")
          | Text -> Bool
    T.null Text
    bs = ([Text -> MIMEValue
    parseMIMEMessage Text
    as],Text
    "")
          | Text -> Text -> Bool
    T.isPrefixOf Text
    "--" Text
    bs    =  ([Text -> MIMEValue
    parseMIMEMessage Text
    as], Text -> Text
    dropTrailer Text
    bs)
          | Bool
    otherwise   = let ([MIMEValue]
    zs,Text
    ys) = Text -> ([MIMEValue], Text)
    splitMulti1 (Text -> Text
    dropTrailer Text
    bs)
                                in ((Text -> MIMEValue
    parseMIMEMessage Text
    as) MIMEValue -> [MIMEValue] -> [MIMEValue]
    forall a. a -> [a] -> [a]
    : [MIMEValue]
    zs,Text
    ys)

        where
          (Text
    as,Text
    bs) = Text -> Text -> (Text, Text)
    matchUntil Text
    dashBoundary Text
    xs

      dropTrailer :: Text -> Text
    dropTrailer Text
    xs
          | Text
    "\r\n" Text -> Text -> Bool
    `T.isPrefixOf` Text
    xs1 = Int -> Text -> Text
    T.drop Int
    2 Text
    xs1
          | Bool
    otherwise   = Text
    xs1 -- hmm, flag an error?
        where
           xs1 :: Text
    xs1 = (Char -> Bool) -> Text -> Text
    T.dropWhile Char -> Bool
    isHSpace Text
    xs

    parseMIMEType :: T.Text -> Maybe Type
    parseMIMEType :: Text -> Maybe Type
    parseMIMEType = Text -> Maybe Type
    parseContentType

    parseContentType :: T.Text -> Maybe Type
    parseContentType :: Text -> Maybe Type
    parseContentType Text
    str
        | Text -> Bool
    T.null Text
    minor0 = [Char] -> Maybe Type -> Maybe Type
    forall b. [Char] -> b -> b
    doTrace ([Char]
    "unable to parse content-type: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    forall a. Show a => a -> [Char]
    show Text
    str) (Maybe Type -> Maybe Type) -> Maybe Type -> Maybe Type
    forall a b. (a -> b) -> a -> b
    $ Maybe Type
    forall a. Maybe a
    Nothing
        | Bool
    otherwise     = Type -> Maybe Type
    forall a. a -> Maybe a
    Just Type  { mimeType :: MIMEType
    mimeType = Text -> Text -> MIMEType
    toType Text
    maj Text
    as
                                     , mimeParams :: [MIMEParam]
    mimeParams = Text -> [MIMEParam]
    parseParams ((Char -> Bool) -> Text -> Text
    T.dropWhile Char -> Bool
    isHSpace Text
    bs)
                                     }
      where
        (Text
    maj, Text
    minor0) = (Char -> Bool) -> Text -> (Text, Text)
    T.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '/') (Text -> Text
    dropFoldingWSP Text
    str)
        minor :: Text
    minor = Int -> Text -> Text
    T.drop Int
    1 Text
    minor0
        (Text
    as, Text
    bs) = (Char -> Bool) -> Text -> (Text, Text)
    T.break (\ Char
    ch -> Char -> Bool
    isHSpace Char
    ch Bool -> Bool -> Bool
    || Char -> Bool
    isTSpecial Char
    ch) Text
    minor
        toType :: Text -> Text -> MIMEType
    toType Text
    a Text
    b = case Text -> [(Text, Text -> MIMEType)] -> Maybe (Text -> MIMEType)
    forall a. Text -> [(Text, a)] -> Maybe a
    lookupField (Text -> Text
    T.toLower Text
    a) [(Text, Text -> MIMEType)]
    mediaTypes of
             Just Text -> MIMEType
    ctor -> Text -> MIMEType
    ctor Text
    b
             Maybe (Text -> MIMEType)
    _ -> Text -> Text -> MIMEType
    Other Text
    a Text
    b

    parseParams :: T.Text -> [MIMEParam]
    parseParams :: Text -> [MIMEParam]
    parseParams Text
    t   | Text -> Bool
    T.null Text
    t          = []
                    | Char
    ';' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == HasCallStack => Text -> Char
    Text -> Char
    T.head Text
    t   = let (Text
    nm_raw, Text
    vs0) = (Char -> Bool) -> Text -> (Text, Text)
    T.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '=') (Text -> Text
    dropFoldingWSP (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Text
    Text -> Text
    T.tail Text
    t)
                                              nm :: Text
    nm = Text -> Text
    T.toLower Text
    nm_raw in
                        if Text -> Bool
    T.null Text
    vs0
                            then []
                            else let vs :: Text
    vs = HasCallStack => Text -> Text
    Text -> Text
    T.tail Text
    vs0 in
                                if Bool -> Bool
    not (Text -> Bool
    T.null Text
    vs) Bool -> Bool -> Bool
    && HasCallStack => Text -> Char
    Text -> Char
    T.head Text
    vs Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '"'
                                    then let vs1 :: Text
    vs1 = HasCallStack => Text -> Text
    Text -> Text
    T.tail Text
    vs
                                             (Text
    val, Text
    zs0) = (Char -> Bool) -> Text -> (Text, Text)
    T.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '"') Text
    vs1 in
                                        if Text -> Bool
    T.null Text
    zs0
                                            then [Text -> Text -> MIMEParam
    MIMEParam Text
    nm Text
    val]
                                            else Text -> Text -> MIMEParam
    MIMEParam Text
    nm Text
    val MIMEParam -> [MIMEParam] -> [MIMEParam]
    forall a. a -> [a] -> [a]
    : Text -> [MIMEParam]
    parseParams ((Char -> Bool) -> Text -> Text
    T.dropWhile Char -> Bool
    isHSpace (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Text
    Text -> Text
    T.tail Text
    zs0)
                                    else let (Text
    val, Text
    zs) = (Char -> Bool) -> Text -> (Text, Text)
    T.break (\Char
    ch -> Char -> Bool
    isHSpace Char
    ch Bool -> Bool -> Bool
    || Char -> Bool
    isTSpecial Char
    ch) Text
    vs in
                                        Text -> Text -> MIMEParam
    MIMEParam Text
    nm Text
    val MIMEParam -> [MIMEParam] -> [MIMEParam]
    forall a. a -> [a] -> [a]
    : Text -> [MIMEParam]
    parseParams ((Char -> Bool) -> Text -> Text
    T.dropWhile Char -> Bool
    isHSpace Text
    zs)
                    | Bool
    otherwise = [Char] -> [MIMEParam] -> [MIMEParam]
    forall b. [Char] -> b -> b
    doTrace ([Char]
    "Codec.MIME.Parse.parseParams: curious param value -- " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    forall a. Show a => a -> [Char]
    show Text
    t) []

    mediaTypes :: [(T.Text, T.Text -> MIMEType)]
    mediaTypes :: [(Text, Text -> MIMEType)]
    mediaTypes =
      [ (Text
    "multipart",   (Multipart -> MIMEType
    Multipart (Multipart -> MIMEType) -> (Text -> Multipart) -> Text -> MIMEType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Multipart
    toMultipart))
      , (Text
    "application", Text -> MIMEType
    Application)
      , (Text
    "audio",       Text -> MIMEType
    Audio)
      , (Text
    "image",       Text -> MIMEType
    Image)
      , (Text
    "message",     Text -> MIMEType
    Message)
      , (Text
    "model",       Text -> MIMEType
    Model)
      , (Text
    "text",        Text -> MIMEType
    Text)
      , (Text
    "video",       Text -> MIMEType
    Video)
      ]
     where toMultipart :: Text -> Multipart
    toMultipart Text
    b = Multipart -> Maybe Multipart -> Multipart
    forall a. a -> Maybe a -> a
    fromMaybe Multipart
    other (Text -> [(Text, Multipart)] -> Maybe Multipart
    forall a. Text -> [(Text, a)] -> Maybe a
    lookupField (Text -> Text
    T.toLower Text
    b) [(Text, Multipart)]
    multipartTypes)
              where other :: Multipart
    other | Text -> Text -> Bool
    T.isPrefixOf Text
    "x-" Text
    b = Text -> Multipart
    Extension Text
    b
                          | Bool
    otherwise           = Text -> Multipart
    OtherMulti Text
    b

    multipartTypes :: [(T.Text, Multipart)]
    multipartTypes :: [(Text, Multipart)]
    multipartTypes =
      [ (Text
    "alternative", Multipart
    Alternative)
      , (Text
    "byteranges",  Multipart
    Byteranges)
      , (Text
    "digest",      Multipart
    Digest)
      , (Text
    "encrypted",   Multipart
    Encrypted)
      , (Text
    "form-data",   Multipart
    FormData)
      , (Text
    "mixed",       Multipart
    Mixed)
      , (Text
    "parallel",    Multipart
    Parallel)
      , (Text
    "related",     Multipart
    Related)
      , (Text
    "signed",      Multipart
    Signed)
      ]

    untilMatch :: T.Text -> T.Text -> Maybe T.Text
    untilMatch :: Text -> Text -> Maybe Text
    untilMatch Text
    a Text
    b  | Text -> Bool
    T.null Text
    a  = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    b
                    | Text -> Bool
    T.null Text
    b  = Maybe Text
    forall a. Maybe a
    Nothing
                    | Text
    a Text -> Text -> Bool
    `T.isPrefixOf` Text
    b = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    T.drop (Text -> Int
    T.length Text
    a) Text
    b
                    | Bool
    otherwise = Text -> Text -> Maybe Text
    untilMatch Text
    a (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Text
    Text -> Text
    T.tail Text
    b

    matchUntil :: T.Text -> T.Text -> (T.Text, T.Text)
    -- searching str; returning parts before str and after str
    matchUntil :: Text -> Text -> (Text, Text)
    matchUntil Text
    str = (Text -> Text) -> (Text, Text) -> (Text, Text)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (Int -> Text -> Text
    T.drop (Int -> Text -> Text) -> Int -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Int
    T.length Text
    str) ((Text, Text) -> (Text, Text))
    -> (Text -> (Text, Text)) -> Text -> (Text, Text)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasCallStack => Text -> Text -> (Text, Text)
    Text -> Text -> (Text, Text)
    T.breakOn Text
    str

    {-
    matchUntil' :: T.Text -> T.Text -> (T.Text, T.Text)
    matchUntil' _   "" = ("", "")
    matchUntil' str xs
        | T.null xs = mempty
        -- slow, but it'll do for now.
        | str `T.isPrefixOf` xs = ("", T.drop (T.length str) xs)
        | otherwise = let (as,bs) = matchUntil' str $ T.tail xs in (T.take 1 xs <> as, bs)
    -}

    isHSpace :: Char -> Bool
    isHSpace :: Char -> Bool
    isHSpace Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\t'

    isTSpecial :: Char -> Bool
    isTSpecial :: Char -> Bool
    isTSpecial Char
    x = Char
    x Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ([Char]
    "()<>@,;:\\\"/[]?="::String) -- "

    dropFoldingWSP :: T.Text -> T.Text
    dropFoldingWSP :: Text -> Text
    dropFoldingWSP Text
    t | Text -> Bool
    T.null Text
    t   = Text
    ""
                     | Char -> Bool
    isHSpace (HasCallStack => Text -> Char
    Text -> Char
    T.head Text
    t) = Text -> Text
    dropFoldingWSP (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Text
    Text -> Text
    T.tail Text
    t
                     | Text
    "\r\n" Text -> Text -> Bool
    `T.isPrefixOf` Text
    t Bool -> Bool -> Bool
    && Bool -> Bool
    not (Text -> Bool
    T.null (Text -> Bool) -> Text -> Bool
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    T.drop Int
    2 Text
    t) Bool -> Bool -> Bool
    && Char -> Bool
    isHSpace (HasCallStack => Text -> Char
    Text -> Char
    T.head (Text -> Char) -> Text -> Char
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    T.drop Int
    2 Text
    t)
                        = Text -> Text
    dropFoldingWSP (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    T.drop Int
    3 Text
    t
                     | Bool
    otherwise    = Text
    t

    takeUntilCRLF :: T.Text -> (T.Text, T.Text)
    takeUntilCRLF :: Text -> (Text, Text)
    takeUntilCRLF Text
    str = Text -> Text -> (Text, Text)
    go Text
    "" Text
    str
     where
      go :: Text -> Text -> (Text, Text)
    go Text
    acc Text
    t  | Text -> Bool
    T.null Text
    t  = (Text -> Text
    T.reverse ((Char -> Bool) -> Text -> Text
    T.dropWhile Char -> Bool
    isHSpace Text
    acc), Text
    "")
                | Text
    "\r\n" Text -> Text -> Bool
    `T.isPrefixOf` Text
    t Bool -> Bool -> Bool
    && Bool -> Bool
    not (Text -> Bool
    T.null (Text -> Bool) -> Text -> Bool
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    T.drop Int
    2 Text
    t) Bool -> Bool -> Bool
    && Char -> Bool
    isHSpace (HasCallStack => Text -> Char
    Text -> Char
    T.head (Text -> Char) -> Text -> Char
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    T.drop Int
    2 Text
    t)
                            = Text -> Text -> (Text, Text)
    go (Text
    " " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    acc) (Int -> Text -> Text
    T.drop Int
    3 Text
    t)
                | Text
    "\r\n" Text -> Text -> Bool
    `T.isPrefixOf` Text
    t Bool -> Bool -> Bool
    && Bool -> Bool
    not (Text -> Bool
    T.null (Text -> Bool) -> Text -> Bool
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    T.drop Int
    2 Text
    t)
                            = (Text -> Text
    T.reverse ((Char -> Bool) -> Text -> Text
    T.dropWhile Char -> Bool
    isHSpace Text
    acc), Int -> Text -> Text
    T.drop Int
    2 Text
    t)
                | Bool
    otherwise = Text -> Text -> (Text, Text)
    go (Int -> Text -> Text
    T.take Int
    1 Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    acc) (Text -> (Text, Text)) -> Text -> (Text, Text)
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Text
    Text -> Text
    T.tail Text
    t

    -- case in-sensitive lookup of field names or attributes\/parameters.
    lookupField :: T.Text -> [(T.Text,a)] -> Maybe a
    lookupField :: forall a. Text -> [(Text, a)] -> Maybe a
    lookupField Text
    n [(Text, a)]
    ns =
       -- assume that inputs have been mostly normalized already
       -- (i.e., lower-cased), but should the lookup fail fall back
       -- to a second try where we do normalize before giving up.
      case Text -> [(Text, a)] -> Maybe a
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    n [(Text, a)]
    ns of
        x :: Maybe a
    x@Just{} -> Maybe a
    x
        Maybe a
    Nothing  ->
          let nl :: Text
    nl = Text -> Text
    T.toLower Text
    n in
          ((Text, a) -> a) -> Maybe (Text, a) -> Maybe a
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Text, a) -> a
    forall a b. (a, b) -> b
    snd (Maybe (Text, a) -> Maybe a) -> Maybe (Text, a) -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ ((Text, a) -> Bool) -> [(Text, a)] -> Maybe (Text, a)
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    L.find ((Text
    nlText -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) (Text -> Bool) -> ((Text, a) -> Text) -> (Text, a) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    T.toLower (Text -> Text) -> ((Text, a) -> Text) -> (Text, a) -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text, a) -> Text
    forall a b. (a, b) -> a
    fst) [(Text, a)]
    ns