{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DerivingStrategies #-}
-- |
-- Internal functions that are used in the SMTP protocol,
-- you may need these module in case if you want to implement additional
-- functionality that does not exist in the "Network.HaskellNet.SMTP".
--
-- __Example__.
--
-- One example could be sending multiple emails over the same stream
-- in order to use that you may want to use 'RSET' command, so you can implement:
--
-- @
-- import "Network.HaskellNet.SMTP.Internal"
--
-- resetConnection :: SMTPConnection -> IO ()
-- resetConnection conn = do
--    (code, _) <- 'sendCommand' conn 'RSET'
--    'unless' (code == 250) $ 'throwIO' $ 'UnexpectedReply' 'RSET' [250] code ""
-- @
--
module Network.HaskellNet.SMTP.Internal
  ( SMTPConnection(..)
  , Command(..)
  , SMTPException(..)
  , ReplyCode
  , tryCommand
  , parseResponse
  , sendCommand
  , sendMailData
  , closeSMTP
  , gracefullyCloseSMTP
  , quitSMTP
    -- * Reexports
  , Address(..)
  ) where

import Control.Exception
import Control.Monad (unless)
import Data.Char (isDigit)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Typeable

import Network.HaskellNet.Auth
import Network.HaskellNet.BSStream

import Network.Mail.Mime

import Prelude

-- | All communication with server is done using @SMTPConnection@ value.
data SMTPConnection = SMTPC {
  -- | Connection communication channel.
  SMTPConnection -> BSStream
bsstream :: !BSStream,
  -- | Server properties as per reply to the 'EHLO' request.
  SMTPConnection -> [ByteString]
_response :: ![ByteString]
  }

-- | SMTP commands.
--
-- Supports basic and extended SMTP protocol without TLS support.
--
-- For each command we provide list of the expected reply codes that happens in success and failure cases
-- respectively.
data Command
  = -- | The @HELO@ command initiates the SMTP session conversation. The client greets the server and introduces itself.
    -- As a rule, HELO is attributed with an argument that specifies the domain name or IP address of the SMTP client.
    --
    -- Success: 250
    -- Failure: 504, 550
    HELO T.Text
  | -- | @EHLO@ is an alternative to HELO for servers that support the SMTP service extensions (ESMTP)
    --
    -- Success: 250
    -- Failure: 502, 504, 550
    EHLO T.Text
  | -- | @MAIL FROM@ command initiates a mail transfer. As an argument, MAIL FROM includes a sender mailbox (reverse-path)
    -- can accept optional parameters.
    --
    -- Success: 250
    --
    -- Failure: 451, 452, 455, 503, 550, 552, 553, 555
    MAIL T.Text
  | -- | The @RCPT TO@ command specifies exactly one recipient.
    --
    -- Success: 250 251
    --
    -- Failure: 450 451 452 455 503 550 551 552 553 555
    RCPT T.Text
  | -- | With the @DATA@ command, the client asks the server for permission to transfer the mail data.
    --
    -- Success: 250, 354
    --
    -- Failure: 450 451 452 503 550 552 554
    --
    -- Client just sends data and after receiving 354 starts streaming email, terminating transfer by
    -- sending @\r\n.\r\n@.
    DATA ByteString
  | -- |
    -- @EXPN@ is used to verify whether a mailing list in the argument exists on the local host.
    -- The positive response will specify the membership of the recipients.
    --
    -- Success: 250 252
    --
    -- Failure: 502 504 550
    EXPN T.Text
  | -- |
    -- @VRFY@ is used to verify whether a mailbox in the argument exists on the local host.
    -- The server response includes the user’s mailbox and may include the user’s full name.
    --
    -- Success: 250 251 252
    --
    -- Failure: 502 504 550 551 553
    VRFY T.Text
  | -- |
    -- With the @HELP@ command, the client requests a list of commands the server supports, may request
    -- help for specific command
    --
    -- Success: 211 214
    --
    -- Failure: 502 504
    HELP T.Text
  | -- | Authorization support
    AUTH AuthType UserName Password
  | -- | @NOOP@  can be used to verify if the connection is alive
    --
    -- Success: 250
    NOOP
  | -- | @RSET@ Resets the state
    --
    -- Success: 250
    RSET
  | -- | @QUIT@ asks server to close connection. Client should terminate the connection when receives
    -- status.
    --
    -- Success: 221
    QUIT
    deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show, Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq)

-- | Code reply from the server. It's always 3 digit integer.
type ReplyCode = Int

-- | Exceptions that can happen during communication.
data SMTPException
  = -- | Reply code was not in the list of expected.
    --
    --  * @Command@ - command that was sent.
    --  * @[ReplyCode]@ -- list of expected codes
    --  * @ReplyCode@ -- the code that we have received
    --  * @ByteString@ -- additional data returned by the server.
    UnexpectedReply Command [ReplyCode] ReplyCode BS.ByteString
    -- | The server didn't accept the start of the message delivery
  | NotConfirmed ReplyCode BS.ByteString
    -- | The server does not support current authentication method
  | AuthNegotiationFailed ReplyCode BS.ByteString
    -- | Can't send email because no recipients were specified.
  | NoRecipients Mail
    -- | Received an unexpected greeting from the server.
  | UnexpectedGreeting ReplyCode
  deriving (Int -> SMTPException -> ShowS
[SMTPException] -> ShowS
SMTPException -> String
(Int -> SMTPException -> ShowS)
-> (SMTPException -> String)
-> ([SMTPException] -> ShowS)
-> Show SMTPException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SMTPException] -> ShowS
$cshowList :: [SMTPException] -> ShowS
show :: SMTPException -> String
$cshow :: SMTPException -> String
showsPrec :: Int -> SMTPException -> ShowS
$cshowsPrec :: Int -> SMTPException -> ShowS
Show)
  deriving (Typeable)

instance Exception SMTPException where
  displayException :: SMTPException -> String
displayException (UnexpectedReply Command
cmd [Int]
expected Int
code ByteString
msg) =
    String
"Cannot execute command " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Command -> String
forall a. Show a => a -> String
show Command
cmd String -> ShowS
forall a. [a] -> [a] -> [a]
++
       String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
prettyExpected [Int]
expected String -> ShowS
forall a. [a] -> [a] -> [a]
++
       String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ByteString -> String
prettyReceived Int
code ByteString
msg
    where
      prettyReceived :: Int -> ByteString -> String
      prettyReceived :: Int -> ByteString -> String
prettyReceived Int
co ByteString
ms = String
"but received" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
co String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BS.unpack ByteString
ms String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
      prettyExpected :: [ReplyCode] -> String
      prettyExpected :: [Int] -> String
prettyExpected [Int
x] = String
"expected reply code of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x
      prettyExpected [Int]
xs = String
"expected any reply code of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int]
xs
  displayException (NotConfirmed Int
code ByteString
msg) =
    String
"This server cannot accept any data. code: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
code String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", msg: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BS.unpack ByteString
msg
  displayException (AuthNegotiationFailed Int
code ByteString
msg) =
    String
"Authentication failed. code: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
code String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", msg: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BS.unpack ByteString
msg
  displayException (NoRecipients Mail
_mail) =
    String
"No recipients were specified"
  displayException (UnexpectedGreeting Int
code) =
    String
"Expected greeting from the server, but got: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
code


-- | Safe wrapper for running a client command over the SMTP
-- connection.
--
-- /Note on current behavior/
--
-- We allow the command to fail several times, retry
-- happens in case if we have received unexpected status code.
-- In this case message will be sent again. However in case
-- of other synchronous or asynchronous exceptions there will
-- be no retries.
--
-- It case if number of retries were exceeded connection will
-- be closed automatically.
--
-- The behaviors in notes will likely be changed in the future
-- and should not be relied upon, see issues 76, 77.
tryCommand
  :: SMTPConnection -- ^ Connection
  -> Command -- ^ Supported command
  -> Int -- ^ Number of allowed retries
  -> [ReplyCode] -- ^ List of accepted codes
  -> IO ByteString -- ^ Resulting data
tryCommand :: SMTPConnection -> Command -> Int -> [Int] -> IO ByteString
tryCommand SMTPConnection
conn Command
cmd Int
tries [Int]
expectedReplies = do
    (Int
code, ByteString
msg) <- SMTPConnection -> Command -> IO (Int, ByteString)
sendCommand SMTPConnection
conn Command
cmd
    case () of
        ()
_ | Int
code Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
expectedReplies -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
msg
        ()
_ | Int
tries Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 ->
            SMTPConnection -> Command -> Int -> [Int] -> IO ByteString
tryCommand SMTPConnection
conn Command
cmd (Int
tries Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Int]
expectedReplies
          | Bool
otherwise ->
            SMTPException -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO (SMTPException -> IO ByteString) -> SMTPException -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Command -> [Int] -> Int -> ByteString -> SMTPException
UnexpectedReply Command
cmd [Int]
expectedReplies Int
code ByteString
msg

-- | Read response from the stream. Response consists of the code
-- and one or more lines of data.
--
-- In case if it's not the last line of reply the code is followed
-- by the '-' sign. We return the code and all the data with the code
-- stripped.
--
-- Eg.:
--
-- @
-- "250-8BITMIME\\r"
-- "250-PIPELINING\\r"
-- "250-SIZE 42991616\\r"
-- "250-AUTH LOGIN PLAIN XOAUTH2\\r"
-- "250-DSN\\r"
-- "250 ENHANCEDSTATUSCODES\\r"
-- @
--
-- Returns:
--
-- @
-- (250, "8BITMIME\\nPIPELINING\nSIZE 42991616\\nAUTH LOGIN PLAIN XOAUTH2\\nDSN\\nENHANCEDSTATUSCODES")
-- @
--
-- Throws 'SMTPException'.
parseResponse :: BSStream -> IO (ReplyCode, ByteString)
parseResponse :: BSStream -> IO (Int, ByteString)
parseResponse BSStream
st =
    do (ByteString
code, [ByteString]
bdy) <- IO (ByteString, [ByteString])
readLines
       (Int, ByteString) -> IO (Int, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BS.unpack ByteString
code, [ByteString] -> ByteString
BS.unlines [ByteString]
bdy)
    where readLines :: IO (ByteString, [ByteString])
readLines =
              do ByteString
l <- BSStream -> IO ByteString
bsGetLine BSStream
st
                 let (ByteString
c, ByteString
bdy) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Char -> Bool
isDigit ByteString
l
                 if Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
bdy) Bool -> Bool -> Bool
&& ByteString -> Char
BS.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 (m :: * -> *) a. Monad m => a -> m a
return (ByteString
c2, ByteString -> ByteString
BS.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
BS.tail ByteString
bdy])

-- | Sends a 'Command' to the server. Function that performs all the logic
-- for sending messages. Throws an exception if something goes wrong.
--
-- Throws 'SMTPException'.
sendCommand
  :: SMTPConnection
  -> Command
  -> IO (ReplyCode, ByteString)
sendCommand :: SMTPConnection -> Command -> IO (Int, ByteString)
sendCommand (SMTPC BSStream
conn [ByteString]
_) (DATA ByteString
dat) =
    do BSStream -> ByteString -> IO ()
bsPutCrLf BSStream
conn ByteString
"DATA"
       (Int
code, ByteString
msg) <- BSStream -> IO (Int, ByteString)
parseResponse BSStream
conn
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
354) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ SMTPException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (SMTPException -> IO ()) -> SMTPException -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> SMTPException
NotConfirmed Int
code ByteString
msg
       (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 -> ByteString) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
stripCR) ([ByteString] -> IO ()) -> [ByteString] -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BS.lines ByteString
dat [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [String -> ByteString
BS.pack String
"."]
       BSStream -> IO (Int, ByteString)
parseResponse BSStream
conn
    where sendLine :: ByteString -> IO ()
sendLine = BSStream -> ByteString -> IO ()
bsPutCrLf BSStream
conn
          stripCR :: ByteString -> ByteString
stripCR ByteString
bs = case ByteString -> Maybe (ByteString, Char)
BS.unsnoc ByteString
bs of
                         Just (ByteString
line, Char
'\r') -> ByteString
line
                         Maybe (ByteString, Char)
_                 -> ByteString
bs
sendCommand (SMTPC BSStream
conn [ByteString]
_) (AUTH AuthType
LOGIN String
username String
password) =
    do BSStream -> ByteString -> IO ()
bsPutCrLf BSStream
conn ByteString
command
       (Int
_, ByteString
_) <- BSStream -> IO (Int, ByteString)
parseResponse BSStream
conn
       BSStream -> ByteString -> IO ()
bsPutCrLf BSStream
conn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
userB64
       (Int
_, ByteString
_) <- BSStream -> IO (Int, ByteString)
parseResponse BSStream
conn
       BSStream -> ByteString -> IO ()
bsPutCrLf BSStream
conn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
passB64
       BSStream -> IO (Int, ByteString)
parseResponse BSStream
conn
    where command :: ByteString
command = ByteString
"AUTH LOGIN"
          (String
userB64, String
passB64) = String -> String -> (String, String)
login String
username String
password
sendCommand (SMTPC BSStream
conn [ByteString]
_) (AUTH AuthType
at String
username String
password) =
    do BSStream -> ByteString -> IO ()
bsPutCrLf BSStream
conn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
command
       (Int
code, ByteString
msg) <- BSStream -> IO (Int, ByteString)
parseResponse BSStream
conn
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
334) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ SMTPException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (SMTPException -> IO ()) -> SMTPException -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> SMTPException
AuthNegotiationFailed Int
code ByteString
msg
       BSStream -> ByteString -> IO ()
bsPutCrLf BSStream
conn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthType -> String -> String -> ShowS
auth AuthType
at (ByteString -> String
BS.unpack ByteString
msg) String
username String
password
       BSStream -> IO (Int, ByteString)
parseResponse BSStream
conn
    where command :: Text
command = [Text] -> Text
T.unwords [Text
"AUTH", String -> Text
T.pack (AuthType -> String
forall a. Show a => a -> String
show AuthType
at)]
sendCommand (SMTPC BSStream
conn [ByteString]
_) Command
meth =
    do BSStream -> ByteString -> IO ()
bsPutCrLf BSStream
conn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$! Text -> ByteString
T.encodeUtf8 Text
command
       BSStream -> IO (Int, ByteString)
parseResponse BSStream
conn
    where command :: Text
command = case Command
meth of
                      (HELO Text
param) -> Text
"HELO " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
param
                      (EHLO Text
param) -> Text
"EHLO " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
param
                      (MAIL Text
param) -> Text
"MAIL FROM:<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
param Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
                      (RCPT Text
param) -> Text
"RCPT TO:<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
param Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
                      (EXPN Text
param) -> Text
"EXPN " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
param
                      (VRFY Text
param) -> Text
"VRFY " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
param
                      (HELP Text
msg)   -> if Text -> Bool
T.null Text
msg
                                      then Text
"HELP\r\n"
                                      else Text
"HELP " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
                      Command
NOOP         -> Text
"NOOP"
                      Command
RSET         -> Text
"RSET"
                      Command
QUIT         -> Text
"QUIT"
                      (DATA ByteString
_)     ->
                          String -> Text
forall a. HasCallStack => String -> a
error String
"BUG: DATA pattern should be matched by sendCommand patterns"
                      (AUTH {})     ->
                          String -> Text
forall a. HasCallStack => String -> a
error String
"BUG: AUTH pattern should be matched by sendCommand patterns"

-- | Sends quit to the server. Connection must be terminated afterwards, i.e. it's not
-- allowed to issue any command on this connection.
quitSMTP :: SMTPConnection -> IO ()
quitSMTP :: SMTPConnection -> IO ()
quitSMTP SMTPConnection
c = do
  ByteString
_ <- SMTPConnection -> Command -> Int -> [Int] -> IO ByteString
tryCommand SMTPConnection
c Command
QUIT Int
1 [Int
221]
  () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Terminates the connection. 'Quit' command is not send in this case.
-- It's safe to issue this command at any time if the connection is still
-- open.
closeSMTP :: SMTPConnection -> IO ()
closeSMTP :: SMTPConnection -> IO ()
closeSMTP (SMTPC BSStream
conn [ByteString]
_) = BSStream -> IO ()
bsClose BSStream
conn

-- | Gracefully closes SMTP connection. Connection should be in available
-- state. First it sends quit command and then closes connection itself.
-- Connection should not be used after this command exits (even if it exits with an exception).
-- This command may throw an exception in case of network failure or
-- protocol failure when sending 'QUIT' command. If it happens connection
-- nevertheless is closed.
--
-- @since 0.6
gracefullyCloseSMTP :: SMTPConnection -> IO ()
gracefullyCloseSMTP :: SMTPConnection -> IO ()
gracefullyCloseSMTP c :: SMTPConnection
c@(SMTPC BSStream
conn [ByteString]
_) = SMTPConnection -> IO ()
quitSMTP SMTPConnection
c IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` BSStream -> IO ()
bsClose BSStream
conn

-- | Sends a mail to the server.
--
-- Throws 'SMTPException'.
sendMailData :: Address -- ^ sender mail
         -> [Address] -- ^ receivers
         -> ByteString -- ^ data
         -> SMTPConnection
         -> IO ()
sendMailData :: Address -> [Address] -> ByteString -> SMTPConnection -> IO ()
sendMailData Address
sender [Address]
receivers ByteString
dat SMTPConnection
conn = do
   Command -> IO ByteString
sendAndCheck (Text -> Command
MAIL (Address -> Text
addressEmail Address
sender))
   (Address -> IO ByteString) -> [Address] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Command -> IO ByteString
sendAndCheck (Command -> IO ByteString)
-> (Address -> Command) -> Address -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Command
RCPT (Text -> Command) -> (Address -> Text) -> Address -> Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Text
addressEmail) [Address]
receivers
   Command -> IO ByteString
sendAndCheck (ByteString -> Command
DATA ByteString
dat)
   () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    sendAndCheck :: Command -> IO ByteString
sendAndCheck Command
cmd = SMTPConnection -> Command -> Int -> [Int] -> IO ByteString
tryCommand SMTPConnection
conn Command
cmd Int
1 [Int
250, Int
251]

-- | Just a crlf constant.
crlf :: BS.ByteString
crlf :: ByteString
crlf = String -> ByteString
BS.pack String
"\r\n"

-- | Write a message ending with ctlf.
bsPutCrLf :: BSStream -> ByteString -> IO ()
bsPutCrLf :: BSStream -> ByteString -> IO ()
bsPutCrLf BSStream
h ByteString
s = BSStream -> ByteString -> IO ()
bsPut BSStream
h (ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
crlf)