Main.hs (7382B)
1 {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE OverloadedStrings #-} 4 5 module Main where 6 7 import qualified Data.ByteString as BS 8 import qualified Data.ByteString.Base16 as B16 9 import Control.DeepSeq 10 import Criterion.Main 11 import qualified Crypto.Curve.Secp256k1 as S 12 13 instance NFData S.Projective 14 instance NFData S.Affine 15 instance NFData S.ECDSA 16 instance NFData S.Context 17 18 main :: IO () 19 main = defaultMain [ 20 parse_point 21 , add 22 , mul 23 , precompute 24 , mul_wnaf 25 , derive_pub 26 , schnorr 27 , ecdsa 28 , ecdh 29 ] 30 31 parse_int256 :: BS.ByteString -> Integer 32 parse_int256 bs = case S.parse_int256 bs of 33 Nothing -> error "bang" 34 Just v -> v 35 36 remQ :: Benchmark 37 remQ = env setup $ \x -> 38 bgroup "remQ (remainder modulo _CURVE_Q)" [ 39 bench "remQ 2 " $ nf S.remQ 2 40 , bench "remQ (2 ^ 255 - 19)" $ nf S.remQ x 41 ] 42 where 43 setup = pure . parse_int256 $ B16.decodeLenient 44 "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" 45 46 parse_point :: Benchmark 47 parse_point = bgroup "parse_point" [ 48 bench "compressed" $ nf S.parse_point p_bs 49 , bench "uncompressed" $ nf S.parse_point t_bs 50 , bench "bip0340" $ nf S.parse_point (BS.drop 1 p_bs) 51 ] 52 53 parse_integer :: Benchmark 54 parse_integer = env setup $ \ ~(small, big) -> 55 bgroup "parse_int256" [ 56 bench "parse_int256 (small)" $ nf parse_int256 small 57 , bench "parse_int256 (big)" $ nf parse_int256 big 58 ] 59 where 60 setup = do 61 let small = BS.replicate 32 0x00 62 big = BS.replicate 32 0xFF 63 pure (small, big) 64 65 add :: Benchmark 66 add = bgroup "add" [ 67 bench "2 p (double, trivial projective point)" $ nf (S.add p) p 68 , bench "2 r (double, nontrivial projective point)" $ nf (S.add r) r 69 , bench "p + q (trivial projective points)" $ nf (S.add p) q 70 , bench "p + s (nontrivial mixed points)" $ nf (S.add p) s 71 , bench "s + r (nontrivial projective points)" $ nf (S.add s) r 72 ] 73 74 mul :: Benchmark 75 mul = env setup $ \x -> 76 bgroup "mul" [ 77 bench "2 G" $ nf (S.mul S._CURVE_G) 2 78 , bench "(2 ^ 255 - 19) G" $ nf (S.mul S._CURVE_G) x 79 ] 80 where 81 setup = pure . parse_int256 $ B16.decodeLenient 82 "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" 83 84 precompute :: Benchmark 85 precompute = bench "precompute" $ nfIO (pure S.precompute) 86 87 mul_wnaf :: Benchmark 88 mul_wnaf = env setup $ \ ~(tex, x) -> 89 bgroup "mul_wnaf" [ 90 bench "2 G" $ nf (S.mul_wnaf tex) 2 91 , bench "(2 ^ 255 - 19) G" $ nf (S.mul_wnaf tex) x 92 ] 93 where 94 setup = do 95 let !tex = S.precompute 96 !int = parse_int256 $ B16.decodeLenient 97 "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" 98 pure (tex, int) 99 100 derive_pub :: Benchmark 101 derive_pub = env setup $ \ ~(tex, x) -> 102 bgroup "derive_pub" [ 103 bench "sk = 2" $ nf S.derive_pub 2 104 , bench "sk = 2 ^ 255 - 19" $ nf S.derive_pub x 105 , bench "wnaf, sk = 2" $ nf (S.derive_pub' tex) 2 106 , bench "wnaf, sk = 2 ^ 255 - 19" $ nf (S.derive_pub' tex) x 107 ] 108 where 109 setup = do 110 let !tex = S.precompute 111 !int = parse_int256 $ B16.decodeLenient 112 "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" 113 pure (tex, int) 114 115 schnorr :: Benchmark 116 schnorr = env setup $ \ ~(tex, big) -> 117 bgroup "schnorr" [ 118 bench "sign_schnorr (small)" $ nf (S.sign_schnorr 2 s_msg) s_aux 119 , bench "sign_schnorr (large)" $ nf (S.sign_schnorr big s_msg) s_aux 120 , bench "sign_schnorr' (small)" $ nf (S.sign_schnorr' tex 2 s_msg) s_aux 121 , bench "sign_schnorr' (large)" $ nf (S.sign_schnorr' tex big s_msg) s_aux 122 , bench "verify_schnorr" $ nf (S.verify_schnorr s_msg s_pk) s_sig 123 , bench "verify_schnorr'" $ nf (S.verify_schnorr' tex s_msg s_pk) s_sig 124 ] 125 where 126 setup = do 127 let !tex = S.precompute 128 !int = parse_int256 $ B16.decodeLenient 129 "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" 130 pure (tex, int) 131 132 ecdsa :: Benchmark 133 ecdsa = env setup $ \ ~(tex, big, pub, msg, sig) -> 134 bgroup "ecdsa" [ 135 bench "sign_ecdsa (small)" $ nf (S.sign_ecdsa 2) s_msg 136 , bench "sign_ecdsa (large)" $ nf (S.sign_ecdsa big) s_msg 137 , bench "sign_ecdsa' (small)" $ nf (S.sign_ecdsa' tex 2) s_msg 138 , bench "sign_ecdsa' (large)" $ nf (S.sign_ecdsa' tex big) s_msg 139 , bench "verify_ecdsa" $ nf (S.verify_ecdsa msg pub) sig 140 , bench "verify_ecdsa'" $ nf (S.verify_ecdsa' tex msg pub) sig 141 ] 142 where 143 setup = do 144 let !tex = S.precompute 145 big = parse_int256 $ B16.decodeLenient 146 "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" 147 Just pub = S.derive_pub big 148 msg = "i approve of this message" 149 Just sig = S.sign_ecdsa big s_msg 150 pure (tex, big, pub, msg, sig) 151 152 ecdh :: Benchmark 153 ecdh = env setup $ \ ~(big, pub) -> 154 bgroup "ecdh" [ 155 bench "ecdh (small)" $ nf (S.ecdh pub) 2 156 , bench "ecdh (large)" $ nf (S.ecdh pub) big 157 ] 158 where 159 setup = do 160 let !big = 161 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed 162 !(Just !pub) = S.parse_point . B16.decodeLenient $ 163 "bd02b9dfc8ef760708950bd972f2dc244893b61b6b46c3b19be1b2da7b034ac5" 164 pure (big, pub) 165 166 p_bs :: BS.ByteString 167 p_bs = B16.decodeLenient 168 "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798" 169 170 p :: S.Projective 171 p = case S.parse_point p_bs of 172 Nothing -> error "bang" 173 Just !pt -> pt 174 175 q_bs :: BS.ByteString 176 q_bs = B16.decodeLenient 177 "02f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f9" 178 179 q :: S.Projective 180 q = case S.parse_point q_bs of 181 Nothing -> error "bang" 182 Just !pt -> pt 183 184 r_bs :: BS.ByteString 185 r_bs = B16.decodeLenient 186 "03a2113cf152585d96791a42cdd78782757fbfb5c6b2c11b59857eb4f7fda0b0e8" 187 188 r :: S.Projective 189 r = case S.parse_point r_bs of 190 Nothing -> error "bang" 191 Just !pt -> pt 192 193 s_bs :: BS.ByteString 194 s_bs = B16.decodeLenient 195 "0306413898a49c93cccf3db6e9078c1b6a8e62568e4a4770e0d7d96792d1c580ad" 196 197 s :: S.Projective 198 s = case S.parse_point s_bs of 199 Nothing -> error "bang" 200 Just !pt -> pt 201 202 t_bs :: BS.ByteString 203 t_bs = B16.decodeLenient "04b838ff44e5bc177bf21189d0766082fc9d843226887fc9760371100b7ee20a6ff0c9d75bfba7b31a6bca1974496eeb56de357071955d83c4b1badaa0b21832e9" 204 205 t :: S.Projective 206 t = case S.parse_point t_bs of 207 Nothing -> error "bang" 208 Just !pt -> pt 209 210 s_sk :: Integer 211 s_sk = parse_int256 . B16.decodeLenient $ 212 "B7E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF" 213 214 s_sig :: BS.ByteString 215 s_sig = B16.decodeLenient "6896BD60EEAE296DB48A229FF71DFE071BDE413E6D43F917DC8DCF8C78DE33418906D11AC976ABCCB20B091292BFF4EA897EFCB639EA871CFA95F6DE339E4B0A" 216 217 s_pk_raw :: BS.ByteString 218 s_pk_raw = B16.decodeLenient 219 "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659" 220 221 s_pk :: S.Projective 222 s_pk = case S.parse_point s_pk_raw of 223 Nothing -> error "bang" 224 Just !pt -> pt 225 226 s_msg :: BS.ByteString 227 s_msg = B16.decodeLenient 228 "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89" 229 230 s_aux :: BS.ByteString 231 s_aux = B16.decodeLenient 232 "0000000000000000000000000000000000000000000000000000000000000001" 233 234 -- e_msg = B16.decodeLenient "313233343030" 235 -- e_sig = B16.decodeLenient "3045022100813ef79ccefa9a56f7ba805f0e478584fe5f0dd5f567bc09b5123ccbc983236502206ff18a52dcc0336f7af62400a6dd9b810732baf1ff758000d6f613a556eb31ba" 236