module Network.Smtp.Monad
(
runMailT,
mailSetWriteTimeout,
mailError,
mailPut,
mailPutLn,
nextResponse
)
where
import qualified Data.Set as S
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
import System.IO
mailError ::
Monad m =>
SmtpCommand -> String -> Integer -> Vector ByteString -> MailT r m a
mailError cmd errMsg code msgs =
lift . throwError $ SmtpException errMsg cmd code (formatMsgs msgs)
mailPut :: MonadIO m => Enumerator ByteString (MailT r m) () -> MailT r m ()
mailPut enum = do
h <- getField mailHandle
timeout <- getField mailWriteTimeout
run (enum $$ iterHandleTimeout timeout h) >>=
either (lift . throwError) return
mailPutLn :: MonadIO m => [ByteString] -> MailT r m ()
mailPutLn strs = mailPut $ concatEnums [enumList 16 strs, enumList 1 ["\r\n"]]
mailSetWriteTimeout :: Int -> MailT r m ()
mailSetWriteTimeout timeout =
modify (\cfg -> cfg { mailWriteTimeout = timeout })
nextResponse :: Monad m => MailT r m SmtpResponse
nextResponse =
lift $ do
let smtpError = throwError $ userError "Connection closed prematurely"
EL.head >>= maybe smtpError return
runMailT :: (Applicative m, Monad m) =>
Int -> Int -> Handle -> MailT a m a ->
Iteratee ByteString m a
runMailT maxLine maxMsgs h c =
let cfg = MailConfig { mailExtensions = S.empty,
mailHandle = h,
mailWriteTimeout = 15000 }
in netLines maxLine =$ smtpResponses maxMsgs =$ evalStateT cfg c