Restore benchmarks

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

tls/test/Certificate.hs

@@ -9,6 +9,7 @@ module Certificate (
     arbitraryDN,
     simpleCertificate,
     simpleX509,
+    getSignatureALG,
     toPubKeyEC,
     toPrivKeyEC,
 ) where

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"

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