tls 2.1.11 → 2.1.12
raw patch · 10 files changed
+343/−10 lines, 10 filesdep +tasty-benchdep ~asn1-typesdep ~bytestringdep ~crypton
Dependencies added: tasty-bench
Dependency ranges changed: asn1-types, bytestring, crypton, crypton-x509, crypton-x509-store, crypton-x509-validation, network, network-run, random, serialise
Files
- Benchmarks/Benchmarks.hs +187/−0
- CHANGELOG.md +13/−0
- Network/TLS.hs +1/−1
- Network/TLS/Backend.hs +14/−2
- Network/TLS/Handshake/Client/ClientHello.hs +21/−0
- Network/TLS/Handshake/Server/TLS13.hs +11/−3
- test/Certificate.hs +1/−0
- test/Run.hs +36/−0
- tls.cabal +45/−2
- util/tls-client.hs +14/−2
+ Benchmarks/Benchmarks.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE BangPatterns #-}++module Main where++import Certificate+import Control.Concurrent.Chan+import Data.Default (def)+import Data.IORef+import Data.X509+import Data.X509.Validation+import Test.Tasty.Bench+import Network.TLS+import Network.TLS.Extra.Cipher+import Session+import Run+import PubKey++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L++blockCipher :: Cipher+blockCipher =+ Cipher+ { cipherID = 0xff12+ , cipherName = "rsa-id-const"+ , cipherBulk =+ Bulk+ { bulkName = "id"+ , bulkKeySize = 16+ , bulkIVSize = 16+ , bulkExplicitIV = 0+ , bulkAuthTagLen = 0+ , bulkBlockSize = 16+ , bulkF = BulkBlockF $ \_ _ _ m -> (m, B.empty)+ }+ , cipherHash = MD5+ , cipherPRFHash = Nothing+ , cipherKeyExchange = CipherKeyExchange_RSA+ , cipherMinVer = Nothing+ }++getParams :: Version -> Cipher -> (ClientParams, ServerParams)+getParams connectVer cipher = (cParams, sParams)+ where+ sParams =+ def+ { serverSupported = supported+ , serverShared =+ def+ { sharedCredentials =+ Credentials+ [(CertificateChain [simpleX509 $ PubKeyRSA pubKey], PrivKeyRSA privKey)]+ }+ }+ cParams =+ (defaultParamsClient "" B.empty)+ { clientSupported = supported+ , clientShared =+ def+ { sharedValidationCache =+ ValidationCache+ { cacheAdd = \_ _ _ -> return ()+ , cacheQuery = \_ _ _ -> return ValidationCachePass+ }+ }+ }+ supported =+ def+ { supportedCiphers = [cipher]+ , supportedVersions = [connectVer]+ , supportedGroups = [X25519, FFDHE2048]+ }+ (pubKey, privKey) = getGlobalRSAPair++runTLSPipe+ :: (ClientParams, ServerParams)+ -> (Context -> Chan b -> IO ())+ -> (Chan a -> Context -> IO ())+ -> a+ -> IO b+runTLSPipe params tlsServer tlsClient d = do+ withDataPipe params tlsServer tlsClient $ \(writeStart, readResult) -> do+ writeStart d+ readResult++runTLSPipeSimple+ :: (ClientParams, ServerParams) -> B.ByteString -> IO B.ByteString+runTLSPipeSimple params = runTLSPipe params tlsServer tlsClient+ where+ tlsServer ctx queue = do+ handshake ctx+ d <- recvData ctx+ writeChan queue d+ bye ctx+ tlsClient queue ctx = do+ handshake ctx+ d <- readChan queue+ sendData ctx (L.fromChunks [d])+ byeBye ctx++benchConnection+ :: (ClientParams, ServerParams) -> B.ByteString -> String -> Benchmark+benchConnection params !d name = bench name . nfIO $ runTLSPipeSimple params d++benchResumption+ :: (ClientParams, ServerParams) -> B.ByteString -> String -> Benchmark+benchResumption params !d name = env initializeSession runResumption+ where+ initializeSession = do+ sessionRefs <- twoSessionRefs+ let sessionManagers = twoSessionManagers sessionRefs+ params1 = setPairParamsSessionManagers sessionManagers params+ _ <- runTLSPipeSimple params1 d++ Just sessionParams <- readClientSessionRef sessionRefs+ let params2 = setPairParamsSessionResuming sessionParams params1+ newIORef params2++ runResumption paramsRef = bench name . nfIO $ do+ params2 <- readIORef paramsRef+ runTLSPipeSimple params2 d++benchResumption13+ :: (ClientParams, ServerParams) -> B.ByteString -> String -> Benchmark+benchResumption13 params !d name = env initializeSession runResumption+ where+ initializeSession = do+ sessionRefs <- twoSessionRefs+ let sessionManagers = twoSessionManagers sessionRefs+ params1 = setPairParamsSessionManagers sessionManagers params+ _ <- runTLSPipeSimple params1 d+ newIORef (params1, sessionRefs)++ -- with TLS13 the sessionId is constantly changing so we must update+ -- our parameters at each iteration unfortunately+ runResumption paramsRef = bench name . nfIO $ do+ (params1, sessionRefs) <- readIORef paramsRef+ Just sessionParams <- readClientSessionRef sessionRefs+ let params2 = setPairParamsSessionResuming sessionParams params1+ runTLSPipeSimple params2 d++benchCiphers :: String -> Version -> B.ByteString -> [Cipher] -> Benchmark+benchCiphers name connectVer d = bgroup name . map doBench+ where+ doBench cipher =+ benchResumption13 (getParams connectVer cipher) d (cipherName cipher)++main :: IO ()+main =+ defaultMain+ [ bgroup+ "connection"+ -- not sure the number actually make sense for anything. improve ..+ [ benchConnection (getParams TLS12 blockCipher) small "TLS12-256 bytes"+ ]+ , bgroup+ "resumption"+ [ benchResumption (getParams TLS12 blockCipher) small "TLS12-256 bytes"+ ]+ , -- Here we try to measure TLS12 and TLS13 performance with AEAD ciphers.+ -- Resumption and a larger message can be a demonstration of the symmetric+ -- crypto but for TLS13 this does not work so well because of dhe_psk.+ benchCiphers+ "TLS12"+ TLS12+ large+ [ cipher_DHE_RSA_WITH_AES_128_GCM_SHA256+ , cipher_DHE_RSA_WITH_AES_256_GCM_SHA384+ , cipher_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256+ , cipher_ECDHE_RSA_WITH_AES_128_GCM_SHA256+ , cipher_ECDHE_RSA_WITH_AES_256_GCM_SHA384+ , cipher_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256+ ]+ , benchCiphers+ "TLS13"+ TLS13+ large+ [ cipher13_AES_128_GCM_SHA256+ , cipher13_AES_256_GCM_SHA384+ , cipher13_CHACHA20_POLY1305_SHA256+ , cipher13_AES_128_CCM_SHA256+ , cipher13_AES_128_CCM_8_SHA256+ ]+ ]+ where+ small = B.replicate 256 0+ large = B.replicate 102400 0
CHANGELOG.md view
@@ -1,5 +1,18 @@ # Change log for "tls" +## Version 2.1.12++* Restore benchmarks.+ [#509](https://github.com/haskell-tls/hs-tls/pull/509)+* Supporting random 1.2.+ [#508](https://github.com/haskell-tls/hs-tls/pull/508)+* Add --trusted-anchor cli option to tls-client.+ [#505](https://github.com/haskell-tls/hs-tls/pull/505)++## Version 2.1.11++* Removing OVERLAPS instances.+ ## Version 2.1.10 * Supporting the SSLKEYLOGFILE environment variable.
Network/TLS.hs view
@@ -85,7 +85,6 @@ onCertificateRequest, OnServerCertificate, onServerCertificate,- validateClientCertificate, onSuggestALPN, onCustomFFDHEGroup, onServerFinished,@@ -94,6 +93,7 @@ ServerHooks, defaultServerHooks, onClientCertificate,+ validateClientCertificate, onUnverifiedClientCert, onCipherChoosing, onServerNameIndication,
Network/TLS/Backend.hs view
@@ -44,7 +44,13 @@ instance HasBackend Network.Socket where initializeBackend _ = return ()- getBackend sock = Backend (return ()) (Network.close sock) (Network.sendAll sock) recvAll+ getBackend sock =+ Backend+ { backendFlush = return ()+ , backendClose = Network.close sock+ , backendSend = Network.sendAll sock+ , backendRecv = recvAll+ } where recvAll n = B.concat <$> loop n where@@ -57,4 +63,10 @@ instance HasBackend Handle where initializeBackend handle = hSetBuffering handle NoBuffering- getBackend handle = Backend (hFlush handle) (hClose handle) (B.hPut handle) (B.hGet handle)+ getBackend handle =+ Backend+ { backendFlush = hFlush handle+ , backendClose = hClose handle+ , backendSend = B.hPut handle+ , backendRecv = B.hGet handle+ }
Network/TLS/Handshake/Client/ClientHello.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -12,6 +13,12 @@ import Network.TLS.ECH.Config import System.Random +#if !MIN_VERSION_random(1,3,0)+import Data.ByteString.Internal (unsafeCreate)+import Foreign.Ptr+import Foreign.Storable+#endif+ import Network.TLS.Cipher import Network.TLS.Context.Internal import Network.TLS.Crypto@@ -571,3 +578,17 @@ , echPayload = payload } return $ toExtensionRaw outer++#if !MIN_VERSION_random(1,3,0)+uniformByteString :: RandomGen g => Int -> g -> (ByteString, g)+uniformByteString l g0 = (bs, g2)+ where+ (g1, g2) = split g0+ bs = unsafeCreate l $ go 0 g1+ go n g ptr+ | n == l = return ()+ | otherwise = do+ let (w, g') = genWord8 g+ poke ptr w+ go (n + 1) g' (plusPtr ptr 1)+#endif
Network/TLS/Handshake/Server/TLS13.hs view
@@ -56,8 +56,14 @@ expectFinished sparams ctx chExtensions appKey clientHandshakeSecret sfSentTime if not authenticated && serverWantClientCert sparams then runRecvHandshake13 $ do- recvHandshake13 ctx $ expectCertificate sparams ctx- recvHandshake13hash ctx "CertVerify" (expectCertVerify sparams ctx)+ -- RFC 8446 Sec 4.4.3: Clients MUST send this message+ -- whenever authenticating via a certificate (i.e., when the+ -- Certificate message is non-empty). When sent, this message MUST+ -- appear immediately after the Certificate message and immediately+ -- prior to the Finished message.+ skip <- recvHandshake13 ctx $ expectCertificate sparams ctx+ unless skip $+ recvHandshake13hash ctx "CertVerify" (expectCertVerify sparams ctx) recvHandshake13hash ctx "Finished" expectFinished' ensureRecvComplete ctx else@@ -105,19 +111,21 @@ expectEndOfEarlyData _ _ hs = unexpected (show hs) (Just "end of early data") expectCertificate- :: MonadIO m => ServerParams -> Context -> Handshake13 -> m ()+ :: MonadIO m => ServerParams -> Context -> Handshake13 -> m Bool expectCertificate sparams ctx (Certificate13 certCtx (CertificateChain_ certs) _ext) = liftIO $ do when (certCtx /= "") $ throwCore $ Error_Protocol "certificate request context MUST be empty" IllegalParameter -- fixme checking _ext clientCertificate sparams ctx certs+ return $ isNullCertificateChain certs expectCertificate sparams ctx (CompressedCertificate13 certCtx (CertificateChain_ certs) _ext) = liftIO $ do when (certCtx /= "") $ throwCore $ Error_Protocol "certificate request context MUST be empty" IllegalParameter -- fixme checking _ext clientCertificate sparams ctx certs+ return $ isNullCertificateChain certs expectCertificate _ _ hs = unexpected (show hs) (Just "certificate 13") sendNewSessionTicket
test/Certificate.hs view
@@ -9,6 +9,7 @@ arbitraryDN, simpleCertificate, simpleX509,+ getSignatureALG, toPubKeyEC, toPrivKeyEC, ) where
test/Run.hs view
@@ -15,6 +15,9 @@ runTLSSuccess, runTLSFailure, expectMaybe,+ newPairContext,+ withDataPipe,+ byeBye, ) where import Control.Concurrent@@ -356,3 +359,36 @@ , loggingPacketRecv = putStrLn . ((pre ++ "<< ") ++) } else defaultLogging+++withDataPipe :: (ClientParams, ServerParams) -> (Context -> Chan result -> IO ()) -> (Chan start -> Context -> IO ()) -> ((start -> IO (), IO result) -> IO a) -> IO a+withDataPipe params tlsServer tlsClient cont = do+ -- initial setup+ startQueue <- newChan+ resultQueue <- newChan++ (cCtx, sCtx) <- snd <$> newPairContext params++ withAsync (E.catch (tlsServer sCtx resultQueue)+ (printAndRaise "server" (serverSupported $ snd params))) $ \sAsync -> withAsync (E.catch (tlsClient startQueue cCtx)+ (printAndRaise "client" (clientSupported $ fst params))) $ \cAsync -> do+ let readResult = waitBoth cAsync sAsync >> readChan resultQueue+ cont (writeChan startQueue, readResult)++ where+ printAndRaise :: String -> Supported -> E.SomeException -> IO ()+ printAndRaise s supported e = do+ putStrLn $ s ++ " exception: " ++ show e +++ ", supported: " ++ show supported+ E.throwIO e++-- Terminate the write direction and wait to receive the peer EOF. This is+-- necessary in situations where we want to confirm the peer status, or to make+-- sure to receive late messages like session tickets. In the test suite this+-- is used each time application code ends the connection without prior call to+-- 'recvData'.+byeBye :: Context -> IO ()+byeBye ctx = do+ bye ctx+ bs <- recvData ctx+ unless (B.null bs) $ fail "byeBye: unexpected application data"
tls.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: tls-version: 2.1.11+version: 2.1.12 license: BSD3 license-file: LICENSE copyright: Vincent Hanquez <vincent@snarc.org>@@ -133,7 +133,7 @@ memory >= 0.18 && < 0.19, mtl >= 2.2 && < 2.4, network >= 3.1,- random >= 1.3 && < 1.4,+ random >= 1.2 && < 1.4, serialise >= 0.2 && < 0.3, transformers >= 0.5 && < 0.7, unix-time >= 0.4.11 && < 0.5,@@ -233,3 +233,46 @@ else buildable: False++benchmark tls-bench+ main-is: Benchmarks.hs+ type: exitcode-stdio-1.0+ other-modules:+ API+ Arbitrary+ Certificate+ CiphersSpec+ ECHSpec+ EncodeSpec+ HandshakeSpec+ PipeChan+ PubKey+ Run+ Session+ ThreadSpec+ hs-source-dirs:+ Benchmarks+ test+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=4.9 && <5,+ bytestring,+ base64-bytestring,+ containers,+ async,+ data-default,+ hourglass,+ crypton,+ crypton-x509,+ crypton-x509-store,+ crypton-x509-validation,+ ech-config,+ network,+ network-run,+ tls,+ asn1-types,+ tasty-bench,+ QuickCheck,+ serialise,+ hspec
util/tls-client.hs view
@@ -46,6 +46,7 @@ , optTraceKey :: Bool , optIPv4Only :: Bool , optIPv6Only :: Bool+ , optTrustedAnchor :: Maybe FilePath } deriving (Show) @@ -69,6 +70,7 @@ , optTraceKey = False , optIPv4Only = False , optIPv6Only = False+ , optTrustedAnchor = Nothing } usage :: String@@ -161,6 +163,11 @@ [] (NoArg (\o -> o{optIPv6Only = True, optIPv4Only = False})) "IPv6 only"+ , Option+ ['t']+ ["trusted-anchor"]+ (ReqArg (\fl o -> o{optTrustedAnchor = Just fl}) "<file>")+ "trusted anchor file" ] showUsageAndExit :: String -> IO a@@ -213,8 +220,13 @@ , auxShow = showContent , auxReadResumptionData = readIORef ref }- mstore <-- if optValidate then Just <$> getSystemCertificateStore else return Nothing+ mstore <- do+ mstore' <- case optTrustedAnchor of+ Nothing -> + if optValidate then Just <$> getSystemCertificateStore else return Nothing+ Just file -> readCertificateStore file+ when (isNothing mstore') $ showUsageAndExit "cannot set trusted anchor"+ return mstore' echConfList <- case optECHConfigFile of Nothing -> return [] Just ecnff ->