diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,9 @@ +0.7 (2025-06-08) + - updated to the lastest GHC, tested with 8.10.7 — 9.12.2 (PR #103) + Thanks to @thomasjm + - various improvements in IMAP protocol (#94, #97, #99) + Thanks to @mpscholten + 0.6.1.0 (2023-06-27) - fixed bug with wrong IMAP header decoding ([Issue 89](https://github.com/qnikst/HaskellNet/issues/89)) Thanks to William Arteroi (@wwmoraes) and Nathan Collins (@ntc2) diff --git a/HaskellNet.cabal b/HaskellNet.cabal --- a/HaskellNet.cabal +++ b/HaskellNet.cabal @@ -6,7 +6,7 @@ Full examples can be found in the . Additional documentation on the major updates can be found in the file -Version: 0.6.1.2 +Version: 0.6.2 Copyright: (c) 2006 Jun Mukai Author: Jun Mukai Maintainer: Alexander Vershilov , @@ -19,11 +19,11 @@ Cabal-version: 1.22 Build-type: Simple Tested-with: - GHC ==8.8.4 - || ==8.10.7 - || ==9.0.2 - || ==9.2.5 - || ==9.4.4 + GHC ==9.4.8 + || ==9.6.7 + || ==9.8.4 + || ==9.10.2 + || ==9.12.2 Extra-Source-Files: CHANGELOG @@ -67,14 +67,14 @@ Network.Mail.Mime Build-Depends: - base >= 4.3 && < 4.18, - network >= 2.6.3.1 && < 3.2, - mtl >= 2.2.2 && < 2.3, - bytestring >=0.10.2 && < 0.12, + base >= 4.3 && < 4.22, + network >= 2.6.3.1 && < 3.3, + mtl >= 2.2.2 && < 2.4, + bytestring >=0.10.2 && < 0.13, pretty >= 1.1.3 && < 1.2, array >= 0.5 && < 0.6, cryptohash-md5 >= 0.11 && < 0.12, - base64 < 0.5, + base64 < 1.1, old-time >= 1.0 && < 1.2, mime-mail >= 0.4 && < 0.6, text >= 1.0 && < 3 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ HaskellNet ========== -![Haskell-CI](https://github.com/qnikst/HaskellNet/workflows/Haskell-CI/badge.svg) +[![ci](https://github.com/qnikst/HaskellNet/actions/workflows/ci.yml/badge.svg)](https://github.com/qnikst/HaskellNet/actions/workflows/ci.yml) This package provides client support for the E-mail protocols POP3, SMTP, and IMAP. diff --git a/example/smtp2.hs b/example/smtp2.hs new file mode 100644 --- /dev/null +++ b/example/smtp2.hs @@ -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 = "

Hello world!

" +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 + diff --git a/src/Network/HaskellNet/Auth.hs b/src/Network/HaskellNet/Auth.hs --- a/src/Network/HaskellNet/Auth.hs +++ b/src/Network/HaskellNet/Auth.hs @@ -48,12 +48,7 @@ b64Decode :: String -> String b64Decode = T.unpack . decode . T.pack - where decode = -#if MIN_VERSION_base64(0,5,0) - B64.decodeBase64Lenient . B64.assertBase64 -#else - B64.decodeBase64Lenient -#endif + where decode = B64.decodeBase64Lenient showOctet :: [Word8] -> String showOctet = concatMap hexChars diff --git a/src/Network/HaskellNet/IMAP.hs b/src/Network/HaskellNet/IMAP.hs --- a/src/Network/HaskellNet/IMAP.hs +++ b/src/Network/HaskellNet/IMAP.hs @@ -11,11 +11,12 @@ , list, lsub, status, append, appendFull -- ** selected state commands , check, close, expunge - , search, store, copy + , search, store, copy, move , idle -- * fetch commands , fetch, fetchHeader, fetchSize, fetchHeaderFields, fetchHeaderFieldsNot , fetchFlags, fetchR, fetchByString, fetchByStringR + , fetchPeek, fetchRPeek -- * other types , Flag(..), Attribute(..), MailboxStatus(..) , SearchQuery(..), FlagsQuery(..) @@ -23,13 +24,13 @@ ) where -import Network.Socket (PortNumber) import Network.Compat +import qualified Network.HaskellNet.Auth as A import Network.HaskellNet.BSStream import Network.HaskellNet.IMAP.Connection -import Network.HaskellNet.IMAP.Types import Network.HaskellNet.IMAP.Parsers -import qualified Network.HaskellNet.Auth as A +import Network.HaskellNet.IMAP.Types +import Network.Socket (PortNumber) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS @@ -374,6 +375,12 @@ do lst <- fetchByString conn uid "BODY[]" return $ maybe BS.empty BS.pack $ lookup' "BODY[]" lst +-- | Like 'fetch' but without marking the email as seen/read +fetchPeek :: IMAPConnection -> UID -> IO ByteString +fetchPeek conn uid = + do lst <- fetchByString conn uid "BODY.PEEK[]" + return $ maybe BS.empty BS.pack $ lookup' "BODY[]" lst + fetchHeader :: IMAPConnection -> UID -> IO ByteString fetchHeader conn uid = do lst <- fetchByString conn uid "BODY[HEADER]" @@ -411,6 +418,13 @@ do lst <- fetchByStringR conn r "BODY[]" return $ map (\(uid, vs) -> (uid, maybe BS.empty BS.pack $ lookup' "BODY[]" vs)) lst + +-- | Like 'fetchR' but without marking the email as seen/read +fetchRPeek :: IMAPConnection -> (UID, UID) -> IO [(UID, ByteString)] +fetchRPeek conn range = + do ls <- fetchByStringR conn range "BODY.PEEK[]" + return $ map (\(uid, vs) -> (uid, maybe BS.empty BS.pack $ lookup' "BODY[]" vs)) ls + fetchByString :: IMAPConnection -> UID -> String -> IO [(String, String)] fetchByString conn uid command = @@ -456,6 +470,9 @@ copy :: IMAPConnection -> UID -> MailboxName -> IO () copy conn uid mbox = copyFull conn (show uid) mbox + +move :: IMAPConnection -> UID -> MailboxName -> IO () +move conn uid mboxname = sendCommand conn ("UID MOVE " ++ show uid ++ " " ++ mboxname) pNone ---------------------------------------------------------------------- -- auxialiary functions diff --git a/src/Network/HaskellNet/IMAP/Parsers.hs b/src/Network/HaskellNet/IMAP/Parsers.hs --- a/src/Network/HaskellNet/IMAP/Parsers.hs +++ b/src/Network/HaskellNet/IMAP/Parsers.hs @@ -237,7 +237,7 @@ return $ Right (attrs, sep, mbox) where parseAttr = do char '\\' - choice [ string "Noinferior" >> return Noinferiors + choice [ string "Noinferiors" >> return Noinferiors , string "Noselect" >> return Noselect , string "Marked" >> return Marked , string "Unmarked" >> return Unmarked diff --git a/src/Network/HaskellNet/POP3.hs b/src/Network/HaskellNet/POP3.hs --- a/src/Network/HaskellNet/POP3.hs +++ b/src/Network/HaskellNet/POP3.hs @@ -31,10 +31,10 @@ ) where -import Network.HaskellNet.BSStream -import Network.Socket import Network.Compat import qualified Network.HaskellNet.Auth as A +import Network.HaskellNet.BSStream +import Network.Socket import Data.ByteString (ByteString) import qualified Data.ByteString as B @@ -159,9 +159,9 @@ (UIDL msg) -> "UIDL " ++ maybe "" show msg (APOP usern passw) -> "APOP " ++ usern ++ " " ++ hexDigest (apopKey conn ++ passw) - (AUTH _ _ _) -> error "BUG: AUTH should not get matched here" - (RETR _) -> error "BUG: RETR should not get matched here" - (TOP _ _) -> error "BUG: TOP should not get matched here" + AUTH _ _ _ -> error "sendCommand: impossible happened AUTH expected to be processed in the preceeding clause" + RETR _ -> error "sendCommand: impossible happened AUTH expected to be processed in the preceeding clause" + TOP _ _ -> error "sendCommand: impossible happened AUTH expected to be processed in the preceeding clause" user :: POP3Connection -> String -> IO () user conn name = do (resp, _) <- sendCommand conn (USER name) diff --git a/src/Network/HaskellNet/SMTP/Internal.hs b/src/Network/HaskellNet/SMTP/Internal.hs --- a/src/Network/HaskellNet/SMTP/Internal.hs +++ b/src/Network/HaskellNet/SMTP/Internal.hs @@ -302,10 +302,8 @@ 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" + DATA _ -> error "sendCommand: impossible happened DATA command expected to be processed in thepreceeding clause" + AUTH _ _ _ -> error "sendCommand: impossible happened AUTH command expected to be processed in the preceeding clause" -- | Sends quit to the server. Connection must be terminated afterwards, i.e. it's not -- allowed to issue any command on this connection. diff --git a/src/Text/Packrat/Parse.hs b/src/Text/Packrat/Parse.hs --- a/src/Text/Packrat/Parse.hs +++ b/src/Text/Packrat/Parse.hs @@ -12,7 +12,6 @@ import Text.Packrat.Pos import Control.Monad -import Control.Applicative (Applicative(..)) import qualified Control.Applicative as A import qualified Control.Monad.Fail as Fail @@ -371,4 +370,3 @@ case dvChar d of NoParse _ -> [] Parsed c rem _ -> c : dvString rem -