{-# LANGUAGE ScopedTypeVariables #-}
{- |

This module provides functions for working with the SMTP protocol in the client side,
including /opening/ and /closing/ connections, /sending commands/ to the server,
/authenticate/ and /sending mails/.

Here's a basic usage example:

>
> import Network.HaskellNet.SMTP
> import Network.HaskellNet.Auth
> import qualified Data.Text.Lazy as T
>
> main = doSMTP "your.smtp.server.com" $ \conn ->
>    authSucceed <- authenticate PLAIN "username" "password" conn
>    if authSucceed
>        then sendPlainTextMail "receiver@server.com" "sender@server.com" "subject" (T.pack "Hello! This is the mail body!") conn
>        else print "Authentication failed."

Notes for the above example:

   * First the 'SMTPConnection' is opened with the 'doSMTP' function.
     The connection should also be established with functions such as 'connectSMTP',
     'connectSMTPPort' and 'doSMTPPort'.
     With the @doSMTP*@ functions the connection is opened, then executed an action
     with it and then closed automatically.
     If the connection is opened with the @connectSMTP*@ functions you may want to
     close it with the 'closeSMTP' function after using it.
     It is also possible to create a 'SMTPConnection' from an already opened connection
     stream ('BSStream') using the 'connectStream' or 'doSMTPStream' functions.

     /NOTE:/ For /SSL\/TLS/ support you may establish the connection using
             the functions (such as @connectSMTPSSL@) provided in the
             @Network.HaskellNet.SMTP.SSL@ module of the
             <http://hackage.haskell.org/package/HaskellNet-SSL HaskellNet-SSL>
             package.

   * The 'authenticate' function authenticates to the server with the specified 'AuthType'.
     'PLAIN', 'LOGIN' and 'CRAM_MD5' 'AuthType's are available. It returns a 'Bool'
     indicating either the authentication succeed or not.


   * To send a mail you can use 'sendPlainTextMail' for plain text mail, or 'sendMimeMail'
     for mime mail.
-}
module Network.HaskellNet.SMTP
    ( -- * Types
      Command(..)
    , Response(..)
    , AuthType(..)
    , SMTPConnection
      -- * Establishing Connection
    , connectSMTPPort
    , connectSMTP
    , connectStream
      -- * Operation to a Connection
    , sendCommand
    , closeSMTP
      -- * Other Useful Operations
    , authenticate
    , sendMail
    , doSMTPPort
    , doSMTP
    , doSMTPStream
    , sendPlainTextMail
    , sendMimeMail
    , sendMimeMail'
    , sendMimeMail2
    )
    where

import Network.HaskellNet.BSStream
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import Network.BSD (getHostName)
import Network.Socket
import Network.Compat

import Control.Applicative ((<$>))
import Control.Exception
import Control.Monad (unless, when)

import Data.Char (isDigit)

import Network.HaskellNet.Auth

import Network.Mail.Mime
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString as S

import qualified Data.Text.Lazy as LT
import qualified Data.Text as T

-- The response field seems to be unused. It's saved at one place, but never
-- retrieved.
data SMTPConnection = SMTPC { SMTPConnection -> BSStream
bsstream :: !BSStream, SMTPConnection -> [ByteString]
_response :: ![ByteString] }

data Command = HELO String
             | EHLO String
             | MAIL String
             | RCPT String
             | DATA ByteString
             | EXPN String
             | VRFY String
             | HELP String
             | AUTH AuthType UserName Password
             | NOOP
             | RSET
             | 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)

type ReplyCode = Int

data Response = Ok
              | SystemStatus
              | HelpMessage
              | ServiceReady
              | ServiceClosing
              | UserNotLocal
              | CannotVerify
              | StartMailInput
              | ServiceNotAvailable
              | MailboxUnavailable
              | ErrorInProcessing
              | InsufficientSystemStorage
              | SyntaxError
              | ParameterError
              | CommandNotImplemented
              | BadSequence
              | ParameterNotImplemented
              | MailboxUnavailableError
              | UserNotLocalError
              | ExceededStorage
              | MailboxNotAllowed
              | TransactionFailed
                deriving (Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show, Response -> Response -> Bool
(Response -> Response -> Bool)
-> (Response -> Response -> Bool) -> Eq Response
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Response -> Response -> Bool
$c/= :: Response -> Response -> Bool
== :: Response -> Response -> Bool
$c== :: Response -> Response -> Bool
Eq)

-- | connecting SMTP server with the specified name and port number.
connectSMTPPort :: String     -- ^ name of the server
                -> PortNumber -- ^ port number
                -> IO SMTPConnection
connectSMTPPort :: String -> PortNumber -> IO SMTPConnection
connectSMTPPort String
hostname PortNumber
port =
    (Handle -> BSStream
handleToStream (Handle -> BSStream) -> IO Handle -> IO BSStream
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> PortNumber -> IO Handle
connectTo String
hostname PortNumber
port)
    IO BSStream -> (BSStream -> IO SMTPConnection) -> IO SMTPConnection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BSStream -> IO SMTPConnection
connectStream

-- | connecting SMTP server with the specified name and port 25.
connectSMTP :: String     -- ^ name of the server
            -> IO SMTPConnection
connectSMTP :: String -> IO SMTPConnection
connectSMTP = (String -> PortNumber -> IO SMTPConnection)
-> PortNumber -> String -> IO SMTPConnection
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> PortNumber -> IO SMTPConnection
connectSMTPPort PortNumber
25

tryCommand :: SMTPConnection -> Command -> Int -> [ReplyCode]
           -> IO ByteString
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 -> do
            BSStream -> IO ()
bsClose (SMTPConnection -> BSStream
bsstream SMTPConnection
conn)
            String -> IO ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ 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]
expectedReplies 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

-- | create SMTPConnection from already connected Stream
connectStream :: BSStream -> IO SMTPConnection
connectStream :: BSStream -> IO SMTPConnection
connectStream BSStream
st =
    do (Int
code1, ByteString
_) <- BSStream -> IO (Int, ByteString)
parseResponse BSStream
st
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
code1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
220) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              do BSStream -> IO ()
bsClose BSStream
st
                 String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot connect to the server"
       String
senderHost <- IO String
getHostName
       ByteString
msg <- SMTPConnection -> Command -> Int -> [Int] -> IO ByteString
tryCommand (BSStream -> [ByteString] -> SMTPConnection
SMTPC BSStream
st []) (String -> Command
EHLO String
senderHost) Int
3 [Int
250]
       SMTPConnection -> IO SMTPConnection
forall (m :: * -> *) a. Monad m => a -> m a
return (BSStream -> [ByteString] -> SMTPConnection
SMTPC BSStream
st ([ByteString] -> [ByteString]
forall a. [a] -> [a]
tail ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BS.lines ByteString
msg))

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])


-- | send a method to a server
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 -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
"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
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ 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
       (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 = String -> ByteString
BS.pack String
"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
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
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ 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
       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 :: ByteString
command = String -> ByteString
BS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"AUTH", 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
$ String -> ByteString
BS.pack String
command
       BSStream -> IO (Int, ByteString)
parseResponse BSStream
conn
    where command :: String
command = case Command
meth of
                      (HELO String
param) -> String
"HELO " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
param
                      (EHLO String
param) -> String
"EHLO " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
param
                      (MAIL String
param) -> String
"MAIL FROM:<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
param String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
                      (RCPT String
param) -> String
"RCPT TO:<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
param String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
                      (EXPN String
param) -> String
"EXPN " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
param
                      (VRFY String
param) -> String
"VRFY " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
param
                      (HELP String
msg)   -> if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
msg
                                        then String
"HELP\r\n"
                                        else String
"HELP " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
                      Command
NOOP         -> String
"NOOP"
                      Command
RSET         -> String
"RSET"
                      Command
QUIT         -> String
"QUIT"
                      (DATA ByteString
_)     ->
                          ShowS
forall a. HasCallStack => String -> a
error String
"BUG: DATA pattern should be matched by sendCommand patterns"
                      (AUTH {})     ->
                          ShowS
forall a. HasCallStack => String -> a
error String
"BUG: AUTH pattern should be matched by sendCommand patterns"

-- | close the connection.  This function send the QUIT method, so you
-- do not have to QUIT method explicitly.
closeSMTP :: SMTPConnection -> IO ()
closeSMTP :: SMTPConnection -> IO ()
closeSMTP (SMTPC BSStream
conn [ByteString]
_) = BSStream -> IO ()
bsClose BSStream
conn

{-
I must be being stupid here

I can't seem to be able to catch the exception arising from the
connection already being closed this would be the correct way to do it
but instead we're being naughty above by just closes the connection
without first sending QUIT

closeSMTP c@(SMTPC conn _) =
    do sendCommand c QUIT
       bsClose conn `catch` \(_ :: IOException) -> return ()
-}

{- |
This function will return 'True' if the authentication succeeds.
Here's an example of sending a mail with a server that requires
authentication:

>    authSucceed <- authenticate PLAIN "username" "password" conn
>    if authSucceed
>        then sendPlainTextMail "receiver@server.com" "sender@server.com" "subject" (T.pack "Hello!") conn
>        else print "Authentication failed."
-}
authenticate :: AuthType -> UserName -> Password -> SMTPConnection -> IO Bool
authenticate :: AuthType -> String -> String -> SMTPConnection -> IO Bool
authenticate AuthType
at String
username String
password SMTPConnection
conn  = do
        (Int
code, ByteString
_) <- SMTPConnection -> Command -> IO (Int, ByteString)
sendCommand SMTPConnection
conn (Command -> IO (Int, ByteString))
-> Command -> IO (Int, ByteString)
forall a b. (a -> b) -> a -> b
$ AuthType -> String -> String -> Command
AUTH AuthType
at String
username String
password
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
235)

-- | sending a mail to a server. This is achieved by sendMessage.  If
-- something is wrong, it raises an IOexception.
sendMail :: String     -- ^ sender mail
         -> [String]   -- ^ receivers
         -> ByteString -- ^ data
         -> SMTPConnection
         -> IO ()
sendMail :: String -> [String] -> ByteString -> SMTPConnection -> IO ()
sendMail String
sender [String]
receivers ByteString
dat SMTPConnection
conn = do
                 Command -> IO ByteString
sendAndCheck (String -> Command
MAIL String
sender)
                 (String -> IO ByteString) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Command -> IO ByteString
sendAndCheck (Command -> IO ByteString)
-> (String -> Command) -> String -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Command
RCPT) [String]
receivers
                 Command -> IO ByteString
sendAndCheck (ByteString -> Command
DATA ByteString
dat)
                 () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    -- Try the command once and @fail@ if the response isn't 250.
    sendAndCheck :: Command -> IO ByteString
sendAndCheck Command
cmd = SMTPConnection -> Command -> Int -> [Int] -> IO ByteString
tryCommand SMTPConnection
conn Command
cmd Int
1 [Int
250, Int
251]

-- | doSMTPPort open a connection, and do an IO action with the
-- connection, and then close it.
doSMTPPort :: String -> PortNumber -> (SMTPConnection -> IO a) -> IO a
doSMTPPort :: String -> PortNumber -> (SMTPConnection -> IO a) -> IO a
doSMTPPort String
host PortNumber
port =
    IO SMTPConnection
-> (SMTPConnection -> IO ()) -> (SMTPConnection -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> PortNumber -> IO SMTPConnection
connectSMTPPort String
host PortNumber
port) SMTPConnection -> IO ()
closeSMTP

-- | doSMTP is similar to doSMTPPort, except that it does not require
-- port number but connects to the server with port 25.
doSMTP :: String -> (SMTPConnection -> IO a) -> IO a
doSMTP :: String -> (SMTPConnection -> IO a) -> IO a
doSMTP String
host = String -> PortNumber -> (SMTPConnection -> IO a) -> IO a
forall a. String -> PortNumber -> (SMTPConnection -> IO a) -> IO a
doSMTPPort String
host PortNumber
25

-- | doSMTPStream is similar to doSMTPPort, except that its argument
-- is a Stream data instead of hostname and port number.
doSMTPStream :: BSStream -> (SMTPConnection -> IO a) -> IO a
doSMTPStream :: BSStream -> (SMTPConnection -> IO a) -> IO a
doSMTPStream BSStream
s = IO SMTPConnection
-> (SMTPConnection -> IO ()) -> (SMTPConnection -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (BSStream -> IO SMTPConnection
connectStream BSStream
s) SMTPConnection -> IO ()
closeSMTP

-- | Send a plain text mail.
sendPlainTextMail :: String  -- ^ receiver
                  -> String  -- ^ sender
                  -> String  -- ^ subject
                  -> LT.Text -- ^ body
                  -> SMTPConnection -- ^ the connection
                  -> IO ()
sendPlainTextMail :: String -> String -> String -> Text -> SMTPConnection -> IO ()
sendPlainTextMail String
to String
from String
subject Text
body SMTPConnection
con = do
    ByteString
renderedMail <- Mail -> IO ByteString
renderMail' Mail
myMail
    String -> [String] -> ByteString -> SMTPConnection -> IO ()
sendMail String
from [String
to] (ByteString -> ByteString
lazyToStrict ByteString
renderedMail) SMTPConnection
con
    where
        myMail :: Mail
myMail = Address -> Address -> Text -> Text -> Mail
simpleMail' (String -> Address
address String
to) (String -> Address
address String
from) (String -> Text
T.pack String
subject) Text
body
        address :: String -> Address
address = Maybe Text -> Text -> Address
Address Maybe Text
forall a. Maybe a
Nothing (Text -> Address) -> (String -> Text) -> String -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Send a mime mail. The attachments are included with the file path.
sendMimeMail :: String               -- ^ receiver
             -> String               -- ^ sender
             -> String               -- ^ subject
             -> LT.Text              -- ^ plain text body
             -> LT.Text              -- ^ html body
             -> [(T.Text, FilePath)] -- ^ attachments: [(content_type, path)]
             -> SMTPConnection
             -> IO ()
sendMimeMail :: String
-> String
-> String
-> Text
-> Text
-> [(Text, String)]
-> SMTPConnection
-> IO ()
sendMimeMail String
to String
from String
subject Text
plainBody Text
htmlBody [(Text, String)]
attachments SMTPConnection
con = do
  Mail
myMail <- Address
-> Address -> Text -> Text -> Text -> [(Text, String)] -> IO Mail
simpleMail (String -> Address
address String
to) (String -> Address
address String
from) (String -> Text
T.pack String
subject)
            Text
plainBody Text
htmlBody [(Text, String)]
attachments
  ByteString
renderedMail <- Mail -> IO ByteString
renderMail' Mail
myMail
  String -> [String] -> ByteString -> SMTPConnection -> IO ()
sendMail String
from [String
to] (ByteString -> ByteString
lazyToStrict ByteString
renderedMail) SMTPConnection
con
  where
    address :: String -> Address
address = Maybe Text -> Text -> Address
Address Maybe Text
forall a. Maybe a
Nothing (Text -> Address) -> (String -> Text) -> String -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Send a mime mail. The attachments are included with in-memory 'ByteString'.
sendMimeMail' :: String                         -- ^ receiver
              -> String                         -- ^ sender
              -> String                         -- ^ subject
              -> LT.Text                        -- ^ plain text body
              -> LT.Text                        -- ^ html body
              -> [(T.Text, T.Text, B.ByteString)] -- ^ attachments: [(content_type, file_name, content)]
              -> SMTPConnection
              -> IO ()
sendMimeMail' :: String
-> String
-> String
-> Text
-> Text
-> [(Text, Text, ByteString)]
-> SMTPConnection
-> IO ()
sendMimeMail' String
to String
from String
subject Text
plainBody Text
htmlBody [(Text, Text, ByteString)]
attachments SMTPConnection
con = do
  let myMail :: Mail
myMail = Address
-> Address
-> Text
-> Text
-> Text
-> [(Text, Text, ByteString)]
-> Mail
simpleMailInMemory (String -> Address
address String
to) (String -> Address
address String
from) (String -> Text
T.pack String
subject)
                                  Text
plainBody Text
htmlBody [(Text, Text, ByteString)]
attachments
  Mail -> SMTPConnection -> IO ()
sendMimeMail2 Mail
myMail SMTPConnection
con
  where
    address :: String -> Address
address = Maybe Text -> Text -> Address
Address Maybe Text
forall a. Maybe a
Nothing (Text -> Address) -> (String -> Text) -> String -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

sendMimeMail2 :: Mail -> SMTPConnection -> IO ()
sendMimeMail2 :: Mail -> SMTPConnection -> IO ()
sendMimeMail2 Mail
mail SMTPConnection
con = do
    let (Address Maybe Text
_ Text
from) = Mail -> Address
mailFrom Mail
mail
        recps :: [String]
recps = (Address -> String) -> [Address] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack (Text -> String) -> (Address -> Text) -> Address -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Text
addressEmail)
                     ([Address] -> [String]) -> [Address] -> [String]
forall a b. (a -> b) -> a -> b
$ (Mail -> [Address]
mailTo Mail
mail [Address] -> [Address] -> [Address]
forall a. [a] -> [a] -> [a]
++ Mail -> [Address]
mailCc Mail
mail [Address] -> [Address] -> [Address]
forall a. [a] -> [a] -> [a]
++ Mail -> [Address]
mailBcc Mail
mail)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
recps) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no receiver specified."
    ByteString
renderedMail <- Mail -> IO ByteString
renderMail' (Mail -> IO ByteString) -> Mail -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Mail
mail { mailBcc :: [Address]
mailBcc = [] }
    String -> [String] -> ByteString -> SMTPConnection -> IO ()
sendMail (Text -> String
T.unpack Text
from) [String]
recps (ByteString -> ByteString
lazyToStrict ByteString
renderedMail) SMTPConnection
con

-- haskellNet uses strict bytestrings
-- TODO: look at making haskellnet lazy
lazyToStrict :: B.ByteString -> S.ByteString
lazyToStrict :: ByteString -> ByteString
lazyToStrict = ByteString -> ByteString
B.toStrict

crlf :: BS.ByteString
crlf :: ByteString
crlf = String -> ByteString
BS.pack String
"\r\n"

bsPutCrLf :: BSStream -> ByteString -> IO ()
bsPutCrLf :: BSStream -> ByteString -> IO ()
bsPutCrLf BSStream
h ByteString
s = BSStream -> ByteString -> IO ()
bsPut BSStream
h ByteString
s IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BSStream -> ByteString -> IO ()
bsPut BSStream
h ByteString
crlf IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BSStream -> IO ()
bsFlush BSStream
h