1{-# LANGUAGE BangPatterns #-} 2module Main where 3 4import Connection 5import Certificate 6import PubKey 7import Gauge.Main 8import Control.Concurrent.Chan 9import Network.TLS 10import Network.TLS.Extra.Cipher 11import Data.X509 12import Data.X509.Validation 13import Data.Default.Class 14import Data.IORef 15 16import qualified Data.ByteString as B 17import qualified Data.ByteString.Lazy as L 18 19blockCipher :: Cipher 20blockCipher = Cipher 21 { cipherID = 0xff12 22 , cipherName = "rsa-id-const" 23 , cipherBulk = Bulk 24 { bulkName = "id" 25 , bulkKeySize = 16 26 , bulkIVSize = 16 27 , bulkExplicitIV= 0 28 , bulkAuthTagLen= 0 29 , bulkBlockSize = 16 30 , bulkF = BulkBlockF $ \ _ _ _ m -> (m, B.empty) 31 } 32 , cipherHash = MD5 33 , cipherPRFHash = Nothing 34 , cipherKeyExchange = CipherKeyExchange_RSA 35 , cipherMinVer = Nothing 36 } 37 38getParams :: Version -> Cipher -> (ClientParams, ServerParams) 39getParams connectVer cipher = (cParams, sParams) 40 where sParams = def { serverSupported = supported 41 , serverShared = def { 42 sharedCredentials = Credentials [ (CertificateChain [simpleX509 $ PubKeyRSA pubKey], PrivKeyRSA privKey) ] 43 } 44 } 45 cParams = (defaultParamsClient "" B.empty) 46 { clientSupported = supported 47 , clientShared = def { sharedValidationCache = ValidationCache 48 { cacheAdd = \_ _ _ -> return () 49 , cacheQuery = \_ _ _ -> return ValidationCachePass 50 } 51 } 52 } 53 supported = def { supportedCiphers = [cipher] 54 , supportedVersions = [connectVer] 55 , supportedGroups = [X25519, FFDHE2048] 56 } 57 (pubKey, privKey) = getGlobalRSAPair 58 59runTLSPipe :: (ClientParams, ServerParams) 60 -> (Context -> Chan b -> IO ()) 61 -> (Chan a -> Context -> IO ()) 62 -> a 63 -> IO b 64runTLSPipe params tlsServer tlsClient d = do 65 withDataPipe params tlsServer tlsClient $ \(writeStart, readResult) -> do 66 writeStart d 67 readResult 68 69runTLSPipeSimple :: (ClientParams, ServerParams) -> B.ByteString -> IO B.ByteString 70runTLSPipeSimple params = runTLSPipe params tlsServer tlsClient 71 where tlsServer ctx queue = do 72 handshake ctx 73 d <- recvData ctx 74 writeChan queue d 75 bye ctx 76 tlsClient queue ctx = do 77 handshake ctx 78 d <- readChan queue 79 sendData ctx (L.fromChunks [d]) 80 byeBye ctx 81 82benchConnection :: (ClientParams, ServerParams) -> B.ByteString -> String -> Benchmark 83benchConnection params !d name = bench name . nfIO $ runTLSPipeSimple params d 84 85benchResumption :: (ClientParams, ServerParams) -> B.ByteString -> String -> Benchmark 86benchResumption params !d name = env initializeSession runResumption 87 where 88 initializeSession = do 89 sessionRefs <- twoSessionRefs 90 let sessionManagers = twoSessionManagers sessionRefs 91 params1 = setPairParamsSessionManagers sessionManagers params 92 _ <- runTLSPipeSimple params1 d 93 94 Just sessionParams <- readClientSessionRef sessionRefs 95 let params2 = setPairParamsSessionResuming sessionParams params1 96 newIORef params2 97 98 runResumption paramsRef = bench name . nfIO $ do 99 params2 <- readIORef paramsRef 100 runTLSPipeSimple params2 d 101 102benchResumption13 :: (ClientParams, ServerParams) -> B.ByteString -> String -> Benchmark 103benchResumption13 params !d name = env initializeSession runResumption 104 where 105 initializeSession = do 106 sessionRefs <- twoSessionRefs 107 let sessionManagers = twoSessionManagers sessionRefs 108 params1 = setPairParamsSessionManagers sessionManagers params 109 _ <- runTLSPipeSimple params1 d 110 newIORef (params1, sessionRefs) 111 112 -- with TLS13 the sessionId is constantly changing so we must update 113 -- our parameters at each iteration unfortunately 114 runResumption paramsRef = bench name . nfIO $ do 115 (params1, sessionRefs) <- readIORef paramsRef 116 Just sessionParams <- readClientSessionRef sessionRefs 117 let params2 = setPairParamsSessionResuming sessionParams params1 118 runTLSPipeSimple params2 d 119 120benchCiphers :: String -> Version -> B.ByteString -> [Cipher] -> Benchmark 121benchCiphers name connectVer d = bgroup name . map doBench 122 where 123 doBench cipher = 124 benchResumption13 (getParams connectVer cipher) d (cipherName cipher) 125 126main :: IO () 127main = defaultMain 128 [ bgroup "connection" 129 -- not sure the number actually make sense for anything. improve .. 130 [ benchConnection (getParams SSL3 blockCipher) small "SSL3-256 bytes" 131 , benchConnection (getParams TLS10 blockCipher) small "TLS10-256 bytes" 132 , benchConnection (getParams TLS11 blockCipher) small "TLS11-256 bytes" 133 , benchConnection (getParams TLS12 blockCipher) small "TLS12-256 bytes" 134 ] 135 , bgroup "resumption" 136 [ benchResumption (getParams SSL3 blockCipher) small "SSL3-256 bytes" 137 , benchResumption (getParams TLS10 blockCipher) small "TLS10-256 bytes" 138 , benchResumption (getParams TLS11 blockCipher) small "TLS11-256 bytes" 139 , benchResumption (getParams TLS12 blockCipher) small "TLS12-256 bytes" 140 ] 141 -- Here we try to measure TLS12 and TLS13 performance with AEAD ciphers. 142 -- Resumption and a larger message can be a demonstration of the symmetric 143 -- crypto but for TLS13 this does not work so well because of dhe_psk. 144 , benchCiphers "TLS12" TLS12 large 145 [ cipher_DHE_RSA_AES128GCM_SHA256 146 , cipher_DHE_RSA_AES256GCM_SHA384 147 , cipher_DHE_RSA_CHACHA20POLY1305_SHA256 148 , cipher_DHE_RSA_AES128CCM_SHA256 149 , cipher_DHE_RSA_AES128CCM8_SHA256 150 , cipher_ECDHE_RSA_AES128GCM_SHA256 151 , cipher_ECDHE_RSA_AES256GCM_SHA384 152 , cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256 153 ] 154 , benchCiphers "TLS13" TLS13 large 155 [ cipher_TLS13_AES128GCM_SHA256 156 , cipher_TLS13_AES256GCM_SHA384 157 , cipher_TLS13_CHACHA20POLY1305_SHA256 158 , cipher_TLS13_AES128CCM_SHA256 159 , cipher_TLS13_AES128CCM8_SHA256 160 ] 161 ] 162 where 163 small = B.replicate 256 0 164 large = B.replicate 102400 0 165