secp256k1

commit 9a388fbe19567ab3b2e43a807a9474b4bdf05130
parent 0b61b1d192f13631bb15d9ae860fe964e5d9a57d
Author: Jared Tobin <jared@jtobin.io>
Date:   Fri, 18 Oct 2024 14:39:10 +0400

lib: constant-time mul

benchmarking mul/2 G
time                 1.626 ms   (1.607 ms .. 1.643 ms)
                     0.999 R²   (0.999 R² .. 1.000 R²)
mean                 1.656 ms   (1.644 ms .. 1.673 ms)
std dev              47.83 μs   (36.46 μs .. 63.24 μs)
variance introduced by outliers: 16% (moderately inflated)

benchmarking mul/(2 ^ 255 - 19) G
time                 1.642 ms   (1.630 ms .. 1.658 ms)
                     0.999 R²   (0.999 R² .. 1.000 R²)
mean                 1.634 ms   (1.626 ms .. 1.644 ms)
std dev              31.30 μs   (25.58 μs .. 38.87 μs)

Diffstat:
M
bench/Main.hs
 | 
14
++++++++------
M
lib/Crypto/Curve/Secp256k1.hs
 | 
29
++++++++++++-----------------

2 files changed, 20 insertions(+), 23 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -53,12 +53,14 @@ add = bgroup "add" [
   ]
 
 mul :: Benchmark
-mul = bgroup "mul" [
-    bench "3 p (trivial projective point)" $ nf (S.mul p) 3
-  , bench "3 r (nontrivial projective point)" $ nf (S.mul r) 3
-  , bench "<large group element> p" $
-      nf (S.mul p) (S._CURVE_Q - 0xFFFFFFFFFFFFFFFFFFFFFFFF)
-  ]
+mul = env setup $ \x ->
+    bgroup "mul" [
+      bench "2 G" $ nf (S.mul S._CURVE_G) 2
+    , bench "(2 ^ 255 - 19) G" $ nf (S.mul S._CURVE_G) x
+    ]
+  where
+    setup = pure . S.parse_int256 $ B16.decodeLenient
+      "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"
 
 schnorr :: Benchmark
 schnorr = bgroup "schnorr" [
diff --git a/lib/Crypto/Curve/Secp256k1.hs b/lib/Crypto/Curve/Secp256k1.hs
@@ -56,6 +56,7 @@ module Crypto.Curve.Secp256k1 (
   , _sign_ecdsa_no_hash
   , _CURVE_P
   , _CURVE_Q
+  , _CURVE_G
   ) where
 
 import Control.Monad (when)
@@ -537,26 +538,20 @@ double (Projective x y z) = runST $ do
   modifySTRef' x3 (\rx3 -> modP (rx3 + rx3))
   Projective <$> readSTRef x3 <*> readSTRef y3 <*> readSTRef z3
 
--- XX must take into account integer size
-
 -- Timing-safe scalar multiplication of secp256k1 points.
 mul :: Projective -> Integer -> Projective
-mul p _MAYBE_SECRET
-    | not (ge _MAYBE_SECRET) =
-        error "ppad-secp256k1 (mul): scalar not in group"
-    | otherwise  = loop _ZERO _CURVE_G p _MAYBE_SECRET
+mul p _SECRET
+    | not (ge _SECRET) = error "ppad-secp256k1 (mul): scalar not in group"
+    | otherwise  = loop (0 :: Int) _ZERO _CURVE_G p _SECRET
   where
-    loop !r !f !d m
-      | m <= 0 = r
+    loop !j !acc !f !d !m
+      | j == _CURVE_Q_BITS = acc
       | otherwise =
           let nd = double d
               nm = I.integerShiftR m 1
-              ev = I.integerTestBit m 0
-              nr | ev = add r d
-                 | otherwise = r
-              nf | not ev = add f d
-                 | otherwise = f
-          in  loop nr nf nd nm
+          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
 {-# NOINLINE mul #-}
 
 -- Timing-unsafe scalar multiplication of secp256k1 points.
@@ -707,8 +702,8 @@ verify_schnorr m (affine -> Affine x_p _) sig
             then False
             else let e = modQ . roll32 $ hash_tagged "BIP0340/challenge"
                            (unroll32 r <> unroll32 x_P <> m)
-                     dif = add (mul _CURVE_G s)
-                               (neg (mul (projective capP) e))
+                     dif = add (mul_unsafe _CURVE_G s)
+                               (neg (mul_unsafe (projective capP) e))
                  in  if   dif == _ZERO
                      then False
                      else let Affine x_R y_R = affine dif
@@ -900,7 +895,7 @@ verify_ecdsa_unrestricted (SHA256.hash -> h) p (ECDSA r s)
             Just si -> si
           u1   = remQ (e * s_inv)
           u2   = remQ (r * s_inv)
-          capR = add (mul _CURVE_G u1) (mul p u2)
+          capR = add (mul_unsafe _CURVE_G u1) (mul_unsafe p u2)
       in  if   capR == _ZERO
           then False
           else let Affine (modQ -> v) _ = affine capR