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