diff --git a/tls/Benchmarks/Benchmarks.hs b/tls/Benchmarks/Benchmarks.hs index df91086c4..9123ac960 100644 --- a/tls/Benchmarks/Benchmarks.hs +++ b/tls/Benchmarks/Benchmarks.hs @@ -3,15 +3,16 @@ module Main where import Certificate -import Connection import Control.Concurrent.Chan import Data.Default (def) import Data.IORef import Data.X509 import Data.X509.Validation -import Gauge.Main +import Test.Tasty.Bench import Network.TLS import Network.TLS.Extra.Cipher +import Session +import Run import PubKey import qualified Data.ByteString as B @@ -150,17 +151,11 @@ main = [ bgroup "connection" -- not sure the number actually make sense for anything. improve .. - [ benchConnection (getParams SSL3 blockCipher) small "SSL3-256 bytes" - , benchConnection (getParams TLS10 blockCipher) small "TLS10-256 bytes" - , benchConnection (getParams TLS11 blockCipher) small "TLS11-256 bytes" - , benchConnection (getParams TLS12 blockCipher) small "TLS12-256 bytes" + [ benchConnection (getParams TLS12 blockCipher) small "TLS12-256 bytes" ] , bgroup "resumption" - [ benchResumption (getParams SSL3 blockCipher) small "SSL3-256 bytes" - , benchResumption (getParams TLS10 blockCipher) small "TLS10-256 bytes" - , benchResumption (getParams TLS11 blockCipher) small "TLS11-256 bytes" - , benchResumption (getParams TLS12 blockCipher) small "TLS12-256 bytes" + [ 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 @@ -169,24 +164,22 @@ main = "TLS12" TLS12 large - [ cipher_DHE_RSA_AES128GCM_SHA256 - , cipher_DHE_RSA_AES256GCM_SHA384 - , cipher_DHE_RSA_CHACHA20POLY1305_SHA256 - , cipher_DHE_RSA_AES128CCM_SHA256 - , cipher_DHE_RSA_AES128CCM8_SHA256 - , cipher_ECDHE_RSA_AES128GCM_SHA256 - , cipher_ECDHE_RSA_AES256GCM_SHA384 - , cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256 + [ 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 - [ cipher_TLS13_AES128GCM_SHA256 - , cipher_TLS13_AES256GCM_SHA384 - , cipher_TLS13_CHACHA20POLY1305_SHA256 - , cipher_TLS13_AES128CCM_SHA256 - , cipher_TLS13_AES128CCM8_SHA256 + [ 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 diff --git a/tls/test/Certificate.hs b/tls/test/Certificate.hs index d7780ce92..e0fbe788d 100644 --- a/tls/test/Certificate.hs +++ b/tls/test/Certificate.hs @@ -9,6 +9,7 @@ module Certificate ( arbitraryDN, simpleCertificate, simpleX509, + getSignatureALG, toPubKeyEC, toPrivKeyEC, ) where diff --git a/tls/test/Run.hs b/tls/test/Run.hs index 87e37f522..1a7145a4c 100644 --- a/tls/test/Run.hs +++ b/tls/test/Run.hs @@ -15,6 +15,9 @@ module Run ( runTLSSuccess, runTLSFailure, expectMaybe, + newPairContext, + withDataPipe, + byeBye, ) where import Control.Concurrent @@ -356,3 +359,36 @@ newPairContext (cParams, sParams) = do , 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" diff --git a/tls/tls.cabal b/tls/tls.cabal index bc297b800..0c497f05b 100644 --- a/tls/tls.cabal +++ b/tls/tls.cabal @@ -233,3 +233,46 @@ executable tls-client 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