packages feed

ppad-fixed 0.1.6 → 0.2.2

raw patch · 11 files changed

Files

CHANGELOG view
@@ -1,5 +1,35 @@ # 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+    converter rewrites a conditional move whose operand is a load as a+    branch, and so made the borrow-masked correction of sub_mod,+    sub_mod#, and sub_mod_c# a branch on the borrow, which depends on+    the operands. NCG builds, and aarch64, were unaffected.++- 0.2.0 (2026-08-01)+  * Addresses a couple of minor issues detected by an LLM scan:++    * Fixes a bug that could lead shl1_c# to produce a malformed Choice+      that would behave incorrectly for negation or selection.++    * Each Montgomery domain's 'signum' implementation was broken,+      producing R^-1 instead of the proper in-domain 'one'. Now these+      return the appropriate values.++    Also clarifies a few Haddocks, on the suggestions of the same scan.+ - 0.1.6 (2026-08-01)   * The eq_{word,wide,wider}# functions now return a mask, instead of a     bit, inside the resulting Choice value.
lib/Data/Choice.hs view
@@ -305,6 +305,9 @@  -- | Select an unboxed word without branching, given a 'Choice'. --+--   Returns the second word if the 'Choice' is truthy, and the first+--   otherwise.+-- --   >>> let w = C.select_word# 0## 1## (C.true# ()) in GHC.Word.W# w --   1 select_word# :: Word# -> Word# -> Choice -> Word#@@ -312,6 +315,9 @@ {-# INLINE select_word# #-}  -- | Select an unboxed two-limb word without branching, given a 'Choice'.+--+--   Returns the second word if the 'Choice' is truthy, and the first+--   otherwise. select_wide#   :: Limb2   -> Limb2@@ -323,6 +329,9 @@ {-# INLINE select_wide# #-}  -- | Select an unboxed four-limb word without branching, given a 'Choice'.+--+--   Returns the second word if the 'Choice' is truthy, and the first+--   otherwise. select_wider#   :: Limb4   -> Limb4
lib/Data/Word/Limb.hs view
@@ -143,7 +143,7 @@  -- constant-time selection ---------------------------------------------------- --- | Return a if c is truthy, otherwise return b.+-- | Return b if c is truthy, otherwise return a. select#   :: Limb     -- ^ a   -> Limb     -- ^ b@@ -268,6 +268,9 @@  -- | Carrying addition, computing augend + addend + carry, returning --   the sum and new carry.+--+--   The carry-in must be 0 or 1; this is not checked. The carry-out+--   is always 0 or 1. add_c#   :: Limb             -- ^ augend   -> Limb             -- ^ addend@@ -304,6 +307,11 @@  -- | Borrowing subtraction, computing minuend - (subtrahend + borrow), --   returning the difference and new borrow mask.+--+--   The borrow-in is interpreted as a mask, of which only the most+--   significant bit is examined; a full-word mask (as produced by+--   this function) borrows 1. The borrow-out is 0 or a full-word+--   mask. sub_b#   :: Limb              -- ^ minuend   -> Limb              -- ^ subtrahend
lib/Data/Word/Wide.hs view
@@ -159,7 +159,7 @@  -- constant-time selection----------------------------------------------------- --- | Return a if c is truthy, otherwise return b.+-- | Return b if c is truthy, otherwise return a. -- --   >>> import qualified Data.Choice as C --   >>> select 0 1 (C.true# ())
lib/Data/Word/Wider.hs view
@@ -319,7 +319,7 @@   in  L4 w0 w1 w2 w3 {-# INLINE select# #-} --- | Return a if c is truthy, otherwise return b.+-- | Return b if c is truthy, otherwise return a. -- --   >>> import qualified Data.Choice as C --   >>> select 0 1 (C.true# ())@@ -384,7 +384,7 @@       !r2           = L.or# s2 c1       !(# s3, c3 #) = (# L.shl# w3 1#, L.shr# w3 s #)       !r3           = L.or# s3 c2-      !(Limb w)     = L.shl# c3 s+      !(Limb w)     = c3   in  (# (# r0, r1, r2, r3 #), C.from_bit# w #) {-# INLINE shl1_c# #-}
lib/Numeric/Montgomery/Secp256k1/Curve.hs view
@@ -105,12 +105,14 @@   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-        !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 (# _, _, _, _ #) -> ()@@ -761,6 +763,9 @@  -- | Multiplicative inverse in the Montgomery domain. --+--   Note that 'zero' has no multiplicative inverse; 'inv' returns+--   'zero' when applied to it.+-- --   >> inv 2 --   57896044618658097711785492504343953926634992332820282019728792003954417335832 --   >> inv 2 * 2@@ -1326,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.@@ -1335,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) @@ -1354,7 +1359,7 @@ select# = WW.select# {-# INLINE select# #-} --- | Return a if c is truthy, otherwise return b.+-- | Return b if c is truthy, otherwise return a. -- --   >>> import qualified Data.Choice as C --   >>> select 0 1 (C.true# ())
lib/Numeric/Montgomery/Secp256k1/Scalar.hs view
@@ -103,12 +103,14 @@   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-        !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 (# _, _, _, _ #) -> ()@@ -792,6 +794,9 @@  -- | Multiplicative inverse in the Montgomery domain. --+--   Note that 'zero' has no multiplicative inverse; 'inv' returns+--   'zero' when applied to it.+-- --   >> inv 2 --   57896044618658097711785492504343953926418782139537452191302581570759080747169 --   >> inv 2 * 2@@ -828,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.@@ -837,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) @@ -856,7 +861,7 @@ select# = WW.select# {-# INLINE select# #-} --- | Return a if c is truthy, otherwise return b.+-- | Return b if c is truthy, otherwise return a. -- --   >>> import qualified Data.Choice as C --   >>> select 0 1 (C.true# ())
ppad-fixed.cabal view
@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               ppad-fixed-version:            0.1.6+version:            0.2.2 synopsis:           Large fixed-width words and constant-time arithmetic. license:            MIT license-file:       LICENSE@@ -31,6 +31,11 @@       -Wall   if flag(llvm)     ghc-options: -fllvm -O2+  -- LLVM's x86 backend rewrites a cmov whose operand is a load as a+  -- branch (its cmov converter), which makes sub_mod#'s borrow-masked+  -- correction a branch on the borrow; keep the cmov.+  if flag(llvm) && arch(x86_64)+    ghc-options: -optlc=-x86-cmov-converter=false   exposed-modules:       Data.Choice     , Data.Word.Limb
test/Montgomery/Curve.hs view
@@ -118,8 +118,23 @@     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)++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@@ -171,17 +186,30 @@ 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   , 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   , 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   ]
test/Montgomery/Scalar.hs view
@@ -118,8 +118,23 @@     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)++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@@ -167,16 +182,34 @@ 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   , 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   , 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   ]
test/Wider.hs view
@@ -183,8 +183,27 @@       !e = 0x44acf6b7e36c1342c2c5897204fe09504e1e2efb1a900377dbc4e7a6a133ec56   H.assertBool mempty (W.eq_vartime o e) +shl1_c :: H.Assertion+shl1_c = case W.shl1_c (2 ^ (255 :: Word)) of+  (# r1, c1 #) -> case W.shl1_c 1 of+    (# r2, c2 #) -> do+      H.assertBool "value, carry out" (W.eq_vartime r1 0)+      H.assertBool "carry decides true" (C.decide c1)+      -- the carry must be a full-word mask, not a bare bit; negating+      -- or selecting on it is otherwise wrong+      H.assertBool "negated carry decides false"+        (not (C.decide (C.not c1)))+      H.assertBool "select on carry"+        (W.eq_vartime (W.select 0 1 c1) 1)+      H.assertBool "value, no carry" (W.eq_vartime r2 2)+      H.assertBool "no carry decides false" (not (C.decide c2))+      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@@ -216,6 +235,7 @@   , H.testCase "sqr" sqr   , H.testCase "mul" mul   , H.testCase "sub_mod" sub_mod+  , H.testCase "shl1_c" shl1_c   , Q.testProperty "odd w ~ odd (from w)" $ Q.withMaxSuccess 500 odd_correct   , Q.testProperty "lt_vartime a b ~ from a < from b" $       Q.withMaxSuccess 500 lt_vartime_correct