ppad-fixed 0.1.0 → 0.1.1
raw patch · 12 files changed
+339/−214 lines, 12 files
Files
- CHANGELOG +3/−0
- bench/Main.hs +3/−3
- bench/Weight.hs +8/−8
- lib/Data/Word/Limb.hs +10/−10
- lib/Data/Word/Wide.hs +30/−11
- lib/Data/Word/Wider.hs +57/−34
- lib/Numeric/Montgomery/Secp256k1/Curve.hs +62/−47
- lib/Numeric/Montgomery/Secp256k1/Scalar.hs +44/−30
- ppad-fixed.cabal +7/−1
- test/Montgomery/Curve.hs +53/−30
- test/Montgomery/Scalar.hs +51/−29
- test/Wider.hs +11/−11
CHANGELOG view
@@ -1,5 +1,8 @@ # Changelog +- 0.1.1 (2025-12-27)+ * Contains miscellaneous hardening and API refinements to v0.1.1.+ - 0.1.0 (2025-12-21) * Initial release, supporting wide, wider, and secp256k1-related Montgomery-form words with supporting constant-time operations.
bench/Main.hs view
@@ -98,9 +98,9 @@ sqrt = let !c2 = 2 :: C.Montgomery !c_big = (2 ^ 255 - 19) :: C.Montgomery- in bgroup "sqrt" [- bench "curve: sqrt M(2)" $ nf C.sqrt c2- , bench "curve: sqrt M(2 ^ 255 - 19)" $ nf C.sqrt c_big+ in bgroup "sqrt_vartime" [+ bench "curve: sqrt_vartime M(2)" $ nf C.sqrt_vartime c2+ , bench "curve: sqrt_vartime M(2 ^ 255 - 19)" $ nf C.sqrt_vartime c_big ] exp :: Benchmark
bench/Weight.hs view
@@ -38,11 +38,11 @@ let !a = 1 !b = 2 !c = 2 ^ 255 - 19- in wgroup "cmp" $ do- func "cmp: 1 < 2" (W.cmp a) b- func "cmp: 2 < 1" (W.cmp b) a- func "cmp: 2 < 2 ^ 255 - 19" (W.cmp b) c- func "cmp: 2 ^ 255 - 19 < 2" (W.cmp c) b+ in wgroup "cmp_vartime" $ do+ func "cmp_vartime: 1 < 2" (W.cmp_vartime a) b+ func "cmp_vartime: 2 < 1" (W.cmp_vartime b) a+ func "cmp_vartime: 2 < 2 ^ 255 - 19" (W.cmp_vartime b) c+ func "cmp_vartime: 2 ^ 255 - 19 < 2" (W.cmp_vartime c) b add :: Weigh () add =@@ -124,9 +124,9 @@ sqrt = let !c2 = 2 :: C.Montgomery !c_big = (2 ^ 255 - 19) :: C.Montgomery- in wgroup "sqrt" $ do- func "curve: sqrt M(2)" C.sqrt c2- func "curve: sqrt M(2 ^ 255 - 19)" C.sqrt c_big+ in wgroup "sqrt_vartime" $ do+ func "curve: sqrt_vartime M(2)" C.sqrt_vartime c2+ func "curve: sqrt_vartime M(2 ^ 255 - 19)" C.sqrt_vartime c_big redc :: Weigh () redc =
lib/Data/Word/Limb.hs view
@@ -285,10 +285,9 @@ :: Limb -> Limb -> Limb-add_s# (Limb a) (Limb b) = case Exts.addWordC# a b of- (# s, 0# #) -> Limb s- _ -> case maxBound :: Word of- Exts.W# m -> Limb m+add_s# (Limb a) (Limb b) =+ let !(# c, s #) = Exts.plusWord2# a b+ in Limb (C.select_word# s (Exts.not# 0##) (C.from_word_nonzero# c)) {-# INLINE add_s# #-} -- subtraction ----------------------------------------------------------------@@ -315,9 +314,10 @@ :: Limb -- ^ minuend -> Limb -- ^ subtrahend -> Limb -- ^ difference-sub_s# (Limb m) (Limb n) = case Exts.subWordC# m n of- (# d, 0# #) -> Limb d- _ -> Limb 0##+sub_s# (Limb m) (Limb n) =+ let !(# d, b #) = Exts.subWordC# m n+ !borrow = C.from_word# (Exts.int2Word# b)+ in Limb (C.select_word# d 0## borrow) {-# INLINE sub_s# #-} -- | Wrapping subtraction, computing minuend - subtrahend, returning the@@ -355,9 +355,9 @@ :: Limb -- ^ multiplicand -> Limb -- ^ multiplier -> Limb -- ^ clamped low word of product-mul_s# (Limb a) (Limb b) = case Exts.timesWord2# a b of- (# 0##, l #) -> Limb l- _ -> Limb (Exts.not# 0##)+mul_s# (Limb a) (Limb b) =+ let !(# h, l #) = Exts.timesWord2# a b+ in Limb (C.select_word# l (Exts.not# 0##) (C.from_word_nonzero# h)) {-# INLINE mul_s# #-} -- | Multiply-add-carry, computing a * b + m + c, returning the
lib/Data/Word/Wide.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE UnboxedSums #-} {-# LANGUAGE UnboxedTuples #-}@@ -20,8 +21,8 @@ -- * Construction, Conversion , wide- , to- , from+ , to_vartime+ , from_vartime -- * Bit Manipulation , or@@ -55,6 +56,7 @@ import Control.DeepSeq import Data.Bits ((.|.), (.&.), (.<<.), (.>>.)) import qualified Data.Bits as B+import qualified Data.Choice as C import Data.Word.Limb (Limb(..)) import qualified Data.Word.Limb as L import GHC.Exts@@ -68,22 +70,33 @@ -- wide words ----------------------------------------------------------------- +pattern Limb2+ :: Word# -> Word#+ -> (# Limb, Limb #)+pattern Limb2 w0 w1 = (# Limb w0, Limb w1 #)+{-# COMPLETE Limb2 #-}+ -- | Little-endian wide words. data Wide = Wide !(# Limb, Limb #) instance Show Wide where- show = show . from+ show = show . from_vartime +-- | Note that 'fromInteger' necessarily runs in variable time due+-- to conversion from the variable-size, potentially heap-allocated+-- 'Integer' type. instance Num Wide where (+) = add (-) = sub (*) = mul abs = id- fromInteger = to+ fromInteger = to_vartime negate = neg- signum a = case a of- Wide (# Limb 0##, Limb 0## #) -> 0- _ -> 1+ signum (Wide (# l0, l1 #)) =+ let !(Limb l) = l0 `L.or#` l1+ !n = C.from_word_nonzero# l+ !b = C.to_word# n+ in Wide (Limb2 b 0##) instance NFData Wide where rnf (Wide a) = case a of (# _, _ #) -> ()@@ -95,8 +108,11 @@ wide (W# l) (W# h) = Wide (# Limb l, Limb h #) -- | Convert an 'Integer' to a 'Wide' word.-to :: Integer -> Wide-to n =+--+-- >>> to_vartime 1+-- 1+to_vartime :: Integer -> Wide+to_vartime n = let !size = B.finiteBitSize (0 :: Word) !mask = fi (maxBound :: Word) :: Integer !(W# w0) = fi (n .&. mask)@@ -104,8 +120,11 @@ in Wide (# Limb w0, Limb w1 #) -- | Convert a 'Wide' word to an 'Integer'.-from :: Wide -> Integer-from (Wide (# Limb a, Limb b #)) =+--+-- >>> from_vartime 1+-- 1+from_vartime :: Wide -> Integer+from_vartime (Wide (# Limb a, Limb b #)) = fi (W# b) .<<. (B.finiteBitSize (0 :: Word)) .|. fi (W# a)
lib/Data/Word/Wider.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE UnboxedSums #-} {-# LANGUAGE UnboxedTuples #-}@@ -18,12 +19,12 @@ -- * Four-limb words Wider(..) , wider- , to- , from+ , to_vartime+ , from_vartime -- * Comparison , eq_vartime- , cmp+ , cmp_vartime , cmp# , eq# , lt@@ -83,7 +84,7 @@ import qualified Data.Choice as C import Data.Word.Limb (Limb(..)) import qualified Data.Word.Limb as L-import GHC.Exts (Word(..), Int(..), Int#)+import GHC.Exts (Word(..), Int(..), Word#, Int#) import qualified GHC.Exts as Exts import Prelude hiding (div, mod, or, and, not, quot, rem, recip, odd) @@ -95,6 +96,12 @@ -- wider words ---------------------------------------------------------------- +pattern Limb4+ :: Word# -> Word# -> Word# -> Word#+ -> (# Limb, Limb, Limb, Limb #)+pattern Limb4 w0 w1 w2 w3 = (# Limb w0, Limb w1, Limb w2, Limb w3 #)+{-# COMPLETE Limb4 #-}+ -- | Little-endian wider words, consisting of four 'Limbs'. -- -- >>> 1 :: Wider@@ -102,24 +109,23 @@ data Wider = Wider !(# Limb, Limb, Limb, Limb #) instance Show Wider where- show = show . from--instance Eq Wider where- Wider a == Wider b = C.decide (eq# a b)--instance Ord Wider where- compare = cmp+ show = show . from_vartime +-- | Note that 'fromInteger' necessarily runs in variable time due+-- to conversion from the variable-size, potentially heap-allocated+-- 'Integer' type. instance Num Wider where (+) = add (-) = sub (*) = mul abs = id- fromInteger = to- negate w = add (not w) (Wider (# Limb 1##, Limb 0##, Limb 0##, Limb 0## #))- signum a = case a of- Wider (# Limb 0##, Limb 0##, Limb 0##, Limb 0## #) -> 0- _ -> 1+ fromInteger = to_vartime+ negate w = add (not w) (Wider (Limb4 1## 0## 0## 0##))+ signum (Wider (# 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 Wider (Limb4 b 0## 0## 0##) instance NFData Wider where rnf (Wider a) = case a of@@ -132,8 +138,8 @@ -> (# Limb, Limb, Limb, Limb #) -> C.Choice eq# a b =- let !(# Limb a0, Limb a1, Limb a2, Limb a3 #) = a- !(# Limb b0, Limb b1, Limb b2, Limb b3 #) = b+ let !(Limb4 a0 a1 a2 a3) = a+ !(Limb4 b0 b1 b2 b3) = b in C.eq_wider# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) {-# INLINE eq# #-} @@ -161,6 +167,13 @@ in C.from_word_mask# bor {-# INLINE lt# #-} +-- | Constant-time less-than comparison between 'Wider' values.+--+-- >>> import qualified Data.Choice as CT+-- >>> CT.decide (lt 1 2)+-- True+-- >>> CT.decide (lt 1 1)+-- False lt :: Wider -> Wider -> C.Choice lt (Wider a) (Wider b) = lt# a b @@ -173,6 +186,13 @@ in C.from_word_mask# bor {-# INLINE gt# #-} +-- | Constant-time greater-than comparison between 'Wider' values.+--+-- >>> import qualified Data.Choice as CT+-- >>> CT.decide (gt 1 2)+-- False+-- >>> CT.decide (gt 2 1)+-- True gt :: Wider -> Wider -> C.Choice gt (Wider a) (Wider b) = gt# a b @@ -194,20 +214,23 @@ in (Exts.word2Int# (C.to_word# (L.nonzero# d3))) Exts.*# s {-# INLINE cmp# #-} --- | Constant-time comparison between 'Wider' words.+-- | Variable-time comparison between 'Wider' words. ----- >>> cmp 1 2+-- The actual comparison here is performed in constant time, but we must+-- branch to return an 'Ordering'.+--+-- >>> cmp_vartime 1 2 -- LT--- >>> cmp 2 1+-- >>> cmp_vartime 2 1 -- GT--- >>> cmp 2 2+-- >>> cmp_vartime 2 2 -- EQ-cmp :: Wider -> Wider -> Ordering-cmp (Wider a) (Wider b) = case cmp# a b of+cmp_vartime :: Wider -> Wider -> Ordering+cmp_vartime (Wider a) (Wider b) = case cmp# a b of 1# -> GT 0# -> EQ _ -> LT-{-# INLINABLE cmp #-}+{-# INLINABLE cmp_vartime #-} -- construction / conversion -------------------------------------------------- @@ -222,10 +245,10 @@ -- | Convert an 'Integer' to a 'Wider' word. ----- >>> to 1+-- >>> to_vartime 1 -- 1-to :: Integer -> Wider-to n =+to_vartime :: Integer -> Wider+to_vartime n = let !size = B.finiteBitSize (0 :: Word) !mask = fi (maxBound :: Word) :: Integer !(W# w0) = fi (n .&. mask)@@ -236,10 +259,10 @@ -- | Convert a 'Wider' word to an 'Integer'. ----- >>> from 1+-- >>> from_vartime 1 -- 1-from :: Wider -> Integer-from (Wider (# Limb w0, Limb w1, Limb w2, Limb w3 #)) =+from_vartime :: Wider -> Integer+from_vartime (Wider (# Limb w0, Limb w1, Limb w2, Limb w3 #)) = fi (W# w3) .<<. (3 * size) .|. fi (W# w2) .<<. (2 * size) .|. fi (W# w1) .<<. size@@ -483,9 +506,9 @@ -- >>> add_o 1 (2 ^ (256 :: Word) - 1) -- (0,1) add_o- :: Wider- -> Wider- -> (Wider, Word)+ :: Wider -- ^ augend+ -> Wider -- ^ addend+ -> (Wider, Word) -- ^ (sum, carry bit) add_o (Wider a) (Wider b) = let !(# s, Limb c #) = add_o# a b in (Wider s, W# c)
lib/Numeric/Montgomery/Secp256k1/Curve.hs view
@@ -19,8 +19,8 @@ -- * Montgomery form, secp256k1 field prime modulus Montgomery(..) , render- , to- , from+ , to_vartime+ , from_vartime , zero , one @@ -51,11 +51,12 @@ , neg# , inv , inv#- , sqrt+ , sqrt_vartime , sqrt# , exp+ , exp# , odd#- , odd+ , odd_vartime ) where import Control.DeepSeq@@ -66,13 +67,13 @@ import Data.Word.Wider (Wider(..)) import qualified Data.Word.Wider as WW import GHC.Exts (Word(..))-import Prelude hiding (or, and, not, sqrt, exp, odd)+import Prelude hiding (or, and, not, sqrt, exp) -- montgomery arithmetic, specialized to the secp256k1 field prime modulus -- 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F -- | Montgomery-form 'Wider' words, on the Montgomery domain defined by--- the secp256k1 scalar group order.+-- the secp256k1 field prime. -- -- >>> let one = 1 :: Montgomery -- >>> one@@ -92,21 +93,23 @@ <> show (W# c) <> ", " <> show (W# d) <> ")" instance Show Montgomery where- show = show . from+ show = show . from_vartime +-- | Note that 'fromInteger' necessarily runs in variable time due+-- to conversion from the variable-size, potentially heap-allocated+-- 'Integer' type. instance Num Montgomery where a + b = add a b a - b = sub a b a * b = mul a b negate a = neg a abs = id- fromInteger = to . WW.to- signum a = case a of- Montgomery (# Limb 0##, Limb 0##, Limb 0##, Limb 0## #) -> 0- _ -> 1--instance Eq Montgomery where- a == b = C.decide (eq a b)+ fromInteger = to_vartime . WW.to_vartime+ 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## #) instance NFData Montgomery where rnf (Montgomery a) = case a of (# _, _, _, _ #) -> ()@@ -144,8 +147,8 @@ -- innards -------------------------------------------------------------------- redc_inner#- :: (# Limb, Limb, Limb, Limb #) -- ^ upper limbs- -> (# Limb, Limb, Limb, Limb #) -- ^ lower limbs+ :: (# Limb, Limb, Limb, Limb #) -- ^ upper limbs+ -> (# Limb, Limb, Limb, Limb #) -- ^ lower limbs -> (# (# Limb, Limb, Limb, Limb #), Limb #) -- ^ upper limbs, meta-carry redc_inner# (# u0, u1, u2, u3 #) (# l0, l1, l2, l3 #) = let !(# m0, m1, m2, m3 #) =@@ -202,7 +205,7 @@ -> Montgomery -- ^ reduced value redc (Montgomery l) (Montgomery u) = let !res = redc# l u- in (Montgomery res)+ in Montgomery res retr_inner# :: (# Limb, Limb, Limb, Limb #) -- ^ value in montgomery form@@ -366,14 +369,14 @@ {-# INLINE to# #-} -- | Convert a 'Wider' word to the Montgomery domain.-to :: Wider -> Montgomery-to (Wider x) = Montgomery (to# x)+to_vartime :: Wider -> Montgomery+to_vartime (Wider x) = Montgomery (to# x) -- | Retrieve a 'Montgomery' word from the Montgomery domain. -- -- This function is a synonym for 'retr'.-from :: Montgomery -> Wider-from = retr+from_vartime :: Montgomery -> Wider+from_vartime = retr add# :: (# Limb, Limb, Limb, Limb #) -- ^ augend@@ -987,24 +990,27 @@ -- | Square root (Tonelli-Shanks) in the Montgomery domain. ----- For a, return x such that a = x x mod p. Returns nothing if no such--- square root exists.+-- Returns 'Nothing' if the square root doesn't exist. ----- >>> sqrt 4+-- Note that the square root calculation itself is performed in+-- constant time; we branch only when casting to 'Maybe' at the end.+--+-- >>> sqrt_vartime 4 -- Just 2--- >>> sqrt 15+-- >>> sqrt_vartime 15 -- Just 69211104694897500952317515077652022726490027694212560352756646854116994689233--- >>> (*) <$> sqrt 15 <*> sqrt 15+-- >>> (*) <$> sqrt_vartime 15 <*> sqrt_vartime 15 -- Just 15-sqrt :: Montgomery -> Maybe Montgomery-sqrt (Montgomery n) = case sqrt# n of- (# a | #) -> Just $! Montgomery a- _ -> Nothing+sqrt_vartime :: Montgomery -> Maybe Montgomery+sqrt_vartime (Montgomery n) = case sqrt# n of+ (# a, c #)+ | C.decide c -> Just $! Montgomery a+ | otherwise -> Nothing -- generated by etc/generate_sqrt.sh sqrt# :: (# Limb, Limb, Limb, Limb #)- -> (# (# Limb, Limb, Limb, Limb #) | () #)+ -> (# (# Limb, Limb, Limb, Limb #), C.Choice #) sqrt# a = let !t0 = (# Limb 0x1000003D1##, Limb 0##, Limb 0##, Limb 0## #) !t1 = sqr# t0@@ -1511,9 +1517,7 @@ !t502 = sqr# t501 !t503 = sqr# t502 !r = t503- in if C.decide (WW.eq# (sqr# r) a)- then (# r | #)- else (# | () #)+ in (# r, WW.eq# (sqr# r) a #) {-# INLINE sqrt# #-} -- | Exponentiation in the Montgomery domain.@@ -1523,31 +1527,42 @@ -- >>> exp 2 10 -- 1024 exp :: Montgomery -> Wider -> Montgomery-exp (Montgomery b) (Wider e) =- let !one# = (# Limb 0x1000003D1##, Limb 0##, Limb 0##, Limb 0## #)- loop !r !_ !_ 0 = r- loop !r !m !ex !n =- let !(# ne, bit #) = WW.shr1_c# ex- !candidate = mul# r m- !nr = select# r candidate bit- !nm = sqr# m- in loop nr nm ne (n - 1)- in Montgomery (loop one# b e (256 :: Word))+exp (Montgomery b) (Wider e) = Montgomery (exp# b e) +exp#+ :: (# Limb, Limb, Limb, Limb #)+ -> (# Limb, Limb, Limb, Limb #)+ -> (# Limb, Limb, Limb, Limb #)+exp# b e =+ let !o = (# Limb 0x1000003D1##, Limb 0##, Limb 0##, Limb 0## #)+ loop !r !m !ex n = case n of+ 0 -> r+ _ ->+ let !(# ne, bit #) = WW.shr1_c# ex+ !candidate = mul# r m+ !nr = select# r candidate bit+ !nm = sqr# m+ in loop nr nm ne (n - 1)+ in loop o b e (256 :: Word)+{-# INLINE exp# #-}+ odd# :: (# Limb, Limb, Limb, Limb #) -> C.Choice odd# = WW.odd#-{-# INLINE odd #-}+{-# INLINE odd# #-} -- | Check if a 'Montgomery' value is odd. --+-- Note that the comparison is performed in constant time, but we+-- branch when converting to 'Bool'.+-- -- >>> odd 1 -- True -- >>> odd 2 -- False -- >>> Data.Word.Wider.odd (retr 3) -- parity is preserved -- True-odd :: Montgomery -> Bool-odd (Montgomery m) = C.decide (odd# m)+odd_vartime :: Montgomery -> Bool+odd_vartime (Montgomery m) = C.decide (odd# m) -- constant-time selection ----------------------------------------------------
lib/Numeric/Montgomery/Secp256k1/Scalar.hs view
@@ -19,8 +19,8 @@ -- * Montgomery form, secp256k1 scalar group order modulus Montgomery(..) , render- , to- , from+ , to_vartime+ , from_vartime , zero , one @@ -52,8 +52,9 @@ , inv , inv# , exp+ , exp# , odd#- , odd+ , odd_vartime ) where import Control.DeepSeq@@ -64,7 +65,7 @@ import Data.Word.Wider (Wider(..)) import qualified Data.Word.Wider as WW import GHC.Exts (Word(..))-import Prelude hiding (or, and, not, exp, odd)+import Prelude hiding (or, and, not, exp) -- montgomery arithmetic, specialized to the secp256k1 scalar group order -- 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141@@ -80,7 +81,7 @@ data Montgomery = Montgomery !(# Limb, Limb, Limb, Limb #) instance Show Montgomery where- show = show . from+ show = show . from_vartime -- | Render a 'Montgomery' value as a 'String', showing its individual -- 'Limb's.@@ -92,19 +93,21 @@ "(" <> show (W# a) <> ", " <> show (W# b) <> ", " <> show (W# c) <> ", " <> show (W# d) <> ")" +-- | Note that 'fromInteger' necessarily runs in variable time due+-- to conversion from the variable-size, potentially heap-allocated+-- 'Integer' type. instance Num Montgomery where a + b = add a b a - b = sub a b a * b = mul a b negate a = neg a abs = id- fromInteger = to . WW.to- signum a = case a of- Montgomery (# Limb 0##, Limb 0##, Limb 0##, Limb 0## #) -> 0- _ -> 1--instance Eq Montgomery where- a == b = C.decide (eq a b)+ fromInteger = to_vartime . WW.to_vartime+ 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## #) instance NFData Montgomery where rnf (Montgomery a) = case a of (# _, _, _, _ #) -> ()@@ -364,14 +367,14 @@ {-# INLINE to# #-} -- | Convert a 'Wider' word to the Montgomery domain.-to :: Wider -> Montgomery-to (Wider x) = Montgomery (to# x)+to_vartime :: Wider -> Montgomery+to_vartime (Wider x) = Montgomery (to# x) -- | Retrieve a 'Montgomery' word from the Montgomery domain. -- -- This function is a synonym for 'retr'.-from :: Montgomery -> Wider-from = retr+from_vartime :: Montgomery -> Wider+from_vartime = retr add# :: (# Limb, Limb, Limb, Limb #) -- ^ augend@@ -948,32 +951,43 @@ -- >>> exp 2 10 -- 1024 exp :: Montgomery -> Wider -> Montgomery-exp (Montgomery b) (Wider e) =- let !one# = (# Limb 0x402DA1732FC9BEBF##, Limb 0x4551231950B75FC4##- , Limb 0x0000000000000001##, Limb 0x0000000000000000## #)- loop !r !_ !_ 0 = r- loop !r !m !ex !n =- let !(# ne, bit #) = WW.shr1_c# ex- !candidate = mul# r m- !nr = select# r candidate bit- !nm = sqr# m- in loop nr nm ne (n - 1)- in Montgomery (loop one# b e (256 :: Word))+exp (Montgomery b) (Wider e) = Montgomery (exp# b e) +exp#+ :: (# Limb, Limb, Limb, Limb #)+ -> (# Limb, Limb, Limb, Limb #)+ -> (# Limb, Limb, Limb, Limb #)+exp# b e =+ let !o = (# Limb 0x402DA1732FC9BEBF##, Limb 0x4551231950B75FC4##+ , Limb 0x0000000000000001##, Limb 0x0000000000000000## #)+ loop !r !m !ex n = case n of+ 0 -> r+ _ ->+ let !(# ne, bit #) = WW.shr1_c# ex+ !candidate = mul# r m+ !nr = select# r candidate bit+ !nm = sqr# m+ in loop nr nm ne (n - 1)+ in loop o b e (256 :: Word)+{-# INLINE exp# #-}+ odd# :: (# Limb, Limb, Limb, Limb #) -> C.Choice odd# = WW.odd#-{-# INLINE odd #-}+{-# INLINE odd# #-} -- | Check if a 'Montgomery' value is odd. --+-- Note that the comparison is performed in constant time, but we+-- branch when converting to 'Bool'.+-- -- >>> odd 1 -- True -- >>> odd 2 -- False -- >>> Data.Word.Wider.odd (retr 3) -- parity is preserved -- True-odd :: Montgomery -> Bool-odd (Montgomery m) = C.decide (odd# m)+odd_vartime :: Montgomery -> Bool+odd_vartime (Montgomery m) = C.decide (odd# m) -- constant-time selection ----------------------------------------------------
ppad-fixed.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-fixed-version: 0.1.0+version: 0.1.1 synopsis: Large fixed-width words and constant-time arithmetic. license: MIT license-file: LICENSE@@ -56,6 +56,8 @@ ghc-options: -rtsopts -Wall -O2+ if flag(llvm)+ ghc-options: -fllvm build-depends: base@@ -72,6 +74,8 @@ ghc-options: -rtsopts -O2 -Wall -fno-warn-orphans+ if flag(llvm)+ ghc-options: -fllvm build-depends: base@@ -86,6 +90,8 @@ ghc-options: -rtsopts -O2 -Wall -fno-warn-orphans+ if flag(llvm)+ ghc-options: -fllvm build-depends: base
test/Montgomery/Curve.hs view
@@ -11,6 +11,7 @@ tests ) where +import qualified Data.Choice as CT import qualified Data.Word.Wider as W import qualified GHC.Num.Integer as I import GHC.Natural@@ -19,6 +20,10 @@ import qualified Test.Tasty.HUnit as H import qualified Test.Tasty.QuickCheck as Q +-- orphan Eq instance for testing+instance Eq C.Montgomery where+ a == b = CT.decide (C.eq a b)+ -- generic modular exponentiation -- b ^ e mod m modexp :: Integer -> Natural -> Natural -> Integer@@ -36,12 +41,15 @@ mm = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F repr :: H.Assertion-repr = H.assertBool mempty (W.eq_vartime 0 (C.from mm))+repr = H.assertBool mempty (W.eq_vartime 0 (C.from_vartime mm)) add_case :: String -> W.Wider -> W.Wider -> W.Wider -> H.Assertion add_case t a b s = do- H.assertEqual "sanity" ((W.from a + W.from b) `mod` W.from m) (W.from s)- H.assertBool t (W.eq_vartime s (C.from (C.to a + C.to b)))+ H.assertEqual "sanity"+ ((W.from_vartime a + W.from_vartime b) `mod` W.from_vartime m)+ (W.from_vartime s)+ H.assertBool t+ (W.eq_vartime s (C.from_vartime (C.to_vartime a + C.to_vartime b))) add :: H.Assertion add = do@@ -61,8 +69,11 @@ sub_case :: String -> W.Wider -> W.Wider -> W.Wider -> H.Assertion sub_case t b a d = do- H.assertEqual "sanity" ((W.from b - W.from a) `mod` W.from m) (W.from d)- H.assertBool t (W.eq_vartime d (C.from (C.to b - C.to a)))+ H.assertEqual "sanity"+ ((W.from_vartime b - W.from_vartime a) `mod` W.from_vartime m)+ (W.from_vartime d)+ H.assertBool t+ (W.eq_vartime d (C.from_vartime (C.to_vartime b - C.to_vartime a))) sub :: H.Assertion sub = do@@ -81,8 +92,11 @@ mul_case :: String -> W.Wider -> W.Wider -> W.Wider -> H.Assertion mul_case t a b p = do- H.assertEqual "sanity" ((W.from a * W.from b) `mod` W.from m) (W.from p)- H.assertBool t (W.eq_vartime p (C.from (C.to a * C.to b)))+ H.assertEqual "sanity"+ ((W.from_vartime a * W.from_vartime b) `mod` W.from_vartime m)+ (W.from_vartime p)+ H.assertBool t+ (W.eq_vartime p (C.from_vartime (C.to_vartime a * C.to_vartime b))) mul :: H.Assertion mul = do@@ -105,48 +119,57 @@ 0x000000000000000000000000000000000000000000000001000007A2000E90A1 instance Q.Arbitrary W.Wider where- arbitrary = fmap W.to Q.arbitrary+ arbitrary = fmap W.to_vartime Q.arbitrary instance Q.Arbitrary C.Montgomery where- arbitrary = fmap C.to Q.arbitrary+ arbitrary = fmap C.to_vartime Q.arbitrary add_matches :: W.Wider -> W.Wider -> Bool add_matches a b =- let ma = C.to a- mb = C.to b- ia = W.from a- ib = W.from b- im = W.from m- in W.eq_vartime (W.to ((ia + ib) `mod` im)) (C.from (ma + mb))+ let ma = C.to_vartime a+ mb = C.to_vartime b+ ia = W.from_vartime a+ ib = W.from_vartime b+ im = W.from_vartime m+ in W.eq_vartime+ (W.to_vartime ((ia + ib) `mod` im))+ (C.from_vartime (ma + mb)) mul_matches :: W.Wider -> W.Wider -> Bool mul_matches a b =- let ma = C.to a- mb = C.to b- ia = W.from a- ib = W.from b- im = W.from m- in W.eq_vartime (W.to ((ia * ib) `mod` im)) (C.from (ma * mb))+ let ma = C.to_vartime a+ mb = C.to_vartime b+ ia = W.from_vartime a+ ib = W.from_vartime b+ im = W.from_vartime m+ in W.eq_vartime+ (W.to_vartime ((ia * ib) `mod` im))+ (C.from_vartime (ma * mb)) sqr_matches :: W.Wider -> Bool sqr_matches a =- let ma = C.to a- ia = W.from a- im = W.from m- in W.eq_vartime (W.to ((ia * ia) `mod` im)) (C.from (C.sqr ma))+ let ma = C.to_vartime a+ ia = W.from_vartime a+ im = W.from_vartime m+ in W.eq_vartime+ (W.to_vartime ((ia * ia) `mod` im))+ (C.from_vartime (C.sqr ma)) exp_matches :: C.Montgomery -> W.Wider -> Bool exp_matches a b =- let ia = W.from (C.from a)- nb = fromIntegral (W.from b)- nm = fromIntegral (W.from m)- in W.eq_vartime (W.to (modexp ia nb nm)) (C.from (C.exp a b))+ let ia = W.from_vartime (C.from_vartime a)+ nb = fromIntegral (W.from_vartime b)+ nm = fromIntegral (W.from_vartime m)+ in W.eq_vartime+ (W.to_vartime (modexp ia nb nm))+ (C.from_vartime (C.exp a b)) inv_valid :: Q.NonZero C.Montgomery -> Bool inv_valid (Q.NonZero s) = C.eq_vartime (C.inv s * s) 1 odd_correct :: C.Montgomery -> Bool-odd_correct w = C.odd w == I.integerTestBit (W.from (C.from w)) 0+odd_correct w =+ C.odd_vartime w == I.integerTestBit (W.from_vartime (C.from_vartime w)) 0 tests :: TestTree tests = testGroup "montgomery tests (curve)" [
test/Montgomery/Scalar.hs view
@@ -11,6 +11,7 @@ tests ) where +import qualified Data.Choice as CT import qualified Data.Word.Wider as W import qualified GHC.Num.Integer as I import GHC.Natural@@ -19,6 +20,10 @@ import qualified Test.Tasty.HUnit as H import qualified Test.Tasty.QuickCheck as Q +-- orphan Eq instance for testing+instance Eq S.Montgomery where+ a == b = CT.decide (S.eq a b)+ -- generic modular exponentiation -- b ^ e mod m modexp :: Integer -> Natural -> Natural -> Integer@@ -36,12 +41,15 @@ mm = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141 repr :: H.Assertion-repr = H.assertBool mempty (W.eq_vartime 0 (S.from mm))+repr = H.assertBool mempty (W.eq_vartime 0 (S.from_vartime mm)) add_case :: String -> W.Wider -> W.Wider -> W.Wider -> H.Assertion add_case t a b s = do- H.assertEqual "sanity" ((W.from a + W.from b) `mod` W.from m) (W.from s)- H.assertBool t (W.eq_vartime s (S.from (S.to a + S.to b)))+ H.assertEqual "sanity"+ ((W.from_vartime a + W.from_vartime b) `mod` W.from_vartime m)+ (W.from_vartime s)+ H.assertBool t+ (W.eq_vartime s (S.from_vartime (S.to_vartime a + S.to_vartime b))) add :: H.Assertion add = do@@ -61,8 +69,11 @@ sub_case :: String -> W.Wider -> W.Wider -> W.Wider -> H.Assertion sub_case t b a d = do- H.assertEqual "sanity" ((W.from b - W.from a) `mod` W.from m) (W.from d)- H.assertBool t (W.eq_vartime d (S.from (S.to b - S.to a)))+ H.assertEqual "sanity"+ ((W.from_vartime b - W.from_vartime a) `mod` W.from_vartime m)+ (W.from_vartime d)+ H.assertBool t+ (W.eq_vartime d (S.from_vartime (S.to_vartime b - S.to_vartime a))) sub :: H.Assertion sub = do@@ -81,8 +92,11 @@ mul_case :: String -> W.Wider -> W.Wider -> W.Wider -> H.Assertion mul_case t a b p = do- H.assertEqual "sanity" ((W.from a * W.from b) `mod` W.from m) (W.from p)- H.assertBool t (W.eq_vartime p (S.from (S.to a * S.to b)))+ H.assertEqual "sanity"+ ((W.from_vartime a * W.from_vartime b) `mod` W.from_vartime m)+ (W.from_vartime p)+ H.assertBool t+ (W.eq_vartime p (S.from_vartime (S.to_vartime a * S.to_vartime b))) mul :: H.Assertion mul = do@@ -105,42 +119,50 @@ 0x9D671CD581C69BC5E697F5E45BCD07C6741496C20E7CF878896CF21467D7D140 instance Q.Arbitrary W.Wider where- arbitrary = fmap W.to Q.arbitrary+ arbitrary = fmap W.to_vartime Q.arbitrary instance Q.Arbitrary S.Montgomery where- arbitrary = fmap S.to Q.arbitrary+ arbitrary = fmap S.to_vartime Q.arbitrary add_matches :: W.Wider -> W.Wider -> Bool add_matches a b =- let ma = S.to a- mb = S.to b- ia = W.from a- ib = W.from b- im = W.from m- in W.eq_vartime (W.to ((ia + ib) `mod` im)) (S.from (ma + mb))+ let ma = S.to_vartime a+ mb = S.to_vartime b+ ia = W.from_vartime a+ ib = W.from_vartime b+ im = W.from_vartime m+ in W.eq_vartime+ (W.to_vartime ((ia + ib) `mod` im))+ (S.from_vartime (ma + mb)) mul_matches :: W.Wider -> W.Wider -> Bool mul_matches a b =- let ma = S.to a- mb = S.to b- ia = W.from a- ib = W.from b- im = W.from m- in W.eq_vartime (W.to ((ia * ib) `mod` im)) (S.from (ma * mb))+ let ma = S.to_vartime a+ mb = S.to_vartime b+ ia = W.from_vartime a+ ib = W.from_vartime b+ im = W.from_vartime m+ in W.eq_vartime+ (W.to_vartime ((ia * ib) `mod` im))+ (S.from_vartime (ma * mb)) sqr_matches :: W.Wider -> Bool sqr_matches a =- let ma = S.to a- ia = W.from a- im = W.from m- in W.eq_vartime (W.to ((ia * ia) `mod` im)) (S.from (S.sqr ma))+ let ma = S.to_vartime a+ ia = W.from_vartime a+ im = W.from_vartime m+ in W.eq_vartime+ (W.to_vartime ((ia * ia) `mod` im))+ (S.from_vartime (S.sqr ma)) exp_matches :: S.Montgomery -> W.Wider -> Bool exp_matches a b =- let ia = W.from (S.from a)- nb = fromIntegral (W.from b)- nm = fromIntegral (W.from m)- in W.eq_vartime (W.to (modexp ia nb nm)) (S.from (S.exp a b))+ let ia = W.from_vartime (S.from_vartime a)+ nb = fromIntegral (W.from_vartime b)+ nm = fromIntegral (W.from_vartime m)+ in W.eq_vartime+ (W.to_vartime (modexp ia nb nm))+ (S.from_vartime (S.exp a b)) inv_valid :: Q.NonZero S.Montgomery -> Bool inv_valid (Q.NonZero s) = S.eq_vartime (S.inv s * s) 1
test/Wider.hs view
@@ -107,17 +107,17 @@ let !a = 0 !b = 1 !c = 2 ^ (256 :: Word) - 1- H.assertEqual mempty (W.cmp a b) LT- H.assertEqual mempty (W.cmp a c) LT- H.assertEqual mempty (W.cmp b c) LT+ H.assertEqual mempty (W.cmp_vartime a b) LT+ H.assertEqual mempty (W.cmp_vartime a c) LT+ H.assertEqual mempty (W.cmp_vartime b c) LT - H.assertEqual mempty (W.cmp a a) EQ- H.assertEqual mempty (W.cmp b b) EQ- H.assertEqual mempty (W.cmp c c) EQ+ H.assertEqual mempty (W.cmp_vartime a a) EQ+ H.assertEqual mempty (W.cmp_vartime b b) EQ+ H.assertEqual mempty (W.cmp_vartime c c) EQ - H.assertEqual mempty (W.cmp b a) GT- H.assertEqual mempty (W.cmp c a) GT- H.assertEqual mempty (W.cmp c b) GT+ H.assertEqual mempty (W.cmp_vartime b a) GT+ H.assertEqual mempty (W.cmp_vartime c a) GT+ H.assertEqual mempty (W.cmp_vartime c b) GT sqr :: H.Assertion sqr = do@@ -144,10 +144,10 @@ H.assertBool mempty (W.eq_vartime o e) instance Q.Arbitrary W.Wider where- arbitrary = fmap W.to Q.arbitrary+ arbitrary = fmap W.to_vartime Q.arbitrary odd_correct :: W.Wider -> Bool-odd_correct w = C.decide (W.odd w) == I.integerTestBit (W.from w) 0+odd_correct w = C.decide (W.odd w) == I.integerTestBit (W.from_vartime w) 0 tests :: TestTree tests = testGroup "wider tests" [