ppad-secp256k1 0.4.0 → 0.5.0

raw patch · 10 files changed

+1647/−1509 lines, 10 filesdep +ppad-base16dep +ppad-fixeddep −base16-bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: ppad-base16, ppad-fixed

Dependencies removed: base16-bytestring

API changes (from Hackage documentation)

Files

• CHANGELOG +14/−0
• bench/Main.hs +82/−55
• bench/Weight.hs +112/−124
• lib/Crypto/Curve/Secp256k1.hs +1363/−1250
• ppad-secp256k1.cabal +15/−4
• test/BIP340.hs +10/−16
• test/Main.hs +8/−3
• test/Noble.hs +12/−16
• test/Wycheproof.hs +20/−16
• test/WycheproofEcdh.hs +11/−25

@@ -1,5 +1,19 @@ # Changelog +- 0.5.0 (2025-12-21)+  * We get a significant upgrade to all functionality by pulling in the+    ppad-fixed library for large unsigned and Montgomery-form integers.+    Constant-time and allocation properties are made much more rigorous+    across the board, as we no longer depend on 'Integer' whatsoever.++    This version also improves performance radically throughout. A+    summary of the speedups achieved:++    sign_schnorr:   ~7.1x speedup+    verify_schnorr: ~4.5x speedup+    sign_ecdsa:     ~1.5x speedup+    verify_ecdsa:   ~4.5x speedup+ - 0.4.0 (2025-06-21)   * Scalar multiplication, signing, verifying, and ECHD functions are now     all total, returning 'Nothing' when supplied with invalid inputs.

@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns -fno-warn-type-defaults #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} @@ -6,43 +6,43 @@  import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16+import qualified Data.Word.Wider as W import Control.DeepSeq import Criterion.Main import qualified Crypto.Curve.Secp256k1 as S +import qualified Numeric.Montgomery.Secp256k1.Curve as C+ instance NFData S.Projective instance NFData S.Affine instance NFData S.ECDSA instance NFData S.Context +decodeLenient :: BS.ByteString -> BS.ByteString+decodeLenient bs = case B16.decode bs of+  Nothing -> error "bang"+  Just b -> b+ main :: IO () main = defaultMain [     parse_point   , add+  , double   , mul-  , precompute+  , mul_vartime   , mul_wnaf+  , precompute   , derive_pub   , schnorr   , ecdsa   , ecdh   ] -parse_int256 :: BS.ByteString -> Integer+parse_int256 :: BS.ByteString -> W.Wider parse_int256 bs = case S.parse_int256 bs of   Nothing -> error "bang"   Just v -> v -remQ :: Benchmark-remQ = env setup $ \x ->-    bgroup "remQ (remainder modulo _CURVE_Q)" [-      bench "remQ 2 " $ nf S.remQ 2-    , bench "remQ (2 ^ 255 - 19)" $ nf S.remQ x-    ]-  where-    setup = pure . parse_int256 $ B16.decodeLenient-      "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"- parse_point :: Benchmark parse_point = bgroup "parse_point" [     bench "compressed" $ nf S.parse_point p_bs@@ -62,15 +62,31 @@           big   = BS.replicate 32 0xFF       pure (small, big) -add :: Benchmark-add = bgroup "add" [-    bench "2 p (double, trivial projective point)" $ nf (S.add p) p-  , bench "2 r (double, nontrivial projective point)" $ nf (S.add r) r-  , bench "p + q (trivial projective points)" $ nf (S.add p) q-  , bench "p + s (nontrivial mixed points)" $ nf (S.add p) s-  , bench "s + r (nontrivial projective points)" $ nf (S.add s) r+mul_fixed :: Benchmark+mul_fixed = bgroup "mul_fixed" [+    bench "curve:  M(2) * M(2)" $ nf (C.mul 2) 2+  , bench "curve:  M(2) * M(2 ^ 255 - 19)" $ nf (C.mul 2) (2 ^ 255 - 19)   ] +add :: Benchmark+add = env setup $ \ ~(!pl, !ql, !rl, !sl) ->+    bgroup "add" [+      bench "p + q (trivial projective points)" $ nf (S.add pl) ql+    , bench "p + s (nontrivial mixed points)" $ nf (S.add pl) sl+    , bench "s + r (nontrivial projective points)" $ nf (S.add sl) rl+    ]+  where+    setup = pure (p, q, r, s)++double :: Benchmark+double = env setup $ \ ~(!pl, !rl) ->+    bgroup "double" [+      bench "2 p (double, trivial projective point)" $ nf (S.add pl) pl+    , bench "2 r (double, nontrivial projective point)" $ nf (S.add rl) rl+    ]+  where+    setup = pure (p, r)+ mul :: Benchmark mul = env setup $ \x ->     bgroup "mul" [@@ -78,9 +94,19 @@     , bench "(2 ^ 255 - 19) G" $ nf (S.mul S._CURVE_G) x     ]   where-    setup = pure . parse_int256 $ B16.decodeLenient+    setup = pure . parse_int256 $ decodeLenient       "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" +mul_vartime :: Benchmark+mul_vartime = env setup $ \x ->+    bgroup "mul_vartime" [+      bench "2 G" $ nf (S.mul_vartime S._CURVE_G) 2+    , bench "(2 ^ 255 - 19) G" $ nf (S.mul_vartime S._CURVE_G) x+    ]+  where+    setup = pure . parse_int256 $ decodeLenient+      "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"+ precompute :: Benchmark precompute = bench "precompute" $ nfIO (pure S.precompute) @@ -93,7 +119,7 @@   where     setup = do       let !tex = S.precompute-          !int = parse_int256 $ B16.decodeLenient+          !int = parse_int256 $ decodeLenient             "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"       pure (tex, int) @@ -108,7 +134,7 @@   where     setup = do       let !tex = S.precompute-          !int = parse_int256 $ B16.decodeLenient+          !int = parse_int256 $ decodeLenient             "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"       pure (tex, int) @@ -125,7 +151,7 @@   where     setup = do       let !tex = S.precompute-          !int = parse_int256 $ B16.decodeLenient+          !int = parse_int256 $ decodeLenient             "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"       pure (tex, int) @@ -142,7 +168,7 @@   where     setup = do       let !tex = S.precompute-          big = parse_int256 $ B16.decodeLenient+          big = parse_int256 $ decodeLenient             "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"           Just pub = S.derive_pub big           msg = "i approve of this message"@@ -159,39 +185,43 @@     setup = do       let !big =             0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed-          !(Just !pub) = S.parse_point . B16.decodeLenient $+          !(Just !pub) = S.parse_point . decodeLenient $             "bd02b9dfc8ef760708950bd972f2dc244893b61b6b46c3b19be1b2da7b034ac5"       pure (big, pub) -p_bs :: BS.ByteString-p_bs = B16.decodeLenient-  "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"  p :: S.Projective-p = case S.parse_point p_bs of-  Nothing -> error "bang"-  Just !pt -> pt+p = S.Projective+  55066263022277343669578718895168534326250603453777594175500187360389116729240+  32670510020758816978083085130507043184471273380659243275938904335757337482424+  1 +q :: S.Projective+q = S.Projective+  112711660439710606056748659173929673102114977341539408544630613555209775888121+  25583027980570883691656905877401976406448868254816295069919888960541586679410+  1++r :: S.Projective+r = S.Projective+  73305138481390301074068425511419969342201196102229546346478796034582161436904+  77311080844824646227678701997218206005272179480834599837053144390237051080427+  1++p_bs :: BS.ByteString+p_bs = decodeLenient+  "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"+ q_bs :: BS.ByteString-q_bs = B16.decodeLenient+q_bs = decodeLenient   "02f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f9" -q :: S.Projective-q = case S.parse_point q_bs of-  Nothing -> error "bang"-  Just !pt -> pt- r_bs :: BS.ByteString-r_bs = B16.decodeLenient+r_bs = decodeLenient   "03a2113cf152585d96791a42cdd78782757fbfb5c6b2c11b59857eb4f7fda0b0e8" -r :: S.Projective-r = case S.parse_point r_bs of-  Nothing -> error "bang"-  Just !pt -> pt- s_bs :: BS.ByteString-s_bs = B16.decodeLenient+s_bs = decodeLenient   "0306413898a49c93cccf3db6e9078c1b6a8e62568e4a4770e0d7d96792d1c580ad"  s :: S.Projective@@ -200,22 +230,22 @@   Just !pt -> pt  t_bs :: BS.ByteString-t_bs = B16.decodeLenient "04b838ff44e5bc177bf21189d0766082fc9d843226887fc9760371100b7ee20a6ff0c9d75bfba7b31a6bca1974496eeb56de357071955d83c4b1badaa0b21832e9"+t_bs = decodeLenient "04b838ff44e5bc177bf21189d0766082fc9d843226887fc9760371100b7ee20a6ff0c9d75bfba7b31a6bca1974496eeb56de357071955d83c4b1badaa0b21832e9"  t :: S.Projective t = case S.parse_point t_bs of   Nothing -> error "bang"   Just !pt -> pt -s_sk :: Integer-s_sk = parse_int256 . B16.decodeLenient $+s_sk :: W.Wider+s_sk = parse_int256 . decodeLenient $   "B7E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF"  s_sig :: BS.ByteString-s_sig = B16.decodeLenient "6896BD60EEAE296DB48A229FF71DFE071BDE413E6D43F917DC8DCF8C78DE33418906D11AC976ABCCB20B091292BFF4EA897EFCB639EA871CFA95F6DE339E4B0A"+s_sig = decodeLenient "6896BD60EEAE296DB48A229FF71DFE071BDE413E6D43F917DC8DCF8C78DE33418906D11AC976ABCCB20B091292BFF4EA897EFCB639EA871CFA95F6DE339E4B0A"  s_pk_raw :: BS.ByteString-s_pk_raw = B16.decodeLenient+s_pk_raw = decodeLenient   "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659"  s_pk :: S.Projective@@ -224,13 +254,10 @@   Just !pt -> pt  s_msg :: BS.ByteString-s_msg = B16.decodeLenient+s_msg = decodeLenient   "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89"  s_aux :: BS.ByteString-s_aux = B16.decodeLenient+s_aux = decodeLenient   "0000000000000000000000000000000000000000000000000000000000000001"---- e_msg = B16.decodeLenient "313233343030"--- e_sig = B16.decodeLenient "3045022100813ef79ccefa9a56f7ba805f0e478584fe5f0dd5f567bc09b5123ccbc983236502206ff18a52dcc0336f7af62400a6dd9b810732baf1ff758000d6f613a556eb31ba" 

@@ -6,6 +6,8 @@  import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16+import Data.Maybe (fromJust)+import Data.Word.Wider (Wider(..)) import Control.DeepSeq import qualified Crypto.Curve.Secp256k1 as S import qualified Weigh as W@@ -15,160 +17,146 @@ instance NFData S.ECDSA instance NFData S.Context -parse_int :: BS.ByteString -> Integer+decodeLenient :: BS.ByteString -> BS.ByteString+decodeLenient bs = case B16.decode bs of+  Nothing -> error "bang"+  Just b -> b++parse_int :: BS.ByteString -> Wider parse_int bs = case S.parse_int256 bs of   Nothing -> error "bang"   Just v -> v -big :: Integer-big = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed--tex :: S.Context-tex = S.precompute- -- note that 'weigh' doesn't work properly in a repl main :: IO () main = W.mainWith $ do-  remQ   parse_int256+  ge   add+  double   mul-  mul_unsafe   mul_wnaf   derive_pub   schnorr   ecdsa   ecdh -remQ :: W.Weigh ()-remQ = W.wgroup "remQ" $ do-  W.func "remQ 2" S.remQ 2-  W.func "remQ (2 ^ 255 - 19)" S.remQ big+ge :: W.Weigh ()+ge =+  let !t = 2+      !b = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed+  in  W.wgroup "ge" $ do+        W.func' "small" S.ge t+        W.func' "large" S.ge b  parse_int256 :: W.Weigh ()-parse_int256 = W.wgroup "parse_int256" $ do-  W.func' "parse_int (small)" parse_int (BS.replicate 32 0x00)-  W.func' "parse_int (big)" parse_int (BS.replicate 32 0xFF)+parse_int256 =+  let !a = BS.replicate 32 0x00+      !b = BS.replicate 32 0xFF+  in  W.wgroup "parse_int256" $ do+        W.func' "parse_int (small)" parse_int a+        W.func' "parse_int (big)" parse_int b  add :: W.Weigh ()-add = W.wgroup " add" $ do-  W.func "2 p (double, trivial projective point)" (S.add p) p-  W.func "2 r (double, nontrivial projective point)" (S.add r) r-  W.func "p + q (trivial projective points)" (S.add p) q-  W.func "p + s (nontrivial mixed points)" (S.add p) s-  W.func "s + r (nontrivial projective points)" (S.add s) r+add =+  let !p = fromJust . S.parse_point . decodeLenient $+        "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"+      !r = fromJust . S.parse_point . decodeLenient $+        "03a2113cf152585d96791a42cdd78782757fbfb5c6b2c11b59857eb4f7fda0b0e8"+      !q = fromJust . S.parse_point . decodeLenient $+        "02f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f9"+      !s = fromJust . S.parse_point . decodeLenient $+        "0306413898a49c93cccf3db6e9078c1b6a8e62568e4a4770e0d7d96792d1c580ad"+  in  W.wgroup "add" $ do+        W.func' "p + q (trivial projective points)" (S.add p) q+        W.func' "s + p (nontrivial mixed points)" (S.add s) p+        W.func' "r + s (nontrivial projective points)" (S.add r) s -mul :: W.Weigh ()-mul = W.wgroup "mul" $ do-  W.func "2 G" (S.mul S._CURVE_G) 2-  W.func "(2 ^ 255 - 19) G" (S.mul S._CURVE_G) big+double :: W.Weigh ()+double =+  let !p = fromJust . S.parse_point . decodeLenient $+        "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"+      !r = fromJust . S.parse_point . decodeLenient $+        "03a2113cf152585d96791a42cdd78782757fbfb5c6b2c11b59857eb4f7fda0b0e8"+  in  W.wgroup "double" $ do+        W.func' "2 p (double, trivial projective point)" S.double p+        W.func' "2 r (double, nontrivial projective point)" S.double r -mul_unsafe :: W.Weigh ()-mul_unsafe = W.wgroup "mul_unsafe" $ do-  W.func "2 G" (S.mul_unsafe S._CURVE_G) 2-  W.func "(2 ^ 255 - 19) G" (S.mul_unsafe S._CURVE_G) big+mul :: W.Weigh ()+mul =+  let !g = S._CURVE_G+      !t = 2+      !b = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed+  in  W.wgroup "mul" $ do+        W.func' "2 G" (S.mul g) t+        W.func' "(2 ^ 255 - 19) G" (S.mul g) b  mul_wnaf :: W.Weigh ()-mul_wnaf = W.wgroup "mul_wnaf" $ do-  W.value "precompute" S.precompute-  W.func "2 G" (S.mul_wnaf tex) 2-  W.func "(2 ^ 255 - 19) G" (S.mul_wnaf tex) big+mul_wnaf =+  let !t = 2+      !b = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed+      !con = S.precompute+  in  W.wgroup "mul_wnaf" $ do+        W.func' "precompute" S._precompute (8 :: Int)+        W.func' "2 G" (S.mul_wnaf con) t+        W.func' "(2 ^ 255 - 19) G" (S.mul_wnaf con) b  derive_pub :: W.Weigh ()-derive_pub = W.wgroup "derive_pub" $ do-  W.func "sk = 2" S.derive_pub 2-  W.func "sk = 2 ^ 255 - 19" S.derive_pub big-  W.func "wnaf, sk = 2" (S.derive_pub' tex) 2-  W.func "wnaf, sk = 2 ^ 255 - 19" (S.derive_pub' tex) big+derive_pub =+  let !t = 2+      !b = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed+      !con = S.precompute+  in  W.wgroup "derive_pub" $ do+        W.func' "sk = 2" S.derive_pub t+        W.func' "sk = 2 ^ 255 - 19" S.derive_pub b+        W.func' "wnaf, sk = 2" (S.derive_pub' con) t+        W.func' "wnaf, sk = 2 ^ 255 - 19" (S.derive_pub' con) b  schnorr :: W.Weigh ()-schnorr = W.wgroup "schnorr" $ do-  W.func "sign_schnorr (small)" (S.sign_schnorr 2 s_msg) s_aux-  W.func "sign_schnorr (large)" (S.sign_schnorr big s_msg) s_aux-  W.func "sign_schnorr' (small)" (S.sign_schnorr' tex 2 s_msg) s_aux-  W.func "sign_schnorr' (large)" (S.sign_schnorr' tex big s_msg) s_aux-  W.func "verify_schnorr" (S.verify_schnorr s_msg s_pk) s_sig-  W.func "verify_schnorr'" (S.verify_schnorr' tex s_msg s_pk) s_sig+schnorr =+  let !t = 2+      !b = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed+      !con   = S.precompute+      !s_msg = decodeLenient+        "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89"+      !s_aux = decodeLenient+        "0000000000000000000000000000000000000000000000000000000000000001"+      !s_sig = decodeLenient+        "6896BD60EEAE296DB48A229FF71DFE071BDE413E6D43F917DC8DCF8C78DE33418906D11AC976ABCCB20B091292BFF4EA897EFCB639EA871CFA95F6DE339E4B0A"+      !(Just !s_pk) = S.parse_point . decodeLenient $+        "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659"+  in  W.wgroup "schnorr" $ do+        W.func "sign_schnorr (small)" (S.sign_schnorr t s_msg) s_aux+        W.func "sign_schnorr (large)" (S.sign_schnorr b s_msg) s_aux+        W.func "sign_schnorr' (small)" (S.sign_schnorr' con t s_msg) s_aux+        W.func "sign_schnorr' (large)" (S.sign_schnorr' con b s_msg) s_aux+        W.func "verify_schnorr" (S.verify_schnorr s_msg s_pk) s_sig+        W.func "verify_schnorr'" (S.verify_schnorr' con s_msg s_pk) s_sig  ecdsa :: W.Weigh ()-ecdsa = W.wgroup "ecdsa" $ do-    W.func "sign_ecdsa (small)" (S.sign_ecdsa 2) s_msg-    W.func "sign_ecdsa (large)" (S.sign_ecdsa big) s_msg-    W.func "sign_ecdsa' (small)" (S.sign_ecdsa' tex 2) s_msg-    W.func "sign_ecdsa' (large)" (S.sign_ecdsa' tex big) s_msg-    W.func "verify_ecdsa" (S.verify_ecdsa msg pub) sig-    W.func "verify_ecdsa'" (S.verify_ecdsa' tex msg pub) sig-  where-    Just pub = S.derive_pub big-    msg = "i approve of this message"-    Just sig = S.sign_ecdsa big s_msg+ecdsa =+  let !t = 2+      !b = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed+      !con   = S.precompute+      !msg   = "i approve of this message"+      !s_msg = decodeLenient+        "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89"+      !(Just !pub) = S.derive_pub b+      !(Just !sig) = S.sign_ecdsa b s_msg+  in   W.wgroup "ecdsa" $ do+         W.func "sign_ecdsa (small)" (S.sign_ecdsa t) s_msg+         W.func "sign_ecdsa (large)" (S.sign_ecdsa b) s_msg+         W.func "sign_ecdsa' (small)" (S.sign_ecdsa' con t) s_msg+         W.func "sign_ecdsa' (large)" (S.sign_ecdsa' con b) s_msg+         W.func "verify_ecdsa" (S.verify_ecdsa msg pub) sig+         W.func "verify_ecdsa'" (S.verify_ecdsa' con msg pub) sig  ecdh :: W.Weigh ()-ecdh = W.wgroup "ecdh" $ do-    W.func "ecdh (small)" (S.ecdh pub) 2-    W.func "ecdh (large)" (S.ecdh pub) b-  where-    b = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed-    Just pub = S.parse_point . B16.decodeLenient $-      "bd02b9dfc8ef760708950bd972f2dc244893b61b6b46c3b19be1b2da7b034ac5"--s_sk :: Integer-s_sk = parse_int . B16.decodeLenient $-  "B7E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF"--s_sig :: BS.ByteString-s_sig = B16.decodeLenient "6896BD60EEAE296DB48A229FF71DFE071BDE413E6D43F917DC8DCF8C78DE33418906D11AC976ABCCB20B091292BFF4EA897EFCB639EA871CFA95F6DE339E4B0A"--s_pk_raw :: BS.ByteString-s_pk_raw = B16.decodeLenient-  "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659"--s_pk :: S.Projective-s_pk = case S.parse_point s_pk_raw of-  Nothing -> error "bang"-  Just !pt -> pt--s_msg :: BS.ByteString-s_msg = B16.decodeLenient-  "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89"--s_aux :: BS.ByteString-s_aux = B16.decodeLenient-  "0000000000000000000000000000000000000000000000000000000000000001"--p_bs :: BS.ByteString-p_bs = B16.decodeLenient-  "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"--p :: S.Projective-p = case S.parse_point p_bs of-  Nothing -> error "bang"-  Just !pt -> pt--q_bs :: BS.ByteString-q_bs = B16.decodeLenient-  "02f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f9"--q :: S.Projective-q = case S.parse_point q_bs of-  Nothing -> error "bang"-  Just !pt -> pt--r_bs :: BS.ByteString-r_bs = B16.decodeLenient-  "03a2113cf152585d96791a42cdd78782757fbfb5c6b2c11b59857eb4f7fda0b0e8"--r :: S.Projective-r = case S.parse_point r_bs of-  Nothing -> error "bang"-  Just !pt -> pt--s_bs :: BS.ByteString-s_bs = B16.decodeLenient-  "0306413898a49c93cccf3db6e9078c1b6a8e62568e4a4770e0d7d96792d1c580ad"--s :: S.Projective-s = case S.parse_point s_bs of-  Nothing -> error "bang"-  Just !pt -> pt+ecdh =+  let !b = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed+      !(Just !pub) = S.parse_point . decodeLenient $+        "bd02b9dfc8ef760708950bd972f2dc244893b61b6b46c3b19be1b2da7b034ac5"+  in  W.wgroup "ecdh" $ do+        W.func "ecdh (small)" (S.ecdh pub) 2+        W.func "ecdh (large)" (S.ecdh pub) b 

@@ -2,1254 +2,1367 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE UnboxedSums #-}-{-# LANGUAGE ViewPatterns #-}---- |--- Module: Crypto.Curve.Secp256k1--- Copyright: (c) 2024 Jared Tobin--- License: MIT--- Maintainer: Jared Tobin <jared@ppad.tech>------ Pure [BIP0340](https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki)--- Schnorr signatures, deterministic--- [RFC6979](https://www.rfc-editor.org/rfc/rfc6979) ECDSA (with--- [BIP0146](https://github.com/bitcoin/bips/blob/master/bip-0146.mediawiki)-style--- "low-S" signatures), and ECDH shared secret computation---  on the elliptic curve secp256k1.--module Crypto.Curve.Secp256k1 (-  -- * Field and group parameters-    _CURVE_Q-  , _CURVE_P-  , remQ-  , modQ--  -- * secp256k1 points-  , Pub-  , derive_pub-  , derive_pub'-  , _CURVE_G-  , _CURVE_ZERO--  -- * Parsing-  , parse_int256-  , parse_point-  , parse_sig--  -- * Serializing-  , serialize_point--  -- * ECDH-  , ecdh--  -- * BIP0340 Schnorr signatures-  , sign_schnorr-  , verify_schnorr--  -- * RFC6979 ECDSA-  , ECDSA(..)-  , SigType(..)-  , sign_ecdsa-  , sign_ecdsa_unrestricted-  , verify_ecdsa-  , verify_ecdsa_unrestricted--  -- * Fast variants-  , Context-  , precompute-  , sign_schnorr'-  , verify_schnorr'-  , sign_ecdsa'-  , sign_ecdsa_unrestricted'-  , verify_ecdsa'-  , verify_ecdsa_unrestricted'--  -- Elliptic curve group operations-  , neg-  , add-  , double-  , mul-  , mul_unsafe-  , mul_wnaf--  -- Coordinate systems and transformations-  , Affine(..)-  , Projective(..)-  , affine-  , projective-  , valid--  -- for testing/benchmarking-  , _sign_ecdsa_no_hash-  , _sign_ecdsa_no_hash'-  ) where--import Control.Monad (guard, when)-import Control.Monad.ST-import qualified Crypto.DRBG.HMAC as DRBG-import qualified Crypto.Hash.SHA256 as SHA256-import Data.Bits ((.|.))-import qualified Data.Bits as B-import qualified Data.ByteString as BS-import qualified Data.ByteString.Unsafe as BU-import qualified Data.Maybe as M (isJust)-import qualified Data.Primitive.Array as A-import Data.STRef-import Data.Word (Word8, Word64)-import GHC.Generics-import GHC.Natural-import qualified GHC.Num.Integer as I---- note the use of GHC.Num.Integer-qualified functions throughout this--- module; in some cases explicit use of these functions (especially--- I.integerPowMod# and I.integerRecipMod#) yields tremendous speedups--- compared to more general versions---- keystroke savers & other utilities -------------------------------------------fi :: (Integral a, Num b) => a -> b-fi = fromIntegral-{-# INLINE fi #-}---- generic modular exponentiation--- b ^ e mod m-modexp :: Integer -> Natural -> Natural -> Integer-modexp b (fi -> e) m = case I.integerPowMod# b e m of-  (# fi -> n | #) -> n-  (# | _ #) -> error "ppad-secp256k1 (modexp): internal error"-{-# INLINE modexp #-}---- generic modular inverse--- for a, m return x such that ax = 1 mod m-modinv :: Integer -> Natural -> Maybe Integer-modinv a m = case I.integerRecipMod# a m of-  (# fi -> n | #) -> Just $! n-  (# | _ #) -> Nothing-{-# INLINE modinv #-}---- bytewise xor-xor :: BS.ByteString -> BS.ByteString -> BS.ByteString-xor = BS.packZipWith B.xor---- arbitrary-size big-endian bytestring decoding-roll :: BS.ByteString -> Integer-roll = BS.foldl' alg 0 where-  alg !a (fi -> !b) = (a `I.integerShiftL` 8) `I.integerOr` b---- /Note:/ there can be substantial differences in execution time--- when this function is called with "extreme" inputs. For example: a--- bytestring consisting entirely of 0x00 bytes will parse more quickly--- than one consisting of entirely 0xFF bytes. For appropriately-random--- inputs, timings should be indistinguishable.------ 256-bit big-endian bytestring decoding. the input size is not checked!-roll32 :: BS.ByteString -> Integer-roll32 bs = go (0 :: Word64) (0 :: Word64) (0 :: Word64) (0 :: Word64) 0 where-  go !acc0 !acc1 !acc2 !acc3 !j-    | j == 32  =-            (fi acc0 `B.unsafeShiftL` 192)-        .|. (fi acc1 `B.unsafeShiftL` 128)-        .|. (fi acc2 `B.unsafeShiftL` 64)-        .|. fi acc3-    | j < 8    =-        let b = fi (BU.unsafeIndex bs j)-        in  go ((acc0 `B.unsafeShiftL` 8) .|. b) acc1 acc2 acc3 (j + 1)-    | j < 16   =-        let b = fi (BU.unsafeIndex bs j)-        in go acc0 ((acc1 `B.unsafeShiftL` 8) .|. b) acc2 acc3 (j + 1)-    | j < 24   =-        let b = fi (BU.unsafeIndex bs j)-        in go acc0 acc1 ((acc2 `B.unsafeShiftL` 8) .|. b) acc3 (j + 1)-    | otherwise =-        let b = fi (BU.unsafeIndex bs j)-        in go acc0 acc1 acc2 ((acc3 `B.unsafeShiftL` 8) .|. b) (j + 1)-{-# INLINE roll32 #-}---- this "looks" inefficient due to the call to reverse, but it's--- actually really fast---- big-endian bytestring encoding-unroll :: Integer -> BS.ByteString-unroll i = case i of-    0 -> BS.singleton 0-    _ -> BS.reverse $ BS.unfoldr step i-  where-    step 0 = Nothing-    step m = Just (fi m, m `I.integerShiftR` 8)---- big-endian bytestring encoding for 256-bit ints, left-padding with--- zeros if necessary. the size of the integer is not checked.-unroll32 :: Integer -> BS.ByteString-unroll32 (unroll -> u)-    | l < 32 = BS.replicate (32 - l) 0 <> u-    | otherwise = u-  where-    l = BS.length u---- (bip0340) return point with x coordinate == x and with even y coordinate-lift :: Integer -> Maybe Affine-lift x = do-  guard (fe x)-  let c = remP (modexp x 3 (fi _CURVE_P) + 7) -- modexp always nonnegative-      e = (_CURVE_P + 1) `I.integerQuot` 4-      y = modexp c (fi e) (fi _CURVE_P)-      y_p | B.testBit y 0 = _CURVE_P - y-          | otherwise = y-  guard (c == modexp y 2 (fi _CURVE_P))-  pure $! Affine x y_p---- coordinate systems & transformations ------------------------------------------- curve point, affine coordinates-data Affine = Affine !Integer !Integer-  deriving stock (Show, Generic)--instance Eq Affine where-  Affine x1 y1 == Affine x2 y2 =-    modP x1 == modP x2 && modP y1 == modP y2---- curve point, projective coordinates-data Projective = Projective {-    px :: !Integer-  , py :: !Integer-  , pz :: !Integer-  }-  deriving stock (Show, Generic)--instance Eq Projective where-  Projective ax ay az == Projective bx by bz =-    let x1z2 = modP (ax * bz)-        x2z1 = modP (bx * az)-        y1z2 = modP (ay * bz)-        y2z1 = modP (by * az)-    in  x1z2 == x2z1 && y1z2 == y2z1---- | A Schnorr and ECDSA-flavoured alias for a secp256k1 point.-type Pub = Projective---- Convert to affine coordinates.-affine :: Projective -> Affine-affine p@(Projective x y z)-  | p == _CURVE_ZERO = Affine 0 0-  | z == 1     = Affine x y-  | otherwise  = case modinv z (fi _CURVE_P) of-      Nothing -> error "ppad-secp256k1 (affine): internal error"-      Just iz -> Affine (modP (x * iz)) (modP (y * iz))---- Convert to projective coordinates.-projective :: Affine -> Projective-projective (Affine x y)-  | x == 0 && y == 0 = _CURVE_ZERO-  | otherwise = Projective x y 1---- Point is valid-valid :: Projective -> Bool-valid p = case affine p of-  Affine x y-    | not (fe x) || not (fe y) -> False-    | modP (y * y) /= weierstrass x -> False-    | otherwise -> True---- curve parameters -------------------------------------------------------------- see https://www.secg.org/sec2-v2.pdf for parameter specs---- ~ 2^256 - 2^32 - 2^9 - 2^8 - 2^7 - 2^6 - 2^4 - 1---- | secp256k1 field prime.-_CURVE_P :: Integer-_CURVE_P = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F---- | secp256k1 group order.-_CURVE_Q :: Integer-_CURVE_Q = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141---- bitlength of group order------ = smallest integer such that _CURVE_Q < 2 ^ _CURVE_Q_BITS-_CURVE_Q_BITS :: Int-_CURVE_Q_BITS = 256---- bytelength of _CURVE_Q------ = _CURVE_Q_BITS / 8-_CURVE_Q_BYTES :: Int-_CURVE_Q_BYTES = 32---- secp256k1 short weierstrass form, /a/ coefficient-_CURVE_A :: Integer-_CURVE_A = 0---- secp256k1 weierstrass form, /b/ coefficient-_CURVE_B :: Integer-_CURVE_B = 7---- ~ parse_point . B16.decode $---     "0279BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798"---- | secp256k1 generator point.-_CURVE_G :: Projective-_CURVE_G = Projective x y 1 where-  x = 0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798-  y = 0x483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8---- | secp256k1 zero point, point at infinity, or monoidal identity.-_CURVE_ZERO :: Projective-_CURVE_ZERO = Projective 0 1 0---- secp256k1 zero point, point at infinity, or monoidal identity-_ZERO :: Projective-_ZERO = Projective 0 1 0-{-# DEPRECATED _ZERO "use _CURVE_ZERO instead" #-}---- secp256k1 in prime order j-invariant 0 form (i.e. a == 0).-weierstrass :: Integer -> Integer-weierstrass x = remP (remP (x * x) * x + _CURVE_B)-{-# INLINE weierstrass #-}---- field, group operations -------------------------------------------------------- Division modulo secp256k1 field prime.-modP :: Integer -> Integer-modP a = I.integerMod a _CURVE_P-{-# INLINE modP #-}---- Division modulo secp256k1 field prime, when argument is nonnegative.--- (more efficient than modP)-remP :: Integer -> Integer-remP a = I.integerRem a _CURVE_P-{-# INLINE remP #-}---- | Division modulo secp256k1 group order.-modQ :: Integer -> Integer-modQ a = I.integerMod a _CURVE_Q-{-# INLINE modQ #-}---- | Division modulo secp256k1 group order, when argument is nonnegative.-remQ :: Integer -> Integer-remQ a = I.integerRem a _CURVE_Q-{-# INLINE remQ #-}---- Is field element?-fe :: Integer -> Bool-fe n = 0 < n && n < _CURVE_P-{-# INLINE fe #-}---- Is group element?-ge :: Integer -> Bool-ge n = 0 < n && n < _CURVE_Q-{-# INLINE ge #-}---- Square root (Shanks-Tonelli) modulo secp256k1 field prime.------ For a, return x such that a = x x mod _CURVE_P.-modsqrtP :: Integer -> Maybe Integer-modsqrtP n = runST $ do-  r   <- newSTRef 1-  num <- newSTRef n-  e   <- newSTRef ((_CURVE_P + 1) `I.integerQuot` 4)--  let loop = do-        ev <- readSTRef e-        when (ev > 0) $ do-          when (I.integerTestBit ev 0) $ do-            numv <- readSTRef num-            modifySTRef' r (\rv -> remP (rv * numv))-          modifySTRef' num (\numv -> remP (numv * numv))-          modifySTRef' e (`I.integerShiftR` 1)-          loop--  loop-  rv  <- readSTRef r--  pure $ do-    guard (remP (rv * rv) == n)-    Just $! rv---- ec point operations ------------------------------------------------------------ Negate secp256k1 point.-neg :: Projective -> Projective-neg (Projective x y z) = Projective x (modP (negate y)) z---- Elliptic curve addition on secp256k1.-add :: Projective -> Projective -> Projective-add p q@(Projective _ _ z)-  | p == q = double p        -- algo 9-  | z == 1 = add_mixed p q   -- algo 8-  | otherwise = add_proj p q -- algo 7---- algo 7, "complete addition formulas for prime order elliptic curves,"--- renes et al, 2015------ https://eprint.iacr.org/2015/1060.pdf-add_proj :: Projective -> Projective -> Projective-add_proj (Projective x1 y1 z1) (Projective x2 y2 z2) = runST $ do-  x3 <- newSTRef 0-  y3 <- newSTRef 0-  z3 <- newSTRef 0-  let b3 = remP (_CURVE_B * 3)-  t0 <- newSTRef (modP (x1 * x2)) -- 1-  t1 <- newSTRef (modP (y1 * y2))-  t2 <- newSTRef (modP (z1 * z2))-  t3 <- newSTRef (modP (x1 + y1)) -- 4-  t4 <- newSTRef (modP (x2 + y2))-  readSTRef t4 >>= \r4 ->-    modifySTRef' t3 (\r3 -> modP (r3 * r4))-  readSTRef t0 >>= \r0 ->-    readSTRef t1 >>= \r1 ->-    writeSTRef t4 (modP (r0 + r1))-  readSTRef t4 >>= \r4 ->-    modifySTRef' t3 (\r3 -> modP (r3 - r4)) -- 8-  writeSTRef t4 (modP (y1 + z1))-  writeSTRef x3 (modP (y2 + z2))-  readSTRef x3 >>= \rx3 ->-    modifySTRef' t4 (\r4 -> modP (r4 * rx3))-  readSTRef t1 >>= \r1 ->-    readSTRef t2 >>= \r2 ->-    writeSTRef x3 (modP (r1 + r2)) -- 12-  readSTRef x3 >>= \rx3 ->-    modifySTRef' t4 (\r4 -> modP (r4 - rx3))-  writeSTRef x3 (modP (x1 + z1))-  writeSTRef y3 (modP (x2 + z2))-  readSTRef y3 >>= \ry3 ->-    modifySTRef' x3 (\rx3 -> modP (rx3 * ry3)) -- 16-  readSTRef t0 >>= \r0 ->-    readSTRef t2 >>= \r2 ->-    writeSTRef y3 (modP (r0 + r2))-  readSTRef x3 >>= \rx3 ->-    modifySTRef' y3 (\ry3 -> modP (rx3 - ry3))-  readSTRef t0 >>= \r0 ->-    writeSTRef x3 (modP (r0 + r0))-  readSTRef x3 >>= \rx3 ->-    modifySTRef t0 (\r0 -> modP (rx3 + r0)) -- 20-  modifySTRef' t2 (\r2 -> modP (b3 * r2))-  readSTRef t1 >>= \r1 ->-    readSTRef t2 >>= \r2 ->-    writeSTRef z3 (modP (r1 + r2))-  readSTRef t2 >>= \r2 ->-    modifySTRef' t1 (\r1 -> modP (r1 - r2))-  modifySTRef' y3 (\ry3 -> modP (b3 * ry3)) -- 24-  readSTRef t4 >>= \r4 ->-    readSTRef y3 >>= \ry3 ->-    writeSTRef x3 (modP (r4 * ry3))-  readSTRef t3 >>= \r3 ->-    readSTRef t1 >>= \r1 ->-    writeSTRef t2 (modP (r3 * r1))-  readSTRef t2 >>= \r2 ->-    modifySTRef' x3 (\rx3 -> modP (r2 - rx3))-  readSTRef t0 >>= \r0 ->-    modifySTRef' y3 (\ry3 -> modP (ry3 * r0)) -- 28-  readSTRef z3 >>= \rz3 ->-    modifySTRef' t1 (\r1 -> modP (r1 * rz3))-  readSTRef t1 >>= \r1 ->-    modifySTRef' y3 (\ry3 -> modP (r1 + ry3))-  readSTRef t3 >>= \r3 ->-    modifySTRef' t0 (\r0 -> modP (r0 * r3))-  readSTRef t4 >>= \r4 ->-    modifySTRef' z3 (\rz3 -> modP (rz3 * r4)) -- 32-  readSTRef t0 >>= \r0 ->-    modifySTRef' z3 (\rz3 -> modP (rz3 + r0))-  Projective <$> readSTRef x3 <*> readSTRef y3 <*> readSTRef z3---- algo 8, renes et al, 2015-add_mixed :: Projective -> Projective -> Projective-add_mixed (Projective x1 y1 z1) (Projective x2 y2 z2)-  | z2 /= 1   = error "ppad-secp256k1 (add_mixed): internal error"-  | otherwise = runST $ do-      x3 <- newSTRef 0-      y3 <- newSTRef 0-      z3 <- newSTRef 0-      let b3 = remP (_CURVE_B * 3)-      t0 <- newSTRef (modP (x1 * x2)) -- 1-      t1 <- newSTRef (modP (y1 * y2))-      t3 <- newSTRef (modP (x2 + y2))-      t4 <- newSTRef (modP (x1 + y1)) -- 4-      readSTRef t4 >>= \r4 ->-        modifySTRef' t3 (\r3 -> modP (r3 * r4))-      readSTRef t0 >>= \r0 ->-        readSTRef t1 >>= \r1 ->-        writeSTRef t4 (modP (r0 + r1))-      readSTRef t4 >>= \r4 ->-        modifySTRef' t3 (\r3 -> modP (r3 - r4)) -- 7-      writeSTRef t4 (modP (y2 * z1))-      modifySTRef' t4 (\r4 -> modP (r4 + y1))-      writeSTRef y3 (modP (x2 * z1)) -- 10-      modifySTRef' y3 (\ry3 -> modP (ry3 + x1))-      readSTRef t0 >>= \r0 ->-        writeSTRef x3 (modP (r0 + r0))-      readSTRef x3 >>= \rx3 ->-        modifySTRef' t0 (\r0 -> modP (rx3 + r0)) -- 13-      t2 <- newSTRef (modP (b3 * z1))-      readSTRef t1 >>= \r1 ->-        readSTRef t2 >>= \r2 ->-        writeSTRef z3 (modP (r1 + r2))-      readSTRef t2 >>= \r2 ->-        modifySTRef' t1 (\r1 -> modP (r1 - r2)) -- 16-      modifySTRef' y3 (\ry3 -> modP (b3 * ry3))-      readSTRef t4 >>= \r4 ->-        readSTRef y3 >>= \ry3 ->-        writeSTRef x3 (modP (r4 * ry3))-      readSTRef t3 >>= \r3 ->-        readSTRef t1 >>= \r1 ->-        writeSTRef t2 (modP (r3 * r1)) -- 19-      readSTRef t2 >>= \r2 ->-        modifySTRef' x3 (\rx3 -> modP (r2 - rx3))-      readSTRef t0 >>= \r0 ->-        modifySTRef' y3 (\ry3 -> modP (ry3 * r0))-      readSTRef z3 >>= \rz3 ->-        modifySTRef' t1 (\r1 -> modP (r1 * rz3)) -- 22-      readSTRef t1 >>= \r1 ->-        modifySTRef' y3 (\ry3 -> modP (r1 + ry3))-      readSTRef t3 >>= \r3 ->-        modifySTRef' t0 (\r0 -> modP (r0 * r3))-      readSTRef t4 >>= \r4 ->-        modifySTRef' z3 (\rz3 -> modP (rz3 * r4)) -- 25-      readSTRef t0 >>= \r0 ->-        modifySTRef' z3 (\rz3 -> modP (rz3 + r0))-      Projective <$> readSTRef x3 <*> readSTRef y3 <*> readSTRef z3---- algo 9, renes et al, 2015-double :: Projective -> Projective-double (Projective x y z) = runST $ do-  x3 <- newSTRef 0-  y3 <- newSTRef 0-  z3 <- newSTRef 0-  let b3 = remP (_CURVE_B * 3)-  t0 <- newSTRef (modP (y * y)) -- 1-  readSTRef t0 >>= \r0 ->-    writeSTRef z3 (modP (r0 + r0))-  modifySTRef' z3 (\rz3 -> modP (rz3 + rz3))-  modifySTRef' z3 (\rz3 -> modP (rz3 + rz3)) -- 4-  t1 <- newSTRef (modP (y * z))-  t2 <- newSTRef (modP (z * z))-  modifySTRef t2 (\r2 -> modP (b3 * r2)) -- 7-  readSTRef z3 >>= \rz3 ->-    readSTRef t2 >>= \r2 ->-    writeSTRef x3 (modP (r2 * rz3))-  readSTRef t0 >>= \r0 ->-    readSTRef t2 >>= \r2 ->-    writeSTRef y3 (modP (r0 + r2))-  readSTRef t1 >>= \r1 ->-    modifySTRef' z3 (\rz3 -> modP (r1 * rz3)) -- 10-  readSTRef t2 >>= \r2 ->-    writeSTRef t1 (modP (r2 + r2))-  readSTRef t1 >>= \r1 ->-    modifySTRef' t2 (\r2 -> modP (r1 + r2))-  readSTRef t2 >>= \r2 ->-    modifySTRef' t0 (\r0 -> modP (r0 - r2)) -- 13-  readSTRef t0 >>= \r0 ->-    modifySTRef' y3 (\ry3 -> modP (r0 * ry3))-  readSTRef x3 >>= \rx3 ->-    modifySTRef' y3 (\ry3 -> modP (rx3 + ry3))-  writeSTRef t1 (modP (x * y)) -- 16-  readSTRef t0 >>= \r0 ->-    readSTRef t1 >>= \r1 ->-    writeSTRef x3 (modP (r0 * r1))-  modifySTRef' x3 (\rx3 -> modP (rx3 + rx3))-  Projective <$> readSTRef x3 <*> readSTRef y3 <*> readSTRef z3---- Timing-safe scalar multiplication of secp256k1 points.-mul :: Projective -> Integer -> Maybe Projective-mul p _SECRET = do-    guard (ge _SECRET)-    pure $! loop (0 :: Int) _CURVE_ZERO _CURVE_G p _SECRET-  where-    loop !j !acc !f !d !m-      | j == _CURVE_Q_BITS = acc-      | otherwise =-          let nd = double d-              nm = I.integerShiftR m 1-          in  if   I.integerTestBit m 0-              then loop (succ j) (add acc d) f nd nm-              else loop (succ j) acc (add f d) nd nm-{-# INLINE mul #-}---- Timing-unsafe scalar multiplication of secp256k1 points.------ Don't use this function if the scalar could potentially be a secret.-mul_unsafe :: Projective -> Integer -> Maybe Projective-mul_unsafe p n-    | n == 0 = pure $! _CURVE_ZERO-    | not (ge n) = Nothing-    | otherwise  = pure $! loop _CURVE_ZERO p n-  where-    loop !r !d m-      | m <= 0 = r-      | otherwise =-          let nd = double d-              nm = I.integerShiftR m 1-              nr = if I.integerTestBit m 0 then add r d else r-          in  loop nr nd nm---- | Precomputed multiples of the secp256k1 base or generator point.-data Context = Context {-    ctxW     :: {-# UNPACK #-} !Int-  , ctxArray :: !(A.Array Projective)-  } deriving (Eq, Generic)--instance Show Context where-  show Context {} = "<secp256k1 context>"---- | Create a secp256k1 context by precomputing multiples of the curve's---   generator point.------   This should be used once to create a 'Context' to be reused---   repeatedly afterwards.------   >>> let !tex = precompute---   >>> sign_ecdsa' tex sec msg---   >>> sign_schnorr' tex sec msg aux-precompute :: Context-precompute = _precompute 8---- dumb strict pair-data Pair a b = Pair !a !b---- translation of noble-secp256k1's 'precompute'-_precompute :: Int -> Context-_precompute ctxW = Context {..} where-  ctxArray = A.arrayFromListN size (loop_w mempty _CURVE_G 0)-  capJ = (2 :: Int) ^ (ctxW - 1)-  ws = 256 `quot` ctxW + 1-  size = ws * capJ--  loop_w !acc !p !w-    | w == ws = reverse acc-    | otherwise =-        let b = p-            !(Pair nacc nb) = loop_j p (b : acc) b 1-            np = double nb-        in  loop_w nacc np (succ w)--  loop_j !p !acc !b !j-    | j == capJ = Pair acc b-    | otherwise =-        let nb = add b p-        in  loop_j p (nb : acc) nb (succ j)---- Timing-safe wNAF (w-ary non-adjacent form) scalar multiplication of--- secp256k1 points.-mul_wnaf :: Context -> Integer -> Maybe Projective-mul_wnaf Context {..} _SECRET = do-    guard (ge _SECRET)-    pure $! loop 0 _CURVE_ZERO _CURVE_G _SECRET-  where-    wins = 256 `quot` ctxW + 1-    wsize = 2 ^ (ctxW - 1)-    mask = 2 ^ ctxW - 1-    mnum = 2 ^ ctxW--    loop !w !acc !f !n-      | w == wins = acc-      | otherwise =-          let !off0 = w * fi wsize--              !b0 = n `I.integerAnd` mask-              !n0 = n `I.integerShiftR` fi ctxW--              !(Pair b1 n1) | b0 > wsize = Pair (b0 - mnum) (n0 + 1)-                            | otherwise  = Pair b0 n0--              !c0 = B.testBit w 0-              !c1 = b1 < 0--              !off1 = off0 + fi (abs b1) - 1--          in  if   b1 == 0-              then let !pr = A.indexArray ctxArray off0-                       !pt | c0 = neg pr-                           | otherwise = pr-                   in  loop (w + 1) acc (add f pt) n1-              else let !pr = A.indexArray ctxArray off1-                       !pt | c1 = neg pr-                           | otherwise = pr-                   in  loop (w + 1) (add acc pt) f n1-{-# INLINE mul_wnaf #-}---- | Derive a public key (i.e., a secp256k1 point) from the provided---   secret.------   >>> import qualified System.Entropy as E---   >>> sk <- fmap parse_int256 (E.getEntropy 32)---   >>> derive_pub sk---   Just "<secp256k1 point>"-derive_pub :: Integer -> Maybe Pub-derive_pub = mul _CURVE_G-{-# NOINLINE derive_pub #-}---- | The same as 'derive_pub', except uses a 'Context' to optimise---   internal calculations.------   >>> import qualified System.Entropy as E---   >>> sk <- fmap parse_int256 (E.getEntropy 32)---   >>> let !tex = precompute---   >>> derive_pub' tex sk---   Just "<secp256k1 point>"-derive_pub' :: Context -> Integer -> Maybe Pub-derive_pub' = mul_wnaf-{-# NOINLINE derive_pub' #-}---- parsing ------------------------------------------------------------------------ | Parse a positive 256-bit 'Integer', /e.g./ a Schnorr or ECDSA---   secret key.------   >>> import qualified Data.ByteString as BS---   >>> parse_int256 (BS.replicate 32 0xFF)---   Just <2^256 - 1>-parse_int256 :: BS.ByteString -> Maybe Integer-parse_int256 bs = do-  guard (BS.length bs == 32)-  pure $! roll32 bs---- | Parse compressed secp256k1 point (33 bytes), uncompressed point (65---   bytes), or BIP0340-style point (32 bytes).------   >>> parse_point <33-byte compressed point>---   Just <Pub>---   >>> parse_point <65-byte uncompressed point>---   Just <Pub>---   >>> parse_point <32-byte bip0340 public key>---   Just <Pub>---   >>> parse_point <anything else>---   Nothing-parse_point :: BS.ByteString -> Maybe Projective-parse_point bs-    | len == 32 = _parse_bip0340 bs-    | len == 33 = _parse_compressed h t-    | len == 65 = _parse_uncompressed h t-    | otherwise = Nothing-  where-    len = BS.length bs-    h = BU.unsafeIndex bs 0 -- lazy-    t = BS.drop 1 bs---- input is guaranteed to be 32B in length-_parse_bip0340 :: BS.ByteString -> Maybe Projective-_parse_bip0340 = fmap projective . lift . roll32---- bytestring input is guaranteed to be 32B in length-_parse_compressed :: Word8 -> BS.ByteString -> Maybe Projective-_parse_compressed h (roll32 -> x)-  | h /= 0x02 && h /= 0x03 = Nothing-  | not (fe x) = Nothing-  | otherwise = do-      y <- modsqrtP (weierstrass x)-      let yodd = I.integerTestBit y 0-          hodd = B.testBit h 0-      pure $!-        if   hodd /= yodd-        then Projective x (modP (negate y)) 1-        else Projective x y 1---- bytestring input is guaranteed to be 64B in length-_parse_uncompressed :: Word8 -> BS.ByteString -> Maybe Projective-_parse_uncompressed h (BS.splitAt _CURVE_Q_BYTES -> (roll32 -> x, roll32 -> y))-  | h /= 0x04 = Nothing-  | otherwise = do-      let p = Projective x y 1-      guard (valid p)-      pure $! p---- | Parse an ECDSA signature encoded in 64-byte "compact" form.------   >>> parse_sig <64-byte compact signature>---   Just "<ecdsa signature>"-parse_sig :: BS.ByteString -> Maybe ECDSA-parse_sig bs-  | BS.length bs /= 64 = Nothing-  | otherwise = pure $-      let (roll -> r, roll -> s) = BS.splitAt 32 bs-      in  ECDSA r s---- serializing -------------------------------------------------------------------- | Serialize a secp256k1 point in 33-byte compressed form.------   >>> serialize_point pub---   "<33-byte compressed point>"-serialize_point :: Projective -> BS.ByteString-serialize_point (affine -> Affine x y) = BS.cons b (unroll32 x) where-  b | I.integerTestBit y 0 = 0x03-    | otherwise = 0x02---- schnorr ----------------------------------------------------------------------- see https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki---- | Create a 64-byte Schnorr signature for the provided message, using---   the provided secret key.------   BIP0340 recommends that 32 bytes of fresh auxiliary entropy be---   generated and added at signing time as additional protection---   against side-channel attacks (namely, to thwart so-called "fault---   injection" attacks). This entropy is /supplemental/ to security,---   and the cryptographic security of the signature scheme itself does---   not rely on it, so it is not strictly required; 32 zero bytes can---   be used in its stead (and can be supplied via 'mempty').------   >>> import qualified System.Entropy as E---   >>> aux <- E.getEntropy 32---   >>> sign_schnorr sec msg aux---   Just "<64-byte schnorr signature>"-sign_schnorr-  :: Integer        -- ^ secret key-  -> BS.ByteString  -- ^ message-  -> BS.ByteString  -- ^ 32 bytes of auxilliary random data-  -> Maybe BS.ByteString  -- ^ 64-byte Schnorr signature-sign_schnorr = _sign_schnorr (mul _CURVE_G)---- | The same as 'sign_schnorr', except uses a 'Context' to optimise---   internal calculations.------   You can expect about a 2x performance increase when using this---   function, compared to 'sign_schnorr'.------   >>> import qualified System.Entropy as E---   >>> aux <- E.getEntropy 32---   >>> let !tex = precompute---   >>> sign_schnorr' tex sec msg aux---   Just "<64-byte schnorr signature>"-sign_schnorr'-  :: Context        -- ^ secp256k1 context-  -> Integer        -- ^ secret key-  -> BS.ByteString  -- ^ message-  -> BS.ByteString  -- ^ 32 bytes of auxilliary random data-  -> Maybe BS.ByteString  -- ^ 64-byte Schnorr signature-sign_schnorr' tex = _sign_schnorr (mul_wnaf tex)--_sign_schnorr-  :: (Integer -> Maybe Projective)  -- partially-applied multiplication function-  -> Integer                  -- secret key-  -> BS.ByteString            -- message-  -> BS.ByteString            -- 32 bytes of auxilliary random data-  -> Maybe BS.ByteString-_sign_schnorr _mul _SECRET m a = do-  p_proj <- _mul _SECRET-  let Affine x_p y_p = affine p_proj-      d | I.integerTestBit y_p 0 = _CURVE_Q - _SECRET-        | otherwise = _SECRET--      bytes_d = unroll32 d-      h_a = hash_aux a-      t = xor bytes_d h_a--      bytes_p = unroll32 x_p-      rand = hash_nonce (t <> bytes_p <> m)--      k' = modQ (roll32 rand)--  if   k' == 0 -- negligible probability-  then Nothing -- XX handle me-  else do-    pt <- _mul k'-    let Affine x_r y_r = affine pt-        k | I.integerTestBit y_r 0 = _CURVE_Q - k'-          | otherwise = k'--        bytes_r = unroll32 x_r-        e = modQ . roll32 . hash_challenge-          $ bytes_r <> bytes_p <> m--        bytes_ked = unroll32 (modQ (k + e * d))--        sig = bytes_r <> bytes_ked--    guard (verify_schnorr m p_proj sig)-    pure $! sig-{-# INLINE _sign_schnorr #-}---- | Verify a 64-byte Schnorr signature for the provided message with---   the supplied public key.------   >>> verify_schnorr msg pub <valid signature>---   True---   >>> verify_schnorr msg pub <invalid signature>---   False-verify_schnorr-  :: BS.ByteString  -- ^ message-  -> Pub            -- ^ public key-  -> BS.ByteString  -- ^ 64-byte Schnorr signature-  -> Bool-verify_schnorr = _verify_schnorr (mul_unsafe _CURVE_G)---- | The same as 'verify_schnorr', except uses a 'Context' to optimise---   internal calculations.------   You can expect about a 1.5x performance increase when using this---   function, compared to 'verify_schnorr'.------   >>> let !tex = precompute---   >>> verify_schnorr' tex msg pub <valid signature>---   True---   >>> verify_schnorr' tex msg pub <invalid signature>---   False-verify_schnorr'-  :: Context        -- ^ secp256k1 context-  -> BS.ByteString  -- ^ message-  -> Pub            -- ^ public key-  -> BS.ByteString  -- ^ 64-byte Schnorr signature-  -> Bool-verify_schnorr' tex = _verify_schnorr (mul_wnaf tex)--_verify_schnorr-  :: (Integer -> Maybe Projective) -- partially-applied multiplication function-  -> BS.ByteString-  -> Pub-  -> BS.ByteString-  -> Bool-_verify_schnorr _mul m (affine -> Affine x_p _) sig-  | BS.length sig /= 64 = False-  | otherwise = M.isJust $ do-      capP@(Affine x_P _) <- lift x_p-      let (roll32 -> r, roll32 -> s) = BS.splitAt 32 sig-      guard (r < _CURVE_P && s < _CURVE_Q)-      let e = modQ . roll32 $ hash_challenge-                (unroll32 r <> unroll32 x_P <> m)-      pt0 <- _mul s-      pt1 <- mul_unsafe (projective capP) e-      let dif = add pt0 (neg pt1)-      guard (dif /= _CURVE_ZERO)-      let Affine x_R y_R = affine dif-      guard $ not (I.integerTestBit y_R 0 || x_R /= r)-      pure ()-{-# INLINE _verify_schnorr #-}---- hardcoded tag of BIP0340/aux------ \x -> let h = SHA256.hash "BIP0340/aux"---       in  SHA256.hash (h <> h <> x)-hash_aux :: BS.ByteString -> BS.ByteString-hash_aux x = SHA256.hash $-  "\241\239N^\192c\202\218m\148\202\250\157\152~\160i&X9\236\193\US\151-w\165.\216\193\204\144\241\239N^\192c\202\218m\148\202\250\157\152~\160i&X9\236\193\US\151-w\165.\216\193\204\144" <> x-{-# INLINE hash_aux #-}---- hardcoded tag of BIP0340/nonce-hash_nonce :: BS.ByteString -> BS.ByteString-hash_nonce x = SHA256.hash $-  "\aIw4\167\155\203\&5[\155\140}\ETXO\DC2\FS\244\&4\215>\247-\218\EM\135\NULa\251R\191\235/\aIw4\167\155\203\&5[\155\140}\ETXO\DC2\FS\244\&4\215>\247-\218\EM\135\NULa\251R\191\235/" <> x-{-# INLINE hash_nonce #-}---- hardcoded tag of BIP0340/challenge-hash_challenge :: BS.ByteString -> BS.ByteString-hash_challenge x = SHA256.hash $-  "{\181-z\159\239X2>\177\191z@}\179\130\210\243\242\216\ESC\177\"OI\254Q\143mH\211|{\181-z\159\239X2>\177\191z@}\179\130\210\243\242\216\ESC\177\"OI\254Q\143mH\211|" <> x-{-# INLINE hash_challenge #-}---- ecdsa ------------------------------------------------------------------------- see https://www.rfc-editor.org/rfc/rfc6979, https://secg.org/sec1-v2.pdf---- RFC6979 2.3.2-bits2int :: BS.ByteString -> Integer-bits2int bs =-  let (fi -> blen) = BS.length bs * 8-      (fi -> qlen) = _CURVE_Q_BITS-      del = blen - qlen-  in  if   del > 0-      then roll bs `I.integerShiftR` del-      else roll bs---- RFC6979 2.3.3-int2octets :: Integer -> BS.ByteString-int2octets i = pad (unroll i) where-  pad bs-    | BS.length bs < _CURVE_Q_BYTES = pad (BS.cons 0 bs)-    | otherwise = bs---- RFC6979 2.3.4-bits2octets :: BS.ByteString -> BS.ByteString-bits2octets bs =-  let z1 = bits2int bs-      z2 = modQ z1-  in  int2octets z2---- | An ECDSA signature.-data ECDSA = ECDSA {-    ecdsa_r :: !Integer-  , ecdsa_s :: !Integer-  }-  deriving (Eq, Generic)--instance Show ECDSA where-  show _ = "<ecdsa signature>"---- ECDSA signature type.-data SigType =-    LowS-  | Unrestricted-  deriving Show---- Indicates whether to hash the message or assume it has already been--- hashed.-data HashFlag =-    Hash-  | NoHash-  deriving Show---- | Produce an ECDSA signature for the provided message, using the---   provided private key.------   'sign_ecdsa' produces a "low-s" signature, as is commonly required---   in applications using secp256k1. If you need a generic ECDSA---   signature, use 'sign_ecdsa_unrestricted'.------   >>> sign_ecdsa sec msg---   Just "<ecdsa signature>"-sign_ecdsa-  :: Integer         -- ^ secret key-  -> BS.ByteString   -- ^ message-  -> Maybe ECDSA-sign_ecdsa = _sign_ecdsa (mul _CURVE_G) LowS Hash---- | The same as 'sign_ecdsa', except uses a 'Context' to optimise internal---   calculations.------   You can expect about a 10x performance increase when using this---   function, compared to 'sign_ecdsa'.------   >>> let !tex = precompute---   >>> sign_ecdsa' tex sec msg---   Just "<ecdsa signature>"-sign_ecdsa'-  :: Context         -- ^ secp256k1 context-  -> Integer         -- ^ secret key-  -> BS.ByteString   -- ^ message-  -> Maybe ECDSA-sign_ecdsa' tex = _sign_ecdsa (mul_wnaf tex) LowS Hash---- | Produce an ECDSA signature for the provided message, using the---   provided private key.------   'sign_ecdsa_unrestricted' produces an unrestricted ECDSA signature,---   which is less common in applications using secp256k1 due to the---   signature's inherent malleability. If you need a conventional---   "low-s" signature, use 'sign_ecdsa'.------   >>> sign_ecdsa_unrestricted sec msg---   Just "<ecdsa signature>"-sign_ecdsa_unrestricted-  :: Integer        -- ^ secret key-  -> BS.ByteString  -- ^ message-  -> Maybe ECDSA-sign_ecdsa_unrestricted = _sign_ecdsa (mul _CURVE_G) Unrestricted Hash---- | The same as 'sign_ecdsa_unrestricted', except uses a 'Context' to---   optimise internal calculations.------   You can expect about a 10x performance increase when using this---   function, compared to 'sign_ecdsa_unrestricted'.------   >>> let !tex = precompute---   >>> sign_ecdsa_unrestricted' tex sec msg---   Just "<ecdsa signature>"-sign_ecdsa_unrestricted'-  :: Context        -- ^ secp256k1 context-  -> Integer        -- ^ secret key-  -> BS.ByteString  -- ^ message-  -> Maybe ECDSA-sign_ecdsa_unrestricted' tex = _sign_ecdsa (mul_wnaf tex) Unrestricted Hash---- Produce a "low-s" ECDSA signature for the provided message, using--- the provided private key. Assumes that the message has already been--- pre-hashed.------ (Useful for testing against noble-secp256k1's suite, in which messages--- in the test vectors have already been hashed.)-_sign_ecdsa_no_hash-  :: Integer        -- ^ secret key-  -> BS.ByteString  -- ^ message digest-  -> Maybe ECDSA-_sign_ecdsa_no_hash = _sign_ecdsa (mul _CURVE_G) LowS NoHash--_sign_ecdsa_no_hash'-  :: Context-  -> Integer-  -> BS.ByteString-  -> Maybe ECDSA-_sign_ecdsa_no_hash' tex = _sign_ecdsa (mul_wnaf tex) LowS NoHash--_sign_ecdsa-  :: (Integer -> Maybe Projective) -- partially-applied multiplication function-  -> SigType-  -> HashFlag-  -> Integer-  -> BS.ByteString-  -> Maybe ECDSA-_sign_ecdsa _mul ty hf _SECRET m = runST $ do-    -- RFC6979 sec 3.3a-    let entropy = int2octets _SECRET-        nonce   = bits2octets h-    drbg <- DRBG.new SHA256.hmac entropy nonce mempty-    -- RFC6979 sec 2.4-    sign_loop drbg-  where-    h = case hf of-      Hash -> SHA256.hash m-      NoHash -> m--    h_modQ = remQ (bits2int h) -- bits2int yields nonnegative--    sign_loop g = do-      k <- gen_k g-      let mpair = do-            kg <- _mul k-            let Affine (modQ -> r) _ = affine kg-            kinv <- modinv k (fi _CURVE_Q)-            let s = remQ (remQ (h_modQ + remQ (_SECRET * r)) * kinv)-            pure $! (r, s)-      case mpair of-        Nothing -> pure Nothing-        Just (r, s)-          | r == 0 -> sign_loop g -- negligible probability-          | otherwise ->-              let !sig = Just $! ECDSA r s-              in  case ty of-                    Unrestricted -> pure sig-                    LowS -> pure (fmap low sig)-{-# INLINE _sign_ecdsa #-}---- RFC6979 sec 3.3b-gen_k :: DRBG.DRBG s -> ST s Integer-gen_k g = loop g where-  loop drbg = do-    bytes <- DRBG.gen mempty (fi _CURVE_Q_BYTES) drbg-    let can = bits2int bytes-    if   can >= _CURVE_Q-    then loop drbg-    else pure can-{-# INLINE gen_k #-}---- Convert an ECDSA signature to low-S form.-low :: ECDSA -> ECDSA-low (ECDSA r s) = ECDSA r ms where-  ms-    | s > B.unsafeShiftR _CURVE_Q 1 = modQ (negate s)-    | otherwise = s-{-# INLINE low #-}---- | Verify a "low-s" ECDSA signature for the provided message and---   public key,------   Fails to verify otherwise-valid "high-s" signatures. If you need to---   verify generic ECDSA signatures, use 'verify_ecdsa_unrestricted'.------   >>> verify_ecdsa msg pub valid_sig---   True---   >>> verify_ecdsa msg pub invalid_sig---   False-verify_ecdsa-  :: BS.ByteString -- ^ message-  -> Pub           -- ^ public key-  -> ECDSA         -- ^ signature-  -> Bool-verify_ecdsa m p sig@(ECDSA _ s)-  | s > B.unsafeShiftR _CURVE_Q 1 = False-  | otherwise = verify_ecdsa_unrestricted m p sig---- | The same as 'verify_ecdsa', except uses a 'Context' to optimise---   internal calculations.------   You can expect about a 2x performance increase when using this---   function, compared to 'verify_ecdsa'.------   >>> let !tex = precompute---   >>> verify_ecdsa' tex msg pub valid_sig---   True---   >>> verify_ecdsa' tex msg pub invalid_sig---   False-verify_ecdsa'-  :: Context       -- ^ secp256k1 context-  -> BS.ByteString -- ^ message-  -> Pub           -- ^ public key-  -> ECDSA         -- ^ signature-  -> Bool-verify_ecdsa' tex m p sig@(ECDSA _ s)-  | s > B.unsafeShiftR _CURVE_Q 1 = False-  | otherwise = verify_ecdsa_unrestricted' tex m p sig---- | Verify an unrestricted ECDSA signature for the provided message and---   public key.------   >>> verify_ecdsa_unrestricted msg pub valid_sig---   True---   >>> verify_ecdsa_unrestricted msg pub invalid_sig---   False-verify_ecdsa_unrestricted-  :: BS.ByteString -- ^ message-  -> Pub           -- ^ public key-  -> ECDSA         -- ^ signature-  -> Bool-verify_ecdsa_unrestricted = _verify_ecdsa_unrestricted (mul_unsafe _CURVE_G)---- | The same as 'verify_ecdsa_unrestricted', except uses a 'Context' to---   optimise internal calculations.------   You can expect about a 2x performance increase when using this---   function, compared to 'verify_ecdsa_unrestricted'.------   >>> let !tex = precompute---   >>> verify_ecdsa_unrestricted' tex msg pub valid_sig---   True---   >>> verify_ecdsa_unrestricted' tex msg pub invalid_sig---   False-verify_ecdsa_unrestricted'-  :: Context       -- ^ secp256k1 context-  -> BS.ByteString -- ^ message-  -> Pub           -- ^ public key-  -> ECDSA         -- ^ signature-  -> Bool-verify_ecdsa_unrestricted' tex = _verify_ecdsa_unrestricted (mul_wnaf tex)--_verify_ecdsa_unrestricted-  :: (Integer -> Maybe Projective) -- partially-applied multiplication function-  -> BS.ByteString-  -> Pub-  -> ECDSA-  -> Bool-_verify_ecdsa_unrestricted _mul (SHA256.hash -> h) p (ECDSA r s) = M.isJust $ do-  -- SEC1-v2 4.1.4-  guard (ge r && ge s)-  let e = remQ (bits2int h)-  s_inv <- modinv s (fi _CURVE_Q)-  let u1 = remQ (e * s_inv)-      u2 = remQ (r * s_inv)-  pt0 <- _mul u1-  pt1 <- mul_unsafe p u2-  let capR = add pt0 pt1-  guard (capR /= _CURVE_ZERO)-  let Affine (modQ -> v) _ = affine capR-  guard (v == r)-  pure ()-{-# INLINE _verify_ecdsa_unrestricted #-}---- ecdh --------------------------------------------------------------------------- SEC1-v2 3.3.1, plus SHA256 hash---- | Compute a shared secret, given a secret key and public secp256k1 point,---   via Elliptic Curve Diffie-Hellman (ECDH).------   The shared secret is the SHA256 hash of the x-coordinate of the---   point obtained by scalar multiplication.------   >>> let sec_alice = 0x03                   -- contrived---   >>> let sec_bob   = 2 ^ 128 - 1            -- contrived---   >>> let Just pub_alice = derive_pub sec_alice---   >>> let Just pub_bob   = derive_pub sec_bob---   >>> let secret_as_computed_by_alice = ecdh pub_bob sec_alice---   >>> let secret_as_computed_by_bob   = ecdh pub_alice sec_bob---   >>> secret_as_computed_by_alice == secret_as_computed_by_bob---   True-ecdh-  :: Projective    -- ^ public key-  -> Integer       -- ^ secret key-  -> Maybe BS.ByteString -- ^ shared secret-ecdh pub _SECRET = do-  pt <- mul pub _SECRET-  guard (pt /= _CURVE_ZERO)-  let Affine x _ = affine pt-  pure $! SHA256.hash (unroll32 x)+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module: Crypto.Curve.Secp256k1+-- Copyright: (c) 2024 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Pure [BIP0340](https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki)+-- Schnorr signatures, deterministic+-- [RFC6979](https://www.rfc-editor.org/rfc/rfc6979) ECDSA (with+-- [BIP0146](https://github.com/bitcoin/bips/blob/master/bip-0146.mediawiki)-style+-- "low-S" signatures), and ECDH shared secret computation+--  on the elliptic curve secp256k1.++module Crypto.Curve.Secp256k1 (+  -- * Field and group parameters+    _CURVE_Q+  , _CURVE_P++  -- * secp256k1 points+  , Pub+  , derive_pub+  , derive_pub'+  , _CURVE_G+  , _CURVE_ZERO+  , ge+  , fe++  -- * Parsing+  , parse_int256+  , parse_point+  , parse_sig++  -- * Serializing+  , serialize_point++  -- * ECDH+  , ecdh++  -- * BIP0340 Schnorr signatures+  , sign_schnorr+  , verify_schnorr++  -- * RFC6979 ECDSA+  , ECDSA(..)+  , SigType(..)+  , sign_ecdsa+  , sign_ecdsa_unrestricted+  , verify_ecdsa+  , verify_ecdsa_unrestricted++  -- * Fast variants+  , Context+  , precompute+  , sign_schnorr'+  , verify_schnorr'+  , sign_ecdsa'+  , sign_ecdsa_unrestricted'+  , verify_ecdsa'+  , verify_ecdsa_unrestricted'++  -- Elliptic curve group operations+  , neg+  , add+  , add_mixed+  , add_proj+  , double+  , mul+  , mul_vartime+  , mul_wnaf++  -- Coordinate systems and transformations+  , Affine(..)+  , Projective(..)+  , affine+  , projective+  , valid++  -- for testing/benchmarking+  , _precompute+  , _sign_ecdsa_no_hash+  , _sign_ecdsa_no_hash'+  , roll32+  , unsafe_roll32+  , unroll32+  , select_proj+  ) where++import Control.Monad (guard)+import Control.Monad.ST+import qualified Crypto.DRBG.HMAC as DRBG+import qualified Crypto.Hash.SHA256 as SHA256+import qualified Data.Bits as B+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BI+import qualified Data.ByteString.Unsafe as BU+import qualified Data.Choice as CT+import qualified Data.Maybe as M+import Data.Primitive.ByteArray (ByteArray(..), MutableByteArray(..))+import qualified Data.Primitive.ByteArray as BA+import Data.Word (Word8)+import Data.Word.Limb (Limb(..))+import qualified Data.Word.Limb as L+import Data.Word.Wider (Wider(..))+import qualified Data.Word.Wider as W+import qualified Foreign.Storable as Storable (pokeByteOff)+import qualified GHC.Exts as Exts+import GHC.Generics+import qualified GHC.Word (Word(..), Word8(..))+import qualified Numeric.Montgomery.Secp256k1.Curve as C+import qualified Numeric.Montgomery.Secp256k1.Scalar as S+import Prelude hiding (sqrt)++-- convenience synonyms -------------------------------------------------------++-- Unboxed Wider/Montgomery synonym.+type Limb4 = (# Limb, Limb, Limb, Limb #)++-- Unboxed Projective synonym.+type Proj = (# Limb4, Limb4, Limb4 #)++pattern Zero :: Wider+pattern Zero = Wider Z++pattern Z :: Limb4+pattern Z = (# Limb 0##, Limb 0##, Limb 0##, Limb 0## #)++pattern P :: Limb4 -> Limb4 -> Limb4 -> Projective+pattern P x y z =+  Projective (C.Montgomery x) (C.Montgomery y) (C.Montgomery z)+{-# COMPLETE P #-}++-- utilities ------------------------------------------------------------------++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral+{-# INLINE fi #-}++-- convert a Word8 to a Limb+limb :: Word8 -> Limb+limb (GHC.Word.W8# (Exts.word8ToWord# -> w)) = Limb w+{-# INLINABLE limb #-}++-- convert a Limb to a Word8+word8 :: Limb -> Word8+word8 (Limb w) = GHC.Word.W8# (Exts.wordToWord8# w)+{-# INLINABLE word8 #-}++-- convert a Limb to a Word8 after right-shifting+word8s :: Limb -> Exts.Int# -> Word8+word8s l s =+  let !(Limb w) = L.shr# l s+  in  GHC.Word.W8# (Exts.wordToWord8# w)+{-# INLINABLE word8s #-}++-- convert a Word8 to a Wider+word8_to_wider :: Word8 -> Wider+word8_to_wider w = Wider (# limb w, Limb 0##, Limb 0##, Limb 0## #)+{-# INLINABLE word8_to_wider #-}++-- unsafely extract the first 64-bit word from a big-endian-encoded bytestring+unsafe_word0 :: BS.ByteString -> Limb+unsafe_word0 bs =+          (limb (BU.unsafeIndex bs 00) `L.shl#` 56#)+  `L.or#` (limb (BU.unsafeIndex bs 01) `L.shl#` 48#)+  `L.or#` (limb (BU.unsafeIndex bs 02) `L.shl#` 40#)+  `L.or#` (limb (BU.unsafeIndex bs 03) `L.shl#` 32#)+  `L.or#` (limb (BU.unsafeIndex bs 04) `L.shl#` 24#)+  `L.or#` (limb (BU.unsafeIndex bs 05) `L.shl#` 16#)+  `L.or#` (limb (BU.unsafeIndex bs 06) `L.shl#` 08#)+  `L.or#` (limb (BU.unsafeIndex bs 07))+{-# INLINABLE unsafe_word0 #-}++-- unsafely extract the second 64-bit word from a big-endian-encoded bytestring+unsafe_word1 :: BS.ByteString -> Limb+unsafe_word1 bs =+          (limb (BU.unsafeIndex bs 08) `L.shl#` 56#)+  `L.or#` (limb (BU.unsafeIndex bs 09) `L.shl#` 48#)+  `L.or#` (limb (BU.unsafeIndex bs 10) `L.shl#` 40#)+  `L.or#` (limb (BU.unsafeIndex bs 11) `L.shl#` 32#)+  `L.or#` (limb (BU.unsafeIndex bs 12) `L.shl#` 24#)+  `L.or#` (limb (BU.unsafeIndex bs 13) `L.shl#` 16#)+  `L.or#` (limb (BU.unsafeIndex bs 14) `L.shl#` 08#)+  `L.or#` (limb (BU.unsafeIndex bs 15))+{-# INLINABLE unsafe_word1 #-}++-- unsafely extract the third 64-bit word from a big-endian-encoded bytestring+unsafe_word2 :: BS.ByteString -> Limb+unsafe_word2 bs =+          (limb (BU.unsafeIndex bs 16) `L.shl#` 56#)+  `L.or#` (limb (BU.unsafeIndex bs 17) `L.shl#` 48#)+  `L.or#` (limb (BU.unsafeIndex bs 18) `L.shl#` 40#)+  `L.or#` (limb (BU.unsafeIndex bs 19) `L.shl#` 32#)+  `L.or#` (limb (BU.unsafeIndex bs 20) `L.shl#` 24#)+  `L.or#` (limb (BU.unsafeIndex bs 21) `L.shl#` 16#)+  `L.or#` (limb (BU.unsafeIndex bs 22) `L.shl#` 08#)+  `L.or#` (limb (BU.unsafeIndex bs 23))+{-# INLINABLE unsafe_word2 #-}++-- unsafely extract the fourth 64-bit word from a big-endian-encoded bytestring+unsafe_word3 :: BS.ByteString -> Limb+unsafe_word3 bs =+          (limb (BU.unsafeIndex bs 24) `L.shl#` 56#)+  `L.or#` (limb (BU.unsafeIndex bs 25) `L.shl#` 48#)+  `L.or#` (limb (BU.unsafeIndex bs 26) `L.shl#` 40#)+  `L.or#` (limb (BU.unsafeIndex bs 27) `L.shl#` 32#)+  `L.or#` (limb (BU.unsafeIndex bs 28) `L.shl#` 24#)+  `L.or#` (limb (BU.unsafeIndex bs 29) `L.shl#` 16#)+  `L.or#` (limb (BU.unsafeIndex bs 30) `L.shl#` 08#)+  `L.or#` (limb (BU.unsafeIndex bs 31))+{-# INLINABLE unsafe_word3 #-}++-- 256-bit big-endian bytestring decoding. the input size is not checked!+unsafe_roll32 :: BS.ByteString -> Wider+unsafe_roll32 bs =+  let !w0 = unsafe_word0 bs+      !w1 = unsafe_word1 bs+      !w2 = unsafe_word2 bs+      !w3 = unsafe_word3 bs+  in  Wider (# w3, w2, w1, w0 #)+{-# INLINABLE unsafe_roll32 #-}++-- arbitrary-size big-endian bytestring decoding+roll32 :: BS.ByteString -> Maybe Wider+roll32 bs+    | BS.length stripped > 32 = Nothing+    | otherwise = Just $! BS.foldl' alg 0 stripped+  where+    stripped = BS.dropWhile (== 0) bs+    alg !a (word8_to_wider -> !b) = (a `W.shl_limb` 8) `W.or` b+{-# INLINABLE roll32 #-}++-- 256-bit big-endian bytestring encoding+unroll32 :: Wider -> BS.ByteString+unroll32 (Wider (# w0, w1, w2, w3 #)) =+  BI.unsafeCreate 32 $ \ptr -> do+    -- w0+    Storable.pokeByteOff ptr 00 (word8s w3 56#)+    Storable.pokeByteOff ptr 01 (word8s w3 48#)+    Storable.pokeByteOff ptr 02 (word8s w3 40#)+    Storable.pokeByteOff ptr 03 (word8s w3 32#)+    Storable.pokeByteOff ptr 04 (word8s w3 24#)+    Storable.pokeByteOff ptr 05 (word8s w3 16#)+    Storable.pokeByteOff ptr 06 (word8s w3 08#)+    Storable.pokeByteOff ptr 07 (word8 w3)+    -- w1+    Storable.pokeByteOff ptr 08 (word8s w2 56#)+    Storable.pokeByteOff ptr 09 (word8s w2 48#)+    Storable.pokeByteOff ptr 10 (word8s w2 40#)+    Storable.pokeByteOff ptr 11 (word8s w2 32#)+    Storable.pokeByteOff ptr 12 (word8s w2 24#)+    Storable.pokeByteOff ptr 13 (word8s w2 16#)+    Storable.pokeByteOff ptr 14 (word8s w2 08#)+    Storable.pokeByteOff ptr 15 (word8 w2)+    -- w2+    Storable.pokeByteOff ptr 16 (word8s w1 56#)+    Storable.pokeByteOff ptr 17 (word8s w1 48#)+    Storable.pokeByteOff ptr 18 (word8s w1 40#)+    Storable.pokeByteOff ptr 19 (word8s w1 32#)+    Storable.pokeByteOff ptr 20 (word8s w1 24#)+    Storable.pokeByteOff ptr 21 (word8s w1 16#)+    Storable.pokeByteOff ptr 22 (word8s w1 08#)+    Storable.pokeByteOff ptr 23 (word8 w1)+    -- w3+    Storable.pokeByteOff ptr 24 (word8s w0 56#)+    Storable.pokeByteOff ptr 25 (word8s w0 48#)+    Storable.pokeByteOff ptr 26 (word8s w0 40#)+    Storable.pokeByteOff ptr 27 (word8s w0 32#)+    Storable.pokeByteOff ptr 28 (word8s w0 24#)+    Storable.pokeByteOff ptr 29 (word8s w0 16#)+    Storable.pokeByteOff ptr 30 (word8s w0 08#)+    Storable.pokeByteOff ptr 31 (word8 w0)+{-# INLINABLE unroll32 #-}++-- cheeky montgomery-assisted modQ+modQ :: Wider -> Wider+modQ = S.from . S.to+{-# INLINABLE modQ #-}++-- bytewise xor+xor :: BS.ByteString -> BS.ByteString -> BS.ByteString+xor = BS.packZipWith B.xor+{-# INLINABLE xor #-}++-- constants ------------------------------------------------------------------++-- | secp256k1 field prime.+_CURVE_P :: Wider+_CURVE_P = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F++-- | secp256k1 group order.+_CURVE_Q :: Wider+_CURVE_Q = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141++-- | half of the secp256k1 group order.+_CURVE_QH :: Wider+_CURVE_QH = 0x7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5D576E7357A4501DDFE92F46681B20A0++-- bitlength of group order+--+-- = smallest integer such that _CURVE_Q < 2 ^ _CURVE_Q_BITS+_CURVE_Q_BITS :: Int+_CURVE_Q_BITS = 256++-- bytelength of _CURVE_Q+--+-- = _CURVE_Q_BITS / 8+_CURVE_Q_BYTES :: Int+_CURVE_Q_BYTES = 32++-- secp256k1 weierstrass form, /b/ coefficient+_CURVE_B :: Wider+_CURVE_B = 7++-- secp256k1 weierstrass form, /b/ coefficient, montgomery form+_CURVE_Bm :: C.Montgomery+_CURVE_Bm = 7++-- _CURVE_Bm * 3+_CURVE_Bm3 :: C.Montgomery+_CURVE_Bm3 = 21++-- Is field element?+fe :: Wider -> Bool+fe n = n > 0 && n < _CURVE_P+{-# INLINE fe #-}++-- Is group element?+ge :: Wider -> Bool+ge (Wider n) = CT.decide (ge# n)+{-# INLINE ge #-}++-- curve points ---------------------------------------------------------------++-- curve point, affine coordinates+data Affine = Affine !C.Montgomery !C.Montgomery+  deriving stock (Show, Generic)++-- curve point, projective coordinates+data Projective = Projective {+    px :: !C.Montgomery+  , py :: !C.Montgomery+  , pz :: !C.Montgomery+  }+  deriving stock (Show, Generic)++instance Eq Projective where+  Projective ax ay az == Projective bx by bz =+    let !x1z2 = ax * bz+        !x2z1 = bx * az+        !y1z2 = ay * bz+        !y2z1 = by * az+    in  CT.decide (CT.and# (C.eq x1z2 x2z1) (C.eq y1z2 y2z1))++-- | An ECC-flavoured alias for a secp256k1 point.+type Pub = Projective++-- Convert to affine coordinates.+affine :: Projective -> Affine+affine (Projective x y z) =+  let !iz = C.inv z+  in  Affine (x * iz) (y * iz)+{-# INLINABLE affine #-}++-- Convert to projective coordinates.+projective :: Affine -> Projective+projective = \case+  Affine 0 0 -> _CURVE_ZERO+  Affine x y -> Projective x y 1++-- | secp256k1 generator point.+_CURVE_G :: Projective+_CURVE_G = Projective x y z where+  !x = C.Montgomery+    (# Limb 15507633332195041431##, Limb  2530505477788034779##+    ,  Limb 10925531211367256732##, Limb 11061375339145502536## #)+  !y = C.Montgomery+    (# Limb 12780836216951778274##, Limb 10231155108014310989##+    ,  Limb 8121878653926228278##,  Limb 14933801261141951190## #)+  !z = C.Montgomery+    (# Limb 0x1000003D1##, Limb 0##, Limb 0##, Limb 0## #)++-- | secp256k1 zero point, point at infinity, or monoidal identity.+_CURVE_ZERO :: Projective+_CURVE_ZERO = Projective 0 1 0++-- secp256k1 zero point, point at infinity, or monoidal identity+_ZERO :: Projective+_ZERO = Projective 0 1 0+{-# DEPRECATED _ZERO "use _CURVE_ZERO instead" #-}++-- secp256k1 in short weierstrass form (y ^ 2 = x ^ 3 + 7)+weierstrass :: C.Montgomery -> C.Montgomery+weierstrass x = C.sqr x * x + _CURVE_Bm+{-# INLINE weierstrass #-}++-- Point is valid+valid :: Projective -> Bool+valid p = case affine p of+  Affine x y+    | C.sqr y /= weierstrass x -> False+    | otherwise -> True++-- (bip0340) return point with x coordinate == x and with even y coordinate+--+-- conceptually:+--   y ^ 2 = x ^ 3 + 7+--   y     = "+-" sqrt (x ^ 3 + 7)+--     (n.b. for solution y, p - y is also a solution)+--   y + (p - y) = p (odd)+--     (n.b. sum is odd, so one of y and p - y must be odd, and the other even)+--   if y even, return (x, y)+--   else,      return (x, p - y)+lift_vartime :: C.Montgomery -> Maybe Affine+lift_vartime x = do+  let !c = weierstrass x+  !y <- C.sqrt c+  let !y_e | C.odd y   = negate y+           | otherwise = y+  guard (C.sqr y_e == c)+  pure $! Affine x y_e++even_y_vartime :: Projective -> Projective+even_y_vartime p = case affine p of+  Affine _ (C.retr -> y)+    | CT.decide (W.odd y) -> neg p+    | otherwise -> p++-- Constant-time selection of Projective points.+select_proj :: Projective -> Projective -> CT.Choice -> Projective+select_proj (P ax ay az) (P bx by bz) c =+  P (W.select# ax bx c) (W.select# ay by c) (W.select# az bz c)+{-# INLINE select_proj #-}++-- unboxed internals ----------------------------------------------------------++-- algo 7, renes et al, 2015+add_proj# :: Proj -> Proj -> Proj+add_proj# (# x1, y1, z1 #) (# x2, y2, z2 #) =+  let !(C.Montgomery b3) = _CURVE_Bm3+      !t0a  = C.mul# x1 x2+      !t1a  = C.mul# y1 y2+      !t2a  = C.mul# z1 z2+      !t3a  = C.add# x1 y1+      !t4a  = C.add# x2 y2+      !t3b  = C.mul# t3a t4a+      !t4b  = C.add# t0a t1a+      !t3c  = C.sub# t3b t4b+      !t4c  = C.add# y1 z1+      !x3a  = C.add# y2 z2+      !t4d  = C.mul# t4c x3a+      !x3b  = C.add# t1a t2a+      !t4e  = C.sub# t4d x3b+      !x3c  = C.add# x1 z1+      !y3a  = C.add# x2 z2+      !x3d  = C.mul# x3c y3a+      !y3b  = C.add# t0a t2a+      !y3c  = C.sub# x3d y3b+      !x3e  = C.add# t0a t0a+      !t0b  = C.add# x3e t0a+      !t2b  = C.mul# b3 t2a+      !z3a  = C.add# t1a t2b+      !t1b  = C.sub# t1a t2b+      !y3d  = C.mul# b3 y3c+      !x3f  = C.mul# t4e y3d+      !t2c  = C.mul# t3c t1b+      !x3g  = C.sub# t2c x3f+      !y3e  = C.mul# y3d t0b+      !t1c  = C.mul# t1b z3a+      !y3f  = C.add# t1c y3e+      !t0c  = C.mul# t0b t3c+      !z3b  = C.mul# z3a t4e+      !z3c  = C.add# z3b t0c+  in  (# x3g, y3f, z3c #)+{-# INLINE add_proj# #-}++-- algo 8, renes et al, 2015+add_mixed# :: Proj -> Proj -> Proj+add_mixed# (# x1, y1, z1 #) (# x2, y2, _z2 #) =+  let !(C.Montgomery b3) = _CURVE_Bm3+      !t0a  = C.mul# x1 x2+      !t1a  = C.mul# y1 y2+      !t3a  = C.add# x2 y2+      !t4a  = C.add# x1 y1+      !t3b  = C.mul# t3a t4a+      !t4b  = C.add# t0a t1a+      !t3c  = C.sub# t3b t4b+      !t4c  = C.mul# y2 z1+      !t4d  = C.add# t4c y1+      !y3a  = C.mul# x2 z1+      !y3b  = C.add# y3a x1+      !x3a  = C.add# t0a t0a+      !t0b  = C.add# x3a t0a+      !t2a  = C.mul# b3 z1+      !z3a  = C.add# t1a t2a+      !t1b  = C.sub# t1a t2a+      !y3c  = C.mul# b3 y3b+      !x3b  = C.mul# t4d y3c+      !t2b  = C.mul# t3c t1b+      !x3c  = C.sub# t2b x3b+      !y3d  = C.mul# y3c t0b+      !t1c  = C.mul# t1b z3a+      !y3e  = C.add# t1c y3d+      !t0c  = C.mul# t0b t3c+      !z3b  = C.mul# z3a t4d+      !z3c  = C.add# z3b t0c+  in  (# x3c, y3e, z3c #)+{-# INLINE add_mixed# #-}++-- algo 9, renes et al, 2015+double# :: Proj -> Proj+double# (# x, y, z #) =+  let !(C.Montgomery b3) = _CURVE_Bm3+      !t0  = C.sqr# y+      !z3a = C.add# t0 t0+      !z3b = C.add# z3a z3a+      !z3c = C.add# z3b z3b+      !t1  = C.mul# y z+      !t2a = C.sqr# z+      !t2b = C.mul# b3 t2a+      !x3a = C.mul# t2b z3c+      !y3a = C.add# t0 t2b+      !z3d = C.mul# t1 z3c+      !t1b = C.add# t2b t2b+      !t2c = C.add# t1b t2b+      !t0b = C.sub# t0 t2c+      !y3b = C.mul# t0b y3a+      !y3c = C.add# x3a y3b+      !t1c = C.mul# x y+      !x3b = C.mul# t0b t1c+      !x3c = C.add# x3b x3b+  in  (# x3c, y3c, z3d #)+{-# INLINE double# #-}++select_proj# :: Proj -> Proj -> CT.Choice -> Proj+select_proj# (# ax, ay, az #) (# bx, by, bz #) c =+  (# W.select# ax bx c, W.select# ay by c, W.select# az bz c #)+{-# INLINE select_proj# #-}++neg# :: Proj -> Proj+neg# (# x, y, z #) = (# x, C.neg# y, z #)+{-# INLINE neg# #-}++mul# :: Proj -> Limb4 -> (# () | Proj #)+mul# (# px, py, pz #) s+    | CT.decide (CT.not# (ge# s)) = (# () | #)+    | otherwise =+        let !(P gx gy gz) = _CURVE_G+            !(C.Montgomery o) = C.one+        in  loop (0 :: Int) (# Z, o, Z #) (# gx, gy, gz #) (# px, py, pz #) s+  where+    loop !j !a !f !d !_SECRET+      | j == _CURVE_Q_BITS = (# | a #)+      | otherwise =+          let !nd = double# d+              !(# nm, lsb_set #) = W.shr1_c# _SECRET+              !nacc = select_proj# a (add_proj# a d) lsb_set+              !nf   = select_proj# (add_proj# f d) f lsb_set+          in  loop (succ j) nacc nf nd nm+{-# INLINE mul# #-}++ge# :: Limb4 -> CT.Choice+ge# n =+  let !(Wider q) = _CURVE_Q+  in  CT.and# (W.gt# n Z) (W.lt# n q)+{-# INLINE ge# #-}++mul_wnaf# :: ByteArray -> Int -> Limb4 -> (# () | Proj #)+mul_wnaf# ctxArray ctxW ls+    | CT.decide (CT.not# (ge# ls)) = (# () | #)+    | otherwise =+        let !(P zx zy zz) = _CURVE_ZERO+            !(P gx gy gz) = _CURVE_G+        in  (# | loop 0 (# zx, zy, zz #) (# gx, gy, gz #) ls #)+  where+    !one                  = (# Limb 1##, Limb 0##, Limb 0##, Limb 0## #)+    !wins                 = fi (256 `quot` ctxW + 1)+    !size@(GHC.Word.W# s) = 2 ^ (ctxW - 1)+    !(GHC.Word.W# mask)   = 2 ^ ctxW - 1+    !(GHC.Word.W# texW)   = fi ctxW+    !(GHC.Word.W# mnum)   = 2 ^ ctxW++    loop !j@(GHC.Word.W# w) !acc !f !n@(# Limb lo, _, _, _ #)+      | j == wins = acc+      | otherwise =+          let !(GHC.Word.W# off0) = j * size+              !b0          = Exts.and# lo mask+              !bor         = CT.from_word_gt# b0 s++              !(# n0, _ #) = W.shr_limb# n (Exts.word2Int# texW)+              !n0_plus_1   = W.add_w# n0 one+              !n1          = W.select# n0 n0_plus_1 bor++              !abs_b       = CT.select_word# b0 (Exts.minusWord# mnum b0) bor+              !is_zero     = CT.from_word_eq# b0 0##+              !c0          = CT.from_word# (Exts.and# w 1##)+              !off_nz      = Exts.minusWord# (Exts.plusWord# off0 abs_b) 1##+              !off         = CT.select_word# off0 off_nz (CT.not# is_zero)++              !pr          = index_proj# ctxArray (Exts.word2Int# off)+              !neg_pr      = neg# pr+              !pt_zero     = select_proj# pr neg_pr c0+              !pt_nonzero  = select_proj# pr neg_pr bor++              !f_added     = add_proj# f pt_zero+              !acc_added   = add_proj# acc pt_nonzero+              !nacc        = select_proj# acc_added acc is_zero+              !nf          = select_proj# f f_added is_zero+          in  loop (succ j) nacc nf n1+{-# INLINE mul_wnaf# #-}++-- retrieve a point (as an unboxed tuple) from a context array+index_proj# :: ByteArray -> Exts.Int# -> Proj+index_proj# (ByteArray arr#) i# =+  let !base# = i# Exts.*# 12#+      !x = (# Limb (Exts.indexWordArray# arr# base#)+            , Limb (Exts.indexWordArray# arr# (base# Exts.+# 01#))+            , Limb (Exts.indexWordArray# arr# (base# Exts.+# 02#))+            , Limb (Exts.indexWordArray# arr# (base# Exts.+# 03#)) #)+      !y = (# Limb (Exts.indexWordArray# arr# (base# Exts.+# 04#))+            , Limb (Exts.indexWordArray# arr# (base# Exts.+# 05#))+            , Limb (Exts.indexWordArray# arr# (base# Exts.+# 06#))+            , Limb (Exts.indexWordArray# arr# (base# Exts.+# 07#)) #)+      !z = (# Limb (Exts.indexWordArray# arr# (base# Exts.+# 08#))+            , Limb (Exts.indexWordArray# arr# (base# Exts.+# 09#))+            , Limb (Exts.indexWordArray# arr# (base# Exts.+# 10#))+            , Limb (Exts.indexWordArray# arr# (base# Exts.+# 11#)) #)+  in  (# x, y, z #)+{-# INLINE index_proj# #-}++-- ec arithmetic --------------------------------------------------------------++-- Negate secp256k1 point.+neg :: Projective -> Projective+neg (P x y z) =+  let !(# px, py, pz #) = neg# (# x, y, z #)+  in  P px py pz+{-# INLINABLE neg #-}++-- Elliptic curve addition on secp256k1.+add :: Projective -> Projective -> Projective+add p q = add_proj p q+{-# INLINABLE add #-}++-- algo 7, "complete addition formulas for prime order elliptic curves,"+-- renes et al, 2015+--+-- https://eprint.iacr.org/2015/1060.pdf+add_proj :: Projective -> Projective -> Projective+add_proj (P ax ay az) (P bx by bz) =+  let !(# x, y, z #) = add_proj# (# ax, ay, az #) (# bx, by, bz #)+  in  P x y z+{-# INLINABLE add_proj #-}++-- algo 8, renes et al, 2015+add_mixed :: Projective -> Projective -> Projective+add_mixed (P ax ay az) (P bx by bz) =+  let !(# x, y, z #) = add_mixed# (# ax, ay, az #) (# bx, by, bz #)+  in  P x y z+{-# INLINABLE add_mixed #-}++-- algo 9, renes et al, 2015+double :: Projective -> Projective+double (Projective (C.Montgomery ax) (C.Montgomery ay) (C.Montgomery az)) =+  let !(# x, y, z #) = double# (# ax, ay, az #)+  in  P x y z+{-# INLINABLE double #-}++-- Timing-safe scalar multiplication of secp256k1 points.+mul :: Projective -> Wider -> Maybe Projective+mul (P x y z) (Wider s) = case mul# (# x, y, z #) s of+  (# () | #)               -> Nothing+  (# | (# px, py, pz #) #) -> Just $! P px py pz+{-# INLINABLE mul #-}++-- Timing-unsafe scalar multiplication of secp256k1 points.+--+-- Don't use this function if the scalar could potentially be a secret.+mul_vartime :: Projective -> Wider -> Maybe Projective+mul_vartime p = \case+    Zero -> pure _CURVE_ZERO+    n | not (ge n) -> Nothing+      | otherwise  -> pure $! loop _CURVE_ZERO p n+  where+    loop !r !d = \case+      Zero -> r+      m ->+        let !nd = double d+            !(# nm, lsb_set #) = W.shr1_c m+            !nr = if CT.decide lsb_set then add r d else r+        in  loop nr nd nm++-- | Precomputed multiples of the secp256k1 base or generator point.+data Context = Context {+    ctxW     :: {-# UNPACK #-} !Int+  , ctxArray :: {-# UNPACK #-} !ByteArray+  } deriving Generic++instance Show Context where+  show Context {} = "<secp256k1 context>"++-- | Create a secp256k1 context by precomputing multiples of the curve's+--   generator point.+--+--   This should be used once to create a 'Context' to be reused+--   repeatedly afterwards.+--+--   >>> let !tex = precompute+--   >>> sign_ecdsa' tex sec msg+--   >>> sign_schnorr' tex sec msg aux+precompute :: Context+precompute = _precompute 8++-- This is a highly-optimized version of a function originally+-- translated from noble-secp256k1's "precompute". Points are stored in+-- a ByteArray by arranging each limb into slices of 12 consecutive+-- slots (each Projective point consists of three Montgomery values,+-- each of which consists of four limbs, summing to twelve limbs in+-- total).+--+-- Each point takes 96 bytes to store in this fashion, so the total size of+-- the ByteArray is (size * 96) bytes.+_precompute :: Int -> Context+_precompute ctxW = Context {..} where+  capJ = (2 :: Int) ^ (ctxW - 1)+  ws = 256 `quot` ctxW + 1+  size = ws * capJ++  -- construct the context array+  ctxArray = runST $ do+    marr <- BA.newByteArray (size * 96)+    loop_w marr _CURVE_G 0+    BA.unsafeFreezeByteArray marr++  -- write a point into the i^th 12-slot slice in the array+  write :: MutableByteArray s -> Int -> Projective -> ST s ()+  write marr i+      (P (# Limb x0, Limb x1, Limb x2, Limb x3 #)+         (# Limb y0, Limb y1, Limb y2, Limb y3 #)+         (# Limb z0, Limb z1, Limb z2, Limb z3 #)) = do+    let !base = i * 12+    BA.writeByteArray marr (base + 00) (GHC.Word.W# x0)+    BA.writeByteArray marr (base + 01) (GHC.Word.W# x1)+    BA.writeByteArray marr (base + 02) (GHC.Word.W# x2)+    BA.writeByteArray marr (base + 03) (GHC.Word.W# x3)+    BA.writeByteArray marr (base + 04) (GHC.Word.W# y0)+    BA.writeByteArray marr (base + 05) (GHC.Word.W# y1)+    BA.writeByteArray marr (base + 06) (GHC.Word.W# y2)+    BA.writeByteArray marr (base + 07) (GHC.Word.W# y3)+    BA.writeByteArray marr (base + 08) (GHC.Word.W# z0)+    BA.writeByteArray marr (base + 09) (GHC.Word.W# z1)+    BA.writeByteArray marr (base + 10) (GHC.Word.W# z2)+    BA.writeByteArray marr (base + 11) (GHC.Word.W# z3)++  -- loop over windows+  loop_w :: MutableByteArray s -> Projective -> Int -> ST s ()+  loop_w !marr !p !w+    | w == ws = pure ()+    | otherwise = do+        nb <- loop_j marr p p (w * capJ) 0+        let np = double nb+        loop_w marr np (succ w)++  -- loop within windows+  loop_j+    :: MutableByteArray s+    -> Projective+    -> Projective+    -> Int+    -> Int+    -> ST s Projective+  loop_j !marr !p !b !idx !j = do+    write marr idx b+    if   j == capJ - 1+    then pure b+    else do+      let !nb = add b p+      loop_j marr p nb (succ idx) (succ j)++-- Timing-safe wNAF (w-ary non-adjacent form) scalar multiplication of+-- secp256k1 points.+mul_wnaf :: Context -> Wider -> Maybe Projective+mul_wnaf Context {..} (Wider s) = case mul_wnaf# ctxArray ctxW s of+  (# () | #)               -> Nothing+  (# | (# px, py, pz #) #) -> Just $! P px py pz+{-# INLINABLE mul_wnaf #-}++-- | Derive a public key (i.e., a secp256k1 point) from the provided+--   secret.+--+--   >>> import qualified System.Entropy as E+--   >>> sk <- fmap parse_int256 (E.getEntropy 32)+--   >>> derive_pub sk+--   Just "<secp256k1 point>"+derive_pub :: Wider -> Maybe Pub+derive_pub = mul _CURVE_G+{-# NOINLINE derive_pub #-}++-- | The same as 'derive_pub', except uses a 'Context' to optimise+--   internal calculations.+--+--   >>> import qualified System.Entropy as E+--   >>> sk <- fmap parse_int256 (E.getEntropy 32)+--   >>> let !tex = precompute+--   >>> derive_pub' tex sk+--   Just "<secp256k1 point>"+derive_pub' :: Context -> Wider -> Maybe Pub+derive_pub' = mul_wnaf+{-# NOINLINE derive_pub' #-}++-- parsing --------------------------------------------------------------------++-- | Parse a 'Wider', /e.g./ a Schnorr or ECDSA secret key.+--+--   >>> import qualified Data.ByteString as BS+--   >>> parse_int256 (BS.replicate 32 0xFF)+--   Just <2^256 - 1>+parse_int256 :: BS.ByteString -> Maybe Wider+parse_int256 bs = do+  guard (BS.length bs == 32)+  pure $! unsafe_roll32 bs+{-# INLINABLE parse_int256 #-}++-- | Parse compressed secp256k1 point (33 bytes), uncompressed point (65+--   bytes), or BIP0340-style point (32 bytes).+--+--   >>> parse_point <33-byte compressed point>+--   Just <Pub>+--   >>> parse_point <65-byte uncompressed point>+--   Just <Pub>+--   >>> parse_point <32-byte bip0340 public key>+--   Just <Pub>+--   >>> parse_point <anything else>+--   Nothing+parse_point :: BS.ByteString -> Maybe Projective+parse_point bs+    | len == 32 = _parse_bip0340 bs+    | len == 33 = _parse_compressed h t+    | len == 65 = _parse_uncompressed h t+    | otherwise = Nothing+  where+    len = BS.length bs+    h = BU.unsafeIndex bs 0 -- lazy+    t = BS.drop 1 bs++-- input is guaranteed to be 32B in length+_parse_bip0340 :: BS.ByteString -> Maybe Projective+_parse_bip0340 = fmap projective . lift_vartime . C.to . unsafe_roll32++-- bytestring input is guaranteed to be 32B in length+_parse_compressed :: Word8 -> BS.ByteString -> Maybe Projective+_parse_compressed h (unsafe_roll32 -> x)+  | h /= 0x02 && h /= 0x03 = Nothing+  | not (fe x) = Nothing+  | otherwise = do+      let !mx = C.to x+      !my <- C.sqrt (weierstrass mx)+      let !yodd = CT.decide (W.odd (C.retr my))+          !hodd = B.testBit h 0+      pure $!+        if   hodd /= yodd+        then Projective mx (negate my) 1+        else Projective mx my 1++-- bytestring input is guaranteed to be 64B in length+_parse_uncompressed :: Word8 -> BS.ByteString -> Maybe Projective+_parse_uncompressed h bs = do+  let (unsafe_roll32 -> x, unsafe_roll32 -> y) = BS.splitAt _CURVE_Q_BYTES bs+  guard (h == 0x04)+  let !p = Projective (C.to x) (C.to y) 1+  guard (valid p)+  pure $! p++-- | Parse an ECDSA signature encoded in 64-byte "compact" form.+--+--   >>> parse_sig <64-byte compact signature>+--   Just "<ecdsa signature>"+parse_sig :: BS.ByteString -> Maybe ECDSA+parse_sig bs = do+  guard (BS.length bs == 64)+  let (r0, s0) = BS.splitAt 32 bs+  r <- roll32 r0+  s <- roll32 s0+  pure $! ECDSA r s++-- serializing ----------------------------------------------------------------++-- | Serialize a secp256k1 point in 33-byte compressed form.+--+--   >>> serialize_point pub+--   "<33-byte compressed point>"+serialize_point :: Projective -> BS.ByteString+serialize_point (affine -> Affine (C.from -> x) (C.from -> y)) =+  let !(Wider (# Limb w, _, _, _ #)) = y+      !b | B.testBit (GHC.Word.W# w) 0 = 0x03+         | otherwise = 0x02+  in  BS.cons b (unroll32 x)++-- ecdh -----------------------------------------------------------------------++-- SEC1-v2 3.3.1, plus SHA256 hash++-- | Compute a shared secret, given a secret key and public secp256k1 point,+--   via Elliptic Curve Diffie-Hellman (ECDH).+--+--   The shared secret is the SHA256 hash of the x-coordinate of the+--   point obtained by scalar multiplication.+--+--   >>> let sec_alice = 0x03+--   >>> let sec_bob   = 2 ^ 128 - 1+--   >>> let Just pub_alice = derive_pub sec_alice+--   >>> let Just pub_bob   = derive_pub sec_bob+--   >>> let secret_as_computed_by_alice = ecdh pub_bob sec_alice+--   >>> let secret_as_computed_by_bob   = ecdh pub_alice sec_bob+--   >>> secret_as_computed_by_alice == secret_as_computed_by_bob+--   True+ecdh+  :: Projective          -- ^ public key+  -> Wider               -- ^ secret key+  -> Maybe BS.ByteString -- ^ shared secret+ecdh pub _SECRET = do+  pt@(P _ _ (C.Montgomery -> z)) <- mul pub _SECRET+  let !(Affine (C.retr -> x) _) = affine pt+      !result = SHA256.hash (unroll32 x)+  if CT.decide (C.eq z 0) then Nothing else Just result++-- schnorr --------------------------------------------------------------------+-- see https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki++-- | Create a 64-byte Schnorr signature for the provided message, using+--   the provided secret key.+--+--   BIP0340 recommends that 32 bytes of fresh auxiliary entropy be+--   generated and added at signing time as additional protection+--   against side-channel attacks (namely, to thwart so-called "fault+--   injection" attacks). This entropy is /supplemental/ to security,+--   and the cryptographic security of the signature scheme itself does+--   not rely on it, so it is not strictly required; 32 zero bytes can+--   be used in its stead (and can be supplied via 'mempty').+--+--   >>> import qualified System.Entropy as E+--   >>> aux <- E.getEntropy 32+--   >>> sign_schnorr sec msg aux+--   Just "<64-byte schnorr signature>"+sign_schnorr+  :: Wider          -- ^ secret key+  -> BS.ByteString  -- ^ message+  -> BS.ByteString  -- ^ 32 bytes of auxilliary random data+  -> Maybe BS.ByteString  -- ^ 64-byte Schnorr signature+sign_schnorr = _sign_schnorr (mul _CURVE_G)++-- | The same as 'sign_schnorr', except uses a 'Context' to optimise+--   internal calculations.+--+--   You can expect about a 2x performance increase when using this+--   function, compared to 'sign_schnorr'.+--+--   >>> import qualified System.Entropy as E+--   >>> aux <- E.getEntropy 32+--   >>> let !tex = precompute+--   >>> sign_schnorr' tex sec msg aux+--   Just "<64-byte schnorr signature>"+sign_schnorr'+  :: Context        -- ^ secp256k1 context+  -> Wider          -- ^ secret key+  -> BS.ByteString  -- ^ message+  -> BS.ByteString  -- ^ 32 bytes of auxilliary random data+  -> Maybe BS.ByteString  -- ^ 64-byte Schnorr signature+sign_schnorr' tex = _sign_schnorr (mul_wnaf tex)++_sign_schnorr+  :: (Wider -> Maybe Projective)  -- partially-applied multiplication function+  -> Wider                        -- secret key+  -> BS.ByteString                -- message+  -> BS.ByteString                -- 32 bytes of auxilliary random data+  -> Maybe BS.ByteString+_sign_schnorr _mul _SECRET m a = do+  p <- _mul _SECRET+  let Affine (C.retr -> x_p) (C.retr -> y_p) = affine p+      s       = S.to _SECRET+      d       = S.select s (negate s) (W.odd y_p)+      bytes_d = unroll32 (S.retr d)+      bytes_p = unroll32 x_p+      t       = xor bytes_d (hash_aux a)+      rand    = hash_nonce (t <> bytes_p <> m)+      k'      = S.to (unsafe_roll32 rand)+  guard (k' /= 0) -- negligible probability+  pt <- _mul (S.retr k')+  let Affine (C.retr -> x_r) (C.retr -> y_r) = affine pt+      k         = S.select k' (negate k') (W.odd y_r)+      bytes_r   = unroll32 x_r+      rand'     = hash_challenge (bytes_r <> bytes_p <> m)+      e         = S.to (unsafe_roll32 rand')+      bytes_ked = unroll32 (S.retr (k + e * d))+      sig       = bytes_r <> bytes_ked+  -- NB for benchmarking we morally want to remove the precautionary+  --    verification check here.+  --+  -- guard (verify_schnorr m p sig)+  pure $! sig+{-# INLINE _sign_schnorr #-}++-- | Verify a 64-byte Schnorr signature for the provided message with+--   the supplied public key.+--+--   >>> verify_schnorr msg pub <valid signature>+--   True+--   >>> verify_schnorr msg pub <invalid signature>+--   False+verify_schnorr+  :: BS.ByteString  -- ^ message+  -> Pub            -- ^ public key+  -> BS.ByteString  -- ^ 64-byte Schnorr signature+  -> Bool+verify_schnorr = _verify_schnorr (mul_vartime _CURVE_G)++-- | The same as 'verify_schnorr', except uses a 'Context' to optimise+--   internal calculations.+--+--   You can expect about a 1.5x performance increase when using this+--   function, compared to 'verify_schnorr'.+--+--   >>> let !tex = precompute+--   >>> verify_schnorr' tex msg pub <valid signature>+--   True+--   >>> verify_schnorr' tex msg pub <invalid signature>+--   False+verify_schnorr'+  :: Context        -- ^ secp256k1 context+  -> BS.ByteString  -- ^ message+  -> Pub            -- ^ public key+  -> BS.ByteString  -- ^ 64-byte Schnorr signature+  -> Bool+verify_schnorr' tex = _verify_schnorr (mul_wnaf tex)++_verify_schnorr+  :: (Wider -> Maybe Projective) -- partially-applied multiplication function+  -> BS.ByteString+  -> Pub+  -> BS.ByteString+  -> Bool+_verify_schnorr _mul m p sig+  | BS.length sig /= 64 = False+  | otherwise = M.isJust $ do+      let capP = even_y_vartime p+          (unsafe_roll32 -> r, unsafe_roll32 -> s) = BS.splitAt 32 sig+      guard (fe r && ge s)+      let Affine (C.retr -> x_P) _ = affine capP+          e = modQ . unsafe_roll32 $+            hash_challenge (unroll32 r <> unroll32 x_P <> m)+      pt0 <- _mul s+      pt1 <- mul_vartime capP e+      let dif = add pt0 (neg pt1)+      guard (dif /= _CURVE_ZERO)+      let Affine (C.from -> x_R) (C.from -> y_R) = affine dif+      guard $ not (CT.decide (W.odd y_R) || x_R /= r) -- XX+{-# INLINE _verify_schnorr #-}++-- hardcoded tag of BIP0340/aux+--+-- \x -> let h = SHA256.hash "BIP0340/aux"+--       in  SHA256.hash (h <> h <> x)+hash_aux :: BS.ByteString -> BS.ByteString+hash_aux x = SHA256.hash $+  "\241\239N^\192c\202\218m\148\202\250\157\152~\160i&X9\236\193\US\151-w\165.\216\193\204\144\241\239N^\192c\202\218m\148\202\250\157\152~\160i&X9\236\193\US\151-w\165.\216\193\204\144" <> x+{-# INLINE hash_aux #-}++-- hardcoded tag of BIP0340/nonce+hash_nonce :: BS.ByteString -> BS.ByteString+hash_nonce x = SHA256.hash $+  "\aIw4\167\155\203\&5[\155\140}\ETXO\DC2\FS\244\&4\215>\247-\218\EM\135\NULa\251R\191\235/\aIw4\167\155\203\&5[\155\140}\ETXO\DC2\FS\244\&4\215>\247-\218\EM\135\NULa\251R\191\235/" <> x+{-# INLINE hash_nonce #-}++-- hardcoded tag of BIP0340/challenge+hash_challenge :: BS.ByteString -> BS.ByteString+hash_challenge x = SHA256.hash $+  "{\181-z\159\239X2>\177\191z@}\179\130\210\243\242\216\ESC\177\"OI\254Q\143mH\211|{\181-z\159\239X2>\177\191z@}\179\130\210\243\242\216\ESC\177\"OI\254Q\143mH\211|" <> x+{-# INLINE hash_challenge #-}++-- ecdsa ----------------------------------------------------------------------+-- see https://www.rfc-editor.org/rfc/rfc6979, https://secg.org/sec1-v2.pdf++-- RFC6979 2.3.2+bits2int :: BS.ByteString -> Wider+bits2int = unsafe_roll32+{-# INLINABLE bits2int #-}++-- RFC6979 2.3.3+int2octets :: Wider -> BS.ByteString+int2octets = unroll32+{-# INLINABLE int2octets #-}++-- RFC6979 2.3.4+bits2octets :: BS.ByteString -> BS.ByteString+bits2octets bs =+  let z1 = bits2int bs+      z2 = modQ z1+  in  int2octets z2++-- | An ECDSA signature.+data ECDSA = ECDSA {+    ecdsa_r :: !Wider+  , ecdsa_s :: !Wider+  }+  deriving (Eq, Generic)++instance Show ECDSA where+  show _ = "<ecdsa signature>"++-- ECDSA signature type.+data SigType =+    LowS+  | Unrestricted+  deriving Show++-- Indicates whether to hash the message or assume it has already been+-- hashed.+data HashFlag =+    Hash+  | NoHash+  deriving Show++-- Convert an ECDSA signature to low-S form.+low :: ECDSA -> ECDSA+low (ECDSA r s) = ECDSA r (W.select s (_CURVE_Q - s) (W.gt s _CURVE_QH))+{-# INLINE low #-}++-- | Produce an ECDSA signature for the provided message, using the+--   provided private key.+--+--   'sign_ecdsa' produces a "low-s" signature, as is commonly required+--   in applications using secp256k1. If you need a generic ECDSA+--   signature, use 'sign_ecdsa_unrestricted'.+--+--   >>> sign_ecdsa sec msg+--   Just "<ecdsa signature>"+sign_ecdsa+  :: Wider         -- ^ secret key+  -> BS.ByteString -- ^ message+  -> Maybe ECDSA+sign_ecdsa = _sign_ecdsa (mul _CURVE_G) LowS Hash++-- | The same as 'sign_ecdsa', except uses a 'Context' to optimise internal+--   calculations.+--+--   You can expect about a 10x performance increase when using this+--   function, compared to 'sign_ecdsa'.+--+--   >>> let !tex = precompute+--   >>> sign_ecdsa' tex sec msg+--   Just "<ecdsa signature>"+sign_ecdsa'+  :: Context       -- ^ secp256k1 context+  -> Wider         -- ^ secret key+  -> BS.ByteString -- ^ message+  -> Maybe ECDSA+sign_ecdsa' tex = _sign_ecdsa (mul_wnaf tex) LowS Hash++-- | Produce an ECDSA signature for the provided message, using the+--   provided private key.+--+--   'sign_ecdsa_unrestricted' produces an unrestricted ECDSA signature,+--   which is less common in applications using secp256k1 due to the+--   signature's inherent malleability. If you need a conventional+--   "low-s" signature, use 'sign_ecdsa'.+--+--   >>> sign_ecdsa_unrestricted sec msg+--   Just "<ecdsa signature>"+sign_ecdsa_unrestricted+  :: Wider         -- ^ secret key+  -> BS.ByteString -- ^ message+  -> Maybe ECDSA+sign_ecdsa_unrestricted = _sign_ecdsa (mul _CURVE_G) Unrestricted Hash++-- | The same as 'sign_ecdsa_unrestricted', except uses a 'Context' to+--   optimise internal calculations.+--+--   You can expect about a 10x performance increase when using this+--   function, compared to 'sign_ecdsa_unrestricted'.+--+--   >>> let !tex = precompute+--   >>> sign_ecdsa_unrestricted' tex sec msg+--   Just "<ecdsa signature>"+sign_ecdsa_unrestricted'+  :: Context       -- ^ secp256k1 context+  -> Wider         -- ^ secret key+  -> BS.ByteString -- ^ message+  -> Maybe ECDSA+sign_ecdsa_unrestricted' tex = _sign_ecdsa (mul_wnaf tex) Unrestricted Hash++-- Produce a "low-s" ECDSA signature for the provided message, using+-- the provided private key. Assumes that the message has already been+-- pre-hashed.+--+-- (Useful for testing against noble-secp256k1's suite, in which messages+-- in the test vectors have already been hashed.)+_sign_ecdsa_no_hash+  :: Wider         -- ^ secret key+  -> BS.ByteString -- ^ message digest+  -> Maybe ECDSA+_sign_ecdsa_no_hash = _sign_ecdsa (mul _CURVE_G) LowS NoHash++_sign_ecdsa_no_hash'+  :: Context+  -> Wider+  -> BS.ByteString+  -> Maybe ECDSA+_sign_ecdsa_no_hash' tex = _sign_ecdsa (mul_wnaf tex) LowS NoHash++_sign_ecdsa+  :: (Wider -> Maybe Projective) -- partially-applied multiplication function+  -> SigType+  -> HashFlag+  -> Wider+  -> BS.ByteString+  -> Maybe ECDSA+_sign_ecdsa _mul ty hf _SECRET m = runST $ do+    -- RFC6979 sec 3.3a+    let entropy = int2octets _SECRET+        nonce   = bits2octets h+    drbg <- DRBG.new SHA256.hmac entropy nonce mempty+    -- RFC6979 sec 2.4+    sign_loop drbg+  where+    d  = S.to _SECRET+    hm = S.to (bits2int h)+    h  = case hf of+      Hash -> SHA256.hash m+      NoHash -> m++    sign_loop g = do+      k <- gen_k g+      let mpair = do+            kg <- _mul k+            let Affine (S.to . C.retr -> r) _ = affine kg+                ki = S.inv (S.to k)+                s  = (hm + d * r) * ki+            pure $! (S.retr r, S.retr s)+      case mpair of+        Nothing -> pure Nothing+        Just (r, s)+          | r == 0 -> sign_loop g -- negligible probability+          | otherwise ->+              let !sig = Just $! ECDSA r s+              in  case ty of+                    Unrestricted -> pure sig+                    LowS -> pure (fmap low sig)+{-# INLINE _sign_ecdsa #-}++-- RFC6979 sec 3.3b+gen_k :: DRBG.DRBG s -> ST s Wider+gen_k g = loop g where+  loop drbg = do+    bytes <- DRBG.gen mempty (fi _CURVE_Q_BYTES) drbg+    let can = bits2int bytes+    if   can >= _CURVE_Q+    then loop drbg+    else pure can+{-# INLINE gen_k #-}++-- | Verify a "low-s" ECDSA signature for the provided message and+--   public key,+--+--   Fails to verify otherwise-valid "high-s" signatures. If you need to+--   verify generic ECDSA signatures, use 'verify_ecdsa_unrestricted'.+--+--   >>> verify_ecdsa msg pub valid_sig+--   True+--   >>> verify_ecdsa msg pub invalid_sig+--   False+verify_ecdsa+  :: BS.ByteString -- ^ message+  -> Pub           -- ^ public key+  -> ECDSA         -- ^ signature+  -> Bool+verify_ecdsa m p sig@(ECDSA _ s)+  | s > _CURVE_QH = False+  | otherwise = verify_ecdsa_unrestricted m p sig++-- | The same as 'verify_ecdsa', except uses a 'Context' to optimise+--   internal calculations.+--+--   You can expect about a 2x performance increase when using this+--   function, compared to 'verify_ecdsa'.+--+--   >>> let !tex = precompute+--   >>> verify_ecdsa' tex msg pub valid_sig+--   True+--   >>> verify_ecdsa' tex msg pub invalid_sig+--   False+verify_ecdsa'+  :: Context       -- ^ secp256k1 context+  -> BS.ByteString -- ^ message+  -> Pub           -- ^ public key+  -> ECDSA         -- ^ signature+  -> Bool+verify_ecdsa' tex m p sig@(ECDSA _ s)+  | s > _CURVE_QH = False+  | otherwise = verify_ecdsa_unrestricted' tex m p sig++-- | Verify an unrestricted ECDSA signature for the provided message and+--   public key.+--+--   >>> verify_ecdsa_unrestricted msg pub valid_sig+--   True+--   >>> verify_ecdsa_unrestricted msg pub invalid_sig+--   False+verify_ecdsa_unrestricted+  :: BS.ByteString -- ^ message+  -> Pub           -- ^ public key+  -> ECDSA         -- ^ signature+  -> Bool+verify_ecdsa_unrestricted = _verify_ecdsa_unrestricted (mul_vartime _CURVE_G)++-- | The same as 'verify_ecdsa_unrestricted', except uses a 'Context' to+--   optimise internal calculations.+--+--   You can expect about a 2x performance increase when using this+--   function, compared to 'verify_ecdsa_unrestricted'.+--+--   >>> let !tex = precompute+--   >>> verify_ecdsa_unrestricted' tex msg pub valid_sig+--   True+--   >>> verify_ecdsa_unrestricted' tex msg pub invalid_sig+--   False+verify_ecdsa_unrestricted'+  :: Context       -- ^ secp256k1 context+  -> BS.ByteString -- ^ message+  -> Pub           -- ^ public key+  -> ECDSA         -- ^ signature+  -> Bool+verify_ecdsa_unrestricted' tex = _verify_ecdsa_unrestricted (mul_wnaf tex)++_verify_ecdsa_unrestricted+  :: (Wider -> Maybe Projective) -- partially-applied multiplication function+  -> BS.ByteString+  -> Pub+  -> ECDSA+  -> Bool+_verify_ecdsa_unrestricted _mul m p (ECDSA r0 s0) = M.isJust $ do+  -- SEC1-v2 4.1.4+  let h = SHA256.hash m+  guard (ge r0 && ge s0)+  let r  = S.to r0+      s  = S.to s0+      e  = S.to (bits2int h)+      si = S.inv s+      u1 = S.retr (e * si)+      u2 = S.retr (r * si)+  pt0 <- _mul u1+  pt1 <- mul_vartime p u2+  let capR = add pt0 pt1+  guard (capR /= _CURVE_ZERO)+  let Affine (S.to . C.retr -> v) _ = affine capR+  guard (v == r)+{-# INLINE _verify_ecdsa_unrestricted #-} 

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               ppad-secp256k1-version:            0.4.0+version:            0.5.0 synopsis:           Schnorr signatures, ECDSA, and ECDH on the elliptic curve                     secp256k1 license:            MIT@@ -15,6 +15,11 @@   Pure BIP0340-style Schnorr signatures, deterministic RFC6979 ECDSA, and   ECDH shared secret computation on the elliptic curve secp256k1. +flag llvm+  description: Use GHC's LLVM backend.+  default:     False+  manual:      True+ source-repository head   type:     git   location: git.ppad.tech/secp256k1.git@@ -24,6 +29,8 @@   hs-source-dirs:   lib   ghc-options:       -Wall+  if flag(llvm)+    ghc-options: -fllvm -O2   exposed-modules:       Crypto.Curve.Secp256k1   build-depends:@@ -31,6 +38,7 @@     , bytestring >= 0.9 && < 0.13     , ppad-hmac-drbg >= 0.1 && < 0.2     , ppad-sha256 >= 0.2 && < 0.3+    , ppad-fixed >= 0.1 && < 0.2     , primitive >= 0.8 && < 0.10  test-suite secp256k1-tests@@ -51,8 +59,9 @@       aeson     , attoparsec     , base-    , base16-bytestring     , bytestring+    , ppad-base16+    , ppad-fixed     , ppad-secp256k1     , ppad-sha256     , tasty@@ -70,10 +79,11 @@    build-depends:       base-    , base16-bytestring     , bytestring     , criterion     , deepseq+    , ppad-base16+    , ppad-fixed     , ppad-secp256k1  benchmark secp256k1-weigh@@ -87,9 +97,10 @@    build-depends:       base-    , base16-bytestring     , bytestring     , deepseq+    , ppad-base16+    , ppad-fixed     , ppad-secp256k1     , weigh 

@@ -13,19 +13,13 @@ import qualified Data.Attoparsec.ByteString.Char8 as AT import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16-import qualified GHC.Num.Integer as I import Test.Tasty import Test.Tasty.HUnit --- XX make a test prelude instead of copying/pasting these things everywhere--fi :: (Integral a, Num b) => a -> b-fi = fromIntegral-{-# INLINE fi #-}--roll :: BS.ByteString -> Integer-roll = BS.foldl' unstep 0 where-  unstep a (fi -> b) = (a `I.integerShiftL` 8) `I.integerOr` b+decodeLenient :: BS.ByteString -> BS.ByteString+decodeLenient bs = case B16.decode bs of+  Nothing -> error "bang"+  Just b -> b  data Case = Case {     c_index   :: !Int@@ -40,7 +34,7 @@  execute :: Context -> Case -> TestTree execute tex Case {..} = testCase ("bip0340 " <> show c_index) $-  case parse_point (B16.decodeLenient c_pk) of+  case parse_point (decodeLenient c_pk) of     Nothing -> assertBool mempty (not c_res)     Just pk -> do       if   c_sk == mempty@@ -56,7 +50,7 @@           assertBool mempty (not ver')       -- XX test pubkey derivation from sk       else do -- signature present; test sig too-        let sk = roll c_sk+        let sk = unsafe_roll32 c_sk             Just sig  = sign_schnorr sk c_msg c_aux             Just sig' = sign_schnorr' tex sk c_msg c_aux             ver  = verify_schnorr c_msg pk sig@@ -80,15 +74,15 @@ test_case = do   c_index <- AT.decimal AT.<?> "index"   _ <- AT.char ','-  c_sk <- fmap B16.decodeLenient (AT.takeWhile (/= ',') AT.<?> "sk")+  c_sk <- fmap decodeLenient (AT.takeWhile (/= ',') AT.<?> "sk")   _ <- AT.char ','   c_pk <- AT.takeWhile1 (/= ',') AT.<?> "pk"   _ <- AT.char ','-  c_aux <- fmap B16.decodeLenient (AT.takeWhile (/= ',') AT.<?> "aux")+  c_aux <- fmap decodeLenient (AT.takeWhile (/= ',') AT.<?> "aux")   _ <- AT.char ','-  c_msg <- fmap B16.decodeLenient (AT.takeWhile (/= ',') AT.<?> "msg")+  c_msg <- fmap decodeLenient (AT.takeWhile (/= ',') AT.<?> "msg")   _ <- AT.char ','-  c_sig <- fmap B16.decodeLenient (AT.takeWhile1 (/= ',') AT.<?> "sig")+  c_sig <- fmap decodeLenient (AT.takeWhile1 (/= ',') AT.<?> "sig")   _ <- AT.char ','   c_res <- (AT.string "TRUE" *> pure True) <|> (AT.string "FALSE" *> pure False)             AT.<?> "res"

@@ -21,6 +21,11 @@ fi = fromIntegral {-# INLINE fi #-} +decodeLenient :: BS.ByteString -> BS.ByteString+decodeLenient bs = case B16.decode bs of+  Nothing -> error "bang"+  Just b -> b+ main :: IO () main = do   wp_ecdsa_sha256 <- TIO.readFile "etc/ecdsa_secp256k1_sha256_test.json"@@ -89,19 +94,19 @@  parse_point_test_p :: TestTree parse_point_test_p = testCase (render p_hex) $-  case parse_point (B16.decodeLenient p_hex) of+  case parse_point (decodeLenient p_hex) of     Nothing -> assertFailure "bad parse"     Just p  -> assertEqual mempty p_pro p  parse_point_test_q :: TestTree parse_point_test_q = testCase (render q_hex) $-  case parse_point (B16.decodeLenient q_hex) of+  case parse_point (decodeLenient q_hex) of     Nothing -> assertFailure "bad parse"     Just q  -> assertEqual mempty q_pro q  parse_point_test_r :: TestTree parse_point_test_r = testCase (render r_hex) $-  case parse_point (B16.decodeLenient r_hex) of+  case parse_point (decodeLenient r_hex) of     Nothing -> assertFailure "bad parse"     Just r  -> assertEqual mempty r_pro r 

@@ -17,10 +17,15 @@ import qualified Data.ByteString.Base16 as B16 import qualified Data.Text as T import qualified Data.Text.Encoding as TE-import qualified GHC.Num.Integer as I+import Data.Word.Wider (Wider(..)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertEqual, assertBool, assertFailure, testCase) +decodeLenient :: BS.ByteString -> BS.ByteString+decodeLenient bs = case B16.decode bs of+  Nothing -> error "bang"+  Just b -> b+ data Ecdsa = Ecdsa {     ec_valid   :: ![(Int, ValidTest)]   , ec_invalid :: !InvalidTest@@ -63,7 +68,7 @@ execute_invalid_verify :: Context -> (Int, InvalidVerifyTest) -> TestTree execute_invalid_verify tex (label, InvalidVerifyTest {..}) =   testCase ("noble-secp256k1, invalid verify (" <> show label <> ")") $-    case parse_point (B16.decodeLenient ivv_Q) of+    case parse_point (decodeLenient ivv_Q) of       Nothing -> assertBool "no parse" True       Just pub -> do         let sig = parse_compact ivv_signature@@ -72,22 +77,13 @@         assertBool mempty (not ver)         assertBool mempty (not ver') -fi :: (Integral a, Num b) => a -> b-fi = fromIntegral-{-# INLINE fi #-}- -- parser helper toBS :: T.Text -> BS.ByteString-toBS = B16.decodeLenient . TE.encodeUtf8+toBS = decodeLenient . TE.encodeUtf8  -- parser helper-toSecKey :: T.Text -> Integer-toSecKey = roll . toBS---- big-endian bytestring decoding-roll :: BS.ByteString -> Integer-roll = BS.foldl' unstep 0 where-  unstep a (fi -> b) = (a `I.integerShiftL` 8) `I.integerOr` b+toSecKey :: T.Text -> Wider+toSecKey = unsafe_roll32 . toBS  instance A.FromJSON Ecdsa where   parseJSON = A.withObject "Ecdsa" $ \m -> Ecdsa@@ -95,7 +91,7 @@     <*> m .: "invalid"  data ValidTest = ValidTest {-    vt_d           :: !Integer+    vt_d           :: !Wider   , vt_m           :: !BS.ByteString   , vt_signature   :: !BS.ByteString   } deriving Show@@ -122,7 +118,7 @@     <*> fmap (zip [0..]) (m .: "verify")  data InvalidSignTest = InvalidSignTest {-    ivs_d           :: !Integer+    ivs_d           :: !Wider   , ivs_m           :: !BS.ByteString   } deriving Show 

@@ -17,19 +17,18 @@ import qualified Data.ByteString.Base16 as B16 import qualified Data.Text as T import qualified Data.Text.Encoding as TE-import qualified GHC.Num.Integer as I import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, testCase) +decodeLenient :: BS.ByteString -> BS.ByteString+decodeLenient bs = case B16.decode bs of+  Nothing -> error "bang"+  Just b -> b+ fi :: (Integral a, Num b) => a -> b fi = fromIntegral {-# INLINE fi #-} --- big-endian bytestring decoding-roll :: BS.ByteString -> Integer-roll = BS.foldl' unstep 0 where-  unstep a (fi -> b) = (a `I.integerShiftL` 8) `I.integerOr` b- execute_group :: Context -> SigType -> EcdsaTestGroup -> TestTree execute_group tex ty EcdsaTestGroup {..} =     testGroup msg (fmap (execute tex ty pk_uncompressed) etg_tests)@@ -39,7 +38,7 @@  execute :: Context -> SigType -> Projective -> EcdsaVerifyTest -> TestTree execute tex ty pub EcdsaVerifyTest {..} = testCase report $ do-    let msg = B16.decodeLenient (TE.encodeUtf8 t_msg)+    let msg = decodeLenient (TE.encodeUtf8 t_msg)         sig = toEcdsa t_sig     case sig of       Left _  -> assertBool mempty (t_result == "invalid")@@ -69,13 +68,18 @@     meat len = do       (lr, bs_r) <- parseAsnInt       (ls, bs_s) <- parseAsnInt-      let r = fi (roll bs_r)-          s = fi (roll bs_s)-          checks = lr + ls == len-      rest <- AT.takeByteString-      if   rest == mempty && checks-      then pure (ECDSA r s)-      else fail "input remaining or length mismatch"+      let rs = do+            r <- roll32 bs_r+            s <- roll32 bs_s+            pure (r, s)+      case rs of+        Nothing -> fail "signature components too large"+        Just (r, s) -> do+          let checks = lr + ls == len+          rest <- AT.takeByteString+          if   rest == mempty && checks+          then pure (ECDSA r s)+          else fail "input remaining or length mismatch"  parseAsnInt :: AT.Parser (Int, BS.ByteString) parseAsnInt = do@@ -136,7 +140,7 @@   } deriving Show  toProjective :: T.Text -> Projective-toProjective (B16.decodeLenient . TE.encodeUtf8 -> bs) = case parse_point bs of+toProjective (decodeLenient . TE.encodeUtf8 -> bs) = case parse_point bs of   Nothing -> error "wycheproof: couldn't parse pubkey"   Just p -> p @@ -148,7 +152,7 @@     <*> fmap toProjective (m .: "uncompressed")  toEcdsa :: T.Text -> Either String ECDSA-toEcdsa (B16.decodeLenient . TE.encodeUtf8 -> bs) =+toEcdsa (decodeLenient . TE.encodeUtf8 -> bs) =   AT.parseOnly parse_der_sig bs  data EcdsaVerifyTest = EcdsaVerifyTest {

@@ -13,14 +13,19 @@ import Data.Aeson ((.:)) import qualified Data.Aeson as A import qualified Data.Attoparsec.ByteString as AT-import Data.Bits ((.<<.), (.>>.), (.|.)) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16 import qualified Data.Text as T import qualified Data.Text.Encoding as TE+import Data.Word.Wider (Wider(..)) import Test.Tasty (TestTree, testGroup) import qualified Test.Tasty.HUnit as H (assertBool, assertEqual, testCase) +decodeLenient :: BS.ByteString -> BS.ByteString+decodeLenient bs = case B16.decode bs of+  Nothing -> error "bang"+  Just b -> b+ fi :: (Integral a, Num b) => a -> b fi = fromIntegral {-# INLINE fi #-}@@ -129,32 +134,13 @@         Just pt -> pure pt  der_to_pub :: T.Text -> Either String Projective-der_to_pub (B16.decodeLenient . TE.encodeUtf8 -> bs) =+der_to_pub (decodeLenient . TE.encodeUtf8 -> bs) =   AT.parseOnly parse_der_pub bs -parse_bigint :: T.Text -> Integer-parse_bigint (B16.decodeLenient . TE.encodeUtf8 -> bs) = roll bs where-  roll :: BS.ByteString -> Integer-  roll = BS.foldl' alg 0 where-    alg !a (fi -> !b) = (a .<<. 8) .|. b---- big-endian bytestring encoding-unroll :: Integer -> BS.ByteString-unroll i = case i of-    0 -> BS.singleton 0-    _ -> BS.reverse $ BS.unfoldr step i-  where-    step 0 = Nothing-    step m = Just (fi m, m .>>. 8)---- big-endian bytestring encoding for 256-bit ints, left-padding with--- zeros if necessary. the size of the integer is not checked.-unroll32 :: Integer -> BS.ByteString-unroll32 (unroll -> u)-    | l < 32 = BS.replicate (32 - l) 0 <> u-    | otherwise = u-  where-    l = BS.length u+parse_bigint :: T.Text -> Wider+parse_bigint (decodeLenient . TE.encodeUtf8 -> bs) = case roll32 bs of+  Nothing -> error "couldn't parse_bigint"+  Just v -> v  data Wycheproof = Wycheproof {     wp_testGroups :: ![EcdhTestGroup]