From 17336857c5fec89429c4d81853e2d2e463195d88 Mon Sep 17 00:00:00 2001 From: Will Song Date: Mon, 1 Jun 2020 20:56:42 -0500 Subject: [PATCH 1/6] implement square roots in f2m --- Crypto/Number/F2m.hs | 52 +++++++++++++++++++++++++++++++++++++++++--- tests/Number/F2m.hs | 8 +++++++ 2 files changed, 57 insertions(+), 3 deletions(-) diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs index 93b1f48..ad0941f 100644 --- a/Crypto/Number/F2m.hs +++ b/Crypto/Number/F2m.hs @@ -16,7 +16,10 @@ module Crypto.Number.F2m , mulF2m , squareF2m' , squareF2m + , powF2m + , powF2m' , modF2m + , sqrtF2m , invF2m , divF2m ) where @@ -66,8 +69,8 @@ mulF2m :: BinaryPolynomial -- ^ Modulus mulF2m fx n1 n2 | fx < 0 || n1 < 0 - || n2 < 0 = error "mulF2m: negative number represent no binary binary polynomial" - | fx == 0 = error "modF2m: cannot multiply modulo zero polynomial" + || n2 < 0 = error "mulF2m: negative number represent no binary polynomial" + | fx == 0 = error "mulF2m: cannot multiply modulo zero polynomial" | otherwise = modF2m fx $ go (if n2 `mod` 2 == 1 then n1 else 0) (log2 n2) where go n s | s == 0 = n @@ -96,10 +99,53 @@ squareF2m fx = modF2m fx . squareF2m' squareF2m' :: Integer -> Integer squareF2m' n - | n < 0 = error "mulF2m: negative number represent no binary binary polynomial" + | n < 0 = error "mulF2m: negative number represent no binary polynomial" | otherwise = foldl' (\acc s -> if testBit n s then setBit acc (2 * s) else acc) 0 [0 .. log2 n] {-# INLINE squareF2m' #-} +-- | Exponentiation in F₂m by computing @a^b mod fx@. +-- +-- This implements an exponentiation by squaring based solution. It inherits the +-- same restrictions as 'squareF2m'. Negative exponents are disallowed. See +-- 'powF2m'' for one that handles this case +powF2m :: BinaryPolynomial -- ^Modulus + -> Integer -- ^a + -> Integer -- ^b + -> Integer +powF2m fx a b + | b == 0 = 1 + | b > 0 = squareF2m fx x * if even b then 1 else a + | b < 0 = error "powF2m: negative exponents disallowed" + | otherwise = error "powF2m: impossible" + where x = powF2m fx a (b `div` 2) + +-- | Exponentiation in F₂m by computing @a^b mod fx@. +-- +-- This implements an exponentiation by squaring based solution. It inherits the +-- same restrictions as 'squareF2m'. 'Nothing' is returned when a negative +-- exponent is given and @a@ is not invertible. +powF2m' :: BinaryPolynomial -- ^Modulus + -> Integer -- ^a + -> Integer -- ^b + -> Maybe Integer +powF2m' fx a b + | b == 0 = Just 1 + | b > 0 = Just $ powF2m fx a b + | b < 0 = case invF2m fx a of + Just inv -> Just $ powF2m fx inv (-b) + Nothing -> Nothing + | otherwise = error "impossible" + +-- | Square rooot in F₂m. +-- +-- We exploit the fact that @a^(2^m) = a@, or in particular, @a^(2^m - 1) = 1@ +-- from a classical result by Lagrange. Thus the square root is simply @a^(2^(m +-- - 1))@. +sqrtF2m :: BinaryPolynomial -- ^Modulus + -> Integer -- ^a + -> Integer +sqrtF2m fx a = powF2m fx a (2 ^ (log2 fx - 1)) + -- | Extended GCD algorithm for polynomials. For @a@ and @b@ returns @(g, u, v)@ such that @a * u + b * v == g@. -- -- Reference: https://en.wikipedia.org/wiki/Polynomial_greatest_common_divisor#B.C3.A9zout.27s_identity_and_extended_GCD_algorithm diff --git a/tests/Number/F2m.hs b/tests/Number/F2m.hs index afa6e50..4434a9b 100644 --- a/tests/Number/F2m.hs +++ b/tests/Number/F2m.hs @@ -52,6 +52,14 @@ mulTests = testGroup "mulF2m" squareTests = testGroup "squareF2m" [ testProperty "sqr(a) == a * a" $ \(Positive m) (NonNegative a) -> mulF2m m a a == squareF2m m a + -- disabled because we require @m@ to be a suitable modulus and there is no + -- way to guarantee this + -- , testProperty "sqrt(a) * sqrt(a) = a" + -- $ \(Positive m) (NonNegative aa) -> let a = sqrtF2m m aa in mulF2m m a a == modF2m m aa + , testProperty "sqrt(a) * sqrt(a) = a in GF(2^16)" + $ let m = 65581 :: Integer -- x^16 + x^5 + x^3 + x^2 + 1 + nums = [0 .. 65535 :: Integer] + in nums == [let y = sqrtF2m m x in squareF2m m y | x <- nums] ] invTests = testGroup "invF2m" From f64efafbad17a92aa8b7c009e70a9073ac3c940b Mon Sep 17 00:00:00 2001 From: Will Song Date: Mon, 8 Jun 2020 10:16:42 -0500 Subject: [PATCH 2/6] update sqrtF2m --- Crypto/Number/F2m.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs index ad0941f..53b1c69 100644 --- a/Crypto/Number/F2m.hs +++ b/Crypto/Number/F2m.hs @@ -144,7 +144,9 @@ powF2m' fx a b sqrtF2m :: BinaryPolynomial -- ^Modulus -> Integer -- ^a -> Integer -sqrtF2m fx a = powF2m fx a (2 ^ (log2 fx - 1)) +sqrtF2m fx a = go (log2 fx - 1) a + where go 0 x = x + go n x = go (n - 1) (squareF2m fx x) -- | Extended GCD algorithm for polynomials. For @a@ and @b@ returns @(g, u, v)@ such that @a * u + b * v == g@. -- From 5f657fda2e18988b2b7ed91c7cc3373f98922b2f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 12 Jun 2020 18:54:37 +0200 Subject: [PATCH 3/6] Remove powF2m' We keep only the function providing the base service, negative exponents can be still computed with invF2m. --- Crypto/Number/F2m.hs | 21 +-------------------- 1 file changed, 1 insertion(+), 20 deletions(-) diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs index 53b1c69..4dd0db2 100644 --- a/Crypto/Number/F2m.hs +++ b/Crypto/Number/F2m.hs @@ -17,7 +17,6 @@ module Crypto.Number.F2m , squareF2m' , squareF2m , powF2m - , powF2m' , modF2m , sqrtF2m , invF2m @@ -106,8 +105,7 @@ squareF2m' n -- | Exponentiation in F₂m by computing @a^b mod fx@. -- -- This implements an exponentiation by squaring based solution. It inherits the --- same restrictions as 'squareF2m'. Negative exponents are disallowed. See --- 'powF2m'' for one that handles this case +-- same restrictions as 'squareF2m'. Negative exponents are disallowed. powF2m :: BinaryPolynomial -- ^Modulus -> Integer -- ^a -> Integer -- ^b @@ -119,23 +117,6 @@ powF2m fx a b | otherwise = error "powF2m: impossible" where x = powF2m fx a (b `div` 2) --- | Exponentiation in F₂m by computing @a^b mod fx@. --- --- This implements an exponentiation by squaring based solution. It inherits the --- same restrictions as 'squareF2m'. 'Nothing' is returned when a negative --- exponent is given and @a@ is not invertible. -powF2m' :: BinaryPolynomial -- ^Modulus - -> Integer -- ^a - -> Integer -- ^b - -> Maybe Integer -powF2m' fx a b - | b == 0 = Just 1 - | b > 0 = Just $ powF2m fx a b - | b < 0 = case invF2m fx a of - Just inv -> Just $ powF2m fx inv (-b) - Nothing -> Nothing - | otherwise = error "impossible" - -- | Square rooot in F₂m. -- -- We exploit the fact that @a^(2^m) = a@, or in particular, @a^(2^m - 1) = 1@ From dfc9fb9fb254e4cdf517585c406bf4b01704ccaa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 12 Jun 2020 19:01:52 +0200 Subject: [PATCH 4/6] Fix powF2m when exponent is not a power of 2 Integer multiplication cannot be used because it includes carry propagation. This needs to use carry-less mulF2m instead. --- Crypto/Number/F2m.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs index 4dd0db2..6ca2604 100644 --- a/Crypto/Number/F2m.hs +++ b/Crypto/Number/F2m.hs @@ -111,10 +111,10 @@ powF2m :: BinaryPolynomial -- ^Modulus -> Integer -- ^b -> Integer powF2m fx a b - | b == 0 = 1 - | b > 0 = squareF2m fx x * if even b then 1 else a - | b < 0 = error "powF2m: negative exponents disallowed" - | otherwise = error "powF2m: impossible" + | b < 0 = error "powF2m: negative exponents disallowed" + | b == 0 = if fx > 1 then 1 else 0 + | even b = squareF2m fx x + | otherwise = mulF2m fx a (squareF2m' x) where x = powF2m fx a (b `div` 2) -- | Square rooot in F₂m. From edbd9e09fb379023bfbbdd3703570d85e7c14ffa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 12 Jun 2020 19:06:58 +0200 Subject: [PATCH 5/6] Test properties of powF2m --- tests/Number/F2m.hs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/tests/Number/F2m.hs b/tests/Number/F2m.hs index 4434a9b..80c86be 100644 --- a/tests/Number/F2m.hs +++ b/tests/Number/F2m.hs @@ -62,6 +62,24 @@ squareTests = testGroup "squareF2m" in nums == [let y = sqrtF2m m x in squareF2m m y | x <- nums] ] +powTests = testGroup "powF2m" + [ testProperty "2 is square" + $ \(Positive m) (NonNegative a) -> powF2m m a 2 == squareF2m m a + , testProperty "1 is identity" + $ \(Positive m) (NonNegative a) -> powF2m m a 1 == modF2m m a + , testProperty "0 is annihilator" + $ \(Positive m) (NonNegative a) -> powF2m m a 0 == modF2m m 1 + , testProperty "(a * b) ^ c == (a ^ c) * (b ^ c)" + $ \(Positive m) (NonNegative a) (NonNegative b) (NonNegative c) + -> powF2m m (mulF2m m a b) c == mulF2m m (powF2m m a c) (powF2m m b c) + , testProperty "a ^ (b + c) == (a ^ b) * (a ^ c)" + $ \(Positive m) (NonNegative a) (NonNegative b) (NonNegative c) + -> powF2m m a (b + c) == mulF2m m (powF2m m a b) (powF2m m a c) + , testProperty "a ^ (b * c) == (a ^ b) ^ c" + $ \(Positive m) (NonNegative a) (NonNegative b) (NonNegative c) + -> powF2m m a (b * c) == powF2m m (powF2m m a b) c + ] + invTests = testGroup "invF2m" [ testProperty "1 / a * a == 1" $ \(Positive m) (NonNegative a) @@ -86,6 +104,7 @@ tests = testGroup "number.F2m" , modTests , mulTests , squareTests + , powTests , invTests , divTests ] From c123752de438fe00a7342e91e522c67bb274f642 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 13 Jun 2020 09:24:47 +0200 Subject: [PATCH 6/6] Use isNothing --- tests/Number/F2m.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/Number/F2m.hs b/tests/Number/F2m.hs index 80c86be..19acd61 100644 --- a/tests/Number/F2m.hs +++ b/tests/Number/F2m.hs @@ -2,6 +2,7 @@ module Number.F2m (tests) where import Imports hiding ((.&.)) import Data.Bits +import Data.Maybe import Crypto.Number.Basic (log2) import Crypto.Number.F2m @@ -96,7 +97,7 @@ divTests = testGroup "divF2m" -> divF2m m a b == (mulF2m m a <$> invF2m m b) , testProperty "a * b / b == a" $ \(Positive m) (NonNegative a) (NonNegative b) - -> invF2m m b == Nothing || divF2m m (mulF2m m a b) b == Just (modF2m m a) + -> isNothing (invF2m m b) || divF2m m (mulF2m m a b) b == Just (modF2m m a) ] tests = testGroup "number.F2m"