HaskellNet 0.5.3 → 0.6

raw patch · 8 files changed

+735/−312 lines, 8 filesdep +base64dep −base64-stringPVP ok

version bump matches the API change (PVP)

Dependencies added: base64

Dependencies removed: base64-string

API changes (from Hackage documentation)

Files

• CHANGELOG +19/−0
• HaskellNet.cabal +13/−11
• Updating.md +31/−0
• example/smtp.hs +21/−15
• example/smtp2.hs +34/−0
• src/Network/HaskellNet/Auth.hs +5/−7
• src/Network/HaskellNet/SMTP.hs +256/−279
• src/Network/HaskellNet/SMTP/Internal.hs +356/−0

@@ -1,3 +1,22 @@+0.6 (2020-12-27)+----------------+  - sendMail API was simplified (see Updating.md for details)+  - Functions for graceful close were introduced.+  - Use Text type instead of String internally.+  - Use mime-mail.Address type instead of String for representing+    addresses. (Issues #78, #59)+  - Introduce SMTP exceptions family and move to using that+    from fail method.+  - Fixes possible double handle close in case of exceptions (Issue #76)+  - SMTP: Fix issue with extra flushes. Now there are twice+    as few messages during communication and that largely improves+    communication speed.+  - Module HaskellNet.SMTP.Internal was introduced. It contains+    internal functions that may be useful when implementing primitives.+    There is no API stability guarantees on the module.+  - SMTP documentation largely improved+  - Package moved from base64-string to base64 package (Issue #61)+ 0.5.3 (2020-12-22) ------------------ 

@@ -1,10 +1,12 @@ Name:           HaskellNet Synopsis:       Client support for POP3, SMTP, and IMAP Description:    This package provides client support for the POP3,-                SMTP, and IMAP protocols.  NOTE: this package will be-                split into smaller, protocol-specific packages in the-                future.-Version:        0.5.3+                SMTP, and IMAP protocols.+                .+                Full examples can be found in the <https://github.com/qnikst/HaskellNet/tree/master/example repository>.+                Additional documentation on the major updates can be found in the+                <https://github.com/qnikst/HaskellNet/blob/master/Updating.md Updating.md> file+Version:        0.6 Copyright:      (c) 2006 Jun Mukai Author:         Jun Mukai Maintainer:     Alexander Vershilov <alexander.vershilov@sirius.online>,@@ -14,14 +16,10 @@ License-file:   LICENSE Category:       Network Homepage:       https://github.com/qnikst/HaskellNet-Cabal-version:  >=1.10+Cabal-version:  1.22 Build-type:     Simple Tested-with:-  GHC ==7.8.4-   || ==7.10.3-   || ==8.0.2-   || ==8.2.2-   || ==8.4.4+  GHC ==8.4.4    || ==8.6.5    || ==8.8.4    || ==8.10.2@@ -29,6 +27,7 @@ Extra-Source-Files:   CHANGELOG   README.md+  Updating.md   example/*.hs  Source-Repository head@@ -51,6 +50,7 @@     Network.HaskellNet.IMAP.Types     Network.HaskellNet.IMAP.Parsers     Network.HaskellNet.SMTP+    Network.HaskellNet.SMTP.Internal     Network.HaskellNet.POP3     Network.HaskellNet.POP3.Connection     Network.HaskellNet.POP3.Types@@ -62,6 +62,8 @@     Network.Compat     Text.Packrat.Pos     Text.Packrat.Parse+  Reexported-modules:+    Network.Mail.Mime    Build-Depends:     base >= 4.3 && < 4.15,@@ -71,7 +73,7 @@     pretty,     array,     cryptohash-md5,-    base64-string,+    base64,     old-time,     mime-mail >= 0.4.7 && < 0.6,     text

@@ -0,0 +1,31 @@+# Updating++This document explains how to update package between major versions+of the package.++0.5.x -> 0.6+============++1. Sender, Recipient types were changed from 'Data.Text.Text' to+[Network.Mail.Mime.Address](http://hackage.haskell.org/package/mime-mail-0.5.0/docs/Network-Mail-Mime.html#t:Address).+   This change allows better interoperability with 'mime-mail' package, in addition+   it solved a problem with specifying sender address in the API.+   As Address type implements 'IsString' type class then just having '-XOverloadedStrings'+   extension will be enough. However you should note, that "FirstName LastName <email>"+   will be parsed as `Address Nothing "FirstName LastName <email>"` and not as+   `Address (Just "FirstName LastName") "email"`, it may be surprising but that functionality+   didn't work with older HaskellNet, so it was not changed.+2. Exception. Previously the package exposed only `IOException` custom exceptions were send+   using `failure` (`UserException` constructor). Now there is `SMTPException` family, so+   if you used to capture SMTP exceptions by processing `IOExceptions` you should capture+   `SMTPException` now. The package may still expose `IOException` in case of a network+   failure.+3. `Subject` type is now using Text. Enabling `-XOverladedStrings` extension should help+   in this case.+4. All mail sending functions were deprecated instead of them there is the 'sendMail'+   function. Documentation and deprecation warning for each function explains how to change+   the code to make it work.+5. Now all `doSmtp*` functions implements graceful close, and there is a new `gracefullyCloseSMTP`+   function to run graceful close, you may consider switching to that function from `closeSTMP`.+   However it should be done with care as `gracefullyCloseSTMP` can be run only on the+   connection that is in a awaiting command from the user state.

@@ -22,37 +22,44 @@ 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+example1 = doSMTP server $ \conn -> do+    let mail = simpleMail' to from subject plainBody+    sendMail mail conn  -- | With custom port number-example2 = doSMTPPort server port $ \conn ->-    sendPlainTextMail to from subject plainBody conn+example2 = doSMTPPort server port $ \conn -> do+    let mail = simpleMail' to from subject plainBody+    sendMail mail conn  -- | Manually open and close the connection example3 = do     conn <- connectSMTP server-    sendPlainTextMail to from subject plainBody conn+    let mail = simpleMail' to from subject plainBody+    sendMail mail conn     closeSMTP conn  -- | Send mime mail-example4 = doSMTP server $ \conn ->-    sendMimeMail to from subject plainBody htmlBody [] conn+example4 = doSMTP server $ \conn -> do+    mail <-  simpleMail to from subject plainBody htmlBody []+    sendMail mail conn  -- | With file attachments (modify the `attachments` binding)-example5 = doSMTP server $ \conn ->-    sendMimeMail to from subject plainBody htmlBody attachments conn+example5 = doSMTP server $ \conn -> do+    mail <-  simpleMail to from subject plainBody htmlBody attachments+    sendMail mail conn  -- | With ByteString attachments bsContent = B.pack [43,43,43,43]-example5_2 = doSMTP server $ \conn ->-    sendMimeMail' to from subject plainBody htmlBody [("application/zip", "filename.zip", bsContent)] conn+example5_2 = doSMTP server $ \conn -> do+    let mail = simpleMailInMemory to from subject plainBody htmlBody [("application/zip", "filename.zip", bsContent)]+    sendMail mail conn  -- | With authentication example6 = doSMTP server $ \conn -> do     authSuccess <- authenticate authType username password conn     if authSuccess-        then sendMimeMail to from subject plainBody htmlBody [] conn+        then do mail <- simpleMail to from subject plainBody htmlBody []+                sendMail mail conn         else putStrLn "Authentication failed."  -- | Custom@@ -62,11 +69,10 @@                        [(Address Nothing "to@test.org")]                        [(Address Nothing "cc1@test.org"), (Address Nothing "cc2@test.org")]                        []-                       [("Subject", T.pack subject)]+                       [("Subject", subject)]                        [[htmlPart htmlBody, plainPart plainBody]]     newMail' <- addAttachments attachments newMail-    renderedMail <- renderMail' newMail'-    sendMail from [to] (S.concat . B.toChunks $ renderedMail) conn+    sendMail newMail' conn     closeSMTP conn  main = example1

@@ -0,0 +1,34 @@+{-# OPTIONS -fno-warn-missing-signatures #-}+{-# LANGUAGE OverloadedStrings #-}++import           Network.HaskellNet.Auth+import           Network.HaskellNet.SMTP+import           Network.HaskellNet.SMTP.SSL+import           Network.Mail.Mime+import Network.HaskellNet.Debug+import Control.Monad+import qualified Data.Text as T+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as B++-- | Your settings+server       = "smtp.yandex.ru"+username     = "no-reply@cheops.olimpiada.ru"+password     = "Voo3gahm"+authType     = PLAIN+from         = Address (Just "A V") "no-reply@cheops.olimpiada.ru"+to           = Address (Just "V A") "alexander.vershilov@gmail.com"+subject      = "Network.HaskellNet.SMTP Test :)"+plainBody    = "Hello world!\r\n.\r\nsomething else"+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")]++main = do+  conn <- connectSMTPSSLWithSettings server defaultSettingsSMTPSSL{sslLogToConsole=True}+  authSucceed <- authenticate PLAIN (T.unpack username) (T.unpack password) conn+  when authSucceed $ do+    let newMail = Mail from [to] [] [] [("Subject", T.pack subject)] [[htmlPart htmlBody, plainPart plainBody]]+    newMail' <- addAttachments attachments newMail+    sendMail newMail' conn+  Network.HaskellNet.SMTP.SSL.closeSMTP conn+

@@ -2,17 +2,19 @@ where  import Crypto.Hash.MD5-import qualified Codec.Binary.Base64.String as B64 (encode, decode)+import Data.Text.Encoding.Base64 as B64  import Data.Word import Data.List import Data.Bits import Data.Array import qualified Data.ByteString as B+import qualified Data.Text as T  type UserName = String type Password = String +-- | Authorization types supported by the <https://www.ietf.org/rfc/rfc4954.txt RFC5954> data AuthType = PLAIN               | LOGIN               | CRAM_MD5@@ -26,14 +28,10 @@               showMain CRAM_MD5 = "CRAM-MD5"  b64Encode :: String -> String-b64Encode = map (toEnum.fromEnum)-          -- Hotfix for https://github.com/jtdaugherty/HaskellNet/issues/61-          . delete '\n'-          . B64.encode-          . map (toEnum.fromEnum)+b64Encode = T.unpack . B64.encodeBase64 . T.pack  b64Decode :: String -> String-b64Decode = map (toEnum.fromEnum) . B64.decode . map (toEnum.fromEnum)+b64Decode = T.unpack . B64.decodeBase64Lenient . T.pack  showOctet :: [Word8] -> String showOctet = concatMap hexChars

@@ -1,141 +1,167 @@ {-# 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."+This module provides functions client side of the SMTP protocol. -Notes for the above example:+A basic usage 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.+@+\{\-\# LANGUAGE OverloadedStrings \#\-\}+import "Network.HaskellNet.SMTP"+import "Network.HaskellNet.Auth"+import "Network.Mail.Mime"+import "System.Exit" (die) -     /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.+main :: IO ()+main = 'doSMTP' "your.smtp.server.com" $ \\conn -> do -- (1)+   authSucceed <- 'authenticate' 'PLAIN' "username" "password" conn -- (2)+   if authSucceed+   then do+     let mail = 'Network.Mail.Mime.simpleMail''+           "receiver\@server.com"+           "sender\@server.com"+           "subject"+           "Hello! This is the mail body!"+     sendMail mail conn -- (3)+   else die "Authentication failed."+@ -   * 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.+Notes for the above example: +   * @(1)@ The connection (@conn::@'SMTPConnection') is opened using the 'doSMTP' function.+     We can use this connection to communicate with @SMTP@ server.+   * @(2)@ The 'authenticate' function authenticates to the server with the specified 'AuthType'.+     It returns a 'Bool' indicating either the authentication succeed or not.+   * @(3)@ The 'sendMail' is used to send a email a plain text email. -   * To send a mail you can use 'sendPlainTextMail' for plain text mail, or 'sendMimeMail'-     for mime mail.+__N.B.__ For /SSL\/TLS/ support you may establish the connection using+  the functions (such as @connectSMTPSSL@) provided by the @Network.HaskellNet.SMTP.SSL@ module+  of the <http://hackage.haskell.org/package/HaskellNet-SSL HaskellNet-SSL> package. -} module Network.HaskellNet.SMTP-    ( -- * Types-      Command(..)-    , Response(..)-    , AuthType(..)-    , SMTPConnection-      -- * Establishing Connection-    , connectSMTPPort-    , connectSMTP-    , connectStream-      -- * Operation to a Connection-    , sendCommand-    , closeSMTP-      -- * Other Useful Operations-    , authenticate-    , sendMail+    ( -- * Workflow+      -- $workflow++      -- ** Controlling connections+      -- $controlling-connections+      SMTPConnection+      -- $controlling-connections-1     , doSMTPPort     , doSMTP     , doSMTPStream+      -- $controlling-connections-2++      -- ** Authentication+    , authenticate+      -- $authentication+    , AuthType(..)++      -- ** Sending emails+      -- $sending-mail+    , sendMail+      -- *** Deprecated functions     , sendPlainTextMail     , sendMimeMail     , sendMimeMail'     , sendMimeMail2-    )-    where+      -- * Low level commands+      -- ** Establishing Connection+      -- $low-level-connection+    , connectSMTPPort+    , connectSMTP+    , connectStream+    , closeSMTP+    , gracefullyCloseSMTP+    , SMTPException(..)+    ) where  import Network.HaskellNet.BSStream-import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS import Network.BSD (getHostName) import Network.Socket import Network.Compat -import Control.Applicative ((<$>))+import Control.Applicative import Control.Exception import Control.Monad (unless, when) -import Data.Char (isDigit)- import Network.HaskellNet.Auth  import Network.Mail.Mime import qualified Data.ByteString.Lazy as B-import qualified Data.ByteString as S  import qualified Data.Text.Lazy as LT import qualified Data.Text as T --- The response field seems to be unused. It's saved at one place, but never--- retrieved.-data SMTPConnection = SMTPC { bsstream :: !BSStream, _response :: ![ByteString] }+import GHC.Stack+import Prelude+import Network.HaskellNet.SMTP.Internal -data Command = HELO String-             | EHLO String-             | MAIL String-             | RCPT String-             | DATA ByteString-             | EXPN String-             | VRFY String-             | HELP String-             | AUTH AuthType UserName Password-             | NOOP-             | RSET-             | QUIT-               deriving (Show, Eq) -type ReplyCode = Int+-- $workflow+-- The common workflow while working with the library is:+--+--   1. Establish a new connection+--   2. Authenticate to the server+--   3. Perform message sending+--   4. Close connections+--+-- Steps 1 and 4 are combined together using @bracket@-like API. Other than that+-- the documentation sections are structured according to this workflow. -data Response = Ok-              | SystemStatus-              | HelpMessage-              | ServiceReady-              | ServiceClosing-              | UserNotLocal-              | CannotVerify-              | StartMailInput-              | ServiceNotAvailable-              | MailboxUnavailable-              | ErrorInProcessing-              | InsufficientSystemStorage-              | SyntaxError-              | ParameterError-              | CommandNotImplemented-              | BadSequence-              | ParameterNotImplemented-              | MailboxUnavailableError-              | UserNotLocalError-              | ExceededStorage-              | MailboxNotAllowed-              | TransactionFailed-                deriving (Show, Eq)+-- $controlling-connections +-- $controlling-connections-1+-- The library encourages creation of 'SMTPConnection' using the @doSMTP@-family functions.+-- These functions provide @bracket@-like pattern that manages connection state:+-- creates a connection, passes it to the user defined @IO@ action and frees connection+-- when the action exits. This approach is simple and exception safe.+--+-- __N.B.__ It should be noted that none of these functions implements keep alive of any kind,+-- so the server is free to close the connection by timeout even the end of before the users+-- action exits.+--++-- $controlling-connections-2+--+-- __NOTE:__ For /SSL\/TLS/ support you may establish the connection using+-- the functions (such as @connectSMTPSSL@) provided by the @Network.HaskellNet.SMTP.SSL@ module+-- of the <http://hackage.haskell.org/package/HaskellNet-SSL HaskellNet-SSL> package.+--+-- @bracket-@ style is not the only possible style for resource management,+-- it's possible to use <http://hackage.haskell.org/package/resourcet resourcet> or+-- <http://hackage.haskell.org/package/resource-pool resource-pool> as well. In both of the+-- approaches you need to use low-level 'connectSTM*' and 'closeSMTP' functions.+--+-- Basic example using @resourcet@.+--+-- @+-- \{\-\# LANGUAGE OverloadedStrings \#\-\}+-- import "Network.HaskellNet.SMTP"+-- import "Network.HaskellNet.Auth"+-- import "Control.Monad.Trans.Resource"+-- import "System.Exit" (die)+--+-- main :: IO ()+-- main = 'Control.Monad.Trans.Resource.runResourceT' $ do+--    (key, conn)+--        <- 'Control.Monad.Trans.Resource.allocate'+--               ('connectSMTP' "your.smtp.server.com")+--               ('closeSMTP')+--    ... conn+-- @+--+-- This approach allows resource management even if the code does not form+-- a stack, so is more general.+--+-- __NOTE__. SMTP protocol advices to use 'QUIT' command for graceful connection+-- close. Before version 0.6 the library never sent it, so does 'closeSMTP' call.+--+-- Starting from 0.6 'doSMTP'-family uses graceful exit and sends 'QUIT' before terminating+-- a connection. This way of termination is exposed as 'gracefullyCloseSTMP' function,+-- however it's not a default method because it requires a connection to be in+-- a valid state. So it's not possible to guarantee backwards compatibility.+ -- | connecting SMTP server with the specified name and port number. connectSMTPPort :: String     -- ^ name of the server                 -> PortNumber -- ^ port number@@ -149,229 +175,180 @@             -> IO SMTPConnection connectSMTP = flip connectSMTPPort 25 -tryCommand :: SMTPConnection -> Command -> Int -> [ReplyCode]-           -> IO ByteString-tryCommand conn cmd tries expectedReplies = do-    (code, msg) <- sendCommand conn cmd-    case () of-        _ | code `elem` expectedReplies -> return msg-        _ | tries > 1 ->-            tryCommand conn cmd (tries - 1) expectedReplies-          | otherwise -> do-            bsClose (bsstream conn)-            fail $ "cannot execute command " ++ show cmd ++-                ", " ++ prettyExpected expectedReplies ++-                ", " ++ prettyReceived code msg--  where-    prettyReceived :: Int -> ByteString -> String-    prettyReceived co ms = "but received" ++ show co ++ " (" ++ BS.unpack ms ++ ")"--    prettyExpected :: [ReplyCode] -> String-    prettyExpected [x] = "expected reply code of " ++ show x-    prettyExpected xs = "expected any reply code of " ++ show xs---- | create SMTPConnection from already connected Stream-connectStream :: BSStream -> IO SMTPConnection+-- | Create SMTPConnection from already connected Stream+--+-- Throws @CantConnect :: SMTPException@ in case if got illegal+-- greeting.+connectStream :: HasCallStack => BSStream -> IO SMTPConnection connectStream st =     do (code1, _) <- parseResponse st-       unless (code1 == 220) $-              do bsClose st-                 fail "cannot connect to the server"-       senderHost <- getHostName+       unless (code1 == 220) $ do+         bsClose st+         throwIO $ UnexpectedGreeting code1+       senderHost <- T.pack <$> getHostName        msg <- tryCommand (SMTPC st []) (EHLO senderHost) 3 [250]        return (SMTPC st (tail $ BS.lines msg)) -parseResponse :: BSStream -> IO (ReplyCode, ByteString)-parseResponse st =-    do (code, bdy) <- readLines-       return (read $ BS.unpack code, BS.unlines bdy)-    where readLines =-              do l <- bsGetLine st-                 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)-                    else return (c, [BS.tail bdy]) ---- | send a method to a server-sendCommand :: SMTPConnection -> Command -> IO (ReplyCode, ByteString)-sendCommand (SMTPC conn _) (DATA dat) =-    do bsPutCrLf conn $ BS.pack "DATA"-       (code, msg) <- parseResponse conn-       unless (code == 354) $ fail $ "this server cannot accept any data. code: " ++ show code ++ ", msg: " ++ BS.unpack msg-       mapM_ (sendLine . stripCR) $ BS.lines dat ++ [BS.pack "."]-       parseResponse conn-    where sendLine = bsPutCrLf conn-          stripCR bs = case BS.unsnoc bs of-                         Just (line, '\r') -> line-                         _                 -> bs-sendCommand (SMTPC conn _) (AUTH LOGIN username password) =-    do bsPutCrLf conn command-       (_, _) <- parseResponse conn-       bsPutCrLf conn $ BS.pack userB64-       (_, _) <- parseResponse conn-       bsPutCrLf conn $ BS.pack passB64-       parseResponse conn-    where command = BS.pack "AUTH LOGIN"-          (userB64, passB64) = login username password-sendCommand (SMTPC conn _) (AUTH at username password) =-    do bsPutCrLf conn command-       (code, msg) <- parseResponse conn-       unless (code == 334) $ fail $ "authentication failed. code: " ++ show code ++ ", msg: " ++ BS.unpack msg-       bsPutCrLf conn $ BS.pack $ auth at (BS.unpack msg) username password-       parseResponse conn-    where command = BS.pack $ unwords ["AUTH", show at]-sendCommand (SMTPC conn _) meth =-    do bsPutCrLf conn $ BS.pack command-       parseResponse conn-    where command = case meth of-                      (HELO param) -> "HELO " ++ param-                      (EHLO param) -> "EHLO " ++ param-                      (MAIL param) -> "MAIL FROM:<" ++ param ++ ">"-                      (RCPT param) -> "RCPT TO:<" ++ param ++ ">"-                      (EXPN param) -> "EXPN " ++ param-                      (VRFY param) -> "VRFY " ++ param-                      (HELP msg)   -> if null msg-                                        then "HELP\r\n"-                                        else "HELP " ++ msg-                      NOOP         -> "NOOP"-                      RSET         -> "RSET"-                      QUIT         -> "QUIT"-                      (DATA _)     ->-                          error "BUG: DATA pattern should be matched by sendCommand patterns"-                      (AUTH {})     ->-                          error "BUG: AUTH pattern should be matched by sendCommand patterns"---- | close the connection.  This function send the QUIT method, so you--- do not have to QUIT method explicitly.-closeSMTP :: SMTPConnection -> IO ()-closeSMTP (SMTPC conn _) = bsClose conn--{--I must be being stupid here--I can't seem to be able to catch the exception arising from the-connection already being closed this would be the correct way to do it-but instead we're being naughty above by just closes the connection-without first sending QUIT--closeSMTP c@(SMTPC conn _) =-    do sendCommand c QUIT-       bsClose conn `catch` \(_ :: IOException) -> return ()--}+-- $authentication  {- |-This function will return 'True' if the authentication succeeds.-Here's an example of sending a mail with a server that requires-authentication:+Authenticates user on the remote server. Returns 'True' if the authentication succeeds,+otherwise returns 'False'. ->    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."+Usage example:++@+\{\-\# LANGUAGE OverloadedStrings \#\-\}+authSucceed <- 'authenticate' 'PLAIN' "username" "password" conn+if authSucceed+then 'sendPlainTextMail' "receiver\@server.com" "sender\@server.com" "subject" "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-         -> [String]   -- ^ receivers-         -> ByteString -- ^ data-         -> SMTPConnection-         -> IO ()-sendMail sender receivers dat conn = do-                 sendAndCheck (MAIL sender)-                 mapM_ (sendAndCheck . RCPT) receivers-                 sendAndCheck (DATA dat)-                 return ()-  where-    -- Try the command once and @fail@ if the response isn't 250.-    sendAndCheck cmd = tryCommand conn cmd 1 [250, 251]+-- $authentication+-- __N.B.__ The choice of the authentication method is currently explicit and the library+-- does not analyze server capabilities reply for choosing the right method.+-- --- | doSMTPPort open a connection, and do an IO action with the--- connection, and then close it.+-- | 'doSMTPPort' opens a connection to the given port server and+-- performs an IO action with the connection, and then close it.+--+-- 'SMTPConnection' is freed once 'IO' action scope is finished, it means that+-- 'SMTPConnection' value should not escape the action scope. doSMTPPort :: String -> PortNumber -> (SMTPConnection -> IO a) -> IO a-doSMTPPort host port =-    bracket (connectSMTPPort host port) closeSMTP+doSMTPPort host port f =+    bracket (connectSMTPPort host port)+            (\(SMTPC conn _) -> bsClose conn)+            (\c -> f c >>= \x -> quitSMTP c >> pure x) --- | doSMTP is similar to doSMTPPort, except that it does not require--- port number but connects to the server with port 25.+-- | 'doSMTP' is similar to 'doSMTPPort', except that it does not require+-- port number and connects to the default SMTP port — 25. doSMTP :: String -> (SMTPConnection -> IO a) -> IO a 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' is similar to 'doSMTPPort', except that its argument+-- is a Stream data instead of hostname and port number. Using this function+-- you can embed connections maintained by the other libraries or add debug info+-- in a common  way.+--+-- Using this function you can create an 'SMTPConnection' from an already+-- opened connection stream. See more info on the 'BStream' abstraction in the+-- "Network.HaskellNet.BSStream" module. doSMTPStream :: BSStream -> (SMTPConnection -> IO a) -> IO a-doSMTPStream s = bracket (connectStream s) closeSMTP+doSMTPStream s f =+  bracket (connectStream s)+          (\(SMTPC conn _) -> bsClose conn)+          (\c -> f c >>= \x -> quitSMTP c >> pure x) +-- $sending-mail+--+-- Since version 0.6 there is only one function 'sendMail' that sends a email+-- rendered using mime-mail package. Historically there is a family of @send*Mail@+-- functions that provide simpler interface but they basically mimic the functions+-- from the mime-mail package, and it's encouraged to use those functions directly.+--+-- +------------------------+------------+----------+-------------+-------------++-- | Method                 | Plain text | Html body| Attachments |  Note       |+-- |                        | body       |          |             |             |+-- +========================+============+==========+=============+=============++-- | 'sendMail'             |   Uses mail-mime 'Mail' type        |             |+-- +------------------------+------------+----------+-------------+-------------++-- | 'sendPlainTextMail'    |     ✓      |    ✗     |     ✗       | deprecated  |+-- +------------------------+------------+----------+-------------+-------------++-- | 'sendMimeMail'         |     ✓      |    ✓     | ✓ (filepath)| deprecated  |+-- +------------------------+------------+----------+-------------+-------------++-- | 'sendMimeMail''        |    ✓       |    ✓     | ✓  (memory) | deprecated  |+-- +------------------------+------------+----------+-------------+-------------++-- | 'sendMimeMail2'        |   Uses mail-mime 'Mail' type        | deprecated  |+-- +------------------------+-------------------------------------+-------------++ -- | Send a plain text mail.-sendPlainTextMail :: String  -- ^ receiver-                  -> String  -- ^ sender-                  -> String  -- ^ subject+--+-- __DEPRECATED__. Instead of @sendPlainTextMail to from subject plainBody@ use:+--+-- @+-- mail = 'Network.Mail.Mime.simpleMail'' to from subject plainBody+-- sendMail mail conn+-- @+{-# DEPRECATED sendPlainTextMail "Use 'sendMail (Network.Mail.Mime.simpleMail' to from subject plainBody)' instead" #-}+sendPlainTextMail :: Address -- ^ receiver+                  -> Address -- ^ sender+                  -> T.Text  -- ^ 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+sendPlainTextMail to from subject body con =+  let mail = simpleMail' to from subject body+  in sendMail mail con + -- | Send a mime mail. The attachments are included with the file path.-sendMimeMail :: String               -- ^ receiver-             -> String               -- ^ sender-             -> String               -- ^ subject+--+-- __DEPRECATED__. Instead of @sendMimeMail to from subject plainBody htmlBody attachments@ use:+--+-- @+-- mail <- 'Network.Mail.Mime.simpleMail' to from subject plainBody htmlBody attachments+-- sendMail mail conn+-- @+--+{-# DEPRECATED sendMimeMail "Use 'Network.Mail.Mime.simpleMail to from subject plainBody htmlBody attachments >>= \\mail -> sendMail mail conn' instead" #-}+sendMimeMail :: Address              -- ^ receiver+             -> Address              -- ^ sender+             -> T.Text               -- ^ 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-  renderedMail <- renderMail' myMail-  sendMail from [to] (lazyToStrict renderedMail) con-  where-    address = Address Nothing . T.pack+  myMail <- simpleMail to from subject plainBody htmlBody attachments+  sendMail myMail con  -- | Send a mime mail. The attachments are included with in-memory 'ByteString'.-sendMimeMail' :: String                         -- ^ receiver-              -> String                         -- ^ sender-              -> String                         -- ^ subject+--+-- __DEPRECATED__. Instead of @sendMimeMail to from subject plainBody htmlBody attachments@ use:+--+-- @+-- let mail = Network.Mail.Mime.simpleMailInMemory to from subject plainBody htmlBody attachments+-- sendMail mail conn+-- @+--+{-# DEPRECATED sendMimeMail' "Use 'sendMail (Network.Mail.Mime.simpleMailInMemory to from subject plainBody htmlBody attachments) conn'" #-}+sendMimeMail' :: Address                        -- ^ receiver+              -> Address                        -- ^ sender+              -> T.Text                         -- ^ subject               -> LT.Text                        -- ^ plain text body               -> LT.Text                        -- ^ html body               -> [(T.Text, T.Text, B.ByteString)] -- ^ attachments: [(content_type, file_name, content)]               -> SMTPConnection               -> IO () sendMimeMail' to from subject plainBody htmlBody attachments con = do-  let myMail = simpleMailInMemory (address to) (address from) (T.pack subject)-                                  plainBody htmlBody attachments-  sendMimeMail2 myMail con-  where-    address = Address Nothing . T.pack--sendMimeMail2 :: Mail -> SMTPConnection -> IO ()-sendMimeMail2 mail con = do-    let (Address _ from) = mailFrom mail-        recps = map (T.unpack . addressEmail)-                     $ (mailTo mail ++ mailCc mail ++ mailBcc mail)-    when (null recps) $ fail "no receiver specified."-    renderedMail <- renderMail' $ mail { mailBcc = [] }-    sendMail (T.unpack from) recps (lazyToStrict renderedMail) con---- haskellNet uses strict bytestrings--- TODO: look at making haskellnet lazy-lazyToStrict :: B.ByteString -> S.ByteString-lazyToStrict = B.toStrict+  let myMail = simpleMailInMemory to from subject plainBody htmlBody attachments+  sendMail myMail con -crlf :: BS.ByteString-crlf = BS.pack "\r\n"+-- | Sends email in generated using 'mime-mail' package.+--+-- Throws 'UserError' @::@ 'IOError' if recipient address not specified.+{-# DEPRECATED sendMimeMail2 "Use sendMail instead" #-}+sendMimeMail2 :: HasCallStack => Mail -> SMTPConnection -> IO ()+sendMimeMail2 = sendMail -bsPutCrLf :: BSStream -> ByteString -> IO ()-bsPutCrLf h s = bsPut h s >> bsPut h crlf >> bsFlush h+-- | Sends email using 'Mail' type from the mime-mail package.+--+-- Sender is taken from the 'mailFrom' field of the @mail@. Message+-- is sent to all the recipients in the 'mailTo', 'mailCc', 'mailBcc' fields.+-- But 'mailBcc' emails are not visible to other recipients as it should be.+--+-- @since 0.6+sendMail :: HasCallStack => Mail -> SMTPConnection -> IO ()+sendMail mail conn = do+  let recps = mailTo mail ++ mailCc mail ++ mailBcc mail+  when (null recps) $ throwIO $ NoRecipients mail+  renderedMail <- renderMail' $ mail { mailBcc = [] }+  sendMailData (mailFrom mail) recps (B.toStrict renderedMail) conn

@@ -0,0 +1,356 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DerivingStrategies #-}+-- |+-- Internal functions that are used in the SMTP protocol,+-- you may need these module in case if you want to implement additional+-- functionality that does not exist in the "Network.HaskellNet.SMTP".+--+-- __Example__.+--+-- One example could be sending multiple emails over the same stream+-- in order to use that you may want to use 'RSET' command, so you can implement:+--+-- @+-- import "Network.HaskellNet.SMTP.Internal"+--+-- resetConnection :: SMTPConnection -> IO ()+-- resetConnection conn = do+--    (code, _) <- 'sendCommand' conn 'RSET'+--    'unless' (code == 250) $ 'throwIO' $ 'UnexpectedReply' 'RSET' [250] code ""+-- @+--+module Network.HaskellNet.SMTP.Internal+  ( SMTPConnection(..)+  , Command(..)+  , SMTPException(..)+  , ReplyCode+  , tryCommand+  , parseResponse+  , sendCommand+  , sendMailData+  , closeSMTP+  , gracefullyCloseSMTP+  , quitSMTP+    -- * Reexports+  , Address(..)+  ) where++import Control.Exception+import Control.Monad (unless)+import Data.Char (isDigit)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Typeable++import Network.HaskellNet.Auth+import Network.HaskellNet.BSStream++import Network.Mail.Mime++import Prelude++-- | All communication with server is done using @SMTPConnection@ value.+data SMTPConnection = SMTPC {+  -- | Connection communication channel.+  bsstream :: !BSStream,+  -- | Server properties as per reply to the 'EHLO' request.+  _response :: ![ByteString]+  }++-- | SMTP commands.+--+-- Supports basic and extended SMTP protocol without TLS support.+--+-- For each command we provide list of the expected reply codes that happens in success and failure cases+-- respectively.+data Command+  = -- | The @HELO@ command initiates the SMTP session conversation. The client greets the server and introduces itself.+    -- As a rule, HELO is attributed with an argument that specifies the domain name or IP address of the SMTP client.+    --+    -- Success: 250+    -- Failure: 504, 550+    HELO T.Text+  | -- | @EHLO@ is an alternative to HELO for servers that support the SMTP service extensions (ESMTP)+    --+    -- Success: 250+    -- Failure: 502, 504, 550+    EHLO T.Text+  | -- | @MAIL FROM@ command initiates a mail transfer. As an argument, MAIL FROM includes a sender mailbox (reverse-path)+    -- can accept optional parameters.+    --+    -- Success: 250+    --+    -- Failure: 451, 452, 455, 503, 550, 552, 553, 555+    MAIL T.Text+  | -- | The @RCPT TO@ command specifies exactly one recipient.+    --+    -- Success: 250 251+    --+    -- Failure: 450 451 452 455 503 550 551 552 553 555+    RCPT T.Text+  | -- | With the @DATA@ command, the client asks the server for permission to transfer the mail data.+    --+    -- Success: 250, 354+    --+    -- Failure: 450 451 452 503 550 552 554+    --+    -- Client just sends data and after receiving 354 starts streaming email, terminating transfer by+    -- sending @\r\n.\r\n@.+    DATA ByteString+  | -- |+    -- @EXPN@ is used to verify whether a mailing list in the argument exists on the local host.+    -- The positive response will specify the membership of the recipients.+    --+    -- Success: 250 252+    --+    -- Failure: 502 504 550+    EXPN T.Text+  | -- |+    -- @VRFY@ is used to verify whether a mailbox in the argument exists on the local host.+    -- The server response includes the user’s mailbox and may include the user’s full name.+    --+    -- Success: 250 251 252+    --+    -- Failure: 502 504 550 551 553+    VRFY T.Text+  | -- |+    -- With the @HELP@ command, the client requests a list of commands the server supports, may request+    -- help for specific command+    --+    -- Success: 211 214+    --+    -- Failure: 502 504+    HELP T.Text+  | -- | Authorization support+    AUTH AuthType UserName Password+  | -- | @NOOP@  can be used to verify if the connection is alive+    --+    -- Success: 250+    NOOP+  | -- | @RSET@ Resets the state+    --+    -- Success: 250+    RSET+  | -- | @QUIT@ asks server to close connection. Client should terminate the connection when receives+    -- status.+    --+    -- Success: 221+    QUIT+    deriving (Show, Eq)++-- | Code reply from the server. It's always 3 digit integer.+type ReplyCode = Int++-- | Exceptions that can happen during communication.+data SMTPException+  = -- | Reply code was not in the list of expected.+    --+    --  * @Command@ - command that was sent.+    --  * @[ReplyCode]@ -- list of expected codes+    --  * @ReplyCode@ -- the code that we have received+    --  * @ByteString@ -- additional data returned by the server.+    UnexpectedReply Command [ReplyCode] ReplyCode BS.ByteString+    -- | The server didn't accept the start of the message delivery+  | NotConfirmed ReplyCode BS.ByteString+    -- | The server does not support current authentication method+  | AuthNegotiationFailed ReplyCode BS.ByteString+    -- | Can't send email because no recipients were specified.+  | NoRecipients Mail+    -- | Received an unexpected greeting from the server.+  | UnexpectedGreeting ReplyCode+  deriving (Show)+  deriving (Typeable)++instance Exception SMTPException where+  displayException (UnexpectedReply cmd expected code msg) =+    "Cannot execute command " ++ show cmd +++       ", " ++ prettyExpected expected +++       ", " ++ prettyReceived code msg+    where+      prettyReceived :: Int -> ByteString -> String+      prettyReceived co ms = "but received" ++ show co ++ " (" ++ BS.unpack ms ++ ")"+      prettyExpected :: [ReplyCode] -> String+      prettyExpected [x] = "expected reply code of " ++ show x+      prettyExpected xs = "expected any reply code of " ++ show xs+  displayException (NotConfirmed code msg) =+    "This server cannot accept any data. code: " ++ show code ++ ", msg: " ++ BS.unpack msg+  displayException (AuthNegotiationFailed code msg) =+    "Authentication failed. code: " ++ show code ++ ", msg: " ++ BS.unpack msg+  displayException (NoRecipients _mail) =+    "No recipients were specified"+  displayException (UnexpectedGreeting code) =+    "Expected greeting from the server, but got: " <> show code+++-- | Safe wrapper for running a client command over the SMTP+-- connection.+--+-- /Note on current behavior/+--+-- We allow the command to fail several times, retry+-- happens in case if we have received unexpected status code.+-- In this case message will be sent again. However in case+-- of other synchronous or asynchronous exceptions there will+-- be no retries.+--+-- It case if number of retries were exceeded connection will+-- be closed automatically.+--+-- The behaviors in notes will likely be changed in the future+-- and should not be relied upon, see issues 76, 77.+tryCommand+  :: SMTPConnection -- ^ Connection+  -> Command -- ^ Supported command+  -> Int -- ^ Number of allowed retries+  -> [ReplyCode] -- ^ List of accepted codes+  -> IO ByteString -- ^ Resulting data+tryCommand conn cmd tries expectedReplies = do+    (code, msg) <- sendCommand conn cmd+    case () of+        _ | code `elem` expectedReplies -> return msg+        _ | tries > 1 ->+            tryCommand conn cmd (tries - 1) expectedReplies+          | otherwise ->+            throwIO $ UnexpectedReply cmd expectedReplies code msg++-- | Read response from the stream. Response consists of the code+-- and one or more lines of data.+--+-- In case if it's not the last line of reply the code is followed+-- by the '-' sign. We return the code and all the data with the code+-- stripped.+--+-- Eg.:+--+-- @+-- "250-8BITMIME\\r"+-- "250-PIPELINING\\r"+-- "250-SIZE 42991616\\r"+-- "250-AUTH LOGIN PLAIN XOAUTH2\\r"+-- "250-DSN\\r"+-- "250 ENHANCEDSTATUSCODES\\r"+-- @+--+-- Returns:+--+-- @+-- (250, "8BITMIME\\nPIPELINING\nSIZE 42991616\\nAUTH LOGIN PLAIN XOAUTH2\\nDSN\\nENHANCEDSTATUSCODES")+-- @+--+-- Throws 'SMTPException'.+parseResponse :: BSStream -> IO (ReplyCode, ByteString)+parseResponse st =+    do (code, bdy) <- readLines+       return (read $ BS.unpack code, BS.unlines bdy)+    where readLines =+              do l <- bsGetLine st+                 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)+                    else return (c, [BS.tail bdy])++-- | Sends a 'Command' to the server. Function that performs all the logic+-- for sending messages. Throws an exception if something goes wrong.+--+-- Throws 'SMTPException'.+sendCommand+  :: SMTPConnection+  -> Command+  -> IO (ReplyCode, ByteString)+sendCommand (SMTPC conn _) (DATA dat) =+    do bsPutCrLf conn "DATA"+       (code, msg) <- parseResponse conn+       unless (code == 354) $ throwIO $ NotConfirmed code msg+       mapM_ (sendLine . stripCR) $ BS.lines dat ++ [BS.pack "."]+       parseResponse conn+    where sendLine = bsPutCrLf conn+          stripCR bs = case BS.unsnoc bs of+                         Just (line, '\r') -> line+                         _                 -> bs+sendCommand (SMTPC conn _) (AUTH LOGIN username password) =+    do bsPutCrLf conn command+       (_, _) <- parseResponse conn+       bsPutCrLf conn $ BS.pack userB64+       (_, _) <- parseResponse conn+       bsPutCrLf conn $ BS.pack passB64+       parseResponse conn+    where command = "AUTH LOGIN"+          (userB64, passB64) = login username password+sendCommand (SMTPC conn _) (AUTH at username password) =+    do bsPutCrLf conn $ T.encodeUtf8 command+       (code, msg) <- parseResponse conn+       unless (code == 334) $ throwIO $ AuthNegotiationFailed code msg+       bsPutCrLf conn $ BS.pack $ auth at (BS.unpack msg) username password+       parseResponse conn+    where command = T.unwords ["AUTH", T.pack (show at)]+sendCommand (SMTPC conn _) meth =+    do bsPutCrLf conn $! T.encodeUtf8 command+       parseResponse conn+    where command = case meth of+                      (HELO param) -> "HELO " <> param+                      (EHLO param) -> "EHLO " <> param+                      (MAIL param) -> "MAIL FROM:<" <> param <> ">"+                      (RCPT param) -> "RCPT TO:<" <> param <> ">"+                      (EXPN param) -> "EXPN " <> param+                      (VRFY param) -> "VRFY " <> param+                      (HELP msg)   -> if T.null msg+                                      then "HELP\r\n"+                                      else "HELP " <> msg+                      NOOP         -> "NOOP"+                      RSET         -> "RSET"+                      QUIT         -> "QUIT"+                      (DATA _)     ->+                          error "BUG: DATA pattern should be matched by sendCommand patterns"+                      (AUTH {})     ->+                          error "BUG: AUTH pattern should be matched by sendCommand patterns"++-- | Sends quit to the server. Connection must be terminated afterwards, i.e. it's not+-- allowed to issue any command on this connection.+quitSMTP :: SMTPConnection -> IO ()+quitSMTP c = do+  _ <- tryCommand c QUIT 1 [221]+  pure ()++-- | Terminates the connection. 'Quit' command is not send in this case.+-- It's safe to issue this command at any time if the connection is still+-- open.+closeSMTP :: SMTPConnection -> IO ()+closeSMTP (SMTPC conn _) = bsClose conn++-- | Gracefully closes SMTP connection. Connection should be in available+-- state. First it sends quit command and then closes connection itself.+-- Connection should not be used after this command exits (even if it exits with an exception).+-- This command may throw an exception in case of network failure or+-- protocol failure when sending 'QUIT' command. If it happens connection+-- nevertheless is closed.+--+-- @since 0.6+gracefullyCloseSMTP :: SMTPConnection -> IO ()+gracefullyCloseSMTP c@(SMTPC conn _) = quitSMTP c `finally` bsClose conn++-- | Sends a mail to the server.+--+-- Throws 'SMTPException'.+sendMailData :: Address -- ^ sender mail+         -> [Address] -- ^ receivers+         -> ByteString -- ^ data+         -> SMTPConnection+         -> IO ()+sendMailData sender receivers dat conn = do+   sendAndCheck (MAIL (addressEmail sender))+   mapM_ (sendAndCheck . RCPT . addressEmail) receivers+   sendAndCheck (DATA dat)+   return ()+  where+    sendAndCheck cmd = tryCommand conn cmd 1 [250, 251]++-- | Just a crlf constant.+crlf :: BS.ByteString+crlf = BS.pack "\r\n"++-- | Write a message ending with ctlf.+bsPutCrLf :: BSStream -> ByteString -> IO ()+bsPutCrLf h s = bsPut h (s <> crlf)