diff --git a/CHANGELOG.md b/CHANGELOG.md index 995951e..42158af 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,6 +20,10 @@ A template is provided: - Indicate if changes are major, minor, or patch changes. ``` +## 0.5.0.0 + +- Adds support for OAuth authentication with a new function `sendMailWithLoginOAuthSTARTTLS`. + ## 0.4.0.2 - Switch to `crypton` because the `cryptonite` package is no longer maintained. diff --git a/Network/Mail/SMTP.hs b/Network/Mail/SMTP.hs index 984d235..148c984 100644 --- a/Network/Mail/SMTP.hs +++ b/Network/Mail/SMTP.hs @@ -18,6 +18,8 @@ module Network.Mail.SMTP , sendMailSTARTTLS' , sendMailWithLoginSTARTTLS , sendMailWithLoginSTARTTLS' + , sendMailWithLoginOAuthSTARTTLS + , sendMailWithLoginOAuthSTARTTLS' , sendMailWithSenderSTARTTLS , sendMailWithSenderSTARTTLS' , simpleMail @@ -260,6 +262,17 @@ sendCommand (SMTPC conn _) (AUTH LOGIN username password) = do command = "AUTH LOGIN" (userB64, passB64) = encodeLogin username password +sendCommand (SMTPC conn _) (AUTH LOGIN_OAUTH username token) = do + bsPutCrLf conn command + _ <- parseResponse conn + bsPutCrLf conn tokenB64 + (code, msg) <- parseResponse conn + unless (code == 235) $ fail "authentication failed." + return (code, msg) + where + command = "AUTH XOAUTH2" + tokenB64 = encodeLoginOAuth username token + sendCommand (SMTPC conn _) (AUTH at username password) = do bsPutCrLf conn command (code, msg) <- parseResponse conn @@ -364,6 +377,14 @@ sendMailWithLoginTLS host user pass mail = connectSMTPS host >>= sendMailWithLog sendMailWithLoginTLS' :: HostName -> PortNumber -> UserName -> Password -> Mail -> IO () sendMailWithLoginTLS' host port user pass mail = connectSMTPS' host port >>= sendMailWithLoginIntern user pass mail +-- | Connect to an SMTP server, login with OAuth, send a 'Mail', disconnect. Uses STARTTLS with the default port (587). +sendMailWithLoginOAuthSTARTTLS :: HostName -> UserName -> Token -> Mail -> IO () +sendMailWithLoginOAuthSTARTTLS host user token mail = connectSMTPSTARTTLS host >>= sendMailWithLoginOAuthIntern user token mail + +-- | Connect to an SMTP server, login with OAuth, send a 'Mail', disconnect. Uses STARTTLS. +sendMailWithLoginOAuthSTARTTLS' :: HostName -> PortNumber -> UserName -> Token -> Mail -> IO () +sendMailWithLoginOAuthSTARTTLS' host port user token mail = connectSMTPSTARTTLS' host port >>= sendMailWithLoginOAuthIntern user token mail + -- | Send a 'Mail' with a given sender. Uses SMTPS with its default port (465). sendMailWithSenderTLS :: ByteString -> HostName -> Mail -> IO () sendMailWithSenderTLS sender host mail = connectSMTPS host >>= sendMailWithSenderIntern sender mail @@ -402,6 +423,12 @@ sendMailWithLoginIntern user pass mail con = do renderAndSend con mail closeSMTP con +sendMailWithLoginOAuthIntern :: UserName -> Password -> Mail -> SMTPConnection -> IO () +sendMailWithLoginOAuthIntern user token mail con = do + _ <- sendCommand con (AUTH LOGIN_OAUTH user token) + renderAndSend con mail + closeSMTP con + sendMailWithSenderIntern :: ByteString -> Mail -> SMTPConnection -> IO () sendMailWithSenderIntern sender mail con = do renderAndSendFrom sender con mail diff --git a/Network/Mail/SMTP/Auth.hs b/Network/Mail/SMTP/Auth.hs index 70457f0..548f140 100644 --- a/Network/Mail/SMTP/Auth.hs +++ b/Network/Mail/SMTP/Auth.hs @@ -1,8 +1,10 @@ module Network.Mail.SMTP.Auth ( UserName, Password, + Token, AuthType(..), encodeLogin, + encodeLoginOAuth, auth, ) where @@ -19,19 +21,22 @@ import qualified Data.ByteString.Char8 as B8 (unwords) type UserName = String type Password = String +type Token = String data AuthType = PLAIN | LOGIN + | LOGIN_OAUTH | 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" + showMain PLAIN = "PLAIN" + showMain LOGIN = "LOGIN" + showMain LOGIN_OAUTH = "XOAUTH2" + showMain CRAM_MD5 = "CRAM-MD5" toAscii :: String -> ByteString toAscii = B.pack . map (toEnum.fromEnum) @@ -50,6 +55,12 @@ encodePlain user pass = b64Encode $ intercalate "\0" [user, user, pass] encodeLogin :: UserName -> Password -> (ByteString, ByteString) encodeLogin user pass = (b64Encode user, b64Encode pass) +-- | Encode the xoauth 2 message based on: +-- https://docs.microsoft.com/en-us/exchange/client-developer/legacy-protocols/how-to-authenticate-an-imap-pop-smtp-application-by-using-oauth#sasl-xoauth2 +encodeLoginOAuth :: UserName -> Token -> ByteString +encodeLoginOAuth user oauthToken = + b64Encode ("user=" <> user <> "\x01" <> "auth=Bearer " <> oauthToken <> "\x01\x01") + cramMD5 :: String -> UserName -> Password -> ByteString cramMD5 challenge user pass = B64.encode $ B8.unwords [user', B16.encode (hmacMD5 challenge' pass')] @@ -59,6 +70,7 @@ cramMD5 challenge user pass = pass' = toAscii pass auth :: AuthType -> String -> UserName -> Password -> ByteString -auth PLAIN _ u p = encodePlain u p -auth LOGIN _ u p = let (u', p') = encodeLogin u p in B8.unwords [u', p'] -auth CRAM_MD5 c u p = cramMD5 c u p +auth PLAIN _ u p = encodePlain u p +auth LOGIN _ u p = let (u', p') = encodeLogin u p in B8.unwords [u', p'] +auth LOGIN_OAUTH _ u t = encodeLoginOAuth u t +auth CRAM_MD5 c u p = cramMD5 c u p diff --git a/smtp-mail.cabal b/smtp-mail.cabal index 0fc3fec..6605788 100644 --- a/smtp-mail.cabal +++ b/smtp-mail.cabal @@ -1,5 +1,5 @@ name: smtp-mail -version: 0.4.0.2 +version: 0.5.0.0 synopsis: Simple email sending via SMTP description: This packages provides a simple interface for mail over SMTP. Please see the README for more information. homepage: http://github.com/haskell-github-trust/smtp-mail