Main.hs (8126B)
1 {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns -fno-warn-type-defaults #-} 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 qualified Data.Word.Wider as W 10 import Control.DeepSeq 11 import Criterion.Main 12 import qualified Crypto.Curve.Secp256k1 as S 13 14 import qualified Numeric.Montgomery.Secp256k1.Curve as C 15 16 instance NFData S.Projective 17 instance NFData S.Affine 18 instance NFData S.ECDSA 19 instance NFData S.Context 20 21 decodeLenient :: BS.ByteString -> BS.ByteString 22 decodeLenient bs = case B16.decode bs of 23 Nothing -> error "bang" 24 Just b -> b 25 26 main :: IO () 27 main = defaultMain [ 28 parse_point 29 , add 30 , double 31 , mul 32 , mul_vartime 33 , mul_wnaf 34 , precompute 35 , derive_pub 36 , schnorr 37 , ecdsa 38 , ecdh 39 ] 40 41 parse_int256 :: BS.ByteString -> W.Wider 42 parse_int256 bs = case S.parse_int256 bs of 43 Nothing -> error "bang" 44 Just v -> v 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 mul_fixed :: Benchmark 66 mul_fixed = bgroup "mul_fixed" [ 67 bench "curve: M(2) * M(2)" $ nf (C.mul 2) 2 68 , bench "curve: M(2) * M(2 ^ 255 - 19)" $ nf (C.mul 2) (2 ^ 255 - 19) 69 ] 70 71 add :: Benchmark 72 add = env setup $ \ ~(!pl, !ql, !rl, !sl) -> 73 bgroup "add" [ 74 bench "p + q (trivial projective points)" $ nf (S.add pl) ql 75 , bench "p + s (nontrivial mixed points)" $ nf (S.add pl) sl 76 , bench "s + r (nontrivial projective points)" $ nf (S.add sl) rl 77 ] 78 where 79 setup = pure (p, q, r, s) 80 81 double :: Benchmark 82 double = env setup $ \ ~(!pl, !rl) -> 83 bgroup "double" [ 84 bench "2 p (double, trivial projective point)" $ nf (S.add pl) pl 85 , bench "2 r (double, nontrivial projective point)" $ nf (S.add rl) rl 86 ] 87 where 88 setup = pure (p, r) 89 90 mul :: Benchmark 91 mul = env setup $ \x -> 92 bgroup "mul" [ 93 bench "2 G" $ nf (S.mul S._CURVE_G) 2 94 , bench "(2 ^ 255 - 19) G" $ nf (S.mul S._CURVE_G) x 95 ] 96 where 97 setup = pure . parse_int256 $ decodeLenient 98 "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" 99 100 mul_vartime :: Benchmark 101 mul_vartime = env setup $ \x -> 102 bgroup "mul_vartime" [ 103 bench "2 G" $ nf (S.mul_vartime S._CURVE_G) 2 104 , bench "(2 ^ 255 - 19) G" $ nf (S.mul_vartime S._CURVE_G) x 105 ] 106 where 107 setup = pure . parse_int256 $ decodeLenient 108 "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" 109 110 precompute :: Benchmark 111 precompute = bench "precompute" $ nfIO (pure S.precompute) 112 113 mul_wnaf :: Benchmark 114 mul_wnaf = env setup $ \ ~(tex, x) -> 115 bgroup "mul_wnaf" [ 116 bench "2 G" $ nf (S.mul_wnaf tex) 2 117 , bench "(2 ^ 255 - 19) G" $ nf (S.mul_wnaf tex) x 118 ] 119 where 120 setup = do 121 let !tex = S.precompute 122 !int = parse_int256 $ decodeLenient 123 "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" 124 pure (tex, int) 125 126 derive_pub :: Benchmark 127 derive_pub = env setup $ \ ~(tex, x) -> 128 bgroup "derive_pub" [ 129 bench "sk = 2" $ nf S.derive_pub 2 130 , bench "sk = 2 ^ 255 - 19" $ nf S.derive_pub x 131 , bench "wnaf, sk = 2" $ nf (S.derive_pub' tex) 2 132 , bench "wnaf, sk = 2 ^ 255 - 19" $ nf (S.derive_pub' tex) x 133 ] 134 where 135 setup = do 136 let !tex = S.precompute 137 !int = parse_int256 $ decodeLenient 138 "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" 139 pure (tex, int) 140 141 schnorr :: Benchmark 142 schnorr = env setup $ \ ~(tex, big) -> 143 bgroup "schnorr" [ 144 bench "sign_schnorr (small)" $ nf (S.sign_schnorr 2 s_msg) s_aux 145 , bench "sign_schnorr (large)" $ nf (S.sign_schnorr big s_msg) s_aux 146 , bench "sign_schnorr' (small)" $ nf (S.sign_schnorr' tex 2 s_msg) s_aux 147 , bench "sign_schnorr' (large)" $ nf (S.sign_schnorr' tex big s_msg) s_aux 148 , bench "verify_schnorr" $ nf (S.verify_schnorr s_msg s_pk) s_sig 149 , bench "verify_schnorr'" $ nf (S.verify_schnorr' tex s_msg s_pk) s_sig 150 ] 151 where 152 setup = do 153 let !tex = S.precompute 154 !int = parse_int256 $ decodeLenient 155 "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" 156 pure (tex, int) 157 158 ecdsa :: Benchmark 159 ecdsa = env setup $ \ ~(tex, big, pub, msg, sig) -> 160 bgroup "ecdsa" [ 161 bench "sign_ecdsa (small)" $ nf (S.sign_ecdsa 2) s_msg 162 , bench "sign_ecdsa (large)" $ nf (S.sign_ecdsa big) s_msg 163 , bench "sign_ecdsa' (small)" $ nf (S.sign_ecdsa' tex 2) s_msg 164 , bench "sign_ecdsa' (large)" $ nf (S.sign_ecdsa' tex big) s_msg 165 , bench "verify_ecdsa" $ nf (S.verify_ecdsa msg pub) sig 166 , bench "verify_ecdsa'" $ nf (S.verify_ecdsa' tex msg pub) sig 167 ] 168 where 169 setup = do 170 let !tex = S.precompute 171 big = parse_int256 $ decodeLenient 172 "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" 173 Just pub = S.derive_pub big 174 msg = "i approve of this message" 175 Just sig = S.sign_ecdsa big s_msg 176 pure (tex, big, pub, msg, sig) 177 178 ecdh :: Benchmark 179 ecdh = env setup $ \ ~(big, pub) -> 180 bgroup "ecdh" [ 181 bench "ecdh (small)" $ nf (S.ecdh pub) 2 182 , bench "ecdh (large)" $ nf (S.ecdh pub) big 183 ] 184 where 185 setup = do 186 let !big = 187 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed 188 !(Just !pub) = S.parse_point . decodeLenient $ 189 "bd02b9dfc8ef760708950bd972f2dc244893b61b6b46c3b19be1b2da7b034ac5" 190 pure (big, pub) 191 192 193 p :: S.Projective 194 p = S.Projective 195 55066263022277343669578718895168534326250603453777594175500187360389116729240 196 32670510020758816978083085130507043184471273380659243275938904335757337482424 197 1 198 199 q :: S.Projective 200 q = S.Projective 201 112711660439710606056748659173929673102114977341539408544630613555209775888121 202 25583027980570883691656905877401976406448868254816295069919888960541586679410 203 1 204 205 r :: S.Projective 206 r = S.Projective 207 73305138481390301074068425511419969342201196102229546346478796034582161436904 208 77311080844824646227678701997218206005272179480834599837053144390237051080427 209 1 210 211 p_bs :: BS.ByteString 212 p_bs = decodeLenient 213 "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798" 214 215 q_bs :: BS.ByteString 216 q_bs = decodeLenient 217 "02f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f9" 218 219 r_bs :: BS.ByteString 220 r_bs = decodeLenient 221 "03a2113cf152585d96791a42cdd78782757fbfb5c6b2c11b59857eb4f7fda0b0e8" 222 223 s_bs :: BS.ByteString 224 s_bs = decodeLenient 225 "0306413898a49c93cccf3db6e9078c1b6a8e62568e4a4770e0d7d96792d1c580ad" 226 227 s :: S.Projective 228 s = case S.parse_point s_bs of 229 Nothing -> error "bang" 230 Just !pt -> pt 231 232 t_bs :: BS.ByteString 233 t_bs = decodeLenient "04b838ff44e5bc177bf21189d0766082fc9d843226887fc9760371100b7ee20a6ff0c9d75bfba7b31a6bca1974496eeb56de357071955d83c4b1badaa0b21832e9" 234 235 t :: S.Projective 236 t = case S.parse_point t_bs of 237 Nothing -> error "bang" 238 Just !pt -> pt 239 240 s_sk :: W.Wider 241 s_sk = parse_int256 . decodeLenient $ 242 "B7E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF" 243 244 s_sig :: BS.ByteString 245 s_sig = decodeLenient "6896BD60EEAE296DB48A229FF71DFE071BDE413E6D43F917DC8DCF8C78DE33418906D11AC976ABCCB20B091292BFF4EA897EFCB639EA871CFA95F6DE339E4B0A" 246 247 s_pk_raw :: BS.ByteString 248 s_pk_raw = decodeLenient 249 "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659" 250 251 s_pk :: S.Projective 252 s_pk = case S.parse_point s_pk_raw of 253 Nothing -> error "bang" 254 Just !pt -> pt 255 256 s_msg :: BS.ByteString 257 s_msg = decodeLenient 258 "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89" 259 260 s_aux :: BS.ByteString 261 s_aux = decodeLenient 262 "0000000000000000000000000000000000000000000000000000000000000001" 263