Simple.hs

-- |
-- Module:     Network.Smtp.Simple
-- Copyright:  (c) 2011 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
--
-- Higher level interface to ismtp.

{-# LANGUAGE ScopedTypeVariables #-}

module Network.Smtp.Simple
    ( -- * Execute sessions
      SendMail(..),
      defSendMail,
      sendMail,
      sendMail_
    )
    where

import qualified Data.Set as S
import Control.Arrow
import Control.ContStuff
import Control.Exception.Lifted
import Data.Enumerator
import Network.Smtp.Tools
import Network.Smtp.Types
import System.IO


-- | Session configuration.

data SendMail =
    SendMail {
      mailBufferSize   :: Int,     -- ^ Input buffer size.
      mailInputHandle  :: Handle,  -- ^ Input handle (e.g. receiving socket).
      mailMaxLine      :: Int,     -- ^ Maximum line length (flood protection).
      mailMaxMessages  :: Int,     -- ^ Maximum number of messages (flood protection).
      mailOutputHandle :: Handle,  -- ^ Output handle (e.g. sending socket).
      mailTimeout      :: Int,     -- ^ Session timeout in milliseconds.
      mailTimeoutIO    :: Int      -- ^ Read/write timeout in milliseconds.
    }


-- | Default values for 'SendMail' with the given input and output
-- handle respectively.

defSendMail :: Handle -> Handle -> SendMail
defSendMail inH outH =
    SendMail { mailBufferSize = 4096,
               mailInputHandle = inH,
               mailMaxLine = 512,
               mailMaxMessages = 128,
               mailOutputHandle = outH,
               mailTimeout = 60000,
               mailTimeoutIO = 15000 }


-- | Execute the given mail session using the supplied configuration.
-- Please note that both handles must be set to binary mode and be
-- unbuffered.  See 'hSetBuffering' and 'hSetBinaryMode'.  This function
-- returns the mail session computation as well as the initial session
-- configuration for the underlying state monad.

sendMail ::
    forall a m. (MailMonad m, MonadIO m) =>
    SendMail -> Iteratee SmtpResponse m a ->
    (MailConfig, m (Either SomeException a))
sendMail cfg c = (state, comp)

    where
    comp :: m (Either SomeException a)
    comp =
        run $
        enumHandleTimeout bufSize timeout inH $$
        responseLines maxLine maxMsgs $ c

    state :: MailConfig
    state = MailConfig { mailExtensions = S.empty,
                         mailHandle = outH,
                         mailWriteTimeout = ioTimeout }

    SendMail { mailBufferSize = bufSize,
               mailInputHandle = inH,
               mailMaxLine = maxLine,
               mailMaxMessages = maxMsgs,
               mailOutputHandle = outH,
               mailTimeout = timeout,
               mailTimeoutIO = ioTimeout } = cfg


-- | Like 'sendMail', but throws an exception on error.

sendMail_ ::
    (MailMonad m, MonadIO m) =>
    SendMail -> Iteratee SmtpResponse m a -> (MailConfig, m a)
sendMail_ cfg = second (>>= either (liftIO . throwIO) return) . sendMail cfg