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 (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