fixed

commit 711fb0e5286505e5a4688cd35e95d3e49287dc7e
parent d005913bf324ca4db9d90550765433fed30ed22e
Author: Jared Tobin <jared@jtobin.io>
Date:   Sat,  1 Aug 2026 14:10:05 -0230

lib: fix Montgomery signum

signum returned raw limbs (1, 0, 0, 0), which in the Montgomery
domain represents R^-1 rather than the multiplicative unit, so e.g.
abs x * signum x /= x. Select between the domain's zero and one
instead.

Diffstat:
M
lib/Numeric/Montgomery/Secp256k1/Curve.hs
 | 
5
+++--
M
lib/Numeric/Montgomery/Secp256k1/Scalar.hs
 | 
5
+++--
M
test/Montgomery/Curve.hs
 | 
8
++++++++
M
test/Montgomery/Scalar.hs
 | 
8
++++++++

4 files changed, 22 insertions(+), 4 deletions(-)
diff --git a/lib/Numeric/Montgomery/Secp256k1/Curve.hs b/lib/Numeric/Montgomery/Secp256k1/Curve.hs
@@ -109,8 +109,9 @@ instance Num Montgomery where
   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
-        !b = C.to_word# n
-    in  Montgomery (# Limb b, Limb 0##, Limb 0##, Limb 0## #)
+        !(Montgomery z) = zero
+        !(Montgomery o) = one
+    in  Montgomery (select# z o n)
 
 instance NFData Montgomery where
   rnf (Montgomery a) = case a of (# _, _, _, _ #) -> ()
diff --git a/lib/Numeric/Montgomery/Secp256k1/Scalar.hs b/lib/Numeric/Montgomery/Secp256k1/Scalar.hs
@@ -107,8 +107,9 @@ instance Num Montgomery where
   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
-        !b = C.to_word# n
-    in  Montgomery (L4 b 0## 0## 0##)
+        !(Montgomery z) = zero
+        !(Montgomery o) = one
+    in  Montgomery (select# z o n)
 
 instance NFData Montgomery where
   rnf (Montgomery a) = case a of (# _, _, _, _ #) -> ()
diff --git a/test/Montgomery/Curve.hs b/test/Montgomery/Curve.hs
@@ -118,6 +118,13 @@ mul = do
     0x00000000000000000000000000000000000000000000000000000001000003D1
     0x000000000000000000000000000000000000000000000001000007A2000E90A1
 
+signum_correct :: H.Assertion
+signum_correct = do
+  H.assertBool "signum 0 = 0" (C.eq_vartime (signum 0) 0)
+  H.assertBool "signum 5 = 1" (C.eq_vartime (signum 5) 1)
+  H.assertBool "abs 5 * signum 5 = 5"
+    (C.eq_vartime (abs 5 * signum 5) 5)
+
 instance Q.Arbitrary W.Wider where
   arbitrary = fmap W.to_vartime Q.arbitrary
 
@@ -177,6 +184,7 @@ tests = testGroup "montgomery tests (curve)" [
   , H.testCase "add" add
   , H.testCase "sub" sub
   , H.testCase "mul" mul
+  , H.testCase "signum" signum_correct
   , Q.testProperty "a + b mod m ~ ma + mb" $ Q.withMaxSuccess 500 add_matches
   , Q.testProperty "a * b mod m ~ ma * mb" $ Q.withMaxSuccess 500 mul_matches
   , Q.testProperty "a ^ 2 mod m ~ ma ^ 2"  $ Q.withMaxSuccess 500 sqr_matches
diff --git a/test/Montgomery/Scalar.hs b/test/Montgomery/Scalar.hs
@@ -118,6 +118,13 @@ mul = do
     0x000000000000000000000000000000014551231950B75FC4402DA1732FC9BEBF
     0x9D671CD581C69BC5E697F5E45BCD07C6741496C20E7CF878896CF21467D7D140
 
+signum_correct :: H.Assertion
+signum_correct = do
+  H.assertBool "signum 0 = 0" (S.eq_vartime (signum 0) 0)
+  H.assertBool "signum 5 = 1" (S.eq_vartime (signum 5) 1)
+  H.assertBool "abs 5 * signum 5 = 5"
+    (S.eq_vartime (abs 5 * signum 5) 5)
+
 instance Q.Arbitrary W.Wider where
   arbitrary = fmap W.to_vartime Q.arbitrary
 
@@ -173,6 +180,7 @@ tests = testGroup "montgomery tests (scalar)" [
   , H.testCase "add" add
   , H.testCase "sub" sub
   , H.testCase "mul" mul
+  , H.testCase "signum" signum_correct
   , Q.testProperty "a + b mod m ~ ma + mb" $ Q.withMaxSuccess 500 add_matches
   , Q.testProperty "a * b mod m ~ ma * mb" $ Q.withMaxSuccess 500 mul_matches
   , Q.testProperty "a ^ 2 mod m ~ ma ^ 2"  $ Q.withMaxSuccess 500 sqr_matches