module Network.Smtp.Session
(
hello,
mailData,
mailDataStr,
mailFrom,
quit,
rcptTo,
reset,
verify,
waitForWelcome
)
where
import qualified Data.Set as S
import qualified Data.Vector as V
import Control.ContStuff
import Data.ByteString (ByteString)
import Data.Enumerator as E
import Data.List as L
import Data.Maybe
import Network.Smtp.Monad
import Network.Smtp.Tools
import Network.Smtp.Types
hello :: forall m r. MonadIO m => ByteString -> MailT r m ()
hello domain = do
mailPutLn ["EHLO ", domain]
SmtpResponse code msgs <- nextResponse
let exts = S.fromList . catMaybes . L.map stringToExtension .
L.drop 1 . V.toList $ msgs
case code of
250 -> modify (\cfg -> cfg { mailExtensions = exts })
500 -> tryHelo
502 -> tryHelo
554 -> tryHelo
_ -> mailError (SmtpHelloCmd domain) "EHLO rejected" code msgs
where
tryHelo :: MailT r m ()
tryHelo = do
mailPutLn ["HELO ", domain]
SmtpResponse code msgs <- nextResponse
case code of
250 -> return ()
_ -> mailError (SmtpHelloCmd domain) "HELO rejected" code msgs
mailData :: MonadIO m => Enumerator ByteString (MailT r m) () -> MailT r m ()
mailData enumMail = do
mailPutLn ["DATA"]
SmtpResponse code msgs <- nextResponse
case code of
354 -> do
mailPut (enumMail >==> enumList 1 [".\r\n"])
SmtpResponse code2 msgs2 <- nextResponse
case code2 of
250 -> return ()
_ -> mailError SmtpDataCmd "Mail data rejected" code2 msgs2
_ -> mailError SmtpDataCmd "Mail rejected" code msgs
mailDataStr :: MonadIO m => ByteString -> MailT r m ()
mailDataStr = mailData . enumList 1 . (:[])
mailFrom :: MonadIO m => ByteString -> MailT r m ()
mailFrom from = do
mailPutLn ["MAIL FROM:<", from, ">"]
SmtpResponse code msgs <- nextResponse
case code of
250 -> return ()
_ -> mailError (SmtpMailFromCmd from) "MAIL FROM rejected" code msgs
quit :: MonadIO m => MailT r m ()
quit = do
mailPutLn ["QUIT"]
SmtpResponse code msgs <- nextResponse
case code of
221 -> return ()
250 -> return ()
_ -> mailError SmtpQuitCmd "Quit rejected" code msgs
rcptTo :: MonadIO m => ByteString -> MailT r m ()
rcptTo to = do
mailPutLn ["RCPT TO:<", to, ">"]
SmtpResponse code msgs <- nextResponse
case code of
250 -> return ()
_ -> mailError (SmtpRcptToCmd to) "RCPT TO rejected" code msgs
reset :: MonadIO m => MailT r m ()
reset = do
mailPutLn ["RSET"]
SmtpResponse code msgs <- nextResponse
case code of
250 -> return ()
_ -> mailError SmtpResetCmd "RSET rejected" code msgs
verify :: MonadIO m => ByteString -> MailT r m Bool
verify checkUser = do
mailPutLn ["VRFY ", checkUser]
SmtpResponse code msgs <- nextResponse
case code of
250 -> return True
550 -> return False
_ -> mailError (SmtpVerifyCmd checkUser) "VRFY rejected" code msgs
waitForWelcome :: Monad m => MailT r m ()
waitForWelcome = do
SmtpResponse code msgs <- nextResponse
case code of
220 -> return ()
_ -> mailError SmtpWelcomeCmd "We're not welcome" code msgs