From fcf1ff55fb42dafa6f422fb6a008bcb3987c2527 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 1 Nov 2017 18:02:38 +0100 Subject: [PATCH 01/23] Reorder C sources ed25519 uses sha512 code and must come later when using GHCi dynamic linker on macOS. --- cryptonite.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cryptonite.cabal b/cryptonite.cabal index c85f26f..45162f1 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -241,7 +241,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 +262,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 From 9ea718f55e8534d43a01e4b0ee2e3461b79a3883 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 4 Nov 2017 19:34:37 +0100 Subject: [PATCH 02/23] Arithmetic primitives over curve Ed25519 --- Crypto/ECC/Ed25519.hs | 232 ++++++++++++++++++++++++ cbits/ed25519/ed25519-cryptonite-exts.h | 122 +++++++++++++ cbits/ed25519/ed25519.c | 1 + cryptonite.cabal | 1 + 4 files changed, 356 insertions(+) create mode 100644 Crypto/ECC/Ed25519.hs create mode 100644 cbits/ed25519/ed25519-cryptonite-exts.h diff --git a/Crypto/ECC/Ed25519.hs b/Crypto/ECC/Ed25519.hs new file mode 100644 index 0000000..2e51537 --- /dev/null +++ b/Crypto/ECC/Ed25519.hs @@ -0,0 +1,232 @@ +-- | +-- Module : Crypto.ECC.Ed25519 +-- License : BSD-style +-- Maintainer : Olivier Chéron +-- Stability : experimental +-- Portability : unknown +-- +-- Ed25519 arithmetic primitives. +-- +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Crypto.ECC.Ed25519 + ( Scalar + , Point + -- * Scalars + , scalarGenerate + , scalarDecodeLong + , scalarEncode + -- * Points + , pointDecode + , pointEncode + -- * Arithmetic functions + , toPoint + , pointAdd + , pointDouble + , pointMul + ) 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 order of curve Ed25519. +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 Ed25519. +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 = unwrap . scalarDecodeLong . clamp <$> generate + where + unwrap (CryptoPassed x) = x + unwrap (CryptoFailed _) = error "scalarGenerate: assumption failed" + + generate :: MonadRandom randomly => randomly ScrubbedBytes + generate = getRandomBytes 32 + + -- Uses the same bit mask than during key-generation procedure, + -- but without making divisible by 8. As a consequence of modular + -- reduction, distribution is not uniform. But the curve order is + -- very close to 2^252 so only a tiny fraction of the scalars have + -- lower probability, roughly 1/(2^126) of all possible values. + clamp :: ByteArrayAccess ba => ba -> ScrubbedBytes + clamp bs = B.copyAndFreeze bs $ \p -> do + b31 <- peekElemOff p 31 :: IO Word8 + pokeElemOff p 31 ((b31 .&. 0x7F) .|. 0x40) + +-- | Serialize a scalar to binary, i.e. a 32-byte little-endian +-- number. +-- +-- Format is binary compatible with 'Crypto.PubKey.Curve25519.SecretKey' +-- from module "Crypto.PubKey.Curve25519". +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. +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 #-} + +-- | 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 Ed25519. +-- +-- /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 #-} + +-- | 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 + +-- | Scalar multiplication over Ed25519. +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 + +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_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_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_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 () diff --git a/cbits/ed25519/ed25519-cryptonite-exts.h b/cbits/ed25519/ed25519-cryptonite-exts.h new file mode 100644 index 0000000..5eebb17 --- /dev/null +++ b/cbits/ed25519/ed25519-cryptonite-exts.h @@ -0,0 +1,122 @@ +/* + 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)); +} + + +/* + 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; +} + +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_base_scalarmul) (ge25519 *r, const bignum256modm s) { + ge25519_scalarmult_base_niels(r, ge25519_niels_base_multiples, s); +} + +void +ED25519_FN(ed25519_point_scalarmul) (ge25519 *r, const ge25519 *p, const bignum256modm s) { + ge25519 tmp; + uint32_t scalar_bit; + unsigned char ss[32]; + + // transform scalar as little-endian number + contract256_modm(ss, s); + + // initialize r to identity + memset(r, 0, sizeof(ge25519)); + r->y[0] = 1; + r->z[0] = 1; + + // double-add-always + for (int i = 31; i >= 0; i--) { + for (int j = 7; j >= 0; j--) { + ge25519_double(r, r); + + ge25519_add(&tmp, r, p); + scalar_bit = (ss[i] >> j) & 1; + curve25519_swap_conditional(r->x, tmp.x, scalar_bit); + curve25519_swap_conditional(r->y, tmp.y, scalar_bit); + curve25519_swap_conditional(r->z, tmp.z, scalar_bit); + curve25519_swap_conditional(r->t, tmp.t, scalar_bit); + } + } +} 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/cryptonite.cabal b/cryptonite.cabal index 45162f1..941be68 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -121,6 +121,7 @@ Library Crypto.Data.AFIS Crypto.Data.Padding Crypto.ECC + Crypto.ECC.Ed25519 Crypto.Error Crypto.MAC.CMAC Crypto.MAC.Poly1305 From 7d61abff03ab26b3cf7921d47888ae68f267dfcf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 4 Nov 2017 15:33:03 +0100 Subject: [PATCH 03/23] Ed25519 point negation --- Crypto/ECC/Ed25519.hs | 13 +++++++++++++ cbits/ed25519/ed25519-cryptonite-exts.h | 8 ++++++++ 2 files changed, 21 insertions(+) diff --git a/Crypto/ECC/Ed25519.hs b/Crypto/ECC/Ed25519.hs index 2e51537..aea6f69 100644 --- a/Crypto/ECC/Ed25519.hs +++ b/Crypto/ECC/Ed25519.hs @@ -20,6 +20,7 @@ module Crypto.ECC.Ed25519 , pointEncode -- * Arithmetic functions , toPoint + , pointNegate , pointAdd , pointDouble , pointMul @@ -151,6 +152,13 @@ pointDecode bs else return $ CryptoPassed (Point p) {-# NOINLINE pointDecode #-} +-- | 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) = @@ -209,6 +217,11 @@ foreign import ccall "cryptonite_ed25519_point_eq" -> 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 diff --git a/cbits/ed25519/ed25519-cryptonite-exts.h b/cbits/ed25519/ed25519-cryptonite-exts.h index 5eebb17..3c7fbd8 100644 --- a/cbits/ed25519/ed25519-cryptonite-exts.h +++ b/cbits/ed25519/ed25519-cryptonite-exts.h @@ -77,6 +77,14 @@ ED25519_FN(ed25519_point_eq) (const ge25519 *p, const ge25519 *q) { 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); From 35f1d20b79737205c5cde7f855dc91f7166878bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 6 Nov 2017 19:19:06 +0100 Subject: [PATCH 04/23] Ed25519 scalar add & multiply --- Crypto/ECC/Ed25519.hs | 30 +++++++++++++++++++++++++ cbits/ed25519/ed25519-cryptonite-exts.h | 10 +++++++++ 2 files changed, 40 insertions(+) diff --git a/Crypto/ECC/Ed25519.hs b/Crypto/ECC/Ed25519.hs index aea6f69..cf9fcd6 100644 --- a/Crypto/ECC/Ed25519.hs +++ b/Crypto/ECC/Ed25519.hs @@ -20,6 +20,8 @@ module Crypto.ECC.Ed25519 , pointEncode -- * Arithmetic functions , toPoint + , scalarAdd + , scalarMul , pointNegate , pointAdd , pointDouble @@ -119,6 +121,22 @@ scalarDecodeLong bs 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) = @@ -202,6 +220,18 @@ foreign import ccall "cryptonite_ed25519_scalar_decode_long" -> 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 diff --git a/cbits/ed25519/ed25519-cryptonite-exts.h b/cbits/ed25519/ed25519-cryptonite-exts.h index 3c7fbd8..4bca444 100644 --- a/cbits/ed25519/ed25519-cryptonite-exts.h +++ b/cbits/ed25519/ed25519-cryptonite-exts.h @@ -30,6 +30,16 @@ ED25519_FN(ed25519_scalar_eq) (const bignum256modm a, const bignum256modm b) { 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 From 416fc649e1be9705d26258b6d1254316a973f657 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 4 Nov 2017 08:45:24 +0100 Subject: [PATCH 05/23] Test Ed25519 arithmetic primitives --- cryptonite.cabal | 1 + tests/ECC/Ed25519.hs | 116 +++++++++++++++++++++++++++++++++++++++++++ tests/Tests.hs | 2 + 3 files changed, 119 insertions(+) create mode 100644 tests/ECC/Ed25519.hs diff --git a/cryptonite.cabal b/cryptonite.cabal index 941be68..dfb75cf 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -371,6 +371,7 @@ Test-Suite test-cryptonite ChaCha BCrypt ECC + ECC.Ed25519 Hash Imports KAT_AES.KATCBC diff --git a/tests/ECC/Ed25519.hs b/tests/ECC/Ed25519.hs new file mode 100644 index 0000000..dd0bcc1 --- /dev/null +++ b/tests/ECC/Ed25519.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE OverloadedStrings #-} +module ECC.Ed25519 ( tests ) where + +import Crypto.Error +import qualified Crypto.ECC.Ed25519 as Ed25519 +import Imports + +instance Arbitrary Ed25519.Scalar where + arbitrary = fmap (throwCryptoError . Ed25519.scalarDecodeLong) + (arbitraryBS 32) + +instance Arbitrary Ed25519.Point where + arbitrary = Ed25519.toPoint `fmap` arbitrary + +tests = testGroup "ECC.Ed25519" + [ testGroup "vectors" + [ testCase "11*G" $ p011 @=? Ed25519.toPoint s011 + , testCase "123*G" $ p123 @=? Ed25519.toPoint s123 + , testCase "134*G" $ p134 @=? Ed25519.toPoint s134 + , testCase "123*G + 11*G" $ p134 @=? Ed25519.pointAdd p123 p011 + ] + , testGroup "scalar arithmetic" + [ testProperty "scalarDecodeLong.scalarEncode==id" $ \s -> + let bs = Ed25519.scalarEncode s :: ByteString + ss = Ed25519.scalarDecodeLong bs + in CryptoPassed s `propertyEq` ss + , testCase "curve order" $ s0 @=? sN + , testProperty "addition with zero" $ \s -> + propertyHold [ eqTest "zero left" s (Ed25519.scalarAdd s0 s) + , eqTest "zero right" s (Ed25519.scalarAdd s s0) + ] + , testProperty "addition associative" $ \sa sb sc -> + Ed25519.scalarAdd sa (Ed25519.scalarAdd sb sc) === Ed25519.scalarAdd (Ed25519.scalarAdd sa sb) sc + , testProperty "addition commutative" $ \sa sb -> + Ed25519.scalarAdd sa sb === Ed25519.scalarAdd sb sa + , testProperty "multiplication with zero" $ \s -> + propertyHold [ eqTest "zero left" s0 (Ed25519.scalarMul s0 s) + , eqTest "zero right" s0 (Ed25519.scalarMul s s0) + ] + , testProperty "multiplication with one" $ \s -> + propertyHold [ eqTest "one left" s (Ed25519.scalarMul s1 s) + , eqTest "one right" s (Ed25519.scalarMul s s1) + ] + , testProperty "multiplication associative" $ \sa sb sc -> + Ed25519.scalarMul sa (Ed25519.scalarMul sb sc) === Ed25519.scalarMul (Ed25519.scalarMul sa sb) sc + , testProperty "multiplication commutative" $ \sa sb -> + Ed25519.scalarMul sa sb === Ed25519.scalarMul sb sa + , testProperty "multiplication distributive" $ \sa sb sc -> + propertyHold [ eqTest "distributive left" ((sa `Ed25519.scalarMul` sb) `Ed25519.scalarAdd` (sa `Ed25519.scalarMul` sc)) + (sa `Ed25519.scalarMul` (sb `Ed25519.scalarAdd` sc)) + , eqTest "distributive right" ((sb `Ed25519.scalarMul` sa) `Ed25519.scalarAdd` (sc `Ed25519.scalarMul` sa)) + ((sb `Ed25519.scalarAdd` sc) `Ed25519.scalarMul` sa) + ] + ] + , testGroup "point arithmetic" + [ testProperty "pointDecode.pointEncode==id" $ \p -> + let bs = Ed25519.pointEncode p :: ByteString + p' = Ed25519.pointDecode bs + in CryptoPassed p `propertyEq` p' + , testProperty "pointEncode.pointDecode==id" $ \p -> + let b = Ed25519.pointEncode p :: ByteString + p' = Ed25519.pointDecode b + b' = Ed25519.pointEncode `fmap` p' + in CryptoPassed b `propertyEq` b' + , testProperty "addition with identity" $ \p -> + propertyHold [ eqTest "identity left" p (Ed25519.pointAdd p0 p) + , eqTest "identity right" p (Ed25519.pointAdd p p0) + ] + , testProperty "addition associative" $ \pa pb pc -> + Ed25519.pointAdd pa (Ed25519.pointAdd pb pc) === Ed25519.pointAdd (Ed25519.pointAdd pa pb) pc + , testProperty "addition commutative" $ \pa pb -> + Ed25519.pointAdd pa pb === Ed25519.pointAdd pb pa + , testProperty "negation" $ \p -> + p0 `propertyEq` Ed25519.pointAdd p (Ed25519.pointNegate p) + , testProperty "doubling" $ \p -> + Ed25519.pointAdd p p `propertyEq` Ed25519.pointDouble p + , testProperty "scalarmult with zero" $ \p -> + p0 `propertyEq` Ed25519.pointMul s0 p + , testProperty "scalarmult with one" $ \p -> + p `propertyEq` Ed25519.pointMul s1 p + , testProperty "scalarmult with two" $ \p -> + Ed25519.pointDouble p `propertyEq` Ed25519.pointMul s2 p + , testProperty "scalarmult with curve order - 1" $ \p -> + Ed25519.pointNegate p `propertyEq` Ed25519.pointMul sI p + , testProperty "scalarmult commutative" $ \a b -> + Ed25519.pointMul a (Ed25519.toPoint b) === Ed25519.pointMul b (Ed25519.toPoint a) + , testProperty "scalarmult distributive" $ \x y p -> + let pR = Ed25519.pointMul x p `Ed25519.pointAdd` Ed25519.pointMul y p + in pR `propertyEq` Ed25519.pointMul (x `Ed25519.scalarAdd` y) p + ] + ] + where + p0 = Ed25519.toPoint s0 + CryptoPassed s0 = Ed25519.scalarDecodeLong ("" :: ByteString) + CryptoPassed s1 = Ed25519.scalarDecodeLong ("\x01" :: ByteString) + CryptoPassed s2 = Ed25519.scalarDecodeLong ("\x02" :: ByteString) + CryptoPassed sI = Ed25519.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) + CryptoPassed sN = Ed25519.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) + + CryptoPassed s011 = Ed25519.scalarDecodeLong ("\011" :: ByteString) + CryptoPassed s123 = Ed25519.scalarDecodeLong ("\123" :: ByteString) + CryptoPassed s134 = Ed25519.scalarDecodeLong ("\134" :: ByteString) + + CryptoPassed p011 = Ed25519.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) + CryptoPassed p123 = Ed25519.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) + CryptoPassed p134 = Ed25519.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 + -- >>> ed25519.encodepoint(ed25519.scalarmult(ed25519.B, 11)).encode('hex') + -- '1337036ac32d8f30d4589c3c1c595812ce0fff40e37c6f5a97ab213f318290ad' + -- >>> ed25519.encodepoint(ed25519.scalarmult(ed25519.B, 123)).encode('hex') + -- 'c4b800c87010f9468303deea876503e886bfde1900e9e846fd4c3cd09c1cbc9f' + -- >>> ed25519.encodepoint(ed25519.scalarmult(ed25519.B, 134)).encode('hex') + -- '5120abe03ca2af66c77ca320f0b21fb556f6b65fdd7e3264c14a30d97bf7a76f' diff --git a/tests/Tests.hs b/tests/Tests.hs index 0dafb9a..439d863 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.Ed25519 import qualified Hash import qualified Poly1305 import qualified Salsa @@ -83,6 +84,7 @@ tests = testGroup "cryptonite" ] , KAT_AFIS.tests , ECC.tests + , ECC.Ed25519.tests ] main = defaultMain tests From 5778909761f223a65f331cc021a95b3bd33695e6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Thu, 9 Nov 2017 08:42:28 +0100 Subject: [PATCH 06/23] Add Ed25519.pointsMulVarTime --- Crypto/ECC/Ed25519.hs | 23 +++++++++++++++++++++++ cbits/ed25519/ed25519-cryptonite-exts.h | 6 ++++++ tests/ECC/Ed25519.hs | 3 +++ 3 files changed, 32 insertions(+) diff --git a/Crypto/ECC/Ed25519.hs b/Crypto/ECC/Ed25519.hs index cf9fcd6..0a18223 100644 --- a/Crypto/ECC/Ed25519.hs +++ b/Crypto/ECC/Ed25519.hs @@ -26,6 +26,7 @@ module Crypto.ECC.Ed25519 , pointAdd , pointDouble , pointMul + , pointsMulVarTime ) where import Data.Bits @@ -204,6 +205,21 @@ pointMul (Scalar scalar) (Point base) = 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 @@ -273,3 +289,10 @@ foreign import ccall "cryptonite_ed25519_point_scalarmul" -> 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/cbits/ed25519/ed25519-cryptonite-exts.h b/cbits/ed25519/ed25519-cryptonite-exts.h index 4bca444..78a657a 100644 --- a/cbits/ed25519/ed25519-cryptonite-exts.h +++ b/cbits/ed25519/ed25519-cryptonite-exts.h @@ -138,3 +138,9 @@ ED25519_FN(ed25519_point_scalarmul) (ge25519 *r, const ge25519 *p, const bignum2 } } } + +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); +} diff --git a/tests/ECC/Ed25519.hs b/tests/ECC/Ed25519.hs index dd0bcc1..66505ea 100644 --- a/tests/ECC/Ed25519.hs +++ b/tests/ECC/Ed25519.hs @@ -87,6 +87,9 @@ tests = testGroup "ECC.Ed25519" , testProperty "scalarmult distributive" $ \x y p -> let pR = Ed25519.pointMul x p `Ed25519.pointAdd` Ed25519.pointMul y p in pR `propertyEq` Ed25519.pointMul (x `Ed25519.scalarAdd` y) p + , testProperty "double scalarmult" $ \n1 n2 p -> + let pR = Ed25519.pointAdd (Ed25519.toPoint n1) (Ed25519.pointMul n2 p) + in pR `propertyEq` Ed25519.pointsMulVarTime n1 n2 p ] ] where From 123e22ec08e9075e1d4cb75818fd7a0a67d9a4e2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Thu, 2 Nov 2017 19:34:55 +0100 Subject: [PATCH 07/23] Ed25519 scalar multiplication with 4-bit fixed window --- Crypto/ECC/Ed25519.hs | 17 +++++++- cbits/ed25519/ed25519-cryptonite-exts.h | 56 +++++++++++++++++++++++++ 2 files changed, 72 insertions(+), 1 deletion(-) diff --git a/Crypto/ECC/Ed25519.hs b/Crypto/ECC/Ed25519.hs index 0a18223..d9fea9a 100644 --- a/Crypto/ECC/Ed25519.hs +++ b/Crypto/ECC/Ed25519.hs @@ -26,6 +26,7 @@ module Crypto.ECC.Ed25519 , pointAdd , pointDouble , pointMul + , pointMulW , pointsMulVarTime ) where @@ -197,7 +198,7 @@ pointDouble (Point a) = withByteArray a $ \pa -> ed25519_point_double out pa --- | Scalar multiplication over Ed25519. +-- | Scalar multiplication over Ed25519 (double-add always). pointMul :: Scalar -> Point -> Point pointMul (Scalar scalar) (Point base) = Point $ B.allocAndFreeze pointArraySize $ \out -> @@ -205,6 +206,14 @@ pointMul (Scalar scalar) (Point base) = withByteArray base $ \pbase -> ed25519_point_scalarmul out pbase pscalar +-- | Scalar multiplication over Ed25519 (4-bit fixed window). +pointMulW :: Scalar -> Point -> Point +pointMulW (Scalar scalar) (Point base) = + Point $ B.allocAndFreeze pointArraySize $ \out -> + withByteArray scalar $ \pscalar -> + withByteArray base $ \pbase -> + ed25519_point_scalarmul_w out pbase pscalar + -- | Multiply the point @p@ with @s2@ and add a lifted to curve value @s1@. -- -- @ @@ -290,6 +299,12 @@ foreign import ccall "cryptonite_ed25519_point_scalarmul" -> Ptr Scalar -- scalar -> IO () +foreign import ccall "cryptonite_ed25519_point_scalarmul_w" + ed25519_point_scalarmul_w :: 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 diff --git a/cbits/ed25519/ed25519-cryptonite-exts.h b/cbits/ed25519/ed25519-cryptonite-exts.h index 78a657a..57df83c 100644 --- a/cbits/ed25519/ed25519-cryptonite-exts.h +++ b/cbits/ed25519/ed25519-cryptonite-exts.h @@ -139,6 +139,62 @@ ED25519_FN(ed25519_point_scalarmul) (ge25519 *r, const ge25519 *p, const bignum2 } } +void +ED25519_FN(ed25519_point_scalarmul_w) (ge25519 *r, const ge25519 *p, const bignum256modm s) { + ge25519_pniels mult[16]; + 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; + + // initialize mult[0] to identity, i.e. ge25519_pniels (1, 1, 1, 0) + memset(&mult[0], 0, sizeof(ge25519_pniels)); + mult->ysubx[0] = 1; + mult->xaddy[0] = 1; + mult->z[0] = 1; + + // precompute other multiples of P: 1.P, 2.P, ..., 15.P + ge25519_full_to_pniels(&mult[1], p); + for (int i = 2; i < 16; i++) { + ge25519_pnielsadd(&mult[i], p, &mult[i-1]); + } + + // 4-bit fixed window, still 256 doublings but 64 additions + // + // NOTE: direct indexed access to 'mult' table leaks data through + // CPU cache but provides 33% speedup compared to naive unvectored + // table lookup with unint32 constant-time conditional selection + for (int i = 31; i >= 0; i--) { + // higher bits in ss[i] + ge25519_pnielsadd_p1p1(&t, r, &mult[ss[i] >> 4], 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] + ge25519_pnielsadd_p1p1(&t, r, &mult[ss[i] & 0x0F], 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 From d497040ddd9491ee202712563518be686708ff2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 4 Nov 2017 08:45:24 +0100 Subject: [PATCH 08/23] Avoid direct indexed access in precomputed table --- cbits/ed25519/ed25519-cryptonite-exts.h | 68 +++++++++++++++++++------ 1 file changed, 52 insertions(+), 16 deletions(-) diff --git a/cbits/ed25519/ed25519-cryptonite-exts.h b/cbits/ed25519/ed25519-cryptonite-exts.h index 57df83c..a295195 100644 --- a/cbits/ed25519/ed25519-cryptonite-exts.h +++ b/cbits/ed25519/ed25519-cryptonite-exts.h @@ -139,9 +139,53 @@ ED25519_FN(ed25519_point_scalarmul) (ge25519 *r, const ge25519 *p, const bignum2 } } +#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_w) (ge25519 *r, const ge25519 *p, const bignum256modm s) { - ge25519_pniels mult[16]; + ge25519_pniels mult[15]; + ge25519_pniels pn; ge25519_p1p1 t; unsigned char ss[32]; @@ -153,26 +197,17 @@ ED25519_FN(ed25519_point_scalarmul_w) (ge25519 *r, const ge25519 *p, const bignu r->y[0] = 1; r->z[0] = 1; - // initialize mult[0] to identity, i.e. ge25519_pniels (1, 1, 1, 0) - memset(&mult[0], 0, sizeof(ge25519_pniels)); - mult->ysubx[0] = 1; - mult->xaddy[0] = 1; - mult->z[0] = 1; - - // precompute other multiples of P: 1.P, 2.P, ..., 15.P - ge25519_full_to_pniels(&mult[1], p); - for (int i = 2; i < 16; i++) { + // 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 - // - // NOTE: direct indexed access to 'mult' table leaks data through - // CPU cache but provides 33% speedup compared to naive unvectored - // table lookup with unint32 constant-time conditional selection for (int i = 31; i >= 0; i--) { // higher bits in ss[i] - ge25519_pnielsadd_p1p1(&t, r, &mult[ss[i] >> 4], 0); + 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); @@ -181,7 +216,8 @@ ED25519_FN(ed25519_point_scalarmul_w) (ge25519 *r, const ge25519 *p, const bignu ge25519_double(r, r); // lower bits in ss[i] - ge25519_pnielsadd_p1p1(&t, r, &mult[ss[i] & 0x0F], 0); + 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); From 6b3bf37eea1c6643fcb019ff2dbb017d46a0430a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 4 Nov 2017 09:03:50 +0100 Subject: [PATCH 09/23] Use only fixed-window implementation --- Crypto/ECC/Ed25519.hs | 17 +------------- cbits/ed25519/ed25519-cryptonite-exts.h | 31 +------------------------ 2 files changed, 2 insertions(+), 46 deletions(-) diff --git a/Crypto/ECC/Ed25519.hs b/Crypto/ECC/Ed25519.hs index d9fea9a..0a18223 100644 --- a/Crypto/ECC/Ed25519.hs +++ b/Crypto/ECC/Ed25519.hs @@ -26,7 +26,6 @@ module Crypto.ECC.Ed25519 , pointAdd , pointDouble , pointMul - , pointMulW , pointsMulVarTime ) where @@ -198,7 +197,7 @@ pointDouble (Point a) = withByteArray a $ \pa -> ed25519_point_double out pa --- | Scalar multiplication over Ed25519 (double-add always). +-- | Scalar multiplication over Ed25519. pointMul :: Scalar -> Point -> Point pointMul (Scalar scalar) (Point base) = Point $ B.allocAndFreeze pointArraySize $ \out -> @@ -206,14 +205,6 @@ pointMul (Scalar scalar) (Point base) = withByteArray base $ \pbase -> ed25519_point_scalarmul out pbase pscalar --- | Scalar multiplication over Ed25519 (4-bit fixed window). -pointMulW :: Scalar -> Point -> Point -pointMulW (Scalar scalar) (Point base) = - Point $ B.allocAndFreeze pointArraySize $ \out -> - withByteArray scalar $ \pscalar -> - withByteArray base $ \pbase -> - ed25519_point_scalarmul_w out pbase pscalar - -- | Multiply the point @p@ with @s2@ and add a lifted to curve value @s1@. -- -- @ @@ -299,12 +290,6 @@ foreign import ccall "cryptonite_ed25519_point_scalarmul" -> Ptr Scalar -- scalar -> IO () -foreign import ccall "cryptonite_ed25519_point_scalarmul_w" - ed25519_point_scalarmul_w :: 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 diff --git a/cbits/ed25519/ed25519-cryptonite-exts.h b/cbits/ed25519/ed25519-cryptonite-exts.h index a295195..530c8cf 100644 --- a/cbits/ed25519/ed25519-cryptonite-exts.h +++ b/cbits/ed25519/ed25519-cryptonite-exts.h @@ -110,35 +110,6 @@ ED25519_FN(ed25519_point_base_scalarmul) (ge25519 *r, const bignum256modm s) { ge25519_scalarmult_base_niels(r, ge25519_niels_base_multiples, s); } -void -ED25519_FN(ed25519_point_scalarmul) (ge25519 *r, const ge25519 *p, const bignum256modm s) { - ge25519 tmp; - uint32_t scalar_bit; - unsigned char ss[32]; - - // transform scalar as little-endian number - contract256_modm(ss, s); - - // initialize r to identity - memset(r, 0, sizeof(ge25519)); - r->y[0] = 1; - r->z[0] = 1; - - // double-add-always - for (int i = 31; i >= 0; i--) { - for (int j = 7; j >= 0; j--) { - ge25519_double(r, r); - - ge25519_add(&tmp, r, p); - scalar_bit = (ss[i] >> j) & 1; - curve25519_swap_conditional(r->x, tmp.x, scalar_bit); - curve25519_swap_conditional(r->y, tmp.y, scalar_bit); - curve25519_swap_conditional(r->z, tmp.z, scalar_bit); - curve25519_swap_conditional(r->t, tmp.t, scalar_bit); - } - } -} - #if defined(ED25519_64BIT) typedef uint64_t ed25519_move_cond_word; #else @@ -183,7 +154,7 @@ ed25519_point_scalarmul_w_choose_pniels(ge25519_pniels *t, const ge25519_pniels } void -ED25519_FN(ed25519_point_scalarmul_w) (ge25519 *r, const ge25519 *p, const bignum256modm s) { +ED25519_FN(ed25519_point_scalarmul) (ge25519 *r, const ge25519 *p, const bignum256modm s) { ge25519_pniels mult[15]; ge25519_pniels pn; ge25519_p1p1 t; From c55dd4d27f0b6a87222df3a05d40071ac1c2222f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 4 Nov 2017 15:34:12 +0100 Subject: [PATCH 10/23] Add Curve_Ed25519 --- Crypto/ECC.hs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 576247d..54f56dd 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -17,6 +17,7 @@ module Crypto.ECC , Curve_P521R1(..) , Curve_X25519(..) , Curve_X448(..) + , Curve_Ed25519(..) , EllipticCurve(..) , EllipticCurveDH(..) , EllipticCurveArith(..) @@ -25,6 +26,7 @@ module Crypto.ECC ) where import qualified Crypto.PubKey.ECC.P256 as P256 +import qualified Crypto.ECC.Ed25519 as Ed25519 import qualified Crypto.ECC.Simple.Types as Simple import qualified Crypto.ECC.Simple.Prim as Simple import Crypto.Random @@ -225,6 +227,23 @@ instance EllipticCurveDH Curve_X448 where where secret = X448.dh p s ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p) +data Curve_Ed25519 = Curve_Ed25519 + deriving (Show,Data,Typeable) + +instance EllipticCurve Curve_Ed25519 where + type Point Curve_Ed25519 = Ed25519.Point + type Scalar Curve_Ed25519 = Ed25519.Scalar + curveSizeBits _ = 255 + curveGenerateScalar _ = Ed25519.scalarGenerate + curveGenerateKeyPair _ = toKeyPair <$> Ed25519.scalarGenerate + where toKeyPair scalar = KeyPair (Ed25519.toPoint scalar) scalar + encodePoint _ point = Ed25519.pointEncode point + decodePoint _ bs = Ed25519.pointDecode bs + +instance EllipticCurveArith Curve_Ed25519 where + pointAdd _ a b = Ed25519.pointAdd a b + pointSmul _ s p = Ed25519.pointMul s p + checkNonZeroDH :: SharedSecret -> CryptoFailable SharedSecret checkNonZeroDH s@(SharedSecret b) | B.constAllZero b = CryptoFailed CryptoError_ScalarMultiplicationInvalid From 4f7d742461d034d529ccebb10742e5a65ce301bf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 10 Nov 2017 13:10:20 +0100 Subject: [PATCH 11/23] Export and test ECC.pointNegate --- Crypto/PubKey/ECC/Prim.hs | 1 + tests/KAT_PubKey/ECC.hs | 7 +++++++ 2 files changed, 8 insertions(+) diff --git a/Crypto/PubKey/ECC/Prim.hs b/Crypto/PubKey/ECC/Prim.hs index 2428fc8..a4c10b5 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 diff --git a/tests/KAT_PubKey/ECC.hs b/tests/KAT_PubKey/ECC.hs index 9c6a923..59e43c2 100644 --- a/tests/KAT_PubKey/ECC.hs +++ b/tests/KAT_PubKey/ECC.hs @@ -155,6 +155,13 @@ 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 + , 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) , localOption (QuickCheckTests 20) $ testProperty "point-mul-mul" $ \aCurve (QAInteger n1) (QAInteger n2) -> do p <- arbitraryPoint aCurve From b8b59be5a565706d739c9f87acbaa7fa59fce74a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 10 Nov 2017 13:11:06 +0100 Subject: [PATCH 12/23] Normalize result of ECC.pointNegate --- Crypto/ECC/Simple/Prim.hs | 2 +- Crypto/PubKey/ECC/Prim.hs | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/Crypto/ECC/Simple/Prim.hs b/Crypto/ECC/Simple/Prim.hs index 4a36b05..fcb0a3c 100644 --- a/Crypto/ECC/Simple/Prim.hs +++ b/Crypto/ECC/Simple/Prim.hs @@ -49,7 +49,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/Prim.hs b/Crypto/PubKey/ECC/Prim.hs index a4c10b5..d87672b 100644 --- a/Crypto/PubKey/ECC/Prim.hs +++ b/Crypto/PubKey/ECC/Prim.hs @@ -31,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. -- From e8f1bc08c8098d253882be56e9e191a1318995fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 10 Nov 2017 13:13:19 +0100 Subject: [PATCH 13/23] Decrease iterations of ECC tests --- tests/KAT_PubKey/ECC.hs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/tests/KAT_PubKey/ECC.hs b/tests/KAT_PubKey/ECC.hs index 59e43c2..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 @@ -162,14 +162,12 @@ eccTests = testGroup "ECC" , testProperty "point-negate-negate" $ \aCurve -> do p <- arbitraryPoint aCurve return $ p `propertyEq` ECC.pointNegate aCurve (ECC.pointNegate aCurve p) - , localOption (QuickCheckTests 20) $ - testProperty "point-mul-mul" $ \aCurve (QAInteger n1) (QAInteger n2) -> do + , 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 From 8d7e0d236c8da14c31a186d70f4ed0724d22cc0e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 10 Nov 2017 13:37:56 +0100 Subject: [PATCH 14/23] Add P256.pointNegate --- Crypto/PubKey/ECC/P256.hs | 12 ++++++++++++ cbits/p256/p256_ec.c | 11 +++++++++++ tests/KAT_PubKey/P256.hs | 7 +++++++ 3 files changed, 30 insertions(+) diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index f1d8c32..161983a 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/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/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 From 8567bacc2e675edc272cbfa57b2a857e109cbf03 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 10 Nov 2017 15:00:09 +0100 Subject: [PATCH 15/23] Add pointNegate to class EllipticCurveArith --- Crypto/ECC.hs | 7 +++++++ Crypto/ECC/Simple/Prim.hs | 1 + 2 files changed, 8 insertions(+) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 54f56dd..6119af8 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -103,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 @@ -139,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 @@ -160,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 @@ -182,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 @@ -242,6 +248,7 @@ instance EllipticCurve Curve_Ed25519 where instance EllipticCurveArith Curve_Ed25519 where pointAdd _ a b = Ed25519.pointAdd a b + pointNegate _ p = Ed25519.pointNegate p pointSmul _ s p = Ed25519.pointMul s p checkNonZeroDH :: SharedSecret -> CryptoFailable SharedSecret diff --git a/Crypto/ECC/Simple/Prim.hs b/Crypto/ECC/Simple/Prim.hs index fcb0a3c..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 From d472d9b74fdd9036c015ab30a5c97451d2af4474 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 10 Dec 2017 21:10:49 +0100 Subject: [PATCH 16/23] Import Ed25519 unqualified --- tests/ECC/Ed25519.hs | 122 +++++++++++++++++++++---------------------- 1 file changed, 61 insertions(+), 61 deletions(-) diff --git a/tests/ECC/Ed25519.hs b/tests/ECC/Ed25519.hs index 66505ea..a05b00f 100644 --- a/tests/ECC/Ed25519.hs +++ b/tests/ECC/Ed25519.hs @@ -2,118 +2,118 @@ module ECC.Ed25519 ( tests ) where import Crypto.Error -import qualified Crypto.ECC.Ed25519 as Ed25519 +import Crypto.ECC.Ed25519 import Imports -instance Arbitrary Ed25519.Scalar where - arbitrary = fmap (throwCryptoError . Ed25519.scalarDecodeLong) +instance Arbitrary Scalar where + arbitrary = fmap (throwCryptoError . scalarDecodeLong) (arbitraryBS 32) -instance Arbitrary Ed25519.Point where - arbitrary = Ed25519.toPoint `fmap` arbitrary +instance Arbitrary Point where + arbitrary = toPoint `fmap` arbitrary tests = testGroup "ECC.Ed25519" [ testGroup "vectors" - [ testCase "11*G" $ p011 @=? Ed25519.toPoint s011 - , testCase "123*G" $ p123 @=? Ed25519.toPoint s123 - , testCase "134*G" $ p134 @=? Ed25519.toPoint s134 - , testCase "123*G + 11*G" $ p134 @=? Ed25519.pointAdd p123 p011 + [ 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 = Ed25519.scalarEncode s :: ByteString - ss = Ed25519.scalarDecodeLong bs + 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 (Ed25519.scalarAdd s0 s) - , eqTest "zero right" s (Ed25519.scalarAdd s s0) + propertyHold [ eqTest "zero left" s (scalarAdd s0 s) + , eqTest "zero right" s (scalarAdd s s0) ] , testProperty "addition associative" $ \sa sb sc -> - Ed25519.scalarAdd sa (Ed25519.scalarAdd sb sc) === Ed25519.scalarAdd (Ed25519.scalarAdd sa sb) sc + scalarAdd sa (scalarAdd sb sc) === scalarAdd (scalarAdd sa sb) sc , testProperty "addition commutative" $ \sa sb -> - Ed25519.scalarAdd sa sb === Ed25519.scalarAdd sb sa + scalarAdd sa sb === scalarAdd sb sa , testProperty "multiplication with zero" $ \s -> - propertyHold [ eqTest "zero left" s0 (Ed25519.scalarMul s0 s) - , eqTest "zero right" s0 (Ed25519.scalarMul s s0) + 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 (Ed25519.scalarMul s1 s) - , eqTest "one right" s (Ed25519.scalarMul s s1) + propertyHold [ eqTest "one left" s (scalarMul s1 s) + , eqTest "one right" s (scalarMul s s1) ] , testProperty "multiplication associative" $ \sa sb sc -> - Ed25519.scalarMul sa (Ed25519.scalarMul sb sc) === Ed25519.scalarMul (Ed25519.scalarMul sa sb) sc + scalarMul sa (scalarMul sb sc) === scalarMul (scalarMul sa sb) sc , testProperty "multiplication commutative" $ \sa sb -> - Ed25519.scalarMul sa sb === Ed25519.scalarMul sb sa + scalarMul sa sb === scalarMul sb sa , testProperty "multiplication distributive" $ \sa sb sc -> - propertyHold [ eqTest "distributive left" ((sa `Ed25519.scalarMul` sb) `Ed25519.scalarAdd` (sa `Ed25519.scalarMul` sc)) - (sa `Ed25519.scalarMul` (sb `Ed25519.scalarAdd` sc)) - , eqTest "distributive right" ((sb `Ed25519.scalarMul` sa) `Ed25519.scalarAdd` (sc `Ed25519.scalarMul` sa)) - ((sb `Ed25519.scalarAdd` sc) `Ed25519.scalarMul` sa) + 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 = Ed25519.pointEncode p :: ByteString - p' = Ed25519.pointDecode bs + let bs = pointEncode p :: ByteString + p' = pointDecode bs in CryptoPassed p `propertyEq` p' , testProperty "pointEncode.pointDecode==id" $ \p -> - let b = Ed25519.pointEncode p :: ByteString - p' = Ed25519.pointDecode b - b' = Ed25519.pointEncode `fmap` 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 (Ed25519.pointAdd p0 p) - , eqTest "identity right" p (Ed25519.pointAdd p p0) + propertyHold [ eqTest "identity left" p (pointAdd p0 p) + , eqTest "identity right" p (pointAdd p p0) ] , testProperty "addition associative" $ \pa pb pc -> - Ed25519.pointAdd pa (Ed25519.pointAdd pb pc) === Ed25519.pointAdd (Ed25519.pointAdd pa pb) pc + pointAdd pa (pointAdd pb pc) === pointAdd (pointAdd pa pb) pc , testProperty "addition commutative" $ \pa pb -> - Ed25519.pointAdd pa pb === Ed25519.pointAdd pb pa + pointAdd pa pb === pointAdd pb pa , testProperty "negation" $ \p -> - p0 `propertyEq` Ed25519.pointAdd p (Ed25519.pointNegate p) + p0 `propertyEq` pointAdd p (pointNegate p) , testProperty "doubling" $ \p -> - Ed25519.pointAdd p p `propertyEq` Ed25519.pointDouble p + pointAdd p p `propertyEq` pointDouble p , testProperty "scalarmult with zero" $ \p -> - p0 `propertyEq` Ed25519.pointMul s0 p + p0 `propertyEq` pointMul s0 p , testProperty "scalarmult with one" $ \p -> - p `propertyEq` Ed25519.pointMul s1 p + p `propertyEq` pointMul s1 p , testProperty "scalarmult with two" $ \p -> - Ed25519.pointDouble p `propertyEq` Ed25519.pointMul s2 p + pointDouble p `propertyEq` pointMul s2 p , testProperty "scalarmult with curve order - 1" $ \p -> - Ed25519.pointNegate p `propertyEq` Ed25519.pointMul sI p + pointNegate p `propertyEq` pointMul sI p , testProperty "scalarmult commutative" $ \a b -> - Ed25519.pointMul a (Ed25519.toPoint b) === Ed25519.pointMul b (Ed25519.toPoint a) + pointMul a (toPoint b) === pointMul b (toPoint a) , testProperty "scalarmult distributive" $ \x y p -> - let pR = Ed25519.pointMul x p `Ed25519.pointAdd` Ed25519.pointMul y p - in pR `propertyEq` Ed25519.pointMul (x `Ed25519.scalarAdd` y) 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 = Ed25519.pointAdd (Ed25519.toPoint n1) (Ed25519.pointMul n2 p) - in pR `propertyEq` Ed25519.pointsMulVarTime n1 n2 p + let pR = pointAdd (toPoint n1) (pointMul n2 p) + in pR `propertyEq` pointsMulVarTime n1 n2 p ] ] where - p0 = Ed25519.toPoint s0 - CryptoPassed s0 = Ed25519.scalarDecodeLong ("" :: ByteString) - CryptoPassed s1 = Ed25519.scalarDecodeLong ("\x01" :: ByteString) - CryptoPassed s2 = Ed25519.scalarDecodeLong ("\x02" :: ByteString) - CryptoPassed sI = Ed25519.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) - CryptoPassed sN = Ed25519.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) + p0 = toPoint s0 + CryptoPassed s0 = scalarDecodeLong ("" :: ByteString) + CryptoPassed s1 = scalarDecodeLong ("\x01" :: ByteString) + CryptoPassed s2 = scalarDecodeLong ("\x02" :: ByteString) + CryptoPassed sI = 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) + CryptoPassed sN = 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) - CryptoPassed s011 = Ed25519.scalarDecodeLong ("\011" :: ByteString) - CryptoPassed s123 = Ed25519.scalarDecodeLong ("\123" :: ByteString) - CryptoPassed s134 = Ed25519.scalarDecodeLong ("\134" :: ByteString) + CryptoPassed s011 = scalarDecodeLong ("\011" :: ByteString) + CryptoPassed s123 = scalarDecodeLong ("\123" :: ByteString) + CryptoPassed s134 = scalarDecodeLong ("\134" :: ByteString) - CryptoPassed p011 = Ed25519.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) - CryptoPassed p123 = Ed25519.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) - CryptoPassed p134 = Ed25519.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) + CryptoPassed p011 = 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) + CryptoPassed p123 = 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) + CryptoPassed p134 = 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 : + -- Using : -- -- >>> import ed25519 - -- >>> ed25519.encodepoint(ed25519.scalarmult(ed25519.B, 11)).encode('hex') + -- >>> encodepoint(scalarmult(B, 11)).encode('hex') -- '1337036ac32d8f30d4589c3c1c595812ce0fff40e37c6f5a97ab213f318290ad' - -- >>> ed25519.encodepoint(ed25519.scalarmult(ed25519.B, 123)).encode('hex') + -- >>> encodepoint(scalarmult(B, 123)).encode('hex') -- 'c4b800c87010f9468303deea876503e886bfde1900e9e846fd4c3cd09c1cbc9f' - -- >>> ed25519.encodepoint(ed25519.scalarmult(ed25519.B, 134)).encode('hex') + -- >>> encodepoint(scalarmult(B, 134)).encode('hex') -- '5120abe03ca2af66c77ca320f0b21fb556f6b65fdd7e3264c14a30d97bf7a76f' From 45723e35425929058c223bdb8d81e966673348eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 10 Dec 2017 20:00:35 +0100 Subject: [PATCH 17/23] Rename to Edwards25519 --- Crypto/ECC.hs | 30 +++++++++++----------- Crypto/ECC/{Ed25519.hs => Edwards25519.hs} | 14 +++++----- cryptonite.cabal | 4 +-- tests/ECC/{Ed25519.hs => Edwards25519.hs} | 6 ++--- tests/Tests.hs | 4 +-- 5 files changed, 29 insertions(+), 29 deletions(-) rename Crypto/ECC/{Ed25519.hs => Edwards25519.hs} (97%) rename tests/ECC/{Ed25519.hs => Edwards25519.hs} (98%) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 6119af8..1583cf2 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -17,7 +17,7 @@ module Crypto.ECC , Curve_P521R1(..) , Curve_X25519(..) , Curve_X448(..) - , Curve_Ed25519(..) + , Curve_Edwards25519(..) , EllipticCurve(..) , EllipticCurveDH(..) , EllipticCurveArith(..) @@ -26,7 +26,7 @@ module Crypto.ECC ) where import qualified Crypto.PubKey.ECC.P256 as P256 -import qualified Crypto.ECC.Ed25519 as Ed25519 +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 @@ -233,23 +233,23 @@ instance EllipticCurveDH Curve_X448 where where secret = X448.dh p s ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p) -data Curve_Ed25519 = Curve_Ed25519 +data Curve_Edwards25519 = Curve_Edwards25519 deriving (Show,Data,Typeable) -instance EllipticCurve Curve_Ed25519 where - type Point Curve_Ed25519 = Ed25519.Point - type Scalar Curve_Ed25519 = Ed25519.Scalar +instance EllipticCurve Curve_Edwards25519 where + type Point Curve_Edwards25519 = Edwards25519.Point + type Scalar Curve_Edwards25519 = Edwards25519.Scalar curveSizeBits _ = 255 - curveGenerateScalar _ = Ed25519.scalarGenerate - curveGenerateKeyPair _ = toKeyPair <$> Ed25519.scalarGenerate - where toKeyPair scalar = KeyPair (Ed25519.toPoint scalar) scalar - encodePoint _ point = Ed25519.pointEncode point - decodePoint _ bs = Ed25519.pointDecode bs + 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_Ed25519 where - pointAdd _ a b = Ed25519.pointAdd a b - pointNegate _ p = Ed25519.pointNegate p - pointSmul _ s p = Ed25519.pointMul s p +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) diff --git a/Crypto/ECC/Ed25519.hs b/Crypto/ECC/Edwards25519.hs similarity index 97% rename from Crypto/ECC/Ed25519.hs rename to Crypto/ECC/Edwards25519.hs index 0a18223..e82ccf5 100644 --- a/Crypto/ECC/Ed25519.hs +++ b/Crypto/ECC/Edwards25519.hs @@ -1,14 +1,14 @@ -- | --- Module : Crypto.ECC.Ed25519 +-- Module : Crypto.ECC.Edwards25519 -- License : BSD-style -- Maintainer : Olivier Chéron -- Stability : experimental -- Portability : unknown -- --- Ed25519 arithmetic primitives. +-- Arithmetic primitives over curve edwards25519. -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Crypto.ECC.Ed25519 +module Crypto.ECC.Edwards25519 ( Scalar , Point -- * Scalars @@ -47,7 +47,7 @@ import Crypto.Random scalarArraySize :: Int scalarArraySize = 40 -- maximum [9 * 4 {- 32 bits -}, 5 * 8 {- 64 bits -}] --- | A scalar modulo order of curve Ed25519. +-- | A scalar modulo order of curve edwards25519. newtype Scalar = Scalar ScrubbedBytes deriving (Show,NFData) @@ -61,7 +61,7 @@ instance Eq Scalar where pointArraySize :: Int pointArraySize = 160 -- maximum [4 * 10 * 4 {- 32 bits -}, 4 * 5 * 8 {- 64 bits -}] --- | A point on curve Ed25519. +-- | A point on curve edwards25519. newtype Point = Point Bytes deriving NFData @@ -156,7 +156,7 @@ pointEncode (Point p) = ed25519_point_encode out pp -- | Deserialize a 32-byte array as a point, ensuring the point is --- valid on Ed25519. +-- valid on edwards25519. -- -- /WARNING:/ variable time pointDecode :: B.ByteArrayAccess bs => bs -> CryptoFailable Point @@ -197,7 +197,7 @@ pointDouble (Point a) = withByteArray a $ \pa -> ed25519_point_double out pa --- | Scalar multiplication over Ed25519. +-- | Scalar multiplication over curve edwards25519. pointMul :: Scalar -> Point -> Point pointMul (Scalar scalar) (Point base) = Point $ B.allocAndFreeze pointArraySize $ \out -> diff --git a/cryptonite.cabal b/cryptonite.cabal index dfb75cf..6d1efa7 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -121,7 +121,7 @@ Library Crypto.Data.AFIS Crypto.Data.Padding Crypto.ECC - Crypto.ECC.Ed25519 + Crypto.ECC.Edwards25519 Crypto.Error Crypto.MAC.CMAC Crypto.MAC.Poly1305 @@ -371,7 +371,7 @@ Test-Suite test-cryptonite ChaCha BCrypt ECC - ECC.Ed25519 + ECC.Edwards25519 Hash Imports KAT_AES.KATCBC diff --git a/tests/ECC/Ed25519.hs b/tests/ECC/Edwards25519.hs similarity index 98% rename from tests/ECC/Ed25519.hs rename to tests/ECC/Edwards25519.hs index a05b00f..46893b0 100644 --- a/tests/ECC/Ed25519.hs +++ b/tests/ECC/Edwards25519.hs @@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} -module ECC.Ed25519 ( tests ) where +module ECC.Edwards25519 ( tests ) where import Crypto.Error -import Crypto.ECC.Ed25519 +import Crypto.ECC.Edwards25519 import Imports instance Arbitrary Scalar where @@ -12,7 +12,7 @@ instance Arbitrary Scalar where instance Arbitrary Point where arbitrary = toPoint `fmap` arbitrary -tests = testGroup "ECC.Ed25519" +tests = testGroup "ECC.Edwards25519" [ testGroup "vectors" [ testCase "11*G" $ p011 @=? toPoint s011 , testCase "123*G" $ p123 @=? toPoint s123 diff --git a/tests/Tests.hs b/tests/Tests.hs index 439d863..2f973c9 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -7,7 +7,7 @@ import qualified Number import qualified Number.F2m import qualified BCrypt import qualified ECC -import qualified ECC.Ed25519 +import qualified ECC.Edwards25519 import qualified Hash import qualified Poly1305 import qualified Salsa @@ -84,7 +84,7 @@ tests = testGroup "cryptonite" ] , KAT_AFIS.tests , ECC.tests - , ECC.Ed25519.tests + , ECC.Edwards25519.tests ] main = defaultMain tests From fbe1c213e2f156fd5ecafbafa93ed336b776d79d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 11 Dec 2017 06:40:41 +0100 Subject: [PATCH 18/23] Use throwCryptoError --- Crypto/ECC/Edwards25519.hs | 5 +---- tests/ECC/Edwards25519.hs | 22 +++++++++++----------- 2 files changed, 12 insertions(+), 15 deletions(-) diff --git a/Crypto/ECC/Edwards25519.hs b/Crypto/ECC/Edwards25519.hs index e82ccf5..2e91fb9 100644 --- a/Crypto/ECC/Edwards25519.hs +++ b/Crypto/ECC/Edwards25519.hs @@ -80,11 +80,8 @@ instance Eq Point where -- | Generate a random scalar. scalarGenerate :: MonadRandom randomly => randomly Scalar -scalarGenerate = unwrap . scalarDecodeLong . clamp <$> generate +scalarGenerate = throwCryptoError . scalarDecodeLong . clamp <$> generate where - unwrap (CryptoPassed x) = x - unwrap (CryptoFailed _) = error "scalarGenerate: assumption failed" - generate :: MonadRandom randomly => randomly ScrubbedBytes generate = getRandomBytes 32 diff --git a/tests/ECC/Edwards25519.hs b/tests/ECC/Edwards25519.hs index 46893b0..fd887c3 100644 --- a/tests/ECC/Edwards25519.hs +++ b/tests/ECC/Edwards25519.hs @@ -94,19 +94,19 @@ tests = testGroup "ECC.Edwards25519" ] where p0 = toPoint s0 - CryptoPassed s0 = scalarDecodeLong ("" :: ByteString) - CryptoPassed s1 = scalarDecodeLong ("\x01" :: ByteString) - CryptoPassed s2 = scalarDecodeLong ("\x02" :: ByteString) - CryptoPassed sI = 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) - CryptoPassed sN = 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) + s0 = throwCryptoError $ scalarDecodeLong ("" :: ByteString) + s1 = throwCryptoError $ scalarDecodeLong ("\x01" :: ByteString) + s2 = throwCryptoError $ scalarDecodeLong ("\x02" :: ByteString) + 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) - CryptoPassed s011 = scalarDecodeLong ("\011" :: ByteString) - CryptoPassed s123 = scalarDecodeLong ("\123" :: ByteString) - CryptoPassed s134 = scalarDecodeLong ("\134" :: ByteString) + s011 = throwCryptoError $ scalarDecodeLong ("\011" :: ByteString) + s123 = throwCryptoError $ scalarDecodeLong ("\123" :: ByteString) + s134 = throwCryptoError $ scalarDecodeLong ("\134" :: ByteString) - CryptoPassed p011 = 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) - CryptoPassed p123 = 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) - CryptoPassed p134 = 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) + 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 : -- From 0820cd5c38da86a73755bedd7923bd645d8c3ce6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 11 Dec 2017 20:16:45 +0100 Subject: [PATCH 19/23] Simpler Edwards25519.scalarGenerate --- Crypto/ECC/Edwards25519.hs | 20 ++++++++------------ tests/ECC/Edwards25519.hs | 2 +- 2 files changed, 9 insertions(+), 13 deletions(-) diff --git a/Crypto/ECC/Edwards25519.hs b/Crypto/ECC/Edwards25519.hs index 2e91fb9..c217df3 100644 --- a/Crypto/ECC/Edwards25519.hs +++ b/Crypto/ECC/Edwards25519.hs @@ -80,20 +80,16 @@ instance Eq Point where -- | Generate a random scalar. scalarGenerate :: MonadRandom randomly => randomly Scalar -scalarGenerate = throwCryptoError . scalarDecodeLong . clamp <$> generate +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 32 - - -- Uses the same bit mask than during key-generation procedure, - -- but without making divisible by 8. As a consequence of modular - -- reduction, distribution is not uniform. But the curve order is - -- very close to 2^252 so only a tiny fraction of the scalars have - -- lower probability, roughly 1/(2^126) of all possible values. - clamp :: ByteArrayAccess ba => ba -> ScrubbedBytes - clamp bs = B.copyAndFreeze bs $ \p -> do - b31 <- peekElemOff p 31 :: IO Word8 - pokeElemOff p 31 ((b31 .&. 0x7F) .|. 0x40) + generate = getRandomBytes 64 -- | Serialize a scalar to binary, i.e. a 32-byte little-endian -- number. diff --git a/tests/ECC/Edwards25519.hs b/tests/ECC/Edwards25519.hs index fd887c3..f126c9d 100644 --- a/tests/ECC/Edwards25519.hs +++ b/tests/ECC/Edwards25519.hs @@ -7,7 +7,7 @@ import Imports instance Arbitrary Scalar where arbitrary = fmap (throwCryptoError . scalarDecodeLong) - (arbitraryBS 32) + (arbitraryBS 64) instance Arbitrary Point where arbitrary = toPoint `fmap` arbitrary From b962952c309b54e36cbc58e35e6b159f7ff37735 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Thu, 14 Dec 2017 06:43:56 +0100 Subject: [PATCH 20/23] Add introduction and warnings about possible pitfalls --- Crypto/ECC/Edwards25519.hs | 51 +++++++++++++++++++++++++++++++++++--- 1 file changed, 47 insertions(+), 4 deletions(-) diff --git a/Crypto/ECC/Edwards25519.hs b/Crypto/ECC/Edwards25519.hs index c217df3..c6dffd5 100644 --- a/Crypto/ECC/Edwards25519.hs +++ b/Crypto/ECC/Edwards25519.hs @@ -7,6 +7,44 @@ -- -- 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 +-- +-- 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 @@ -47,7 +85,7 @@ import Crypto.Random scalarArraySize :: Int scalarArraySize = 40 -- maximum [9 * 4 {- 32 bits -}, 5 * 8 {- 64 bits -}] --- | A scalar modulo order of curve edwards25519. +-- | A scalar modulo prime order of curve edwards25519. newtype Scalar = Scalar ScrubbedBytes deriving (Show,NFData) @@ -93,9 +131,6 @@ scalarGenerate = throwCryptoError . scalarDecodeLong <$> generate -- | Serialize a scalar to binary, i.e. a 32-byte little-endian -- number. --- --- Format is binary compatible with 'Crypto.PubKey.Curve25519.SecretKey' --- from module "Crypto.PubKey.Curve25519". scalarEncode :: B.ByteArray bs => Scalar -> bs scalarEncode (Scalar s) = B.allocAndFreeze 32 $ \out -> @@ -103,6 +138,10 @@ scalarEncode (Scalar s) = -- | 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 @@ -191,6 +230,10 @@ pointDouble (Point a) = ed25519_point_double 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 -> From 251f164f47ce28b5dee355a3708b93303e02a8dd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 16 Dec 2017 07:19:41 +0100 Subject: [PATCH 21/23] Apply bugfix to Edwards25519.pointsMulVarTime --- cbits/ed25519/ed25519-donna-impl-base.h | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) 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); + } } } From 9cd77ed3e2d51f66fe9080574febb0d802654e13 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 16 Dec 2017 07:54:24 +0100 Subject: [PATCH 22/23] Test points with a torsion component --- tests/ECC/Edwards25519.hs | 36 ++++++++++++++++++++++++++++++------ 1 file changed, 30 insertions(+), 6 deletions(-) diff --git a/tests/ECC/Edwards25519.hs b/tests/ECC/Edwards25519.hs index f126c9d..5ad4d0f 100644 --- a/tests/ECC/Edwards25519.hs +++ b/tests/ECC/Edwards25519.hs @@ -3,14 +3,33 @@ 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 = toPoint `fmap` arbitrary + 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" @@ -74,17 +93,20 @@ tests = testGroup "ECC.Edwards25519" p0 `propertyEq` pointAdd p (pointNegate p) , testProperty "doubling" $ \p -> pointAdd p p `propertyEq` pointDouble 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 -> + , testProperty "scalarmult with curve order - 1" $ \(PrimeOrder p) -> pointNegate p `propertyEq` pointMul sI p , testProperty "scalarmult commutative" $ \a b -> pointMul a (toPoint b) === pointMul b (toPoint a) - , testProperty "scalarmult distributive" $ \x y p -> + , 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 -> @@ -94,9 +116,11 @@ tests = testGroup "ECC.Edwards25519" ] where p0 = toPoint s0 - s0 = throwCryptoError $ scalarDecodeLong ("" :: ByteString) - s1 = throwCryptoError $ scalarDecodeLong ("\x01" :: ByteString) - s2 = throwCryptoError $ scalarDecodeLong ("\x02" :: ByteString) + 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) From 3217038a1a97f1b774f565b5392795e0bc381581 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 17 Dec 2017 09:42:42 +0100 Subject: [PATCH 23/23] Add pointMulByCofactor and pointHasPrimeOrder --- Crypto/ECC/Edwards25519.hs | 39 +++++++++++++++++++++++++ cbits/ed25519/ed25519-cryptonite-exts.h | 37 +++++++++++++++++++++++ tests/ECC/Edwards25519.hs | 8 +++-- 3 files changed, 82 insertions(+), 2 deletions(-) diff --git a/Crypto/ECC/Edwards25519.hs b/Crypto/ECC/Edwards25519.hs index c6dffd5..ebba8ca 100644 --- a/Crypto/ECC/Edwards25519.hs +++ b/Crypto/ECC/Edwards25519.hs @@ -37,6 +37,10 @@ -- -- - 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. @@ -56,6 +60,7 @@ module Crypto.ECC.Edwards25519 -- * Points , pointDecode , pointEncode + , pointHasPrimeOrder -- * Arithmetic functions , toPoint , scalarAdd @@ -64,6 +69,7 @@ module Crypto.ECC.Edwards25519 , pointAdd , pointDouble , pointMul + , pointMulByCofactor , pointsMulVarTime ) where @@ -203,6 +209,19 @@ pointDecode bs 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) = @@ -229,6 +248,17 @@ pointDouble (Point a) = 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 @@ -299,6 +329,10 @@ foreign import ccall "cryptonite_ed25519_point_eq" -> 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 @@ -315,6 +349,11 @@ foreign import ccall "cryptonite_ed25519_point_double" -> 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 diff --git a/cbits/ed25519/ed25519-cryptonite-exts.h b/cbits/ed25519/ed25519-cryptonite-exts.h index 530c8cf..8a74618 100644 --- a/cbits/ed25519/ed25519-cryptonite-exts.h +++ b/cbits/ed25519/ed25519-cryptonite-exts.h @@ -87,6 +87,25 @@ ED25519_FN(ed25519_point_eq) (const ge25519 *p, const ge25519 *q) { 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); @@ -105,6 +124,13 @@ 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); @@ -207,3 +233,14 @@ ED25519_FN(ed25519_base_double_scalarmul_vartime) (ge25519 *r, const bignum256mo // 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/tests/ECC/Edwards25519.hs b/tests/ECC/Edwards25519.hs index 5ad4d0f..602ae72 100644 --- a/tests/ECC/Edwards25519.hs +++ b/tests/ECC/Edwards25519.hs @@ -93,6 +93,10 @@ tests = testGroup "ECC.Edwards25519" 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 @@ -102,8 +106,8 @@ tests = testGroup "ECC.Edwards25519" p `propertyEq` pointMul s1 p , testProperty "scalarmult with two" $ \p -> pointDouble p `propertyEq` pointMul s2 p - , testProperty "scalarmult with curve order - 1" $ \(PrimeOrder p) -> - pointNegate p `propertyEq` pointMul sI 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) ->