diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 5629bc4..a272cd5 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -17,6 +17,7 @@ module Crypto.ECC , Curve_P521R1(..) , Curve_X25519(..) , Curve_X448(..) + , Curve_Edwards25519(..) , EllipticCurve(..) , EllipticCurveDH(..) , EllipticCurveArith(..) @@ -25,6 +26,7 @@ module Crypto.ECC ) where import qualified Crypto.PubKey.ECC.P256 as P256 +import qualified Crypto.ECC.Edwards25519 as Edwards25519 import qualified Crypto.ECC.Simple.Types as Simple import qualified Crypto.ECC.Simple.Prim as Simple import Crypto.Random @@ -101,6 +103,9 @@ class EllipticCurve curve => EllipticCurveArith curve where -- | Add points on a curve pointAdd :: proxy curve -> Point curve -> Point curve -> Point curve + -- | Negate a curve point + pointNegate :: proxy curve -> Point curve -> Point curve + -- | Scalar Multiplication on a curve pointSmul :: proxy curve -> Scalar curve -> Point curve -> Point curve @@ -137,6 +142,7 @@ instance EllipticCurve Curve_P256R1 where instance EllipticCurveArith Curve_P256R1 where pointAdd _ a b = P256.pointAdd a b + pointNegate _ p = P256.pointNegate p pointSmul _ s p = P256.pointMul s p instance EllipticCurveDH Curve_P256R1 where @@ -158,6 +164,7 @@ instance EllipticCurve Curve_P384R1 where instance EllipticCurveArith Curve_P384R1 where pointAdd _ a b = Simple.pointAdd a b + pointNegate _ p = Simple.pointNegate p pointSmul _ s p = Simple.pointMul s p instance EllipticCurveDH Curve_P384R1 where @@ -180,6 +187,7 @@ instance EllipticCurve Curve_P521R1 where instance EllipticCurveArith Curve_P521R1 where pointAdd _ a b = Simple.pointAdd a b + pointNegate _ p = Simple.pointNegate p pointSmul _ s p = Simple.pointMul s p instance EllipticCurveDH Curve_P521R1 where @@ -225,6 +233,24 @@ instance EllipticCurveDH Curve_X448 where where secret = X448.dh p s ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p) +data Curve_Edwards25519 = Curve_Edwards25519 + deriving (Show,Data,Typeable) + +instance EllipticCurve Curve_Edwards25519 where + type Point Curve_Edwards25519 = Edwards25519.Point + type Scalar Curve_Edwards25519 = Edwards25519.Scalar + curveSizeBits _ = 255 + curveGenerateScalar _ = Edwards25519.scalarGenerate + curveGenerateKeyPair _ = toKeyPair <$> Edwards25519.scalarGenerate + where toKeyPair scalar = KeyPair (Edwards25519.toPoint scalar) scalar + encodePoint _ point = Edwards25519.pointEncode point + decodePoint _ bs = Edwards25519.pointDecode bs + +instance EllipticCurveArith Curve_Edwards25519 where + pointAdd _ a b = Edwards25519.pointAdd a b + pointNegate _ p = Edwards25519.pointNegate p + pointSmul _ s p = Edwards25519.pointMul s p + checkNonZeroDH :: SharedSecret -> CryptoFailable SharedSecret checkNonZeroDH s@(SharedSecret b) | B.constAllZero b = CryptoFailed CryptoError_ScalarMultiplicationInvalid diff --git a/Crypto/ECC/Edwards25519.hs b/Crypto/ECC/Edwards25519.hs new file mode 100644 index 0000000..ebba8ca --- /dev/null +++ b/Crypto/ECC/Edwards25519.hs @@ -0,0 +1,373 @@ +-- | +-- Module : Crypto.ECC.Edwards25519 +-- License : BSD-style +-- Maintainer : Olivier Chéron +-- Stability : experimental +-- Portability : unknown +-- +-- Arithmetic primitives over curve edwards25519. +-- +-- Twisted Edwards curves are a familly of elliptic curves allowing +-- complete addition formulas without any special case and no point at +-- infinity. Curve edwards25519 is based on prime 2^255 - 19 for +-- efficient implementation. Equation and parameters are given in +-- . +-- +-- This module provides types and primitive operations that are useful +-- to implement cryptographic schemes based on curve edwards25519: +-- +-- - arithmetic functions for point addition, doubling, negation, +-- scalar multiplication with an arbitrary point, with the base point, +-- etc. +-- +-- - arithmetic functions dealing with scalars modulo the prime order +-- L of the base point +-- +-- All functions run in constant time unless noted otherwise. +-- +-- Warnings: +-- +-- 1. Curve edwards25519 has a cofactor h = 8 so the base point does +-- not generate the entire curve and points with order 2, 4, 8 exist. +-- When implementing cryptographic algorithms, special care must be +-- taken using one of the following methods: +-- +-- - points must be checked for membership in the prime-order +-- subgroup +-- +-- - or cofactor must be cleared by multiplying points by 8 +-- +-- Utility functions are provided to implement this. Testing +-- subgroup membership with 'pointHasPrimeOrder' is 50-time slower +-- than call 'pointMulByCofactor'. +-- +-- 2. Scalar arithmetic is always reduced modulo L, allowing fixed +-- length and constant execution time, but this reduction is valid +-- only when points are in the prime-order subgroup. +-- +-- 3. Because of modular reduction in this implementation it is not +-- possible to multiply points directly by scalars like 8.s or L. +-- This has to be decomposed into several steps. +-- +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Crypto.ECC.Edwards25519 + ( Scalar + , Point + -- * Scalars + , scalarGenerate + , scalarDecodeLong + , scalarEncode + -- * Points + , pointDecode + , pointEncode + , pointHasPrimeOrder + -- * Arithmetic functions + , toPoint + , scalarAdd + , scalarMul + , pointNegate + , pointAdd + , pointDouble + , pointMul + , pointMulByCofactor + , pointsMulVarTime + ) where + +import Data.Bits +import Data.Word +import Foreign.C.Types +import Foreign.Ptr +import Foreign.Storable + +import Crypto.Error +import Crypto.Internal.ByteArray (ByteArrayAccess, Bytes, + ScrubbedBytes, withByteArray) +import qualified Crypto.Internal.ByteArray as B +import Crypto.Internal.Compat +import Crypto.Internal.Imports +import Crypto.Random + + +scalarArraySize :: Int +scalarArraySize = 40 -- maximum [9 * 4 {- 32 bits -}, 5 * 8 {- 64 bits -}] + +-- | A scalar modulo prime order of curve edwards25519. +newtype Scalar = Scalar ScrubbedBytes + deriving (Show,NFData) + +instance Eq Scalar where + (Scalar s1) == (Scalar s2) = unsafeDoIO $ + withByteArray s1 $ \ps1 -> + withByteArray s2 $ \ps2 -> + fmap (/= 0) (ed25519_scalar_eq ps1 ps2) + {-# NOINLINE (==) #-} + +pointArraySize :: Int +pointArraySize = 160 -- maximum [4 * 10 * 4 {- 32 bits -}, 4 * 5 * 8 {- 64 bits -}] + +-- | A point on curve edwards25519. +newtype Point = Point Bytes + deriving NFData + +instance Show Point where + showsPrec d p = + let bs = pointEncode p :: Bytes + in showParen (d > 10) $ showString "Point " + . shows (B.convertToBase B.Base16 bs :: Bytes) + +instance Eq Point where + (Point p1) == (Point p2) = unsafeDoIO $ + withByteArray p1 $ \pp1 -> + withByteArray p2 $ \pp2 -> + fmap (/= 0) (ed25519_point_eq pp1 pp2) + {-# NOINLINE (==) #-} + +-- | Generate a random scalar. +scalarGenerate :: MonadRandom randomly => randomly Scalar +scalarGenerate = throwCryptoError . scalarDecodeLong <$> generate + where + -- Scalar generation is based on a fixed number of bytes so that + -- there is no timing leak. But because of modular reduction + -- distribution is not uniform. We use many more bytes than + -- necessary so the probability bias is small. With 512 bits we + -- get 22% of scalars with a higher frequency, but the relative + -- probability difference is only 2^(-260). + generate :: MonadRandom randomly => randomly ScrubbedBytes + generate = getRandomBytes 64 + +-- | Serialize a scalar to binary, i.e. a 32-byte little-endian +-- number. +scalarEncode :: B.ByteArray bs => Scalar -> bs +scalarEncode (Scalar s) = + B.allocAndFreeze 32 $ \out -> + withByteArray s $ \ps -> ed25519_scalar_encode out ps + +-- | Deserialize a little-endian number as a scalar. Input array can +-- have any length from 0 to 64 bytes. +-- +-- Note: it is not advised to put secret information in the 3 lowest +-- bits of a scalar if this scalar may be multiplied to untrusted +-- points outside the prime-order subgroup. +scalarDecodeLong :: B.ByteArrayAccess bs => bs -> CryptoFailable Scalar +scalarDecodeLong bs + | B.length bs > 64 = CryptoFailed CryptoError_EcScalarOutOfBounds + | otherwise = unsafeDoIO $ withByteArray bs initialize + where + len = fromIntegral $ B.length bs + initialize inp = do + s <- B.alloc scalarArraySize $ \ps -> + ed25519_scalar_decode_long ps inp len + return $ CryptoPassed (Scalar s) +{-# NOINLINE scalarDecodeLong #-} + +-- | Add two scalars. +scalarAdd :: Scalar -> Scalar -> Scalar +scalarAdd (Scalar a) (Scalar b) = + Scalar $ B.allocAndFreeze scalarArraySize $ \out -> + withByteArray a $ \pa -> + withByteArray b $ \pb -> + ed25519_scalar_add out pa pb + +-- | Multiply two scalars. +scalarMul :: Scalar -> Scalar -> Scalar +scalarMul (Scalar a) (Scalar b) = + Scalar $ B.allocAndFreeze scalarArraySize $ \out -> + withByteArray a $ \pa -> + withByteArray b $ \pb -> + ed25519_scalar_mul out pa pb + +-- | Multiplies a scalar with the curve base point. +toPoint :: Scalar -> Point +toPoint (Scalar scalar) = + Point $ B.allocAndFreeze pointArraySize $ \out -> + withByteArray scalar $ \pscalar -> + ed25519_point_base_scalarmul out pscalar + +-- | Serialize a point to a 32-byte array. +-- +-- Format is binary compatible with 'Crypto.PubKey.Ed25519.PublicKey' +-- from module "Crypto.PubKey.Ed25519". +pointEncode :: B.ByteArray bs => Point -> bs +pointEncode (Point p) = + B.allocAndFreeze 32 $ \out -> + withByteArray p $ \pp -> + ed25519_point_encode out pp + +-- | Deserialize a 32-byte array as a point, ensuring the point is +-- valid on edwards25519. +-- +-- /WARNING:/ variable time +pointDecode :: B.ByteArrayAccess bs => bs -> CryptoFailable Point +pointDecode bs + | B.length bs == 32 = unsafeDoIO $ withByteArray bs initialize + | otherwise = CryptoFailed CryptoError_PointSizeInvalid + where + initialize inp = do + (res, p) <- B.allocRet pointArraySize $ \pp -> + ed25519_point_decode_vartime pp inp + if res == 0 then return $ CryptoFailed CryptoError_PointCoordinatesInvalid + else return $ CryptoPassed (Point p) +{-# NOINLINE pointDecode #-} + +-- | Test whether a point belongs to the prime-order subgroup +-- generated by the base point. Result is 'True' for the identity +-- point. +-- +-- @ +-- pointHasPrimeOrder p = 'pointNegate' p == 'pointMul' l_minus_one p +-- @ +pointHasPrimeOrder :: Point -> Bool +pointHasPrimeOrder (Point p) = unsafeDoIO $ + withByteArray p $ \pp -> + fmap (/= 0) (ed25519_point_has_prime_order pp) +{-# NOINLINE pointHasPrimeOrder #-} + +-- | Negate a point. +pointNegate :: Point -> Point +pointNegate (Point a) = + Point $ B.allocAndFreeze pointArraySize $ \out -> + withByteArray a $ \pa -> + ed25519_point_negate out pa + +-- | Add two points. +pointAdd :: Point -> Point -> Point +pointAdd (Point a) (Point b) = + Point $ B.allocAndFreeze pointArraySize $ \out -> + withByteArray a $ \pa -> + withByteArray b $ \pb -> + ed25519_point_add out pa pb + +-- | Add a point to itself. +-- +-- @ +-- pointDouble p = 'pointAdd' p p +-- @ +pointDouble :: Point -> Point +pointDouble (Point a) = + Point $ B.allocAndFreeze pointArraySize $ \out -> + withByteArray a $ \pa -> + ed25519_point_double out pa + +-- | Multiply a point by h = 8. +-- +-- @ +-- pointMulByCofactor p = 'pointMul' scalar_8 p +-- @ +pointMulByCofactor :: Point -> Point +pointMulByCofactor (Point a) = + Point $ B.allocAndFreeze pointArraySize $ \out -> + withByteArray a $ \pa -> + ed25519_point_mul_by_cofactor out pa + +-- | Scalar multiplication over curve edwards25519. +-- +-- Note: when the scalar had reduction modulo L and the input point +-- has a torsion component, the output point may not be in the +-- expected subgroup. +pointMul :: Scalar -> Point -> Point +pointMul (Scalar scalar) (Point base) = + Point $ B.allocAndFreeze pointArraySize $ \out -> + withByteArray scalar $ \pscalar -> + withByteArray base $ \pbase -> + ed25519_point_scalarmul out pbase pscalar + +-- | Multiply the point @p@ with @s2@ and add a lifted to curve value @s1@. +-- +-- @ +-- pointsMulVarTime s1 s2 p = 'pointAdd' ('toPoint' s1) ('pointMul' s2 p) +-- @ +-- +-- /WARNING:/ variable time +pointsMulVarTime :: Scalar -> Scalar -> Point -> Point +pointsMulVarTime (Scalar s1) (Scalar s2) (Point p) = + Point $ B.allocAndFreeze pointArraySize $ \out -> + withByteArray s1 $ \ps1 -> + withByteArray s2 $ \ps2 -> + withByteArray p $ \pp -> + ed25519_base_double_scalarmul_vartime out ps1 pp ps2 + +foreign import ccall "cryptonite_ed25519_scalar_eq" + ed25519_scalar_eq :: Ptr Scalar + -> Ptr Scalar + -> IO CInt + +foreign import ccall "cryptonite_ed25519_scalar_encode" + ed25519_scalar_encode :: Ptr Word8 + -> Ptr Scalar + -> IO () + +foreign import ccall "cryptonite_ed25519_scalar_decode_long" + ed25519_scalar_decode_long :: Ptr Scalar + -> Ptr Word8 + -> CSize + -> IO () + +foreign import ccall "cryptonite_ed25519_scalar_add" + ed25519_scalar_add :: Ptr Scalar -- sum + -> Ptr Scalar -- a + -> Ptr Scalar -- b + -> IO () + +foreign import ccall "cryptonite_ed25519_scalar_mul" + ed25519_scalar_mul :: Ptr Scalar -- out + -> Ptr Scalar -- a + -> Ptr Scalar -- b + -> IO () + +foreign import ccall "cryptonite_ed25519_point_encode" + ed25519_point_encode :: Ptr Word8 + -> Ptr Point + -> IO () + +foreign import ccall "cryptonite_ed25519_point_decode_vartime" + ed25519_point_decode_vartime :: Ptr Point + -> Ptr Word8 + -> IO CInt + +foreign import ccall "cryptonite_ed25519_point_eq" + ed25519_point_eq :: Ptr Point + -> Ptr Point + -> IO CInt + +foreign import ccall "cryptonite_ed25519_point_has_prime_order" + ed25519_point_has_prime_order :: Ptr Point + -> IO CInt + +foreign import ccall "cryptonite_ed25519_point_negate" + ed25519_point_negate :: Ptr Point -- minus_a + -> Ptr Point -- a + -> IO () + +foreign import ccall "cryptonite_ed25519_point_add" + ed25519_point_add :: Ptr Point -- sum + -> Ptr Point -- a + -> Ptr Point -- b + -> IO () + +foreign import ccall "cryptonite_ed25519_point_double" + ed25519_point_double :: Ptr Point -- two_a + -> Ptr Point -- a + -> IO () + +foreign import ccall "cryptonite_ed25519_point_mul_by_cofactor" + ed25519_point_mul_by_cofactor :: Ptr Point -- eight_a + -> Ptr Point -- a + -> IO () + +foreign import ccall "cryptonite_ed25519_point_base_scalarmul" + ed25519_point_base_scalarmul :: Ptr Point -- scaled + -> Ptr Scalar -- scalar + -> IO () + +foreign import ccall "cryptonite_ed25519_point_scalarmul" + ed25519_point_scalarmul :: Ptr Point -- scaled + -> Ptr Point -- base + -> Ptr Scalar -- scalar + -> IO () + +foreign import ccall "cryptonite_ed25519_base_double_scalarmul_vartime" + ed25519_base_double_scalarmul_vartime :: Ptr Point -- combo + -> Ptr Scalar -- scalar1 + -> Ptr Point -- base2 + -> Ptr Scalar -- scalar2 + -> IO () diff --git a/Crypto/ECC/Simple/Prim.hs b/Crypto/ECC/Simple/Prim.hs index 4a36b05..7eebb4e 100644 --- a/Crypto/ECC/Simple/Prim.hs +++ b/Crypto/ECC/Simple/Prim.hs @@ -6,6 +6,7 @@ module Crypto.ECC.Simple.Prim ( scalarGenerate , scalarFromInteger , pointAdd + , pointNegate , pointDouble , pointBaseMul , pointMul @@ -49,7 +50,7 @@ pointNegate :: Curve curve => Point curve -> Point curve pointNegate PointO = PointO pointNegate point@(Point x y) = case curveType point of - CurvePrime {} -> Point x (-y) + CurvePrime (CurvePrimeParam p) -> Point x (p - y) CurveBinary {} -> Point x (x `addF2m` y) -- | Elliptic Curve point addition. diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index e227c51..9259f8e 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -17,6 +17,7 @@ module Crypto.PubKey.ECC.P256 -- * Point arithmetic , pointBase , pointAdd + , pointNegate , pointMul , pointDh , pointsMulVarTime @@ -106,6 +107,12 @@ pointAdd a b = withNewPoint $ \dx dy -> withPoint a $ \ax ay -> withPoint b $ \bx by -> ccryptonite_p256e_point_add ax ay bx by dx dy +-- | Negate a point +pointNegate :: Point -> Point +pointNegate a = withNewPoint $ \dx dy -> + withPoint a $ \ax ay -> do + ccryptonite_p256e_point_negate ax ay dx dy + -- | Multiply a point by a scalar -- -- warning: variable time @@ -372,6 +379,11 @@ foreign import ccall "cryptonite_p256e_point_add" -> Ptr P256X -> Ptr P256Y -> IO () +foreign import ccall "cryptonite_p256e_point_negate" + ccryptonite_p256e_point_negate :: Ptr P256X -> Ptr P256Y + -> Ptr P256X -> Ptr P256Y + -> IO () + -- compute (out_x,out,y) = n1 * G + n2 * (in_x,in_y) foreign import ccall "cryptonite_p256_points_mul_vartime" ccryptonite_p256_points_mul_vartime :: Ptr P256Scalar -- n1 diff --git a/Crypto/PubKey/ECC/Prim.hs b/Crypto/PubKey/ECC/Prim.hs index 2428fc8..d87672b 100644 --- a/Crypto/PubKey/ECC/Prim.hs +++ b/Crypto/PubKey/ECC/Prim.hs @@ -4,6 +4,7 @@ module Crypto.PubKey.ECC.Prim ( scalarGenerate , pointAdd + , pointNegate , pointDouble , pointBaseMul , pointMul @@ -30,9 +31,9 @@ scalarGenerate curve = generateBetween 1 (n - 1) -- | 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) +pointNegate _ PointO = PointO +pointNegate (CurveFP c) (Point x y) = Point x (ecc_p c - y) +pointNegate CurveF2m{} (Point x y) = Point x (x `addF2m` y) -- | Elliptic Curve point addition. -- diff --git a/cbits/ed25519/ed25519-cryptonite-exts.h b/cbits/ed25519/ed25519-cryptonite-exts.h new file mode 100644 index 0000000..8a74618 --- /dev/null +++ b/cbits/ed25519/ed25519-cryptonite-exts.h @@ -0,0 +1,246 @@ +/* + Public domain by Olivier Chéron + + Arithmetic extensions to Ed25519-donna +*/ + + +/* + Scalar functions +*/ + +void +ED25519_FN(ed25519_scalar_encode) (unsigned char out[32], const bignum256modm in) { + contract256_modm(out, in); +} + +void +ED25519_FN(ed25519_scalar_decode_long) (bignum256modm out, const unsigned char *in, size_t len) { + expand256_modm(out, in, len); +} + +int +ED25519_FN(ed25519_scalar_eq) (const bignum256modm a, const bignum256modm b) { + bignum256modm_element_t e = 0; + + for (int i = 0; i < bignum256modm_limb_size; i++) { + e |= a[i] ^ b[i]; + } + + return (int) (1 & ((e - 1) >> bignum256modm_bits_per_limb)); +} + +void +ED25519_FN(ed25519_scalar_add) (bignum256modm r, const bignum256modm x, const bignum256modm y) { + add256_modm(r, x, y); +} + +void +ED25519_FN(ed25519_scalar_mul) (bignum256modm r, const bignum256modm x, const bignum256modm y) { + mul256_modm(r, x, y); +} + + +/* + Point functions +*/ + +void +ED25519_FN(ed25519_point_encode) (unsigned char r[32], const ge25519 *p) { + ge25519_pack(r, p); +} + +int +ED25519_FN(ed25519_point_decode_vartime) (ge25519 *r, const unsigned char p[32]) { + unsigned char p_neg[32]; + + // invert parity bit of X coordinate so the point is negated twice + // (once here, once in ge25519_unpack_negative_vartime) + for (int i = 0; i < 31; i++) { + p_neg[i] = p[i]; + } + p_neg[31] = p[31] ^ 0x80; + + return ge25519_unpack_negative_vartime(r, p_neg); +} + +int +ED25519_FN(ed25519_point_eq) (const ge25519 *p, const ge25519 *q) { + bignum25519 a, b; + unsigned char contract_a[32], contract_b[32]; + int eq; + + // pX * qZ = qX * pZ + curve25519_mul(a, p->x, q->z); + curve25519_contract(contract_a, a); + curve25519_mul(b, q->x, p->z); + curve25519_contract(contract_b, b); + eq = ed25519_verify(contract_a, contract_b, 32); + + // pY * qZ = qY * pZ + curve25519_mul(a, p->y, q->z); + curve25519_contract(contract_a, a); + curve25519_mul(b, q->y, p->z); + curve25519_contract(contract_b, b); + eq &= ed25519_verify(contract_a, contract_b, 32); + + return eq; +} + +static int +ED25519_FN(ed25519_point_is_identity) (const ge25519 *p) { + static const unsigned char zero[32] = {0}; + unsigned char check[32]; + bignum25519 d; + int eq; + + // pX = 0 + curve25519_contract(check, p->x); + eq = ed25519_verify(check, zero, 32); + + // pY - pZ = 0 + curve25519_sub_reduce(d, p->y, p->z); + curve25519_contract(check, d); + eq &= ed25519_verify(check, zero, 32); + + return eq; +} + +void +ED25519_FN(ed25519_point_negate) (ge25519 *r, const ge25519 *p) { + curve25519_neg(r->x, p->x); + curve25519_copy(r->y, p->y); + curve25519_copy(r->z, p->z); + curve25519_neg(r->t, p->t); +} + +void +ED25519_FN(ed25519_point_add) (ge25519 *r, const ge25519 *p, const ge25519 *q) { + ge25519_add(r, p, q); +} + +void +ED25519_FN(ed25519_point_double) (ge25519 *r, const ge25519 *p) { + ge25519_double(r, p); +} + +void +ED25519_FN(ed25519_point_mul_by_cofactor) (ge25519 *r, const ge25519 *p) { + ge25519_double_partial(r, p); + ge25519_double_partial(r, r); + ge25519_double(r, r); +} + +void +ED25519_FN(ed25519_point_base_scalarmul) (ge25519 *r, const bignum256modm s) { + ge25519_scalarmult_base_niels(r, ge25519_niels_base_multiples, s); +} + +#if defined(ED25519_64BIT) +typedef uint64_t ed25519_move_cond_word; +#else +typedef uint32_t ed25519_move_cond_word; +#endif + +/* out = (flag) ? in : out */ +DONNA_INLINE static void +ed25519_move_cond_pniels(ge25519_pniels *out, const ge25519_pniels *in, uint32_t flag) { + const int word_count = sizeof(ge25519_pniels) / sizeof(ed25519_move_cond_word); + const ed25519_move_cond_word nb = (ed25519_move_cond_word) flag - 1, b = ~nb; + + ed25519_move_cond_word *outw = (ed25519_move_cond_word *) out; + const ed25519_move_cond_word *inw = (const ed25519_move_cond_word *) in; + + // ge25519_pniels has 4 coordinates, so word_count is divisible by 4 + for (int i = 0; i < word_count; i += 4) { + outw[i + 0] = (outw[i + 0] & nb) | (inw[i + 0] & b); + outw[i + 1] = (outw[i + 1] & nb) | (inw[i + 1] & b); + outw[i + 2] = (outw[i + 2] & nb) | (inw[i + 2] & b); + outw[i + 3] = (outw[i + 3] & nb) | (inw[i + 3] & b); + } +} + +static void +ed25519_point_scalarmul_w_choose_pniels(ge25519_pniels *t, const ge25519_pniels table[15], uint32_t pos) { + // initialize t to identity, i.e. (1, 1, 1, 0) + memset(t, 0, sizeof(ge25519_pniels)); + t->ysubx[0] = 1; + t->xaddy[0] = 1; + t->z[0] = 1; + + // move one entry from table matching requested position, + // scanning all table to avoid cache-timing attack + // + // when pos == 0, no entry matches and this returns + // identity as expected + for (uint32_t i = 1; i < 16; i++) { + uint32_t flag = ((i ^ pos) - 1) >> 31; + ed25519_move_cond_pniels(t, table + i - 1, flag); + } +} + +void +ED25519_FN(ed25519_point_scalarmul) (ge25519 *r, const ge25519 *p, const bignum256modm s) { + ge25519_pniels mult[15]; + ge25519_pniels pn; + ge25519_p1p1 t; + unsigned char ss[32]; + + // transform scalar as little-endian number + contract256_modm(ss, s); + + // initialize r to identity, i.e. ge25519 (0, 1, 1, 0) + memset(r, 0, sizeof(ge25519)); + r->y[0] = 1; + r->z[0] = 1; + + // precompute multiples of P: 1.P, 2.P, ..., 15.P + ge25519_full_to_pniels(&mult[0], p); + for (int i = 1; i < 15; i++) { + ge25519_pnielsadd(&mult[i], p, &mult[i-1]); + } + + // 4-bit fixed window, still 256 doublings but 64 additions + for (int i = 31; i >= 0; i--) { + // higher bits in ss[i] + ed25519_point_scalarmul_w_choose_pniels(&pn, mult, ss[i] >> 4); + ge25519_pnielsadd_p1p1(&t, r, &pn, 0); + ge25519_p1p1_to_partial(r, &t); + + ge25519_double_partial(r, r); + ge25519_double_partial(r, r); + ge25519_double_partial(r, r); + ge25519_double(r, r); + + // lower bits in ss[i] + ed25519_point_scalarmul_w_choose_pniels(&pn, mult, ss[i] & 0x0F); + ge25519_pnielsadd_p1p1(&t, r, &pn, 0); + if (i > 0) { + ge25519_p1p1_to_partial(r, &t); + + ge25519_double_partial(r, r); + ge25519_double_partial(r, r); + ge25519_double_partial(r, r); + ge25519_double(r, r); + } else { + ge25519_p1p1_to_full(r, &t); + } + } +} + +void +ED25519_FN(ed25519_base_double_scalarmul_vartime) (ge25519 *r, const bignum256modm s1, const ge25519 *p2, const bignum256modm s2) { + // computes [s1]basepoint + [s2]p2 + ge25519_double_scalarmult_vartime(r, p2, s2, s1); +} + +int +ED25519_FN(ed25519_point_has_prime_order) (const ge25519 *p) { + static const bignum256modm sc_zero = {0}; + ge25519 q; + + // computes Q = m.P, vartime allowed because m is not secret + ED25519_FN(ed25519_base_double_scalarmul_vartime) (&q, sc_zero, p, modm_m); + + return ED25519_FN(ed25519_point_is_identity) (&q); +} diff --git a/cbits/ed25519/ed25519-donna-impl-base.h b/cbits/ed25519/ed25519-donna-impl-base.h index 48913ed..e8356cd 100644 --- a/cbits/ed25519/ed25519-donna-impl-base.h +++ b/cbits/ed25519/ed25519-donna-impl-base.h @@ -287,7 +287,13 @@ ge25519_double_scalarmult_vartime(ge25519 *r, const ge25519 *p1, const bignum256 ge25519_nielsadd2_p1p1(&t, r, &ge25519_niels_sliding_multiples[abs(slide2[i]) / 2], (unsigned char)slide2[i] >> 7); } - ge25519_p1p1_to_partial(r, &t); + // diverges from the original source code and resolves bug explained + // in + if (i == 0) { + ge25519_p1p1_to_full(r, &t); + } else { + ge25519_p1p1_to_partial(r, &t); + } } } diff --git a/cbits/ed25519/ed25519.c b/cbits/ed25519/ed25519.c index e70ed7c..2eaab47 100644 --- a/cbits/ed25519/ed25519.c +++ b/cbits/ed25519/ed25519.c @@ -11,6 +11,7 @@ #include "ed25519.h" #include "ed25519-randombytes.h" #include "ed25519-hash.h" +#include "ed25519-cryptonite-exts.h" /* Generates a (extsk[0..31]) and aExt (extsk[32..63]) diff --git a/cbits/p256/p256_ec.c b/cbits/p256/p256_ec.c index e9c41e1..bee8ff0 100644 --- a/cbits/p256/p256_ec.c +++ b/cbits/p256/p256_ec.c @@ -1303,3 +1303,14 @@ void cryptonite_p256e_point_add( from_montgomery(out_x, px1); from_montgomery(out_y, py1); } + +/* this function is not part of the original source + negate a point, i.e. (out_x, out_y) = (in_x, -in_y) + */ +void cryptonite_p256e_point_negate( + const cryptonite_p256_int *in_x, const cryptonite_p256_int *in_y, + cryptonite_p256_int *out_x, cryptonite_p256_int *out_y) +{ + memcpy(out_x, in_x, P256_NBYTES); + cryptonite_p256_sub(&cryptonite_SECP256r1_p, in_y, out_y); +} diff --git a/cryptonite.cabal b/cryptonite.cabal index 897599b..b7c2a51 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -121,6 +121,7 @@ Library Crypto.Data.AFIS Crypto.Data.Padding Crypto.ECC + Crypto.ECC.Edwards25519 Crypto.Error Crypto.MAC.CMAC Crypto.MAC.Poly1305 @@ -241,7 +242,6 @@ Library , cbits/cryptonite_xsalsa.c , cbits/cryptonite_rc4.c , cbits/cryptonite_cpu.c - , cbits/ed25519/ed25519.c , cbits/p256/p256.c , cbits/p256/p256_ec.c , cbits/cryptonite_blake2s.c @@ -263,6 +263,7 @@ Library , cbits/cryptonite_whirlpool.c , cbits/cryptonite_scrypt.c , cbits/cryptonite_pbkdf2.c + , cbits/ed25519/ed25519.c include-dirs: cbits , cbits/ed25519 , cbits/decaf/include @@ -370,6 +371,7 @@ Test-Suite test-cryptonite ChaCha BCrypt ECC + ECC.Edwards25519 Hash Imports KAT_AES.KATCBC diff --git a/tests/ECC/Edwards25519.hs b/tests/ECC/Edwards25519.hs new file mode 100644 index 0000000..602ae72 --- /dev/null +++ b/tests/ECC/Edwards25519.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE OverloadedStrings #-} +module ECC.Edwards25519 ( tests ) where + +import Crypto.Error +import Crypto.ECC.Edwards25519 +import qualified Data.ByteString as B +import Data.Word (Word8) +import Imports + +instance Arbitrary Scalar where + arbitrary = fmap (throwCryptoError . scalarDecodeLong) + (arbitraryBS 64) + +smallScalar :: Word8 -> Scalar +smallScalar = throwCryptoError . scalarDecodeLong . B.singleton + +newtype PrimeOrder = PrimeOrder Point + deriving Show + +-- points in the prime-order subgroup +instance Arbitrary PrimeOrder where + arbitrary = (PrimeOrder . toPoint) `fmap` arbitrary + +-- arbitrary curve point, including points with a torsion component +instance Arbitrary Point where + arbitrary = do a <- arbitrary + b <- elements $ map smallScalar [0 .. 7] + return (pointsMulVarTime a b torsion8) + +-- an 8-torsion point +torsion8 :: Point +torsion8 = throwCryptoError $ pointDecode ("\199\ETBjp=M\216O\186<\vv\r\DLEg\SI* S\250,9\204\198N\199\253w\146\172\ETXz" :: ByteString) + +tests = testGroup "ECC.Edwards25519" + [ testGroup "vectors" + [ testCase "11*G" $ p011 @=? toPoint s011 + , testCase "123*G" $ p123 @=? toPoint s123 + , testCase "134*G" $ p134 @=? toPoint s134 + , testCase "123*G + 11*G" $ p134 @=? pointAdd p123 p011 + ] + , testGroup "scalar arithmetic" + [ testProperty "scalarDecodeLong.scalarEncode==id" $ \s -> + let bs = scalarEncode s :: ByteString + ss = scalarDecodeLong bs + in CryptoPassed s `propertyEq` ss + , testCase "curve order" $ s0 @=? sN + , testProperty "addition with zero" $ \s -> + propertyHold [ eqTest "zero left" s (scalarAdd s0 s) + , eqTest "zero right" s (scalarAdd s s0) + ] + , testProperty "addition associative" $ \sa sb sc -> + scalarAdd sa (scalarAdd sb sc) === scalarAdd (scalarAdd sa sb) sc + , testProperty "addition commutative" $ \sa sb -> + scalarAdd sa sb === scalarAdd sb sa + , testProperty "multiplication with zero" $ \s -> + propertyHold [ eqTest "zero left" s0 (scalarMul s0 s) + , eqTest "zero right" s0 (scalarMul s s0) + ] + , testProperty "multiplication with one" $ \s -> + propertyHold [ eqTest "one left" s (scalarMul s1 s) + , eqTest "one right" s (scalarMul s s1) + ] + , testProperty "multiplication associative" $ \sa sb sc -> + scalarMul sa (scalarMul sb sc) === scalarMul (scalarMul sa sb) sc + , testProperty "multiplication commutative" $ \sa sb -> + scalarMul sa sb === scalarMul sb sa + , testProperty "multiplication distributive" $ \sa sb sc -> + propertyHold [ eqTest "distributive left" ((sa `scalarMul` sb) `scalarAdd` (sa `scalarMul` sc)) + (sa `scalarMul` (sb `scalarAdd` sc)) + , eqTest "distributive right" ((sb `scalarMul` sa) `scalarAdd` (sc `scalarMul` sa)) + ((sb `scalarAdd` sc) `scalarMul` sa) + ] + ] + , testGroup "point arithmetic" + [ testProperty "pointDecode.pointEncode==id" $ \p -> + let bs = pointEncode p :: ByteString + p' = pointDecode bs + in CryptoPassed p `propertyEq` p' + , testProperty "pointEncode.pointDecode==id" $ \p -> + let b = pointEncode p :: ByteString + p' = pointDecode b + b' = pointEncode `fmap` p' + in CryptoPassed b `propertyEq` b' + , testProperty "addition with identity" $ \p -> + propertyHold [ eqTest "identity left" p (pointAdd p0 p) + , eqTest "identity right" p (pointAdd p p0) + ] + , testProperty "addition associative" $ \pa pb pc -> + pointAdd pa (pointAdd pb pc) === pointAdd (pointAdd pa pb) pc + , testProperty "addition commutative" $ \pa pb -> + pointAdd pa pb === pointAdd pb pa + , testProperty "negation" $ \p -> + p0 `propertyEq` pointAdd p (pointNegate p) + , testProperty "doubling" $ \p -> + pointAdd p p `propertyEq` pointDouble p + , testProperty "multiplication by cofactor" $ \p -> + pointMul s8 p `propertyEq` pointMulByCofactor p + , testProperty "prime order" $ \(PrimeOrder p) -> + True `propertyEq` pointHasPrimeOrder p + , testCase "8-torsion point" $ do + assertBool "mul by 4" $ p0 /= pointMul s4 torsion8 + assertBool "mul by 8" $ p0 == pointMul s8 torsion8 + , testProperty "scalarmult with zero" $ \p -> + p0 `propertyEq` pointMul s0 p + , testProperty "scalarmult with one" $ \p -> + p `propertyEq` pointMul s1 p + , testProperty "scalarmult with two" $ \p -> + pointDouble p `propertyEq` pointMul s2 p + , testProperty "scalarmult with curve order - 1" $ \p -> + pointHasPrimeOrder p === (pointNegate p == pointMul sI p) + , testProperty "scalarmult commutative" $ \a b -> + pointMul a (toPoint b) === pointMul b (toPoint a) + , testProperty "scalarmult distributive" $ \x y (PrimeOrder p) -> + let pR = pointMul x p `pointAdd` pointMul y p + in pR `propertyEq` pointMul (x `scalarAdd` y) p + , testProperty "double scalarmult" $ \n1 n2 p -> + let pR = pointAdd (toPoint n1) (pointMul n2 p) + in pR `propertyEq` pointsMulVarTime n1 n2 p + ] + ] + where + p0 = toPoint s0 + s0 = smallScalar 0 + s1 = smallScalar 1 + s2 = smallScalar 2 + s4 = smallScalar 4 + s8 = smallScalar 8 + sI = throwCryptoError $ scalarDecodeLong ("\236\211\245\\\SUBc\DC2X\214\156\247\162\222\249\222\DC4\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\DLE" :: ByteString) + sN = throwCryptoError $ scalarDecodeLong ("\237\211\245\\\SUBc\DC2X\214\156\247\162\222\249\222\DC4\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\DLE" :: ByteString) + + s011 = throwCryptoError $ scalarDecodeLong ("\011" :: ByteString) + s123 = throwCryptoError $ scalarDecodeLong ("\123" :: ByteString) + s134 = throwCryptoError $ scalarDecodeLong ("\134" :: ByteString) + + p011 = throwCryptoError $ pointDecode ("\x13\x37\x03\x6a\xc3\x2d\x8f\x30\xd4\x58\x9c\x3c\x1c\x59\x58\x12\xce\x0f\xff\x40\xe3\x7c\x6f\x5a\x97\xab\x21\x3f\x31\x82\x90\xad" :: ByteString) + p123 = throwCryptoError $ pointDecode ("\xc4\xb8\x00\xc8\x70\x10\xf9\x46\x83\x03\xde\xea\x87\x65\x03\xe8\x86\xbf\xde\x19\x00\xe9\xe8\x46\xfd\x4c\x3c\xd0\x9c\x1c\xbc\x9f" :: ByteString) + p134 = throwCryptoError $ pointDecode ("\x51\x20\xab\xe0\x3c\xa2\xaf\x66\xc7\x7c\xa3\x20\xf0\xb2\x1f\xb5\x56\xf6\xb6\x5f\xdd\x7e\x32\x64\xc1\x4a\x30\xd9\x7b\xf7\xa7\x6f" :: ByteString) + + -- Using : + -- + -- >>> import ed25519 + -- >>> encodepoint(scalarmult(B, 11)).encode('hex') + -- '1337036ac32d8f30d4589c3c1c595812ce0fff40e37c6f5a97ab213f318290ad' + -- >>> encodepoint(scalarmult(B, 123)).encode('hex') + -- 'c4b800c87010f9468303deea876503e886bfde1900e9e846fd4c3cd09c1cbc9f' + -- >>> encodepoint(scalarmult(B, 134)).encode('hex') + -- '5120abe03ca2af66c77ca320f0b21fb556f6b65fdd7e3264c14a30d97bf7a76f' diff --git a/tests/KAT_PubKey/ECC.hs b/tests/KAT_PubKey/ECC.hs index 9c6a923..7a97428 100644 --- a/tests/KAT_PubKey/ECC.hs +++ b/tests/KAT_PubKey/ECC.hs @@ -147,7 +147,7 @@ arbitraryPoint aCurve = eccTests = testGroup "ECC" [ testGroup "valid-point" $ map doPointValidTest (zip [katZero..] vectorsPoint) - , testGroup "property" + , localOption (QuickCheckTests 20) $ testGroup "property" [ testProperty "point-add" $ \aCurve (QAInteger r1) (QAInteger r2) -> let curveN = ECC.ecc_n . ECC.common_curve $ aCurve curveGen = ECC.ecc_g . ECC.common_curve $ aCurve @@ -155,14 +155,19 @@ eccTests = testGroup "ECC" p2 = ECC.pointMul aCurve r2 curveGen pR = ECC.pointMul aCurve ((r1 + r2) `mod` curveN) curveGen in pR `propertyEq` ECC.pointAdd aCurve p1 p2 - , localOption (QuickCheckTests 20) $ - testProperty "point-mul-mul" $ \aCurve (QAInteger n1) (QAInteger n2) -> do + , testProperty "point-negate-add" $ \aCurve -> do + p <- arbitraryPoint aCurve + let o = ECC.pointAdd aCurve p (ECC.pointNegate aCurve p) + return $ ECC.PointO `propertyEq` o + , testProperty "point-negate-negate" $ \aCurve -> do + p <- arbitraryPoint aCurve + return $ p `propertyEq` ECC.pointNegate aCurve (ECC.pointNegate aCurve p) + , testProperty "point-mul-mul" $ \aCurve (QAInteger n1) (QAInteger n2) -> do p <- arbitraryPoint aCurve let pRes = ECC.pointMul aCurve (n1 * n2) p let pDef = ECC.pointMul aCurve n1 (ECC.pointMul aCurve n2 p) return $ pRes `propertyEq` pDef - , localOption (QuickCheckTests 20) $ - testProperty "double-scalar-mult" $ \aCurve (QAInteger n1) (QAInteger n2) -> do + , testProperty "double-scalar-mult" $ \aCurve (QAInteger n1) (QAInteger n2) -> do p1 <- arbitraryPoint aCurve p2 <- arbitraryPoint aCurve let pRes = ECC.pointAddTwoMuls aCurve n1 p1 n2 p2 diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index 6b6d279..2d6bb2b 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -113,6 +113,7 @@ tests = testGroup "P256" in r @=? P256.pointAdd s t , testProperty "lift-to-curve" $ propertyLiftToCurve , testProperty "point-add" $ propertyPointAdd + , testProperty "point-negate" $ propertyPointNegate ] ] where @@ -136,6 +137,12 @@ tests = testGroup "P256" , eqTest "ecc" peR (pointP256ToECC pR) ] + propertyPointNegate r = + let p = P256.toPoint (unP256Scalar r) + pe = ECC.pointMul curve (unP256 r) curveGen + pR = P256.pointNegate p + in ECC.pointNegate curve pe `propertyEq` (pointP256ToECC pR) + i2ospScalar :: Integer -> Bytes i2ospScalar i = case i2ospOf 32 i of diff --git a/tests/Tests.hs b/tests/Tests.hs index 0dafb9a..2f973c9 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -7,6 +7,7 @@ import qualified Number import qualified Number.F2m import qualified BCrypt import qualified ECC +import qualified ECC.Edwards25519 import qualified Hash import qualified Poly1305 import qualified Salsa @@ -83,6 +84,7 @@ tests = testGroup "cryptonite" ] , KAT_AFIS.tests , ECC.tests + , ECC.Edwards25519.tests ] main = defaultMain tests