HaskellNet 0.4 → 0.4.1
raw patch · 7 files changed
+209/−53 lines, 7 filesnew-uploaderPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Network.HaskellNet.SMTP: authenticate :: AuthType -> UserName -> Password -> SMTPConnection -> IO Bool
+ Network.HaskellNet.SMTP: sendPlainTextMail :: String -> String -> String -> Text -> SMTPConnection -> IO ()
Files
- CHANGELOG +18/−0
- HaskellNet.cabal +1/−1
- README.md +4/−2
- example/smtp.hs +57/−22
- src/Network/HaskellNet/Auth.hs +2/−2
- src/Network/HaskellNet/IMAP.hs +33/−11
- src/Network/HaskellNet/SMTP.hs +94/−15
CHANGELOG view
@@ -1,4 +1,22 @@ +0.4 -> 0.4.1+------------++ - login function for IMAP must escape the password+ Due to the possibility of the password contain special characters+ (See https://github.com/jtdaugherty/HaskellNet/issues/31)+ - Improved documentation for SMTP+ - Merge pull request #29 from lemol/master:+ Update on SMTP example+ - Merge pull request #26 from lemol/master:+ * Fix a bug when parsing the response of fetch in IMAP+ (See https://github.com/jtdaugherty/HaskellNet/issues/27)+ * Add a function for sending plain text email+ - Merge pull request #25 from lemol/master:+ Add a function for authentication in SMTP+ - Merge pull request #24 from lemol/master:+ Bug fix on PLAIN authentication encode+ 0.3 -> 0.4 ----------
HaskellNet.cabal view
@@ -4,7 +4,7 @@ SMTP, and IMAP protocols. NOTE: this package will be split into smaller, protocol-specific packages in the future.-Version: 0.4+Version: 0.4.1 Copyright: (c) 2006 Jun Mukai Author: Jun Mukai Maintainer: Jonathan Daugherty <cygnus@foobox.com>
README.md view
@@ -1,6 +1,8 @@ HaskellNet ========== +[](https://travis-ci.org/lemol/HaskellNet)+ This package provides client support for the E-mail protocols POP3, SMTP, and IMAP. @@ -11,8 +13,8 @@ ghci -hide-package monads-fd example/smtpMimeMail.hs main- -If you encounter problems and want to debug the ghci ++If you encounter problems and want to debug the ghci debugger works well: :set -fbreak-on-exception
example/smtp.hs view
@@ -1,32 +1,67 @@-import System.IO-import Network.HaskellNet.SMTP-import Text.Mime-import qualified Data.ByteString.Char8 as BS-import Codec.Binary.Base64.String+{-# OPTIONS -fno-warn-missing-signatures #-}+{-# LANGUAGE OverloadedStrings #-} +import Network.HaskellNet.SMTP+import Network.HaskellNet.Auth+import Network.Mail.Mime+import qualified Data.Text as T+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as B -smtpServer = "outmail.f2s.com"-sendFrom = "test@test.org"-sendTo = ["wrwills@gmail.com"]+-- | Your settings+server = "smtp.test.com"+port = toEnum 25+username = "username"+password = "password"+authType = PLAIN+from = "test@test.com"+to = "to@test.com"+subject = "Network.HaskellNet.SMTP Test :)"+plainBody = "Hello world!"+htmlBody = "<html><head></head><body><h1>Hello <i>world!</i></h1></body></html>"+attachments = [] -- example [("application/octet-stream", "/path/to/file1.tar.gz), ("application/pdf", "/path/to/file2.pdf")] +-- | Send plain text mail+example1 = doSMTP server $ \conn ->+ sendPlainTextMail to from subject plainBody conn -main = do- con <- connectSMTP smtpServer- message <- BS.readFile "example/message.txt"- messageHtml <- BS.readFile "example/message.html"- let textP = SinglePart [("Content-Type", "text/plain; charset=utf-8")] message- let htmlP = SinglePart [("Content-Type", "text/html; charset=utf-8")] messageHtml- let msg = MultiPart [("From", "Network.HaskellNet <" ++ sendFrom ++ ">"),("Subject","Test")] [htmlP, textP]- sendMail sendFrom sendTo (BS.pack $ show $ showMime "utf-8" msg) con- closeSMTP con- +-- | With custom port number+example2 = doSMTPPort server port $ \conn ->+ sendPlainTextMail to from subject plainBody conn +-- | Manually open and close the connection+example3 = do+ conn <- connectSMTP server+ sendPlainTextMail to from subject plainBody conn+ closeSMTP conn - --let msg = ([("From", "Network.HaskellNet <" ++ sendFrom ++ ">"),("Subject","Test")], MultiPart [] [textP, htmlP])- --sendMail sendFrom sendTo (BS.pack $ show $ showMessage "utf-8" msg) con--- let msg = ([("From", "Network.HaskellNet <" ++ sendFrom ++ ">"),("Subject","Test")], BS.pack "\r\nhello 算法是指完成一个任from haskellnet")+-- | Send mime mail+example4 = doSMTP server $ \conn ->+ sendMimeMail to from subject plainBody htmlBody [] conn ---htmlP = SinglePart [("Content-Type", "text/html; charset=utf-8", "Content-Transfer-Encoding", ""] BS.pack $ encode $ +-- | With attachments (modify the `attachments` binding)+example5 = doSMTP server $ \conn ->+ sendMimeMail to from subject plainBody htmlBody attachments conn +-- | With authentication+example6 = doSMTP server $ \conn -> do+ authSuccess <- authenticate authType username password conn+ if authSuccess+ then sendMimeMail to from subject plainBody htmlBody [] conn+ else putStrLn "Authentication failed." +-- | Custom+example7 = do+ conn <- connectSMTPPort server port+ let newMail = Mail (Address (Just "My Name") "from@test.org")+ [(Address Nothing "to@test.org")]+ [(Address Nothing "cc1@test.org"), (Address Nothing "cc2@test.org")]+ []+ [("Subject", T.pack subject)]+ [[htmlPart htmlBody, plainPart plainBody]]+ newMail' <- addAttachments attachments newMail+ renderedMail <- renderMail' newMail'+ sendMail from [to] (S.concat . B.toChunks $ renderedMail) conn+ closeSMTP conn +main = example1
src/Network/HaskellNet/Auth.hs view
@@ -32,7 +32,7 @@ b64Decode = map (toEnum.fromEnum) . B64.decode . map (toEnum.fromEnum) showOctet :: [Word8] -> String-showOctet = concat . map hexChars+showOctet = concatMap hexChars where hexChars c = [arr ! (c `div` 16), arr ! (c `mod` 16)] arr = listArray (0, 15) "0123456789abcdef" @@ -51,7 +51,7 @@ okey = zipWith xor key' opad plain :: UserName -> Password -> String-plain user pass = b64Encode $ concat $ intersperse "\0" [user, user, pass]+plain user pass = b64Encode $ intercalate "\0" ["", user, pass] login :: UserName -> Password -> (String, String) login user pass = (b64Encode user, b64Encode pass)
src/Network/HaskellNet/IMAP.hs view
@@ -204,7 +204,7 @@ bsClose (stream c) login :: IMAPConnection -> A.UserName -> A.Password -> IO ()-login conn username password = sendCommand conn ("LOGIN " ++ username ++ " " ++ password)+login conn username password = sendCommand conn ("LOGIN " ++ (escapeLogin username) ++ " " ++ (escapeLogin password)) pNone authenticate :: IMAPConnection -> A.AuthType@@ -338,36 +338,36 @@ fetch :: IMAPConnection -> UID -> IO ByteString fetch conn uid = do lst <- fetchByString conn uid "BODY[]"- return $ maybe BS.empty BS.pack $ lookup "BODY[]" lst+ return $ maybe BS.empty BS.pack $ lookup' "BODY[]" lst fetchHeader :: IMAPConnection -> UID -> IO ByteString fetchHeader conn uid = do lst <- fetchByString conn uid "BODY[HEADER]"- return $ maybe BS.empty BS.pack $ lookup "BODY[HEADER]" lst+ return $ maybe BS.empty BS.pack $ lookup' "BODY[HEADER]" lst fetchSize :: IMAPConnection -> UID -> IO Int fetchSize conn uid = do lst <- fetchByString conn uid "RFC822.SIZE"- return $ maybe 0 read $ lookup "RFC822.SIZE" lst+ return $ maybe 0 read $ lookup' "RFC822.SIZE" lst fetchHeaderFields :: IMAPConnection -> UID -> [String] -> IO ByteString fetchHeaderFields conn uid hs = do lst <- fetchByString conn uid ("BODY[HEADER.FIELDS "++unwords hs++"]") return $ maybe BS.empty BS.pack $- lookup ("BODY[HEADER.FIELDS "++unwords hs++"]") lst+ lookup' ("BODY[HEADER.FIELDS "++unwords hs++"]") lst fetchHeaderFieldsNot :: IMAPConnection -> UID -> [String] -> IO ByteString fetchHeaderFieldsNot conn uid hs = do let fetchCmd = "BODY[HEADER.FIELDS.NOT "++unwords hs++"]" lst <- fetchByString conn uid fetchCmd- return $ maybe BS.empty BS.pack $ lookup fetchCmd lst+ return $ maybe BS.empty BS.pack $ lookup' fetchCmd lst fetchFlags :: IMAPConnection -> UID -> IO [Flag] fetchFlags conn uid = do lst <- fetchByString conn uid "FLAGS"- return $ getFlags $ lookup "FLAGS" lst+ return $ getFlags $ lookup' "FLAGS" lst where getFlags Nothing = [] getFlags (Just s) = eval' dvFlags "" s @@ -376,7 +376,7 @@ fetchR conn r = do lst <- fetchByStringR conn r "BODY[]" return $ map (\(uid, vs) -> (uid, maybe BS.empty BS.pack $- lookup "BODY[]" vs)) lst+ lookup' "BODY[]" vs)) lst fetchByString :: IMAPConnection -> UID -> String -> IO [(String, String)] fetchByString conn uid command =@@ -388,7 +388,7 @@ fetchByStringR conn (s, e) command = fetchCommand conn ("UID FETCH "++show s++":"++show e++" "++command) proc where proc (n, ps) =- (maybe (toEnum (fromIntegral n)) read (lookup "UID" ps), ps)+ (maybe (toEnum (fromIntegral n)) read (lookup' "UID" ps), ps) fetchCommand :: IMAPConnection -> String -> ((Integer, [(String, String)]) -> b) -> IO [b]@@ -406,8 +406,8 @@ flgs (PlusFlags fs) = toFStr "+FLAGS" $ fstrs fs flgs (MinusFlags fs) = toFStr "-FLAGS" $ fstrs fs procStore (n, ps) = (maybe (toEnum (fromIntegral n)) read- (lookup "UID" ps)- ,maybe [] (eval' dvFlags "") (lookup "FLAG" ps))+ (lookup' "UID" ps)+ ,maybe [] (eval' dvFlags "") (lookup' "FLAG" ps)) store :: IMAPConnection -> UID -> FlagsQuery -> IO ()@@ -450,3 +450,25 @@ bsPutCrLf :: BSStream -> ByteString -> IO () bsPutCrLf h s = bsPut h s >> bsPut h crlf >> bsFlush h++lookup' :: String -> [(String, b)] -> Maybe b+lookup' _ [] = Nothing+lookup' q ((k,v):xs) | q == lastWord k = return v+ | otherwise = lookup' q xs+ where+ lastWord = last . words++-- TODO: This is just a first trial solution for this stack overflow question:+-- http://stackoverflow.com/questions/26183675/error-when-fetching-subject-from-email-using-haskellnets-imap+-- It must be reviewed. References: rfc3501#6.2.3, rfc2683#3.4.2.+-- This function was tested against the password: `~1!2@3#4$5%6^7&8*9(0)-_=+[{]}\|;:'",<.>/? (with spaces in the laterals).+escapeLogin :: String -> String+escapeLogin x = "\"" ++ replaceSpecialChars x ++ "\""+ where+ replaceSpecialChars "" = ""+ replaceSpecialChars (c:cs) = escapeChar c ++ replaceSpecialChars cs+ escapeChar '"' = "\\\""+ escapeChar '\\' = "\\\\"+ escapeChar '{' = "\\{"+ escapeChar '}' = "\\}"+ escapeChar s = [s]
src/Network/HaskellNet/SMTP.hs view
@@ -1,4 +1,49 @@ {-# LANGUAGE ScopedTypeVariables #-}+{- |++This module provides functions for working with the SMTP protocol in the client side,+including /opening/ and /closing/ connections, /sending commands/ to the server,+/authenticate/ and /sending mails/.++Here's a basic usage example:++>+> import Network.HaskellNet.SMTP+> import Network.HaskellNet.Auth+> import qualified Data.Text.Lazy as T+>+> main = doSMTP "your.smtp.server.com" $ \conn ->+> authSucceed <- authenticate PLAIN "username" "password" conn+> if authSucceed+> then sendPlainTextMail "receiver@server.com" "sender@server.com" "subject" (T.pack "Hello! This is the mail body!") conn+> else print "Authentication failed."++Notes for the above example:++ * First the 'SMTPConnection' is opened with the 'doSMTP' function.+ The connection should also be established with functions such as 'connectSMTP',+ 'connectSMTPPort' and 'doSMTPPort'.+ With the @doSMTP*@ functions the connection is opened, then executed an action+ with it and then closed automatically.+ If the connection is opened with the @connectSMTP*@ functions you may want to+ close it with the 'closeSMTP' function after using it.+ It is also possible to create a 'SMTPConnection' from an already opened connection+ stream ('BSStream') using the 'connectStream' or 'doSMTPStream' functions.++ /NOTE:/ For /SSL\/TLS/ support you may establish the connection using+ the functions (such as @connectSMTPSSL@) provided in the+ @Network.HaskellNet.SMTP.SSL@ module of the+ <http://hackage.haskell.org/package/HaskellNet-SSL HaskellNet-SSL>+ package.++ * The 'authenticate' function authenticates to the server with the specified 'AuthType'.+ 'PLAIN', 'LOGIN' and 'CRAM_MD5' 'AuthType's are available. It returns a 'Bool'+ indicating either the authentication succeed or not.+++ * To send a mail you can use 'sendPlainTextMail' for plain text mail, or 'sendMimeMail'+ for mime mail.+-} module Network.HaskellNet.SMTP ( -- * Types Command(..)@@ -12,10 +57,12 @@ , sendCommand , closeSMTP -- * Other Useful Operations + , authenticate , sendMail , doSMTPPort , doSMTP , doSMTPStream+ , sendPlainTextMail , sendMimeMail ) where@@ -34,8 +81,6 @@ import Network.HaskellNet.Auth -import System.IO- import Network.Mail.Mime import qualified Data.ByteString.Lazy as B import qualified Data.ByteString as S@@ -43,8 +88,6 @@ import qualified Data.Text.Lazy as LT import qualified Data.Text as T -import Prelude hiding (catch)- -- The response field seems to be unused. It's saved at one place, but never -- retrieved. data SMTPConnection = SMTPC { bsstream :: !BSStream, _response :: ![ByteString] }@@ -110,7 +153,7 @@ _ | code == expectedReply -> return msg _ | tries > 1 -> tryCommand conn cmd (tries - 1) expectedReply- _ | otherwise -> do+ | otherwise -> do bsClose (bsstream conn) fail $ "cannot execute command " ++ show cmd ++ ", expected reply code " ++ show expectedReply ++@@ -136,7 +179,7 @@ let (c, bdy) = BS.span isDigit l if not (BS.null bdy) && BS.head bdy == '-' then do (c2, ls) <- readLines- return (c2, (BS.tail bdy:ls))+ return (c2, BS.tail bdy:ls) else return (c, [BS.tail bdy]) @@ -148,7 +191,7 @@ unless (code == 354) $ fail "this server cannot accept any data." mapM_ sendLine $ BS.lines dat ++ [BS.pack "."] parseResponse conn- where sendLine l = bsPutCrLf conn l+ where sendLine = bsPutCrLf conn sendCommand (SMTPC conn _) (AUTH LOGIN username password) = do bsPutCrLf conn command (_, _) <- parseResponse conn@@ -156,7 +199,7 @@ (_, _) <- parseResponse conn bsPutCrLf conn $ BS.pack passB64 parseResponse conn- where command = BS.pack $ "AUTH LOGIN"+ where command = BS.pack "AUTH LOGIN" (userB64, passB64) = login username password sendCommand (SMTPC conn _) (AUTH at username password) = do bsPutCrLf conn command@@ -183,7 +226,7 @@ QUIT -> "QUIT" (DATA _) -> error "BUG: DATA pattern should be matched by sendCommand patterns"- (AUTH _ _ _) ->+ (AUTH {}) -> error "BUG: AUTH pattern should be matched by sendCommand patterns" -- | close the connection. This function send the QUIT method, so you@@ -204,6 +247,21 @@ bsClose conn `catch` \(_ :: IOException) -> return () -} +{- |+This function will return 'True' if the authentication succeeds.+Here's an example of sending a mail with a server that requires+authentication:++> authSucceed <- authenticate PLAIN "username" "password" conn+> if authSucceed+> then sendPlainTextMail "receiver@server.com" "sender@server.com" "subject" (T.pack "Hello!") conn+> else print "Authentication failed."+-}+authenticate :: AuthType -> UserName -> Password -> SMTPConnection -> IO Bool+authenticate at username password conn = do+ (code, _) <- sendCommand conn $ AUTH at username password+ return (code == 235)+ -- | sending a mail to a server. This is achieved by sendMessage. If -- something is wrong, it raises an IOexception. sendMail :: String -- ^ sender mail@@ -223,21 +281,42 @@ -- | doSMTPPort open a connection, and do an IO action with the -- connection, and then close it. doSMTPPort :: String -> PortNumber -> (SMTPConnection -> IO a) -> IO a-doSMTPPort host port execution =- bracket (connectSMTPPort host port) closeSMTP execution+doSMTPPort host port =+ bracket (connectSMTPPort host port) closeSMTP -- | doSMTP is similar to doSMTPPort, except that it does not require -- port number but connects to the server with port 25. doSMTP :: String -> (SMTPConnection -> IO a) -> IO a-doSMTP host execution = doSMTPPort host 25 execution+doSMTP host = doSMTPPort host 25 -- | doSMTPStream is similar to doSMTPPort, except that its argument -- is a Stream data instead of hostname and port number. doSMTPStream :: BSStream -> (SMTPConnection -> IO a) -> IO a-doSMTPStream s execution = bracket (connectStream s) closeSMTP execution+doSMTPStream s = bracket (connectStream s) closeSMTP -sendMimeMail :: String -> String -> String -> LT.Text- -> LT.Text -> [(T.Text, FilePath)] -> SMTPConnection -> IO ()+-- | Send a plain text mail.+sendPlainTextMail :: String -- ^ receiver+ -> String -- ^ sender+ -> String -- ^ subject+ -> LT.Text -- ^ body+ -> SMTPConnection -- ^ the connection+ -> IO ()+sendPlainTextMail to from subject body con = do+ renderedMail <- renderMail' myMail+ sendMail from [to] (lazyToStrict renderedMail) con+ where+ myMail = simpleMail' (address to) (address from) (T.pack subject) body+ address = Address Nothing . T.pack++-- | Send a mime mail.+sendMimeMail :: String -- ^ receiver+ -> String -- ^ sender+ -> String -- ^ subject+ -> LT.Text -- ^ plain text body+ -> LT.Text -- ^ html body+ -> [(T.Text, FilePath)] -- ^ attachments: [(content_type, path)]+ -> SMTPConnection+ -> IO () sendMimeMail to from subject plainBody htmlBody attachments con = do myMail <- simpleMail (address to) (address from) (T.pack subject) plainBody htmlBody attachments