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