secp256k1

Pure Haskell Schnorr, ECDSA on the elliptic curve secp256k1 (docs.ppad.tech/secp256k1).
git clone git://git.ppad.tech/secp256k1.git
Log | Files | Refs | README | LICENSE

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