0.3.4.1 -> 0.4.0.2

This commit is contained in:
Sarah Vaupel 2025-06-12 14:49:44 +02:00
parent 6fe62d91af
commit 1d346b07fb
8 changed files with 106 additions and 40 deletions

16
CHANGELOG.md Normal file
View File

@ -0,0 +1,16 @@
# Revision history for HaskellNet-SSL
## 0.4.0.0 -- 2025-01-07
- drop support for connection in favour of crypton-connection
- compatibility with GHCs up to ghc 9.8 (bump base and bytestring)
- fix example
- add tested-with stanza
## 0.4.0.1 -- 2025-01-17
- Ignore 502 error on helo - fixes communication with some servers
## 0.4.0.1 -- 2025-02-15
- bump data-default and network

View File

@ -1,23 +1,24 @@
name: HaskellNet-SSL name: HaskellNet-SSL
synopsis: Helpers to connect to SSL/TLS mail servers with HaskellNet synopsis: Helpers to connect to SSL/TLS mail servers with HaskellNet
version: 0.3.4.1 version: 0.4.0.2
description: This package ties together the HaskellNet and connection description: This package ties together the HaskellNet and connection
packages to make it easy to open IMAP and SMTP connections packages to make it easy to open IMAP and SMTP connections
over SSL. over SSL.
homepage: https://github.com/dpwright/HaskellNet-SSL homepage: https://github.com/dpwright/HaskellNet-SSL
tested-with: GHC ==9.4.8 || ==9.6.5 || ==9.8.2
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Daniel P. Wright author: Daniel P. Wright
maintainer: Leza M. Lutonda <lemol-c@outlook.com>, dani@dpwright.com maintainer: Leza M. Lutonda <lemol-c@outlook.com>, dani@dpwright.com, contact@mangoiv.com
copyright: (c) 2013 Daniel P. Wright copyright: (c) 2013 Daniel P. Wright
category: Network category: Network
build-type: Simple build-type: Simple
cabal-version: >=1.8 cabal-version: 1.18
data-files: README.md extra-doc-files: README.md, CHANGELOG.md
Flag NoUpperBounds flag network-bsd
Description: Removes upper bounds from all packages description: Get Network.BSD from the network-bsd package
Default: False default: True
source-repository head source-repository head
type: git type: git
@ -26,24 +27,30 @@ source-repository head
library library
hs-source-dirs: src hs-source-dirs: src
ghc-options: -Wall ghc-options: -Wall
default-language: Haskell2010
exposed-modules: Network.HaskellNet.IMAP.SSL exposed-modules: Network.HaskellNet.IMAP.SSL
Network.HaskellNet.POP3.SSL Network.HaskellNet.POP3.SSL
Network.HaskellNet.SMTP.SSL Network.HaskellNet.SMTP.SSL
Network.HaskellNet.SSL Network.HaskellNet.SSL
other-modules: Network.HaskellNet.SSL.Internal other-modules: Network.HaskellNet.SSL.Internal
if flag(NoUpperBounds) build-depends: base >= 4 && < 5,
build-depends: base >= 4, HaskellNet >= 0.3 && < 0.7,
HaskellNet >= 0.3, crypton-connection >= 0.3.1 && < 0.5,
tls >= 1.2, bytestring >= 0.9 && < 0.13,
connection >= 0.2.7, data-default >= 0.2 && < 0.9
network >= 2.4, if flag(network-bsd)
bytestring, build-depends: network >= 3.0 && < 3.3,
data-default network-bsd >= 2.7 && < 2.9
else else
build-depends: base >= 4 && < 5, build-depends: network >= 2.4 && < 3.3
HaskellNet >= 0.3 && < 0.6,
tls >= 1.2 && < 1.5, executable HaskellNet-SSL-example
connection >= 0.2.7 && < 0.3, hs-source-dirs: examples
network >= 2.4 && < 2.9, main-is: gmail.hs
bytestring, other-modules:
data-default build-depends: base,
HaskellNet-SSL,
HaskellNet,
bytestring
default-language: Haskell2010

View File

@ -1,13 +1,12 @@
HaskellNet-SSL # HaskellNet-SSL
--------------
[![Build Status](https://travis-ci.org/dpwright/HaskellNet-SSL.svg?branch=master)](https://travis-ci.org/dpwright/HaskellNet-SSL) [![haskell ci](https://github.com/dpwright/HaskellNet-SSL/actions/workflows/haskell.yml/badge.svg)](https://github.com/dpwright/HaskellNet-SSL/actions/workflows/haskell.yml)
This package ties together the excellent [HaskellNet][HaskellNet] and This package ties together the excellent [HaskellNet][HaskellNet] and
[connection][connection] packages to make it easy to open IMAP and SMTP [crypton-connection][crypton-connection] packages to make it easy to open IMAP and SMTP
connections over SSL. This is a simple "glue" library; all credit for a) connections over SSL. This is a simple "glue" library; all credit for a)
connecting to IMAP/SMTP servers and b) making an SSL connection goes to the connecting to IMAP/SMTP servers and b) making an SSL connection goes to the
aforementioned libraries. aforementioned libraries.
[HaskellNet]: https://github.com/jtdaugherty/HaskellNet [HaskellNet]: https://github.com/jtdaugherty/HaskellNet
[connection]: https://github.com/vincenthz/hs-connection [crypton-connection]: https://github.com/kazu-yamamoto/crypton-connection

6
cabal.project Normal file
View File

@ -0,0 +1,6 @@
packages: .
allow-newer:
, HaskellNet:base
, HaskellNet:network
, HaskellNet:data-default

View File

@ -3,34 +3,52 @@
import Network.HaskellNet.IMAP.SSL import Network.HaskellNet.IMAP.SSL
import Network.HaskellNet.SMTP.SSL as SMTP import Network.HaskellNet.SMTP.SSL as SMTP
import Network.HaskellNet.Auth (AuthType(LOGIN)) import Network.HaskellNet.Auth (AuthType(LOGIN), Password)
import Network.Mail.Mime
import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Char8 as B
import Data.String
username :: IsString s => s
username = "username@gmail.com" username = "username@gmail.com"
password :: Password
password = "password" password = "password"
recipient :: Address
recipient = "someone@somewhere.com" recipient = "someone@somewhere.com"
imapTest :: IO ()
imapTest = do imapTest = do
c <- connectIMAPSSLWithSettings "imap.gmail.com" cfg c <- connectIMAPSSLWithSettings "imap.gmail.com" cfg
login c username password login c username password
mboxes <- list c mboxes <- list c
mapM_ print mboxes mapM_ print mboxes
select c "INBOX" select c "INBOX"
msgs <- search c [ALLs] msgs@(firstMsg : _) <- search c [ALLs]
let firstMsg = head msgs
msgContent <- fetch c firstMsg msgContent <- fetch c firstMsg
B.putStrLn msgContent B.putStrLn msgContent
logout c logout c
where cfg = defaultSettingsIMAPSSL { sslMaxLineLength = 100000 } where cfg = defaultSettingsIMAPSSL { sslMaxLineLength = 100000 }
smtpTest :: IO ()
smtpTest = doSMTPSTARTTLS "smtp.gmail.com" $ \c -> do smtpTest = doSMTPSTARTTLS "smtp.gmail.com" $ \c -> do
authSucceed <- SMTP.authenticate LOGIN username password c authSucceed <- SMTP.authenticate LOGIN username password c
if authSucceed if authSucceed
then sendPlainTextMail recipient username subject body c then do
mail <- simpleMail
recipient
username
subject
body
mempty
mempty
sendMail mail c -- recipient username subject body
else print "Authentication error." else print "Authentication error."
where subject = "Test message" where subject = "Test message"
body = "This is a test message" body = "This is a test message"
main :: IO () main :: IO ()
main = smtpTest >> imapTest >> return () main = do
smtpTest
imapTest

View File

@ -1,3 +1,4 @@
-- | IMAP SSL Connections
module Network.HaskellNet.IMAP.SSL module Network.HaskellNet.IMAP.SSL
( -- * Establishing connection ( -- * Establishing connection
connectIMAPSSL connectIMAPSSL
@ -15,11 +16,14 @@ import Network.HaskellNet.SSL
import Network.HaskellNet.SSL.Internal import Network.HaskellNet.SSL.Internal
-- | Create IMAP connection with default settings
connectIMAPSSL :: String -> IO IMAPConnection connectIMAPSSL :: String -> IO IMAPConnection
connectIMAPSSL hostname = connectIMAPSSLWithSettings hostname defaultSettingsIMAPSSL connectIMAPSSL hostname = connectIMAPSSLWithSettings hostname defaultSettingsIMAPSSL
-- | Create IMAP connection with given settings
connectIMAPSSLWithSettings :: String -> Settings -> IO IMAPConnection connectIMAPSSLWithSettings :: String -> Settings -> IO IMAPConnection
connectIMAPSSLWithSettings hostname cfg = connectSSL hostname cfg >>= connectStream connectIMAPSSLWithSettings hostname cfg = connectSSL hostname cfg >>= connectStream
-- | Default IMAP SSL settings, port 993
defaultSettingsIMAPSSL :: Settings defaultSettingsIMAPSSL :: Settings
defaultSettingsIMAPSSL = defaultSettingsWithPort 993 defaultSettingsIMAPSSL = defaultSettingsWithPort 993

View File

@ -48,10 +48,12 @@ connectSTARTTLS hostname cfg = do
(bs, startTLS) <- connectPlain hostname cfg (bs, startTLS) <- connectPlain hostname cfg
greeting <- bsGetLine bs greeting <- bsGetLine bs
failIfNot bs 220 $ parseResponse greeting failIfNot bs 220 $ parse $ B.unpack greeting
hn <- getHostName hn <- getHostName
bsPut bs $ B.pack ("HELO " ++ hn ++ "\r\n") bsPut bs $ B.pack ("HELO " ++ hn ++ "\r\n")
getResponse bs >>= failIfNotEx bs (`elem` [250, 502])
bsPut bs $ B.pack ("EHLO " ++ hn ++ "\r\n")
getResponse bs >>= failIfNot bs 250 getResponse bs >>= failIfNot bs 250
bsPut bs $ B.pack "STARTTLS\r\n" bsPut bs $ B.pack "STARTTLS\r\n"
getResponse bs >>= failIfNot bs 220 getResponse bs >>= failIfNot bs 220
@ -60,15 +62,22 @@ connectSTARTTLS hostname cfg = do
prefixRef <- newIORef [greeting] prefixRef <- newIORef [greeting]
return $ bs {bsGetLine = prefixedGetLine prefixRef (bsGetLine bs)} return $ bs {bsGetLine = prefixedGetLine prefixRef (bsGetLine bs)}
where parseResponse = parse . B.unpack where getFinalResponse bs = do
parse s = (getCode s, s) line <- fmap B.unpack $ bsGetLine bs
if (line !! 3) == '-' then getFinalResponse bs else return line
parse s = (getCode s, s)
getCode = read . head . words getCode = read . head . words
getResponse bs = liftM parseResponse $ bsGetLine bs getResponse bs = liftM parse $ getFinalResponse bs
failIfNot :: BSStream -> Integer -> (Integer, String) -> IO () failIfNot :: BSStream -> Integer -> (Integer, String) -> IO ()
failIfNot bs code (rc, rs) = when (code /= rc) closeAndFail failIfNot bs code (rc, rs) = when (code /= rc) closeAndFail
where closeAndFail = bsClose bs >> fail ("cannot connect to server: " ++ rs) where closeAndFail = bsClose bs >> fail ("cannot connect to server: " ++ rs)
-- | Extended version of fail if, can support multiple statuses
failIfNotEx :: BSStream -> (Integer -> Bool) -> (Integer, String) -> IO ()
failIfNotEx bs f (rc, rs) = unless (f rc) closeAndFail
where closeAndFail = bsClose bs >> fail ("cannot connect to server: " ++ rs)
-- This is a bit of a nasty hack. Network.HaskellNet.SMTP.connectStream -- This is a bit of a nasty hack. Network.HaskellNet.SMTP.connectStream
-- expects to receive a status 220 from the server as soon as it connects, -- expects to receive a status 220 from the server as soon as it connects,
-- but we've intercepted it in order to establish a STARTTLS connection. -- but we've intercepted it in order to establish a STARTTLS connection.

View File

@ -1,17 +1,24 @@
{-# LANGUAGE CPP #-}
module Network.HaskellNet.SSL module Network.HaskellNet.SSL
( Settings (..) ( Settings (..)
, defaultSettingsWithPort , defaultSettingsWithPort
) where ) where
#if MIN_VERSION_network(3,0,0)
import Network.Socket (PortNumber)
#else
import Network.Socket.Internal (PortNumber) import Network.Socket.Internal (PortNumber)
#endif
-- | Settings for configuring HaskellNet connections
data Settings = Settings data Settings = Settings
{ sslPort :: PortNumber { sslPort :: PortNumber -- ^ Port number to connect to
, sslMaxLineLength :: Int , sslMaxLineLength :: Int -- ^ Max line lengths
, sslLogToConsole :: Bool , sslLogToConsole :: Bool -- ^ Log info to console
, sslDisableCertificateValidation :: Bool , sslDisableCertificateValidation :: Bool -- ^ Disable certificate validation
} deriving(Eq, Ord, Show) } deriving(Eq, Ord, Show)
-- | Construct default settings for a port
defaultSettingsWithPort :: PortNumber -> Settings defaultSettingsWithPort :: PortNumber -> Settings
defaultSettingsWithPort p = Settings defaultSettingsWithPort p = Settings
{ sslPort = p { sslPort = p