diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,15 @@ # Changelog +- 0.2.2 (2026-11-07) + * Fixes 'odd#' and 'odd_vartime' in both Montgomery domains, which + took the parity of a value's Montgomery form rather than of the + value itself, and so returned the wrong answer about half the time. + + * Fixes 'fromInteger' in both Montgomery domains, which reduced its + argument modulo 2 ^ 256 before reducing it modulo the domain's + modulus, and so mapped negative integers, and those of 2 ^ 256 or + more, to the wrong values. + - 0.2.1 (2026-10-27) * Under the llvm flag on x86_64, the library is compiled with LLVM's x86 cmov converter off (-optlc=-x86-cmov-converter=false). The diff --git a/lib/Numeric/Montgomery/Secp256k1/Curve.hs b/lib/Numeric/Montgomery/Secp256k1/Curve.hs --- a/lib/Numeric/Montgomery/Secp256k1/Curve.hs +++ b/lib/Numeric/Montgomery/Secp256k1/Curve.hs @@ -105,7 +105,8 @@ a * b = mul a b negate a = neg a abs = id - fromInteger = to . WW.to_vartime + fromInteger n = to (WW.to_vartime (n `mod` p)) where + p = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F signum (Montgomery (# l0, l1, l2, l3 #)) = let !(Limb l) = l0 `L.or#` l1 `L.or#` l2 `L.or#` l3 !n = C.from_word_nonzero# l @@ -1330,8 +1331,10 @@ in loop o b e (256 :: Word) {-# INLINE exp# #-} +-- parity isn't preserved by the montgomery form, so it's taken of the +-- retrieved value odd# :: Limb4 -> C.Choice -odd# = WW.odd# +odd# m = WW.odd# (retr# m) {-# INLINE odd# #-} -- | Check if a 'Montgomery' value is odd. @@ -1339,12 +1342,10 @@ -- Note that the comparison is performed in constant time, but we -- branch when converting to 'Bool'. -- --- >>> odd 1 +-- >>> odd_vartime 1 -- True --- >>> odd 2 +-- >>> odd_vartime 2 -- False --- >>> Data.Word.Wider.odd (retr 3) -- parity is preserved --- True odd_vartime :: Montgomery -> Bool odd_vartime (Montgomery m) = C.decide (odd# m) diff --git a/lib/Numeric/Montgomery/Secp256k1/Scalar.hs b/lib/Numeric/Montgomery/Secp256k1/Scalar.hs --- a/lib/Numeric/Montgomery/Secp256k1/Scalar.hs +++ b/lib/Numeric/Montgomery/Secp256k1/Scalar.hs @@ -103,7 +103,8 @@ a * b = mul a b negate a = neg a abs = id - fromInteger = to . WW.to_vartime + fromInteger n = to (WW.to_vartime (n `mod` q)) where + q = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141 signum (Montgomery (# l0, l1, l2, l3 #)) = let !(Limb l) = l0 `L.or#` l1 `L.or#` l2 `L.or#` l3 !n = C.from_word_nonzero# l @@ -832,8 +833,10 @@ in loop o b e (256 :: Word) {-# INLINE exp# #-} +-- parity isn't preserved by the montgomery form, so it's taken of the +-- retrieved value odd# :: Limb4 -> C.Choice -odd# = WW.odd# +odd# m = WW.odd# (retr# m) {-# INLINE odd# #-} -- | Check if a 'Montgomery' value is odd. @@ -841,12 +844,10 @@ -- Note that the comparison is performed in constant time, but we -- branch when converting to 'Bool'. -- --- >>> odd 1 +-- >>> odd_vartime 1 -- True --- >>> odd 2 +-- >>> odd_vartime 2 -- False --- >>> Data.Word.Wider.odd (retr 3) -- parity is preserved --- True odd_vartime :: Montgomery -> Bool odd_vartime (Montgomery m) = C.decide (odd# m) diff --git a/ppad-fixed.cabal b/ppad-fixed.cabal --- a/ppad-fixed.cabal +++ b/ppad-fixed.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-fixed -version: 0.2.1 +version: 0.2.2 synopsis: Large fixed-width words and constant-time arithmetic. license: MIT license-file: LICENSE diff --git a/test/Montgomery/Curve.hs b/test/Montgomery/Curve.hs --- a/test/Montgomery/Curve.hs +++ b/test/Montgomery/Curve.hs @@ -125,8 +125,16 @@ H.assertBool "abs 5 * signum 5 = 5" (C.eq_vartime (abs 5 * signum 5) 5) +odd_witness :: H.Assertion +odd_witness = do + -- 2 ^ 224 is even, but its montgomery form is odd + H.assertBool "2 ^ 224 is even" (not (C.odd_vartime (2 ^ (224 :: Int)))) + H.assertBool "2 ^ 224 + 1 is odd" (C.odd_vartime (2 ^ (224 :: Int) + 1)) + +-- the whole 256-bit range, not just small values instance Q.Arbitrary W.Wider where - arbitrary = fmap W.to_vartime Q.arbitrary + arbitrary = + fmap W.to_vartime (Q.chooseInteger (0, 2 ^ (256 :: Int) - 1)) instance Q.Arbitrary C.Montgomery where arbitrary = fmap C.to Q.arbitrary @@ -178,6 +186,15 @@ odd_correct w = C.odd_vartime w == I.integerTestBit (W.from_vartime (C.from w)) 0 +-- integers of either sign, well outside the domain +fromInteger_matches :: Q.Property +fromInteger_matches = + let b = 2 ^ (512 :: Int) + in Q.forAll (Q.chooseInteger (negate b, b)) $ \k -> + W.eq_vartime + (W.to_vartime (k `mod` W.from_vartime m)) + (C.from (fromInteger k)) + tests :: TestTree tests = testGroup "montgomery tests (curve)" [ H.testCase "representation" repr @@ -191,5 +208,8 @@ , Q.testProperty "a ^ b mod m ~ ma ^ mb" $ Q.withMaxSuccess 500 exp_matches , Q.testProperty "n ^ -1 mod m * n ~ 1" $ Q.withMaxSuccess 500 inv_valid , Q.testProperty "odd m ~ odd (from m)" $ Q.withMaxSuccess 500 odd_correct + , H.testCase "odd" odd_witness + , Q.testProperty "fromInteger n ~ n mod m" $ + Q.withMaxSuccess 500 fromInteger_matches ] diff --git a/test/Montgomery/Scalar.hs b/test/Montgomery/Scalar.hs --- a/test/Montgomery/Scalar.hs +++ b/test/Montgomery/Scalar.hs @@ -125,8 +125,16 @@ H.assertBool "abs 5 * signum 5 = 5" (S.eq_vartime (abs 5 * signum 5) 5) +odd_witness :: H.Assertion +odd_witness = do + -- 2 ^ 224 is even, but its montgomery form is odd + H.assertBool "2 ^ 224 is even" (not (S.odd_vartime (2 ^ (224 :: Int)))) + H.assertBool "2 ^ 224 + 1 is odd" (S.odd_vartime (2 ^ (224 :: Int) + 1)) + +-- the whole 256-bit range, not just small values instance Q.Arbitrary W.Wider where - arbitrary = fmap W.to_vartime Q.arbitrary + arbitrary = + fmap W.to_vartime (Q.chooseInteger (0, 2 ^ (256 :: Int) - 1)) instance Q.Arbitrary S.Montgomery where arbitrary = fmap S.to Q.arbitrary @@ -174,6 +182,19 @@ inv_valid :: Q.NonZero S.Montgomery -> Bool inv_valid (Q.NonZero s) = S.eq_vartime (S.inv s * s) 1 +odd_correct :: S.Montgomery -> Bool +odd_correct w = + S.odd_vartime w == I.integerTestBit (W.from_vartime (S.from w)) 0 + +-- integers of either sign, well outside the domain +fromInteger_matches :: Q.Property +fromInteger_matches = + let b = 2 ^ (512 :: Int) + in Q.forAll (Q.chooseInteger (negate b, b)) $ \k -> + W.eq_vartime + (W.to_vartime (k `mod` W.from_vartime m)) + (S.from (fromInteger k)) + tests :: TestTree tests = testGroup "montgomery tests (scalar)" [ H.testCase "representation" repr @@ -186,5 +207,9 @@ , Q.testProperty "a ^ 2 mod m ~ ma ^ 2" $ Q.withMaxSuccess 500 sqr_matches , Q.testProperty "a ^ b mod m ~ ma ^ mb" $ Q.withMaxSuccess 500 exp_matches , Q.testProperty "n ^ -1 mod m * n ~ 1" $ Q.withMaxSuccess 500 inv_valid + , Q.testProperty "odd m ~ odd (from m)" $ Q.withMaxSuccess 500 odd_correct + , H.testCase "odd" odd_witness + , Q.testProperty "fromInteger n ~ n mod m" $ + Q.withMaxSuccess 500 fromInteger_matches ] diff --git a/test/Wider.hs b/test/Wider.hs --- a/test/Wider.hs +++ b/test/Wider.hs @@ -200,8 +200,10 @@ H.assertBool "select on no carry" (W.eq_vartime (W.select 0 1 c2) 0) +-- the whole 256-bit range, not just small values instance Q.Arbitrary W.Wider where - arbitrary = fmap W.to_vartime Q.arbitrary + arbitrary = + fmap W.to_vartime (Q.chooseInteger (0, 2 ^ (256 :: Int) - 1)) odd_correct :: W.Wider -> Bool odd_correct w = C.decide (W.odd w) == I.integerTestBit (W.from_vartime w) 0