module Network.Mail.SMTP.Auth (
UserName,
Password,
AuthType(..),
login,
auth,
) where
import Crypto.Hash.MD5 (hash)
import qualified Data.ByteString.Base16 as B16 (encode)
import qualified Data.ByteString.Base64 as B64 (encode)
import Data.ByteString (ByteString)
import Data.List
import Data.Bits
import Data.Monoid
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 Eq
instance Show AuthType where
showsPrec d at = showParen (d>app_prec) $ showString $ showMain at
where app_prec = 10
showMain PLAIN = "PLAIN"
showMain LOGIN = "LOGIN"
showMain CRAM_MD5 = "CRAM-MD5"
toAscii :: String -> ByteString
toAscii = B.pack . map (toEnum.fromEnum)
b64Encode :: String -> ByteString
b64Encode = B64.encode . toAscii
hmacMD5 :: ByteString -> ByteString -> ByteString
hmacMD5 text key = hash (okey <> hash (ikey <> text))
where key' = if B.length key > 64
then hash key <> B.replicate 48 0
else key <> B.replicate (64B.length key) 0
ipad = B.replicate 64 0x36
opad = B.replicate 64 0x5c
ikey = B.pack $ B.zipWith xor key' ipad
okey = B.pack $ B.zipWith xor key' opad
plain :: UserName -> Password -> ByteString
plain user pass = b64Encode $ intercalate "\0" [user, user, pass]
login :: UserName -> Password -> (ByteString, ByteString)
login user pass = (b64Encode user, b64Encode pass)
cramMD5 :: String -> UserName -> Password -> ByteString
cramMD5 challenge user pass =
B64.encode $ B8.unwords [user', B16.encode (hmacMD5 challenge' pass')]
where
challenge' = toAscii challenge
user' = toAscii user
pass' = toAscii pass
auth :: AuthType -> String -> UserName -> Password -> ByteString
auth PLAIN _ u p = plain u p
auth LOGIN _ u p = let (u', p') = login u p in B8.unwords [u', p']
auth CRAM_MD5 c u p = cramMD5 c u p