module Network.SMTP.Client (
sendSMTP,
sendSMTP',
SMTPException(..),
SmtpReply(..),
SmtpCode(..),
SuccessCode(..),
Category(..),
Message(..),
Field(..),
NameAddr(..)
) where
import Network.SMTP.ClientSession
import Control.Exception
import Text.ParserCombinators.Parsec.Rfc2821 (
SmtpReply(..),
SmtpCode(..),
SuccessCode(..),
Category(..)
)
import Text.ParserCombinators.Parsec.Rfc2822 (
Message(..),
Field(..),
NameAddr(..)
)
import Network.Socket
import Control.Applicative
import System.IO
import Control.Monad
import Data.Typeable
import Data.IORef
sendSMTP ::
Maybe (IORef [Maybe SmtpReply])
-> String
-> SockAddr
-> [Message]
-> IO ()
sendSMTP = sendSMTP' (\_ -> return ())
sendSMTP' :: (String -> IO ())
-> Maybe (IORef [Maybe SmtpReply])
-> String
-> SockAddr
-> [Message]
-> IO ()
sendSMTP' log mStatuses domain sockAddr messages = do
sock <- socket AF_INET Stream defaultProtocol
connect sock sockAddr
handle <- socketToHandle sock ReadWriteMode
(do
let smtp = smtpClientSession domain messages
process handle smtp
) `finally` hClose handle
where
process :: Handle -> SMTPState -> IO ()
process h state = do
case mStatuses of
Just statuses -> writeIORef statuses (smtpStatuses state)
Nothing -> return ()
forM_ (smtpOutQueue state) $ \line -> do
log $ "-> "++line
hPutStr h line
hPutStr h "\r\n"
hFlush h
case (smtpSuccess state, smtpFailure state) of
(True, _) -> do
log "SUCCEEDED"
(False, Just err) ->
throwIO $ SMTPException err
otherwise -> do
reply <- reverse . dropWhile (=='\r') . reverse <$> hGetLine h
log $ "<- "++reply
let state' = smtpReceive state reply $ state {smtpOutQueue = []}
process h state'
data SMTPException = SMTPException String
deriving (Eq, Show, Typeable)
instance Exception SMTPException where