commit 5799e341305792dcbeb425c0a891e300d0d858af
parent b739aed3958cb028c77fc623754e6466dcd0f59f
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 20 Dec 2025 17:25:51 -0330
lib: constant-time exp
Diffstat:
4 files changed, 193 insertions(+), 66 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -4,6 +4,7 @@
module Main where
+import Data.Word.Wider (Wider)
import qualified Numeric.Montgomery.Secp256k1.Curve as C
import qualified Numeric.Montgomery.Secp256k1.Scalar as S
import Criterion.Main
@@ -17,86 +18,148 @@ main = defaultMain [
, sqr
, inv
, exp
+ , exp_vartime
, sqrt
, redc
, retr
]
add :: Benchmark
-add = bgroup "add" [
- bench "curve: M(1) + M(2)" $ nf (C.add 1) 2
- , bench "curve: M(1) + M(2 ^ 255 - 19)" $ nf (C.add 1) (2 ^ 255 - 19)
- , bench "scalar: M(1) + M(2)" $ nf (S.add 1) 2
- , bench "scalar: M(1) + M(2 ^ 255 - 19)" $ nf (S.add 1) (2 ^ 255 - 19)
- ]
+add =
+ let !c1 = 1 :: C.Montgomery
+ !c2 = 2 :: C.Montgomery
+ !c_big = (2 ^ 255 - 19) :: C.Montgomery
+ !s1 = 1 :: S.Montgomery
+ !s2 = 2 :: S.Montgomery
+ !s_big = (2 ^ 255 - 19) :: S.Montgomery
+ in bgroup "add" [
+ bench "curve: M(1) + M(2)" $ nf (C.add c1) c2
+ , bench "curve: M(1) + M(2 ^ 255 - 19)" $ nf (C.add c1) c_big
+ , bench "scalar: M(1) + M(2)" $ nf (S.add s1) s2
+ , bench "scalar: M(1) + M(2 ^ 255 - 19)" $ nf (S.add s1) s_big
+ ]
sub :: Benchmark
-sub = bgroup "sub" [
- bench "curve: M(2 ^ 255 - 1) - M(1)" $ nf
- (C.sub (2 ^ 255 - 1))
- 1
- , bench "curve: M(2 ^ 255 - 1) - M(2 ^ 255 - 19)" $ nf
- (C.sub (2 ^ 255 - 1))
- (2 ^ 255 - 19)
- , bench "scalar: M(2 ^ 255 - 1) - M(1)" $ nf
- (S.sub (2 ^ 255 - 1))
- 1
- , bench "scalar: M(2 ^ 255 - 1) - M(2 ^ 255 - 19)" $ nf
- (S.sub (2 ^ 255 - 1))
- (2 ^ 255 - 19)
- ]
+sub =
+ let !c_max = (2 ^ 255 - 1) :: C.Montgomery
+ !c1 = 1 :: C.Montgomery
+ !c_big = (2 ^ 255 - 19) :: C.Montgomery
+ !s_max = (2 ^ 255 - 1) :: S.Montgomery
+ !s1 = 1 :: S.Montgomery
+ !s_big = (2 ^ 255 - 19) :: S.Montgomery
+ in bgroup "sub" [
+ bench "curve: M(2 ^ 255 - 1) - M(1)" $ nf (C.sub c_max) c1
+ , bench "curve: M(2 ^ 255 - 1) - M(2 ^ 255 - 19)" $
+ nf (C.sub c_max) c_big
+ , bench "scalar: M(2 ^ 255 - 1) - M(1)" $ nf (S.sub s_max) s1
+ , bench "scalar: M(2 ^ 255 - 1) - M(2 ^ 255 - 19)" $
+ nf (S.sub s_max) s_big
+ ]
mul :: Benchmark
-mul = bgroup "mul" [
- 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)
- , bench "scalar: M(2) * M(2)" $ nf (S.mul 2) 2
- , bench "scalar: M(2) * M(2 ^ 255 - 19)" $ nf (S.mul 2) (2 ^ 255 - 19)
- ]
+mul =
+ let !c2 = 2 :: C.Montgomery
+ !c_big = (2 ^ 255 - 19) :: C.Montgomery
+ !s2 = 2 :: S.Montgomery
+ !s_big = (2 ^ 255 - 19) :: S.Montgomery
+ in bgroup "mul" [
+ bench "curve: M(2) * M(2)" $ nf (C.mul c2) c2
+ , bench "curve: M(2) * M(2 ^ 255 - 19)" $ nf (C.mul c2) c_big
+ , bench "scalar: M(2) * M(2)" $ nf (S.mul s2) s2
+ , bench "scalar: M(2) * M(2 ^ 255 - 19)" $ nf (S.mul s2) s_big
+ ]
sqr :: Benchmark
-sqr = bgroup "sqr" [
- bench "curve: M(2) ^ 2" $ nf C.sqr 2
- , bench "curve: M(2 ^ 255 - 19) ^ 2" $ nf C.sqr (2 ^ 255 - 19)
- , bench "scalar: M(2) ^ 2" $ nf S.sqr 2
- , bench "scalar: M(2 ^ 255 - 19) ^ 2" $ nf S.sqr (2 ^ 255 - 19)
- ]
+sqr =
+ let !c2 = 2 :: C.Montgomery
+ !c_big = (2 ^ 255 - 19) :: C.Montgomery
+ !s2 = 2 :: S.Montgomery
+ !s_big = (2 ^ 255 - 19) :: S.Montgomery
+ in bgroup "sqr" [
+ bench "curve: M(2) ^ 2" $ nf C.sqr c2
+ , bench "curve: M(2 ^ 255 - 19) ^ 2" $ nf C.sqr c_big
+ , bench "scalar: M(2) ^ 2" $ nf S.sqr s2
+ , bench "scalar: M(2 ^ 255 - 19) ^ 2" $ nf S.sqr s_big
+ ]
inv :: Benchmark
-inv = bgroup "inv" [
- bench "curve: M(2) ^ -1" $ nf C.inv 2
- , bench "curve: M(2 ^ 255 - 19) ^ -1" $ nf C.inv (2 ^ 255 - 19)
- , bench "scalar: M(2) ^ -1" $ nf S.inv 2
- , bench "scalar: M(2 ^ 255 - 19) ^ -1" $ nf S.inv (2 ^ 255 - 19)
- ]
+inv =
+ let !c2 = 2 :: C.Montgomery
+ !c_big = (2 ^ 255 - 19) :: C.Montgomery
+ !s2 = 2 :: S.Montgomery
+ !s_big = (2 ^ 255 - 19) :: S.Montgomery
+ in bgroup "inv" [
+ bench "curve: M(2) ^ -1" $ nf C.inv c2
+ , bench "curve: M(2 ^ 255 - 19) ^ -1" $ nf C.inv c_big
+ , bench "scalar: M(2) ^ -1" $ nf S.inv s2
+ , bench "scalar: M(2 ^ 255 - 19) ^ -1" $ nf S.inv s_big
+ ]
sqrt :: Benchmark
-sqrt = bgroup "sqrt" [
- bench "curve: sqrt M(2)" $ nf C.sqrt 2
- , bench "curve: sqrt M(2 ^ 255 - 19)" $ nf C.sqrt (2 ^ 255 - 19)
- ]
+sqrt =
+ let !c2 = 2 :: C.Montgomery
+ !c_big = (2 ^ 255 - 19) :: C.Montgomery
+ in bgroup "sqrt" [
+ bench "curve: sqrt M(2)" $ nf C.sqrt c2
+ , bench "curve: sqrt M(2 ^ 255 - 19)" $ nf C.sqrt c_big
+ ]
exp :: Benchmark
-exp = bgroup "exp" [
- bench "curve: M(2) ^ 2" $ nf C.exp 2
- , bench "curve: M(2 ^ 255 - 19) ^ 2" $ nf C.exp (2 ^ 255 - 19)
- , bench "scalar: M(2) ^ 2" $ nf S.exp 2
- , bench "scalar: M(2 ^ 255 - 19) ^ 2" $ nf S.exp (2 ^ 255 - 19)
- ]
+exp =
+ let !c2 = 2 :: C.Montgomery
+ !c_big = (2 ^ 255 - 19) :: C.Montgomery
+ !s2 = 2 :: S.Montgomery
+ !s_big = (2 ^ 255 - 19) :: S.Montgomery
+ !e2 = 2 :: Wider
+ !e_big = (2 ^ 255 - 19) :: Wider
+ in bgroup "exp" [
+ bench "curve: M(2) ^ 2" $ nf (C.exp c2) e2
+ , bench "curve: M(2 ^ 255 - 19) ^ (2 ^ 255 - 19)" $
+ nf (C.exp c_big) e_big
+ , bench "scalar: M(2) ^ 2" $ nf (S.exp s2) e2
+ , bench "scalar: M(2 ^ 255 - 19) ^ (2 ^ 255 - 19)" $
+ nf (S.exp s_big) e_big
+ ]
+
+exp_vartime :: Benchmark
+exp_vartime =
+ let !c2 = 2 :: C.Montgomery
+ !c_big = (2 ^ 255 - 19) :: C.Montgomery
+ !s2 = 2 :: S.Montgomery
+ !s_big = (2 ^ 255 - 19) :: S.Montgomery
+ !e2 = 2 :: Wider
+ !e_big = (2 ^ 255 - 19) :: Wider
+ in bgroup "exp_vartime" [
+ bench "curve: M(2) ^ 2" $ nf (C.exp_vartime c2) e2
+ , bench "curve: M(2 ^ 255 - 19) ^ (2 ^ 255 - 19)" $
+ nf (C.exp_vartime c_big) e_big
+ , bench "scalar: M(2) ^ 2" $ nf (S.exp_vartime s2) e2
+ , bench "scalar: M(2 ^ 255 - 19) ^ (2 ^ 255 - 19)" $
+ nf (S.exp_vartime s_big) e_big
+ ]
redc :: Benchmark
-redc = bgroup "redc" [
- bench "curve: REDC(M(2), M(2))" $ nf (C.redc 2) 2
- , bench "curve: REDC(M(2), M(2 ^ 255 - 19))" $ nf (C.redc 2) (2 ^ 255 - 19)
- , bench "scalar: REDC(M(2), M(2))" $ nf (S.redc 2) 2
- , bench "scalar: REDC(M(2), M(2 ^ 255 - 19))" $ nf (S.redc 2) (2 ^ 255 - 19)
- ]
+redc =
+ let !c2 = 2 :: C.Montgomery
+ !c_big = (2 ^ 255 - 19) :: C.Montgomery
+ !s2 = 2 :: S.Montgomery
+ !s_big = (2 ^ 255 - 19) :: S.Montgomery
+ in bgroup "redc" [
+ bench "curve: REDC(M(2), M(2))" $ nf (C.redc c2) c2
+ , bench "curve: REDC(M(2), M(2 ^ 255 - 19))" $ nf (C.redc c2) c_big
+ , bench "scalar: REDC(M(2), M(2))" $ nf (S.redc s2) s2
+ , bench "scalar: REDC(M(2), M(2 ^ 255 - 19))" $ nf (S.redc s2) s_big
+ ]
retr :: Benchmark
-retr = bgroup "retr" [
- bench "curve: RETR(M(2))" $ nf C.retr 2
- , bench "curve: RETR(M(2 ^ 255 - 19))" $ nf C.retr (2 ^ 255 - 19)
- , bench "scalar: RETR(M(2))" $ nf S.retr 2
- , bench "scalar: RETR(M(2 ^ 255 - 19))" $ nf S.retr (2 ^ 255 - 19)
- ]
-
+retr =
+ let !c2 = 2 :: C.Montgomery
+ !c_big = (2 ^ 255 - 19) :: C.Montgomery
+ !s2 = 2 :: S.Montgomery
+ !s_big = (2 ^ 255 - 19) :: S.Montgomery
+ in bgroup "retr" [
+ bench "curve: RETR(M(2))" $ nf C.retr c2
+ , bench "curve: RETR(M(2 ^ 255 - 19))" $ nf C.retr c_big
+ , bench "scalar: RETR(M(2))" $ nf S.retr s2
+ , bench "scalar: RETR(M(2 ^ 255 - 19))" $ nf S.retr s_big
+ ]
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -4,9 +4,10 @@
module Main where
-import Prelude hiding (sqrt)
+import Data.Word.Wider (Wider)
import qualified Numeric.Montgomery.Secp256k1.Curve as C
import qualified Numeric.Montgomery.Secp256k1.Scalar as S
+import Prelude hiding (sqrt, exp)
import Weigh
-- note that 'weigh' doesn't work properly in a repl
@@ -17,6 +18,8 @@ main = mainWith $ do
mul
sqr
inv
+ exp
+ exp_vartime
sqrt
redc
retr
@@ -85,6 +88,30 @@ inv =
func "scalar: M(2) ^ -1" S.inv s2
func "scalar: M(2 ^ 255 - 19) ^ -1" S.inv s_big
+exp :: Weigh ()
+exp =
+ let !c2 = 2 :: C.Montgomery
+ !s2 = 2 :: S.Montgomery
+ !sma = 2 :: Wider
+ !big = (2 ^ 255 - 19) :: Wider
+ in wgroup "exp" $ do
+ func "curve: M(2) ^ 2" (C.exp c2) sma
+ func "curve: M(2) ^ (2 ^ 255 - 19)" (C.exp c2) big
+ func "scalar: M(2) ^ 2" (S.exp s2) sma
+ func "scalar: M(2) ^ (2 ^ 255 - 19)" (S.exp s2) big
+
+exp_vartime :: Weigh ()
+exp_vartime =
+ let !c2 = 2 :: C.Montgomery
+ !s2 = 2 :: S.Montgomery
+ !sma = 2 :: Wider
+ !big = (2 ^ 255 - 19) :: Wider
+ in wgroup "exp_vartime" $ do
+ func "curve: M(2) ^ 2" (C.exp_vartime c2) sma
+ func "curve: M(2) ^ (2 ^ 255 - 19)" (C.exp_vartime c2) big
+ func "scalar: M(2) ^ 2" (S.exp_vartime s2) sma
+ func "scalar: M(2) ^ (2 ^ 255 - 19)" (S.exp_vartime s2) big
+
sqrt :: Weigh ()
sqrt =
let !c2 = 2 :: C.Montgomery
diff --git a/lib/Numeric/Montgomery/Secp256k1/Curve.hs b/lib/Numeric/Montgomery/Secp256k1/Curve.hs
@@ -54,6 +54,7 @@ module Numeric.Montgomery.Secp256k1.Curve (
, sqrt
, sqrt#
, exp
+ , exp_vartime
, odd#
, odd
) where
@@ -1523,7 +1524,25 @@ sqrt# a =
-- >>> exp 2 10
-- 1024
exp :: Montgomery -> Wider -> Montgomery
-exp b = loop 1 b where
+exp (Montgomery b) (Wider e) =
+ let !one# = (# Limb 0x1000003D1##, Limb 0##, Limb 0##, Limb 0## #)
+ loop !r !_ !_ 0 = r
+ loop !r !m !ex !n =
+ let !(# ne, bit #) = WW.shr1_c# ex
+ !candidate = mul# r m
+ !nr = select# r candidate bit
+ !nm = sqr# m
+ in loop nr nm ne (n - 1)
+ in Montgomery (loop one# b e (256 :: Word))
+
+-- | Variable-time exponentiation in the Montgomery domain.
+--
+-- >>> exp_vartime 2 3
+-- 8
+-- >>> exp_vartime 2 10
+-- 1024
+exp_vartime :: Montgomery -> Wider -> Montgomery
+exp_vartime b = loop 1 b where
loop !r !m !e = case WW.cmp e 0 of
GT ->
let !nm = sqr m
diff --git a/lib/Numeric/Montgomery/Secp256k1/Scalar.hs b/lib/Numeric/Montgomery/Secp256k1/Scalar.hs
@@ -52,6 +52,7 @@ module Numeric.Montgomery.Secp256k1.Scalar (
, inv
, inv#
, exp
+ , exp_vartime
, odd#
, odd
) where
@@ -941,8 +942,6 @@ inv
-> Montgomery -- ^ inverse
inv (Montgomery w) = Montgomery (inv# w)
--- XX want unboxed variant
-
-- | Exponentiation in the Montgomery domain.
--
-- >>> exp 2 3
@@ -950,7 +949,26 @@ inv (Montgomery w) = Montgomery (inv# w)
-- >>> exp 2 10
-- 1024
exp :: Montgomery -> Wider -> Montgomery
-exp b = loop 1 b where
+exp (Montgomery b) (Wider e) =
+ let !one# = (# Limb 0x402DA1732FC9BEBF##, Limb 0x4551231950B75FC4##
+ , Limb 0x0000000000000001##, Limb 0x0000000000000000## #)
+ loop !r !_ !_ 0 = r
+ loop !r !m !ex !n =
+ let !(# ne, bit #) = WW.shr1_c# ex
+ !candidate = mul# r m
+ !nr = select# r candidate bit
+ !nm = sqr# m
+ in loop nr nm ne (n - 1)
+ in Montgomery (loop one# b e (256 :: Word))
+
+-- | Variable-time exponentiation in the Montgomery domain.
+--
+-- >>> exp_vartime 2 3
+-- 8
+-- >>> exp_vartime 2 10
+-- 1024
+exp_vartime :: Montgomery -> Wider -> Montgomery
+exp_vartime b = loop 1 b where
loop !r !m !e = case WW.cmp e 0 of
GT ->
let !nm = sqr m
