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

Weight.hs (4724B)


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