-- |
-- Module:     Network.Smtp.Simple
-- Copyright:  (c) 2010 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
-- Stability:  experimental
--
-- 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      -- ^ Receive 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 }


-- | Execute the given mail session using the supplied configuration.
-- Please note that both handles must be set to binary mode and the
-- input handle should be unbuffered ('NoBuffering').

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


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

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