smtp-mail 0.1.4.6 → 0.5.0.1
raw patch · 6 files changed
Files
- CHANGELOG.md +68/−0
- Network/Mail/SMTP.hs +215/−56
- Network/Mail/SMTP/Auth.hs +24/−17
- Network/Mail/SMTP/Types.hs +1/−0
- README.md +90/−0
- smtp-mail.cabal +17/−10
+ CHANGELOG.md view
@@ -0,0 +1,68 @@+# CHANGELOG++This package follows the Package Versioning Policy.+Roughly speaking, this means that we have four digits standing for:++- Major: A significant rewrite of the library.+- Major: A breaking change+- Minor: A non-breaking addition+- Patch: A non-breaking bugfix++## Upcoming++If you are doing a pull-request, please update this list.+A template is provided:++```+- [# PR number](URL to pr) @your_github_username+ - Describe change #1+ - Describe change #2+ - Indicate if changes are major, minor, or patch changes.+```++## 0.5.0.1++- [#63](https://github.com/haskell-github-trust/smtp-mail/pull/63) Switch to `ram` because the `memory` package is no longer maintained.++## 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.++## 0.4.0.1++- [#11](https://github.com/haskell-github-trust/smtp-mail/pull/11) @spencerjanssen+ - Support `crypton-connection-0.4.0`++## 0.4.0.0++- [#5](https://github.com/haskell-github-trust/smtp-mail/pull/5) @spencerjanssen+ - Switch to `crypton-connection` because the `connection` package is no longer maintained+- [#6](https://github.com/haskell-github-trust/smtp-mail/pull/6) @spencerjanssen+ - [Change in maintainership](https://github.com/jhickner/smtp-mail/pull/41#issuecomment-2012521041)++## 0.3.0.0++- [#32](https://github.com/jhickner/smtp-mail/pull/32) @typetetris+ - add some functions to use SMTPS, which should be preferred to+ STARTTLS for mail submissions of endusers according to RFC 8314+ - add STARTTLS+ - add integration test using nixos tests++- [#30](https://github.com/jhickner/smtp-mail/pull/30) @typetetris+ - Replace `cryptohash` dependency with `cryptonite`.+ `cryptohash` is deprecated and `cryptonite` offers HMAC MD5+ directly.++## 0.2.0.0++- [#25](https://github.com/jhickner/smtp-mail/pull/25) @shulhi+ - References to the deprecated `Network` module were removed and replaced + with the new `connection` package. + - Duplicate functionality was deprecated.+- [#23](https://github.com/jhickner/smtp-mail/pull/23) @alexandersgreen+ - The `Cc` and `Bcc` fields will be sent to the SMTP server, and they'll + actually be sent now.
Network/Mail/SMTP.hs view
@@ -8,6 +8,20 @@ , sendMailWithLogin' , sendMailWithSender , sendMailWithSender'+ , sendMailTLS+ , sendMailTLS'+ , sendMailWithLoginTLS+ , sendMailWithLoginTLS'+ , sendMailWithSenderTLS+ , sendMailWithSenderTLS'+ , sendMailSTARTTLS+ , sendMailSTARTTLS'+ , sendMailWithLoginSTARTTLS+ , sendMailWithLoginSTARTTLS'+ , sendMailWithLoginOAuthSTARTTLS+ , sendMailWithLoginOAuthSTARTTLS'+ , sendMailWithSenderSTARTTLS+ , sendMailWithSenderSTARTTLS' , simpleMail , plainTextPart , htmlPart@@ -25,8 +39,14 @@ -- * Establishing Connection , connectSMTP+ , connectSMTPS+ , connectSMTPSTARTTLS , connectSMTP'+ , connectSMTPS'+ , connectSMTPSTARTTLS' , connectSMTPWithHostName+ , connectSMTPWithHostNameAndTlsSettings+ , connectSMTPWithHostNameAndTlsSettingsSTARTTLS -- * Operation to a Connection , sendCommand@@ -40,16 +60,15 @@ import Network.Mail.SMTP.Auth import Network.Mail.SMTP.Types -import System.IO import System.FilePath (takeFileName) import Control.Monad (unless)-import Data.Monoid import Data.Char (isDigit) -import Network+import Network.Socket import Network.BSD (getHostName)-import Network.Mail.Mime hiding (htmlPart, simpleMail)+import Network.Mail.Mime hiding (filePart, htmlPart, simpleMail)+import qualified Network.Connection as Conn import Data.ByteString (ByteString) import qualified Data.ByteString as B@@ -60,32 +79,85 @@ import qualified Data.Text.Lazy.Encoding as TL import Data.Text.Encoding -data SMTPConnection = SMTPC !Handle ![ByteString]+import Data.Default.Class (def) +data SMTPConnection = SMTPC !Conn.Connection ![ByteString]+ instance Eq SMTPConnection where- (==) (SMTPC a _) (SMTPC b _) = a == b+ (==) (SMTPC a _) (SMTPC b _) = Conn.connectionID a == Conn.connectionID b -- | Connect to an SMTP server with the specified host and default port (25) connectSMTP :: HostName -- ^ name of the server -> IO SMTPConnection connectSMTP hostname = connectSMTP' hostname 25 +-- | Connect to an SMTP server with the specified host and default port (587). Uses STARTTLS+connectSMTPSTARTTLS :: HostName -- ^ name of the server+ -> IO SMTPConnection+connectSMTPSTARTTLS hostname = connectSMTPSTARTTLS' hostname 587++defaultTlsSettings :: Conn.TLSSettings+defaultTlsSettings = def++-- | Connect to an SMTP server with the specified host via SMTPS on port (465).+-- According to RFC 8314 this should be preferred over STARTTLS if the server+-- offers it.+-- If you need a different port number or more sophisticated 'Conn.TLSSettings'+-- use 'connectSMTPWithHostNameAndTlsSettings'.+connectSMTPS :: HostName -- ^ name of the server+ -> IO SMTPConnection+connectSMTPS hostname = + connectSMTPS' hostname 465+ -- | Connect to an SMTP server with the specified host and port connectSMTP' :: HostName -- ^ name of the server -> PortNumber -- ^ port number -> IO SMTPConnection-connectSMTP' hostname port =- connectTo hostname (PortNumber port) >>= connectStream getHostName+connectSMTP' hostname port = connectSMTPWithHostName hostname port getHostName +-- | Connect to an SMTP server with the specified host and port using TLS+connectSMTPS' :: HostName -- ^ name of the server+ -> PortNumber -- ^ port number+ -> IO SMTPConnection+connectSMTPS' hostname port = connectSMTPWithHostNameAndTlsSettings hostname port getHostName (Just defaultTlsSettings) +-- | Connect to an SMTP server with the specified host and port using STARTTLS+connectSMTPSTARTTLS' :: HostName -- ^ name of the server+ -> PortNumber -- ^ port number+ -> IO SMTPConnection+connectSMTPSTARTTLS' hostname port = connectSMTPWithHostNameAndTlsSettingsSTARTTLS hostname port getHostName defaultTlsSettings+ -- | Connect to an SMTP server with the specified host and port connectSMTPWithHostName :: HostName -- ^ name of the server -> PortNumber -- ^ port number -> IO String -- ^ Returns the host name to use to send from -> IO SMTPConnection connectSMTPWithHostName hostname port getMailHostName =- connectTo hostname (PortNumber port) >>= connectStream getMailHostName+ connectSMTPWithHostNameAndTlsSettings hostname port getMailHostName Nothing +-- | Connect to an SMTP server with the specified host and port and maybe via TLS+connectSMTPWithHostNameAndTlsSettings :: HostName -- ^ name of the server+ -> PortNumber -- ^ port number+ -> IO String -- ^ Returns the host name to use to send from+ -> Maybe Conn.TLSSettings -- ^ optional TLS parameters+ -> IO SMTPConnection+connectSMTPWithHostNameAndTlsSettings hostname port getMailHostName tlsSettings = do+ context <- Conn.initConnectionContext+ Conn.connectTo context connParams >>= connectStream getMailHostName+ where+ connParams = Conn.ConnectionParams hostname port tlsSettings Nothing+ +-- | Connect to an SMTP server with the specified host and port using STARTTLS+connectSMTPWithHostNameAndTlsSettingsSTARTTLS :: HostName -- ^ name of the server+ -> PortNumber -- ^ port number+ -> IO String -- ^ Returns the host name to use to send from+ -> Conn.TLSSettings -- ^ TLS parameters+ -> IO SMTPConnection+connectSMTPWithHostNameAndTlsSettingsSTARTTLS hostname port getMailHostName tlsSettings = do+ context <- Conn.initConnectionContext+ Conn.connectTo context connParams >>= connectStreamSTARTTLS getMailHostName context tlsSettings+ where + connParams = Conn.ConnectionParams hostname port Nothing Nothing -- | Attemp to send a 'Command' to the SMTP server once tryOnce :: SMTPConnection -> Command -> ReplyCode -> IO ByteString@@ -115,11 +187,11 @@ else return (code, msg) -- | Create an 'SMTPConnection' from an already connected Handle-connectStream :: IO String -> Handle -> IO SMTPConnection+connectStream :: IO String -> Conn.Connection -> IO SMTPConnection connectStream getMailHostName st = do (code1, _) <- parseResponse st unless (code1 == 220) $ do- hClose st+ Conn.connectionClose st fail "cannot connect to the server" senderHost <- getMailHostName (code, initialMsg) <- tryCommandNoFail 3 (SMTPC st []) (EHLO $ B8.pack senderHost) 250@@ -129,18 +201,32 @@ msg <- tryCommand 3 (SMTPC st []) (HELO $ B8.pack senderHost) 250 return (SMTPC st (tail $ B8.lines msg)) -parseResponse :: Handle -> IO (ReplyCode, ByteString)-parseResponse st = do+-- | Create an 'SMTPConnection' from an already connected Handle using STARTTLS+connectStreamSTARTTLS :: IO String -> Conn.ConnectionContext -> Conn.TLSSettings -> Conn.Connection -> IO SMTPConnection+connectStreamSTARTTLS getMailHostName context tlsSettings st = do+ (code1, _) <- parseResponse st+ unless (code1 == 220) $ do+ Conn.connectionClose st+ fail "cannot connect to the server"+ senderHost <- getMailHostName+ _ <- tryCommand 3 (SMTPC st []) (EHLO $ B8.pack senderHost) 250+ _ <- tryCommand 1 (SMTPC st []) STARTTLS 220+ _ <- Conn.connectionSetSecure context st tlsSettings+ msg <- tryCommand 1 (SMTPC st []) (EHLO $ B8.pack senderHost) 250+ return (SMTPC st (tail $ B8.lines msg))++parseResponse :: Conn.Connection -> IO (ReplyCode, ByteString)+parseResponse conn = do (code, bdy) <- readLines return (read $ B8.unpack code, B8.unlines bdy) where readLines = do- l <- B8.hGetLine st- let (c, bdy) = B8.span isDigit l- if not (B8.null bdy) && B8.head bdy == '-'- then do (c2, ls) <- readLines- return (c2, B8.tail bdy:ls)- else return (c, [B8.tail bdy])+ l <- Conn.connectionGetLine 1000 conn+ let (c, bdy) = B8.span isDigit l+ if not (B8.null bdy) && B8.head bdy == '-'+ then do (c2, ls) <- readLines+ return (c2, B8.tail bdy:ls)+ else return (c, [B8.tail bdy]) -- | Send a 'Command' to the SMTP server@@ -176,6 +262,17 @@ 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@@ -202,6 +299,7 @@ NOOP -> "NOOP" RSET -> "RSET" QUIT -> "QUIT"+ STARTTLS -> "STARTTLS" DATA{} -> error "BUG: DATA pattern should be matched by sendCommand patterns" AUTH{} ->@@ -210,7 +308,7 @@ -- | Send 'QUIT' and close the connection. closeSMTP :: SMTPConnection -> IO ()-closeSMTP c@(SMTPC conn _) = sendCommand c QUIT >> hClose conn+closeSMTP c@(SMTPC conn _) = sendCommand c QUIT >> Conn.connectionClose conn -- | Sends a rendered mail to the server. sendRenderedMail :: ByteString -- ^ sender mail@@ -232,58 +330,116 @@ sendRenderedMail from to rendered conn where enc = encodeUtf8 . addressEmail from = enc mailFrom- to = map enc mailTo+ to = map enc $ mailTo ++ mailCc ++ mailBcc --- | Connect to an SMTP server, send a 'Mail', then disconnect. Uses the default port (25).-sendMail :: HostName -> Mail -> IO ()-sendMail host mail = do- con <- connectSMTP host+sendMailOnConnection :: Mail -> SMTPConnection -> IO ()+sendMailOnConnection mail con = do renderAndSend con mail closeSMTP con +-- | Connect to an SMTP server, send a 'Mail', then disconnect. Uses the default port (25).+sendMail :: HostName -> Mail -> IO ()+sendMail host mail = connectSMTP host >>= sendMailOnConnection mail+ -- | Connect to an SMTP server, send a 'Mail', then disconnect. sendMail' :: HostName -> PortNumber -> Mail -> IO ()-sendMail' host port mail = do- con <- connectSMTP' host port- renderAndSend con mail- closeSMTP con+sendMail' host port mail = connectSMTP' host port >>= sendMailOnConnection mail --- | Connect to an SMTP server, login, send a 'Mail', disconnect. Uses the default port (25).+-- | Connect to an SMTP server, login, send a 'Mail', disconnect. Uses the default port (25). sendMailWithLogin :: HostName -> UserName -> Password -> Mail -> IO ()-sendMailWithLogin host user pass mail = do- con <- connectSMTP host- _ <- sendCommand con (AUTH LOGIN user pass)- renderAndSend con mail- closeSMTP con+sendMailWithLogin host user pass mail = connectSMTP host >>= sendMailWithLoginIntern user pass mail -- | Connect to an SMTP server, login, send a 'Mail', disconnect. sendMailWithLogin' :: HostName -> PortNumber -> UserName -> Password -> Mail -> IO ()-sendMailWithLogin' host port user pass mail = do- con <- connectSMTP' host port- _ <- sendCommand con (AUTH LOGIN user pass)- renderAndSend con mail- closeSMTP con+sendMailWithLogin' host port user pass mail = connectSMTP' host port >>= sendMailWithLoginIntern user pass mail -- | Send a 'Mail' with a given sender. sendMailWithSender :: ByteString -> HostName -> Mail -> IO ()-sendMailWithSender sender host mail = do- con <- connectSMTP host- renderAndSendFrom sender con mail- closeSMTP con+sendMailWithSender sender host mail = connectSMTP host >>= sendMailWithSenderIntern sender mail -- | Send a 'Mail' with a given sender. sendMailWithSender' :: ByteString -> HostName -> PortNumber -> Mail -> IO ()-sendMailWithSender' sender host port mail = do- con <- connectSMTP' host port- renderAndSendFrom sender con mail- closeSMTP con+sendMailWithSender' sender host port mail = connectSMTP' host port >>= sendMailWithSenderIntern sender mail +-- | Connect to an SMTP server, send a 'Mail', then disconnect. Uses SMTPS with the default port (465).+sendMailTLS :: HostName -> Mail -> IO ()+sendMailTLS host mail = connectSMTPS host >>= sendMailOnConnection mail++-- | Connect to an SMTP server, send a 'Mail', then disconnect. Uses SMTPS.+sendMailTLS' :: HostName -> PortNumber -> Mail -> IO ()+sendMailTLS' host port mail = connectSMTPS' host port >>= sendMailOnConnection mail++-- | Connect to an SMTP server, login, send a 'Mail', disconnect. Uses SMTPS with its default port (465).+sendMailWithLoginTLS :: HostName -> UserName -> Password -> Mail -> IO ()+sendMailWithLoginTLS host user pass mail = connectSMTPS host >>= sendMailWithLoginIntern user pass mail++-- | Connect to an SMTP server, login, send a 'Mail', disconnect. Uses SMTPS.+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++-- | Send a 'Mail' with a given sender. Uses SMTPS.+sendMailWithSenderTLS' :: ByteString -> HostName -> PortNumber -> Mail -> IO ()+sendMailWithSenderTLS' sender host port mail = connectSMTPS' host port >>= sendMailWithSenderIntern sender mail++-- | Connect to an SMTP server, send a 'Mail', then disconnect. Uses STARTTLS with the default port (587).+sendMailSTARTTLS :: HostName -> Mail -> IO ()+sendMailSTARTTLS host mail = connectSMTPSTARTTLS host >>= sendMailOnConnection mail++-- | Connect to an SMTP server, send a 'Mail', then disconnect. Uses STARTTLS.+sendMailSTARTTLS' :: HostName -> PortNumber -> Mail -> IO ()+sendMailSTARTTLS' host port mail = connectSMTPSTARTTLS' host port >>= sendMailOnConnection mail++-- | Connect to an SMTP server, login, send a 'Mail', disconnect. Uses STARTTLS with the default port (587).+sendMailWithLoginSTARTTLS :: HostName -> UserName -> Password -> Mail -> IO ()+sendMailWithLoginSTARTTLS host user pass mail = connectSMTPSTARTTLS host >>= sendMailWithLoginIntern user pass mail++-- | Connect to an SMTP server, login, send a 'Mail', disconnect. Uses STARTTLS.+sendMailWithLoginSTARTTLS' :: HostName -> PortNumber -> UserName -> Password -> Mail -> IO ()+sendMailWithLoginSTARTTLS' host port user pass mail = connectSMTPSTARTTLS' host port >>= sendMailWithLoginIntern user pass mail++-- | Send a 'Mail' with a given sender. Uses STARTTLS with the default port (587).+sendMailWithSenderSTARTTLS :: ByteString -> HostName -> Mail -> IO ()+sendMailWithSenderSTARTTLS sender host mail = connectSMTPSTARTTLS host >>= sendMailWithSenderIntern sender mail++-- | Send a 'Mail' with a given sender. Uses STARTTLS.+sendMailWithSenderSTARTTLS' :: ByteString -> HostName -> PortNumber -> Mail -> IO ()+sendMailWithSenderSTARTTLS' sender host port mail = connectSMTPSTARTTLS' host port >>= sendMailWithSenderIntern sender mail++sendMailWithLoginIntern :: UserName -> Password -> Mail -> SMTPConnection -> IO ()+sendMailWithLoginIntern user pass mail con = do+ _ <- sendCommand con (AUTH LOGIN user pass)+ 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+ closeSMTP con+ renderAndSendFrom :: ByteString -> SMTPConnection -> Mail -> IO () renderAndSendFrom sender conn mail@Mail{..} = do rendered <- BL.toStrict `fmap` renderMail' mail sendRenderedMail sender to rendered conn where enc = encodeUtf8 . addressEmail- to = map enc mailTo+ to = map enc $ mailTo ++ mailCc ++ mailBcc -- | A convenience function that sends 'AUTH' 'LOGIN' to the server login :: SMTPConnection -> UserName -> Password -> IO (ReplyCode, ByteString)@@ -309,13 +465,15 @@ -- | Construct a plain text 'Part' plainTextPart :: TL.Text -> Part-plainTextPart = Part "text/plain; charset=utf-8"- QuotedPrintableText Nothing [] . TL.encodeUtf8+plainTextPart body = Part "text/plain; charset=utf-8"+ QuotedPrintableText DefaultDisposition [] (PartContent $ TL.encodeUtf8 body)+{-# DEPRECATED plainTextPart "Use plainPart from mime-mail package" #-} -- | Construct an html 'Part' htmlPart :: TL.Text -> Part-htmlPart = Part "text/html; charset=utf-8"- QuotedPrintableText Nothing [] . TL.encodeUtf8+htmlPart body = Part "text/html; charset=utf-8"+ QuotedPrintableText DefaultDisposition [] (PartContent $ TL.encodeUtf8 body)+{-# DEPRECATED htmlPart "Use htmlPart from mime-mail package" #-} -- | Construct a file attachment 'Part' filePart :: T.Text -- ^ content type@@ -323,7 +481,8 @@ -> IO Part filePart ct fp = do content <- BL.readFile fp- return $ Part ct Base64 (Just $ T.pack (takeFileName fp)) [] content+ return $ Part ct Base64 (AttachmentDisposition $ T.pack (takeFileName fp)) [] (PartContent content)+{-# DEPRECATED filePart "Use filePart from mime-mail package" #-} lazyToStrict :: BL.ByteString -> B.ByteString lazyToStrict = B.concat . BL.toChunks@@ -331,5 +490,5 @@ crlf :: B8.ByteString crlf = B8.pack "\r\n" -bsPutCrLf :: Handle -> ByteString -> IO ()-bsPutCrLf h s = B8.hPut h s >> B8.hPut h crlf >> hFlush h+bsPutCrLf :: Conn.Connection -> ByteString -> IO ()+bsPutCrLf conn = Conn.connectionPut conn . flip B.append crlf
Network/Mail/SMTP/Auth.hs view
@@ -1,37 +1,42 @@ module Network.Mail.SMTP.Auth ( UserName, Password,+ Token, AuthType(..), encodeLogin,+ encodeLoginOAuth, auth, ) where -import Crypto.Hash.MD5 (hash)+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 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+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)@@ -40,14 +45,9 @@ 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 (64-B.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+hmacMD5 text key =+ let mac = hmac key text :: HMAC MD5+ in copyAndFreeze mac (const $ return ()) encodePlain :: UserName -> Password -> ByteString encodePlain user pass = b64Encode $ intercalate "\0" [user, user, pass]@@ -55,6 +55,12 @@ 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')]@@ -64,6 +70,7 @@ 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
Network/Mail/SMTP/Types.hs view
@@ -30,6 +30,7 @@ | NOOP | RSET | QUIT+ | STARTTLS deriving (Show, Eq) type ReplyCode = Int
+ README.md view
@@ -0,0 +1,90 @@+SMTP-MAIL+=========++Making it easy to send SMTP emails from Haskell.++```+cabal install smtp-mail+```++### Sending with an SMTP server++```haskell+{-# LANGUAGE OverloadedStrings #-}++import Network.Mail.SMTP++from = Address Nothing "email@domain.com"+to = [Address (Just "Jason Hickner") "email@domain.com"]+cc = []+bcc = []+subject = "email subject"+body = plainTextPart "email body"+html = htmlPart "<h1>HTML</h1>"++mail = simpleMail from to cc bcc subject [body, html]++main = sendMail host mail+```++or with an attachment:++```haskell+main = do+ attachment <- filePart "application/octet-stream" "path/to/attachment.zip"+ let mail = simpleMail from to cc bcc subject [body, html, attachment]+ sendMail host mail+```++or, with authentication:++```haskell+main = sendMailWithLogin host user pass mail+```++or, using STARTTLS:++```haskell+main = sendMailSTARTTLS host mail+```++or, using SMTPS:++```haskell+main = sendMailTLS host mail+```++Note: `sendMail'` and `sendMailWithLogin'` variations are also provided if you want to specify a port as well as a hostname.+++### Sending with sendmail++If you'd like to use sendmail, the sendmail interface from ```Network.Mail.Mime``` +is reexported as well:++```haskell+-- send via the default sendmail executable with default options+renderSendMail mail++-- send via the specified executable with specified options+renderSendMailCustom filepath [opts] mail+```++For more complicated scenarios or for adding attachments or CC/BCC+addresses you can import ```Network.Mail.Mime``` and construct ```Mail```+objects manually.++### Thanks++This library is based on code from HaskellNet, which appears to be no longer+maintained. I've cleaned up the error handling, added some API functions to+make common operations easier, and switched to ByteStrings where applicable.++### Developing++`nix-integration-test/` contains a integration test, which+uses nixos qemu vm tests to start a qemu vm with a postfix and use smtp-mail to+send mails to that postfix.++Install [nix](https://nixos.org), enable [flakes](https://nixos.wiki/wiki/Flakes) and execute+`nix flake check` to execute the test. Success is signalled by a return code of `0`.
smtp-mail.cabal view
@@ -1,25 +1,28 @@--- Initial smtp-mail.cabal generated by cabal init. For further--- documentation, see http://haskell.org/cabal/users-guide/- name: smtp-mail-version: 0.1.4.6+version: 0.5.0.1 synopsis: Simple email sending via SMTP--- description:-homepage: http://github.com/jhickner/smtp-mail+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 license: BSD3 license-file: LICENSE author: Jason Hickner, Matt Parsons-maintainer: parsonsmatt@gmail.com+maintainer: spencerjanssen@gmail.com -- copyright: category: Network build-type: Simple-cabal-version: >=1.8+cabal-version: 2.0+tested-with: GHC ==9.12.2 +extra-source-files:+ README.md+ , CHANGELOG.md+ source-repository head type: git- location: git@github.com:jhickner/smtp-mail.git+ location: git@github.com:haskell-github-trust/smtp-mail.git library+ default-language: Haskell2010 exposed-modules: Network.Mail.SMTP Network.Mail.SMTP.Auth@@ -32,10 +35,14 @@ , base16-bytestring , base64-bytestring , bytestring- , cryptohash+ , crypton-connection ^>= 0.4.6+ , data-default-class ^>= 0.2.0.0 , filepath , mime-mail , network+ , network-bsd , text+ , crypton ^>= 1.1+ , ram ^>= 0.21.1 ghc-options: -Wall -fwarn-tabs