{-# 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
    == :: SMTPConnection -> SMTPConnection -> Bool
(==) (SMTPC a :: Connection
a _) (SMTPC b :: Connection
b _) = Connection -> ConnectionID
Conn.connectionID Connection
a ConnectionID -> ConnectionID -> Bool
forall a. Eq a => a -> a -> Bool
== Connection -> ConnectionID
Conn.connectionID Connection
b

-- | Connect to an SMTP server with the specified host and default port (25)
connectSMTP :: HostName     -- ^ name of the server
            -> IO SMTPConnection
connectSMTP :: HostName -> IO SMTPConnection
connectSMTP hostname :: HostName
hostname = HostName -> PortNumber -> IO SMTPConnection
connectSMTP' HostName
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 -> IO SMTPConnection
connectSMTPSTARTTLS hostname :: HostName
hostname = HostName -> PortNumber -> IO SMTPConnection
connectSMTPSTARTTLS' HostName
hostname 587

defaultTlsSettings :: Conn.TLSSettings
defaultTlsSettings :: TLSSettings
defaultTlsSettings =  Bool -> Bool -> Bool -> TLSSettings
Conn.TLSSettingsSimple Bool
False Bool
False Bool
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 -> IO SMTPConnection
connectSMTPS hostname :: HostName
hostname = 
    HostName -> PortNumber -> IO SMTPConnection
connectSMTPS' HostName
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 -> PortNumber -> IO SMTPConnection
connectSMTP' hostname :: HostName
hostname port :: PortNumber
port = HostName -> PortNumber -> IO HostName -> IO SMTPConnection
connectSMTPWithHostName HostName
hostname PortNumber
port IO HostName
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 -> PortNumber -> IO SMTPConnection
connectSMTPS' hostname :: HostName
hostname port :: PortNumber
port = HostName
-> PortNumber
-> IO HostName
-> Maybe TLSSettings
-> IO SMTPConnection
connectSMTPWithHostNameAndTlsSettings HostName
hostname PortNumber
port IO HostName
getHostName (TLSSettings -> Maybe TLSSettings
forall a. a -> Maybe a
Just TLSSettings
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 -> PortNumber -> IO SMTPConnection
connectSMTPSTARTTLS' hostname :: HostName
hostname port :: PortNumber
port = HostName
-> PortNumber -> IO HostName -> TLSSettings -> IO SMTPConnection
connectSMTPWithHostNameAndTlsSettingsSTARTTLS HostName
hostname PortNumber
port IO HostName
getHostName TLSSettings
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 -> PortNumber -> IO HostName -> IO SMTPConnection
connectSMTPWithHostName hostname :: HostName
hostname port :: PortNumber
port getMailHostName :: IO HostName
getMailHostName =
    HostName
-> PortNumber
-> IO HostName
-> Maybe TLSSettings
-> IO SMTPConnection
connectSMTPWithHostNameAndTlsSettings HostName
hostname PortNumber
port IO HostName
getMailHostName Maybe TLSSettings
forall a. Maybe a
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
-> PortNumber
-> IO HostName
-> Maybe TLSSettings
-> IO SMTPConnection
connectSMTPWithHostNameAndTlsSettings hostname :: HostName
hostname port :: PortNumber
port getMailHostName :: IO HostName
getMailHostName tlsSettings :: Maybe TLSSettings
tlsSettings = do
    ConnectionContext
context <- IO ConnectionContext
Conn.initConnectionContext
    ConnectionContext -> ConnectionParams -> IO Connection
Conn.connectTo ConnectionContext
context ConnectionParams
connParams IO Connection
-> (Connection -> IO SMTPConnection) -> IO SMTPConnection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO HostName -> Connection -> IO SMTPConnection
connectStream IO HostName
getMailHostName
  where
    connParams :: ConnectionParams
connParams = HostName
-> PortNumber
-> Maybe TLSSettings
-> Maybe ProxySettings
-> ConnectionParams
Conn.ConnectionParams HostName
hostname PortNumber
port Maybe TLSSettings
tlsSettings Maybe ProxySettings
forall a. Maybe a
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
-> PortNumber -> IO HostName -> TLSSettings -> IO SMTPConnection
connectSMTPWithHostNameAndTlsSettingsSTARTTLS hostname :: HostName
hostname port :: PortNumber
port getMailHostName :: IO HostName
getMailHostName tlsSettings :: TLSSettings
tlsSettings = do
     ConnectionContext
context <- IO ConnectionContext
Conn.initConnectionContext
     ConnectionContext -> ConnectionParams -> IO Connection
Conn.connectTo ConnectionContext
context ConnectionParams
connParams IO Connection
-> (Connection -> IO SMTPConnection) -> IO SMTPConnection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO HostName
-> ConnectionContext
-> TLSSettings
-> Connection
-> IO SMTPConnection
connectStreamSTARTTLS IO HostName
getMailHostName ConnectionContext
context TLSSettings
tlsSettings
   where 
     connParams :: ConnectionParams
connParams = HostName
-> PortNumber
-> Maybe TLSSettings
-> Maybe ProxySettings
-> ConnectionParams
Conn.ConnectionParams HostName
hostname PortNumber
port Maybe TLSSettings
forall a. Maybe a
Nothing Maybe ProxySettings
forall a. Maybe a
Nothing

-- | Attemp to send a 'Command' to the SMTP server once
tryOnce :: SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryOnce :: SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryOnce = ReplyCode
-> SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryCommand 1

-- | Repeatedly attempt to send a 'Command' to the SMTP server
tryCommand :: Int -> SMTPConnection -> Command -> ReplyCode
           -> IO ByteString
tryCommand :: ReplyCode
-> SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryCommand tries :: ReplyCode
tries st :: SMTPConnection
st cmd :: Command
cmd expectedReply :: ReplyCode
expectedReply = do
    (code :: ReplyCode
code, msg :: ByteString
msg) <- ReplyCode
-> SMTPConnection
-> Command
-> ReplyCode
-> IO (ReplyCode, ByteString)
tryCommandNoFail ReplyCode
tries SMTPConnection
st Command
cmd ReplyCode
expectedReply
    if ReplyCode
code ReplyCode -> ReplyCode -> Bool
forall a. Eq a => a -> a -> Bool
== ReplyCode
expectedReply
      then ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
msg
      else do
        SMTPConnection -> IO ()
closeSMTP SMTPConnection
st
        HostName -> IO ByteString
forall (m :: * -> *) a. MonadFail m => HostName -> m a
fail (HostName -> IO ByteString) -> HostName -> IO ByteString
forall a b. (a -> b) -> a -> b
$ "Unexpected reply to: " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ Command -> HostName
forall a. Show a => a -> HostName
show Command
cmd HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++
          ", Expected reply code: " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ ReplyCode -> HostName
forall a. Show a => a -> HostName
show ReplyCode
expectedReply HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++
          ", Got this instead: " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ ReplyCode -> HostName
forall a. Show a => a -> HostName
show ReplyCode
code HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ " " HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ ByteString -> HostName
forall a. Show a => a -> HostName
show ByteString
msg

tryCommandNoFail :: Int -> SMTPConnection -> Command -> ReplyCode
                 -> IO (ReplyCode, ByteString)
tryCommandNoFail :: ReplyCode
-> SMTPConnection
-> Command
-> ReplyCode
-> IO (ReplyCode, ByteString)
tryCommandNoFail tries :: ReplyCode
tries st :: SMTPConnection
st cmd :: Command
cmd expectedReply :: ReplyCode
expectedReply = do
  (code :: ReplyCode
code, msg :: ByteString
msg) <- SMTPConnection -> Command -> IO (ReplyCode, ByteString)
sendCommand SMTPConnection
st Command
cmd
  if ReplyCode
code ReplyCode -> ReplyCode -> Bool
forall a. Eq a => a -> a -> Bool
== ReplyCode
expectedReply
    then (ReplyCode, ByteString) -> IO (ReplyCode, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ReplyCode
code, ByteString
msg)
    else if ReplyCode
tries ReplyCode -> ReplyCode -> Bool
forall a. Ord a => a -> a -> Bool
> 1
      then ReplyCode
-> SMTPConnection
-> Command
-> ReplyCode
-> IO (ReplyCode, ByteString)
tryCommandNoFail (ReplyCode
tries ReplyCode -> ReplyCode -> ReplyCode
forall a. Num a => a -> a -> a
- 1) SMTPConnection
st Command
cmd ReplyCode
expectedReply
      else (ReplyCode, ByteString) -> IO (ReplyCode, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ReplyCode
code, ByteString
msg)

-- | Create an 'SMTPConnection' from an already connected Handle
connectStream :: IO String -> Conn.Connection -> IO SMTPConnection
connectStream :: IO HostName -> Connection -> IO SMTPConnection
connectStream getMailHostName :: IO HostName
getMailHostName st :: Connection
st = do
    (code1 :: ReplyCode
code1, _) <- Connection -> IO (ReplyCode, ByteString)
parseResponse Connection
st
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ReplyCode
code1 ReplyCode -> ReplyCode -> Bool
forall a. Eq a => a -> a -> Bool
== 220) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Connection -> IO ()
Conn.connectionClose Connection
st
        HostName -> IO ()
forall (m :: * -> *) a. MonadFail m => HostName -> m a
fail "cannot connect to the server"
    HostName
senderHost <- IO HostName
getMailHostName
    (code :: ReplyCode
code, initialMsg :: ByteString
initialMsg) <- ReplyCode
-> SMTPConnection
-> Command
-> ReplyCode
-> IO (ReplyCode, ByteString)
tryCommandNoFail 3 (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st []) (ByteString -> Command
EHLO (ByteString -> Command) -> ByteString -> Command
forall a b. (a -> b) -> a -> b
$ HostName -> ByteString
B8.pack HostName
senderHost) 250
    if ReplyCode
code ReplyCode -> ReplyCode -> Bool
forall a. Eq a => a -> a -> Bool
== 250
      then SMTPConnection -> IO SMTPConnection
forall (m :: * -> *) a. Monad m => a -> m a
return (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st ([ByteString] -> [ByteString]
forall a. [a] -> [a]
tail ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
B8.lines ByteString
initialMsg))
      else do -- EHLO failed, try HELO
        ByteString
msg <- ReplyCode
-> SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryCommand 3 (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st []) (ByteString -> Command
HELO (ByteString -> Command) -> ByteString -> Command
forall a b. (a -> b) -> a -> b
$ HostName -> ByteString
B8.pack HostName
senderHost) 250
        SMTPConnection -> IO SMTPConnection
forall (m :: * -> *) a. Monad m => a -> m a
return (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st ([ByteString] -> [ByteString]
forall a. [a] -> [a]
tail ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
B8.lines ByteString
msg))

-- | Create an 'SMTPConnection' from an already connected Handle using STARTTLS
connectStreamSTARTTLS :: IO String -> Conn.ConnectionContext -> Conn.TLSSettings -> Conn.Connection -> IO SMTPConnection
connectStreamSTARTTLS :: IO HostName
-> ConnectionContext
-> TLSSettings
-> Connection
-> IO SMTPConnection
connectStreamSTARTTLS getMailHostName :: IO HostName
getMailHostName context :: ConnectionContext
context tlsSettings :: TLSSettings
tlsSettings st :: Connection
st = do
    (code1 :: ReplyCode
code1, _) <- Connection -> IO (ReplyCode, ByteString)
parseResponse Connection
st
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ReplyCode
code1 ReplyCode -> ReplyCode -> Bool
forall a. Eq a => a -> a -> Bool
== 220) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Connection -> IO ()
Conn.connectionClose Connection
st
        HostName -> IO ()
forall (m :: * -> *) a. MonadFail m => HostName -> m a
fail "cannot connect to the server"
    HostName
senderHost <- IO HostName
getMailHostName
    ByteString
_ <- ReplyCode
-> SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryCommand 3 (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st []) (ByteString -> Command
EHLO (ByteString -> Command) -> ByteString -> Command
forall a b. (a -> b) -> a -> b
$ HostName -> ByteString
B8.pack HostName
senderHost) 250
    ByteString
_ <- ReplyCode
-> SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryCommand 1 (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st []) Command
STARTTLS 220
    ()
_ <- ConnectionContext -> Connection -> TLSSettings -> IO ()
Conn.connectionSetSecure ConnectionContext
context Connection
st TLSSettings
tlsSettings
    ByteString
msg <- ReplyCode
-> SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryCommand 1 (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st []) (ByteString -> Command
EHLO (ByteString -> Command) -> ByteString -> Command
forall a b. (a -> b) -> a -> b
$ HostName -> ByteString
B8.pack HostName
senderHost) 250
    SMTPConnection -> IO SMTPConnection
forall (m :: * -> *) a. Monad m => a -> m a
return (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st ([ByteString] -> [ByteString]
forall a. [a] -> [a]
tail ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
B8.lines ByteString
msg))

parseResponse :: Conn.Connection -> IO (ReplyCode, ByteString)
parseResponse :: Connection -> IO (ReplyCode, ByteString)
parseResponse conn :: Connection
conn = do
    (code :: ByteString
code, bdy :: [ByteString]
bdy) <- IO (ByteString, [ByteString])
readLines
    (ReplyCode, ByteString) -> IO (ReplyCode, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (HostName -> ReplyCode
forall a. Read a => HostName -> a
read (HostName -> ReplyCode) -> HostName -> ReplyCode
forall a b. (a -> b) -> a -> b
$ ByteString -> HostName
B8.unpack ByteString
code, [ByteString] -> ByteString
B8.unlines [ByteString]
bdy)
  where
    readLines :: IO (ByteString, [ByteString])
readLines = do
      ByteString
l <- ReplyCode -> Connection -> IO ByteString
Conn.connectionGetLine 1000 Connection
conn
      let (c :: ByteString
c, bdy :: ByteString
bdy) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
B8.span Char -> Bool
isDigit ByteString
l
      if Bool -> Bool
not (ByteString -> Bool
B8.null ByteString
bdy) Bool -> Bool -> Bool
&& ByteString -> Char
B8.head ByteString
bdy Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-'
         then do (c2 :: ByteString
c2, ls :: [ByteString]
ls) <- IO (ByteString, [ByteString])
readLines
                 (ByteString, [ByteString]) -> IO (ByteString, [ByteString])
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
c2, ByteString -> ByteString
B8.tail ByteString
bdyByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
ls)
         else (ByteString, [ByteString]) -> IO (ByteString, [ByteString])
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
c, [ByteString -> ByteString
B8.tail ByteString
bdy])


-- | Send a 'Command' to the SMTP server
sendCommand :: SMTPConnection -> Command -> IO (ReplyCode, ByteString)

sendCommand :: SMTPConnection -> Command -> IO (ReplyCode, ByteString)
sendCommand (SMTPC conn :: Connection
conn _) (DATA dat :: ByteString
dat) = do
    Connection -> ByteString -> IO ()
bsPutCrLf Connection
conn "DATA"
    (code :: ReplyCode
code, _) <- Connection -> IO (ReplyCode, ByteString)
parseResponse Connection
conn
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ReplyCode
code ReplyCode -> ReplyCode -> Bool
forall a. Eq a => a -> a -> Bool
== 354) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HostName -> IO ()
forall (m :: * -> *) a. MonadFail m => HostName -> m a
fail "this server cannot accept any data."
    (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> IO ()
sendLine ([ByteString] -> IO ()) -> [ByteString] -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
split ByteString
dat
    ByteString -> IO ()
sendLine ByteString
dot
    Connection -> IO (ReplyCode, ByteString)
parseResponse Connection
conn
  where
    sendLine :: ByteString -> IO ()
sendLine = Connection -> ByteString -> IO ()
bsPutCrLf Connection
conn
    split :: ByteString -> [ByteString]
split = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> ByteString
padDot (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
stripCR) ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B8.lines
    -- remove \r at the end of a line
    stripCR :: ByteString -> ByteString
stripCR s :: ByteString
s = if ByteString
cr ByteString -> ByteString -> Bool
`B8.isSuffixOf` ByteString
s then ByteString -> ByteString
B8.init ByteString
s else ByteString
s
    -- duplicate . at the start of a line
    padDot :: ByteString -> ByteString
padDot s :: ByteString
s = if ByteString
dot ByteString -> ByteString -> Bool
`B8.isPrefixOf` ByteString
s then ByteString
dot ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
s else ByteString
s
    cr :: ByteString
cr = HostName -> ByteString
B8.pack "\r"
    dot :: ByteString
dot = HostName -> ByteString
B8.pack "."

sendCommand (SMTPC conn :: Connection
conn _) (AUTH LOGIN username :: HostName
username password :: HostName
password) = do
    Connection -> ByteString -> IO ()
bsPutCrLf Connection
conn ByteString
command
    (ReplyCode, ByteString)
_ <- Connection -> IO (ReplyCode, ByteString)
parseResponse Connection
conn
    Connection -> ByteString -> IO ()
bsPutCrLf Connection
conn ByteString
userB64
    (ReplyCode, ByteString)
_ <- Connection -> IO (ReplyCode, ByteString)
parseResponse Connection
conn
    Connection -> ByteString -> IO ()
bsPutCrLf Connection
conn ByteString
passB64
    (code :: ReplyCode
code, msg :: ByteString
msg) <- Connection -> IO (ReplyCode, ByteString)
parseResponse Connection
conn
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ReplyCode
code ReplyCode -> ReplyCode -> Bool
forall a. Eq a => a -> a -> Bool
== 235) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HostName -> IO ()
forall (m :: * -> *) a. MonadFail m => HostName -> m a
fail "authentication failed."
    (ReplyCode, ByteString) -> IO (ReplyCode, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ReplyCode
code, ByteString
msg)
  where
    command :: ByteString
command = "AUTH LOGIN"
    (userB64 :: ByteString
userB64, passB64 :: ByteString
passB64) = HostName -> HostName -> (ByteString, ByteString)
encodeLogin HostName
username HostName
password

sendCommand (SMTPC conn :: Connection
conn _) (AUTH at :: AuthType
at username :: HostName
username password :: HostName
password) = do
    Connection -> ByteString -> IO ()
bsPutCrLf Connection
conn ByteString
command
    (code :: ReplyCode
code, msg :: ByteString
msg) <- Connection -> IO (ReplyCode, ByteString)
parseResponse Connection
conn
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ReplyCode
code ReplyCode -> ReplyCode -> Bool
forall a. Eq a => a -> a -> Bool
== 334) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HostName -> IO ()
forall (m :: * -> *) a. MonadFail m => HostName -> m a
fail "authentication failed."
    Connection -> ByteString -> IO ()
bsPutCrLf Connection
conn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ AuthType -> HostName -> HostName -> HostName -> ByteString
auth AuthType
at (ByteString -> HostName
B8.unpack ByteString
msg) HostName
username HostName
password
    Connection -> IO (ReplyCode, ByteString)
parseResponse Connection
conn
  where
    command :: ByteString
command = HostName -> ByteString
B8.pack (HostName -> ByteString) -> HostName -> ByteString
forall a b. (a -> b) -> a -> b
$ [HostName] -> HostName
unwords ["AUTH", AuthType -> HostName
forall a. Show a => a -> HostName
show AuthType
at]

sendCommand (SMTPC conn :: Connection
conn _) meth :: Command
meth = do
    Connection -> ByteString -> IO ()
bsPutCrLf Connection
conn ByteString
command
    Connection -> IO (ReplyCode, ByteString)
parseResponse Connection
conn
  where
    command :: ByteString
command = case Command
meth of
        (HELO param :: ByteString
param) -> "HELO " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
param
        (EHLO param :: ByteString
param) -> "EHLO " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
param
        (MAIL param :: ByteString
param) -> "MAIL FROM:<" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
param ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ">"
        (RCPT param :: ByteString
param) -> "RCPT TO:<" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
param ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ">"
        (EXPN param :: ByteString
param) -> "EXPN " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
param
        (VRFY param :: ByteString
param) -> "VRFY " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
param
        (HELP msg :: ByteString
msg)   -> if ByteString -> Bool
B8.null ByteString
msg
                          then "HELP\r\n"
                          else "HELP " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
msg
        NOOP         -> "NOOP"
        RSET         -> "RSET"
        QUIT         -> "QUIT"
        STARTTLS     -> "STARTTLS"
        DATA{}       ->
            HostName -> ByteString
forall a. HasCallStack => HostName -> a
error "BUG: DATA pattern should be matched by sendCommand patterns"
        AUTH{}       ->
            HostName -> ByteString
forall a. HasCallStack => HostName -> a
error "BUG: AUTH pattern should be matched by sendCommand patterns"


-- | Send 'QUIT' and close the connection.
closeSMTP :: SMTPConnection -> IO ()
closeSMTP :: SMTPConnection -> IO ()
closeSMTP c :: SMTPConnection
c@(SMTPC conn :: Connection
conn _) = SMTPConnection -> Command -> IO (ReplyCode, ByteString)
sendCommand SMTPConnection
c Command
QUIT IO (ReplyCode, ByteString) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Connection -> IO ()
Conn.connectionClose Connection
conn

-- | Sends a rendered mail to the server.
sendRenderedMail :: ByteString   -- ^ sender mail
            -> [ByteString] -- ^ receivers
            -> ByteString   -- ^ data
            -> SMTPConnection
            -> IO ()
sendRenderedMail :: ByteString -> [ByteString] -> ByteString -> SMTPConnection -> IO ()
sendRenderedMail sender :: ByteString
sender receivers :: [ByteString]
receivers dat :: ByteString
dat conn :: SMTPConnection
conn = do
    ByteString
_ <- SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryOnce SMTPConnection
conn (ByteString -> Command
MAIL ByteString
sender) 250
    (ByteString -> IO ByteString) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\r :: ByteString
r -> SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryOnce SMTPConnection
conn (ByteString -> Command
RCPT ByteString
r) 250) [ByteString]
receivers
    ByteString
_ <- SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryOnce SMTPConnection
conn (ByteString -> Command
DATA ByteString
dat) 250
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Render a 'Mail' to a 'ByteString' then send it over the specified
-- 'SMTPConnection'
renderAndSend ::SMTPConnection -> Mail -> IO ()
renderAndSend :: SMTPConnection -> Mail -> IO ()
renderAndSend conn :: SMTPConnection
conn mail :: Mail
mail@Mail{..} = do
    ByteString
rendered <- ByteString -> ByteString
lazyToStrict (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Mail -> IO ByteString
renderMail' Mail
mail
    ByteString -> [ByteString] -> ByteString -> SMTPConnection -> IO ()
sendRenderedMail ByteString
from [ByteString]
to ByteString
rendered SMTPConnection
conn
  where enc :: Address -> ByteString
enc  = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (Address -> Text) -> Address -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Text
addressEmail
        from :: ByteString
from = Address -> ByteString
enc Address
mailFrom
        to :: [ByteString]
to   = (Address -> ByteString) -> [Address] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Address -> ByteString
enc ([Address] -> [ByteString]) -> [Address] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [Address]
mailTo [Address] -> [Address] -> [Address]
forall a. [a] -> [a] -> [a]
++ [Address]
mailCc [Address] -> [Address] -> [Address]
forall a. [a] -> [a] -> [a]
++ [Address]
mailBcc

sendMailOnConnection :: Mail -> SMTPConnection -> IO ()
sendMailOnConnection :: Mail -> SMTPConnection -> IO ()
sendMailOnConnection mail :: Mail
mail con :: SMTPConnection
con = do
  SMTPConnection -> Mail -> IO ()
renderAndSend SMTPConnection
con Mail
mail
  SMTPConnection -> IO ()
closeSMTP SMTPConnection
con

-- | Connect to an SMTP server, send a 'Mail', then disconnect. Uses the default port (25).
sendMail :: HostName -> Mail -> IO ()
sendMail :: HostName -> Mail -> IO ()
sendMail host :: HostName
host mail :: Mail
mail = HostName -> IO SMTPConnection
connectSMTP HostName
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Mail -> SMTPConnection -> IO ()
sendMailOnConnection Mail
mail

-- | Connect to an SMTP server, send a 'Mail', then disconnect.
sendMail' :: HostName -> PortNumber -> Mail -> IO ()
sendMail' :: HostName -> PortNumber -> Mail -> IO ()
sendMail' host :: HostName
host port :: PortNumber
port mail :: Mail
mail = HostName -> PortNumber -> IO SMTPConnection
connectSMTP' HostName
host PortNumber
port IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Mail -> SMTPConnection -> IO ()
sendMailOnConnection Mail
mail

-- | Connect to an SMTP server, login, send a 'Mail', disconnect. Uses the default port (25).
sendMailWithLogin :: HostName -> UserName -> Password -> Mail -> IO ()
sendMailWithLogin :: HostName -> HostName -> HostName -> Mail -> IO ()
sendMailWithLogin host :: HostName
host user :: HostName
user pass :: HostName
pass mail :: Mail
mail = HostName -> IO SMTPConnection
connectSMTP HostName
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HostName -> HostName -> Mail -> SMTPConnection -> IO ()
sendMailWithLoginIntern HostName
user HostName
pass Mail
mail

-- | Connect to an SMTP server, login, send a 'Mail', disconnect.
sendMailWithLogin' :: HostName -> PortNumber -> UserName -> Password -> Mail -> IO ()
sendMailWithLogin' :: HostName -> PortNumber -> HostName -> HostName -> Mail -> IO ()
sendMailWithLogin' host :: HostName
host port :: PortNumber
port user :: HostName
user pass :: HostName
pass mail :: Mail
mail = HostName -> PortNumber -> IO SMTPConnection
connectSMTP' HostName
host PortNumber
port IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HostName -> HostName -> Mail -> SMTPConnection -> IO ()
sendMailWithLoginIntern HostName
user HostName
pass Mail
mail

-- | Send a 'Mail' with a given sender.
sendMailWithSender :: ByteString -> HostName -> Mail -> IO ()
sendMailWithSender :: ByteString -> HostName -> Mail -> IO ()
sendMailWithSender sender :: ByteString
sender host :: HostName
host mail :: Mail
mail = HostName -> IO SMTPConnection
connectSMTP HostName
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Mail -> SMTPConnection -> IO ()
sendMailWithSenderIntern ByteString
sender Mail
mail

-- | Send a 'Mail' with a given sender.
sendMailWithSender' :: ByteString -> HostName -> PortNumber -> Mail -> IO ()
sendMailWithSender' :: ByteString -> HostName -> PortNumber -> Mail -> IO ()
sendMailWithSender' sender :: ByteString
sender host :: HostName
host port :: PortNumber
port mail :: Mail
mail = HostName -> PortNumber -> IO SMTPConnection
connectSMTP' HostName
host PortNumber
port IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Mail -> SMTPConnection -> IO ()
sendMailWithSenderIntern ByteString
sender Mail
mail

-- | Connect to an SMTP server, send a 'Mail', then disconnect. Uses SMTPS with the default port (465).
sendMailTLS :: HostName -> Mail -> IO ()
sendMailTLS :: HostName -> Mail -> IO ()
sendMailTLS host :: HostName
host mail :: Mail
mail = HostName -> IO SMTPConnection
connectSMTPS HostName
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Mail -> SMTPConnection -> IO ()
sendMailOnConnection Mail
mail

-- | Connect to an SMTP server, send a 'Mail', then disconnect. Uses SMTPS.
sendMailTLS' :: HostName -> PortNumber -> Mail -> IO ()
sendMailTLS' :: HostName -> PortNumber -> Mail -> IO ()
sendMailTLS' host :: HostName
host port :: PortNumber
port mail :: Mail
mail = HostName -> PortNumber -> IO SMTPConnection
connectSMTPS' HostName
host PortNumber
port IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Mail -> SMTPConnection -> IO ()
sendMailOnConnection Mail
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 :: HostName -> HostName -> HostName -> Mail -> IO ()
sendMailWithLoginTLS host :: HostName
host user :: HostName
user pass :: HostName
pass mail :: Mail
mail = HostName -> IO SMTPConnection
connectSMTPS HostName
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HostName -> HostName -> Mail -> SMTPConnection -> IO ()
sendMailWithLoginIntern HostName
user HostName
pass Mail
mail

-- | Connect to an SMTP server, login, send a 'Mail', disconnect. Uses SMTPS.
sendMailWithLoginTLS' :: HostName -> PortNumber -> UserName -> Password -> Mail -> IO ()
sendMailWithLoginTLS' :: HostName -> PortNumber -> HostName -> HostName -> Mail -> IO ()
sendMailWithLoginTLS' host :: HostName
host port :: PortNumber
port user :: HostName
user pass :: HostName
pass mail :: Mail
mail = HostName -> PortNumber -> IO SMTPConnection
connectSMTPS' HostName
host PortNumber
port IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HostName -> HostName -> Mail -> SMTPConnection -> IO ()
sendMailWithLoginIntern HostName
user HostName
pass Mail
mail

-- | Send a 'Mail' with a given sender. Uses SMTPS with its default port (465).
sendMailWithSenderTLS :: ByteString -> HostName -> Mail -> IO ()
sendMailWithSenderTLS :: ByteString -> HostName -> Mail -> IO ()
sendMailWithSenderTLS sender :: ByteString
sender host :: HostName
host mail :: Mail
mail = HostName -> IO SMTPConnection
connectSMTPS HostName
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Mail -> SMTPConnection -> IO ()
sendMailWithSenderIntern ByteString
sender Mail
mail

-- | Send a 'Mail' with a given sender. Uses SMTPS.
sendMailWithSenderTLS' :: ByteString -> HostName -> PortNumber -> Mail -> IO ()
sendMailWithSenderTLS' :: ByteString -> HostName -> PortNumber -> Mail -> IO ()
sendMailWithSenderTLS' sender :: ByteString
sender host :: HostName
host port :: PortNumber
port mail :: Mail
mail = HostName -> PortNumber -> IO SMTPConnection
connectSMTPS' HostName
host PortNumber
port IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Mail -> SMTPConnection -> IO ()
sendMailWithSenderIntern ByteString
sender Mail
mail

-- | Connect to an SMTP server, send a 'Mail', then disconnect. Uses STARTTLS with the default port (587).
sendMailSTARTTLS :: HostName -> Mail -> IO ()
sendMailSTARTTLS :: HostName -> Mail -> IO ()
sendMailSTARTTLS host :: HostName
host mail :: Mail
mail = HostName -> IO SMTPConnection
connectSMTPSTARTTLS HostName
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Mail -> SMTPConnection -> IO ()
sendMailOnConnection Mail
mail

-- | Connect to an SMTP server, send a 'Mail', then disconnect. Uses STARTTLS.
sendMailSTARTTLS' :: HostName -> PortNumber -> Mail -> IO ()
sendMailSTARTTLS' :: HostName -> PortNumber -> Mail -> IO ()
sendMailSTARTTLS' host :: HostName
host port :: PortNumber
port mail :: Mail
mail = HostName -> PortNumber -> IO SMTPConnection
connectSMTPSTARTTLS' HostName
host PortNumber
port IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Mail -> SMTPConnection -> IO ()
sendMailOnConnection Mail
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 :: HostName -> HostName -> HostName -> Mail -> IO ()
sendMailWithLoginSTARTTLS host :: HostName
host user :: HostName
user pass :: HostName
pass mail :: Mail
mail = HostName -> IO SMTPConnection
connectSMTPSTARTTLS HostName
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HostName -> HostName -> Mail -> SMTPConnection -> IO ()
sendMailWithLoginIntern HostName
user HostName
pass Mail
mail

-- | Connect to an SMTP server, login, send a 'Mail', disconnect. Uses STARTTLS.
sendMailWithLoginSTARTTLS' :: HostName -> PortNumber -> UserName -> Password -> Mail -> IO ()
sendMailWithLoginSTARTTLS' :: HostName -> PortNumber -> HostName -> HostName -> Mail -> IO ()
sendMailWithLoginSTARTTLS' host :: HostName
host port :: PortNumber
port user :: HostName
user pass :: HostName
pass mail :: Mail
mail = HostName -> PortNumber -> IO SMTPConnection
connectSMTPSTARTTLS' HostName
host PortNumber
port IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HostName -> HostName -> Mail -> SMTPConnection -> IO ()
sendMailWithLoginIntern HostName
user HostName
pass Mail
mail

-- | Send a 'Mail' with a given sender. Uses STARTTLS with the default port (587).
sendMailWithSenderSTARTTLS :: ByteString -> HostName -> Mail -> IO ()
sendMailWithSenderSTARTTLS :: ByteString -> HostName -> Mail -> IO ()
sendMailWithSenderSTARTTLS sender :: ByteString
sender host :: HostName
host mail :: Mail
mail = HostName -> IO SMTPConnection
connectSMTPSTARTTLS HostName
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Mail -> SMTPConnection -> IO ()
sendMailWithSenderIntern ByteString
sender Mail
mail

-- | Send a 'Mail' with a given sender. Uses STARTTLS.
sendMailWithSenderSTARTTLS' :: ByteString -> HostName -> PortNumber -> Mail -> IO ()
sendMailWithSenderSTARTTLS' :: ByteString -> HostName -> PortNumber -> Mail -> IO ()
sendMailWithSenderSTARTTLS' sender :: ByteString
sender host :: HostName
host port :: PortNumber
port mail :: Mail
mail = HostName -> PortNumber -> IO SMTPConnection
connectSMTPSTARTTLS' HostName
host PortNumber
port IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Mail -> SMTPConnection -> IO ()
sendMailWithSenderIntern ByteString
sender Mail
mail

sendMailWithLoginIntern :: UserName -> Password -> Mail -> SMTPConnection -> IO ()
sendMailWithLoginIntern :: HostName -> HostName -> Mail -> SMTPConnection -> IO ()
sendMailWithLoginIntern user :: HostName
user pass :: HostName
pass mail :: Mail
mail con :: SMTPConnection
con = do
  (ReplyCode, ByteString)
_ <- SMTPConnection -> Command -> IO (ReplyCode, ByteString)
sendCommand SMTPConnection
con (AuthType -> HostName -> HostName -> Command
AUTH AuthType
LOGIN HostName
user HostName
pass)
  SMTPConnection -> Mail -> IO ()
renderAndSend SMTPConnection
con Mail
mail
  SMTPConnection -> IO ()
closeSMTP SMTPConnection
con

sendMailWithSenderIntern :: ByteString -> Mail -> SMTPConnection -> IO ()
sendMailWithSenderIntern :: ByteString -> Mail -> SMTPConnection -> IO ()
sendMailWithSenderIntern sender :: ByteString
sender mail :: Mail
mail con :: SMTPConnection
con = do
  ByteString -> SMTPConnection -> Mail -> IO ()
renderAndSendFrom ByteString
sender SMTPConnection
con Mail
mail
  SMTPConnection -> IO ()
closeSMTP SMTPConnection
con

renderAndSendFrom :: ByteString -> SMTPConnection -> Mail -> IO ()
renderAndSendFrom :: ByteString -> SMTPConnection -> Mail -> IO ()
renderAndSendFrom sender :: ByteString
sender conn :: SMTPConnection
conn mail :: Mail
mail@Mail{..} = do
    ByteString
rendered <- ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Mail -> IO ByteString
renderMail' Mail
mail
    ByteString -> [ByteString] -> ByteString -> SMTPConnection -> IO ()
sendRenderedMail ByteString
sender [ByteString]
to ByteString
rendered SMTPConnection
conn
  where enc :: Address -> ByteString
enc  = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (Address -> Text) -> Address -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Text
addressEmail
        to :: [ByteString]
to   = (Address -> ByteString) -> [Address] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Address -> ByteString
enc ([Address] -> [ByteString]) -> [Address] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [Address]
mailTo [Address] -> [Address] -> [Address]
forall a. [a] -> [a] -> [a]
++ [Address]
mailCc [Address] -> [Address] -> [Address]
forall a. [a] -> [a] -> [a]
++ [Address]
mailBcc

-- | A convenience function that sends 'AUTH' 'LOGIN' to the server
login :: SMTPConnection -> UserName -> Password -> IO (ReplyCode, ByteString)
login :: SMTPConnection
-> HostName -> HostName -> IO (ReplyCode, ByteString)
login con :: SMTPConnection
con user :: HostName
user pass :: HostName
pass = SMTPConnection -> Command -> IO (ReplyCode, ByteString)
sendCommand SMTPConnection
con (AuthType -> HostName -> HostName -> Command
AUTH AuthType
LOGIN HostName
user HostName
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 :: Address
-> [Address]
-> [Address]
-> [Address]
-> Text
-> Alternatives
-> Mail
simpleMail from :: Address
from to :: [Address]
to cc :: [Address]
cc bcc :: [Address]
bcc subject :: Text
subject parts :: Alternatives
parts =
    Mail :: Address
-> [Address]
-> [Address]
-> [Address]
-> Headers
-> [Alternatives]
-> Mail
Mail { mailFrom :: Address
mailFrom = Address
from
         , mailTo :: [Address]
mailTo   = [Address]
to
         , mailCc :: [Address]
mailCc   = [Address]
cc
         , mailBcc :: [Address]
mailBcc  = [Address]
bcc
         , mailHeaders :: Headers
mailHeaders = [ ("Subject", Text
subject) ]
         , mailParts :: [Alternatives]
mailParts = [Alternatives
parts]
         }

-- | Construct a plain text 'Part'
plainTextPart :: TL.Text -> Part
plainTextPart :: Text -> Part
plainTextPart body :: Text
body = Text -> Encoding -> Disposition -> Headers -> PartContent -> Part
Part "text/plain; charset=utf-8"
              Encoding
QuotedPrintableText Disposition
DefaultDisposition [] (ByteString -> PartContent
PartContent (ByteString -> PartContent) -> ByteString -> PartContent
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TL.encodeUtf8 Text
body)
{-# DEPRECATED plainTextPart "Use plainPart from mime-mail package" #-}

-- | Construct an html 'Part'
htmlPart :: TL.Text -> Part
htmlPart :: Text -> Part
htmlPart body :: Text
body = Text -> Encoding -> Disposition -> Headers -> PartContent -> Part
Part "text/html; charset=utf-8"
             Encoding
QuotedPrintableText Disposition
DefaultDisposition [] (ByteString -> PartContent
PartContent (ByteString -> PartContent) -> ByteString -> PartContent
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TL.encodeUtf8 Text
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 :: Text -> HostName -> IO Part
filePart ct :: Text
ct fp :: HostName
fp = do
    ByteString
content <- HostName -> IO ByteString
BL.readFile HostName
fp
    Part -> IO Part
forall (m :: * -> *) a. Monad m => a -> m a
return (Part -> IO Part) -> Part -> IO Part
forall a b. (a -> b) -> a -> b
$ Text -> Encoding -> Disposition -> Headers -> PartContent -> Part
Part Text
ct Encoding
Base64 (Text -> Disposition
AttachmentDisposition (Text -> Disposition) -> Text -> Disposition
forall a b. (a -> b) -> a -> b
$ HostName -> Text
T.pack (HostName -> HostName
takeFileName HostName
fp)) [] (ByteString -> PartContent
PartContent ByteString
content)
{-# DEPRECATED filePart "Use filePart from mime-mail package" #-}

lazyToStrict :: BL.ByteString -> B.ByteString
lazyToStrict :: ByteString -> ByteString
lazyToStrict = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks

crlf :: B8.ByteString
crlf :: ByteString
crlf = HostName -> ByteString
B8.pack "\r\n"

bsPutCrLf :: Conn.Connection -> ByteString -> IO ()
bsPutCrLf :: Connection -> ByteString -> IO ()
bsPutCrLf conn :: Connection
conn = Connection -> ByteString -> IO ()
Conn.connectionPut Connection
conn (ByteString -> IO ())
-> (ByteString -> ByteString) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> ByteString)
-> ByteString -> ByteString -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> ByteString -> ByteString
B.append ByteString
crlf