ppad-fixed 0.1.3 → 0.1.4

raw patch · 4 files changed

+80/−1 lines, 4 files

Files

• CHANGELOG +3/−0
• lib/Data/Word/Wider.hs +28/−0
• ppad-fixed.cabal +1/−1
• test/Wider.hs +48/−0

@@ -1,5 +1,8 @@ # Changelog +- 0.1.4 (2026-05-22)+  * Adds variable-time comparison functions to Data.Word.Wider.+ - 0.1.3 (2025-12-28)   * Makes some backward-incompatible API tweaks to Data.Choice: 

@@ -32,6 +32,8 @@   , lt#   , gt   , gt#+  , lt_vartime+  , gt_vartime    -- * Parity   , odd#@@ -182,6 +184,22 @@ lt (Wider a) (Wider b) = lt# a b {-# INLINABLE lt #-} +-- | Variable-time less-than comparison between 'Wider' values.+--+--   >>> lt_vartime 1 2+--   True+--   >>> lt_vartime 2 1+--   False+lt_vartime :: Wider -> Wider -> Bool+lt_vartime+      (Wider (# Limb a0, Limb a1, Limb a2, Limb a3 #))+      (Wider (# Limb b0, Limb b1, Limb b2, Limb b3 #))+  | Exts.isTrue# (Exts.neWord# a3 b3) = Exts.isTrue# (Exts.ltWord# a3 b3)+  | Exts.isTrue# (Exts.neWord# a2 b2) = Exts.isTrue# (Exts.ltWord# a2 b2)+  | Exts.isTrue# (Exts.neWord# a1 b1) = Exts.isTrue# (Exts.ltWord# a1 b1)+  | otherwise                         = Exts.isTrue# (Exts.ltWord# a0 b0)+{-# INLINABLE lt_vartime #-}+ gt#   :: Limb4   -> Limb4@@ -201,6 +219,16 @@ gt :: Wider -> Wider -> C.Choice gt (Wider a) (Wider b) = gt# a b {-# INLINABLE gt #-}++-- | Variable-time greater-than comparison between 'Wider' values.+--+--   >>> gt_vartime 1 2+--   False+--   >>> gt_vartime 2 1+--   True+gt_vartime :: Wider -> Wider -> Bool+gt_vartime a b = lt_vartime b a+{-# INLINABLE gt_vartime #-}  cmp#   :: Limb4

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               ppad-fixed-version:            0.1.3+version:            0.1.4 synopsis:           Large fixed-width words and constant-time arithmetic. license:            MIT license-file:       LICENSE

@@ -102,6 +102,40 @@   H.assertBool mempty (not (C.decide (W.lt# c a)))   H.assertBool mempty (not (C.decide (W.lt# c b))) +gt_vartime :: H.Assertion+gt_vartime = do+  let !a = 0+      !b = 1+      !c = 2 ^ (256 :: Word) - 1+  H.assertBool mempty (W.gt_vartime b a)+  H.assertBool mempty (W.gt_vartime c a)+  H.assertBool mempty (W.gt_vartime c b)++  H.assertBool mempty (not (W.gt_vartime a a))+  H.assertBool mempty (not (W.gt_vartime b b))+  H.assertBool mempty (not (W.gt_vartime c c))++  H.assertBool mempty (not (W.gt_vartime a b))+  H.assertBool mempty (not (W.gt_vartime a c))+  H.assertBool mempty (not (W.gt_vartime b c))++lt_vartime :: H.Assertion+lt_vartime = do+  let !a = 0+      !b = 1+      !c = 2 ^ (256 :: Word) - 1+  H.assertBool mempty (W.lt_vartime a b)+  H.assertBool mempty (W.lt_vartime a c)+  H.assertBool mempty (W.lt_vartime b c)++  H.assertBool mempty (not (W.lt_vartime a a))+  H.assertBool mempty (not (W.lt_vartime b b))+  H.assertBool mempty (not (W.lt_vartime c c))++  H.assertBool mempty (not (W.lt_vartime b a))+  H.assertBool mempty (not (W.lt_vartime c a))+  H.assertBool mempty (not (W.lt_vartime c b))+ cmp :: H.Assertion cmp = do   let !a = 0@@ -149,6 +183,14 @@ odd_correct :: W.Wider -> Bool odd_correct w = C.decide (W.odd w) == I.integerTestBit (W.from_vartime w) 0 +lt_vartime_correct :: W.Wider -> W.Wider -> Bool+lt_vartime_correct a b =+  W.lt_vartime a b == (W.from_vartime a < W.from_vartime b)++gt_vartime_correct :: W.Wider -> W.Wider -> Bool+gt_vartime_correct a b =+  W.gt_vartime a b == (W.from_vartime a > W.from_vartime b)+ tests :: TestTree tests = testGroup "wider tests" [     H.testCase "overflowing add, no carry" overflowing_add_no_carry@@ -162,10 +204,16 @@   , H.testCase "eq" eq   , H.testCase "gt" gt   , H.testCase "lt" lt+  , H.testCase "gt_vartime" gt_vartime+  , H.testCase "lt_vartime" lt_vartime   , H.testCase "cmp" cmp   , H.testCase "sqr" sqr   , H.testCase "mul" mul   , H.testCase "sub_mod" sub_mod   , 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+  , Q.testProperty "gt_vartime a b ~ from a > from b" $+      Q.withMaxSuccess 500 gt_vartime_correct   ]