packages feed

ppad-secp256k1 0.5.0 → 0.5.1

raw patch · 4 files changed

+67/−34 lines, 4 filesdep ~ppad-fixedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: ppad-fixed

API changes (from Hackage documentation)

- Crypto.Curve.Secp256k1: instance GHC.Classes.Eq Crypto.Curve.Secp256k1.ECDSA

Files

CHANGELOG view
@@ -1,5 +1,10 @@ # Changelog +- 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.
lib/Crypto/Curve/Secp256k1.hs view
@@ -283,9 +283,12 @@     Storable.pokeByteOff ptr 31 (word8 w0) {-# INLINABLE unroll32 #-} --- cheeky montgomery-assisted modQ+-- modQ via conditional subtraction modQ :: Wider -> Wider-modQ = S.from . S.to+modQ x =+  let !(Wider xw) = x+      !(Wider qw) = _CURVE_Q+  in  W.select x (x - _CURVE_Q) (CT.not (W.lt# xw qw)) {-# INLINABLE modQ #-}  -- bytewise xor@@ -333,7 +336,11 @@  -- Is field element? fe :: Wider -> Bool-fe n = n > 0 && n < _CURVE_P+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?@@ -361,7 +368,7 @@         !x2z1 = bx * az         !y1z2 = ay * bz         !y2z1 = by * az-    in  CT.decide (CT.and# (C.eq x1z2 x2z1) (C.eq y1z2 y2z1))+    in  CT.decide (CT.and (C.eq x1z2 x2z1) (C.eq y1z2 y2z1))  -- | An ECC-flavoured alias for a secp256k1 point. type Pub = Projective@@ -375,9 +382,9 @@  -- Convert to projective coordinates. projective :: Affine -> Projective-projective = \case-  Affine 0 0 -> _CURVE_ZERO-  Affine x y -> Projective x y 1+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@@ -407,10 +414,7 @@  -- Point is valid valid :: Projective -> Bool-valid p = case affine p of-  Affine x y-    | C.sqr y /= weierstrass x -> False-    | otherwise -> True+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 --@@ -425,10 +429,9 @@ lift_vartime :: C.Montgomery -> Maybe Affine lift_vartime x = do   let !c = weierstrass x-  !y <- C.sqrt c-  let !y_e | C.odd y   = negate y+  !y <- C.sqrt_vartime c+  let !y_e | C.odd_vartime y = negate y            | otherwise = y-  guard (C.sqr y_e == c)   pure $! Affine x y_e  even_y_vartime :: Projective -> Projective@@ -554,7 +557,7 @@  mul# :: Proj -> Limb4 -> (# () | Proj #) mul# (# px, py, pz #) s-    | CT.decide (CT.not# (ge# s)) = (# () | #)+    | CT.decide (CT.not (ge# s)) = (# () | #)     | otherwise =         let !(P gx gy gz) = _CURVE_G             !(C.Montgomery o) = C.one@@ -573,12 +576,12 @@ ge# :: Limb4 -> CT.Choice ge# n =   let !(Wider q) = _CURVE_Q-  in  CT.and# (W.gt# n Z) (W.lt# n 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)) = (# () | #)+    | CT.decide (CT.not (ge# ls)) = (# () | #)     | otherwise =         let !(P zx zy zz) = _CURVE_ZERO             !(P gx gy gz) = _CURVE_G@@ -606,9 +609,9 @@               !is_zero     = CT.from_word_eq# b0 0##               !c0          = CT.from_word# (Exts.and# w 1##)               !off_nz      = Exts.minusWord# (Exts.plusWord# off0 abs_b) 1##-              !off         = CT.select_word# off0 off_nz (CT.not# is_zero)+              !off         = CT.select_word# off0 off_nz (CT.not is_zero) -              !pr          = index_proj# ctxArray (Exts.word2Int# off)+              !pr          = ct_index_proj# ctxArray off0 s off               !neg_pr      = neg# pr               !pt_zero     = select_proj# pr neg_pr c0               !pt_nonzero  = select_proj# pr neg_pr bor@@ -639,6 +642,27 @@   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.@@ -720,7 +744,7 @@ --   >>> sign_ecdsa' tex sec msg --   >>> sign_schnorr' tex sec msg aux precompute :: Context-precompute = _precompute 8+precompute = _precompute 4  -- This is a highly-optimized version of a function originally -- translated from noble-secp256k1's "precompute". Points are stored in@@ -865,7 +889,7 @@   | not (fe x) = Nothing   | otherwise = do       let !mx = C.to x-      !my <- C.sqrt (weierstrass mx)+      !my <- C.sqrt_vartime (weierstrass mx)       let !yodd = CT.decide (W.odd (C.retr my))           !hodd = B.testBit h 0       pure $!@@ -995,7 +1019,7 @@       t       = xor bytes_d (hash_aux a)       rand    = hash_nonce (t <> bytes_p <> m)       k'      = S.to (unsafe_roll32 rand)-  guard (k' /= 0) -- negligible probability+  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)@@ -1064,7 +1088,7 @@       let dif = add pt0 (neg pt1)       guard (dif /= _CURVE_ZERO)       let Affine (C.from -> x_R) (C.from -> y_R) = affine dif-      guard $ not (CT.decide (W.odd y_R) || x_R /= r) -- XX+      guard $ not (CT.decide (W.odd y_R) || not (W.eq_vartime x_R r)) {-# INLINE _verify_schnorr #-}  -- hardcoded tag of BIP0340/aux@@ -1113,7 +1137,7 @@     ecdsa_r :: !Wider   , ecdsa_s :: !Wider   }-  deriving (Eq, Generic)+  deriving (Generic)  instance Show ECDSA where   show _ = "<ecdsa signature>"@@ -1250,7 +1274,7 @@       case mpair of         Nothing -> pure Nothing         Just (r, s)-          | r == 0 -> sign_loop g -- negligible probability+          | W.eq_vartime r 0 -> sign_loop g -- negligible probability           | otherwise ->               let !sig = Just $! ECDSA r s               in  case ty of@@ -1264,9 +1288,9 @@   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+    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@@ -1285,7 +1309,7 @@   -> ECDSA         -- ^ signature   -> Bool verify_ecdsa m p sig@(ECDSA _ s)-  | s > _CURVE_QH = False+  | 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@@ -1306,7 +1330,7 @@   -> ECDSA         -- ^ signature   -> Bool verify_ecdsa' tex m p sig@(ECDSA _ s)-  | s > _CURVE_QH = False+  | 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@@ -1363,6 +1387,6 @@   let capR = add pt0 pt1   guard (capR /= _CURVE_ZERO)   let Affine (S.to . C.retr -> v) _ = affine capR-  guard (v == r)+  guard (S.eq_vartime v r) {-# INLINE _verify_ecdsa_unrestricted #-}
ppad-secp256k1.cabal view
@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               ppad-secp256k1-version:            0.5.0+version:            0.5.1 synopsis:           Schnorr signatures, ECDSA, and ECDH on the elliptic curve                     secp256k1 license:            MIT@@ -38,7 +38,7 @@     , bytestring >= 0.9 && < 0.13     , ppad-hmac-drbg >= 0.1 && < 0.2     , ppad-sha256 >= 0.2 && < 0.3-    , ppad-fixed >= 0.1 && < 0.2+    , ppad-fixed >= 0.1.2 && < 0.2     , primitive >= 0.8 && < 0.10  test-suite secp256k1-tests
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 #-}@@ -18,6 +18,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE 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) @@ -25,6 +26,9 @@ 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)]