Compare commits

..

No commits in common. "master" and "0.3.1.0" have entirely different histories.

12 changed files with 47 additions and 177 deletions

1
.gitignore vendored
View File

@ -29,4 +29,3 @@ cabal.config
*.prof *.prof
*.aux *.aux
*.hp *.hp
.stack-work/

View File

@ -2,5 +2,9 @@ language: haskell
matrix: matrix:
fast_finish: true fast_finish: true
include: include:
- ghc: 7.10
- ghc: 7.8 - ghc: 7.8
- ghc: 7.6
- ghc: 7.3
allow_failures:
- ghc: 7.8
install: cabal install --only-dependencies --enable-tests -f NoUpperBounds

View File

@ -1,16 +0,0 @@
# 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,24 +1,23 @@
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.4.0.2 version: 0.3.1.0
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, contact@mangoiv.com maintainer: dani@dpwright.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.18 cabal-version: >=1.8
extra-doc-files: README.md, CHANGELOG.md data-files: README.md
flag network-bsd Flag NoUpperBounds
description: Get Network.BSD from the network-bsd package Description: Removes upper bounds from all packages
default: True Default: False
source-repository head source-repository head
type: git type: git
@ -27,30 +26,24 @@ 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
build-depends: base >= 4 && < 5, if flag(NoUpperBounds)
HaskellNet >= 0.3 && < 0.7, build-depends: base >= 4,
crypton-connection >= 0.3.1 && < 0.5, HaskellNet >= 0.3,
bytestring >= 0.9 && < 0.13, tls >= 1.2,
data-default >= 0.2 && < 0.9 connection >= 0.2,
if flag(network-bsd) network >= 2.4,
build-depends: network >= 3.0 && < 3.3, bytestring,
network-bsd >= 2.7 && < 2.9 data-default
else else
build-depends: network >= 2.4 && < 3.3 build-depends: base >= 4 && < 5,
HaskellNet >= 0.3 && < 0.5,
executable HaskellNet-SSL-example tls >= 1.2 && < 1.4,
hs-source-dirs: examples connection == 0.2.*,
main-is: gmail.hs network >= 2.4 && < 2.7,
other-modules: bytestring,
build-depends: base, data-default
HaskellNet-SSL,
HaskellNet,
bytestring
default-language: Haskell2010

View File

@ -1,12 +1,13 @@
# HaskellNet-SSL 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) [![Build Status](https://travis-ci.org/dpwright/HaskellNet-SSL.svg?branch=master)](https://travis-ci.org/dpwright/HaskellNet-SSL)
This package ties together the excellent [HaskellNet][HaskellNet] and This package ties together the excellent [HaskellNet][HaskellNet] and
[crypton-connection][crypton-connection] packages to make it easy to open IMAP and SMTP [connection][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
[crypton-connection]: https://github.com/kazu-yamamoto/crypton-connection [connection]: https://github.com/vincenthz/hs-connection

View File

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

View File

@ -3,52 +3,34 @@
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), Password) import Network.HaskellNet.Auth (AuthType(LOGIN))
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@(firstMsg : _) <- search c [ALLs] msgs <- 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 do then print "Authentication error."
mail <- simpleMail else sendPlainTextMail recipient username subject body c
recipient
username
subject
body
mempty
mempty
sendMail mail c -- recipient username subject body
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 = do main = smtpTest >> imapTest >> return ()
smtpTest
imapTest

View File

@ -1,4 +1,3 @@
-- | IMAP SSL Connections
module Network.HaskellNet.IMAP.SSL module Network.HaskellNet.IMAP.SSL
( -- * Establishing connection ( -- * Establishing connection
connectIMAPSSL connectIMAPSSL
@ -16,14 +15,11 @@ 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,12 +48,10 @@ connectSTARTTLS hostname cfg = do
(bs, startTLS) <- connectPlain hostname cfg (bs, startTLS) <- connectPlain hostname cfg
greeting <- bsGetLine bs greeting <- bsGetLine bs
failIfNot bs 220 $ parse $ B.unpack greeting failIfNot bs 220 $ parseResponse 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
@ -62,22 +60,15 @@ 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 getFinalResponse bs = do where parseResponse = parse . B.unpack
line <- fmap B.unpack $ bsGetLine bs parse s = (getCode s, s)
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 parse $ getFinalResponse bs getResponse bs = liftM parseResponse $ bsGetLine 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,24 +1,17 @@
{-# 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 -- ^ Port number to connect to { sslPort :: PortNumber
, sslMaxLineLength :: Int -- ^ Max line lengths , sslMaxLineLength :: Int
, sslLogToConsole :: Bool -- ^ Log info to console , sslLogToConsole :: Bool
, sslDisableCertificateValidation :: Bool -- ^ Disable certificate validation , sslDisableCertificateValidation :: Bool
} 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

View File

@ -28,7 +28,6 @@ connectionToStream c cfg = BSStream
, bsClose = connectionClose c , bsClose = connectionClose c
, bsIsOpen = return True , bsIsOpen = return True
, bsGetLine = connectionGetLine maxl c >>= withLog "RECV" , bsGetLine = connectionGetLine maxl c >>= withLog "RECV"
, bsWaitForInput = connectionWaitForInput c
} where maxl = sslMaxLineLength cfg } where maxl = sslMaxLineLength cfg
withLog = if sslLogToConsole cfg then logToConsole withLog = if sslLogToConsole cfg then logToConsole
else flip (const . return) else flip (const . return)

View File

@ -1,66 +0,0 @@
# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# http://docs.haskellstack.org/en/stable/yaml_configuration/
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
# resolver: ghcjs-0.1.0_ghc-7.10.2
# resolver:
# name: custom-snapshot
# location: "./custom-snapshot.yaml"
resolver: lts-7.19
# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# - location:
# git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# extra-dep: true
# subdirs:
# - auto-update
# - wai
#
# A package marked 'extra-dep: true' will only be built if demanded by a
# non-dependency (i.e. a user package), and its test suites and benchmarks
# will not be run. This is useful for tweaking upstream packages.
packages:
- '.'
# Dependency packages to be pulled from upstream that are not in the resolver
# (e.g., acme-missiles-0.3)
extra-deps: []
# Override default flag values for local packages and extra-deps
flags: {}
# Extra package databases containing global packages
extra-package-dbs: []
# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=1.1"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor