packages feed

cryptonite 0.17 → 0.18

raw patch · 9 files changed

+233/−95 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Crypto.Number.F2m: squareF2m' :: Integer -> Integer

Files

CHANGELOG.md view
@@ -1,3 +1,8 @@+## 0.18++* Re-used standard rdrand instructions instead of bytedump of rdrand instruction+* Improvement to F2m, including lots of tests (Andrew Lelechenko)+ ## 0.17  * Add Miyaguchi-Preneel construction (Kei Hibino)
Crypto/Cipher/Blowfish/Primitive.hs view
@@ -79,7 +79,9 @@ -- Cost must be between 4 and 31 inclusive -- See <https://www.usenix.org/conference/1999-usenix-annual-technical-conference/future-adaptable-password-scheme> eksBlowfish :: (ByteArrayAccess salt, ByteArrayAccess password) => Int -> salt -> password -> Context-eksBlowfish cost salt key = makeKeySchedule key (Just (salt, cost))+eksBlowfish cost salt key+    | B.length salt /= 16 = error "bcrypt salt must be 16 bytes"+    | otherwise           = makeKeySchedule key (Just (salt, cost))  coreCrypto :: Context -> Word64 -> Word64 coreCrypto (BF p s0 s1 s2 s3) input = doRound input 0
Crypto/Number/F2m.hs view
@@ -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 Crypto.Number.Basic+import Data.Bits (xor, shift, testBit, setBit)+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'.-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.--- TODO: This is still slower than @mulF2m@.---- Multiplication table? C?-squareF2m :: BinaryPolynomial  -- ^ Irreducible binary polynomial-          -> Integer -> Integer-squareF2m fx = modF2m fx . square+--+-- This function is undefined for negative arguments, because their bit+-- representation is platform-dependent. Zero modulus is also prohibited.+squareF2m :: BinaryPolynomial -- ^ Modulus+          -> Integer+          -> Integer+squareF2m fx = modF2m fx . squareF2m' {-# INLINE squareF2m #-} -square :: Integer -> Integer-square n1 = go n1 ln1+-- | 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' 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@.+--+-- 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-    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 #-}+    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) --- | Inversion of @n over F₂m using extended Euclidean algorithm.+-- | Modular inversion over F₂m.+-- If @n@ doesn't have an inverse, 'Nothing' is returned. ----- 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+-- 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 #-}
Crypto/PubKey/ECC/Prim.hs view
@@ -26,6 +26,13 @@  --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 _ 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 @@ -- /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)
cbits/cryptonite_rdrand.c view
@@ -46,19 +46,6 @@ 	return (cx & 0x40000000); } -/* sadly many people are still using an old binutils,- * leading to report that instruction is not recognized.- */-#if 0-/* Returns 1 on success */-static inline int crypto_random_rdrand64_step(uint64_t *buffer)-{-	unsigned char err;-	asm volatile ("rdrand %0; setc %1" : "=r" (*buffer), "=qm" (err));-	return (int) err;-}-#endif- /* inline encoding of 'rdrand %rax' to cover old binutils  * - no inputs  * - 'cc' to the clobber list as we modify condition code.@@ -84,13 +71,26 @@ #ifdef __x86_64__ # define RDRAND_SZ 8 # define RDRAND_T  uint64_t-#define inline_rdrand(val, err) inline_rdrand_rax(val, err)+#define inline_rdrand(val, err) err = cryptonite_rdrand_step(&val) #else # define RDRAND_SZ 4 # define RDRAND_T  uint32_t-#define inline_rdrand(val, err) inline_rdrand_eax(val, err)+#define inline_rdrand(val, err) err = cryptonite_rdrand_step(&val) #endif +/* sadly many people are still using an old binutils,+ * leading to report that instruction is not recognized.+ */+#if 1+/* Returns 1 on success */+static inline int cryptonite_rdrand_step(RDRAND_T *buffer)+{+	unsigned char err;+	asm volatile ("rdrand %0; setc %1" : "=r" (*buffer), "=qm" (err));+	return (int) err;+}+#endif+ /* Returns the number of bytes succesfully generated */ int cryptonite_get_rand_bytes(uint8_t *buffer, size_t len) {@@ -113,7 +113,7 @@ 		inline_rdrand(tmp, ok); 		if (!ok) 			return (orig_len - len);-		*((uint64_t *) buffer) = tmp;+		*((RDRAND_T *) buffer) = tmp; 	}  	if (len > 0) {
cryptonite.cabal view
@@ -1,5 +1,5 @@ Name:                cryptonite-Version:             0.17+Version:             0.18 Synopsis:            Cryptography Primitives sink Description:     A repository of cryptographic primitives.@@ -308,8 +308,10 @@                      KAT_Camellia                      KAT_Curve25519                      KAT_DES+                     KAT_Ed448                      KAT_Ed25519                      KAT_CMAC+                     KAT_HKDF                      KAT_HMAC                      KAT_MiyaguchiPreneel                      KAT_PBKDF2@@ -323,6 +325,10 @@                      KAT_RC4                      KAT_Scrypt                      KAT_TripleDES+                     ChaChaPoly1305+                     Number+                     Number.F2m+                     Padding                      Poly1305                      Salsa                      Utils
tests/BCrypt.hs view
@@ -74,4 +74,5 @@  tests = testGroup "bcrypt"     [ testGroup "KATs" makeKATs+    , testCase "Invalid hash length" (assertEqual "" (Left "Invalid hash format") (validatePasswordEither B.empty ("$2a$06$DCq7YPn5Rq63x1Lad4cll.TV4S6ytwfsfvkgY8jIucDrjc8deX1s" :: B.ByteString)))     ]
+ tests/Number/F2m.hs view
@@ -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 view
@@ -4,6 +4,7 @@ import Imports  import qualified Number+import qualified Number.F2m import qualified BCrypt import qualified Hash import qualified Poly1305@@ -33,6 +34,7 @@  tests = testGroup "cryptonite"     [ Number.tests+    , Number.F2m.tests     , Hash.tests     , Padding.tests     , testGroup "ConstructHash"