    --------------------------------------------------------------------
    -- |
    -- Module    : Codec.MIME.Decode
    -- Copyright : (c) 2006-2009, Galois, Inc.
    -- License   : BSD3
    --
    -- Maintainer: Sigbjorn Finne <sigbjorn.finne@gmail.com>
    -- Stability : provisional
    -- Portability: portable
    --
    --
    --
    --------------------------------------------------------------------

    module Codec.MIME.Decode where

    import Data.Char

    import Codec.MIME.QuotedPrintable as QP
    import Codec.MIME.Base64 as Base64

    -- | @decodeBody enc str@ decodes @str@ according to the scheme
    -- specified by @enc@. Currently, @base64@ and @quoted-printable@ are
    -- the only two encodings supported. If you supply anything else
    -- for @enc@, @decodeBody@ returns @str@.
    --
    decodeBody :: String -> String -> String
    decodeBody :: String -> String -> String
    decodeBody enc :: String
    enc body :: String
    body =
     case (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    enc of
       "base64"           -> String -> String
    Base64.decodeToString String
    body
       "quoted-printable" -> String -> String
    QP.decode String
    body
       _ -> String
    body

    -- Decoding of RFC 2047's "encoded-words" production
    -- (as used in email-headers and some HTTP header cases
    -- (AtomPub's Slug: header))
    decodeWord :: String -> Maybe (String, String)
    decodeWord :: String -> Maybe (String, String)
    decodeWord str :: String
    str =
      case String
    str of
       '=':'?':xs :: String
    xs ->
         case (String, String) -> (String, String)
    forall a. (a, String) -> (a, String)
    dropLang ((String, String) -> (String, String))
    -> (String, String) -> (String, String)
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (\ch :: Char
    ch -> Char
    ch Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    =='?' Bool -> Bool -> Bool
    || Char
    ch Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '*') String
    xs of
           (cs :: String
    cs,_:x :: Char
    x:'?':bs :: String
    bs)
             | String -> Bool
    isKnownCharset ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    cs) ->
               case Char -> Char
    toLower Char
    x of
                 'q' -> String -> (String, String) -> Maybe (String, String)
    forall p. p -> (String, String) -> Maybe (String, String)
    decodeQ String
    cs ((Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    =='?') String
    bs)
                 'b' -> String -> (String, String) -> Maybe (String, String)
    forall p. p -> (String, String) -> Maybe (String, String)
    decodeB String
    cs ((Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    =='?') String
    bs)
                 _   -> Maybe (String, String)
    forall a. Maybe a
    Nothing
           _ -> Maybe (String, String)
    forall a. Maybe a
    Nothing
       _ -> Maybe (String, String)
    forall a. Maybe a
    Nothing
     where
      isKnownCharset :: String -> Bool
    isKnownCharset cs :: String
    cs = String
    cs String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["iso-8859-1", "us-ascii"]

       -- ignore RFC 2231 extension of permitting a language tag to be supplied
       -- after the charset.
      dropLang :: (a, String) -> (a, String)
    dropLang (as :: a
    as,'*':bs :: String
    bs) = (a
    as,(Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /='?') String
    bs)
      dropLang (as :: a
    as,bs :: String
    bs) = (a
    as,String
    bs)

      decodeQ :: p -> (String, String) -> Maybe (String, String)
    decodeQ cset :: p
    cset (fs :: String
    fs,'?':'=':rs :: String
    rs) = (String, String) -> Maybe (String, String)
    forall a. a -> Maybe a
    Just (p -> String -> String
    forall p p. p -> p -> p
    fromCharset p
    cset (String -> String
    QP.decode String
    fs),String
    rs)
      decodeQ _ _ = Maybe (String, String)
    forall a. Maybe a
    Nothing

      decodeB :: p -> (String, String) -> Maybe (String, String)
    decodeB cset :: p
    cset (fs :: String
    fs,'?':'=':rs :: String
    rs) =
        (String, String) -> Maybe (String, String)
    forall a. a -> Maybe a
    Just (p -> String -> String
    forall p p. p -> p -> p
    fromCharset p
    cset (String -> String
    Base64.decodeToString String
    fs),String
    rs)
      decodeB _ _ = Maybe (String, String)
    forall a. Maybe a
    Nothing

      fromCharset :: p -> p -> p
    fromCharset _cset :: p
    _cset cs :: p
    cs = p
    cs

    decodeWords :: String -> String
    decodeWords :: String -> String
    decodeWords "" = ""
    decodeWords (x :: Char
    x:xs :: String
    xs)
     | Char -> Bool
    isSpace Char
    x = Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    decodeWords String
    xs
     | Bool
    otherwise =
      case String -> Maybe (String, String)
    decodeWord (Char
    xChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    xs) of
        Nothing -> Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    decodeWords String
    xs
        Just (as :: String
    as,bs :: String
    bs) -> String
    as String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    decodeWords String
    bs