Add pointMulByCofactor and pointHasPrimeOrder

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

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

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) ->
+        , testProperty "scalarmult with curve order - 1" $ \p ->
-            pointNegate p `propertyEq` pointMul sI 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) ->