Compare commits
40 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
1d346b07fb | ||
|
|
6fe62d91af | ||
|
|
4b2ea920e9 | ||
|
|
9bb3c2299f | ||
|
|
94266dd970 | ||
|
|
631a0bcbbb | ||
|
|
00602e297b | ||
|
|
48a2c8c1c3 | ||
|
|
7432711d62 | ||
|
|
702d54f76d | ||
|
|
3bbb4a6e05 | ||
|
|
61969afabf | ||
|
|
a777a369d4 | ||
|
|
f7e895fb06 | ||
|
|
35c03e8f84 | ||
|
|
ec5c163e7a | ||
|
|
de90b9b120 | ||
|
|
717f8e202a | ||
|
|
9357f7e609 | ||
|
|
bd46b74785 | ||
|
|
e61f8db1bc | ||
|
|
c9c0127b6d | ||
|
|
bc814b6345 | ||
|
|
2dc5878f29 | ||
|
|
4fd67bbf72 | ||
|
|
3ded1c8aef | ||
|
|
28ec9b955b | ||
|
|
8930d7c983 | ||
|
|
9a1f4856db | ||
|
|
9751145745 | ||
|
|
e9fa5a6d6b | ||
|
|
b934525161 | ||
|
|
263bee1392 | ||
|
|
3f2fb2c79b | ||
|
|
ea58def91a | ||
|
|
4aec92321f | ||
|
|
bb458c529d | ||
|
|
c32368208a | ||
|
|
a54d98a166 | ||
|
|
273decaf96 |
31
.gitignore
vendored
31
.gitignore
vendored
@ -1 +1,32 @@
|
|||||||
|
# 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/
|
||||||
|
|||||||
6
.travis.yml
Normal file
6
.travis.yml
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
language: haskell
|
||||||
|
matrix:
|
||||||
|
fast_finish: true
|
||||||
|
include:
|
||||||
|
- ghc: 7.10
|
||||||
|
- ghc: 7.8
|
||||||
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,19 +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.2.2
|
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: 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 network-bsd
|
||||||
|
description: Get Network.BSD from the network-bsd package
|
||||||
|
default: True
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
@ -22,15 +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
|
||||||
build-depends: base >= 4 && < 5,
|
build-depends: base >= 4 && < 5,
|
||||||
HaskellNet == 0.3.*,
|
HaskellNet >= 0.3 && < 0.7,
|
||||||
tls == 1.1.*,
|
crypton-connection >= 0.3.1 && < 0.5,
|
||||||
connection == 0.1.*,
|
bytestring >= 0.9 && < 0.13,
|
||||||
network == 2.4.*,
|
data-default >= 0.2 && < 0.9
|
||||||
bytestring,
|
if flag(network-bsd)
|
||||||
data-default
|
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
|
||||||
|
|||||||
@ -1,11 +1,12 @@
|
|||||||
HaskellNet-SSL
|
# 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
|
||||||
@ -1,42 +1,54 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
import Network.HaskellNet.IMAP
|
import Network.HaskellNet.IMAP.SSL
|
||||||
import Network.HaskellNet.IMAP.SSL
|
import Network.HaskellNet.SMTP.SSL as SMTP
|
||||||
|
|
||||||
import Network.HaskellNet.SMTP
|
import Network.HaskellNet.Auth (AuthType(LOGIN), Password)
|
||||||
import Network.HaskellNet.SMTP.SSL
|
import Network.Mail.Mime
|
||||||
|
|
||||||
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 <- 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
|
||||||
r@(rsp, _) <- sendCommand c $ AUTH LOGIN username password
|
authSucceed <- SMTP.authenticate LOGIN username password c
|
||||||
if rsp /= 235
|
if authSucceed
|
||||||
then print r
|
then do
|
||||||
else sendMail username [recipient] mailContent c
|
mail <- simpleMail
|
||||||
where mailContent = subject `B.append` body
|
recipient
|
||||||
subject = "Subject: Test message\r\n\r\n"
|
username
|
||||||
body = "This is a test message"
|
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 :: IO ()
|
||||||
main = smtpTest >> imapTest >> return ()
|
main = do
|
||||||
|
smtpTest
|
||||||
|
imapTest
|
||||||
|
|||||||
@ -1,9 +1,13 @@
|
|||||||
|
-- | 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
|
||||||
@ -12,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
|
||||||
|
|||||||
@ -3,7 +3,10 @@ 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
|
||||||
|
|||||||
@ -10,8 +10,11 @@ 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
|
||||||
@ -45,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
|
||||||
@ -57,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,28 @@
|
|||||||
|
{-# 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 -- ^ 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
|
||||||
}
|
}
|
||||||
|
|||||||
@ -3,7 +3,6 @@ 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
|
||||||
@ -11,6 +10,8 @@ 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
|
||||||
@ -21,25 +22,35 @@ connectionGetBytes = loop B.empty where
|
|||||||
|
|
||||||
connectionToStream :: Connection -> Settings -> BSStream
|
connectionToStream :: Connection -> Settings -> BSStream
|
||||||
connectionToStream c cfg = BSStream
|
connectionToStream c cfg = BSStream
|
||||||
{ bsGet = connectionGetBytes c
|
{ bsGet = connectionGetBytes c >=> withLog "RECV"
|
||||||
, bsPut = connectionPut c
|
, bsPut = withLog "SEND" >=> connectionPut c
|
||||||
, bsFlush = return ()
|
, bsFlush = return ()
|
||||||
, bsClose = connectionClose c
|
, bsClose = connectionClose c
|
||||||
, bsIsOpen = return True
|
, bsIsOpen = return True
|
||||||
, bsGetLine = connectionGetLine maxl c
|
, bsGetLine = connectionGetLine maxl c >>= withLog "RECV"
|
||||||
|
, 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 def) Nothing
|
where params = ConnectionParams hostname port (Just tlsCfg) 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 def)
|
return (connectionToStream c cfg, connectionSetSecure ctx c tlsCfg)
|
||||||
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 }
|
||||||
|
|||||||
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