ismtp 3.0.1 → 4.0.1
raw patch · 8 files changed
+181/−115 lines, 8 filesdep ~contstuffdep ~netlines
Dependency ranges changed: contstuff, netlines
Files
- Network/Smtp.hs +16/−19
- Network/Smtp/Connect.hs +3/−2
- Network/Smtp/Monad.hs +23/−50
- Network/Smtp/Session.hs +14/−11
- Network/Smtp/Simple.hs +36/−16
- Network/Smtp/Tools.hs +11/−0
- Network/Smtp/Types.hs +71/−11
- ismtp.cabal +7/−6
Network/Smtp.hs view
@@ -8,12 +8,11 @@ -- sessions, with which you can, among other things, send emails. Here -- is an example session: ----- > import Network.Smtp--- >--- > mailSession ::--- > MonadIO m =>--- > ByteString -> ByteString -> ByteString -> ByteString -> MailT r m ()--- > mailSession srcDomain fromAddr toAddr content = do+-- > testSession ::+-- > (MailMonad m, MonadIO m) =>+-- > ByteString -> ByteString -> ByteString -> ByteString ->+-- > Iteratee SmtpResponse m ()+-- > testSession srcDomain fromAddr toAddr content = do -- > waitForWelcome -- > hello srcDomain -- > mailFrom fromAddr@@ -21,12 +20,6 @@ -- > mailDataStr content -- > quit ----- The @r@ type parameter is related to contstuff's 'StateT' monad--- transformer, which is used internally. If you don't know what to do,--- just leave it fully polymorphic like in the example above. You only--- need to care about @r@, if you want to make use of the CPS features--- of 'StateT'.--- -- The simplest interfaces to running SMTP sessions are 'withSmtpConn' -- and 'withMxConn'. The latter does a DNS lookup for the given domain -- to discover the MX server and connect to it. The former simply@@ -36,14 +29,18 @@ -- parameters like timeout and flood protection, you may want to use -- 'sendMail' or 'sendMail_' instead. Those functions are also useful, -- if you want to run an SMTP session using stdin and stdout for testing--- and other purposes.+-- or if you want to combine multiple stateful iteratees. This also+-- means that you have to run the underlying state computation yourself+-- for whatever state monad you work in. See documentation for+-- 'sendMail'. ----- Finally you can use the low level interface for running sessions.--- See the 'runMailT' function along with 'enumHandleTimeout'. This way--- you get the full power of iteratees. For example you can run the--- session through a custom enumeratee, which enables you to wrap the--- session in another protocol (e.g. proxy servers or SSL). This is not--- possible with the higher level functions.+-- Finally you can use the low level interface for running sessions. In+-- this case you will need to use the iteratee functions directly. This+-- is normally not necessary, as 'sendMail' does most of the boilerplate+-- for you. It can become useful, when you want to use some+-- enumeratees, e.g. to encapsulate the session in SSL or to go through+-- a proxy server. You can use the 'responseLines' function to convert+-- a raw 'ByteString' stream to a stream of 'SmtpResponse's. module Network.Smtp ( -- * Reexports
Network/Smtp/Connect.hs view
@@ -62,8 +62,9 @@ forall a m. (Applicative m, MonadPeelIO m) => HostName -> PortID -> MailT a m a -> m a withSmtpConn host port c =- Ex.bracket connect (liftIO . hClose) $ \h -> do- sendMail_ (defSendMail h h) c+ Ex.bracket connect (liftIO . hClose) $ \h ->+ let (cfg, stateComp) = sendMail_ (defSendMail h h) c+ in evalStateT cfg stateComp where connect :: m Handle
Network/Smtp/Monad.hs view
@@ -6,36 +6,27 @@ -- -- This module implements a monad for SMTP sessions. -{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} module Network.Smtp.Monad- ( -- * Running sessions- runMailT,-- -- * Manipulating sessions- mailSetWriteTimeout,-- -- * Utility functions+ ( -- * Utility functions mailError,+ mailNetworkError, mailPut, mailPutLn, nextResponse ) where -import qualified Data.Set as S import Control.ContStuff---import Control.Exception.Peel as Ex import Data.ByteString (ByteString) import Data.ByteString.Char8 () import Data.Enumerator as E---import Data.Enumerator.Binary as EB 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 -- | Format a bad response together with the supplied error message and@@ -43,60 +34,42 @@ mailError :: Monad m =>- SmtpCommand -> String -> Integer -> Vector ByteString -> MailT r m a+ SmtpCommand -> String -> Integer -> Vector ByteString ->+ Iteratee SmtpResponse m b mailError cmd errMsg code msgs =- lift . throwError $ SmtpException errMsg cmd code (formatMsgs msgs)+ throwError $ SmtpSessionError errMsg cmd code (formatMsgs msgs) +-- | Throws an 'SmtpNetworkError' with the given message.++mailNetworkError :: Monad m => String -> Iteratee a m b+mailNetworkError = throwError . SmtpNetworkError++ -- | Send a stream of 'ByteString's to the SMTP server. -mailPut :: MonadIO m => Enumerator ByteString (MailT r m) () -> MailT r m ()+mailPut ::+ (MailMonad m, MonadIO m) =>+ Enumerator ByteString (Iteratee SmtpResponse m) () ->+ Iteratee SmtpResponse m () mailPut enum = do- h <- getField mailHandle- timeout <- getField mailWriteTimeout+ h <- lift getMailHandle+ timeout <- lift getMailWriteTimeout run (enum $$ iterHandleTimeout timeout h) >>=- either (lift . throwError) return+ either throwError return -- | Send a list of 'ByteString's followed an SMTP line terminator to -- the SMTP server. -mailPutLn :: MonadIO m => [ByteString] -> MailT r m ()+mailPutLn :: (MailMonad m, MonadIO m) => [ByteString] -> Iteratee SmtpResponse m () mailPutLn strs = mailPut $ concatEnums [enumList 16 strs, enumList 1 ["\r\n"]] --- | Set the write timeout for the current mail session in milliseconds.--mailSetWriteTimeout :: Int -> MailT r m ()-mailSetWriteTimeout timeout =- modify (\cfg -> cfg { mailWriteTimeout = timeout })-- -- | Retrieve the next SMTP response. Throw an 'Error', if there is no -- next response. -nextResponse :: Monad m => MailT r m SmtpResponse+nextResponse :: Monad m => Iteratee SmtpResponse m SmtpResponse nextResponse =- lift $ do- let smtpError = throwError $ userError "Connection closed prematurely"- EL.head >>= maybe smtpError return----- | Run a mail session computation with the given protocol line length--- limit (first argument), response lines limit (second argument) and--- output handle. The input is supplied by an 'Enumerator' such as--- 'enumHandleTimeout'.------ The inner iteratee uses 'SmtpResponse' as its input type and hence--- expects the 'netLines' and 'smtpResponses' enumeratees to be applied.--- This is done by 'runMailT' for you, so the resulting iteratee takes a--- raw 'ByteString' stream as input.--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+ EL.head >>=+ maybe (mailNetworkError "Connection closed prematurely") return
Network/Smtp/Session.hs view
@@ -36,7 +36,7 @@ -- | Try /EHLO/ with fallback to /HELO/. -hello :: forall m r. MonadIO m => ByteString -> MailT r m ()+hello :: forall m. (MailMonad m, MonadIO m) => ByteString -> Iteratee SmtpResponse m () hello domain = do mailPutLn ["EHLO ", domain] SmtpResponse code msgs <- nextResponse@@ -44,14 +44,14 @@ L.drop 1 . V.toList $ msgs case code of- 250 -> modify (\cfg -> cfg { mailExtensions = exts })+ 250 -> lift $ setMailExtensions exts 500 -> tryHelo 502 -> tryHelo 554 -> tryHelo _ -> mailError (SmtpHelloCmd domain) "EHLO rejected" code msgs where- tryHelo :: MailT r m ()+ tryHelo :: Iteratee SmtpResponse m () tryHelo = do mailPutLn ["HELO ", domain] SmtpResponse code msgs <- nextResponse@@ -63,7 +63,10 @@ -- | Send the /DATA/ command along with the mail content. Please note -- that the last line must be properly terminated by CRLF. -mailData :: MonadIO m => Enumerator ByteString (MailT r m) () -> MailT r m ()+mailData ::+ (MailMonad m, MonadIO m) =>+ Enumerator ByteString (Iteratee SmtpResponse m) () ->+ Iteratee SmtpResponse m () mailData enumMail = do mailPutLn ["DATA"] SmtpResponse code msgs <- nextResponse@@ -79,13 +82,13 @@ -- | 'ByteString' interface to 'mailData'. -mailDataStr :: MonadIO m => ByteString -> MailT r m ()+mailDataStr :: (MailMonad m, MonadIO m) => ByteString -> Iteratee SmtpResponse m () mailDataStr = mailData . enumList 1 . (:[]) -- | Send /MAIL FROM/ command. -mailFrom :: MonadIO m => ByteString -> MailT r m ()+mailFrom :: (MailMonad m, MonadIO m) => ByteString -> Iteratee SmtpResponse m () mailFrom from = do mailPutLn ["MAIL FROM:<", from, ">"] SmtpResponse code msgs <- nextResponse@@ -97,7 +100,7 @@ -- | Send /QUIT/ command. Please note: This iteratee violates the -- standard by recognizing a 250 result code as success. -quit :: MonadIO m => MailT r m ()+quit :: (MailMonad m, MonadIO m) => Iteratee SmtpResponse m () quit = do mailPutLn ["QUIT"] SmtpResponse code msgs <- nextResponse@@ -109,7 +112,7 @@ -- | Send /RCPT TO/ command. -rcptTo :: MonadIO m => ByteString -> MailT r m ()+rcptTo :: (MailMonad m, MonadIO m) => ByteString -> Iteratee SmtpResponse m () rcptTo to = do mailPutLn ["RCPT TO:<", to, ">"] SmtpResponse code msgs <- nextResponse@@ -120,7 +123,7 @@ -- | Send /RSET/ command. -reset :: MonadIO m => MailT r m ()+reset :: (MailMonad m, MonadIO m) => Iteratee SmtpResponse m () reset = do mailPutLn ["RSET"] SmtpResponse code msgs <- nextResponse@@ -137,7 +140,7 @@ -- false negatives to prevent spamming attempts. It is not recommended -- to use this command. -verify :: MonadIO m => ByteString -> MailT r m Bool+verify :: (MailMonad m, MonadIO m) => ByteString -> Iteratee SmtpResponse m Bool verify checkUser = do mailPutLn ["VRFY ", checkUser] SmtpResponse code msgs <- nextResponse@@ -149,7 +152,7 @@ -- | Wait for the welcome greeting from the SMTP server. -waitForWelcome :: Monad m => MailT r m ()+waitForWelcome :: MailMonad m => Iteratee SmtpResponse m () waitForWelcome = do SmtpResponse code msgs <- nextResponse case code of
Network/Smtp/Simple.hs view
@@ -6,6 +6,8 @@ -- -- Higher level interface to ismtp. +{-# LANGUAGE ScopedTypeVariables #-}+ module Network.Smtp.Simple ( -- * Execute sessions SendMail(..),@@ -15,10 +17,11 @@ ) where +import qualified Data.Set as S+import Control.Arrow import Control.ContStuff import Control.Exception.Peel import Data.Enumerator-import Network.Smtp.Monad import Network.Smtp.Tools import Network.Smtp.Types import System.IO@@ -54,23 +57,40 @@ -- | Execute the given mail session using the supplied configuration. -- Please note that both handles must be set to binary mode and be--- unbuffered. See 'hSetBuffering' and 'hSetBinaryMode'.+-- unbuffered. See 'hSetBuffering' and 'hSetBinaryMode'. This function+-- returns the mail session computation as well as the initial session+-- configuration for the underlying state monad. -sendMail :: (Applicative m, MonadIO m) =>- SendMail -> MailT a m a -> m (Either SomeException a)-sendMail cfg c = do- let SendMail { mailBufferSize = bufSize,- mailInputHandle = inH,- mailMaxLine = maxLine,- mailMaxMessages = maxMsgs,- mailOutputHandle = outH,- mailTimeout = timeout,- mailTimeoutIO = ioTimeout } = cfg- run $ enumHandleTimeout bufSize timeout inH $$- runMailT maxLine maxMsgs outH (mailSetWriteTimeout ioTimeout >> c)+sendMail ::+ forall a m. (MailMonad m, MonadIO m) =>+ SendMail -> Iteratee SmtpResponse m a ->+ (MailConfig, m (Either SomeException a))+sendMail cfg c = (state, comp) + where+ comp :: m (Either SomeException a)+ comp =+ run $+ enumHandleTimeout bufSize timeout inH $$+ responseLines maxLine maxMsgs $ c + state :: MailConfig+ state = MailConfig { mailExtensions = S.empty,+ mailHandle = outH,+ mailWriteTimeout = ioTimeout }++ SendMail { mailBufferSize = bufSize,+ mailInputHandle = inH,+ mailMaxLine = maxLine,+ mailMaxMessages = maxMsgs,+ mailOutputHandle = outH,+ mailTimeout = timeout,+ mailTimeoutIO = ioTimeout } = cfg++ -- | Like 'sendMail', but throws an exception on error. -sendMail_ :: (Applicative m, MonadIO m) => SendMail -> MailT a m a -> m a-sendMail_ cfg = sendMail cfg >=> either throwIO return+sendMail_ ::+ (MailMonad m, MonadIO m) =>+ SendMail -> Iteratee SmtpResponse m a -> (MailConfig, m a)+sendMail_ cfg = second (>>= either throwIO return) . sendMail cfg
Network/Smtp/Tools.hs view
@@ -11,6 +11,7 @@ module Network.Smtp.Tools ( enumHandleTimeout, formatMsgs,+ responseLines, smtpResponseLine, smtpResponse, smtpResponses,@@ -59,6 +60,16 @@ 45 -> return True 32 -> return False _ -> empty+++-- | Turns a raw 'ByteString' stream into a stream of SMTP response+-- lines with the given maximum line length (first argument) and maximum+-- number of lines per response (second argument).++responseLines ::+ Monad m => Int -> Int -> Iteratee SmtpResponse m b -> Iteratee ByteString m b+responseLines maxLine maxMsgs iter =+ netLines maxLine =$ smtpResponses maxMsgs =$ iter -- | Read the next SMTP response line from the given 'ByteString' lines
Network/Smtp/Types.hs view
@@ -6,10 +6,13 @@ -- -- Types used by ismtp. -{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE+ DeriveDataTypeable,+ FlexibleInstances #-} module Network.Smtp.Types- ( -- * Mail monad+ ( -- * Mail monads+ MailMonad(..), Mail, MailT, @@ -36,6 +39,58 @@ import Text.Printf +-- | Mail configuration state monad. Minimal complete definition:+-- 'mapMailConfig'.++class (Functor m, Monad m) => MailMonad m where+ -- | Get the current mail configuration.+ getMailConfig :: m MailConfig+ getMailConfig = mapMailConfig id++ -- | Get supported SMTP service extensions.+ getMailExtensions :: m (Set Extension)+ getMailExtensions = mailExtensions <$> getMailConfig++ -- | Get mail handle.+ getMailHandle :: m Handle+ getMailHandle = mailHandle <$> getMailConfig++ -- | Get write timeout for mail session in milliseconds.+ getMailWriteTimeout :: m Int+ getMailWriteTimeout = mailWriteTimeout <$> getMailConfig++ -- | Map over the current mail configuration with the given function+ -- and return the new configuration.+ mapMailConfig :: (MailConfig -> MailConfig) -> m MailConfig++ -- | Modify the current mail configuration.+ modifyMailConfig :: (MailConfig -> MailConfig) -> m ()+ modifyMailConfig = (() <$) . mapMailConfig++ -- | Set the current mail configuration.+ putMailConfig :: MailConfig -> m ()+ putMailConfig cfg = modifyMailConfig (const cfg)++ -- | Set the set of supported SMTP service extensions.+ setMailExtensions :: Set Extension -> m ()+ setMailExtensions exts =+ modifyMailConfig (\cfg -> cfg { mailExtensions = exts })++ -- | Set the ouput handle.+ setMailHandle :: Handle -> m ()+ setMailHandle h = modifyMailConfig (\cfg -> cfg { mailHandle = h })++ -- | Modify the mail write timeout.+ setMailWriteTimeout :: Int -> m ()+ setMailWriteTimeout timeout =+ modifyMailConfig (\cfg -> cfg { mailWriteTimeout = timeout })++instance MailMonad (StateT r MailConfig m) where+ mapMailConfig f =+ StateT $ \k s0 ->+ let s1 = f s0 in k s1 s1++ -- | Authentication methods for the SMTP authentication extension. data AuthMethod@@ -52,7 +107,7 @@ -- | The 'MailT' monad transformer encapsulates an SMTP session. -type MailT r m = StateT r MailConfig (Iteratee SmtpResponse m)+type MailT r m = Iteratee SmtpResponse (StateT r MailConfig m) -- | The 'Mail' monad is 'MailT' over 'IO'.@@ -85,19 +140,24 @@ -- | SMTP exception. -data SmtpException =- SmtpException {- smtpErrorMessage :: String,- smtpErrorCommand :: SmtpCommand,- smtpErrorCode :: Integer,- smtpErrorServerMessage :: String- }+data SmtpException+ = SmtpNetworkError {+ smtpErrorMessage :: String+ }+ | SmtpSessionError {+ smtpErrorMessage :: String,+ smtpErrorCommand :: SmtpCommand,+ smtpErrorCode :: Integer,+ smtpErrorServerMessage :: String+ }+ deriving Typeable instance Ex.Exception SmtpException instance Show SmtpException where- show (SmtpException msg _ code srvMsg) =+ show (SmtpNetworkError msg) = "SMTP network error: " ++ msg+ show (SmtpSessionError msg _ code srvMsg) = printf "%s (%i): \"%s\"" msg code srvMsg
ismtp.cabal view
@@ -1,5 +1,5 @@ Name: ismtp-Version: 3.0.1+Version: 4.0.1 Category: Network Synopsis: Advanced ESMTP library Maintainer: Ertugrul Söylemez <es@ertes.de>@@ -8,23 +8,23 @@ License: BSD3 License-file: LICENSE Build-type: Simple-Stability: beta+Stability: stable Cabal-version: >= 1.6 Description: - This library provides fast, incremental client-side ESMTP sessions- for mail exchangers and mail transfer agents.+ This library provides fast, incremental, iteratee-based client-side+ ESMTP sessions for mail exchangers and other mail transfer agents. Library Build-depends: base >= 4 && <= 5, bytestring >= 0.9.1.7, containers >= 0.3.0.0,- contstuff >= 1.2.4,+ contstuff >= 1.2.6, dnscache >= 1.0.1, enumerator >= 0.4.7, monad-peel >= 0.1,- netlines >= 0.4.3,+ netlines >= 1.0.0, network >= 2.2.1.7, vector >= 0.7.0.1 GHC-Options: -W@@ -41,6 +41,7 @@ -- Executable ismtp-test -- Build-depends: -- base >= 4 && <= 5,+-- cmdargs >= 0.6.8, -- unix -- GHC-Options: -W -threaded -- Main-is: Test.hs