Compare commits
10 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
1d346b07fb | ||
|
|
6fe62d91af | ||
|
|
4b2ea920e9 | ||
|
|
9bb3c2299f | ||
|
|
94266dd970 | ||
|
|
631a0bcbbb | ||
|
|
00602e297b | ||
|
|
48a2c8c1c3 | ||
|
|
7432711d62 | ||
|
|
702d54f76d |
1
.gitignore
vendored
1
.gitignore
vendored
@ -29,3 +29,4 @@ cabal.config
|
||||
*.prof
|
||||
*.aux
|
||||
*.hp
|
||||
.stack-work/
|
||||
|
||||
@ -2,9 +2,5 @@ language: haskell
|
||||
matrix:
|
||||
fast_finish: true
|
||||
include:
|
||||
- ghc: 7.10
|
||||
- ghc: 7.8
|
||||
- ghc: 7.6
|
||||
- ghc: 7.3
|
||||
allow_failures:
|
||||
- ghc: 7.8
|
||||
install: cabal install --only-dependencies --enable-tests -f NoUpperBounds
|
||||
|
||||
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
|
||||
synopsis: Helpers to connect to SSL/TLS mail servers with HaskellNet
|
||||
version: 0.3.2.1
|
||||
version: 0.4.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: dani@dpwright.com, lemol-c@hotmail.com
|
||||
maintainer: Leza M. Lutonda <lemol-c@outlook.com>, dani@dpwright.com, contact@mangoiv.com
|
||||
copyright: (c) 2013 Daniel P. Wright
|
||||
category: Network
|
||||
build-type: Simple
|
||||
cabal-version: >=1.8
|
||||
data-files: README.md
|
||||
cabal-version: 1.18
|
||||
extra-doc-files: README.md, CHANGELOG.md
|
||||
|
||||
Flag NoUpperBounds
|
||||
Description: Removes upper bounds from all packages
|
||||
Default: False
|
||||
flag network-bsd
|
||||
description: Get Network.BSD from the network-bsd package
|
||||
default: True
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
@ -26,24 +27,30 @@ 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
|
||||
if flag(NoUpperBounds)
|
||||
build-depends: base >= 4,
|
||||
HaskellNet >= 0.3,
|
||||
tls >= 1.2,
|
||||
connection >= 0.2,
|
||||
network >= 2.4,
|
||||
bytestring,
|
||||
data-default
|
||||
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: base >= 4 && < 5,
|
||||
HaskellNet >= 0.3 && < 0.6,
|
||||
tls >= 1.2 && < 1.4,
|
||||
connection == 0.2.*,
|
||||
network >= 2.4 && < 2.7,
|
||||
bytestring,
|
||||
data-default
|
||||
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
|
||||
|
||||
@ -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
|
||||
[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)
|
||||
connecting to IMAP/SMTP servers and b) making an SSL connection goes to the
|
||||
aforementioned libraries.
|
||||
|
||||
[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.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 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
|
||||
login c username password
|
||||
mboxes <- list c
|
||||
mapM_ print mboxes
|
||||
select c "INBOX"
|
||||
msgs <- search c [ALLs]
|
||||
let firstMsg = head msgs
|
||||
msgs@(firstMsg : _) <- search c [ALLs]
|
||||
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 print "Authentication error."
|
||||
else 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."
|
||||
where subject = "Test message"
|
||||
body = "This is a test message"
|
||||
|
||||
main :: IO ()
|
||||
main = smtpTest >> imapTest >> return ()
|
||||
main = do
|
||||
smtpTest
|
||||
imapTest
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
-- | IMAP SSL Connections
|
||||
module Network.HaskellNet.IMAP.SSL
|
||||
( -- * Establishing connection
|
||||
connectIMAPSSL
|
||||
@ -15,11 +16,14 @@ import Network.HaskellNet.SSL
|
||||
|
||||
import Network.HaskellNet.SSL.Internal
|
||||
|
||||
-- | Create IMAP connection with default settings
|
||||
connectIMAPSSL :: String -> IO IMAPConnection
|
||||
connectIMAPSSL hostname = connectIMAPSSLWithSettings hostname defaultSettingsIMAPSSL
|
||||
|
||||
-- | 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
|
||||
|
||||
@ -48,10 +48,12 @@ connectSTARTTLS hostname cfg = do
|
||||
(bs, startTLS) <- connectPlain hostname cfg
|
||||
|
||||
greeting <- bsGetLine bs
|
||||
failIfNot bs 220 $ parseResponse greeting
|
||||
failIfNot bs 220 $ parse $ B.unpack 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
|
||||
@ -60,15 +62,22 @@ connectSTARTTLS hostname cfg = do
|
||||
|
||||
prefixRef <- newIORef [greeting]
|
||||
return $ bs {bsGetLine = prefixedGetLine prefixRef (bsGetLine bs)}
|
||||
where parseResponse = parse . B.unpack
|
||||
parse s = (getCode s, s)
|
||||
where getFinalResponse bs = do
|
||||
line <- fmap B.unpack $ bsGetLine bs
|
||||
if (line !! 3) == '-' then getFinalResponse bs else return line
|
||||
parse s = (getCode s, s)
|
||||
getCode = read . head . words
|
||||
getResponse bs = liftM parseResponse $ bsGetLine bs
|
||||
getResponse bs = liftM parse $ getFinalResponse 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.
|
||||
|
||||
@ -1,17 +1,24 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Network.HaskellNet.SSL
|
||||
( Settings (..)
|
||||
, defaultSettingsWithPort
|
||||
) where
|
||||
|
||||
#if MIN_VERSION_network(3,0,0)
|
||||
import Network.Socket (PortNumber)
|
||||
#else
|
||||
import Network.Socket.Internal (PortNumber)
|
||||
#endif
|
||||
|
||||
-- | Settings for configuring HaskellNet connections
|
||||
data Settings = Settings
|
||||
{ sslPort :: PortNumber
|
||||
, sslMaxLineLength :: Int
|
||||
, sslLogToConsole :: Bool
|
||||
, sslDisableCertificateValidation :: Bool
|
||||
}
|
||||
{ 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)
|
||||
|
||||
-- | Construct default settings for a port
|
||||
defaultSettingsWithPort :: PortNumber -> Settings
|
||||
defaultSettingsWithPort p = Settings
|
||||
{ sslPort = p
|
||||
|
||||
@ -28,6 +28,7 @@ connectionToStream c cfg = BSStream
|
||||
, 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)
|
||||
|
||||
66
stack.yaml
Normal file
66
stack.yaml
Normal file
@ -0,0 +1,66 @@
|
||||
# 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
|
||||
Loading…
Reference in New Issue
Block a user