Simple.hs

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

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

import Control.ContStuff
import Control.Exception.Peel
import Data.Enumerator
import Network.Smtp.Monad
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'.

sendMail :: (Applicative m, MonadIO m) =>
            SendMail -> MailT a m a -> m (Either SomeException a)
sendMail cfg c = do
    let SendMail { mailBufferSize = bufSize,
                   mailInputHandle = inH,
                   mailMaxLine = maxLine,
                   mailMaxMessages = maxMsgs,
                   mailOutputHandle = outH,
                   mailTimeout = timeout,
                   mailTimeoutIO = ioTimeout } = cfg
    run $ enumHandleTimeout bufSize timeout inH $$
          runMailT maxLine maxMsgs outH (mailSetWriteTimeout ioTimeout >> c)


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

sendMail_ :: (Applicative m, MonadIO m) => SendMail -> MailT a m a -> m a
sendMail_ cfg = sendMail cfg >=> either throwIO return