Merge pull request #202 from ocheron/ed25519-arith-negate

Ed25519 arithmetic primitives

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

Crypto/ECC/Edwards25519.hs

@@ -0,0 +1,373 @@
+-- |
+-- Module      : Crypto.ECC.Edwards25519
+-- License     : BSD-style
+-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
+-- 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
+-- <https://tools.ietf.org/html/rfc7748 RFC 7748>.
+--
+-- 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 ()

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.

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

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 _            PointO     = PointO
-pointNegate CurveFP{}  (Point x y) = Point x (-y)
+pointNegate (CurveFP c) (Point x y) = Point x (ecc_p c - y)
-pointNegate CurveF2m{} (Point x y) = Point x (x `addF2m` y)
+pointNegate CurveF2m{}  (Point x y) = Point x (x `addF2m` y)
 
 -- | Elliptic Curve point addition.
 --

cbits/ed25519/ed25519-cryptonite-exts.h

@@ -0,0 +1,246 @@
+/*
+    Public domain by Olivier Chéron <olivier.cheron@gmail.com>
+
+    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);
+}

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 <https://github.com/floodyberry/ed25519-donna/issues/31>
+		if (i == 0) {
+			ge25519_p1p1_to_full(r, &t);
+		} else {
+			ge25519_p1p1_to_partial(r, &t);
+		}
 	}
 }
 

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

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);
+}

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

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 <http://cr.yp.to/python/py>:
+    --
+    -- >>> import ed25519
+    -- >>> encodepoint(scalarmult(B, 11)).encode('hex')
+    -- '1337036ac32d8f30d4589c3c1c595812ce0fff40e37c6f5a97ab213f318290ad'
+    -- >>> encodepoint(scalarmult(B, 123)).encode('hex')
+    -- 'c4b800c87010f9468303deea876503e886bfde1900e9e846fd4c3cd09c1cbc9f'
+    -- >>> encodepoint(scalarmult(B, 134)).encode('hex')
+    -- '5120abe03ca2af66c77ca320f0b21fb556f6b65fdd7e3264c14a30d97bf7a76f'

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-negate-add" $ \aCurve -> do
-          testProperty "point-mul-mul" $ \aCurve (QAInteger n1) (QAInteger n2) -> 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

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

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