Compare commits

..

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

13 changed files with 86 additions and 319 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
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
synopsis: Helpers to connect to SSL/TLS mail servers with HaskellNet
version: 0.4.0.2
version: 0.2
description: This package ties together the HaskellNet and connection
packages to make it easy to open IMAP and SMTP connections
over SSL.
homepage: https://github.com/dpwright/HaskellNet-SSL
tested-with: GHC ==9.4.8 || ==9.6.5 || ==9.8.2
license: BSD3
license-file: LICENSE
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
category: Network
build-type: Simple
cabal-version: 1.18
extra-doc-files: README.md, CHANGELOG.md
flag network-bsd
description: Get Network.BSD from the network-bsd package
default: True
cabal-version: >=1.8
data-files: README.md
source-repository head
type: git
@ -27,30 +22,15 @@ source-repository head
library
hs-source-dirs: src
ghc-options: -Wall
default-language: Haskell2010
exposed-modules: Network.HaskellNet.IMAP.SSL
Network.HaskellNet.POP3.SSL
Network.HaskellNet.SMTP.SSL
Network.HaskellNet.SSL
other-modules: Network.HaskellNet.SSL.Internal
other-modules: Network.HaskellNet.SSL
build-depends: base >= 4 && < 5,
HaskellNet >= 0.3 && < 0.7,
crypton-connection >= 0.3.1 && < 0.5,
bytestring >= 0.9 && < 0.13,
data-default >= 0.2 && < 0.9
if flag(network-bsd)
build-depends: network >= 3.0 && < 3.3,
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
HaskellNet >= 0.3.1,
tls >= 1.1.2,
tls-extra >= 0.6.1,
connection >= 0.1.3,
network >= 2.3,
bytestring,
data-default

View File

@ -1,12 +1,11 @@
# 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)
HaskellNet-SSL
--------------
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)
connecting to IMAP/SMTP servers and b) making an SSL connection goes to the
aforementioned libraries.
[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,37 @@
{-# LANGUAGE OverloadedStrings #-}
import Network.HaskellNet.IMAP.SSL
import Network.HaskellNet.SMTP.SSL as SMTP
import Network.HaskellNet.IMAP
import Network.HaskellNet.IMAP.SSL
import Network.HaskellNet.Auth (AuthType(LOGIN), Password)
import Network.Mail.Mime
import Network.HaskellNet.SMTP
import Network.HaskellNet.SMTP.SSL
import Network.HaskellNet.Auth (AuthType(PLAIN))
import qualified Data.ByteString.Char8 as B
import Data.String
username :: IsString s => s
username = "username@gmail.com"
password :: Password
password = "password"
recipient :: Address
recipient = "someone@somewhere.com"
imapTest :: IO ()
imapTest = do
c <- connectIMAPSSLWithSettings "imap.gmail.com" cfg
c <- connectIMAPSSL "imap.gmail.com"
login c username password
mboxes <- list c
mapM_ print mboxes
select c "INBOX"
msgs@(firstMsg : _) <- search c [ALLs]
msgs <- search c [ALLs]
let firstMsg = head msgs
msgContent <- fetch c firstMsg
B.putStrLn msgContent
logout c
where cfg = defaultSettingsIMAPSSL { sslMaxLineLength = 100000 }
smtpTest :: IO ()
smtpTest = doSMTPSTARTTLS "smtp.gmail.com" $ \c -> do
authSucceed <- SMTP.authenticate LOGIN username password c
if authSucceed
then do
mail <- simpleMail
recipient
username
subject
body
mempty
mempty
sendMail mail c -- recipient username subject body
else print "Authentication error."
where subject = "Test message"
body = "This is a test message"
sendCommand c $ AUTH PLAIN username password
sendMail username [recipient] mailContent c
where mailContent = subject `B.append` body
subject = "Subject: Test message\r\n\r\n"
body = "This is a test message"
main :: IO ()
main = do
smtpTest
imapTest
main = smtpTest >> imapTest >> return ()

View File

@ -1,29 +1,16 @@
-- | IMAP SSL Connections
module Network.HaskellNet.IMAP.SSL
( -- * Establishing connection
connectIMAPSSL
, connectIMAPSSLWithSettings
-- * Settings
, Settings(..)
, defaultSettingsIMAPSSL
-- * Network.HaskellNet.IMAP re-exports
, module Network.HaskellNet.IMAP
) where
import Network.HaskellNet.IMAP.Connection
import Network.HaskellNet.IMAP
import Network.HaskellNet.SSL
import Network.HaskellNet.SSL.Internal
-- | Create IMAP connection with default settings
connectIMAPSSL :: String -> IO IMAPConnection
connectIMAPSSL hostname = connectIMAPSSLWithSettings hostname defaultSettingsIMAPSSL
connectIMAPSSL hostname = connectIMAPSSLWithSettings hostname cfg
where cfg = defaultSettingsWithPort 993
-- | Create IMAP connection with given settings
connectIMAPSSLWithSettings :: String -> Settings -> IO IMAPConnection
connectIMAPSSLWithSettings hostname cfg = connectSSL hostname cfg >>= connectStream
-- | Default IMAP SSL settings, port 993
defaultSettingsIMAPSSL :: Settings
defaultSettingsIMAPSSL = defaultSettingsWithPort 993

View File

@ -2,24 +2,15 @@ module Network.HaskellNet.POP3.SSL
( -- * Establishing connection
connectPop3SSL
, connectPop3SSLWithSettings
-- * Settings
, Settings(..)
, defaultSettingsPop3SSL
-- * Network.HaskellNet.POP3 re-exports
, module Network.HaskellNet.POP3
) where
import Network.HaskellNet.POP3.Connection
import Network.HaskellNet.POP3
import Network.HaskellNet.SSL
import Network.HaskellNet.SSL.Internal
connectPop3SSL :: String -> IO POP3Connection
connectPop3SSL hostname = connectPop3SSLWithSettings hostname defaultSettingsPop3SSL
connectPop3SSL hostname = connectPop3SSLWithSettings hostname cfg
where cfg = defaultSettingsWithPort 995
connectPop3SSLWithSettings :: String -> Settings -> IO POP3Connection
connectPop3SSLWithSettings hostname cfg = connectSSL hostname cfg >>= connectStream
defaultSettingsPop3SSL :: Settings
defaultSettingsPop3SSL = defaultSettingsWithPort 995

View File

@ -9,19 +9,11 @@ module Network.HaskellNet.SMTP.SSL
, doSMTPSSLWithSettings
, doSMTPSTARTTLS
, doSMTPSTARTTLSWithSettings
-- * Settings
, Settings(..)
, defaultSettingsSMTPSSL
, defaultSettingsSMTPSTARTTLS
-- * Network.HaskellNet.SMTP re-exports
, module Network.HaskellNet.SMTP
) where
import Network.HaskellNet.SMTP
import Network.HaskellNet.SSL
import Network.HaskellNet.SSL.Internal
import Network.HaskellNet.BSStream
import Network.BSD (getHostName)
@ -32,13 +24,15 @@ import Control.Monad
import Data.IORef
connectSMTPSSL :: String -> IO SMTPConnection
connectSMTPSSL hostname = connectSMTPSSLWithSettings hostname defaultSettingsSMTPSSL
connectSMTPSSL hostname = connectSMTPSSLWithSettings hostname cfg
where cfg = defaultSettingsWithPort 465
connectSMTPSSLWithSettings :: String -> Settings -> IO SMTPConnection
connectSMTPSSLWithSettings hostname cfg = connectSSL hostname cfg >>= connectStream
connectSMTPSTARTTLS :: String -> IO SMTPConnection
connectSMTPSTARTTLS hostname = connectSMTPSTARTTLSWithSettings hostname defaultSettingsSMTPSTARTTLS
connectSMTPSTARTTLS hostname = connectSMTPSTARTTLSWithSettings hostname cfg
where cfg = defaultSettingsWithPort 587
connectSMTPSTARTTLSWithSettings :: String -> Settings -> IO SMTPConnection
connectSMTPSTARTTLSWithSettings hostname cfg = connectSTARTTLS hostname cfg >>= connectStream
@ -48,12 +42,10 @@ connectSTARTTLS hostname cfg = do
(bs, startTLS) <- connectPlain hostname cfg
greeting <- bsGetLine bs
failIfNot bs 220 $ parse $ B.unpack greeting
failIfNot bs 220 $ parseResponse greeting
hn <- getHostName
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
bsPut bs $ B.pack "STARTTLS\r\n"
getResponse bs >>= failIfNot bs 220
@ -62,22 +54,15 @@ connectSTARTTLS hostname cfg = do
prefixRef <- newIORef [greeting]
return $ bs {bsGetLine = prefixedGetLine prefixRef (bsGetLine bs)}
where getFinalResponse bs = do
line <- fmap B.unpack $ bsGetLine bs
if (line !! 3) == '-' then getFinalResponse bs else return line
parse s = (getCode s, s)
where parseResponse = parse . B.unpack
parse s = (getCode s, s)
getCode = read . head . words
getResponse bs = liftM parse $ getFinalResponse bs
getResponse bs = liftM parseResponse $ bsGetLine bs
failIfNot :: BSStream -> Integer -> (Integer, String) -> IO ()
failIfNot bs code (rc, rs) = when (code /= rc) closeAndFail
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
-- 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.
@ -102,9 +87,3 @@ doSMTPSTARTTLS host = bracketSMTP $ connectSMTPSTARTTLS host
doSMTPSTARTTLSWithSettings :: String -> Settings -> (SMTPConnection -> IO a) -> IO a
doSMTPSTARTTLSWithSettings host port = bracketSMTP $ connectSMTPSTARTTLSWithSettings host port
defaultSettingsSMTPSSL :: Settings
defaultSettingsSMTPSSL = defaultSettingsWithPort 465
defaultSettingsSMTPSTARTTLS :: Settings
defaultSettingsSMTPSTARTTLS = defaultSettingsWithPort 587

View File

@ -1,28 +1,57 @@
{-# LANGUAGE CPP #-}
module Network.HaskellNet.SSL
( Settings (..)
, defaultSettingsWithPort
, connectSSL
, connectPlain
) where
#if MIN_VERSION_network(3,0,0)
import Network.Socket (PortNumber)
#else
import Network.Connection
import Network.HaskellNet.BSStream
import Network.Socket.Internal (PortNumber)
#endif
-- | Settings for configuring HaskellNet connections
import qualified Data.ByteString.Char8 as B
import Data.Default
type STARTTLS = IO ()
data Settings = Settings
{ sslPort :: PortNumber -- ^ Port number to connect to
, sslMaxLineLength :: Int -- ^ Max line lengths
, sslLogToConsole :: Bool -- ^ Log info to console
, sslDisableCertificateValidation :: Bool -- ^ Disable certificate validation
} deriving(Eq, Ord, Show)
{ sslPort :: PortNumber
, sslMaxLineLength :: Int
}
-- | Construct default settings for a port
defaultSettingsWithPort :: PortNumber -> Settings
defaultSettingsWithPort p = Settings
{ sslPort = p
, sslMaxLineLength = 10000
, sslLogToConsole = False
, sslDisableCertificateValidation = False
}
connectionGetBytes :: Connection -> Int -> IO B.ByteString
connectionGetBytes = loop B.empty where
loop buf _ 0 = return buf
loop buf c l = connectionGet c l >>= nextIteration
where nextIteration b = loop (buf `B.append` b) c $ l - B.length b
connectionToStream :: Connection -> Settings -> BSStream
connectionToStream c cfg = BSStream
{ bsGet = connectionGetBytes c
, bsPut = connectionPut c
, bsFlush = return ()
, bsClose = connectionClose c
, bsIsOpen = return True
, bsGetLine = connectionGetLine maxl c
} where maxl = sslMaxLineLength cfg
connectSSL :: String -> Settings -> IO BSStream
connectSSL hostname cfg = do
c <- initConnectionContext >>= flip connectTo params
return $ connectionToStream c cfg
where params = ConnectionParams hostname port (Just def) Nothing
port = sslPort cfg
connectPlain :: String -> Settings -> IO (BSStream, STARTTLS)
connectPlain hostname cfg = do
ctx <- initConnectionContext
c <- connectTo ctx params
return (connectionToStream c cfg, connectionSetSecure ctx c def)
where params = ConnectionParams hostname port Nothing Nothing
port = sslPort cfg

View File

@ -1,56 +0,0 @@
module Network.HaskellNet.SSL.Internal
( connectSSL
, connectPlain
) where
import Network.Connection
import Network.HaskellNet.SSL
import Network.HaskellNet.BSStream
import qualified Data.ByteString.Char8 as B
import Data.Default
import Control.Monad ((>=>))
type STARTTLS = IO ()
connectionGetBytes :: Connection -> Int -> IO B.ByteString
connectionGetBytes = loop B.empty where
loop buf _ 0 = return buf
loop buf c l = connectionGet c l >>= nextIteration
where nextIteration b = loop (buf `B.append` b) c $ l - B.length b
connectionToStream :: Connection -> Settings -> BSStream
connectionToStream c cfg = BSStream
{ bsGet = connectionGetBytes c >=> withLog "RECV"
, bsPut = withLog "SEND" >=> connectionPut c
, bsFlush = return ()
, bsClose = connectionClose c
, bsIsOpen = return True
, bsGetLine = connectionGetLine maxl c >>= withLog "RECV"
, bsWaitForInput = connectionWaitForInput c
} 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 hostname cfg = do
c <- initConnectionContext >>= flip connectTo params
return $ connectionToStream c cfg
where params = ConnectionParams hostname port (Just tlsCfg) Nothing
port = sslPort cfg
tlsCfg = def { settingDisableCertificateValidation = sslDisableCertificateValidation cfg }
connectPlain :: String -> Settings -> IO (BSStream, STARTTLS)
connectPlain hostname cfg = do
ctx <- initConnectionContext
c <- connectTo ctx params
return (connectionToStream c cfg, connectionSetSecure ctx c tlsCfg)
where params = ConnectionParams hostname port Nothing Nothing
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