{-# LANGUAGE ScopedTypeVariables #-}
{- |

This module provides functions client side of the SMTP protocol.

A basic usage example:

@
\{\-\# LANGUAGE OverloadedStrings \#\-\}
import "Network.HaskellNet.SMTP"
import "Network.HaskellNet.Auth"
import "Network.Mail.Mime"
import "System.Exit" (die)

main :: IO ()
main = 'doSMTP' "your.smtp.server.com" $ \\conn -> do -- (1)
   authSucceed <- 'authenticate' 'PLAIN' "username" "password" conn -- (2)
   if authSucceed
   then do
     let mail = 'Network.Mail.Mime.simpleMail''
           "receiver\@server.com"
           "sender\@server.com"
           "subject"
           "Hello! This is the mail body!"
     sendMail mail conn -- (3)
   else die "Authentication failed."
@

Notes for the above example:

   * @(1)@ The connection (@conn::@'SMTPConnection') is opened using the 'doSMTP' function.
     We can use this connection to communicate with @SMTP@ server.
   * @(2)@ The 'authenticate' function authenticates to the server with the specified 'AuthType'.
     It returns a 'Bool' indicating either the authentication succeed or not.
   * @(3)@ The 'sendMail' is used to send a email a plain text email.

__N.B.__ For /SSL\/TLS/ support you may establish the connection using
  the functions (such as @connectSMTPSSL@) provided by the @Network.HaskellNet.SMTP.SSL@ module
  of the <http://hackage.haskell.org/package/HaskellNet-SSL HaskellNet-SSL> package.
-}
module Network.HaskellNet.SMTP
    ( -- * Workflow
      -- $workflow

      -- ** Controlling connections
      -- $controlling-connections
      SMTPConnection
      -- $controlling-connections-1
    , doSMTPPort
    , doSMTP
    , doSMTPStream
      -- $controlling-connections-2

      -- ** Authentication
    , authenticate
      -- $authentication
    , AuthType(..)

      -- ** Sending emails
      -- $sending-mail
    , sendMail
      -- *** Deprecated functions
    , sendPlainTextMail
    , sendMimeMail
    , sendMimeMail'
    , sendMimeMail2
      -- * Low level commands
      -- ** Establishing Connection
      -- $low-level-connection
    , connectSMTPPort
    , connectSMTP
    , connectStream
    , closeSMTP
    , gracefullyCloseSMTP
    , SMTPException(..)
    ) where

import Network.HaskellNet.BSStream
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 Network.HaskellNet.Auth

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

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

import GHC.Stack
import Prelude
import Network.HaskellNet.SMTP.Internal


-- $workflow
-- The common workflow while working with the library is:
--
--   1. Establish a new connection
--   2. Authenticate to the server
--   3. Perform message sending
--   4. Close connections
--
-- Steps 1 and 4 are combined together using @bracket@-like API. Other than that
-- the documentation sections are structured according to this workflow.

-- $controlling-connections

-- $controlling-connections-1
-- The library encourages creation of 'SMTPConnection' using the @doSMTP@-family functions.
-- These functions provide @bracket@-like pattern that manages connection state:
-- creates a connection, passes it to the user defined @IO@ action and frees connection
-- when the action exits. This approach is simple and exception safe.
--
-- __N.B.__ It should be noted that none of these functions implements keep alive of any kind,
-- so the server is free to close the connection by timeout even the end of before the users
-- action exits.
--

-- $controlling-connections-2
--
-- __NOTE:__ For /SSL\/TLS/ support you may establish the connection using
-- the functions (such as @connectSMTPSSL@) provided by the @Network.HaskellNet.SMTP.SSL@ module
-- of the <http://hackage.haskell.org/package/HaskellNet-SSL HaskellNet-SSL> package.
--
-- @bracket-@ style is not the only possible style for resource management,
-- it's possible to use <http://hackage.haskell.org/package/resourcet resourcet> or
-- <http://hackage.haskell.org/package/resource-pool resource-pool> as well. In both of the
-- approaches you need to use low-level 'connectSTM*' and 'closeSMTP' functions.
--
-- Basic example using @resourcet@.
--
-- @
-- \{\-\# LANGUAGE OverloadedStrings \#\-\}
-- import "Network.HaskellNet.SMTP"
-- import "Network.HaskellNet.Auth"
-- import "Control.Monad.Trans.Resource"
-- import "System.Exit" (die)
--
-- main :: IO ()
-- main = 'Control.Monad.Trans.Resource.runResourceT' $ do
--    (key, conn)
--        <- 'Control.Monad.Trans.Resource.allocate'
--               ('connectSMTP' "your.smtp.server.com")
--               ('closeSMTP')
--    ... conn
-- @
--
-- This approach allows resource management even if the code does not form
-- a stack, so is more general.
--
-- __NOTE__. SMTP protocol advices to use 'QUIT' command for graceful connection
-- close. Before version 0.6 the library never sent it, so does 'closeSMTP' call.
--
-- Starting from 0.6 'doSMTP'-family uses graceful exit and sends 'QUIT' before terminating
-- a connection. This way of termination is exposed as 'gracefullyCloseSTMP' function,
-- however it's not a default method because it requires a connection to be in
-- a valid state. So it's not possible to guarantee backwards compatibility.

-- | 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
>>= HasCallStack => BSStream -> IO SMTPConnection
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

-- | Create SMTPConnection from already connected Stream
--
-- Throws @CantConnect :: SMTPException@ in case if got illegal
-- greeting.
connectStream :: HasCallStack => BSStream -> IO SMTPConnection
connectStream :: BSStream -> IO SMTPConnection
connectStream BSStream
st =
    do (ReplyCode
code1, ByteString
_) <- BSStream -> IO (ReplyCode, ByteString)
parseResponse BSStream
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
         BSStream -> IO ()
bsClose BSStream
st
         SMTPException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (SMTPException -> IO ()) -> SMTPException -> IO ()
forall a b. (a -> b) -> a -> b
$ ReplyCode -> SMTPException
UnexpectedGreeting ReplyCode
code1
       Text
senderHost <- String -> Text
T.pack (String -> Text) -> IO String -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getHostName
       ByteString
msg <- SMTPConnection
-> Command -> ReplyCode -> [ReplyCode] -> IO ByteString
tryCommand (BSStream -> [ByteString] -> SMTPConnection
SMTPC BSStream
st []) (Text -> Command
EHLO Text
senderHost) ReplyCode
3 [ReplyCode
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))


-- $authentication

{- |
Authenticates user on the remote server. Returns 'True' if the authentication succeeds,
otherwise returns 'False'.

Usage example:

@
\{\-\# LANGUAGE OverloadedStrings \#\-\}
authSucceed <- 'authenticate' 'PLAIN' "username" "password" conn
if authSucceed
then 'sendPlainTextMail' "receiver\@server.com" "sender\@server.com" "subject" "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
        (ReplyCode
code, ByteString
_) <- SMTPConnection -> Command -> IO (ReplyCode, ByteString)
sendCommand SMTPConnection
conn (Command -> IO (ReplyCode, ByteString))
-> Command -> IO (ReplyCode, 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 (ReplyCode
code ReplyCode -> ReplyCode -> Bool
forall a. Eq a => a -> a -> Bool
== ReplyCode
235)

-- $authentication
-- __N.B.__ The choice of the authentication method is currently explicit and the library
-- does not analyze server capabilities reply for choosing the right method.
--

-- | 'doSMTPPort' opens a connection to the given port server and
-- performs an IO action with the connection, and then close it.
--
-- 'SMTPConnection' is freed once 'IO' action scope is finished, it means that
-- 'SMTPConnection' value should not escape the action scope.
doSMTPPort :: String -> PortNumber -> (SMTPConnection -> IO a) -> IO a
doSMTPPort :: String -> PortNumber -> (SMTPConnection -> IO a) -> IO a
doSMTPPort String
host PortNumber
port SMTPConnection -> IO a
f =
    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)
            (\(SMTPC BSStream
conn [ByteString]
_) -> BSStream -> IO ()
bsClose BSStream
conn)
            (\SMTPConnection
c -> SMTPConnection -> IO a
f SMTPConnection
c IO a -> (a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> SMTPConnection -> IO ()
quitSMTP SMTPConnection
c IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)

-- | 'doSMTP' is similar to 'doSMTPPort', except that it does not require
-- port number and connects to the default SMTP 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. Using this function
-- you can embed connections maintained by the other libraries or add debug info
-- in a common  way.
--
-- Using this function you can create an 'SMTPConnection' from an already
-- opened connection stream. See more info on the 'BStream' abstraction in the
-- "Network.HaskellNet.BSStream" module.
doSMTPStream :: BSStream -> (SMTPConnection -> IO a) -> IO a
doSMTPStream :: BSStream -> (SMTPConnection -> IO a) -> IO a
doSMTPStream BSStream
s SMTPConnection -> IO a
f =
  IO SMTPConnection
-> (SMTPConnection -> IO ()) -> (SMTPConnection -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (HasCallStack => BSStream -> IO SMTPConnection
BSStream -> IO SMTPConnection
connectStream BSStream
s)
          (\(SMTPC BSStream
conn [ByteString]
_) -> BSStream -> IO ()
bsClose BSStream
conn)
          (\SMTPConnection
c -> SMTPConnection -> IO a
f SMTPConnection
c IO a -> (a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> SMTPConnection -> IO ()
quitSMTP SMTPConnection
c IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)

-- $sending-mail
--
-- Since version 0.6 there is only one function 'sendMail' that sends a email
-- rendered using mime-mail package. Historically there is a family of @send*Mail@
-- functions that provide simpler interface but they basically mimic the functions
-- from the mime-mail package, and it's encouraged to use those functions directly.
--
-- +------------------------+------------+----------+-------------+-------------+
-- | Method                 | Plain text | Html body| Attachments |  Note       |
-- |                        | body       |          |             |             |
-- +========================+============+==========+=============+=============+
-- | 'sendMail'             |   Uses mail-mime 'Mail' type        |             |
-- +------------------------+------------+----------+-------------+-------------+
-- | 'sendPlainTextMail'    |     ✓      |    ✗     |     ✗       | deprecated  |
-- +------------------------+------------+----------+-------------+-------------+
-- | 'sendMimeMail'         |     ✓      |    ✓     | ✓ (filepath)| deprecated  |
-- +------------------------+------------+----------+-------------+-------------+
-- | 'sendMimeMail''        |    ✓       |    ✓     | ✓  (memory) | deprecated  |
-- +------------------------+------------+----------+-------------+-------------+
-- | 'sendMimeMail2'        |   Uses mail-mime 'Mail' type        | deprecated  |
-- +------------------------+-------------------------------------+-------------+

-- | Send a plain text mail.
--
-- __DEPRECATED__. Instead of @sendPlainTextMail to from subject plainBody@ use:
--
-- @
-- mail = 'Network.Mail.Mime.simpleMail'' to from subject plainBody
-- sendMail mail conn
-- @
{-# DEPRECATED sendPlainTextMail "Use 'sendMail (Network.Mail.Mime.simpleMail' to from subject plainBody)' instead" #-}
sendPlainTextMail :: Address -- ^ receiver
                  -> Address -- ^ sender
                  -> T.Text  -- ^ subject
                  -> LT.Text -- ^ body
                  -> SMTPConnection -- ^ the connection
                  -> IO ()
sendPlainTextMail :: Address -> Address -> Text -> Text -> SMTPConnection -> IO ()
sendPlainTextMail Address
to Address
from Text
subject Text
body SMTPConnection
con =
  let mail :: Mail
mail = Address -> Address -> Text -> Text -> Mail
simpleMail' Address
to Address
from Text
subject Text
body
  in HasCallStack => Mail -> SMTPConnection -> IO ()
Mail -> SMTPConnection -> IO ()
sendMail Mail
mail SMTPConnection
con


-- | Send a mime mail. The attachments are included with the file path.
--
-- __DEPRECATED__. Instead of @sendMimeMail to from subject plainBody htmlBody attachments@ use:
--
-- @
-- mail <- 'Network.Mail.Mime.simpleMail' to from subject plainBody htmlBody attachments
-- sendMail mail conn
-- @
--
{-# DEPRECATED sendMimeMail "Use 'Network.Mail.Mime.simpleMail to from subject plainBody htmlBody attachments >>= \\mail -> sendMail mail conn' instead" #-}
sendMimeMail :: Address              -- ^ receiver
             -> Address              -- ^ sender
             -> T.Text               -- ^ subject
             -> LT.Text              -- ^ plain text body
             -> LT.Text              -- ^ html body
             -> [(T.Text, FilePath)] -- ^ attachments: [(content_type, path)]
             -> SMTPConnection
             -> IO ()
sendMimeMail :: Address
-> Address
-> Text
-> Text
-> Text
-> [(Text, String)]
-> SMTPConnection
-> IO ()
sendMimeMail Address
to Address
from Text
subject Text
plainBody Text
htmlBody [(Text, String)]
attachments SMTPConnection
con = do
  Mail
myMail <- Address
-> Address -> Text -> Text -> Text -> [(Text, String)] -> IO Mail
simpleMail Address
to Address
from Text
subject Text
plainBody Text
htmlBody [(Text, String)]
attachments
  HasCallStack => Mail -> SMTPConnection -> IO ()
Mail -> SMTPConnection -> IO ()
sendMail Mail
myMail SMTPConnection
con

-- | Send a mime mail. The attachments are included with in-memory 'ByteString'.
--
-- __DEPRECATED__. Instead of @sendMimeMail to from subject plainBody htmlBody attachments@ use:
--
-- @
-- let mail = Network.Mail.Mime.simpleMailInMemory to from subject plainBody htmlBody attachments
-- sendMail mail conn
-- @
--
{-# DEPRECATED sendMimeMail' "Use 'sendMail (Network.Mail.Mime.simpleMailInMemory to from subject plainBody htmlBody attachments) conn'" #-}
sendMimeMail' :: Address                        -- ^ receiver
              -> Address                        -- ^ sender
              -> T.Text                         -- ^ 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' :: Address
-> Address
-> Text
-> Text
-> Text
-> [(Text, Text, ByteString)]
-> SMTPConnection
-> IO ()
sendMimeMail' Address
to Address
from Text
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 Address
to Address
from Text
subject Text
plainBody Text
htmlBody [(Text, Text, ByteString)]
attachments
  HasCallStack => Mail -> SMTPConnection -> IO ()
Mail -> SMTPConnection -> IO ()
sendMail Mail
myMail SMTPConnection
con

-- | Sends email in generated using 'mime-mail' package.
--
-- Throws 'UserError' @::@ 'IOError' if recipient address not specified.
{-# DEPRECATED sendMimeMail2 "Use sendMail instead" #-}
sendMimeMail2 :: HasCallStack => Mail -> SMTPConnection -> IO ()
sendMimeMail2 :: Mail -> SMTPConnection -> IO ()
sendMimeMail2 = HasCallStack => Mail -> SMTPConnection -> IO ()
Mail -> SMTPConnection -> IO ()
sendMail

-- | Sends email using 'Mail' type from the mime-mail package.
--
-- Sender is taken from the 'mailFrom' field of the @mail@. Message
-- is sent to all the recipients in the 'mailTo', 'mailCc', 'mailBcc' fields.
-- But 'mailBcc' emails are not visible to other recipients as it should be.
--
-- @since 0.6
sendMail :: HasCallStack => Mail -> SMTPConnection -> IO ()
sendMail :: Mail -> SMTPConnection -> IO ()
sendMail Mail
mail SMTPConnection
conn = do
  let recps :: [Address]
recps = 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 ([Address] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Address]
recps) (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
$ Mail -> SMTPException
NoRecipients Mail
mail
  ByteString
renderedMail <- Mail -> IO ByteString
renderMail' (Mail -> IO ByteString) -> Mail -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Mail
mail { mailBcc :: [Address]
mailBcc = [] }
  Address -> [Address] -> ByteString -> SMTPConnection -> IO ()
sendMailData (Mail -> Address
mailFrom Mail
mail) [Address]
recps (ByteString -> ByteString
B.toStrict ByteString
renderedMail) SMTPConnection
conn