Weight.hs (5068B)
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 qualified Crypto.Curve.Secp256k1 as S 11 import qualified Weigh as W 12 13 instance NFData S.Projective 14 instance NFData S.Affine 15 instance NFData S.ECDSA 16 instance NFData S.Context 17 18 big :: Integer 19 big = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed 20 21 tex :: S.Context 22 tex = S.precompute 23 24 -- note that 'weigh' doesn't work properly in a repl 25 main :: IO () 26 main = W.mainWith $ do 27 remQ 28 parse_int256 29 add 30 mul 31 mul_unsafe 32 mul_wnaf 33 derive_pub 34 schnorr 35 ecdsa 36 ecdh 37 38 remQ :: W.Weigh () 39 remQ = W.wgroup "remQ" $ do 40 W.func "remQ 2" S.remQ 2 41 W.func "remQ (2 ^ 255 - 19)" S.remQ big 42 43 parse_int256 :: W.Weigh () 44 parse_int256 = W.wgroup "parse_int256" $ do 45 W.func' "parse_int256 (small)" S.parse_int256 (BS.replicate 32 0x00) 46 W.func' "parse_int256 (big)" S.parse_int256 (BS.replicate 32 0xFF) 47 48 add :: W.Weigh () 49 add = W.wgroup " add" $ do 50 W.func "2 p (double, trivial projective point)" (S.add p) p 51 W.func "2 r (double, nontrivial projective point)" (S.add r) r 52 W.func "p + q (trivial projective points)" (S.add p) q 53 W.func "p + s (nontrivial mixed points)" (S.add p) s 54 W.func "s + r (nontrivial projective points)" (S.add s) r 55 56 mul :: W.Weigh () 57 mul = W.wgroup "mul" $ do 58 W.func "2 G" (S.mul S._CURVE_G) 2 59 W.func "(2 ^ 255 - 19) G" (S.mul S._CURVE_G) big 60 61 mul_unsafe :: W.Weigh () 62 mul_unsafe = W.wgroup "mul_unsafe" $ do 63 W.func "2 G" (S.mul_unsafe S._CURVE_G) 2 64 W.func "(2 ^ 255 - 19) G" (S.mul_unsafe S._CURVE_G) big 65 66 mul_wnaf :: W.Weigh () 67 mul_wnaf = W.wgroup "mul_wnaf" $ do 68 W.value "precompute" S.precompute 69 W.func "2 G" (S.mul_wnaf tex) 2 70 W.func "(2 ^ 255 - 19) G" (S.mul_wnaf tex) big 71 72 derive_pub :: W.Weigh () 73 derive_pub = W.wgroup "derive_pub" $ do 74 W.func "sk = 2" S.derive_pub 2 75 W.func "sk = 2 ^ 255 - 19" S.derive_pub big 76 W.func "wnaf, sk = 2" (S.derive_pub' tex) 2 77 W.func "wnaf, sk = 2 ^ 255 - 19" (S.derive_pub' tex) big 78 79 schnorr :: W.Weigh () 80 schnorr = W.wgroup "schnorr" $ do 81 W.func "sign_schnorr (small)" (S.sign_schnorr 2 s_msg) s_aux 82 W.func "sign_schnorr (large)" (S.sign_schnorr big s_msg) s_aux 83 W.func "sign_schnorr' (small)" (S.sign_schnorr' tex 2 s_msg) s_aux 84 W.func "sign_schnorr' (large)" (S.sign_schnorr' tex big s_msg) s_aux 85 W.func "verify_schnorr" (S.verify_schnorr s_msg s_pk) s_sig 86 W.func "verify_schnorr'" (S.verify_schnorr' tex s_msg s_pk) s_sig 87 88 ecdsa :: W.Weigh () 89 ecdsa = W.wgroup "ecdsa" $ do 90 W.func "sign_ecdsa (small)" (S.sign_ecdsa 2) s_msg 91 W.func "sign_ecdsa (large)" (S.sign_ecdsa big) s_msg 92 W.func "sign_ecdsa' (small)" (S.sign_ecdsa' tex 2) s_msg 93 W.func "sign_ecdsa' (large)" (S.sign_ecdsa' tex big) s_msg 94 W.func "verify_ecdsa" (S.verify_ecdsa msg pub) sig 95 W.func "verify_ecdsa'" (S.verify_ecdsa' tex msg pub) sig 96 where 97 pub = S.derive_pub big 98 msg = "i approve of this message" 99 sig = S.sign_ecdsa big s_msg 100 101 ecdh :: W.Weigh () 102 ecdh = W.wgroup "ecdh" $ do 103 W.func "ecdh (small)" (S.ecdh pub) 2 104 W.func "ecdh (large)" (S.ecdh pub) b 105 where 106 b = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed 107 Just pub = S.parse_point . B16.decodeLenient $ 108 "bd02b9dfc8ef760708950bd972f2dc244893b61b6b46c3b19be1b2da7b034ac5" 109 110 s_sk :: Integer 111 s_sk = S.parse_int256 . B16.decodeLenient $ 112 "B7E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF" 113 114 s_sig :: BS.ByteString 115 s_sig = B16.decodeLenient "6896BD60EEAE296DB48A229FF71DFE071BDE413E6D43F917DC8DCF8C78DE33418906D11AC976ABCCB20B091292BFF4EA897EFCB639EA871CFA95F6DE339E4B0A" 116 117 s_pk_raw :: BS.ByteString 118 s_pk_raw = B16.decodeLenient 119 "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659" 120 121 s_pk :: S.Projective 122 s_pk = case S.parse_point s_pk_raw of 123 Nothing -> error "bang" 124 Just !pt -> pt 125 126 s_msg :: BS.ByteString 127 s_msg = B16.decodeLenient 128 "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89" 129 130 s_aux :: BS.ByteString 131 s_aux = B16.decodeLenient 132 "0000000000000000000000000000000000000000000000000000000000000001" 133 134 p_bs :: BS.ByteString 135 p_bs = B16.decodeLenient 136 "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798" 137 138 p :: S.Projective 139 p = case S.parse_point p_bs of 140 Nothing -> error "bang" 141 Just !pt -> pt 142 143 q_bs :: BS.ByteString 144 q_bs = B16.decodeLenient 145 "02f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f9" 146 147 q :: S.Projective 148 q = case S.parse_point q_bs of 149 Nothing -> error "bang" 150 Just !pt -> pt 151 152 r_bs :: BS.ByteString 153 r_bs = B16.decodeLenient 154 "03a2113cf152585d96791a42cdd78782757fbfb5c6b2c11b59857eb4f7fda0b0e8" 155 156 r :: S.Projective 157 r = case S.parse_point r_bs of 158 Nothing -> error "bang" 159 Just !pt -> pt 160 161 s_bs :: BS.ByteString 162 s_bs = B16.decodeLenient 163 "0306413898a49c93cccf3db6e9078c1b6a8e62568e4a4770e0d7d96792d1c580ad" 164 165 s :: S.Projective 166 s = case S.parse_point s_bs of 167 Nothing -> error "bang" 168 Just !pt -> pt 169