Compare commits

..

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

13 changed files with 45 additions and 247 deletions

31
.gitignore vendored
View File

@ -1,32 +1 @@
# Linux
*~
.directory
# Vim
[._]*.s[a-w][a-z]
[._]s[a-w][a-z]
*.un~
Session.vim
.netrwhist
*~
tags
# Haskell
dist dist
cabal-dev
*.o
*.hi
*.chi
*.chs.h
*.dyn_o
*.dyn_hi
.virtualenv
.hpc
.hsenv
.cabal-sandbox/
cabal.sandbox.config
cabal.config
*.prof
*.aux
*.hp
.stack-work/

View File

@ -1,6 +0,0 @@
language: haskell
matrix:
fast_finish: true
include:
- ghc: 7.10
- ghc: 7.8

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,19 @@
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.2.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, 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
description: Get Network.BSD from the network-bsd package
default: True
source-repository head source-repository head
type: git type: git
@ -27,30 +22,15 @@ 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, build-depends: base >= 4 && < 5,
HaskellNet >= 0.3 && < 0.7, HaskellNet == 0.3.*,
crypton-connection >= 0.3.1 && < 0.5, tls == 1.1.*,
bytestring >= 0.9 && < 0.13, connection == 0.1.*,
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
build-depends: network >= 2.4 && < 3.3
executable HaskellNet-SSL-example
hs-source-dirs: examples
main-is: gmail.hs
other-modules:
build-depends: base,
HaskellNet-SSL,
HaskellNet,
bytestring
default-language: Haskell2010

View File

@ -1,12 +1,11 @@
# 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)
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

@ -1,54 +1,42 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
import Network.HaskellNet.IMAP.SSL import Network.HaskellNet.IMAP
import Network.HaskellNet.SMTP.SSL as SMTP import Network.HaskellNet.IMAP.SSL
import Network.HaskellNet.Auth (AuthType(LOGIN), Password) import Network.HaskellNet.SMTP
import Network.Mail.Mime import Network.HaskellNet.SMTP.SSL
import Network.HaskellNet.SSL
import Network.HaskellNet.Auth (AuthType(LOGIN))
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 r@(rsp, _) <- sendCommand c $ AUTH LOGIN username password
if authSucceed if rsp /= 235
then do then print r
mail <- simpleMail else sendMail username [recipient] mailContent c
recipient where mailContent = subject `B.append` body
username subject = "Subject: Test message\r\n\r\n"
subject body = "This is a test message"
body
mempty
mempty
sendMail mail c -- recipient username subject body
else print "Authentication error."
where subject = "Test message"
body = "This is a test message"
main :: IO () main :: IO ()
main = do main = smtpTest >> imapTest >> return ()
smtpTest
imapTest

View File

@ -1,13 +1,9 @@
-- | IMAP SSL Connections
module Network.HaskellNet.IMAP.SSL module Network.HaskellNet.IMAP.SSL
( -- * Establishing connection ( -- * Establishing connection
connectIMAPSSL connectIMAPSSL
, connectIMAPSSLWithSettings , connectIMAPSSLWithSettings
-- * Settings -- * Settings
, Settings(..)
, defaultSettingsIMAPSSL , defaultSettingsIMAPSSL
-- * Network.HaskellNet.IMAP re-exports
, module Network.HaskellNet.IMAP
) where ) where
import Network.HaskellNet.IMAP.Connection import Network.HaskellNet.IMAP.Connection
@ -16,14 +12,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

@ -3,10 +3,7 @@ module Network.HaskellNet.POP3.SSL
connectPop3SSL connectPop3SSL
, connectPop3SSLWithSettings , connectPop3SSLWithSettings
-- * Settings -- * Settings
, Settings(..)
, defaultSettingsPop3SSL , defaultSettingsPop3SSL
-- * Network.HaskellNet.POP3 re-exports
, module Network.HaskellNet.POP3
) where ) where
import Network.HaskellNet.POP3.Connection import Network.HaskellNet.POP3.Connection

View File

@ -10,11 +10,8 @@ module Network.HaskellNet.SMTP.SSL
, doSMTPSTARTTLS , doSMTPSTARTTLS
, doSMTPSTARTTLSWithSettings , doSMTPSTARTTLSWithSettings
-- * Settings -- * Settings
, Settings(..)
, defaultSettingsSMTPSSL , defaultSettingsSMTPSSL
, defaultSettingsSMTPSTARTTLS , defaultSettingsSMTPSTARTTLS
-- * Network.HaskellNet.SMTP re-exports
, module Network.HaskellNet.SMTP
) where ) where
import Network.HaskellNet.SMTP import Network.HaskellNet.SMTP
@ -48,12 +45,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 +57,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,28 +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 }
, sslDisableCertificateValidation :: Bool -- ^ Disable certificate validation
} 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
, sslMaxLineLength = 10000 , sslMaxLineLength = 10000
, sslLogToConsole = False
, sslDisableCertificateValidation = False
} }

View File

@ -3,6 +3,7 @@ module Network.HaskellNet.SSL.Internal
, connectPlain , connectPlain
) where ) where
import Network.Connection import Network.Connection
import Network.HaskellNet.SSL import Network.HaskellNet.SSL
import Network.HaskellNet.BSStream import Network.HaskellNet.BSStream
@ -10,8 +11,6 @@ import Network.HaskellNet.BSStream
import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Char8 as B
import Data.Default import Data.Default
import Control.Monad ((>=>))
type STARTTLS = IO () type STARTTLS = IO ()
connectionGetBytes :: Connection -> Int -> IO B.ByteString connectionGetBytes :: Connection -> Int -> IO B.ByteString
@ -22,35 +21,25 @@ connectionGetBytes = loop B.empty where
connectionToStream :: Connection -> Settings -> BSStream connectionToStream :: Connection -> Settings -> BSStream
connectionToStream c cfg = BSStream connectionToStream c cfg = BSStream
{ bsGet = connectionGetBytes c >=> withLog "RECV" { bsGet = connectionGetBytes c
, bsPut = withLog "SEND" >=> connectionPut c , bsPut = connectionPut c
, bsFlush = return () , bsFlush = return ()
, bsClose = connectionClose c , bsClose = connectionClose c
, bsIsOpen = return True , bsIsOpen = return True
, bsGetLine = connectionGetLine maxl c >>= withLog "RECV" , bsGetLine = connectionGetLine maxl c
, bsWaitForInput = connectionWaitForInput c
} where maxl = sslMaxLineLength cfg } where maxl = sslMaxLineLength cfg
withLog = if sslLogToConsole cfg then logToConsole
else flip (const . return)
logToConsole :: String -> B.ByteString -> IO B.ByteString
logToConsole dir s = do
putStrLn $ "HaskellNet-SSL " ++ dir ++ ": " ++ show s
return s
connectSSL :: String -> Settings -> IO BSStream connectSSL :: String -> Settings -> IO BSStream
connectSSL hostname cfg = do connectSSL hostname cfg = do
c <- initConnectionContext >>= flip connectTo params c <- initConnectionContext >>= flip connectTo params
return $ connectionToStream c cfg return $ connectionToStream c cfg
where params = ConnectionParams hostname port (Just tlsCfg) Nothing where params = ConnectionParams hostname port (Just def) Nothing
port = sslPort cfg port = sslPort cfg
tlsCfg = def { settingDisableCertificateValidation = sslDisableCertificateValidation cfg }
connectPlain :: String -> Settings -> IO (BSStream, STARTTLS) connectPlain :: String -> Settings -> IO (BSStream, STARTTLS)
connectPlain hostname cfg = do connectPlain hostname cfg = do
ctx <- initConnectionContext ctx <- initConnectionContext
c <- connectTo ctx params c <- connectTo ctx params
return (connectionToStream c cfg, connectionSetSecure ctx c tlsCfg) return (connectionToStream c cfg, connectionSetSecure ctx c def)
where params = ConnectionParams hostname port Nothing Nothing where params = ConnectionParams hostname port Nothing Nothing
port = sslPort cfg port = sslPort cfg
tlsCfg = def { settingDisableCertificateValidation = sslDisableCertificateValidation cfg }

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