diff --git a/Network/SMTP/Client.hs b/Network/SMTP/Client.hs
--- a/Network/SMTP/Client.hs
+++ b/Network/SMTP/Client.hs
@@ -1,13 +1,28 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 
+-- | An SMTP client in the IO Monad.
+
 module Network.SMTP.Client (
         sendSMTP,
-        sendSMTP_,
-        SMTPException(..)
+        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(..),
@@ -23,26 +38,32 @@
 
 -- | Send a list of email messages to an SMTP server. Throws SMTPException on
 -- failure at the communication protocol level.
--- The message body may contain either \"\n\" or \"\\r\\n\" for an end-of-line
--- marker and in all cases it will be sent correctly to the server.
-sendSMTP :: String      -- ^ Domain name for EHLO command
+--
+-- 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.
+--
+-- The message body may use either \"\\n\" or \"\\r\\n\" for 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
+         -> String      -- ^ Domain name for EHLO command
          -> SockAddr    -- ^ Network address of SMTP server
          -> [Message]   -- ^ List of messages to send
          -> IO ()
-sendSMTP = sendSMTP_ (\_ -> return ()) Nothing
+sendSMTP = sendSMTP' (\_ -> return ())
 
--- | Like sendSMTP_ but takes an additional function for logging all input and
--- output for diagnostic purposes.  Also an optional IORef for storing the
--- number of emails sent so far.  The emails are sent strictly in order, so this
--- count can be used when an exception is caught to mark sent emails.
-sendSMTP_ :: (String -> IO ())  -- ^ Diagnostic log function
-          -> Maybe (IORef Int)  -- ^ Optional IORef for storing the number of
-                                -- emails successfully sent so far.
+-- | Like sendSMTP but takes an additional function for logging all input and
+-- output for diagnostic purposes.
+sendSMTP' :: (String -> IO ())  -- ^ Diagnostic log function
+          -> Maybe (IORef [Maybe SmtpReply]) -- ^ For storing failure statuses of messages sent so far
           -> String             -- ^ Domain name for EHLO command
           -> SockAddr           -- ^ Network address of SMTP server
           -> [Message]          -- ^ List of messages to send
           -> IO ()
-sendSMTP_ log mSentSoFar domain sockAddr messages = do
+sendSMTP' log mStatuses domain sockAddr messages = do
         sock <- socket AF_INET Stream defaultProtocol
         connect sock sockAddr
         handle <- socketToHandle sock ReadWriteMode
@@ -54,17 +75,17 @@
         
         process :: Handle -> SMTPState -> IO ()
         process h state = do
-        
-            case mSentSoFar of
-                Just sentSoFar -> writeIORef sentSoFar (smtpSent state)
+
+            case mStatuses of
+                Just statuses -> writeIORef statuses (smtpStatuses state)
                 Nothing -> return ()
-        
-            forM_ (reverse $ smtpOutQueue state) $ \ line -> do
+
+            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"
@@ -73,11 +94,11 @@
                 otherwise -> do
                     -- Strip trailing \r. hGetLine has already stripped \n for us.
                     reply <- reverse . dropWhile (=='\r') . reverse <$> hGetLine h
-                    putStrLn $ "<- "++reply
+                    log $ "<- "++reply
                     let state' = smtpReceive state reply $ state {smtpOutQueue = []}
                     process h state'
 
-
+-- | An exception indicating a communications failure at the level of the SMTP protocol.
 data SMTPException = SMTPException String
     deriving (Eq, Show, Typeable)
 
diff --git a/Network/SMTP/ClientSession.hs b/Network/SMTP/ClientSession.hs
--- a/Network/SMTP/ClientSession.hs
+++ b/Network/SMTP/ClientSession.hs
@@ -1,6 +1,15 @@
+-- | A pure SMTP client state machine.
+
 module Network.SMTP.ClientSession (
         smtpClientSession,
-        SMTPState(..)
+        SMTPState(..),
+        SmtpReply(..),
+        SmtpCode(..),
+        SuccessCode(..),
+        Category(..),
+        Message(..),
+        Field(..),
+        NameAddr(..)
         {-, suite-}
     ) where
 
@@ -18,7 +27,7 @@
     )
 import Data.Maybe
 import qualified Data.Set as Set
-import Prelude hiding (fail, return)
+import Prelude hiding (fail)
 import Data.List
 import System.Time
 import System.Locale
@@ -35,33 +44,36 @@
 
 data SMTPState = SMTPState {
 
-        -- | Caller must output any lines queued up in this list, making sure to
-        -- clear them in the state passed back to smtpReceive.  These lines are in
-        -- reverse order, so the caller must reverse them before processing.
-        -- 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 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\").
         smtpOutQueue :: [String],
 
-        -- | When there is nothing to send, the caller should wait for a line from
-        -- the SMTP server, strip any end-of-line characters, and pass it to this
-        -- function for processing.
+        -- | 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,
 
-        -- | When True, this flag indicates that the SMTP session has completed
-        -- successfully and there is no more work to do.
+        -- | Step 3. Check if this is True, which indicates that the SMTP session
+        -- has completed successfully and there is no more work to do.
         smtpSuccess  :: Bool,
 
-        -- | When Just err, this indicates that a protocol error has occurred, and
-        -- that the caller must terminate the session.
+        -- | Step 4. 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,
 
-        -- | The number of emails successfully sent so far.
-        smtpSent     :: Int
+        -- | 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
+        -- the SMTP server.
+        smtpStatuses :: [Maybe SmtpReply]
     }
 
 send :: String -> (SMTPState -> SMTPState) -> SMTPState -> SMTPState
-send txt return state =
-    return $
+send txt cont state =
+    cont $
         state {
                 smtpOutQueue = txt:smtpOutQueue state
             }
@@ -72,23 +84,41 @@
 receive :: (String -> SMTPState -> SMTPState) -> SMTPState -> SMTPState
 receive cont state =
     state {
-            smtpReceive = \line state -> cont line $ state {smtpReceive = nullReceive}
+            -- Reverse the out queue before passing it to the caller because we
+            -- have been assembling it backwards.
+            smtpOutQueue = reverse $ smtpOutQueue state,
+            smtpReceive = \line state -> cont line $ state {
+                    smtpOutQueue = [],
+                    smtpReceive = nullReceive
+                }
         }
 
 fail :: String -> SMTPState -> SMTPState
 fail errorText state =
     state {
+            smtpOutQueue = [],
             smtpFailure = Just errorText
         }
 
 success :: SMTPState -> SMTPState
-success state = state {smtpSuccess = True}
+success state =
+    state {
+            smtpOutQueue = [],
+            smtpSuccess = True
+        }
 
-check :: SuccessCode -> Category -> String -> SmtpReply -> (SMTPState -> SMTPState) -> SMTPState -> SMTPState
-check code cat descr reply return =
+equals :: SuccessCode -> Category -> SmtpReply -> Bool
+equals code cat reply =
     case reply of
-        Reply (Code gotCode gotCat _) _ | gotCode == code && gotCat == cat -> return
-        _ -> fail $ "SMTP error: got "++
+        Reply (Code gotCode gotCat _) _ | gotCode == code && gotCat == cat -> True
+        otherwise -> False
+
+check :: (SmtpReply -> Bool) -> String -> SmtpReply -> (SMTPState -> SMTPState) -> SMTPState -> SMTPState
+check cond descr reply cont =
+    if cond reply
+        then cont
+        else
+            fail $ "SMTP error: got "++
                     (cleanUp $ show reply)++
                     " when I expected "++descr
 
@@ -99,71 +129,75 @@
     dropWhile (\x -> x == '\n') .
     reverse .
     filter (/= '\r')
- 
+
 maybeRead :: Read a => String -> Maybe a
 maybeRead s = case reads s of
     [(x, "")] -> Just x
     _         -> Nothing
 
-for :: [a] -> (a -> (SMTPState -> SMTPState) -> SMTPState -> SMTPState) -> (SMTPState -> SMTPState) -> SMTPState -> SMTPState
-for [] _ return = return
-for (x:xs) code return =
-    code x $
-    for xs code return
+for :: [a]
+       -- loop body, passed: value next
+    -> (a -> (SMTPState -> SMTPState) -> SMTPState -> SMTPState)
+    -> (SMTPState -> SMTPState)
+    -> SMTPState -> SMTPState
+for [] _ cont = cont
+for (x:xs) body cont =
+    body x $
+    for xs body cont
 
-incSent :: (SMTPState -> SMTPState) -> SMTPState -> SMTPState
-incSent return state = return $ state {smtpSent = smtpSent state + 1}
+putStatuses :: [Maybe SmtpReply] -> (SMTPState -> SMTPState) -> SMTPState -> SMTPState
+putStatuses statuses cont state = cont $ state {smtpStatuses = statuses}
 
 -- | Receive an SMTP reply, e.g.
 -- 250-worked
 -- 250-like
 -- 250 a charm
 receiveReply :: (SmtpReply -> SMTPState -> SMTPState) -> SMTPState -> SMTPState
-receiveReply return =
+receiveReply cont =
         rec [] $ \revMsgs@(final:_) ->
         if length(final) < 4 || final !! 3 /= ' ' then
             fail ("malformed SMTP reply: "++final)
         else
             case maybeRead (take 3 final) of
                 Just code ->
-                    return $ mkReply code (reverse $ map (drop 4) revMsgs)
+                    cont $ mkReply code (reverse $ map (drop 4) revMsgs)
                 Nothing ->
                     fail ("Malformed SMTP reply: "++final)
     where
         rec :: [String] -> ([String] -> SMTPState -> SMTPState) -> SMTPState -> SMTPState
-        rec msgs return =
+        rec msgs cont =
             receive $ \line ->
             if length(line) < 4 then
                 fail ("malformed SMTP reply: "++line)
             else if line !! 3 == '-' then
-                rec (line:msgs) return
+                rec (line:msgs) cont
             else
-                return (line:msgs)
+                cont (line:msgs)
 
         mkReply :: Int -> [String] -> SmtpReply
         mkReply code msgs = reply (code `div` 100) ((code `div` 10) `mod` 10) (code `mod` 10) msgs
 
+equalsMailOK :: SmtpReply -> Bool
+equalsMailOK = equals Success MailSystem
+
 checkMailOK :: (SMTPState -> SMTPState) -> SMTPState -> SMTPState
-checkMailOK return =
+checkMailOK cont =
     receiveReply $ \reply ->
-    check Success MailSystem "\"mail system OK\" (code 25x)" reply $
-    return
+    check equalsMailOK "\"mail system OK\" (code 25x)" reply $
+    cont
 
 checkConnectionOK :: (SMTPState -> SMTPState) -> SMTPState -> SMTPState
-checkConnectionOK return =
+checkConnectionOK cont =
     receiveReply $ \reply ->
-    check Success Connection "\"connection OK\" (code 22x)" reply $
-    return
+    check (equals Success Connection) "\"connection OK\" (code 22x)" reply $
+    cont
 
-checkDataOK :: (SMTPState -> SMTPState) -> SMTPState -> SMTPState
-checkDataOK return =
-    receiveReply $ \reply ->
-    check IntermediateSuccess MailSystem "\"connection OK\" (code 35x)" reply $
-    return
+equalsDataOK :: SmtpReply -> Bool
+equalsDataOK = equals IntermediateSuccess MailSystem
 
--- | Pure state machine for an SMTP client session.  Caller must handle I/O.
--- The message body may contain either \"\n\" or \"\\r\\n\" for an end-of-line
--- marker. All are stripped before passing to caller for dispatch.
+-- | 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
+-- end-of-line marker.
 smtpClientSession :: String     -- ^ Domain name used in EHLO command
                   -> [Message]  -- ^ List of messges to send
                   -> SMTPState
@@ -172,7 +206,7 @@
             smtpReceive  = nullReceive,
             smtpSuccess  = False,
             smtpFailure  = Nothing,
-            smtpSent     = 0
+            smtpStatuses = []
         }
 
 -- Continuation passing style.
@@ -181,20 +215,21 @@
         checkConnectionOK $
         send ("EHLO "++domain) $
         checkMailOK $
-        sendMessages messages $
+        sendMessages messages [] $
         send "QUIT" $
         checkConnectionOK $
         success
     where
-        sendMessages :: [Message] -> (SMTPState -> SMTPState) -> SMTPState -> SMTPState
-        sendMessages messages return =
-            for messages (\message cont ->
-                    sendMessage message cont
-                ) $
-            return
+        sendMessages :: [Message] -> [Maybe SmtpReply] -> (SMTPState -> SMTPState) -> SMTPState -> SMTPState
+        sendMessages [] _ cont = cont
+        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
+            sendMessages rest statuses' cont
 
-        sendMessage :: Message -> (SMTPState -> SMTPState) -> SMTPState -> SMTPState
-        sendMessage message return =
+        sendMessage :: Message -> (Maybe SmtpReply -> SMTPState -> SMTPState) -> SMTPState -> SMTPState
+        sendMessage message cont =
             let Message fields _ = message
 
                 froms = map (\(NameAddr _ addr) -> addr) $
@@ -217,23 +252,35 @@
                 fail "email contains to To: field"
             else (
                     send ((("MAIL FROM:"++) . angle_addr (head froms)) "") $
-                    checkMailOK $
-                    for tos (\to return ->
-                            send ((("RCPT TO:"++) . angle_addr to) "") $
-                            checkMailOK $
-                            return
-                        ) $
-                    send "DATA" $
-                    checkDataOK $
-                    let msgLines = formatMessage message in
-                    for msgLines (\line return ->
-                            send (if line == "." then ". " else line) $
-                            return
-                        ) $
-                    send "." $
-                    checkMailOK $
-                    incSent
-                    return
+                    receiveReply $ \reply ->
+                    if not $ equalsMailOK reply then
+                        cont (Just reply)  -- failure status
+                    else (
+                            for tos (\to next ->
+                                    send ((("RCPT TO:"++) . angle_addr to) "") $
+                                    receiveReply $ \reply ->
+                                    if not $ equalsMailOK reply
+                                        then cont (Just reply)  -- failure status
+                                        else next
+                                ) $
+                            send "DATA" $
+                            receiveReply $ \reply ->
+                            if not $ equalsDataOK reply then
+                                cont (Just reply)  -- failure status
+                            else (
+                                    let msgLines = formatMessage message in
+                                    for msgLines (\line cont ->
+                                            send (if line == "." then ". " else line) $
+                                            cont
+                                        ) $
+                                    send "." $
+                                    receiveReply $ \reply ->
+                                    if not $ equalsMailOK reply then
+                                        cont (Just reply)  -- failure status
+                                    else
+                                        cont Nothing  -- success
+                                )
+                        )
                 )
 
 atext_alphabet = Set.fromList $
diff --git a/SMTPClient.cabal b/SMTPClient.cabal
--- a/SMTPClient.cabal
+++ b/SMTPClient.cabal
@@ -1,12 +1,12 @@
 name: SMTPClient
-version: 0.2
+version: 0.3
 license: BSD3
 license-file: LICENSE
 cabal-version: >= 1.2
 copyright: (c) Stephen Blackheath
 author: Stephen Blackheath
 maintainer: http://blacksapphire.com/antispam/
-stability: beta
+stability: release-candidate
 synopsis: A simple SMTP client
 description:
     A simple SMTP client
diff --git a/example.hs b/example.hs
--- a/example.hs
+++ b/example.hs
@@ -1,16 +1,11 @@
 import Network.SMTP.ClientSession
 import Network.SMTP.Client
 import Network.Socket
-import Text.ParserCombinators.Parsec.Rfc2822
 import System.Time
 import System.IO
 import Data.Bits
 import Data.IORef
 
--- To do: Find out the proper way of doing this.
-intToPortNumber :: Int -> PortNumber
-intToPortNumber v = PortNum $ fromIntegral $ ((v `shiftR` 8) .|. (v `shiftL` 8)) .&. 0xffff
-
 myDomain = "example.com"
 smtpHost = "smtp.example.com"    -- <-- Your SMTP server here
 
@@ -29,12 +24,16 @@
              "Yours sincerely,\n"++
              "Mr. Nobody\n")
     addrs <- getAddrInfo Nothing (Just smtpHost) Nothing
-    let SockAddrInet _ hostAddr = addrAddress $ (addrs !! 0)
-    let sockAddr = SockAddrInet (intToPortNumber 25) hostAddr
+    let SockAddrInet _ hostAddr = addrAddress (addrs !! 0)
+        sockAddr = SockAddrInet (fromIntegral 25) hostAddr
     putStrLn $ "connecting to "++show sockAddr
-    sentRef <- newIORef 0
-    sendSMTP_ (hPutStrLn stderr) (Just sentRef) myDomain
+    sentRef <- newIORef []
+    sendSMTP' (hPutStrLn stderr) (Just sentRef) myDomain
         sockAddr [message]
-    sent <- readIORef sentRef
-    putStrLn $ "no of emails sent=" ++ show sent
+    statuses <- readIORef sentRef
+    -- If no exception was caught, statuses is guaranteed to be
+    -- the same length as the list of input messages, therefore head won't fail here.
+    case head statuses of
+        Nothing     -> putStrLn "Message successfully sent"
+        Just status -> putStrLn $ "Message send failed with status "++show status