smtp-mail-0.1.4.6/0000755000000000000000000000000013022124163011743 5ustar0000000000000000smtp-mail-0.1.4.6/smtp-mail.cabal0000644000000000000000000000210013022124163014623 0ustar0000000000000000-- 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 synopsis: Simple email sending via SMTP -- description: 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.8 source-repository head type: git location: git@github.com:jhickner/smtp-mail.git library 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 , cryptohash , filepath , mime-mail , network , text ghc-options: -Wall -fwarn-tabs smtp-mail-0.1.4.6/LICENSE0000644000000000000000000000300713022124163012750 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.1.4.6/Setup.hs0000644000000000000000000000005613022124163013400 0ustar0000000000000000import Distribution.Simple main = defaultMain smtp-mail-0.1.4.6/Network/0000755000000000000000000000000013022124163013374 5ustar0000000000000000smtp-mail-0.1.4.6/Network/Mail/0000755000000000000000000000000013022124163014256 5ustar0000000000000000smtp-mail-0.1.4.6/Network/Mail/SMTP.hs0000644000000000000000000002601513022124163015401 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-} module Network.Mail.SMTP ( -- * Main interface sendMail , sendMail' , sendMailWithLogin , sendMailWithLogin' , sendMailWithSender , sendMailWithSender' , 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 , connectSMTP' , connectSMTPWithHostName -- * Operation to a Connection , sendCommand , login , closeSMTP , renderAndSend , renderAndSendFrom ) where 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.BSD (getHostName) import Network.Mail.Mime hiding (htmlPart, simpleMail) 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 !Handle ![ByteString] instance Eq SMTPConnection where (==) (SMTPC a _) (SMTPC b _) = a == 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 port connectSMTP' :: HostName -- ^ name of the server -> PortNumber -- ^ port number -> IO SMTPConnection connectSMTP' hostname port = connectTo hostname (PortNumber port) >>= connectStream getHostName -- | 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 -- | 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 -> Handle -> IO SMTPConnection connectStream getMailHostName st = do (code1, _) <- parseResponse st unless (code1 == 220) $ do hClose 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)) parseResponse :: Handle -> IO (ReplyCode, ByteString) parseResponse st = 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]) -- | 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" 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 >> hClose 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 -- | 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 renderAndSend con mail closeSMTP con -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 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 -- | 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 = Part "text/plain; charset=utf-8" QuotedPrintableText Nothing [] . TL.encodeUtf8 -- | Construct an html 'Part' htmlPart :: TL.Text -> Part htmlPart = Part "text/html; charset=utf-8" QuotedPrintableText Nothing [] . TL.encodeUtf8 -- | 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 (Just $ T.pack (takeFileName fp)) [] content lazyToStrict :: BL.ByteString -> B.ByteString lazyToStrict = B.concat . BL.toChunks 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 smtp-mail-0.1.4.6/Network/Mail/SMTP/0000755000000000000000000000000013022124163015041 5ustar0000000000000000smtp-mail-0.1.4.6/Network/Mail/SMTP/Auth.hs0000644000000000000000000000411313022124163016275 0ustar0000000000000000module Network.Mail.SMTP.Auth ( UserName, Password, AuthType(..), encodeLogin, 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 (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 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.1.4.6/Network/Mail/SMTP/Types.hs0000644000000000000000000000221713022124163016503 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 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)