SMTPClient 0.3 → 1.0

raw patch · 3 files changed

+78/−54 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Network/SMTP/Client.hs +46/−31
• Network/SMTP/ClientSession.hs +29/−20
• SMTPClient.cabal +3/−3

@@ -1,10 +1,15 @@ {-# LANGUAGE DeriveDataTypeable #-}  -- | An SMTP client in the IO Monad.+--+-- Data structures for representing SMTP status codes and email messages are+-- re-exported here from /Text.ParserCombinators.Parsec.Rfc2821/ and+-- /Text.ParserCombinators.Parsec.Rfc2822/ in the /hsemail/ package.  module Network.SMTP.Client (         sendSMTP,         sendSMTP',+        processSMTP,         SMTPException(..),         SmtpReply(..),         SmtpCode(..),@@ -37,15 +42,17 @@   -- | Send a list of email messages to an SMTP server. Throws SMTPException on--- failure at the communication protocol level.+-- failure at the communication protocol level, and it can also throw+-- socket-level exceptions. -- -- The optional IORef is used to store a list of statuses for messages sent so -- far, where Nothing means success.  The list elements correspond to the elements -- of the input message list.  If the caller catches an exception, this list is--- likely to be shorter than the input message list, and so it gives an indication--- of how many messages were dispatched.+-- likely to be shorter than the input message list:  The length of the list+-- indicates how many messages were dispatched.  If no exception is caught, the+-- length of the statuses will equal the length of the input messages list. ----- The message body may use either \"\\n\" or \"\\r\\n\" for an end-of-line+-- The message body may use either \"\\n\" or \"\\r\\n\" as an end-of-line -- marker and in either case it will be sent correctly to the server. sendSMTP ::             Maybe (IORef [Maybe SmtpReply]) -- ^ For storing failure statuses of messages sent so far@@ -64,39 +71,47 @@           -> [Message]          -- ^ List of messages to send           -> IO () sendSMTP' log mStatuses domain sockAddr messages = do-        sock <- socket AF_INET Stream defaultProtocol-        connect sock sockAddr-        handle <- socketToHandle sock ReadWriteMode+        handle <- bracketOnError+            (socket AF_INET Stream defaultProtocol)+            sClose+            (\sock -> do+                    connect sock sockAddr+                    socketToHandle sock ReadWriteMode+                )         (do                 let smtp = smtpClientSession domain messages-                process handle smtp+                processSMTP log mStatuses 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 ()+-- | A lower level function that does the I/O processing for an SMTP client session on a handle.+-- Returns when the session has completed, with the handle still open.+processSMTP :: (String -> IO ())               -- ^ Diagnostic log function+            -> Maybe (IORef [Maybe SmtpReply]) -- ^ For storing failure statuses of messages sent so far+            -> Handle+            -> SMTPState -> IO ()+processSMTP log mStatuses h state = do -            forM_ (smtpOutQueue state) $ \line -> do-                log $ "-> "++line-                hPutStr h line-                hPutStr h "\r\n"-                hFlush h+    case mStatuses of+        Just statuses -> writeIORef statuses (smtpStatuses state)+        Nothing -> return () -            case (smtpSuccess state, smtpFailure state) of-                (True, _) -> do-                    log "SUCCEEDED"-                (False, Just err) ->-                    throwIO $ SMTPException err-                otherwise -> do-                    -- Strip trailing \r. hGetLine has already stripped \n for us.-                    reply <- reverse . dropWhile (=='\r') . reverse <$> hGetLine h-                    log $ "<- "++reply-                    let state' = smtpReceive state reply $ state {smtpOutQueue = []}-                    process h state'+    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+            -- Strip trailing \r. hGetLine has already stripped \n for us.+            reply <- reverse . dropWhile (=='\r') . reverse <$> hGetLine h+            log $ "<- "++reply+            let state' = smtpReceive state reply $ state {smtpOutQueue = []}+            processSMTP log mStatuses h state'  -- | An exception indicating a communications failure at the level of the SMTP protocol. data SMTPException = SMTPException String

@@ -1,4 +1,8 @@ -- | A pure SMTP client state machine.+--+-- Data structures for representing SMTP status codes and email messages are+-- re-exported here from /Text.ParserCombinators.Parsec.Rfc2821/ and+-- /Text.ParserCombinators.Parsec.Rfc2822/ in the /hsemail/ package.  module Network.SMTP.ClientSession (         smtpClientSession,@@ -44,29 +48,32 @@  data SMTPState = SMTPState { -        -- | Step 1. Caller must output any lines queued up in this list.  They do not-        -- have end-of-line characters, so the caller must add \"\\r\\n\" on the-        -- end (as required by RFC2821 - not just \"\\n\").+        -- | Step 1. Caller must send any lines queued up in this list to the SMTP+        -- server.  They do not have end-of-line characters, so you must add+        -- \"\\r\\n\" on the end (both characters are required by RFC2821 - do not+        -- just send \"\\n\").         smtpOutQueue :: [String], -        -- | Step 2. When sends are completed, the caller should wait for a line from-        -- the SMTP server, strip the \"\\n\" end-of-line characters, and pass the-        -- line to this function for processing.-        smtpReceive  :: String -> SMTPState -> SMTPState,--        -- | Step 3. Check if this is True, which indicates that the SMTP session+        -- | Step 2. Check if this is True, which indicates that the SMTP session         -- has completed successfully and there is no more work to do.         smtpSuccess  :: Bool, -        -- | Step 4. Check if this is Just err, which indicates that a protocol error+        -- | Step 3. Check if this is Just err, which indicates that a protocol error         -- has occurred, and that the caller must terminate the session.         smtpFailure  :: Maybe String, +        -- | Step 4. The caller should wait for a line from the SMTP server,+        -- strip the \"\\r\\n\" end-of-line characters, and pass the stripped+        -- line to this function for processing.  Go to step 1.+        smtpReceive  :: String -> SMTPState -> SMTPState,+         -- | A list containing a failure status for each message that has been sent so far,         -- where each element corresponds to one in the list of messages.-        -- If the SMTP session fails part-way through, this list is likely to be-        -- shorter than the input messages list.-        -- "Nothing" means success, and "Just x" is a failure status returned by+        -- If the SMTP session does not complete successfully, then this list is+        -- likely to be shorter than the input messages list.  When smtpSuccess is+        -- true, this list is guaranteed to be the same length as the list of input+        -- messages.+        -- /Nothing/ means success, and /Just x/ is a failure status returned by         -- the SMTP server.         smtpStatuses :: [Maybe SmtpReply]     }@@ -78,6 +85,7 @@                 smtpOutQueue = txt:smtpOutQueue state             } +-- | A 'null' smtpReceive callback that discards anything given to it. nullReceive :: String -> SMTPState -> SMTPState nullReceive _ state = state @@ -114,14 +122,15 @@         otherwise -> False  check :: (SmtpReply -> Bool) -> String -> SmtpReply -> (SMTPState -> SMTPState) -> SMTPState -> SMTPState-check cond descr reply cont =-    if cond reply+check isOK descr reply cont =+    if isOK reply         then cont         else             fail $ "SMTP error: got "++                     (cleanUp $ show reply)++                     " when I expected "++descr +-- | Squish the SMTP reply description into one line. cleanUp :: String -> String cleanUp =     map (\x -> if x == '\n' then '/' else x) .@@ -155,7 +164,7 @@ receiveReply :: (SmtpReply -> SMTPState -> SMTPState) -> SMTPState -> SMTPState receiveReply cont =         rec [] $ \revMsgs@(final:_) ->-        if length(final) < 4 || final !! 3 /= ' ' then+        if length final < 4 || final !! 3 /= ' ' then             fail ("malformed SMTP reply: "++final)         else             case maybeRead (take 3 final) of@@ -167,7 +176,7 @@         rec :: [String] -> ([String] -> SMTPState -> SMTPState) -> SMTPState -> SMTPState         rec msgs cont =             receive $ \line ->-            if length(line) < 4 then+            if length line < 4 then                 fail ("malformed SMTP reply: "++line)             else if line !! 3 == '-' then                 rec (line:msgs) cont@@ -196,7 +205,7 @@ equalsDataOK = equals IntermediateSuccess MailSystem  -- | Construct a pure state machine for an SMTP client session.  Caller must--- handle I/O.  The message body may use either \"\\n\" or \"\\r\\n\" for an+-- handle I/O.  The message body may use either \"\\n\" or \"\\r\\n\" as an -- end-of-line marker. smtpClientSession :: String     -- ^ Domain name used in EHLO command                   -> [Message]  -- ^ List of messges to send@@ -225,7 +234,7 @@         sendMessages (message:rest) statuses cont =             sendMessage message $ \status ->             let statuses' = status:statuses in   -- collate statuses backwards-            putStatuses (reverse statuses') $    -- reverse to write smtpStatuses in correct order+            putStatuses (reverse statuses') $    -- reverse to store in correct order             sendMessages rest statuses' cont          sendMessage :: Message -> (Maybe SmtpReply -> SMTPState -> SMTPState) -> SMTPState -> SMTPState@@ -249,7 +258,7 @@             if null froms then                 fail "email contains no From: field"             else if null tos then-                fail "email contains to To: field"+                fail "email contains no To:, Cc: or Bcc: field"             else (                     send ((("MAIL FROM:"++) . angle_addr (head froms)) "") $                     receiveReply $ \reply ->

@@ -1,15 +1,15 @@ name: SMTPClient-version: 0.3+version: 1.0 license: BSD3 license-file: LICENSE cabal-version: >= 1.2 copyright: (c) Stephen Blackheath author: Stephen Blackheath maintainer: http://blacksapphire.com/antispam/-stability: release-candidate+stability: stable synopsis: A simple SMTP client description:-    A simple SMTP client+    A simple SMTP client for applications that want to send emails.     .     DARCS repository:     <http://blacksapphire.com/SMTPClient/>