Monad.hs

-- |
-- Module:     Network.Smtp.Monad
-- Copyright:  (c) 2011 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
--
-- This module implements a monad for SMTP sessions.

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

module Network.Smtp.Monad
    ( -- * Utility functions
      mailError,
      mailNetworkError,
      mailPut,
      mailPutLn,
      nextResponse
    )
    where

import Control.ContStuff
import Data.ByteString (ByteString)
import Data.ByteString.Char8 ()
import Data.Enumerator as E
import Data.Enumerator.List as EL
import Data.Enumerator.NetLines
import Data.Vector (Vector)
import Network.Smtp.Tools
import Network.Smtp.Types


-- | Format a bad response together with the supplied error message and
-- throw an 'SmtpException' in the underlying 'Iteratee'.

mailError ::
    Monad m =>
    SmtpCommand -> String -> Integer -> Vector ByteString ->
    Iteratee SmtpResponse m b
mailError cmd errMsg code msgs =
    throwError $ SmtpSessionError errMsg cmd code (formatMsgs msgs)


-- | Throws an 'SmtpNetworkError' with the given message.

mailNetworkError :: Monad m => String -> Iteratee a m b
mailNetworkError = throwError . SmtpNetworkError


-- | Send a stream of 'ByteString's to the SMTP server.

mailPut ::
    (MailMonad m, MonadIO m) =>
    Enumerator ByteString (Iteratee SmtpResponse m) () ->
    Iteratee SmtpResponse m ()
mailPut enum = do
    h <- lift getMailHandle
    timeout <- lift getMailWriteTimeout
    run (enum $$ iterHandleTimeout timeout h) >>=
        either throwError return


-- | Send a list of 'ByteString's followed an SMTP line terminator to
-- the SMTP server.

mailPutLn :: (MailMonad m, MonadIO m) => [ByteString] -> Iteratee SmtpResponse m ()
mailPutLn strs = mailPut $ concatEnums [enumList 16 strs, enumList 1 ["\r\n"]]


-- | Retrieve the next SMTP response.  Throw an 'Error', if there is no
-- next response.

nextResponse :: Monad m => Iteratee SmtpResponse m SmtpResponse
nextResponse =
    EL.head >>=
    maybe (mailNetworkError "Connection closed prematurely") return