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