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