0.3.4.1 -> 0.4.0.2
This commit is contained in:
parent
6fe62d91af
commit
1d346b07fb
16
CHANGELOG.md
Normal file
16
CHANGELOG.md
Normal 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
|
||||||
@ -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
|
||||||
|
|||||||
@ -1,13 +1,12 @@
|
|||||||
HaskellNet-SSL
|
# HaskellNet-SSL
|
||||||
--------------
|
|
||||||
|
|
||||||
[](https://travis-ci.org/dpwright/HaskellNet-SSL)
|
[](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
6
cabal.project
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
packages: .
|
||||||
|
|
||||||
|
allow-newer:
|
||||||
|
, HaskellNet:base
|
||||||
|
, HaskellNet:network
|
||||||
|
, HaskellNet:data-default
|
||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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.
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user