{-# 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

import Data.Default.Class (def)

data SMTPConnection = SMTPC !Conn.Connection ![ByteString]

instance Eq SMTPConnection where
    == :: SMTPConnection -> SMTPConnection -> Bool
(==) (SMTPC Connection
a [ByteString]
_) (SMTPC Connection
b [ByteString]
_) = 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 :: [Char] -> IO SMTPConnection
connectSMTP [Char]
hostname = [Char] -> PortNumber -> IO SMTPConnection
connectSMTP' [Char]
hostname PortNumber
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 :: [Char] -> IO SMTPConnection
connectSMTPSTARTTLS [Char]
hostname = [Char] -> PortNumber -> IO SMTPConnection
connectSMTPSTARTTLS' [Char]
hostname PortNumber
587

defaultTlsSettings :: Conn.TLSSettings
defaultTlsSettings :: TLSSettings
defaultTlsSettings =  TLSSettings
forall a. Default a => a
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 :: [Char] -> IO SMTPConnection
connectSMTPS [Char]
hostname = 
    [Char] -> PortNumber -> IO SMTPConnection
connectSMTPS' [Char]
hostname PortNumber
465

-- | Connect to an SMTP server with the specified host and port
connectSMTP' :: HostName     -- ^ name of the server
             -> PortNumber -- ^ port number
             -> IO SMTPConnection
connectSMTP' :: [Char] -> PortNumber -> IO SMTPConnection
connectSMTP' [Char]
hostname PortNumber
port = [Char] -> PortNumber -> IO [Char] -> IO SMTPConnection
connectSMTPWithHostName [Char]
hostname PortNumber
port IO [Char]
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' :: [Char] -> PortNumber -> IO SMTPConnection
connectSMTPS' [Char]
hostname PortNumber
port = [Char]
-> PortNumber
-> IO [Char]
-> Maybe TLSSettings
-> IO SMTPConnection
connectSMTPWithHostNameAndTlsSettings [Char]
hostname PortNumber
port IO [Char]
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' :: [Char] -> PortNumber -> IO SMTPConnection
connectSMTPSTARTTLS' [Char]
hostname PortNumber
port = [Char]
-> PortNumber -> IO [Char] -> TLSSettings -> IO SMTPConnection
connectSMTPWithHostNameAndTlsSettingsSTARTTLS [Char]
hostname PortNumber
port IO [Char]
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 :: [Char] -> PortNumber -> IO [Char] -> IO SMTPConnection
connectSMTPWithHostName [Char]
hostname PortNumber
port IO [Char]
getMailHostName =
    [Char]
-> PortNumber
-> IO [Char]
-> Maybe TLSSettings
-> IO SMTPConnection
connectSMTPWithHostNameAndTlsSettings [Char]
hostname PortNumber
port IO [Char]
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 :: [Char]
-> PortNumber
-> IO [Char]
-> Maybe TLSSettings
-> IO SMTPConnection
connectSMTPWithHostNameAndTlsSettings [Char]
hostname PortNumber
port IO [Char]
getMailHostName 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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO [Char] -> Connection -> IO SMTPConnection
connectStream IO [Char]
getMailHostName
  where
    connParams :: ConnectionParams
connParams = [Char]
-> PortNumber
-> Maybe TLSSettings
-> Maybe ProxySettings
-> ConnectionParams
Conn.ConnectionParams [Char]
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 :: [Char]
-> PortNumber -> IO [Char] -> TLSSettings -> IO SMTPConnection
connectSMTPWithHostNameAndTlsSettingsSTARTTLS [Char]
hostname PortNumber
port IO [Char]
getMailHostName 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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO [Char]
-> ConnectionContext
-> TLSSettings
-> Connection
-> IO SMTPConnection
connectStreamSTARTTLS IO [Char]
getMailHostName ConnectionContext
context TLSSettings
tlsSettings
   where 
     connParams :: ConnectionParams
connParams = [Char]
-> PortNumber
-> Maybe TLSSettings
-> Maybe ProxySettings
-> ConnectionParams
Conn.ConnectionParams [Char]
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 ReplyCode
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 ReplyCode
tries SMTPConnection
st Command
cmd ReplyCode
expectedReply = do
    (ReplyCode
code, 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
msg
      else do
        SMTPConnection -> IO ()
closeSMTP SMTPConnection
st
        [Char] -> IO ByteString
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO ByteString) -> [Char] -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected reply to: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Command -> [Char]
forall a. Show a => a -> [Char]
show Command
cmd [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
          [Char]
", Expected reply code: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ReplyCode -> [Char]
forall a. Show a => a -> [Char]
show ReplyCode
expectedReply [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
          [Char]
", Got this instead: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ReplyCode -> [Char]
forall a. Show a => a -> [Char]
show ReplyCode
code [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
msg

tryCommandNoFail :: Int -> SMTPConnection -> Command -> ReplyCode
                 -> IO (ReplyCode, ByteString)
tryCommandNoFail :: ReplyCode
-> SMTPConnection
-> Command
-> ReplyCode
-> IO (ReplyCode, ByteString)
tryCommandNoFail ReplyCode
tries SMTPConnection
st Command
cmd ReplyCode
expectedReply = do
  (ReplyCode
code, 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 a. a -> IO a
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
> ReplyCode
1
      then ReplyCode
-> SMTPConnection
-> Command
-> ReplyCode
-> IO (ReplyCode, ByteString)
tryCommandNoFail (ReplyCode
tries ReplyCode -> ReplyCode -> ReplyCode
forall a. Num a => a -> a -> a
- ReplyCode
1) SMTPConnection
st Command
cmd ReplyCode
expectedReply
      else (ReplyCode, ByteString) -> IO (ReplyCode, ByteString)
forall a. a -> IO a
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 [Char] -> Connection -> IO SMTPConnection
connectStream IO [Char]
getMailHostName Connection
st = do
    (ReplyCode
code1, ByteString
_) <- 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
== ReplyCode
220) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Connection -> IO ()
Conn.connectionClose Connection
st
        [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot connect to the server"
    [Char]
senderHost <- IO [Char]
getMailHostName
    (ReplyCode
code, ByteString
initialMsg) <- ReplyCode
-> SMTPConnection
-> Command
-> ReplyCode
-> IO (ReplyCode, ByteString)
tryCommandNoFail ReplyCode
3 (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st []) (ByteString -> Command
EHLO (ByteString -> Command) -> ByteString -> Command
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
B8.pack [Char]
senderHost) ReplyCode
250
    if ReplyCode
code ReplyCode -> ReplyCode -> Bool
forall a. Eq a => a -> a -> Bool
== ReplyCode
250
      then SMTPConnection -> IO SMTPConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st ([ByteString] -> [ByteString]
forall a. HasCallStack => [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 ReplyCode
3 (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st []) (ByteString -> Command
HELO (ByteString -> Command) -> ByteString -> Command
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
B8.pack [Char]
senderHost) ReplyCode
250
        SMTPConnection -> IO SMTPConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st ([ByteString] -> [ByteString]
forall a. HasCallStack => [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 [Char]
-> ConnectionContext
-> TLSSettings
-> Connection
-> IO SMTPConnection
connectStreamSTARTTLS IO [Char]
getMailHostName ConnectionContext
context TLSSettings
tlsSettings Connection
st = do
    (ReplyCode
code1, ByteString
_) <- 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
== ReplyCode
220) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Connection -> IO ()
Conn.connectionClose Connection
st
        [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot connect to the server"
    [Char]
senderHost <- IO [Char]
getMailHostName
    ByteString
_ <- ReplyCode
-> SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryCommand ReplyCode
3 (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st []) (ByteString -> Command
EHLO (ByteString -> Command) -> ByteString -> Command
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
B8.pack [Char]
senderHost) ReplyCode
250
    ByteString
_ <- ReplyCode
-> SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryCommand ReplyCode
1 (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st []) Command
STARTTLS ReplyCode
220
    ()
_ <- ConnectionContext -> Connection -> TLSSettings -> IO ()
Conn.connectionSetSecure ConnectionContext
context Connection
st TLSSettings
tlsSettings
    ByteString
msg <- ReplyCode
-> SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryCommand ReplyCode
1 (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st []) (ByteString -> Command
EHLO (ByteString -> Command) -> ByteString -> Command
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
B8.pack [Char]
senderHost) ReplyCode
250
    SMTPConnection -> IO SMTPConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Connection -> [ByteString] -> SMTPConnection
SMTPC Connection
st ([ByteString] -> [ByteString]
forall a. HasCallStack => [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 Connection
conn = do
    (ByteString
code, [ByteString]
bdy) <- IO (ByteString, [ByteString])
readLines
    (ReplyCode, ByteString) -> IO (ReplyCode, ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ReplyCode
forall a. Read a => [Char] -> a
read ([Char] -> ReplyCode) -> [Char] -> ReplyCode
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
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 ReplyCode
1000 Connection
conn
      let (ByteString
c, 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
== Char
'-'
         then do (ByteString
c2, [ByteString]
ls) <- IO (ByteString, [ByteString])
readLines
                 (ByteString, [ByteString]) -> IO (ByteString, [ByteString])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
c2, HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B8.tail ByteString
bdyByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
ls)
         else (ByteString, [ByteString]) -> IO (ByteString, [ByteString])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
c, [HasCallStack => ByteString -> ByteString
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 Connection
conn [ByteString]
_) (DATA ByteString
dat) = do
    Connection -> ByteString -> IO ()
bsPutCrLf Connection
conn ByteString
"DATA"
    (ReplyCode
code, ByteString
_) <- 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
== ReplyCode
354) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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 ByteString
s = if ByteString
cr ByteString -> ByteString -> Bool
`B8.isSuffixOf` ByteString
s then HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B8.init ByteString
s else ByteString
s
    -- duplicate . at the start of a line
    padDot :: ByteString -> ByteString
padDot 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 = [Char] -> ByteString
B8.pack [Char]
"\r"
    dot :: ByteString
dot = [Char] -> ByteString
B8.pack [Char]
"."

sendCommand (SMTPC Connection
conn [ByteString]
_) (AUTH AuthType
LOGIN [Char]
username [Char]
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
    (ReplyCode
code, 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
== ReplyCode
235) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"authentication failed."
    (ReplyCode, ByteString) -> IO (ReplyCode, ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReplyCode
code, ByteString
msg)
  where
    command :: ByteString
command = ByteString
"AUTH LOGIN"
    (ByteString
userB64, ByteString
passB64) = [Char] -> [Char] -> (ByteString, ByteString)
encodeLogin [Char]
username [Char]
password

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

sendCommand (SMTPC Connection
conn [ByteString]
_) 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 ByteString
param) -> ByteString
"HELO " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
param
        (EHLO ByteString
param) -> ByteString
"EHLO " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
param
        (MAIL ByteString
param) -> ByteString
"MAIL FROM:<" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
param ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
">"
        (RCPT ByteString
param) -> ByteString
"RCPT TO:<" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
param ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
">"
        (EXPN ByteString
param) -> ByteString
"EXPN " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
param
        (VRFY ByteString
param) -> ByteString
"VRFY " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
param
        (HELP ByteString
msg)   -> if ByteString -> Bool
B8.null ByteString
msg
                          then ByteString
"HELP\r\n"
                          else ByteString
"HELP " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
msg
        Command
NOOP         -> ByteString
"NOOP"
        Command
RSET         -> ByteString
"RSET"
        Command
QUIT         -> ByteString
"QUIT"
        Command
STARTTLS     -> ByteString
"STARTTLS"
        DATA{}       ->
            [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: DATA pattern should be matched by sendCommand patterns"
        AUTH{}       ->
            [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"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 Connection
conn [ByteString]
_) = SMTPConnection -> Command -> IO (ReplyCode, ByteString)
sendCommand SMTPConnection
c Command
QUIT IO (ReplyCode, ByteString) -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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 ByteString
sender [ByteString]
receivers ByteString
dat SMTPConnection
conn = do
    ByteString
_ <- SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryOnce SMTPConnection
conn (ByteString -> Command
MAIL ByteString
sender) ReplyCode
250
    (ByteString -> IO ByteString) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ByteString
r -> SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryOnce SMTPConnection
conn (ByteString -> Command
RCPT ByteString
r) ReplyCode
250) [ByteString]
receivers
    ByteString
_ <- SMTPConnection -> Command -> ReplyCode -> IO ByteString
tryOnce SMTPConnection
conn (ByteString -> Command
DATA ByteString
dat) ReplyCode
250
    () -> IO ()
forall a. a -> IO a
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 SMTPConnection
conn mail :: Mail
mail@Mail{[Alternatives]
Headers
[Address]
Address
mailFrom :: Address
mailTo :: [Address]
mailCc :: [Address]
mailBcc :: [Address]
mailHeaders :: Headers
mailParts :: [Alternatives]
mailFrom :: Mail -> Address
mailTo :: Mail -> [Address]
mailCc :: Mail -> [Address]
mailBcc :: Mail -> [Address]
mailHeaders :: Mail -> Headers
mailParts :: Mail -> [Alternatives]
..} = do
    ByteString
rendered <- ByteString -> ByteString
lazyToStrict (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> IO a -> IO b
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 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 :: [Char] -> Mail -> IO ()
sendMail [Char]
host Mail
mail = [Char] -> IO SMTPConnection
connectSMTP [Char]
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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' :: [Char] -> PortNumber -> Mail -> IO ()
sendMail' [Char]
host PortNumber
port Mail
mail = [Char] -> PortNumber -> IO SMTPConnection
connectSMTP' [Char]
host PortNumber
port IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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 :: [Char] -> [Char] -> [Char] -> Mail -> IO ()
sendMailWithLogin [Char]
host [Char]
user [Char]
pass Mail
mail = [Char] -> IO SMTPConnection
connectSMTP [Char]
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> [Char] -> Mail -> SMTPConnection -> IO ()
sendMailWithLoginIntern [Char]
user [Char]
pass Mail
mail

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

-- | Send a 'Mail' with a given sender.
sendMailWithSender :: ByteString -> HostName -> Mail -> IO ()
sendMailWithSender :: ByteString -> [Char] -> Mail -> IO ()
sendMailWithSender ByteString
sender [Char]
host Mail
mail = [Char] -> IO SMTPConnection
connectSMTP [Char]
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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 -> [Char] -> PortNumber -> Mail -> IO ()
sendMailWithSender' ByteString
sender [Char]
host PortNumber
port Mail
mail = [Char] -> PortNumber -> IO SMTPConnection
connectSMTP' [Char]
host PortNumber
port IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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 :: [Char] -> Mail -> IO ()
sendMailTLS [Char]
host Mail
mail = [Char] -> IO SMTPConnection
connectSMTPS [Char]
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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' :: [Char] -> PortNumber -> Mail -> IO ()
sendMailTLS' [Char]
host PortNumber
port Mail
mail = [Char] -> PortNumber -> IO SMTPConnection
connectSMTPS' [Char]
host PortNumber
port IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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 :: [Char] -> [Char] -> [Char] -> Mail -> IO ()
sendMailWithLoginTLS [Char]
host [Char]
user [Char]
pass Mail
mail = [Char] -> IO SMTPConnection
connectSMTPS [Char]
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> [Char] -> Mail -> SMTPConnection -> IO ()
sendMailWithLoginIntern [Char]
user [Char]
pass Mail
mail

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

-- | Send a 'Mail' with a given sender. Uses SMTPS with its default port (465).
sendMailWithSenderTLS :: ByteString -> HostName -> Mail -> IO ()
sendMailWithSenderTLS :: ByteString -> [Char] -> Mail -> IO ()
sendMailWithSenderTLS ByteString
sender [Char]
host Mail
mail = [Char] -> IO SMTPConnection
connectSMTPS [Char]
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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 -> [Char] -> PortNumber -> Mail -> IO ()
sendMailWithSenderTLS' ByteString
sender [Char]
host PortNumber
port Mail
mail = [Char] -> PortNumber -> IO SMTPConnection
connectSMTPS' [Char]
host PortNumber
port IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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 :: [Char] -> Mail -> IO ()
sendMailSTARTTLS [Char]
host Mail
mail = [Char] -> IO SMTPConnection
connectSMTPSTARTTLS [Char]
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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' :: [Char] -> PortNumber -> Mail -> IO ()
sendMailSTARTTLS' [Char]
host PortNumber
port Mail
mail = [Char] -> PortNumber -> IO SMTPConnection
connectSMTPSTARTTLS' [Char]
host PortNumber
port IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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 :: [Char] -> [Char] -> [Char] -> Mail -> IO ()
sendMailWithLoginSTARTTLS [Char]
host [Char]
user [Char]
pass Mail
mail = [Char] -> IO SMTPConnection
connectSMTPSTARTTLS [Char]
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> [Char] -> Mail -> SMTPConnection -> IO ()
sendMailWithLoginIntern [Char]
user [Char]
pass Mail
mail

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

-- | Send a 'Mail' with a given sender. Uses STARTTLS with the default port (587).
sendMailWithSenderSTARTTLS :: ByteString -> HostName -> Mail -> IO ()
sendMailWithSenderSTARTTLS :: ByteString -> [Char] -> Mail -> IO ()
sendMailWithSenderSTARTTLS ByteString
sender [Char]
host Mail
mail = [Char] -> IO SMTPConnection
connectSMTPSTARTTLS [Char]
host IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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 -> [Char] -> PortNumber -> Mail -> IO ()
sendMailWithSenderSTARTTLS' ByteString
sender [Char]
host PortNumber
port Mail
mail = [Char] -> PortNumber -> IO SMTPConnection
connectSMTPSTARTTLS' [Char]
host PortNumber
port IO SMTPConnection -> (SMTPConnection -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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 :: [Char] -> [Char] -> Mail -> SMTPConnection -> IO ()
sendMailWithLoginIntern [Char]
user [Char]
pass Mail
mail SMTPConnection
con = do
  (ReplyCode, ByteString)
_ <- SMTPConnection -> Command -> IO (ReplyCode, ByteString)
sendCommand SMTPConnection
con (AuthType -> [Char] -> [Char] -> Command
AUTH AuthType
LOGIN [Char]
user [Char]
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 ByteString
sender Mail
mail 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 ByteString
sender SMTPConnection
conn mail :: Mail
mail@Mail{[Alternatives]
Headers
[Address]
Address
mailFrom :: Mail -> Address
mailTo :: Mail -> [Address]
mailCc :: Mail -> [Address]
mailBcc :: Mail -> [Address]
mailHeaders :: Mail -> Headers
mailParts :: Mail -> [Alternatives]
mailFrom :: Address
mailTo :: [Address]
mailCc :: [Address]
mailBcc :: [Address]
mailHeaders :: Headers
mailParts :: [Alternatives]
..} = do
    ByteString
rendered <- ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> IO a -> IO b
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 -> [Char] -> [Char] -> IO (ReplyCode, ByteString)
login SMTPConnection
con [Char]
user [Char]
pass = SMTPConnection -> Command -> IO (ReplyCode, ByteString)
sendCommand SMTPConnection
con (AuthType -> [Char] -> [Char] -> Command
AUTH AuthType
LOGIN [Char]
user [Char]
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 Address
from [Address]
to [Address]
cc [Address]
bcc Text
subject Alternatives
parts =
    Mail { mailFrom :: Address
mailFrom = Address
from
         , mailTo :: [Address]
mailTo   = [Address]
to
         , mailCc :: [Address]
mailCc   = [Address]
cc
         , mailBcc :: [Address]
mailBcc  = [Address]
bcc
         , mailHeaders :: Headers
mailHeaders = [ (ByteString
"Subject", Text
subject) ]
         , mailParts :: [Alternatives]
mailParts = [Alternatives
parts]
         }

-- | Construct a plain text 'Part'
plainTextPart :: TL.Text -> Part
plainTextPart :: Text -> Part
plainTextPart Text
body = Text -> Encoding -> Disposition -> Headers -> PartContent -> Part
Part Text
"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 Text
body = Text -> Encoding -> Disposition -> Headers -> PartContent -> Part
Part Text
"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 -> [Char] -> IO Part
filePart Text
ct [Char]
fp = do
    ByteString
content <- [Char] -> IO ByteString
BL.readFile [Char]
fp
    Part -> IO Part
forall a. a -> IO a
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
$ [Char] -> Text
T.pack ([Char] -> [Char]
takeFileName [Char]
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 = [Char] -> ByteString
B8.pack [Char]
"\r\n"

bsPutCrLf :: Conn.Connection -> ByteString -> IO ()
bsPutCrLf :: Connection -> ByteString -> IO ()
bsPutCrLf 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