smtp-mail-0.3.0.0/0000755000000000000000000000000007346545000011744 5ustar0000000000000000smtp-mail-0.3.0.0/CHANGELOG.md0000755000000000000000000000264307346545000013565 0ustar0000000000000000# 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.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. smtp-mail-0.3.0.0/LICENSE0000644000000000000000000000300707346545000012751 0ustar0000000000000000Copyright (c) 2012-2016, Jason Hickner, Matt Parsons All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Jason Hickner nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. smtp-mail-0.3.0.0/Network/Mail/0000755000000000000000000000000007346545000014257 5ustar0000000000000000smtp-mail-0.3.0.0/Network/Mail/SMTP.hs0000644000000000000000000004605707346545000015412 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-} module Network.Mail.SMTP ( -- * Main interface sendMail , sendMail' , sendMailWithLogin , sendMailWithLogin' , sendMailWithSender , sendMailWithSender' , sendMailTLS , sendMailTLS' , sendMailWithLoginTLS , sendMailWithLoginTLS' , sendMailWithSenderTLS , sendMailWithSenderTLS' , sendMailSTARTTLS , sendMailSTARTTLS' , sendMailWithLoginSTARTTLS , sendMailWithLoginSTARTTLS' , sendMailWithSenderSTARTTLS , sendMailWithSenderSTARTTLS' , simpleMail , plainTextPart , htmlPart , filePart -- * Types , module Network.Mail.SMTP.Types , SMTPConnection -- * Network.Mail.Mime's sendmail interface (reexports) , sendmail , sendmailCustom , renderSendMail , renderSendMailCustom -- * Establishing Connection , connectSMTP , connectSMTPS , connectSMTPSTARTTLS , connectSMTP' , connectSMTPS' , connectSMTPSTARTTLS' , connectSMTPWithHostName , connectSMTPWithHostNameAndTlsSettings , connectSMTPWithHostNameAndTlsSettingsSTARTTLS -- * Operation to a Connection , sendCommand , login , closeSMTP , renderAndSend , renderAndSendFrom ) where import Network.Mail.SMTP.Auth import Network.Mail.SMTP.Types import System.FilePath (takeFileName) import Control.Monad (unless) import Data.Char (isDigit) import Network.Socket import Network.BSD (getHostName) import Network.Mail.Mime hiding (filePart, htmlPart, simpleMail) import qualified Network.Connection as Conn import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import Data.Text.Encoding data SMTPConnection = SMTPC !Conn.Connection ![ByteString] instance Eq SMTPConnection where (==) (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 = Conn.TLSSettingsSimple False False False -- | 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 = 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 = 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 tryOnce = tryCommand 1 -- | Repeatedly attempt to send a 'Command' to the SMTP server tryCommand :: Int -> SMTPConnection -> Command -> ReplyCode -> IO ByteString tryCommand tries st cmd expectedReply = do (code, msg) <- tryCommandNoFail tries st cmd expectedReply if code == expectedReply then return msg else do closeSMTP st fail $ "Unexpected reply to: " ++ show cmd ++ ", Expected reply code: " ++ show expectedReply ++ ", Got this instead: " ++ show code ++ " " ++ show msg tryCommandNoFail :: Int -> SMTPConnection -> Command -> ReplyCode -> IO (ReplyCode, ByteString) tryCommandNoFail tries st cmd expectedReply = do (code, msg) <- sendCommand st cmd if code == expectedReply then return (code, msg) else if tries > 1 then tryCommandNoFail (tries - 1) st cmd expectedReply else return (code, msg) -- | Create an 'SMTPConnection' from an already connected Handle connectStream :: IO String -> Conn.Connection -> IO SMTPConnection connectStream getMailHostName st = do (code1, _) <- parseResponse st unless (code1 == 220) $ do Conn.connectionClose st fail "cannot connect to the server" senderHost <- getMailHostName (code, initialMsg) <- tryCommandNoFail 3 (SMTPC st []) (EHLO $ B8.pack senderHost) 250 if code == 250 then return (SMTPC st (tail $ B8.lines initialMsg)) else do -- EHLO failed, try HELO msg <- tryCommand 3 (SMTPC st []) (HELO $ B8.pack senderHost) 250 return (SMTPC st (tail $ B8.lines msg)) -- | 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 <- 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 sendCommand :: SMTPConnection -> Command -> IO (ReplyCode, ByteString) sendCommand (SMTPC conn _) (DATA dat) = do bsPutCrLf conn "DATA" (code, _) <- parseResponse conn unless (code == 354) $ fail "this server cannot accept any data." mapM_ sendLine $ split dat sendLine dot parseResponse conn where sendLine = bsPutCrLf conn split = map (padDot . stripCR) . B8.lines -- remove \r at the end of a line stripCR s = if cr `B8.isSuffixOf` s then B8.init s else s -- duplicate . at the start of a line padDot s = if dot `B8.isPrefixOf` s then dot <> s else s cr = B8.pack "\r" dot = B8.pack "." sendCommand (SMTPC conn _) (AUTH LOGIN username password) = do bsPutCrLf conn command _ <- parseResponse conn bsPutCrLf conn userB64 _ <- parseResponse conn bsPutCrLf conn passB64 (code, msg) <- parseResponse conn unless (code == 235) $ fail "authentication failed." return (code, msg) where command = "AUTH LOGIN" (userB64, passB64) = encodeLogin username password sendCommand (SMTPC conn _) (AUTH at username password) = do bsPutCrLf conn command (code, msg) <- parseResponse conn unless (code == 334) $ fail "authentication failed." bsPutCrLf conn $ auth at (B8.unpack msg) username password parseResponse conn where command = B8.pack $ unwords ["AUTH", show at] sendCommand (SMTPC conn _) meth = do bsPutCrLf conn command parseResponse conn where command = case meth of (HELO param) -> "HELO " <> param (EHLO param) -> "EHLO " <> param (MAIL param) -> "MAIL FROM:<" <> param <> ">" (RCPT param) -> "RCPT TO:<" <> param <> ">" (EXPN param) -> "EXPN " <> param (VRFY param) -> "VRFY " <> param (HELP msg) -> if B8.null msg then "HELP\r\n" else "HELP " <> msg NOOP -> "NOOP" RSET -> "RSET" QUIT -> "QUIT" STARTTLS -> "STARTTLS" DATA{} -> error "BUG: DATA pattern should be matched by sendCommand patterns" AUTH{} -> error "BUG: AUTH pattern should be matched by sendCommand patterns" -- | Send 'QUIT' and close the connection. closeSMTP :: SMTPConnection -> IO () closeSMTP c@(SMTPC conn _) = sendCommand c QUIT >> Conn.connectionClose conn -- | Sends a rendered mail to the server. sendRenderedMail :: ByteString -- ^ sender mail -> [ByteString] -- ^ receivers -> ByteString -- ^ data -> SMTPConnection -> IO () sendRenderedMail sender receivers dat conn = do _ <- tryOnce conn (MAIL sender) 250 mapM_ (\r -> tryOnce conn (RCPT r) 250) receivers _ <- tryOnce conn (DATA dat) 250 return () -- | Render a 'Mail' to a 'ByteString' then send it over the specified -- 'SMTPConnection' renderAndSend ::SMTPConnection -> Mail -> IO () renderAndSend conn mail@Mail{..} = do rendered <- lazyToStrict `fmap` renderMail' mail sendRenderedMail from to rendered conn where enc = encodeUtf8 . addressEmail from = enc mailFrom to = map enc $ mailTo ++ mailCc ++ mailBcc 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 = connectSMTP' host port >>= sendMailOnConnection mail -- | 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 = 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 = connectSMTP' host port >>= sendMailWithLoginIntern user pass mail -- | Send a 'Mail' with a given sender. sendMailWithSender :: ByteString -> HostName -> Mail -> IO () 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 = 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 -- | 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 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 ++ mailCc ++ mailBcc -- | A convenience function that sends 'AUTH' 'LOGIN' to the server login :: SMTPConnection -> UserName -> Password -> IO (ReplyCode, ByteString) login con user pass = sendCommand con (AUTH LOGIN user pass) -- | A simple interface for generating a 'Mail' with a plantext body and -- an optional HTML body. simpleMail :: Address -- ^ from -> [Address] -- ^ to -> [Address] -- ^ CC -> [Address] -- ^ BCC -> T.Text -- ^ subject -> [Part] -- ^ list of parts (list your preferred part last) -> Mail simpleMail from to cc bcc subject parts = Mail { mailFrom = from , mailTo = to , mailCc = cc , mailBcc = bcc , mailHeaders = [ ("Subject", subject) ] , mailParts = [parts] } -- | Construct a plain text 'Part' plainTextPart :: TL.Text -> Part 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 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 -> FilePath -- ^ path to file -> IO Part filePart ct fp = do content <- BL.readFile fp 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 crlf :: B8.ByteString crlf = B8.pack "\r\n" bsPutCrLf :: Conn.Connection -> ByteString -> IO () bsPutCrLf conn = Conn.connectionPut conn . flip B.append crlf smtp-mail-0.3.0.0/Network/Mail/SMTP/0000755000000000000000000000000007346545000015042 5ustar0000000000000000smtp-mail-0.3.0.0/Network/Mail/SMTP/Auth.hs0000644000000000000000000000354507346545000016306 0ustar0000000000000000module 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 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 = 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] encodeLogin :: UserName -> Password -> (ByteString, ByteString) encodeLogin 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 = 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 smtp-mail-0.3.0.0/Network/Mail/SMTP/Types.hs0000644000000000000000000000223607346545000016505 0ustar0000000000000000module Network.Mail.SMTP.Types ( Command(..), ReplyCode, Response(..), -- * Auth types (re-exports) UserName, Password, AuthType(..), -- * "Network.Mail.Mime" types (re-exports) Address(..), ) where import Network.Mail.SMTP.Auth import Data.ByteString (ByteString) import Network.Mail.Mime data Command = HELO ByteString | EHLO ByteString | MAIL ByteString | RCPT ByteString | DATA ByteString | EXPN ByteString | VRFY ByteString | HELP ByteString | AUTH AuthType UserName Password | NOOP | RSET | QUIT | STARTTLS deriving (Show, Eq) type ReplyCode = Int data Response = Ok | SystemStatus | HelpMessage | ServiceReady | ServiceClosing | UserNotLocal | CannotVerify | StartMailInput | ServiceNotAvailable | MailboxUnavailable | ErrorInProcessing | InsufficientSystemStorage | SyntaxError | ParameterError | CommandNotImplemented | BadSequence | ParameterNotImplemented | MailboxUnavailableError | UserNotLocalError | ExceededStorage | MailboxNotAllowed | TransactionFailed deriving (Show, Eq) smtp-mail-0.3.0.0/README.md0000755000000000000000000000442307346545000013231 0ustar0000000000000000SMTP-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 "

HTML

" 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/integration-test.nix` 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) and execute `nix-build nix-integration-test/integration-test.nix` to execute the test. Success is signalled by a return code of `0`. Unconveniently it can't be run via github actions or travis, as it needs kvm virtualization. smtp-mail-0.3.0.0/Setup.hs0000644000000000000000000000005607346545000013401 0ustar0000000000000000import Distribution.Simple main = defaultMain smtp-mail-0.3.0.0/smtp-mail.cabal0000644000000000000000000000232707346545000014637 0ustar0000000000000000name: smtp-mail version: 0.3.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/jhickner/smtp-mail license: BSD3 license-file: LICENSE author: Jason Hickner, Matt Parsons maintainer: parsonsmatt@gmail.com -- copyright: category: Network build-type: Simple cabal-version: >=1.10 extra-source-files: README.md , CHANGELOG.md source-repository head type: git location: git@github.com:jhickner/smtp-mail.git library default-language: Haskell2010 exposed-modules: Network.Mail.SMTP Network.Mail.SMTP.Auth Network.Mail.SMTP.Types -- other-modules: build-depends: base >= 4.5 && < 5 , array , base16-bytestring , base64-bytestring , bytestring , connection , filepath , mime-mail , network , network-bsd , text , cryptonite , memory ghc-options: -Wall -fwarn-tabs