openssl-streams 1.1.0.2 → 1.2.0.0
raw patch · 4 files changed
+161/−62 lines, 4 filesdep ~HsOpenSSLdep ~io-streamsdep ~networkPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: HsOpenSSL, io-streams, network, test-framework, test-framework-hunit
API changes (from Hackage documentation)
+ System.IO.Streams.SSL: withConnection :: SSLContext -> HostName -> PortNumber -> (InputStream ByteString -> OutputStream ByteString -> SSL -> IO a) -> IO a
Files
- changelog.md +20/−0
- openssl-streams.cabal +13/−20
- src/System/IO/Streams/SSL.hs +61/−6
- test/TestSuite.hs +67/−36
+ changelog.md view
@@ -0,0 +1,20 @@+# openssl-streams changelog #++## 1.2.0.0+ - Added `withConnection`, a convenience function for initiating an SSL+ connection to a given `(host, port)` pair. The socket and SSL connection+ are closed after the user handler runs.+ - Moved changelog from cabal file to changelog.md+ - Updated the dependency list to allow latest `io-streams` and `network`.++## 1.1.0.2+Fixed a bug in the `connect` routine uncovered by the recent network upgrade.++## 1.1.0.1+Widened @network@ dependency to include 2.5.++## 1.1.0.0+Updated `openssl-streams` to work with `io-streams` 1.1.0.0.++## 1.0.0.0+First release.
openssl-streams.cabal view
@@ -1,5 +1,5 @@ Name: openssl-streams-Version: 1.1.0.2+Version: 1.2.0.0 License: BSD3 License-file: LICENSE Category: Network, IO-Streams@@ -10,16 +10,9 @@ Description: The openssl-streams library contains io-streams routines for secure networking using OpenSSL (by way of HsOpenSSL).- .- /ChangeLog/- [@1.1.0.2@] Fixed a bug in the \"connect\" routine uncovered by the recent- network upgrade.- .- [@1.1.0.1@] Widened @network@ dependency to include 2.5.- .- [@1.1.0.0@] Updated @openssl-streams@ to work with @io-streams@ 1.1.0.0. Extra-Source-Files: CONTRIBUTORS,+ changelog.md test/cert.pem, test/key.pem @@ -37,9 +30,9 @@ Build-depends: base >= 4 && <5, bytestring >= 0.9.2 && <0.11,- HsOpenSSL >= 0.10.3 && <0.11,- io-streams >= 1.0 && <1.2,- network >= 2.4 && <2.6+ HsOpenSSL >= 0.10.3 && <0.12,+ io-streams >= 1.0 && <1.3,+ network >= 2.4 && <2.7 ------------------------------------------------------------------------------@@ -54,15 +47,15 @@ -fno-warn-unused-do-bind ghc-prof-options: -prof -auto-all - Build-depends: base >= 4 && <5,- bytestring >= 0.9.2 && <0.11,- HsOpenSSL >= 0.10.3 && <0.11,- io-streams >= 1.0 && <1.2,- network >= 2.3 && <2.6,+ Build-depends: base >= 4 && <5,+ bytestring >= 0.9.2 && <0.11,+ HsOpenSSL >= 0.10.3 && <0.12,+ io-streams >= 1.0 && <1.3,+ network >= 2.3 && <2.7, -- test deps follow.- HUnit >= 1.2 && <2,- test-framework >= 0.6 && <0.7,- test-framework-hunit >= 0.2.7 && <0.3+ HUnit >= 1.2 && <2,+ test-framework >= 0.8.0.3 && <0.9,+ test-framework-hunit >= 0.3 && <0.4 other-extensions: OverloadedStrings
src/System/IO/Streams/SSL.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ScopedTypeVariables #-}+ -- | This module provides convenience functions for interfacing @io-streams@ -- with @HsOpenSSL@. It is intended to be imported @qualified@, e.g.: --@@ -24,9 +26,12 @@ module System.IO.Streams.SSL ( connect+ , withConnection , sslToStreams ) where +import qualified Control.Exception as E+import Control.Monad (void) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import Network.Socket (HostName, PortNumber)@@ -90,15 +95,65 @@ let protocol = N.addrProtocol addrInfo let address = N.addrAddress addrInfo - sock <- N.socket family socketType protocol- N.connect sock address- ssl <- SSL.connection ctx sock- SSL.connect ssl- (is, os) <- sslToStreams ssl- return $! (is, os, ssl)+ E.bracketOnError (N.socket family socketType protocol)+ N.close+ (\sock -> do N.connect sock address+ ssl <- SSL.connection ctx sock+ SSL.connect ssl+ (is, os) <- sslToStreams ssl+ return $! (is, os, ssl)+ ) where hints = N.defaultHints { N.addrFlags = [N.AI_ADDRCONFIG, N.AI_NUMERICSERV] , N.addrSocketType = N.Stream }+++------------------------------------------------------------------------------+-- | Convenience function for initiating an SSL connection to the given+-- @('HostName', 'PortNumber')@ combination. The socket and SSL connection are+-- closed and deleted after the user handler runs.+--+-- /Since: 1.2.0.0./+withConnection ::+ SSLContext -- ^ SSL context. See the @HsOpenSSL@+ -- documentation for information on creating+ -- this.+ -> HostName -- ^ hostname to connect to+ -> PortNumber -- ^ port number to connect to+ -> (InputStream ByteString -> OutputStream ByteString -> SSL -> IO a)+ -- ^ Action to run with the new connection+ -> IO a+withConnection ctx host port action = do+ (addrInfo:_) <- N.getAddrInfo (Just hints) (Just host) (Just $ show port)+ E.bracket (connectTo addrInfo) cleanup go++ where+ go (is, os, ssl, _) = action is os ssl++ connectTo addrInfo = do+ let family = N.addrFamily addrInfo+ let socketType = N.addrSocketType addrInfo+ let protocol = N.addrProtocol addrInfo+ let address = N.addrAddress addrInfo+ E.bracketOnError (N.socket family socketType protocol)+ N.close+ (\sock -> do N.connect sock address+ ssl <- SSL.connection ctx sock+ SSL.connect ssl+ (is, os) <- sslToStreams ssl+ return $! (is, os, ssl, sock))++ cleanup (_, os, ssl, sock) = E.mask_ $ do+ eatException $! Streams.write Nothing os+ eatException $! SSL.shutdown ssl $! SSL.Unidirectional+ eatException $! N.close sock++ hints = N.defaultHints {+ N.addrFlags = [N.AI_ADDRCONFIG, N.AI_NUMERICSERV]+ , N.addrSocketType = N.Stream+ }++ eatException m = void m `E.catch` (\(_::E.SomeException) -> return $! ())
test/TestSuite.hs view
@@ -17,30 +17,20 @@ main :: IO ()-main = defaultMain [sanityCheck]+main = N.withSocketsDo+ $ SSL.withOpenSSL+ $ defaultMain [sanityCheck, withConnection] ------------------------------------------------------------------------------ sanityCheck :: Test-sanityCheck = testCase "sanitycheck" $ N.withSocketsDo $- SSL.withOpenSSL $ do+sanityCheck = testCase "sanitycheck" $ do ctx1 <- setupContext ctx2 <- setupContext x <- timeout (10 * 10^(6::Int)) $ go ctx1 ctx2 assertEqual "ok" (Just ()) x where- setupContext = do- ctx <- SSL.context- SSL.contextSetDefaultCiphers ctx- SSL.contextSetCertificateFile ctx "test/cert.pem"- SSL.contextSetPrivateKeyFile ctx "test/key.pem"- SSL.contextSetVerificationMode ctx SSL.VerifyNone-- certOK <- SSL.contextCheckPrivateKey ctx- assertBool "private key is bad" certOK- return ctx- go ctx1 ctx2 = do portMVar <- newEmptyMVar resultMVar <- newEmptyMVar@@ -57,25 +47,66 @@ Streams.toList is >>= putMVar resultMVar maybe (return ()) N.sClose $ SSL.sslSocket ssl - server ctx mvar = do- let hint = N.defaultHints {- N.addrFamily = N.AF_INET,- N.addrSocketType = N.Stream,- N.addrFlags = [N.AI_NUMERICHOST]- }- xs <- N.getAddrInfo (Just hint) (Just "127.0.0.1") Nothing- let [addr] = xs- sock <- N.socket N.AF_INET N.Stream N.defaultProtocol- let saddr = N.addrAddress addr- N.bind sock saddr- N.listen sock 5- port <- N.socketPort sock- putMVar mvar port- (csock, _) <- N.accept sock- ssl <- SSL.connection ctx csock- SSL.accept ssl- (is, os) <- SSLStreams.sslToStreams ssl- Streams.toList is >>= flip Streams.writeList os- SSL.shutdown ssl SSL.Unidirectional- maybe (return ()) N.close $ SSL.sslSocket ssl- N.close sock++------------------------------------------------------------------------------+withConnection :: Test+withConnection = testCase "withConnection" $ do+ ctx1 <- setupContext+ ctx2 <- setupContext+ x <- timeout (10 * 10^(6::Int)) $ go ctx1 ctx2+ assertEqual "ok" (Just ()) x++ where+ go ctx1 ctx2 = do+ portMVar <- newEmptyMVar+ resultMVar <- newEmptyMVar+ forkIO $ client ctx1 portMVar resultMVar+ server ctx2 portMVar+ l <- takeMVar resultMVar+ assertEqual "testSocket" l ["ok"]++ client ctx mvar resultMVar = do+ port <- takeMVar mvar+ SSLStreams.withConnection ctx "127.0.0.1" port $ \is os ssl -> do+ Streams.fromList ["ok"] >>= Streams.connectTo os+ SSL.shutdown ssl SSL.Unidirectional+ Streams.toList is >>= putMVar resultMVar+ maybe (return ()) N.sClose $ SSL.sslSocket ssl++------------------------------------------------------------------------------+server :: SSL.SSLContext -> MVar N.PortNumber -> IO ()+server ctx mvar = do+ let hint = N.defaultHints {+ N.addrFamily = N.AF_INET,+ N.addrSocketType = N.Stream,+ N.addrFlags = [N.AI_NUMERICHOST]+ }+ xs <- N.getAddrInfo (Just hint) (Just "127.0.0.1") Nothing+ let [addr] = xs+ sock <- N.socket N.AF_INET N.Stream N.defaultProtocol+ let saddr = N.addrAddress addr+ N.bind sock saddr+ N.listen sock 5+ port <- N.socketPort sock+ putMVar mvar port+ (csock, _) <- N.accept sock+ ssl <- SSL.connection ctx csock+ SSL.accept ssl+ (is, os) <- SSLStreams.sslToStreams ssl+ Streams.toList is >>= flip Streams.writeList os+ SSL.shutdown ssl SSL.Unidirectional+ maybe (return ()) N.close $ SSL.sslSocket ssl+ N.close sock+++setupContext :: IO SSL.SSLContext+setupContext = do+ ctx <- SSL.context+ SSL.contextSetDefaultCiphers ctx+ SSL.contextSetCertificateFile ctx "test/cert.pem"+ SSL.contextSetPrivateKeyFile ctx "test/key.pem"+ SSL.contextSetVerificationMode ctx SSL.VerifyNone++ certOK <- SSL.contextCheckPrivateKey ctx+ assertBool "private key is bad" certOK+ return ctx