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