diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,4 +1,9 @@ -# Revision history for tcp-simple +# Revision history for tcp-streams + +## 0.6.0.0 + +* Update built-in mozilla CA list(2016/11/02). +* Split openssl part into [tcp-streams-openssl](hackage.haskell.org/package/tcp-streams-openssl) ## 0.5.0.0 diff --git a/Data/OpenSSLSetting.hs b/Data/OpenSSLSetting.hs deleted file mode 100644 --- a/Data/OpenSSLSetting.hs +++ /dev/null @@ -1,91 +0,0 @@ --- | Helpers for setting up a tls connection with @HsOpenSSL@ package, --- for further customization, please refer to @HsOpenSSL@ package. --- --- Note, functions in this module will throw error if can't load certificates or CA store. --- -module Data.OpenSSLSetting - ( -- * choose a CAStore - TrustedCAStore(..) - -- * make TLS settings - , makeClientSSLContext - , makeClientSSLContext' - , makeServerSSLContext - , makeServerSSLContext' - ) where - -import qualified OpenSSL.X509.SystemStore as X509 -import qualified OpenSSL.Session as SSL -import OpenSSL (withOpenSSL) -import Paths_tcp_streams (getDataFileName) -import Data.TLSSetting (TrustedCAStore(..)) - - -makeCAStore :: TrustedCAStore -> SSL.SSLContext -> IO () -makeCAStore SystemCAStore ctx = X509.contextLoadSystemCerts ctx -makeCAStore MozillaCAStore ctx = do - fp <- getDataFileName "mozillaCAStore.pem" - SSL.contextSetCAFile ctx fp -makeCAStore (CustomCAStore fp) ctx = SSL.contextSetCAFile ctx fp - --- | make a simple 'SSL.SSLContext' that will validate server and use tls connection --- without providing client's own certificate. suitable for connecting server which don't --- validate clients. --- -makeClientSSLContext :: TrustedCAStore -- ^ trusted certificates. - -> IO SSL.SSLContext -makeClientSSLContext tca = withOpenSSL $ do - let caStore = makeCAStore tca - ctx <- SSL.context - caStore ctx - SSL.contextSetDefaultCiphers ctx - SSL.contextSetVerificationMode ctx (SSL.VerifyPeer True True Nothing) - return ctx - --- | make a simple 'SSL.SSLContext' that will validate server and use tls connection --- while providing client's own certificate. suitable for connecting server which --- validate clients. --- --- The chain certificate must be in PEM format and must be sorted starting with the subject's certificate --- (actual client or server certificate), followed by intermediate CA certificates if applicable, --- and ending at the highest level (root) CA. --- -makeClientSSLContext' :: FilePath -- ^ public certificate (X.509 format). - -> [FilePath] -- ^ chain certificate (X.509 format). - -> FilePath -- ^ private key associated. - -> TrustedCAStore -- ^ server will use these certificates to validate clients. - -> IO SSL.SSLContext -makeClientSSLContext' pub certs priv tca = withOpenSSL $ do - let caStore = makeCAStore tca - ctx <- SSL.context - caStore ctx - SSL.contextSetDefaultCiphers ctx - SSL.contextSetCertificateFile ctx pub - SSL.contextSetPrivateKeyFile ctx priv - mapM_ (SSL.contextSetCertificateChainFile ctx) certs - SSL.contextSetVerificationMode ctx (SSL.VerifyPeer True True Nothing) - return ctx - --- | make a simple 'SSL.SSLContext' for server without validating client's certificate. --- -makeServerSSLContext :: FilePath -- ^ public certificate (X.509 format). - -> [FilePath] -- ^ chain certificate (X.509 format). - -> FilePath -- ^ private key associated. - -> IO SSL.SSLContext -makeServerSSLContext pub certs priv = withOpenSSL $ do - ctx <- SSL.context - SSL.contextSetDefaultCiphers ctx - SSL.contextSetCertificateFile ctx pub - SSL.contextSetPrivateKeyFile ctx priv - mapM_ (SSL.contextSetCertificateChainFile ctx) certs - return ctx - --- | make a 'SSL.SSLConext' that also validating client's certificate. --- --- This's an alias to 'makeClientSSLContext''. --- -makeServerSSLContext' :: FilePath -- ^ public certificate (X.509 format). - -> [FilePath] -- ^ chain certificates (X.509 format). - -> FilePath -- ^ private key associated. - -> TrustedCAStore -- ^ server will use these certificates to validate clients. - -> IO SSL.SSLContext -makeServerSSLContext' = makeClientSSLContext' diff --git a/Data/TLSSetting.hs b/Data/TLSSetting.hs --- a/Data/TLSSetting.hs +++ b/Data/TLSSetting.hs @@ -4,13 +4,15 @@ -- Note, functions in this module will throw error if can't load certificates or CA store. -- module Data.TLSSetting - ( -- * choose a CAStore + ( -- * Choose a CAStore TrustedCAStore(..) - -- * make TLS settings + -- * Make TLS settings , makeClientParams , makeClientParams' , makeServerParams , makeServerParams' + -- * Internal + , mozillaCAStorePath ) where import qualified Data.ByteString as B @@ -34,9 +36,13 @@ | CustomCAStore FilePath -- ^ provided by your self, the CA file can contain multiple certificates. deriving (Show, Eq) +-- | Get the built-in mozilla CA's path. +mozillaCAStorePath :: IO FilePath +mozillaCAStorePath = getDataFileName "mozillaCAStore.pem" + makeCAStore :: TrustedCAStore -> IO X509.CertificateStore makeCAStore SystemCAStore = X509.getSystemCertificateStore -makeCAStore MozillaCAStore = makeCAStore . CustomCAStore =<< getDataFileName "mozillaCAStore.pem" +makeCAStore MozillaCAStore = makeCAStore . CustomCAStore =<< mozillaCAStorePath makeCAStore (CustomCAStore fp) = do bs <- B.readFile fp let Right pems = X509.pemParseBS bs diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -8,17 +8,11 @@ + use [io-streams](https://hackage.haskell.org/package/io-streams) for auto read buffering and easy streamming process. -+ use [tls](http://hackage.haskell.org/package/tls) or [HsOpenSSL](http://hackage.haskell.org/package/HsOpenSSL) for tls connection. - -Built-in [mozilla CA list](https://curl.haxx.se/docs/caextract.html) date: 2016/09/14. - -Mac user may need manually passing openssl library path if linker can't find them: ++ use [tls](http://hackage.haskell.org/package/tls) for tls connection. -``` -cabal install --extra-include-dirs=/usr/local/opt/openssl/include --extra-lib-dirs=/usr/local/opt/openssl/lib tcp-streams -``` +Built-in [mozilla CA list](https://curl.haxx.se/docs/caextract.html) date: 2016/11/02. -You can disable openssl support with `cabal install -f -openssl`. +From v0.6 TLS using [HsOpenSSL](http://hackage.haskell.org/package/HsOpenSSL) is split into [tcp-streams-openssl](http://hackage.haskell.org/package/tcp-streams-openssl) due to the difficulties of setting up openssl on many platform. Also take a look at [wire-stream](http://hackage.haskell.org/package/wire-streams-0.0.2.0), for serialize/deserialize data. Happy hacking! diff --git a/System/IO/Streams/OpenSSL.hs b/System/IO/Streams/OpenSSL.hs deleted file mode 100644 --- a/System/IO/Streams/OpenSSL.hs +++ /dev/null @@ -1,158 +0,0 @@ -{-# 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 is intended to be imported @qualified@, e.g.: --- --- @ --- import qualified "Data.SSLSetting" as SSL --- import qualified "System.IO.Streams.OpenSSL" as SSL --- @ --- -module System.IO.Streams.OpenSSL - ( -- * client - connect - , withConnection - -- * server - , accept - -- * helpers - , sslToStreams - , close - -- * re-export helpers - , 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 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 - --- | Given an existing HsOpenSSL 'SSL' connection, produces an 'InputStream' \/ --- 'OutputStream' pair. --- -sslToStreams :: SSL -- ^ SSL connection object - -> IO (InputStream ByteString, OutputStream ByteString) -sslToStreams ssl = do - is <- Streams.makeInputStream input - os <- Streams.makeOutputStream output - return (is, os) - - where - input = ( do - s <- SSL.read ssl bUFSIZ - 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 - SSL.shutdown ssl SSL.Unidirectional - maybe (return ()) N.close (SSL.sslSocket ssl) - --- | Convenience function for initiating an SSL connection to the given --- @('HostName', 'PortNumber')@ combination. --- --- this function will try to verify server's identity, --- a 'SSL.ProtocolError' will be thrown if fail. --- -connect :: SSLContext -- ^ SSL context. See the @HsOpenSSL@ - -- documentation for information on creating - -- this. - -> 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) -connect ctx subname host port = withOpenSSL $ do - sock <- TCP.connectSocket host port - E.bracketOnError (SSL.connection ctx sock) close $ \ ssl -> do - SSL.connect ssl - trusted <- SSL.getVerifyResult ssl - cert <- SSL.getPeerCertificate ssl - subnames <- maybe (return []) (`X509.getSubjectName` False) cert - let cnname = lookup "CN" subnames - verified = case subname of - Just subname' -> maybe False (== subname') cnname - Nothing -> maybe False (matchDomain host) cnname - unless (trusted && verified) (E.throwIO $ SSL.ProtocolError "fail to verify certificate") - (is, os) <- sslToStreams ssl - return (is, os, ssl) - - where - matchDomain :: String -> String -> Bool - matchDomain n1 n2 = - let n1' = reverse (splitDot n1) - n2' = reverse (splitDot n2) - cmp src target = src == "*" || src == target - in and (zipWith cmp n1' n2') - splitDot :: String -> [String] - splitDot "" = [""] - splitDot x = - let (y, z) = break (== '.') x in - y : (if z == "" then [] else splitDot $ drop 1 z) - --- | 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 ()) - - --- | 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 ctx sock = withOpenSSL $ do - (sock', sockAddr) <- N.accept sock - E.bracketOnError (SSL.connection ctx sock') close $ \ 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) - diff --git a/System/IO/Streams/TLS.hs b/System/IO/Streams/TLS.hs --- a/System/IO/Streams/TLS.hs +++ b/System/IO/Streams/TLS.hs @@ -11,7 +11,6 @@ -- This module is intended to be imported @qualified@, e.g.: -- -- @ --- import qualified "Data.TLSSetting" as TLS -- import qualified "System.IO.Streams.TLS" as TLS -- @ -- diff --git a/mozillaCAStore.pem b/mozillaCAStore.pem --- a/mozillaCAStore.pem +++ b/mozillaCAStore.pem @@ -1,20 +1,20 @@ ## ## Bundle of CA Root Certificates ## -## Certificate data from Mozilla as of: Wed Sep 14 03:12:05 2016 +## Certificate data from Mozilla as of: Wed Nov 2 04:12:05 2016 GMT ## ## This is a bundle of X.509 certificates of public Certificate Authorities ## (CA). These were automatically extracted from Mozilla's root certificates ## file (certdata.txt). This file can be found in the mozilla source tree: -## http://hg.mozilla.org/releases/mozilla-release/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt +## https://hg.mozilla.org/releases/mozilla-release/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt ## ## It contains the certificates in PEM format and therefore ## can be directly used with curl / libcurl / php_curl, or with ## an Apache+mod_ssl webserver for SSL client authentication. ## Just configure this file as the SSLCACertificateFile. ## -## Conversion done with mk-ca-bundle.pl version 1.26. -## SHA256: 01bbf1ecdd693f554ff4dcbe15880b3e6c33188a956c15ff845d313ca69cfeb8 +## Conversion done with mk-ca-bundle.pl version 1.27. +## SHA256: 17e2a90c8a5cfd6a675b3475d3d467e1ab1fe0d5397e907b08206182389caa08 ## @@ -1764,7 +1764,7 @@ -----END CERTIFICATE----- NetLock Arany (Class Gold) Főtanúsítvány -============================================ +======================================== -----BEGIN CERTIFICATE----- MIIEFTCCAv2gAwIBAgIGSUEs5AAQMA0GCSqGSIb3DQEBCwUAMIGnMQswCQYDVQQGEwJIVTERMA8G A1UEBwwIQnVkYXBlc3QxFTATBgNVBAoMDE5ldExvY2sgS2Z0LjE3MDUGA1UECwwuVGFuw7pzw610 @@ -2280,7 +2280,7 @@ -----END CERTIFICATE----- Certinomis - Autorité Racine -============================= +============================ -----BEGIN CERTIFICATE----- MIIFnDCCA4SgAwIBAgIBATANBgkqhkiG9w0BAQUFADBjMQswCQYDVQQGEwJGUjETMBEGA1UEChMK Q2VydGlub21pczEXMBUGA1UECxMOMDAwMiA0MzM5OTg5MDMxJjAkBgNVBAMMHUNlcnRpbm9taXMg @@ -3675,7 +3675,7 @@ -----END CERTIFICATE----- TÜRKTRUST Elektronik Sertifika Hizmet Sağlayıcısı H5 -========================================================= +==================================================== -----BEGIN CERTIFICATE----- MIIEJzCCAw+gAwIBAgIHAI4X/iQggTANBgkqhkiG9w0BAQsFADCBsTELMAkGA1UEBhMCVFIxDzAN BgNVBAcMBkFua2FyYTFNMEsGA1UECgxEVMOcUktUUlVTVCBCaWxnaSDEsGxldGnFn2ltIHZlIEJp @@ -3699,7 +3699,7 @@ -----END CERTIFICATE----- TÜRKTRUST Elektronik Sertifika Hizmet Sağlayıcısı H6 -========================================================= +==================================================== -----BEGIN CERTIFICATE----- MIIEJjCCAw6gAwIBAgIGfaHyZeyKMA0GCSqGSIb3DQEBCwUAMIGxMQswCQYDVQQGEwJUUjEPMA0G A1UEBwwGQW5rYXJhMU0wSwYDVQQKDERUw5xSS1RSVVNUIEJpbGdpIMSwbGV0acWfaW0gdmUgQmls @@ -4033,4 +4033,34 @@ BgNVHSMEGDAWgBRHd8MUi2I5DMlv4VBN0BBY3JWIbTAKBggqhkjOPQQDAwNpADBmAjEAj6jcnboM BBf6Fek9LykBl7+BFjNAk2z8+e2AcG+qj9uEwov1NcoG3GRvaBbhj5G5AjEA2Euly8LQCGzpGPta 3U1fJAuwACEl74+nBCZx4nxp5V2a+EEfOzmTk51V6s2N8fvB +-----END CERTIFICATE----- + +ISRG Root X1 +============ +-----BEGIN CERTIFICATE----- +MIIFazCCA1OgAwIBAgIRAIIQz7DSQONZRGPgu2OCiwAwDQYJKoZIhvcNAQELBQAwTzELMAkGA1UE +BhMCVVMxKTAnBgNVBAoTIEludGVybmV0IFNlY3VyaXR5IFJlc2VhcmNoIEdyb3VwMRUwEwYDVQQD +EwxJU1JHIFJvb3QgWDEwHhcNMTUwNjA0MTEwNDM4WhcNMzUwNjA0MTEwNDM4WjBPMQswCQYDVQQG +EwJVUzEpMCcGA1UEChMgSW50ZXJuZXQgU2VjdXJpdHkgUmVzZWFyY2ggR3JvdXAxFTATBgNVBAMT +DElTUkcgUm9vdCBYMTCCAiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBAK3oJHP0FDfzm54r +Vygch77ct984kIxuPOZXoHj3dcKi/vVqbvYATyjb3miGbESTtrFj/RQSa78f0uoxmyF+0TM8ukj1 +3Xnfs7j/EvEhmkvBioZxaUpmZmyPfjxwv60pIgbz5MDmgK7iS4+3mX6UA5/TR5d8mUgjU+g4rk8K +b4Mu0UlXjIB0ttov0DiNewNwIRt18jA8+o+u3dpjq+sWT8KOEUt+zwvo/7V3LvSye0rgTBIlDHCN +Aymg4VMk7BPZ7hm/ELNKjD+Jo2FR3qyHB5T0Y3HsLuJvW5iB4YlcNHlsdu87kGJ55tukmi8mxdAQ +4Q7e2RCOFvu396j3x+UCB5iPNgiV5+I3lg02dZ77DnKxHZu8A/lJBdiB3QW0KtZB6awBdpUKD9jf +1b0SHzUvKBds0pjBqAlkd25HN7rOrFleaJ1/ctaJxQZBKT5ZPt0m9STJEadao0xAH0ahmbWnOlFu +hjuefXKnEgV4We0+UXgVCwOPjdAvBbI+e0ocS3MFEvzG6uBQE3xDk3SzynTnjh8BCNAw1FtxNrQH +usEwMFxIt4I7mKZ9YIqioymCzLq9gwQbooMDQaHWBfEbwrbwqHyGO0aoSCqI3Haadr8faqU9GY/r +OPNk3sgrDQoo//fb4hVC1CLQJ13hef4Y53CIrU7m2Ys6xt0nUW7/vGT1M0NPAgMBAAGjQjBAMA4G +A1UdDwEB/wQEAwIBBjAPBgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBR5tFnme7bl5AFzgAiIyBpY +9umbbjANBgkqhkiG9w0BAQsFAAOCAgEAVR9YqbyyqFDQDLHYGmkgJykIrGF1XIpu+ILlaS/V9lZL +ubhzEFnTIZd+50xx+7LSYK05qAvqFyFWhfFQDlnrzuBZ6brJFe+GnY+EgPbk6ZGQ3BebYhtF8GaV +0nxvwuo77x/Py9auJ/GpsMiu/X1+mvoiBOv/2X/qkSsisRcOj/KKNFtY2PwByVS5uCbMiogziUwt +hDyC3+6WVwW6LLv3xLfHTjuCvjHIInNzktHCgKQ5ORAzI4JMPJ+GslWYHb4phowim57iaztXOoJw +TdwJx4nLCgdNbOhdjsnvzqvHu7UrTkXWStAmzOVyyghqpZXjFaH3pO3JLF+l+/+sKAIuvtd7u+Nx +e5AW0wdeRlN8NwdCjNPElpzVmbUq4JUagEiuTDkHzsxHpFKVK7q4+63SM1N95R1NbdWhscdCb+ZA +JzVcoyi3B43njTOQ5yOf+1CceWxG1bQVs5ZufpsMljq4Ui0/1lvh+wjChP4kqKOJ2qxq4RgqsahD +YVvTH9w7jXbyLeiNdd8XM2w9U/t7y0Ff/9yi0GE44Za4rF2LN9d11TPAmRGunUHBcnWEvgJBQl9n +JEiU0Zsnvgc/ubhPgXRR4Xq37Z0j4r7g1SgEEzwxA57demyPxgcYxn/eR44/KJ4EBs+lVDR3veyJ +m+kXQ99b21/+jh5Xos1AnX5iItreGCc= -----END CERTIFICATE----- diff --git a/tcp-streams.cabal b/tcp-streams.cabal --- a/tcp-streams.cabal +++ b/tcp-streams.cabal @@ -1,12 +1,13 @@ name: tcp-streams -version: 0.5.0.0 +version: 0.6.0.0 synopsis: One stop solution for tcp client and server with tls support. description: One stop solution for tcp client and server with tls support. license: BSD3 license-file: LICENSE author: winterland1989 maintainer: winterland1989@gmail.com --- copyright: +homepage: https://github.com/winterland1989/tcp-streams +copyright: (c) Winterland 2016 category: Network build-type: Simple extra-source-files: ChangeLog.md @@ -18,10 +19,6 @@ data-files: mozillaCAStore.pem cabal-version: >=1.10 -flag openssl - description: Enable openssl support via @HsOpenSSL@ - default: True - source-repository head type: git location: git://github.com/winterland1989/tcp-streams.git @@ -30,9 +27,6 @@ exposed-modules: Data.TLSSetting , System.IO.Streams.TCP , System.IO.Streams.TLS - if flag(openssl) - exposed-modules: Data.OpenSSLSetting - , System.IO.Streams.OpenSSL other-modules: Paths_tcp_streams -- other-extensions: @@ -46,19 +40,6 @@ , x509-system >= 1.5 && < 2.0 , x509-store >= 1.5 && < 2.0 , pem - - if flag(openssl) - build-depends: HsOpenSSL >=0.10.3 && <0.12 - , HsOpenSSL-x509-system == 0.1.* - if os(mingw32) || os(windows) - extra-libraries: eay32, ssl32 - else - if os(osx) - extra-libraries: crypto - extra-lib-dirs: /usr/local/lib - include-dirs: /usr/local/include - else - extra-libraries: crypto ghc-options: -Wall -- hs-source-dirs: diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -16,11 +16,9 @@ import System.Directory (removeFile) ------------------------------------------------------------------------------ import qualified Data.TLSSetting as TLS -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.TLS as TLS -import qualified System.IO.Streams.OpenSSL as SSL ------------------------------------------------------------------------------ main :: IO () @@ -28,7 +26,6 @@ where tests = [ testGroup "TCP" rawTests , testGroup "TLS" tlsTests - , testGroup "OpenSSL" sslTests ] ------------------------------------------------------------------------------ @@ -117,57 +114,3 @@ bs <- Stream.readExactly 1024 is TLS.close ctx return (B.length bs) - ------------------------------------------------------------------------------- - -sslTests :: [Test] -sslTests = [ testSSLSocket, testHTTPS' ] - -testSSLSocket :: Test -testSSLSocket = testCase "network/socket" $ - N.withSocketsDo $ do - x <- timeout (10 * 10^(6::Int)) go - assertEqual "ok" (Just ()) x - - where - go = do - portMVar <- newEmptyMVar - resultMVar <- newEmptyMVar - forkIO $ client portMVar resultMVar - server portMVar - l <- takeMVar resultMVar - assertEqual "testSocket" l (Just "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 - - server mvar = do - sp <- SSL.makeServerSSLContext "./test/cert/server.crt" [] "./test/cert/server.key" - sock <- Raw.bindAndListen 8890 1024 - putMVar mvar () - (is, os, ssl, _) <- SSL.accept sp sock - os' <- Stream.atEndOfOutput (SSL.close ssl) os - os' `Stream.connectTo` is - -testHTTPS' :: Test -testHTTPS' = testCase "network/https" $ - N.withSocketsDo $ do - x <- timeout (10 * 10^(6::Int)) go - assertEqual "ok" (Just 1024) x - where - go = do - cp <- SSL.makeClientSSLContext SSL.SystemCAStore - (is, os, ctx) <- SSL.connect cp Nothing "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 - return (B.length bs) - -