    module Network.Mail.SMTP.Auth (
        UserName,
        Password,
        AuthType(..),
        encodeLogin,
        auth,
    ) where

    import Crypto.MAC.HMAC (hmac, HMAC)
    import Crypto.Hash.Algorithms (MD5)
    import Data.ByteArray (copyAndFreeze)
    import qualified Data.ByteString.Base16 as B16  (encode)
    import qualified Data.ByteString.Base64 as B64  (encode)

    import Data.ByteString  (ByteString)
    import Data.List
    import qualified Data.ByteString       as B
    import qualified Data.ByteString.Char8 as B8    (unwords)

    type UserName = String
    type Password = String

    data AuthType
        = PLAIN
        | LOGIN
        | CRAM_MD5
        deriving AuthType -> AuthType -> Bool
    (AuthType -> AuthType -> Bool)
    -> (AuthType -> AuthType -> Bool) -> Eq AuthType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: AuthType -> AuthType -> Bool
    == :: AuthType -> AuthType -> Bool
    $c/= :: AuthType -> AuthType -> Bool
    /= :: AuthType -> AuthType -> Bool
    Eq

    instance Show AuthType where
        showsPrec :: Int -> AuthType -> ShowS
    showsPrec Int
    d AuthType
    at = Bool -> ShowS -> ShowS
    showParen (Int
    dInt -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >Int
    app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    showString (String -> ShowS) -> String -> ShowS
    forall a b. (a -> b) -> a -> b
    $ AuthType -> String
    showMain AuthType
    at
            where app_prec :: Int
    app_prec = Int
    10
                  showMain :: AuthType -> String
    showMain AuthType
    PLAIN    = String
    "PLAIN"
                  showMain AuthType
    LOGIN    = String
    "LOGIN"
                  showMain AuthType
    CRAM_MD5 = String
    "CRAM-MD5"

    toAscii :: String -> ByteString
    toAscii :: String -> ByteString
    toAscii = [Word8] -> ByteString
    B.pack ([Word8] -> ByteString)
    -> (String -> [Word8]) -> String -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Word8) -> String -> [Word8]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Word8
    forall a. Enum a => Int -> a
    toEnum(Int -> Word8) -> (Char -> Int) -> Char -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> Int
    forall a. Enum a => a -> Int
    fromEnum)

    b64Encode :: String -> ByteString
    b64Encode :: String -> ByteString
    b64Encode = ByteString -> ByteString
    B64.encode (ByteString -> ByteString)
    -> (String -> ByteString) -> String -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ByteString
    toAscii

    hmacMD5 :: ByteString -> ByteString -> ByteString
    hmacMD5 :: ByteString -> ByteString -> ByteString
    hmacMD5 ByteString
    text ByteString
    key =
        let mac :: HMAC MD5
    mac = ByteString -> ByteString -> HMAC MD5
    forall key message a.
    (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
    key -> message -> HMAC a
    hmac ByteString
    key ByteString
    text :: HMAC MD5
        in HMAC MD5 -> (Ptr Any -> IO ()) -> ByteString
    forall bs1 bs2 p.
    (ByteArrayAccess bs1, ByteArray bs2) =>
    bs1 -> (Ptr p -> IO ()) -> bs2
    copyAndFreeze HMAC MD5
    mac (IO () -> Ptr Any -> IO ()
    forall a b. a -> b -> a
    const (IO () -> Ptr Any -> IO ()) -> IO () -> Ptr Any -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    encodePlain :: UserName -> Password -> ByteString
    encodePlain :: String -> String -> ByteString
    encodePlain String
    user String
    pass = String -> ByteString
    b64Encode (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\0" [String
    user, String
    user, String
    pass]

    encodeLogin :: UserName -> Password -> (ByteString, ByteString)
    encodeLogin :: String -> String -> (ByteString, ByteString)
    encodeLogin String
    user String
    pass = (String -> ByteString
    b64Encode String
    user, String -> ByteString
    b64Encode String
    pass)

    cramMD5 :: String -> UserName -> Password -> ByteString
    cramMD5 :: String -> String -> String -> ByteString
    cramMD5 String
    challenge String
    user String
    pass =
        ByteString -> ByteString
    B64.encode (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    B8.unwords [ByteString
    user', ByteString -> ByteString
    B16.encode (ByteString -> ByteString -> ByteString
    hmacMD5 ByteString
    challenge' ByteString
    pass')]
      where
        challenge' :: ByteString
    challenge' = String -> ByteString
    toAscii String
    challenge
        user' :: ByteString
    user'      = String -> ByteString
    toAscii String
    user
        pass' :: ByteString
    pass'      = String -> ByteString
    toAscii String
    pass

    auth :: AuthType -> String -> UserName -> Password -> ByteString
    auth :: AuthType -> String -> String -> String -> ByteString
    auth AuthType
    PLAIN    String
    _ String
    u String
    p = String -> String -> ByteString
    encodePlain String
    u String
    p
    auth AuthType
    LOGIN    String
    _ String
    u String
    p = let (ByteString
    u', ByteString
    p') = String -> String -> (ByteString, ByteString)
    encodeLogin String
    u String
    p in [ByteString] -> ByteString
    B8.unwords [ByteString
    u', ByteString
    p']
    auth AuthType
    CRAM_MD5 String
    c String
    u String
    p = String -> String -> String -> ByteString
    cramMD5 String
    c String
    u String
    p