diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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) diff --git a/Crypto/Cipher/Blowfish/Primitive.hs b/Crypto/Cipher/Blowfish/Primitive.hs --- a/Crypto/Cipher/Blowfish/Primitive.hs +++ b/Crypto/Cipher/Blowfish/Primitive.hs @@ -79,7 +79,9 @@ -- Cost must be between 4 and 31 inclusive -- See 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 diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs --- a/Crypto/Number/F2m.hs +++ b/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 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 #-} diff --git a/Crypto/PubKey/ECC/Prim.hs b/Crypto/PubKey/ECC/Prim.hs --- a/Crypto/PubKey/ECC/Prim.hs +++ b/Crypto/PubKey/ECC/Prim.hs @@ -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) diff --git a/cbits/cryptonite_rdrand.c b/cbits/cryptonite_rdrand.c --- a/cbits/cryptonite_rdrand.c +++ b/cbits/cryptonite_rdrand.c @@ -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) { diff --git a/cryptonite.cabal b/cryptonite.cabal --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -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 diff --git a/tests/BCrypt.hs b/tests/BCrypt.hs --- a/tests/BCrypt.hs +++ b/tests/BCrypt.hs @@ -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))) ] diff --git a/tests/Number/F2m.hs b/tests/Number/F2m.hs new file mode 100644 --- /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 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -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"