Merge pull request #92 from Bodigrim/number-f2m

Arithmetic over F2m

Crypto/Number/F2m.hs

@@ -9,100 +9,133 @@
 -- 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
     , mulF2m
+    , squareF2m'
     , squareF2m
     , modF2m
     , invF2m
     , divF2m
     ) where
 
-import Data.Bits ((.&.),(.|.),xor,shift,testBit)
+import Data.Bits (xor, shift, testBit, setBit)
-import Crypto.Number.Basic
+import Data.List
 import Crypto.Internal.Imports
+import Crypto.Number.Basic
 
 -- | Binary Polynomial represented by an integer
 type BinaryPolynomial = Integer
 
--- | Addition over F₂m. This is just a synonym of  'xor'.
+-- | Addition over F₂m. This is just a synonym of 'xor'.
-addF2m :: Integer -> Integer -> Integer
+addF2m :: Integer
+       -> Integer
+       -> Integer
 addF2m = xor
 {-# INLINE addF2m #-}
 
--- | Binary polynomial reduction modulo using long division algorithm.
+-- | Reduction by modulo over F₂m.
-modF2m :: BinaryPolynomial -- ^ Irreducible binary polynomial
+--
-       -> Integer -> Integer
+-- This function is undefined for negative arguments, because their bit
-modF2m fx = go
+-- representation is platform-dependent. Zero modulus is also prohibited.
-  where
+modF2m :: BinaryPolynomial -- ^ Modulus
-    lfx = log2 fx
+       -> Integer
-    go n | s == 0  = n `xor` fx
+       -> Integer
-         | s < 0 = n
+modF2m fx i
-         | otherwise = go $ n `xor` shift fx s
+    | 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))
+-- This function is undefined for negative arguments, because their bit
-mulF2m :: BinaryPolynomial  -- ^ Irreducible binary polynomial
+-- representation is platform-dependent. Zero modulus is also prohibited.
-       -> Integer -> Integer -> Integer
+mulF2m :: BinaryPolynomial -- ^ Modulus
-mulF2m fx n1 n2 = modF2m fx
+       -> Integer
-                $ go (if n2 `mod` 2 == 1 then n1 else 0) (log2 n2)
+       -> Integer
-  where
+       -> Integer
-    go n s | s == 0  = n
+mulF2m fx n1 n2
-           | otherwise = if testBit n2 s
+    |    fx < 0
-                            then go (n `xor` shift n1 s) (s - 1)
+      || n1 < 0
-                            else go n (s - 1)
+      || 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.
--- TODO: This is still slower than @mulF2m@.
+--
-
+-- This function is undefined for negative arguments, because their bit
--- Multiplication table? C?
+-- representation is platform-dependent. Zero modulus is also prohibited.
-squareF2m :: BinaryPolynomial  -- ^ Irreducible binary polynomial
+squareF2m :: BinaryPolynomial -- ^ Modulus
-          -> Integer -> Integer
+          -> Integer
-squareF2m fx = modF2m fx . square
+          -> Integer
+squareF2m fx = modF2m fx . squareF2m'
 {-# INLINE squareF2m #-}
 
-square :: Integer -> Integer
+-- | Squaring over F₂m without reduction by modulo.
-square n1 = 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)
-{-# INLINE square #-}
-
--- | Inversion of @n over F₂m using extended Euclidean algorithm.
 --
--- If @n doesn't have an inverse, Nothing is returned.
+-- The implementation utilizes the fact that for binary polynomial S(x) we have
-invF2m :: BinaryPolynomial -- ^ Irreducible binary polynomial
+-- S(x)^2 = S(x^2). In other words, insert a zero bit between every bits of argument: 1101 -> 1010001.
-       -> Integer -> Maybe Integer
+--
-invF2m _  0 = Nothing
+-- This function is undefined for negative arguments, because their bit
-invF2m fx n
+-- representation is platform-dependent.
-    | n >= fx   = Nothing
+squareF2m' :: Integer
-    | otherwise = go n fx 1 0
+           -> Integer
-    where
+squareF2m' n
-      go u v g1 g2
+    | n < 0     = error "mulF2m: negative number represent no binary binary polynomial"
-          | u == 1    = Just $ modF2m fx g1
+    | otherwise = foldl' (\acc s -> if testBit n s then setBit acc (2 * s) else acc) 0 [0 .. log2 n]
-          | j < 0     = go u  (v  `xor` shift  u (-j)) g1 (g2 `xor` shift g1 (-j))
+{-# INLINE squareF2m' #-}
-          | otherwise = go (u  `xor` shift v  j) v (g1 `xor` shift g2 j) g2
+
-        where
+-- | Extended GCD algorithm for polynomials. For @a@ and @b@ returns @(g, u, v)@ such that @a * u + b * v == g@.
-          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
+-- This function is undefined for negative arguments, because their bit
-divF2m :: BinaryPolynomial  -- ^ Irreducible binary polynomial
+-- representation is platform-dependent. Zero modulus is also prohibited.
-       -> Integer  -- ^ Dividend
+divF2m :: BinaryPolynomial -- ^ Modulus
-       -> Integer  -- ^ Quotient
+       -> Integer          -- ^ Dividend
-       -> Maybe Integer
+       -> Integer          -- ^ Divisor
+       -> Maybe Integer    -- ^ Quotient
 divF2m fx n1 n2 = mulF2m fx n1 <$> invF2m fx n2
 {-# INLINE divF2m #-}

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)
+pointAdd c p q
-    | p == Point xq (-yq) = PointO
+  | p == q = pointDouble c p
-    | p == q = pointDouble c p
+  | p == pointNegate c q = PointO
-    | otherwise = fromMaybe PointO $ do
+pointAdd (CurveFP (CurvePrime pr _)) (Point xp yp) (Point xq yq)
-                      s <- divmod (yp - yq) (xp - xq) pr
+    = fromMaybe PointO $ do
-                      let xr = (s ^ (2::Int) - xp - xq) `mod` pr
+        s <- divmod (yp - yq) (xp - xq) pr
-                          yr = (s * (xp - xr) - yp) `mod` pr
+        let xr = (s ^ (2::Int) - xp - xq) `mod` pr
-                      return $ Point xr yr
+            yr = (s * (xp - xr) - yp) `mod` pr
-pointAdd c@(CurveF2m (CurveBinary fx cc)) p@(Point xp yp) q@(Point xq yq)
+        return $ Point xr yr
-    | p == Point xq (xq `addF2m` yq) = PointO
+pointAdd (CurveF2m (CurveBinary fx cc)) (Point xp yp) (Point xq yq)
-    | p == q = pointDouble c p
+    = fromMaybe PointO $ do
-    | otherwise = fromMaybe PointO $ do
+        s <- divF2m fx (yp `addF2m` yq) (xp `addF2m` xq)
-                     s <- divF2m fx (yp `addF2m` yq) (xp `addF2m` xq)
+        let xr = mulF2m fx s s `addF2m` s `addF2m` xp `addF2m` xq `addF2m` a
-                     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
-                         yr = mulF2m fx s (xp `addF2m` xr) `addF2m` xr `addF2m` yp
+        return $ Point xr yr
-                     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)
+pointMul c n p
-    | n <  0 = pointMul c (-n) (Point xp (-yp))
+    | n <  0 = pointMul c (-n) (pointNegate c p)
     | n == 0 = PointO
     | n == 1 = p
     | odd n = pointAdd c p (pointMul c (n - 1) p)

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
+    ]

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

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
+    ]

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"