ppad-secp256k1 0.4.0 → 0.5.7
raw patch · 10 files changed
Files
- CHANGELOG +50/−0
- bench/Main.hs +83/−55
- bench/Weight.hs +112/−124
- lib/Crypto/Curve/Secp256k1.hs +1458/−1252
- ppad-secp256k1.cabal +18/−7
- test/BIP340.hs +10/−16
- test/Main.hs +8/−3
- test/Noble.hs +20/−17
- test/Wycheproof.hs +20/−16
- test/WycheproofEcdh.hs +11/−25
CHANGELOG view
@@ -1,5 +1,55 @@ # Changelog +- 0.5.7 (2026-06-07)+ * Improves the performance of all wNAF-based signing & verification+ functions by about 1.5-2x, due to optimizations in 1) the+ constant-time wNAF scalar multiplication function, and 2) upstream+ modular field inversion (in ppad-fixed).++- 0.5.6 (2026-06-07)+ * Improves the wall-clock performance of the constant-time, non-wNAF+ scalar multiplication function by about 35%. ECDH also speeds up+ proportionally as a direct result.++- 0.5.5 (2026-05-22)+ * Adds no-hash ECDSA signature verification utilities that skip the+ internal SHA256 step.++- 0.5.4 (2026-02-04)+ * Nonce generation for ECDSA is now more secure due to recent+ improvements in ppad-hmac-drbg. The DRBG state is now guaranteed+ to live in only one location on the heap, and it is now wiped+ explicitly after use.++ * ECDSA signing now allocates about 1.5 orders of magnitude less than+ it did previously.++- 0.5.3 (2026-01-10)+ * Bumps the ppad-sha256 and ppad-hmac-drbg dependencies.++- 0.5.2 (2025-12-28)+ * Adds an explicit 64-bit architecture constraint.+ * Tests on GHC.10.3.++- 0.5.1 (2025-12-27)+ * Improves the constant-time semantics in wNAF scalar multiplication,+ replacing "indexing via a constant-time selected value" by performing+ a full window scan and selecting via mask.++- 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.
bench/Main.hs view
@@ -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"@@ -151,6 +177,7 @@ ecdh :: Benchmark ecdh = env setup $ \ ~(big, pub) ->+ -- the order of these seems to matter particularly for some reason bgroup "ecdh" [ bench "ecdh (small)" $ nf (S.ecdh pub) 2 , bench "ecdh (large)" $ nf (S.ecdh pub) big@@ -159,39 +186,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 +231,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 +255,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"
bench/Weight.hs view
@@ -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
lib/Crypto/Curve/Secp256k1.hs view
@@ -1,1255 +1,1461 @@ {-# OPTIONS_HADDOCK prune #-} {-# 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 CPP #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ViewPatterns #-}++#include "MachDeps.h"+#if WORD_SIZE_IN_BITS != 64+#error "ppad-secp256k1 requires a 64-bit architecture"+#endif++-- |+-- 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 (+ -- * Parsing+ parse_int256+ , parse_point+ , parse_sig++ -- * Serializing+ , serialize_point++ -- * secp256k1 points+ , Pub+ , derive_pub+ , derive_pub'+ , _CURVE_G+ , _CURVE_ZERO+ , ge+ , fe++ -- * 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++ -- * Field and group parameters+ , _CURVE_Q+ , _CURVE_P++ -- Coordinate systems and transformations+ , Affine(..)+ , Projective(..)+ , affine+ , projective+ , valid++ -- for testing/benchmarking+ , _precompute+ , _sign_ecdsa_no_hash+ , _sign_ecdsa_no_hash'+ , _verify_ecdsa_no_hash+ , _verify_ecdsa_no_hash'+ , roll32+ , unsafe_roll32+ , unroll32+ , select_proj+ ) where++import Control.Monad (guard)+import Control.Monad.ST+import qualified Crypto.DRBG.HMAC.SHA256 as DRBG+import qualified Crypto.Hash.SHA256 as SHA256+import qualified Data.Bits as B+import Data.Bits ((.<<.))+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 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 #-}++-- modQ via conditional subtraction+modQ :: Wider -> Wider+modQ x = W.select x (x - _CURVE_Q) (CT.not (W.lt x _CURVE_Q))+{-# INLINABLE modQ #-}++-- bytewise xor+xor :: BS.ByteString -> BS.ByteString -> BS.ByteString+xor = BS.packZipWith B.xor+{-# INLINABLE xor #-}++-- constants ------------------------------------------------------------------++-- | secp256k1 field prime.+--+-- >>> _CURVE_P+-- 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F+_CURVE_P :: Wider+_CURVE_P = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F++-- | secp256k1 group order.+--+-- >>> _CURVE_Q+-- 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141+_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 = case W.cmp_vartime n 0 of+ GT -> case W.cmp_vartime n _CURVE_P of+ LT -> True+ _ -> False+ _ -> False+{-# 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))++-- | A public key, i.e. 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 (Affine x y)+ | C.eq_vartime x 0 || C.eq_vartime y 0 = _CURVE_ZERO+ | otherwise = 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 (affine -> Affine x y) = C.eq_vartime (C.sqr y) (weierstrass x)++-- (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_vartime c+ let !y_e | C.odd_vartime y = negate y+ | otherwise = y+ 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 (Projective ax ay az) (Projective bx by bz) c =+ Projective (C.select ax bx c) (C.select ay by c) (C.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 !(C.Montgomery o) = C.one+ in loop (0 :: Int) (# Z, o, Z #) (# px, py, pz #) s+ where+ loop !j !a !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+ in loop (succ j) nacc nd nm+{-# INLINE mul# #-}++mul_vartime# :: Proj -> Limb4 -> (# () | Proj #)+mul_vartime# (# px, py, pz #) s+ | zero# s =+ let !(P zx zy zz) = _CURVE_ZERO+ in (# | (# zx, zy, zz #) #)+ | CT.decide (CT.not (ge# s)) = (# () | #)+ | otherwise =+ let !(P zx zy zz) = _CURVE_ZERO+ in (# | loop (# zx, zy, zz #) (# px, py, pz #) s #)+ where+ zero# (# Limb a, Limb b, Limb c, Limb d #) = Exts.isTrue#+ ((a `Exts.or#` b `Exts.or#` c `Exts.or#` d) `Exts.eqWord#` 0##)++ loop !r !d !m+ | zero# m = r+ | otherwise =+ let !nd = double# d+ !(# nm, lsb_set #) = W.shr1_c# m+ !nr = if CT.decide lsb_set then add_proj# r d else r+ in loop nr nd nm+{-# INLINE mul_vartime# #-}++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+ in (# | loop 0 (# zx, zy, zz #) ls #)+ where+ !one = (# Limb 1##, Limb 0##, Limb 0##, Limb 0## #)+ !wins = fi (256 `quot` ctxW + 1)+ !size@(GHC.Word.W# s) = 1 .<<. (ctxW - 1)+ !(GHC.Word.W# mask) = 1 .<<. ctxW - 1+ !(GHC.Word.W# texW) = fi ctxW+ !(GHC.Word.W# mnum) = 1 .<<. ctxW++ loop !j !acc !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##+ !off_nz = Exts.minusWord# (Exts.plusWord# off0 abs_b) 1##+ !off = CT.select_word# off0 off_nz (CT.not is_zero)++ !pr = ct_index_proj# ctxArray off0 s off+ !neg_pr = neg# pr+ !pt_nonzero = select_proj# pr neg_pr bor++ !acc_added = add_proj# acc pt_nonzero+ !nacc = select_proj# acc_added acc is_zero+ in loop (succ j) nacc 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# #-}++-- Constant-time table lookup within a window.+--+-- Unconditionally scans all entries from 'base' to 'base + size - 1',+-- selecting the one where 'index' equals 'target'.+ct_index_proj#+ :: ByteArray+ -> Exts.Word# -- ^ base index+ -> Exts.Word# -- ^ size of window+ -> Exts.Word# -- ^ target index+ -> Proj+ct_index_proj# arr base size target = loop 0## (# Z, Z, Z #) where+ loop i acc+ | Exts.isTrue# (i `Exts.geWord#` size) = acc+ | otherwise =+ let !idx = Exts.plusWord# base i+ !pt = index_proj# arr (Exts.word2Int# idx)+ !eq = CT.from_word_eq# idx target+ !nacc = select_proj# acc pt eq+ in loop (Exts.plusWord# i 1##) nacc+{-# INLINE ct_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 x y z) (Wider s) = case mul_vartime# (# x, y, z #) s of+ (# () | #) -> Nothing+ (# | (# px, py, pz #) #) -> Just $! P px py pz++-- | 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 4++-- 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 = (1 :: 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_vartime (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 (not (S.eq_vartime 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) || not (W.eq_vartime x_R r))+{-# 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 (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 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 -> do+ DRBG.wipe g+ pure Nothing+ Just (r, s)+ | W.eq_vartime r 0 -> sign_loop g -- negligible probability+ | otherwise -> do+ DRBG.wipe g+ let !sig = Just $! ECDSA r s+ pure $ case ty of+ Unrestricted -> sig+ LowS -> 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 drbg mempty (fi _CURVE_Q_BYTES)+ case bytes of+ Left {} -> error "ppad-secp256k1: internal error (please report a bug!)"+ Right bs -> do+ let can = bits2int bs+ case W.cmp_vartime can _CURVE_Q of+ LT -> pure can+ _ -> loop drbg -- 2 ^ -128 probability+{-# 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)+ | CT.decide (W.gt 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)+ | CT.decide (W.gt 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) Hash++-- | 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) Hash++_verify_ecdsa_unrestricted+ :: (Wider -> Maybe Projective) -- partially-applied multiplication function+ -> HashFlag+ -> BS.ByteString+ -> Pub+ -> ECDSA+ -> Bool+_verify_ecdsa_unrestricted _mul hf m p (ECDSA r0 s0) = M.isJust $ do+ -- SEC1-v2 4.1.4+ let h = case hf of+ Hash -> SHA256.hash m+ NoHash -> 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 = case _mul u1 of+ Nothing -> _CURVE_ZERO+ Just pt -> pt+ pt1 <- mul_vartime p u2+ let capR = add pt0 pt1+ guard (capR /= _CURVE_ZERO)+ let Affine (S.to . C.retr -> v) _ = affine capR+ guard (S.eq_vartime v r)+{-# INLINE _verify_ecdsa_unrestricted #-}++-- | Verify a "low-s" ECDSA signature for the provided message digest+-- and public key.+--+-- Mirrors 'verify_ecdsa', but skips the internal SHA256 step,+-- treating the input as the message digest itself.+--+-- >>> _verify_ecdsa_no_hash dig pub valid_sig+-- True+-- >>> _verify_ecdsa_no_hash dig pub invalid_sig+-- False+_verify_ecdsa_no_hash+ :: BS.ByteString -- ^ message digest+ -> Pub -- ^ public key+ -> ECDSA -- ^ signature+ -> Bool+_verify_ecdsa_no_hash m p sig@(ECDSA _ s)+ | W.gt_vartime s _CURVE_QH = False+ | otherwise =+ _verify_ecdsa_unrestricted (mul_vartime _CURVE_G) NoHash m p sig++-- | The same as '_verify_ecdsa_no_hash', except uses a 'Context' to+-- optimise internal calculations.+--+-- You can expect about a 2x performance increase when using this+-- function, compared to '_verify_ecdsa_no_hash'.+--+-- >>> let !tex = precompute+-- >>> _verify_ecdsa_no_hash' tex dig pub valid_sig+-- True+-- >>> _verify_ecdsa_no_hash' tex dig pub invalid_sig+-- False+_verify_ecdsa_no_hash'+ :: Context -- ^ secp256k1 context+ -> BS.ByteString -- ^ message digest+ -> Pub -- ^ public key+ -> ECDSA -- ^ signature+ -> Bool+_verify_ecdsa_no_hash' tex m p sig@(ECDSA _ s)+ | W.gt_vartime s _CURVE_QH = False+ | otherwise =+ _verify_ecdsa_unrestricted (mul_wnaf tex) NoHash m p sig
ppad-secp256k1.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-secp256k1-version: 0.4.0+version: 0.5.7 synopsis: Schnorr signatures, ECDSA, and ECDH on the elliptic curve secp256k1 license: MIT@@ -9,12 +9,17 @@ maintainer: jared@ppad.tech category: Cryptography build-type: Simple-tested-with: GHC == { 9.8.1, 9.6.4 }+tested-with: GHC == { 9.10.3 } extra-doc-files: CHANGELOG description: 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,13 +29,16 @@ hs-source-dirs: lib ghc-options: -Wall+ if flag(llvm)+ ghc-options: -fllvm -O2 exposed-modules: Crypto.Curve.Secp256k1 build-depends: base >= 4.9 && < 5 , bytestring >= 0.9 && < 0.13- , ppad-hmac-drbg >= 0.1 && < 0.2- , ppad-sha256 >= 0.2 && < 0.3+ , ppad-hmac-drbg >= 0.3.1 && < 0.4+ , ppad-sha256 >= 0.3.2 && < 0.4+ , ppad-fixed >= 0.1.5 && < 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
test/BIP340.hs view
@@ -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"
test/Main.hs view
@@ -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
test/Noble.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns -fno-warn-orphans #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -17,10 +17,19 @@ 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 qualified Data.Word.Wider as 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++instance Eq ECDSA where+ ECDSA r0 s0 == ECDSA r1 s1 = Wider.eq_vartime r0 r1 && Wider.eq_vartime s0 s1+ data Ecdsa = Ecdsa { ec_valid :: ![(Int, ValidTest)] , ec_invalid :: !InvalidTest@@ -43,8 +52,11 @@ pec = parse_compact vt_signature Just sig = _sign_ecdsa_no_hash x msg Just sig' = _sign_ecdsa_no_hash' tex x msg+ Just pub = derive_pub x assertEqual mempty sig sig' assertEqual mempty pec sig+ assertBool mempty (_verify_ecdsa_no_hash msg pub sig)+ assertBool mempty (_verify_ecdsa_no_hash' tex msg pub sig) execute_invalid_sign :: Context -> (Int, InvalidSignTest) -> TestTree execute_invalid_sign tex (label, InvalidSignTest {..}) =@@ -63,7 +75,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 +84,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 +98,7 @@ <*> m .: "invalid" data ValidTest = ValidTest {- vt_d :: !Integer+ vt_d :: !Wider , vt_m :: !BS.ByteString , vt_signature :: !BS.ByteString } deriving Show@@ -122,7 +125,7 @@ <*> fmap (zip [0..]) (m .: "verify") data InvalidSignTest = InvalidSignTest {- ivs_d :: !Integer+ ivs_d :: !Wider , ivs_m :: !BS.ByteString } deriving Show
test/Wycheproof.hs view
@@ -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 {
test/WycheproofEcdh.hs view
@@ -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]