tcp-streams-openssl 0.6.0.0 → 1.0.0.0

raw patch · 4 files changed

+83/−127 lines, 4 filesdep −QuickCheckdep −directorydep −test-framework-quickcheck2dep ~tcp-streamsPVP ok

version bump matches the API change (PVP)

Dependencies removed: QuickCheck, directory, test-framework-quickcheck2

Dependency ranges changed: tcp-streams

API changes (from Hackage documentation)

Files

• README.md +1/−1
• System/IO/Streams/OpenSSL.hs +44/−87
• tcp-streams-openssl.cabal +5/−8
• test/Main.hs +33/−31

@@ -2,7 +2,7 @@ ===================  [![Hackage](https://img.shields.io/hackage/v/tcp-streams-openssl.svg?style=flat)](http://hackage.haskell.org/package/tcp-streams-openssl)-[![Build Status](https://travis-ci.org/winterland1989/tcp-streams.svg)](https://travis-ci.org/winterland1989/tcp-streams)+[![Build Status](https://travis-ci.org/didi-FP/tcp-streams.svg)](https://travis-ci.org/didi-FP/tcp-streams)  This package provides TLS support based on [tcp-streams](http://hackage.haskell.org/package/tcp-streams) using [HsOpenSSL](http://hackage.haskell.org/package/HsOpenSSL). By default `tcp-streams` use `tls` package which is much easier to install but slightly slower. 

@@ -1,74 +1,61 @@ {-# LANGUAGE ScopedTypeVariables #-} --- | This module provides convenience functions for interfacing @io-streams@--- with @HsOpenSSL@. @ssl/SSL@ here stand for @HsOpenSSL@ library, not the--- deprecated SSL 2.0/3.0 protocol. the receive buffer size is 32752.--- sending is unbuffered, anything write into 'OutputStream' will be immediately--- send to underlying socket.------ The same exceptions rule which applied to TCP apply here, with addtional--- 'SSL.SomeSSLException` to be watched out.+-- | This module provides convenience functions for interfacing @HsOpenSSL@.+-- @ssl/SSL@ here stand for @HsOpenSSL@ library, not the deprecated SSL 2.0/3.0 protocol. -- -- This module is intended to be imported @qualified@, e.g.: -- -- @+-- import           "Data.Connection" -- import qualified "System.IO.Streams.OpenSSL" as SSL -- @ -- module System.IO.Streams.OpenSSL-  ( -- * client-    connect+  ( TLSConnection+    -- * client+  , connect   , connectWithVerifier-  , withConnection+  , sslToConnection     -- * server   , accept-    -- * helpers-  , sslToStreams-  , close-    -- * re-export helpers+    -- * re-export   , module Data.OpenSSLSetting   ) where  import qualified Control.Exception     as E-import           Control.Monad         (unless, void)-import           Data.ByteString.Char8 (ByteString)-import qualified Data.ByteString.Char8 as S+import           Control.Monad         (unless)+import           Data.Connection+import qualified Data.ByteString       as S import           Data.OpenSSLSetting-import           Network.Socket        (HostName, PortNumber, Socket) import qualified Network.Socket        as N import           OpenSSL               (withOpenSSL)-import           OpenSSL.Session       (SSL, SSLContext) import qualified OpenSSL.Session       as SSL import qualified OpenSSL.X509          as X509-import           System.IO.Streams     (InputStream, OutputStream) import qualified System.IO.Streams     as Streams import qualified System.IO.Streams.TCP as TCP -bUFSIZ :: Int-bUFSIZ = 32752+-- | Type alias for tls connection.+--+-- Normally you shouldn't use 'SSL.SSL' in 'connExtraInfo' directly.+--+type TLSConnection = Connection (SSL.SSL , N.SockAddr)  -- | Given an existing HsOpenSSL 'SSL' connection, produces an 'InputStream' \/ -- 'OutputStream' pair. ---sslToStreams :: SSL             -- ^ SSL connection object-             -> IO (InputStream ByteString, OutputStream ByteString)-sslToStreams ssl = do+sslToConnection :: (SSL.SSL, N.SockAddr)             -- ^ SSL connection object+                -> IO TLSConnection+sslToConnection (ssl, addr) = do     is <- Streams.makeInputStream input-    os <- Streams.makeOutputStream output-    return (is, os)-+    return (Connection is (SSL.lazyWrite ssl) (closeSSL ssl) (ssl, addr))   where     input = ( do-        s <- SSL.read ssl bUFSIZ+        s <- SSL.read ssl TCP.defaultChunkSize         return $! if S.null s then Nothing else Just s         ) `E.catch` (\(_::E.SomeException) -> return Nothing) -    output Nothing  = return ()-    output (Just s) = SSL.write ssl s-{-# INLINABLE sslToStreams #-}--close :: SSL.SSL -> IO ()-close ssl = withOpenSSL $ do+closeSSL :: SSL.SSL -> IO ()+closeSSL ssl = withOpenSSL $ do     SSL.shutdown ssl SSL.Unidirectional     maybe (return ()) N.close (SSL.sslSocket ssl) @@ -89,14 +76,13 @@ -- -- If the certificate or hostname is not verified, a 'SSL.ProtocolError' will be thrown. ---connect :: SSLContext           -- ^ SSL context. See the @HsOpenSSL@-                                -- documentation for information on creating-                                -- this.+connect :: SSL.SSLContext           -- ^ SSL context, see the @HsOpenSSL@+                                -- documentation for more information         -> Maybe String         -- ^ Optional certificate subject name, if set to 'Nothing'-                                -- then we will try to verify 'HostName' as subject name.-        -> HostName             -- ^ hostname to connect to-        -> PortNumber           -- ^ port number to connect to-        -> IO (InputStream ByteString, OutputStream ByteString, SSL)+                                -- then we will try to verify 'HostName' as subject name+        -> N.HostName           -- ^ hostname to connect to+        -> N.PortNumber         -- ^ port number to connect to+        -> IO TLSConnection connect ctx vhost host port = withOpenSSL $ do     connectWithVerifier ctx verify host port   where@@ -119,18 +105,18 @@ -- -- @since 0.6.0.0@ ---connectWithVerifier :: SSLContext       -- ^ SSL context. See the @HsOpenSSL@+connectWithVerifier :: SSL.SSLContext       -- ^ SSL context. See the @HsOpenSSL@                                         -- documentation for information on creating                                         -- this.                     -> (Bool -> Maybe String -> Bool) -- ^ A verify callback, the first param is-                                                -- the result of certificate verification, the-                                                -- second param is the certificate's subject name.-                    -> HostName             -- ^ hostname to connect to-                    -> PortNumber           -- ^ port number to connect to-                    -> IO (InputStream ByteString, OutputStream ByteString, SSL)+                                              -- the result of certificate verification, the+                                              -- second param is the certificate's subject name+                    -> N.HostName             -- ^ hostname to connect to+                    -> N.PortNumber           -- ^ port number to connect to+                    -> IO TLSConnection connectWithVerifier ctx f host port = withOpenSSL $ do-    sock <- TCP.connectSocket host port-    E.bracketOnError (SSL.connection ctx sock) close $ \ ssl -> do+    (sock, addr) <- TCP.connectSocket host port+    E.bracketOnError (SSL.connection ctx sock) closeSSL $ \ ssl -> do         SSL.connect ssl         trusted <- SSL.getVerifyResult ssl         cert <- SSL.getPeerCertificate ssl@@ -138,49 +124,20 @@         let cnname = lookup "CN" subnames             verified = f trusted cnname         unless verified (E.throwIO $ SSL.ProtocolError "fail to verify certificate")-        (is, os) <- sslToStreams ssl-        return (is, os, ssl)----- | 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.----withConnection :: SSLContext---               -> Maybe String-               -> HostName-               -> PortNumber-               -> (InputStream ByteString -> OutputStream ByteString -> SSL -> IO a)-                       -- ^ Action to run with the new connection-               -> IO a-withConnection ctx subname host port action =-    E.bracket (connect ctx subname host port) cleanup go--  where-    go (is, os, ssl) = action is os ssl--    cleanup (_, os, ssl) = E.mask_ $-        eatException $! Streams.write Nothing os >> close ssl--    eatException m = void m `E.catch` (\(_::E.SomeException) -> return ())-+        sslToConnection (ssl, addr)  -- | Accept a new connection from remote client, return a 'InputStream' / 'OutputStream' -- pair and remote 'N.SockAddr', you should call 'TCP.bindAndListen' first. -- -- this operation will throw 'SSL.SomeSSLException' on failure. ---accept :: SSL.SSLContext            -- ^ check "Data.OpenSSLSetting".-       -> Socket                    -- ^ the listening 'Socket'.-       -> IO (InputStream ByteString, OutputStream ByteString, SSL.SSL, N.SockAddr)+accept :: SSL.SSLContext            -- ^ check "Data.OpenSSLSetting"+       -> N.Socket                  -- ^ the listening 'Socket'+       -> IO TLSConnection accept ctx sock = withOpenSSL $ do-    (sock', sockAddr) <- N.accept sock-    E.bracketOnError (SSL.connection ctx sock') close $ \ ssl -> do+    (sock', addr) <- N.accept sock+    E.bracketOnError (SSL.connection ctx sock') closeSSL $ \ ssl -> do         SSL.accept ssl         trusted <- SSL.getVerifyResult ssl         unless trusted (E.throwIO $ SSL.ProtocolError "fail to verify certificate")-        (is, os) <- sslToStreams ssl-        return (is, os, ssl, sockAddr)-+        sslToConnection (ssl, addr)

@@ -1,12 +1,12 @@ name:                tcp-streams-openssl-version:             0.6.0.0+version:             1.0.0.0 synopsis:            Tcp streams using openssl for tls support. description:         Tcp streams using openssl for tls support. license:             BSD3 license-file:        LICENSE author:              winterland1989 maintainer:          winterland1989@gmail.com-homepage:            https://github.com/winterland1989/tcp-streams+homepage:            https://github.com/didi-FP/tcp-streams copyright:           (c) Winterland 2016  category:            Network build-type:          Simple@@ -19,7 +19,7 @@  source-repository head   type:     git-  location: git://github.com/winterland1989/tcp-streams.git+  location: git://github.com/didi-FP/tcp-streams.git  library   exposed-modules:    Data.OpenSSLSetting@@ -30,7 +30,7 @@                     ,   network        >=2.3  && < 3.0                     ,   bytestring     >= 0.10.2.0                     ,   io-streams     >= 1.2 && < 2.0-                    ,   tcp-streams    >= 0.6 && < 0.7+                    ,   tcp-streams    >= 1.0 && < 1.1                     ,   HsOpenSSL      >=0.10.3 && <0.12                     ,   HsOpenSSL-x509-system == 0.1.* @@ -40,7 +40,7 @@  test-suite testsuite   type:              exitcode-stdio-1.0-  Hs-source-dirs:    src test+  Hs-source-dirs:    test   main-is:           Main.hs   default-language:  Haskell2010   ghc-options:    -Wall -threaded@@ -51,8 +51,5 @@                     ,   network                     ,   bytestring                     ,   HUnit                      >= 1.2      && <2-                    ,   QuickCheck                 >= 2.3.0.2  && <3                     ,   test-framework             >= 0.6      && <0.9                     ,   test-framework-hunit       >= 0.2.7    && <0.4-                    ,   test-framework-quickcheck2 >= 0.2.12.1 && <0.4-                    ,   directory      == 1.*

@@ -13,28 +13,29 @@ import           Test.Framework.Providers.HUnit import           Test.HUnit                     hiding (Test) import qualified Data.ByteString                as B-import           System.Directory               (removeFile)+import qualified Data.ByteString.Lazy           as L ------------------------------------------------------------------------------+import           Data.Connection import qualified Data.OpenSSLSetting            as SSL import qualified System.IO.Streams              as Stream-import qualified System.IO.Streams.TCP          as Raw+import qualified System.IO.Streams.TCP          as TCP import qualified System.IO.Streams.OpenSSL      as SSL ------------------------------------------------------------------------------  main :: IO () main = defaultMain tests   where-    tests = [ testGroup "TCP" rawTests+    tests = [ testGroup "TCP" tcpTests             , testGroup "OpenSSL" sslTests             ]  ------------------------------------------------------------------------------ -rawTests :: [Test]-rawTests = [ testRawSocket ]+tcpTests :: [Test]+tcpTests = [ testTCPSocket ] -testRawSocket :: Test-testRawSocket = testCase "network/socket" $+testTCPSocket :: Test+testTCPSocket = testCase "network/socket" $     N.withSocketsDo $ do     x <- timeout (10 * 10^(6::Int)) go     assertEqual "ok" (Just ()) x@@ -50,18 +51,18 @@      client mvar resultMVar = do         _ <- takeMVar mvar-        (is, os, sock) <- Raw.connect "127.0.0.1" 8888-        Stream.fromList ["", "ok"] >>= Stream.connectTo os-        N.shutdown sock N.ShutdownSend-        Stream.toList is >>= putMVar resultMVar-        N.close sock+        conn <- TCP.connect "127.0.0.1" 8888+        send conn "ok"+        Stream.toList (source conn) >>= putMVar resultMVar+        close conn      server mvar = do-        sock <- Raw.bindAndListen 8888 1024+        sock <- TCP.bindAndListen 1024 8888         putMVar mvar ()-        (is, os, csock, _) <- Raw.accept sock-        os' <- Stream.atEndOfOutput (N.close csock) os-        os' `Stream.connectTo` is+        conn <- TCP.accept sock+        req <- Stream.readExactly 2 (source conn)+        send conn (L.fromStrict req)+        close conn  ------------------------------------------------------------------------------ @@ -81,23 +82,24 @@         forkIO $ client portMVar resultMVar         server portMVar         l <- takeMVar resultMVar-        assertEqual "testSocket" l (Just "ok")+        assertEqual "testSocket" l ["ok"]      client mvar resultMVar = do         _ <- takeMVar mvar         cp <- SSL.makeClientSSLContext (SSL.CustomCAStore "./test/cert/ca.pem")-        (is, os, ctx) <- SSL.connect cp (Just "Winter") "127.0.0.1" 8890-        Stream.fromList ["", "ok"] >>= Stream.connectTo os-        Stream.read is >>= putMVar resultMVar  -- There's no shutdown in tls, so we won't get a 'Nothing'-        SSL.close ctx+        conn <- SSL.connect cp (Just "Winter") "127.0.0.1" 8890+        send conn "ok"+        Stream.toList (source conn) >>= putMVar resultMVar+        close conn      server mvar = do         sp <- SSL.makeServerSSLContext "./test/cert/server.crt" [] "./test/cert/server.key"-        sock <- Raw.bindAndListen 8890 1024+        sock <- TCP.bindAndListen 1024 8890         putMVar mvar ()-        (is, os, ssl, _) <- SSL.accept sp sock-        os' <- Stream.atEndOfOutput (SSL.close ssl) os-        os' `Stream.connectTo` is+        conn <- SSL.accept sp sock+        req <- Stream.readExactly 2 (source conn)+        send conn (L.fromStrict req)+        close conn  testHTTPS' :: Test testHTTPS' = testCase "network/https" $@@ -107,10 +109,10 @@   where     go = do         cp <- SSL.makeClientSSLContext SSL.SystemCAStore-        (is, os, ctx) <- SSL.connect cp (Just "*.google.com") "www.google.com" 443-        Stream.write (Just "GET / HTTP/1.1\r\n") os-        Stream.write (Just "Host: www.google.com\r\n") os-        Stream.write (Just "\r\n") os-        bs <- Stream.readExactly 1024 is-        SSL.close ctx+        conn <- SSL.connect cp (Just "*.bing.com") "www.bing.com" 443+        send conn "GET / HTTP/1.1\r\n"+        send conn "Host: www.bing.com\r\n"+        send conn "\r\n"+        bs <- Stream.readExactly 1024 (source conn)+        close conn         return (B.length bs)