From d9758ea799d74c2dff645be0c356128b6422f2e2 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Sat, 23 Jul 2016 11:57:17 +0200 Subject: [PATCH 1/6] Benchmarks for Crypto.Number.F2m --- benchs/Number/F2m.hs | 53 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100644 benchs/Number/F2m.hs diff --git a/benchs/Number/F2m.hs b/benchs/Number/F2m.hs new file mode 100644 index 0000000..408a192 --- /dev/null +++ b/benchs/Number/F2m.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE PackageImports #-} + +module Main where + +import Criterion.Main +import System.Random + +import "cryptonite" Crypto.Number.Basic (log2) +import "cryptonite" Crypto.Number.F2m + +genInteger :: Int -> Int -> Integer +genInteger salt bits + = head + . dropWhile ((< bits) . log2) + . scanl (\a r -> a * 2^31 + abs r) 0 + . randoms + . mkStdGen + $ salt + bits + +benchMod :: Int -> Benchmark +benchMod bits = bench (show bits) $ nf (modF2m m) a + where + m = genInteger 0 bits + a = genInteger 1 (2 * bits) + +benchMul :: Int -> Benchmark +benchMul bits = bench (show bits) $ nf (mulF2m m a) b + where + m = genInteger 0 bits + a = genInteger 1 bits + b = genInteger 2 bits + +benchSquare :: Int -> Benchmark +benchSquare bits = bench (show bits) $ nf (squareF2m m) a + where + m = genInteger 0 bits + a = genInteger 1 bits + +benchInv :: Int -> Benchmark +benchInv bits = bench (show bits) $ nf (invF2m m) a + where + m = genInteger 0 bits + a = genInteger 1 bits + +bitsList :: [Int] +bitsList = [64, 128, 256, 512, 1024, 2048] + +main = defaultMain + [ bgroup "modF2m" $ map benchMod bitsList + , bgroup "mulF2m" $ map benchMul bitsList + , bgroup "squareF2m" $ map benchSquare bitsList + , bgroup "invF2m" $ map benchInv bitsList + ] From e80eaa56f30a69552aded62dadb8212b3546578c Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Fri, 22 Jul 2016 18:01:44 +0300 Subject: [PATCH 2/6] Tests for Crypto.Number.F2m --- Crypto/Number/F2m.hs | 9 ++--- cryptonite.cabal | 6 ++++ tests/Number/F2m.hs | 83 ++++++++++++++++++++++++++++++++++++++++++++ tests/Tests.hs | 2 ++ 4 files changed, 96 insertions(+), 4 deletions(-) create mode 100644 tests/Number/F2m.hs diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs index 274b8df..d86d7e9 100644 --- a/Crypto/Number/F2m.hs +++ b/Crypto/Number/F2m.hs @@ -13,6 +13,7 @@ module Crypto.Number.F2m ( BinaryPolynomial , addF2m , mulF2m + , squareF2m' , squareF2m , modF2m , invF2m @@ -64,11 +65,11 @@ mulF2m fx n1 n2 = modF2m fx -- Multiplication table? C? squareF2m :: BinaryPolynomial -- ^ Irreducible binary polynomial -> Integer -> Integer -squareF2m fx = modF2m fx . square +squareF2m fx = modF2m fx . squareF2m' {-# INLINE squareF2m #-} -square :: Integer -> Integer -square n1 = go n1 ln1 +squareF2m' :: Integer -> Integer +squareF2m' n1 = go n1 ln1 where ln1 = log2 n1 go n s | s == 0 = n @@ -76,7 +77,7 @@ square n1 = go n1 ln1 where x = shift (shift n (2 * (s - ln1) - 1)) (2 * (ln1 - s) + 2) y = n .&. (shift 1 (2 * (ln1 - s) + 1) - 1) -{-# INLINE square #-} +{-# INLINE squareF2m' #-} -- | Inversion of @n over F₂m using extended Euclidean algorithm. -- diff --git a/cryptonite.cabal b/cryptonite.cabal index 2450f0a..c2dc811 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -308,8 +308,10 @@ Test-Suite test-cryptonite KAT_Camellia KAT_Curve25519 KAT_DES + KAT_Ed448 KAT_Ed25519 KAT_CMAC + KAT_HKDF KAT_HMAC KAT_MiyaguchiPreneel KAT_PBKDF2 @@ -323,6 +325,10 @@ Test-Suite test-cryptonite KAT_RC4 KAT_Scrypt KAT_TripleDES + ChaChaPoly1305 + Number + Number.F2m + Padding Poly1305 Salsa Utils diff --git a/tests/Number/F2m.hs b/tests/Number/F2m.hs new file mode 100644 index 0000000..afa6e50 --- /dev/null +++ b/tests/Number/F2m.hs @@ -0,0 +1,83 @@ +module Number.F2m (tests) where + +import Imports hiding ((.&.)) +import Data.Bits +import Crypto.Number.Basic (log2) +import Crypto.Number.F2m + +addTests = testGroup "addF2m" + [ testProperty "commutative" + $ \a b -> a `addF2m` b == b `addF2m` a + , testProperty "associative" + $ \a b c -> (a `addF2m` b) `addF2m` c == a `addF2m` (b `addF2m` c) + , testProperty "0 is neutral" + $ \a -> a `addF2m` 0 == a + , testProperty "nullable" + $ \a -> a `addF2m` a == 0 + , testProperty "works per bit" + $ \a b -> (a `addF2m` b) .&. b == (a .&. b) `addF2m` b + ] + +modTests = testGroup "modF2m" + [ testProperty "idempotent" + $ \(Positive m) (NonNegative a) -> modF2m m a == modF2m m (modF2m m a) + , testProperty "upper bound" + $ \(Positive m) (NonNegative a) -> modF2m m a < 2 ^ log2 m + , testProperty "reach upper" + $ \(Positive m) -> let a = 2 ^ log2 m - 1 in modF2m m (m `addF2m` a) == a + , testProperty "lower bound" + $ \(Positive m) (NonNegative a) -> modF2m m a >= 0 + , testProperty "reach lower" + $ \(Positive m) -> modF2m m m == 0 + , testProperty "additive" + $ \(Positive m) (NonNegative a) (NonNegative b) + -> modF2m m a `addF2m` modF2m m b == modF2m m (a `addF2m` b) + ] + +mulTests = testGroup "mulF2m" + [ testProperty "commutative" + $ \(Positive m) (NonNegative a) (NonNegative b) -> mulF2m m a b == mulF2m m b a + , testProperty "associative" + $ \(Positive m) (NonNegative a) (NonNegative b) (NonNegative c) + -> mulF2m m (mulF2m m a b) c == mulF2m m a (mulF2m m b c) + , testProperty "1 is neutral" + $ \(Positive m) (NonNegative a) -> mulF2m m a 1 == modF2m m a + , testProperty "0 is annihilator" + $ \(Positive m) (NonNegative a) -> mulF2m m a 0 == 0 + , testProperty "distributive" + $ \(Positive m) (NonNegative a) (NonNegative b) (NonNegative c) + -> mulF2m m a (b `addF2m` c) == mulF2m m a b `addF2m` mulF2m m a c + ] + +squareTests = testGroup "squareF2m" + [ testProperty "sqr(a) == a * a" + $ \(Positive m) (NonNegative a) -> mulF2m m a a == squareF2m m a + ] + +invTests = testGroup "invF2m" + [ testProperty "1 / a * a == 1" + $ \(Positive m) (NonNegative a) + -> maybe True (\c -> mulF2m m c a == modF2m m 1) (invF2m m a) + , testProperty "1 / a == a (mod a^2-1)" + $ \(NonNegative a) -> a < 2 || invF2m (squareF2m' a `addF2m` 1) a == Just a + ] + +divTests = testGroup "divF2m" + [ testProperty "1 / a == inv a" + $ \(Positive m) (NonNegative a) -> divF2m m 1 a == invF2m m a + , testProperty "a / b == a * inv b" + $ \(Positive m) (NonNegative a) (NonNegative b) + -> 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) + ] + +tests = testGroup "number.F2m" + [ addTests + , modTests + , mulTests + , squareTests + , invTests + , divTests + ] diff --git a/tests/Tests.hs b/tests/Tests.hs index 9d2c017..1ab9ea5 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -4,6 +4,7 @@ module Main where import Imports import qualified Number +import qualified Number.F2m import qualified BCrypt import qualified Hash import qualified Poly1305 @@ -33,6 +34,7 @@ import qualified Padding tests = testGroup "cryptonite" [ Number.tests + , Number.F2m.tests , Hash.tests , Padding.tests , testGroup "ConstructHash" From 66ae77e80595c2b0267960a7de576bafb5e09eb7 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Sun, 24 Jul 2016 10:55:49 +0200 Subject: [PATCH 3/6] Fix tests and provide documentation for Crypto.Number.F2m --- Crypto/Number/F2m.hs | 146 +++++++++++++++++++++++++++---------------- 1 file changed, 92 insertions(+), 54 deletions(-) diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs index d86d7e9..d3edba7 100644 --- a/Crypto/Number/F2m.hs +++ b/Crypto/Number/F2m.hs @@ -9,6 +9,7 @@ -- not optimal and it doesn't provide protection against timing -- attacks. The 'm' parameter is implicitly derived from the irreducible -- polynomial where applicable. + module Crypto.Number.F2m ( BinaryPolynomial , addF2m @@ -22,88 +23,125 @@ module Crypto.Number.F2m import Data.Bits ((.&.),(.|.),xor,shift,testBit) import Crypto.Number.Basic -import Crypto.Internal.Imports -- | Binary Polynomial represented by an integer type BinaryPolynomial = Integer --- | Addition over F₂m. This is just a synonym of 'xor'. -addF2m :: Integer -> Integer -> Integer +-- | Addition over F₂m. This is just a synonym of 'xor'. +addF2m :: Integer + -> Integer + -> Integer addF2m = xor {-# INLINE addF2m #-} --- | Binary polynomial reduction modulo using long division algorithm. -modF2m :: BinaryPolynomial -- ^ Irreducible binary polynomial - -> Integer -> Integer -modF2m fx = go - where - lfx = log2 fx - go n | s == 0 = n `xor` fx - | s < 0 = n - | otherwise = go $ n `xor` shift fx s +-- | Reduction by modulo over F₂m. +-- +-- This function is undefined for negative arguments, because their bit +-- representation is platform-dependent. Zero modulus is also prohibited. +modF2m :: BinaryPolynomial -- ^ Modulus + -> Integer + -> Integer +modF2m fx i + | fx < 0 || i < 0 = error "modF2m: negative number represent no binary polynomial" + | fx == 0 = error "modF2m: cannot divide by zero polynomial" + | fx == 1 = 0 + | otherwise = go i where - s = log2 n - lfx + lfx = log2 fx + go n | s == 0 = n `addF2m` fx + | s < 0 = n + | otherwise = go $ n `addF2m` shift fx s + where s = log2 n - lfx {-# INLINE modF2m #-} -- | Multiplication over F₂m. -- --- n1 * n2 (in F(2^m)) -mulF2m :: BinaryPolynomial -- ^ Irreducible binary polynomial - -> Integer -> Integer -> Integer -mulF2m fx n1 n2 = modF2m fx - $ go (if n2 `mod` 2 == 1 then n1 else 0) (log2 n2) - where - go n s | s == 0 = n - | otherwise = if testBit n2 s - then go (n `xor` shift n1 s) (s - 1) - else go n (s - 1) +-- This function is undefined for negative arguments, because their bit +-- representation is platform-dependent. Zero modulus is also prohibited. +mulF2m :: BinaryPolynomial -- ^ Modulus + -> Integer + -> Integer + -> Integer +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" + | otherwise = modF2m fx $ go (if n2 `mod` 2 == 1 then n1 else 0) (log2 n2) + where + go n s | s == 0 = n + | otherwise = if testBit n2 s + then go (n `addF2m` shift n1 s) (s - 1) + else go n (s - 1) {-# INLINABLE mulF2m #-} -- | Squaring over F₂m. +-- +-- This function is undefined for negative arguments, because their bit +-- representation is platform-dependent. Zero modulus is also prohibited. +-- -- TODO: This is still slower than @mulF2m@. - +-- -- Multiplication table? C? -squareF2m :: BinaryPolynomial -- ^ Irreducible binary polynomial - -> Integer -> Integer +squareF2m :: BinaryPolynomial -- ^ Modulus + -> Integer + -> Integer squareF2m fx = modF2m fx . squareF2m' {-# INLINE squareF2m #-} -squareF2m' :: Integer -> Integer -squareF2m' n1 = go n1 ln1 - where - ln1 = log2 n1 - go n s | s == 0 = n - | otherwise = go (x .|. y) (s - 1) +-- | Squaring over F₂m. +-- +-- This function is undefined for negative arguments, because their bit +-- representation is platform-dependent. +squareF2m' :: Integer + -> Integer +squareF2m' n1 + | n1 < 0 = error "mulF2m: negative number represent no binary binary polynomial" + | otherwise = go n1 ln1 where - x = shift (shift n (2 * (s - ln1) - 1)) (2 * (ln1 - s) + 2) - y = n .&. (shift 1 (2 * (ln1 - s) + 1) - 1) + ln1 = log2 n1 + go n s | s == 0 = n + | otherwise = go (x .|. y) (s - 1) + where + x = shift (shift n (2 * (s - ln1) - 1)) (2 * (ln1 - s) + 2) + y = n .&. (shift 1 (2 * (ln1 - s) + 1) - 1) {-# INLINE squareF2m' #-} --- | Inversion of @n over F₂m using extended Euclidean algorithm. +-- | Extended GCD algorithm for polynomials. For @a@ and @b@ returns @(g, u, v)@ such that @a * u + b * v == g@. -- --- If @n doesn't have an inverse, Nothing is returned. -invF2m :: BinaryPolynomial -- ^ Irreducible binary polynomial - -> Integer -> Maybe Integer -invF2m _ 0 = Nothing -invF2m fx n - | n >= fx = Nothing - | otherwise = go n fx 1 0 - where - go u v g1 g2 - | u == 1 = Just $ modF2m fx g1 - | j < 0 = go u (v `xor` shift u (-j)) g1 (g2 `xor` shift g1 (-j)) - | otherwise = go (u `xor` shift v j) v (g1 `xor` shift g2 j) g2 - where - j = log2 u - log2 v +-- Reference: https://en.wikipedia.org/wiki/Polynomial_greatest_common_divisor#B.C3.A9zout.27s_identity_and_extended_GCD_algorithm +gcdF2m :: Integer + -> Integer + -> (Integer, Integer, Integer) +gcdF2m a b = go (a, b, 1, 0, 0, 1) + where + go (g, 0, u, _, v, _) + = (g, u, v) + go (r0, r1, s0, s1, t0, t1) + = go (r1, r0 `addF2m` shift r1 j, s1, s0 `addF2m` shift s1 j, t1, t0 `addF2m` shift t1 j) + where j = max 0 (log2 r0 - log2 r1) + +-- | Modular inversion over F₂m. +-- If @n@ doesn't have an inverse, 'Nothing' is returned. +-- +-- This function is undefined for negative arguments, because their bit +-- representation is platform-dependent. Zero modulus is also prohibited. +invF2m :: BinaryPolynomial -- ^ Modulus + -> Integer + -> Maybe Integer +invF2m fx n = if g == 1 then Just (modF2m fx u) else Nothing + where + (g, u, _) = gcdF2m n fx {-# INLINABLE invF2m #-} -- | Division over F₂m. If the dividend doesn't have an inverse it returns -- 'Nothing'. -- --- Compute n1 / n2 -divF2m :: BinaryPolynomial -- ^ Irreducible binary polynomial - -> Integer -- ^ Dividend - -> Integer -- ^ Quotient - -> Maybe Integer +-- This function is undefined for negative arguments, because their bit +-- representation is platform-dependent. Zero modulus is also prohibited. +divF2m :: BinaryPolynomial -- ^ Modulus + -> Integer -- ^ Dividend + -> Integer -- ^ Divisor + -> Maybe Integer -- ^ Quotient divF2m fx n1 n2 = mulF2m fx n1 <$> invF2m fx n2 {-# INLINE divF2m #-} From b25df69e263b5b6db6ee95c7c5f9edbfc8c32780 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Sun, 24 Jul 2016 10:52:59 +0200 Subject: [PATCH 4/6] Speed up squaring 3x (now 10% faster than mul) --- Crypto/Number/F2m.hs | 25 +++++++++---------------- 1 file changed, 9 insertions(+), 16 deletions(-) diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs index d3edba7..93b1f48 100644 --- a/Crypto/Number/F2m.hs +++ b/Crypto/Number/F2m.hs @@ -21,7 +21,8 @@ module Crypto.Number.F2m , divF2m ) where -import Data.Bits ((.&.),(.|.),xor,shift,testBit) +import Data.Bits (xor, shift, testBit, setBit) +import Data.List import Crypto.Number.Basic -- | Binary Polynomial represented by an integer @@ -79,32 +80,24 @@ mulF2m fx n1 n2 -- -- This function is undefined for negative arguments, because their bit -- representation is platform-dependent. Zero modulus is also prohibited. --- --- TODO: This is still slower than @mulF2m@. --- --- Multiplication table? C? squareF2m :: BinaryPolynomial -- ^ Modulus -> Integer -> Integer squareF2m fx = modF2m fx . squareF2m' {-# INLINE squareF2m #-} --- | Squaring over F₂m. +-- | Squaring over F₂m without reduction by modulo. +-- +-- The implementation utilizes the fact that for binary polynomial S(x) we have +-- S(x)^2 = S(x^2). In other words, insert a zero bit between every bits of argument: 1101 -> 1010001. -- -- This function is undefined for negative arguments, because their bit -- representation is platform-dependent. squareF2m' :: Integer -> Integer -squareF2m' n1 - | n1 < 0 = error "mulF2m: negative number represent no binary binary polynomial" - | otherwise = go n1 ln1 - where - ln1 = log2 n1 - go n s | s == 0 = n - | otherwise = go (x .|. y) (s - 1) - where - x = shift (shift n (2 * (s - ln1) - 1)) (2 * (ln1 - s) + 2) - y = n .&. (shift 1 (2 * (ln1 - s) + 1) - 1) +squareF2m' n + | n < 0 = error "mulF2m: negative number represent no binary binary polynomial" + | otherwise = foldl' (\acc s -> if testBit n s then setBit acc (2 * s) else acc) 0 [0 .. log2 n] {-# INLINE squareF2m' #-} -- | Extended GCD algorithm for polynomials. For @a@ and @b@ returns @(g, u, v)@ such that @a * u + b * v == g@. From 7e53922f4f710290c7099a565ba474eedeefec83 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Sun, 24 Jul 2016 13:40:24 +0200 Subject: [PATCH 5/6] Fix pointMul with negative factor on CurveF2m --- Crypto/PubKey/ECC/Prim.hs | 42 ++++++++++++++++++++++----------------- 1 file changed, 24 insertions(+), 18 deletions(-) diff --git a/Crypto/PubKey/ECC/Prim.hs b/Crypto/PubKey/ECC/Prim.hs index 139d28a..a3a8324 100644 --- a/Crypto/PubKey/ECC/Prim.hs +++ b/Crypto/PubKey/ECC/Prim.hs @@ -26,6 +26,13 @@ scalarGenerate curve = generateBetween 1 (n - 1) --TODO: Extract helper function for `fromMaybe PointO...` +-- | Elliptic Curve point negation: +-- @pointNegate c p@ returns point @q@ such that @pointAdd c p q == PointO@. +pointNegate :: Curve -> Point -> Point +pointNegate _ PointO = PointO +pointNegate CurveFP{} (Point x y) = Point x (-y) +pointNegate CurveF2m{} (Point x y) = Point x (x `addF2m` y) + -- | Elliptic Curve point addition. -- -- /WARNING:/ Vulnerable to timing attacks. @@ -33,22 +40,21 @@ pointAdd :: Curve -> Point -> Point -> Point pointAdd _ PointO PointO = PointO pointAdd _ PointO q = q pointAdd _ p PointO = p -pointAdd c@(CurveFP (CurvePrime pr _)) p@(Point xp yp) q@(Point xq yq) - | p == Point xq (-yq) = PointO - | p == q = pointDouble c p - | otherwise = fromMaybe PointO $ do - s <- divmod (yp - yq) (xp - xq) pr - let xr = (s ^ (2::Int) - xp - xq) `mod` pr - yr = (s * (xp - xr) - yp) `mod` pr - return $ Point xr yr -pointAdd c@(CurveF2m (CurveBinary fx cc)) p@(Point xp yp) q@(Point xq yq) - | p == Point xq (xq `addF2m` yq) = PointO - | p == q = pointDouble c p - | otherwise = fromMaybe PointO $ do - s <- divF2m fx (yp `addF2m` yq) (xp `addF2m` xq) - let xr = mulF2m fx s s `addF2m` s `addF2m` xp `addF2m` xq `addF2m` a - yr = mulF2m fx s (xp `addF2m` xr) `addF2m` xr `addF2m` yp - return $ Point xr yr +pointAdd c p q + | p == q = pointDouble c p + | p == pointNegate c q = PointO +pointAdd (CurveFP (CurvePrime pr _)) (Point xp yp) (Point xq yq) + = fromMaybe PointO $ do + s <- divmod (yp - yq) (xp - xq) pr + let xr = (s ^ (2::Int) - xp - xq) `mod` pr + yr = (s * (xp - xr) - yp) `mod` pr + return $ Point xr yr +pointAdd (CurveF2m (CurveBinary fx cc)) (Point xp yp) (Point xq yq) + = fromMaybe PointO $ do + s <- divF2m fx (yp `addF2m` yq) (xp `addF2m` xq) + let xr = mulF2m fx s s `addF2m` s `addF2m` xp `addF2m` xq `addF2m` a + yr = mulF2m fx s (xp `addF2m` xr) `addF2m` xr `addF2m` yp + return $ Point xr yr where a = ecc_a cc -- | Elliptic Curve point doubling. @@ -95,8 +101,8 @@ pointBaseMul c n = pointMul c n (ecc_g $ common_curve c) -- /WARNING:/ Vulnerable to timing attacks. pointMul :: Curve -> Integer -> Point -> Point pointMul _ _ PointO = PointO -pointMul c n p@(Point xp yp) - | n < 0 = pointMul c (-n) (Point xp (-yp)) +pointMul c n p + | n < 0 = pointMul c (-n) (pointNegate c p) | n == 0 = PointO | n == 1 = p | odd n = pointAdd c p (pointMul c (n - 1) p) From 2dec05f48b2aeb3c432b6c8bd918e733baabac1a Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Sun, 24 Jul 2016 14:54:22 +0200 Subject: [PATCH 6/6] Restore import of <$> --- Crypto/Number/F2m.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs index 93b1f48..503c309 100644 --- a/Crypto/Number/F2m.hs +++ b/Crypto/Number/F2m.hs @@ -23,6 +23,7 @@ module Crypto.Number.F2m import Data.Bits (xor, shift, testBit, setBit) import Data.List +import Crypto.Internal.Imports import Crypto.Number.Basic -- | Binary Polynomial represented by an integer