Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
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 =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 thedoSMTP
function. We can use this connection to communicate withSMTP
server.(2)
Theauthenticate
function authenticates to the server with the specifiedAuthType
. It returns aBool
indicating either the authentication succeed or not.(3)
ThesendMail
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 HaskellNet-SSL package.
Synopsis
- data SMTPConnection
- doSMTPPort :: String -> PortNumber -> (SMTPConnection -> IO a) -> IO a
- doSMTP :: String -> (SMTPConnection -> IO a) -> IO a
- doSMTPStream :: BSStream -> (SMTPConnection -> IO a) -> IO a
- authenticate :: AuthType -> UserName -> Password -> SMTPConnection -> IO Bool
- data AuthType
- sendMail :: HasCallStack => Mail -> SMTPConnection -> IO ()
- sendPlainTextMail :: Address -> Address -> Text -> Text -> SMTPConnection -> IO ()
- sendMimeMail :: Address -> Address -> Text -> Text -> Text -> [(Text, FilePath)] -> SMTPConnection -> IO ()
- sendMimeMail' :: Address -> Address -> Text -> Text -> Text -> [(Text, Text, ByteString)] -> SMTPConnection -> IO ()
- sendMimeMail2 :: HasCallStack => Mail -> SMTPConnection -> IO ()
- connectSMTPPort :: String -> PortNumber -> IO SMTPConnection
- connectSMTP :: String -> IO SMTPConnection
- connectStream :: HasCallStack => BSStream -> IO SMTPConnection
- closeSMTP :: SMTPConnection -> IO ()
- gracefullyCloseSMTP :: SMTPConnection -> IO ()
- data SMTPException
Workflow
The common workflow while working with the library is:
- Establish a new connection
- Authenticate to the server
- Perform message sending
- 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
data SMTPConnection Source #
All communication with server is done using SMTPConnection
value.
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.
doSMTPPort :: String -> PortNumber -> (SMTPConnection -> IO a) -> IO a Source #
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.
doSMTP :: String -> (SMTPConnection -> IO a) -> IO a Source #
doSMTP
is similar to doSMTPPort
, except that it does not require
port number and connects to the default SMTP port — 25.
doSMTPStream :: BSStream -> (SMTPConnection -> IO a) -> IO a Source #
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.
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 HaskellNet-SSL package.
bracket-
style is not the only possible style for resource management,
it's possible to use resourcet or
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 =runResourceT
$ do (key, conn) <-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.
Authentication
authenticate :: AuthType -> UserName -> Password -> SMTPConnection -> IO Bool Source #
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 thensendPlainTextMail
"receiver@server.com" "sender@server.com" "subject" "Hello!" conn else
Authorization types supported by the RFC5954
Instances
Sending emails
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 body | Html body | Attachments | Note |
---|---|---|---|---|
sendMail | Uses mail-mime Mail type | |||
sendPlainTextMail | ✓ | ✗ | ✗ | deprecated |
sendMimeMail | ✓ | ✓ | ✓ (filepath) | deprecated |
sendMimeMail' | ✓ | ✓ | ✓ (memory) | deprecated |
sendMimeMail2 | Uses mail-mime Mail type | deprecated |
sendMail :: HasCallStack => Mail -> SMTPConnection -> IO () Source #
Deprecated functions
Deprecated: Use 'sendMail (Network.Mail.Mime.simpleMail' to from subject plainBody)' instead
Send a plain text mail.
DEPRECATED. Instead of sendPlainTextMail to from subject plainBody
use:
mail = simpleMail'
to from subject plainBody
sendMail mail conn
:: Address | receiver |
-> Address | sender |
-> Text | subject |
-> Text | plain text body |
-> Text | html body |
-> [(Text, FilePath)] | attachments: [(content_type, path)] |
-> SMTPConnection | |
-> IO () |
Deprecated: Use 'Network.Mail.Mime.simpleMail to from subject plainBody htmlBody attachments >>= mail -> sendMail mail conn' instead
Send a mime mail. The attachments are included with the file path.
DEPRECATED. Instead of sendMimeMail to from subject plainBody htmlBody attachments
use:
mail <- simpleMail
to from subject plainBody htmlBody attachments
sendMail mail conn
:: Address | receiver |
-> Address | sender |
-> Text | subject |
-> Text | plain text body |
-> Text | html body |
-> [(Text, Text, ByteString)] | attachments: [(content_type, file_name, content)] |
-> SMTPConnection | |
-> IO () |
Deprecated: Use 'sendMail (Network.Mail.Mime.simpleMailInMemory to from subject plainBody htmlBody attachments) conn'
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
sendMimeMail2 :: HasCallStack => Mail -> SMTPConnection -> IO () Source #
Deprecated: Use sendMail instead
Sends email in generated using 'mime-mail' package.
Throws UserError
::
IOError
if recipient address not specified.
Low level commands
Establishing Connection
:: String | name of the server |
-> PortNumber | port number |
-> IO SMTPConnection |
connecting SMTP server with the specified name and port number.
:: String | name of the server |
-> IO SMTPConnection |
connecting SMTP server with the specified name and port 25.
connectStream :: HasCallStack => BSStream -> IO SMTPConnection Source #
Create SMTPConnection from already connected Stream
Throws CantConnect :: SMTPException
in case if got illegal
greeting.
closeSMTP :: SMTPConnection -> IO () Source #
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.
gracefullyCloseSMTP :: SMTPConnection -> IO () Source #
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
data SMTPException Source #
Exceptions that can happen during communication.
UnexpectedReply Command [ReplyCode] ReplyCode ByteString | Reply code was not in the list of expected.
|
NotConfirmed ReplyCode ByteString | The server didn't accept the start of the message delivery |
AuthNegotiationFailed ReplyCode ByteString | The server does not support current authentication method |
NoRecipients Mail | Can't send email because no recipients were specified. |
UnexpectedGreeting ReplyCode | Received an unexpected greeting from the server. |
Instances
Exception SMTPException Source # | |
Defined in Network.HaskellNet.SMTP.Internal | |
Show SMTPException Source # | |
Defined in Network.HaskellNet.SMTP.Internal showsPrec :: Int -> SMTPException -> ShowS # show :: SMTPException -> String # showList :: [SMTPException] -> ShowS # |