Main.hs (3042B)
1 {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE OverloadedStrings #-} 4 5 module Main where 6 7 import Control.DeepSeq 8 import Criterion.Main 9 import qualified Data.ByteString as BS 10 import qualified Lightning.Protocol.BOLT8 as BOLT8 11 12 instance NFData BOLT8.Pub where 13 rnf p = rnf (BOLT8.serialize_pub p) 14 15 instance NFData BOLT8.Sec 16 instance NFData BOLT8.Error 17 instance NFData BOLT8.Session 18 instance NFData BOLT8.HandshakeState 19 instance NFData BOLT8.Handshake 20 21 main :: IO () 22 main = defaultMain [ 23 keys 24 , handshake 25 , messages 26 ] 27 28 -- test keys (from BOLT #8 spec) 29 i_s_ent, i_e_ent, r_s_ent, r_e_ent :: BS.ByteString 30 i_s_ent = BS.replicate 32 0x11 31 i_e_ent = BS.replicate 32 0x12 32 r_s_ent = BS.replicate 32 0x21 33 r_e_ent = BS.replicate 32 0x22 34 35 keys :: Benchmark 36 keys = bgroup "keys" [ 37 bench "keypair" $ nf BOLT8.keypair i_s_ent 38 , bench "parse_pub" $ nf BOLT8.parse_pub r_s_pub_bs 39 , bench "serialize_pub" $ nf BOLT8.serialize_pub r_s_pub 40 ] 41 where 42 Just (_, r_s_pub) = BOLT8.keypair r_s_ent 43 r_s_pub_bs = BOLT8.serialize_pub r_s_pub 44 45 handshake :: Benchmark 46 handshake = env setup $ \ ~(i_s_sec, i_s_pub, r_s_sec, r_s_pub, msg1, i_hs, 47 msg2, r_hs, msg3) -> 48 bgroup "handshake" [ 49 bench "act1" $ nf (BOLT8.act1 i_s_sec i_s_pub r_s_pub) i_e_ent 50 , bench "act2" $ nf (BOLT8.act2 r_s_sec r_s_pub r_e_ent) msg1 51 , bench "act3" $ nf (BOLT8.act3 i_hs) msg2 52 , bench "finalize" $ nf (BOLT8.finalize r_hs) msg3 53 ] 54 where 55 setup = do 56 let Just (!i_s_sec, !i_s_pub) = BOLT8.keypair i_s_ent 57 Just (!r_s_sec, !r_s_pub) = BOLT8.keypair r_s_ent 58 Right (!msg1, !i_hs) = BOLT8.act1 i_s_sec i_s_pub r_s_pub i_e_ent 59 Right (!msg2, !r_hs) = BOLT8.act2 r_s_sec r_s_pub r_e_ent msg1 60 Right (!msg3, _) = BOLT8.act3 i_hs msg2 61 pure (i_s_sec, i_s_pub, r_s_sec, r_s_pub, msg1, i_hs, msg2, r_hs, msg3) 62 63 messages :: Benchmark 64 messages = env setup $ \ ~(i_sess, r_sess, ct_small, ct_large) -> 65 bgroup "messages" [ 66 bench "encrypt (32B)" $ nf (BOLT8.encrypt i_sess) small_msg 67 , bench "encrypt (1KB)" $ nf (BOLT8.encrypt i_sess) large_msg 68 , bench "decrypt (32B)" $ nf (BOLT8.decrypt r_sess) ct_small 69 , bench "decrypt (1KB)" $ nf (BOLT8.decrypt r_sess) ct_large 70 ] 71 where 72 small_msg = BS.replicate 32 0x00 73 large_msg = BS.replicate 1024 0x00 74 setup = do 75 let Just (!i_s_sec, !i_s_pub) = BOLT8.keypair i_s_ent 76 Just (!r_s_sec, !r_s_pub) = BOLT8.keypair r_s_ent 77 Right (msg1, i_hs) = BOLT8.act1 i_s_sec i_s_pub r_s_pub i_e_ent 78 Right (msg2, r_hs) = BOLT8.act2 r_s_sec r_s_pub r_e_ent msg1 79 Right (msg3, i_result) = BOLT8.act3 i_hs msg2 80 Right r_result = BOLT8.finalize r_hs msg3 81 !i_sess = BOLT8.session i_result 82 !r_sess = BOLT8.session r_result 83 Right (!ct_small, _) = BOLT8.encrypt i_sess small_msg 84 Right (!ct_large, _) = BOLT8.encrypt i_sess large_msg 85 pure (i_sess, r_sess, ct_small, ct_large)