Merge pull request #300 from ocheron/tc-ecdsa

ECDSA with a type class

Crypto/Number/ModArithmetic.hs

@@ -16,6 +16,7 @@ module Crypto.Number.ModArithmetic
     , inverse
     , inverseCoprimes
     , jacobi
+    , inverseFermat
     ) where
 
 import Control.Exception (throw, Exception)
@@ -120,3 +121,8 @@ jacobi a n
           n1      = n `mod` a1
        in if a1 == 1 then Just s
           else fmap (*s) (jacobi n1 a1)
+
+-- | Modular inverse using Fermat's little theorem.  This works only when
+-- the modulus is prime but avoids side channels like in 'expSafe'.
+inverseFermat :: Integer -> Integer -> Integer
+inverseFermat g p = expSafe g (p - 2) p

Crypto/PubKey/ECC/P256.hs

@@ -8,7 +8,6 @@
 -- P256 support
 --
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE EmptyDataDecls #-}
 {-# OPTIONS_GHC -fno-warn-unused-binds #-}
 module Crypto.PubKey.ECC.P256
@@ -22,7 +21,9 @@ module Crypto.PubKey.ECC.P256
     , pointDh
     , pointsMulVarTime
     , pointIsValid
+    , pointIsAtInfinity
     , toPoint
+    , pointX
     , pointToIntegers
     , pointFromIntegers
     , pointToBinary
@@ -31,11 +32,13 @@ module Crypto.PubKey.ECC.P256
     -- * Scalar arithmetic
     , scalarGenerate
     , scalarZero
+    , scalarN
     , scalarIsZero
     , scalarAdd
     , scalarSub
     , scalarMul
     , scalarInv
+    , scalarInvSafe
     , scalarCmp
     , scalarFromBinary
     , scalarToBinary
@@ -77,6 +80,9 @@ data P256Scalar
 data P256Y
 data P256X
 
+order :: Integer
+order = 0xffffffff00000000ffffffffffffffffbce6faada7179e84f3b9cac2fc632551
+
 ------------------------------------------------------------------------
 -- Point methods
 ------------------------------------------------------------------------
@@ -146,6 +152,19 @@ pointIsValid p = unsafeDoIO $ withPoint p $ \px py -> do
     r <- ccryptonite_p256_is_valid_point px py
     return (r /= 0)
 
+-- | Check if a 'Point' is the point at infinity
+pointIsAtInfinity :: Point -> Bool
+pointIsAtInfinity (Point b) = constAllZero b
+
+-- | Return the x coordinate as a 'Scalar' if the point is not at infinity
+pointX :: Point -> Maybe Scalar
+pointX p
+    | pointIsAtInfinity p = Nothing
+    | otherwise           = Just $
+        withNewScalarFreeze $ \d    ->
+        withPoint p         $ \px _ ->
+            ccryptonite_p256_mod ccryptonite_SECP256r1_n (castPtr px) (castPtr d)
+
 -- | Convert a point to (x,y) Integers
 pointToIntegers :: Point -> (Integer, Integer)
 pointToIntegers p = unsafeDoIO $ withPoint p $ \px py ->
@@ -216,6 +235,10 @@ scalarGenerate = unwrap . scalarFromBinary . witness <$> getRandomBytes 32
 scalarZero :: Scalar
 scalarZero = withNewScalarFreeze $ \d -> ccryptonite_p256_init d
 
+-- | The scalar representing the curve order
+scalarN :: Scalar
+scalarN = throwCryptoError (scalarFromInteger order)
+
 -- | Check if the scalar is 0
 scalarIsZero :: Scalar -> Bool
 scalarIsZero s = unsafeDoIO $ withScalar s $ \d -> do
@@ -256,6 +279,14 @@ scalarInv a =
     withNewScalarFreeze $ \b -> withScalar a $ \pa ->
         ccryptonite_p256_modinv_vartime ccryptonite_SECP256r1_n pa b
 
+-- | Give the inverse of the scalar using safe exponentiation
+--
+-- > 1 / a
+scalarInvSafe :: Scalar -> Scalar
+scalarInvSafe a =
+    withNewScalarFreeze $ \b -> withScalar a $ \pa ->
+        ccryptonite_p256e_scalar_invert pa b
+
 -- | Compare 2 Scalar
 scalarCmp :: Scalar -> Scalar -> Ordering
 scalarCmp a b = unsafeDoIO $
@@ -359,6 +390,8 @@ foreign import ccall "cryptonite_p256_mod"
     ccryptonite_p256_mod :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO ()
 foreign import ccall "cryptonite_p256_modmul"
     ccryptonite_p256_modmul :: Ptr P256Scalar -> Ptr P256Scalar -> P256Digit -> Ptr P256Scalar -> Ptr P256Scalar -> IO ()
+foreign import ccall "cryptonite_p256e_scalar_invert"
+    ccryptonite_p256e_scalar_invert :: Ptr P256Scalar -> Ptr P256Scalar -> IO ()
 --foreign import ccall "cryptonite_p256_modinv"
 --    ccryptonite_p256_modinv :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO ()
 foreign import ccall "cryptonite_p256_modinv_vartime"

Crypto/PubKey/ECDSA.hs

@@ -0,0 +1,272 @@
+-- |
+-- Module      : Crypto.PubKey.ECDSA
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- Elliptic Curve Digital Signature Algorithm, with the parameterized
+-- curve implementations provided by module "Crypto.ECC".
+--
+-- Public/private key pairs can be generated using
+-- 'curveGenerateKeyPair' or decoded from binary.
+--
+-- /WARNING:/ Only curve P-256 has constant-time implementation.
+-- Signature operations with P-384 and P-521 may leak the private key.
+--
+-- Signature verification should be safe for all curves.
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Crypto.PubKey.ECDSA
+    ( EllipticCurveECDSA (..)
+    -- * Public keys
+    , PublicKey
+    , encodePublic
+    , decodePublic
+    , toPublic
+    -- * Private keys
+    , PrivateKey
+    , encodePrivate
+    , decodePrivate
+    -- * Signatures
+    , Signature(..)
+    , signatureFromIntegers
+    , signatureToIntegers
+    -- * Generation and verification
+    , signWith
+    , signDigestWith
+    , sign
+    , signDigest
+    , verify
+    , verifyDigest
+    ) where
+
+import           Control.Monad
+
+import           Crypto.ECC
+import qualified Crypto.ECC.Simple.Types as Simple
+import           Crypto.Error
+import           Crypto.Hash
+import           Crypto.Hash.Types
+import           Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess)
+import           Crypto.Internal.Imports
+import           Crypto.Number.ModArithmetic (inverseFermat)
+import qualified Crypto.PubKey.ECC.P256 as P256
+import           Crypto.Random.Types
+
+import           Data.Bits
+import qualified Data.ByteArray as B
+import           Data.Data
+
+import           Foreign.Ptr (Ptr)
+import           Foreign.Storable (peekByteOff, pokeByteOff)
+
+-- | Represent a ECDSA signature namely R and S.
+data Signature curve = Signature
+    { sign_r :: Scalar curve -- ^ ECDSA r
+    , sign_s :: Scalar curve -- ^ ECDSA s
+    }
+
+deriving instance Eq (Scalar curve) => Eq (Signature curve)
+deriving instance Show (Scalar curve) => Show (Signature curve)
+
+instance NFData (Scalar curve) => NFData (Signature curve) where
+    rnf (Signature r s) = rnf r `seq` rnf s `seq` ()
+
+-- | ECDSA Public Key.
+type PublicKey curve = Point curve
+
+-- | ECDSA Private Key.
+type PrivateKey curve = Scalar curve
+
+-- | Elliptic curves with ECDSA capabilities.
+class EllipticCurveBasepointArith curve => EllipticCurveECDSA curve where
+    -- | Is a scalar in the accepted range for ECDSA
+    scalarIsValid :: proxy curve -> Scalar curve -> Bool
+
+    -- | Test whether the scalar is zero
+    scalarIsZero :: proxy curve -> Scalar curve -> Bool
+    scalarIsZero prx s = s == throwCryptoError (scalarFromInteger prx 0)
+
+    -- | Scalar inversion modulo the curve order
+    scalarInv :: proxy curve -> Scalar curve -> Maybe (Scalar curve)
+
+    -- | Return the point X coordinate as a scalar
+    pointX :: proxy curve -> Point curve -> Maybe (Scalar curve)
+
+instance EllipticCurveECDSA Curve_P256R1 where
+    scalarIsValid _ s = not (P256.scalarIsZero s)
+                            && P256.scalarCmp s P256.scalarN == LT
+
+    scalarIsZero _ = P256.scalarIsZero
+
+    scalarInv _ s = let inv = P256.scalarInvSafe s
+                     in if P256.scalarIsZero inv then Nothing else Just inv
+
+    pointX _  = P256.pointX
+
+instance EllipticCurveECDSA Curve_P384R1 where
+    scalarIsValid _ = ecScalarIsValid (Proxy :: Proxy Simple.SEC_p384r1)
+
+    scalarIsZero _ = ecScalarIsZero
+
+    scalarInv _ = ecScalarInv (Proxy :: Proxy Simple.SEC_p384r1)
+
+    pointX _  = ecPointX (Proxy :: Proxy Simple.SEC_p384r1)
+
+instance EllipticCurveECDSA Curve_P521R1 where
+    scalarIsValid _ = ecScalarIsValid (Proxy :: Proxy Simple.SEC_p521r1)
+
+    scalarIsZero _ = ecScalarIsZero
+
+    scalarInv _ = ecScalarInv (Proxy :: Proxy Simple.SEC_p521r1)
+
+    pointX _  = ecPointX (Proxy :: Proxy Simple.SEC_p521r1)
+
+
+-- | Create a signature from integers (R, S).
+signatureFromIntegers :: EllipticCurveECDSA curve
+                      => proxy curve -> (Integer, Integer) -> CryptoFailable (Signature curve)
+signatureFromIntegers prx (r, s) =
+    liftA2 Signature (scalarFromInteger prx r) (scalarFromInteger prx s)
+
+-- | Get integers (R, S) from a signature.
+--
+-- The values can then be used to encode the signature to binary with
+-- ASN.1.
+signatureToIntegers :: EllipticCurveECDSA curve
+                    => proxy curve -> Signature curve -> (Integer, Integer)
+signatureToIntegers prx sig =
+    (scalarToInteger prx $ sign_r sig, scalarToInteger prx $ sign_s sig)
+
+-- | Encode a public key into binary form, i.e. the uncompressed encoding
+-- referenced from <https://tools.ietf.org/html/rfc5480 RFC 5480> section 2.2.
+encodePublic :: (EllipticCurve curve, ByteArray bs)
+             => proxy curve -> PublicKey curve -> bs
+encodePublic = encodePoint
+
+-- | Try to decode the binary form of a public key.
+decodePublic :: (EllipticCurve curve, ByteArray bs)
+             => proxy curve -> bs -> CryptoFailable (PublicKey curve)
+decodePublic = decodePoint
+
+-- | Encode a private key into binary form, i.e. the @privateKey@ field
+-- described in <https://tools.ietf.org/html/rfc5915 RFC 5915>.
+encodePrivate :: (EllipticCurveECDSA curve, ByteArray bs)
+              => proxy curve -> PrivateKey curve -> bs
+encodePrivate = encodeScalar
+
+-- | Try to decode the binary form of a private key.
+decodePrivate :: (EllipticCurveECDSA curve, ByteArray bs)
+              => proxy curve -> bs -> CryptoFailable (PrivateKey curve)
+decodePrivate = decodeScalar
+
+-- | Create a public key from a private key.
+toPublic :: EllipticCurveECDSA curve
+         => proxy curve -> PrivateKey curve -> PublicKey curve
+toPublic = pointBaseSmul
+
+-- | Sign digest using the private key and an explicit k scalar.
+signDigestWith :: (EllipticCurveECDSA curve, HashAlgorithm hash)
+               => proxy curve -> Scalar curve -> PrivateKey curve -> Digest hash -> Maybe (Signature curve)
+signDigestWith prx k d digest = do
+    let z = tHashDigest prx digest
+        point = pointBaseSmul prx k
+    r <- pointX prx point
+    kInv <- scalarInv prx k
+    let s = scalarMul prx kInv (scalarAdd prx z (scalarMul prx r d))
+    when (scalarIsZero prx r || scalarIsZero prx s) Nothing
+    return $ Signature r s
+
+-- | Sign message using the private key and an explicit k scalar.
+signWith :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash)
+         => proxy curve -> Scalar curve -> PrivateKey curve -> hash -> msg -> Maybe (Signature curve)
+signWith prx k d hashAlg msg = signDigestWith prx k d (hashWith hashAlg msg)
+
+-- | Sign a digest using hash and private key.
+signDigest :: (EllipticCurveECDSA curve, MonadRandom m, HashAlgorithm hash)
+           => proxy curve -> PrivateKey curve -> Digest hash -> m (Signature curve)
+signDigest prx pk digest = do
+    k <- curveGenerateScalar prx
+    case signDigestWith prx k pk digest of
+        Nothing  -> signDigest prx pk digest
+        Just sig -> return sig
+
+-- | Sign a message using hash and private key.
+sign :: (EllipticCurveECDSA curve, MonadRandom m, ByteArrayAccess msg, HashAlgorithm hash)
+     => proxy curve -> PrivateKey curve -> hash -> msg -> m (Signature curve)
+sign prx pk hashAlg msg = signDigest prx pk (hashWith hashAlg msg)
+
+-- | Verify a digest using hash and public key.
+verifyDigest :: (EllipticCurveECDSA curve, HashAlgorithm hash)
+       => proxy curve -> PublicKey curve -> Signature curve -> Digest hash -> Bool
+verifyDigest prx q (Signature r s) digest
+    | not (scalarIsValid prx r) = False
+    | not (scalarIsValid prx s) = False
+    | otherwise = maybe False (r ==) $ do
+        w <- scalarInv prx s
+        let z  = tHashDigest prx digest
+            u1 = scalarMul prx z w
+            u2 = scalarMul prx r w
+            x  = pointsSmulVarTime prx u1 u2 q
+        pointX prx x
+    -- Note: precondition q /= PointO is not tested because we assume
+    -- point decoding never decodes point at infinity.
+
+-- | Verify a signature using hash and public key.
+verify :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash)
+       => proxy curve -> hash -> PublicKey curve -> Signature curve -> msg -> Bool
+verify prx hashAlg q sig msg = verifyDigest prx q sig (hashWith hashAlg msg)
+
+-- | Truncate a digest based on curve order size.
+tHashDigest :: (EllipticCurveECDSA curve, HashAlgorithm hash)
+            => proxy curve -> Digest hash -> Scalar curve
+tHashDigest prx (Digest digest) = throwCryptoError $ decodeScalar prx encoded
+  where m      = curveOrderBits prx
+        d      = m - B.length digest * 8
+        (n, r) = m `divMod` 8
+        n'     = if r > 0 then succ n else n
+
+        encoded
+            | d >  0    = B.zero (n' - B.length digest) `B.append` digest
+            | d == 0    = digest
+            | r == 0    = B.take n digest
+            | otherwise = shiftBytes digest
+
+        shiftBytes bs = B.allocAndFreeze n' $ \dst ->
+            B.withByteArray bs $ \src -> go dst src 0 0
+
+        go :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> IO ()
+        go dst src !a i
+            | i >= n'   = return ()
+            | otherwise = do
+                b <- peekByteOff src i
+                pokeByteOff dst i (unsafeShiftR b (8 - r) .|. unsafeShiftL a r)
+                go dst src b (succ i)
+
+
+ecScalarIsValid :: Simple.Curve c => proxy c -> Simple.Scalar c -> Bool
+ecScalarIsValid prx (Simple.Scalar s) = s > 0 && s < n
+  where n = Simple.curveEccN $ Simple.curveParameters prx
+
+ecScalarIsZero :: forall curve . Simple.Curve curve
+               => Simple.Scalar curve -> Bool
+ecScalarIsZero (Simple.Scalar a) = a == 0
+
+ecScalarInv :: Simple.Curve c
+            => proxy c -> Simple.Scalar c -> Maybe (Simple.Scalar c)
+ecScalarInv prx (Simple.Scalar s)
+    | i == 0    = Nothing
+    | otherwise = Just $ Simple.Scalar i
+  where n = Simple.curveEccN $ Simple.curveParameters prx
+        i = inverseFermat s n
+
+ecPointX :: Simple.Curve c
+         => proxy c -> Simple.Point c -> Maybe (Simple.Scalar c)
+ecPointX _   Simple.PointO      = Nothing
+ecPointX prx (Simple.Point x _) = Just (Simple.Scalar $ x `mod` n)
+  where n = Simple.curveEccN $ Simple.curveParameters prx

QA.hs

@@ -47,6 +47,7 @@ perModuleAllowedExtensions =
     , ("Crypto/Cipher/DES/Primitive.hs", [FlexibleInstances])
     , ("Crypto/Cipher/Twofish/Primitive.hs", [MagicHash])
     , ("Crypto/PubKey/Curve25519.hs", [MagicHash])
+    , ("Crypto/PubKey/ECDSA.hs", [FlexibleContexts,StandaloneDeriving,UndecidableInstances])
     , ("Crypto/Number/Compat.hs", [UnboxedTuples,MagicHash,CPP])
     , ("Crypto/System/CPU.hs", [CPP])
     ]

benchs/Bench.hs

@@ -23,6 +23,7 @@ import           Crypto.Number.Generate
 import qualified Crypto.PubKey.DH as DH
 import qualified Crypto.PubKey.ECC.Types as ECC
 import qualified Crypto.PubKey.ECC.Prim as ECC
+import qualified Crypto.PubKey.ECDSA as ECDSA
 import           Crypto.Random
 
 import           Control.DeepSeq (NFData)
@@ -286,6 +287,44 @@ benchECDH = map doECDHBench curves
              , ("X448",   CurveDH Curve_X448)
              ]
 
+data CurveHashECDSA =
+    forall curve hashAlg . (ECDSA.EllipticCurveECDSA curve,
+                            NFData (Scalar curve),
+                            NFData (Point curve),
+                            HashAlgorithm hashAlg) => CurveHashECDSA curve hashAlg
+
+benchECDSA = map doECDSABench curveHashes
+  where
+    doECDSABench (name, CurveHashECDSA c hashAlg) =
+        let proxy = Just c -- using Maybe as Proxy
+         in bgroup name
+                [ env (signGenerate proxy) $ bench "sign" . nfIO . signRun proxy hashAlg
+                , env (verifyGenerate proxy hashAlg) $ bench "verify" . nf (verifyRun proxy hashAlg)
+                ]
+
+    signGenerate proxy = do
+        m <- tenKB
+        s <- curveGenerateScalar proxy
+        return (s, m)
+
+    signRun proxy hashAlg (priv, msg) = ECDSA.sign proxy priv hashAlg msg
+
+    verifyGenerate proxy hashAlg = do
+        m <- tenKB
+        KeyPair p s <- curveGenerateKeyPair proxy
+        sig <- ECDSA.sign proxy s hashAlg m
+        return (p, sig, m)
+
+    verifyRun proxy hashAlg (pub, sig, msg) = ECDSA.verify proxy hashAlg pub sig msg
+
+    tenKB :: IO Bytes
+    tenKB = getRandomBytes 10240
+
+    curveHashes = [ ("secp256r1_sha256", CurveHashECDSA Curve_P256R1 SHA256)
+                  , ("secp384r1_sha384", CurveHashECDSA Curve_P384R1 SHA384)
+                  , ("secp521r1_sha512", CurveHashECDSA Curve_P521R1 SHA512)
+                  ]
+
 main = defaultMain
     [ bgroup "hash" benchHash
     , bgroup "block-cipher" benchBlockCipher
@@ -298,5 +337,6 @@ main = defaultMain
           [ bgroup "FFDH" benchFFDH
           , bgroup "ECDH" benchECDH
           ]
+    , bgroup "ECDSA" benchECDSA
     , bgroup "F2m" benchF2m
     ]

cbits/p256/p256.c

@@ -408,3 +408,114 @@ void cryptonite_p256e_modsub(const cryptonite_p256_int* MOD, const cryptonite_p2
   top = subM(MOD, top, P256_DIGITS(c), MSB_COMPLEMENT(top));
   addM(MOD, 0, P256_DIGITS(c), top);
 }
+
+// n' such as n * n' = -1 mod (2^32)
+#define MONTGOMERY_FACTOR 0xEE00BC4F
+
+#define NTH_DOUBLE_THEN_ADD(i, a, nth, b, out)   \
+    cryptonite_p256e_montmul(a, a, out);         \
+    for (i = 1; i < nth; i++)                    \
+        cryptonite_p256e_montmul(out, out, out); \
+    cryptonite_p256e_montmul(out, b, out);
+
+const cryptonite_p256_int cryptonite_SECP256r1_r2 = // r^2 mod n
+  {{0xBE79EEA2, 0x83244C95, 0x49BD6FA6, 0x4699799C,
+    0x2B6BEC59, 0x2845B239, 0xF3D95620, 0x66E12D94}};
+
+const cryptonite_p256_int cryptonite_SECP256r1_one = {{1}};
+
+// Montgomery multiplication, i.e. c = ab/r mod n with r = 2^256.
+// Implementation is adapted from 'sc_montmul' in libdecaf.
+static void cryptonite_p256e_montmul(const cryptonite_p256_int* a, const cryptonite_p256_int* b, cryptonite_p256_int* c) {
+  int i, j, borrow;
+  cryptonite_p256_digit accum[P256_NDIGITS+1] = {0};
+  cryptonite_p256_digit hi_carry = 0;
+
+  for (i=0; i<P256_NDIGITS; i++) {
+    cryptonite_p256_digit mand = P256_DIGIT(a, i);
+    const cryptonite_p256_digit *mier = P256_DIGITS(b);
+
+    cryptonite_p256_ddigit chain = 0;
+    for (j=0; j<P256_NDIGITS; j++) {
+      chain += ((cryptonite_p256_ddigit)mand)*mier[j] + accum[j];
+      accum[j] = chain;
+      chain >>= P256_BITSPERDIGIT;
+    }
+    accum[j] = chain;
+
+    mand = accum[0] * MONTGOMERY_FACTOR;
+    chain = 0;
+    mier = P256_DIGITS(&cryptonite_SECP256r1_n);
+    for (j=0; j<P256_NDIGITS; j++) {
+      chain += (cryptonite_p256_ddigit)mand*mier[j] + accum[j];
+      if (j) accum[j-1] = chain;
+      chain >>= P256_BITSPERDIGIT;
+    }
+    chain += accum[j];
+    chain += hi_carry;
+    accum[j-1] = chain;
+    hi_carry = chain >> P256_BITSPERDIGIT;
+  }
+
+  memcpy(P256_DIGITS(c), accum, sizeof(*c));
+  borrow = cryptonite_p256_sub(c, &cryptonite_SECP256r1_n, c);
+  addM(&cryptonite_SECP256r1_n, 0, P256_DIGITS(c), borrow + hi_carry);
+}
+
+// b = 1/a mod n, using Fermat's little theorem.
+void cryptonite_p256e_scalar_invert(const cryptonite_p256_int* a, cryptonite_p256_int* b) {
+  cryptonite_p256_int _1, _10, _11, _101, _111, _1010, _1111;
+  cryptonite_p256_int _10101, _101010, _101111, x6, x8, x16, x32;
+  int i;
+
+  // Montgomerize
+  cryptonite_p256e_montmul(a, &cryptonite_SECP256r1_r2, &_1);
+
+  // P-256 (secp256r1) Scalar Inversion
+  // <https://briansmith.org/ecc-inversion-addition-chains-01>
+  cryptonite_p256e_montmul(&_1     , &_1     , &_10);
+  cryptonite_p256e_montmul(&_10    , &_1     , &_11);
+  cryptonite_p256e_montmul(&_10    , &_11    , &_101);
+  cryptonite_p256e_montmul(&_10    , &_101   , &_111);
+  cryptonite_p256e_montmul(&_101   , &_101   , &_1010);
+  cryptonite_p256e_montmul(&_101   , &_1010  , &_1111);
+  NTH_DOUBLE_THEN_ADD(i, &_1010,  1   , &_1     , &_10101);
+  cryptonite_p256e_montmul(&_10101 , &_10101 , &_101010);
+  cryptonite_p256e_montmul(&_101   , &_101010, &_101111);
+  cryptonite_p256e_montmul(&_10101 , &_101010, &x6);
+  NTH_DOUBLE_THEN_ADD(i, &x6   ,  2   , &_11    , &x8);
+  NTH_DOUBLE_THEN_ADD(i, &x8   ,  8   , &x8     , &x16);
+  NTH_DOUBLE_THEN_ADD(i, &x16  , 16   , &x16    , &x32);
+
+  NTH_DOUBLE_THEN_ADD(i, &x32  , 32+32, &x32    , b);
+  NTH_DOUBLE_THEN_ADD(i, b     ,    32, &x32    , b);
+  NTH_DOUBLE_THEN_ADD(i, b     ,     6, &_101111, b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 2 + 3, &_111   , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 2 + 2, &_11    , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 1 + 4, &_1111  , b);
+  NTH_DOUBLE_THEN_ADD(i, b     ,     5, &_10101 , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 1 + 3, &_101   , b);
+  NTH_DOUBLE_THEN_ADD(i, b     ,     3, &_101   , b);
+  NTH_DOUBLE_THEN_ADD(i, b     ,     3, &_101   , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 2 + 3, &_111   , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 3 + 6, &_101111, b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 2 + 4, &_1111  , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 1 + 1, &_1     , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 4 + 1, &_1     , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 2 + 4, &_1111  , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 2 + 3, &_111   , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 1 + 3, &_111   , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 2 + 3, &_111   , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 2 + 3, &_101   , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 1 + 2, &_11    , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 4 + 6, &_101111, b);
+  NTH_DOUBLE_THEN_ADD(i, b     ,     2, &_11    , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 3 + 2, &_11    , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 3 + 2, &_11    , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 2 + 1, &_1     , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 2 + 5, &_10101 , b);
+  NTH_DOUBLE_THEN_ADD(i, b     , 2 + 4, &_1111  , b);
+
+  // Demontgomerize
+  cryptonite_p256e_montmul(b, &cryptonite_SECP256r1_one, b);
+}

cryptonite.cabal

@@ -159,6 +159,7 @@ Library
                      Crypto.PubKey.ECC.ECDSA
                      Crypto.PubKey.ECC.P256
                      Crypto.PubKey.ECC.Types
+                     Crypto.PubKey.ECDSA
                      Crypto.PubKey.ECIES
                      Crypto.PubKey.Ed25519
                      Crypto.PubKey.Ed448
@@ -387,6 +388,7 @@ Test-Suite test-cryptonite
                      BCryptPBKDF
                      ECC
                      ECC.Edwards25519
+                     ECDSA
                      Hash
                      Imports
                      KAT_AES.KATCBC

tests/ECDSA.hs

@@ -0,0 +1,61 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
+module ECDSA (tests) where
+
+import qualified Crypto.ECC as ECDSA
+import qualified Crypto.PubKey.ECC.ECDSA as ECC
+import qualified Crypto.PubKey.ECC.Types as ECC
+import qualified Crypto.PubKey.ECDSA as ECDSA
+import Crypto.Hash.Algorithms
+import Crypto.Error
+import qualified Data.ByteString as B
+
+import Imports
+
+data Curve = forall curve. (ECDSA.EllipticCurveECDSA curve, Show (ECDSA.Scalar curve)) => Curve curve ECC.Curve ECC.CurveName
+
+instance Show Curve where
+    showsPrec d (Curve _ _ name) = showsPrec d name
+
+instance Arbitrary Curve where
+    arbitrary = elements
+        [ makeCurve ECDSA.Curve_P256R1 ECC.SEC_p256r1
+        , makeCurve ECDSA.Curve_P384R1 ECC.SEC_p384r1
+        , makeCurve ECDSA.Curve_P521R1 ECC.SEC_p521r1
+        ]
+      where
+        makeCurve c name = Curve c (ECC.getCurveByName name) name
+
+arbitraryScalar curve = choose (1, n - 1)
+  where n = ECC.ecc_n (ECC.common_curve curve)
+
+sigECCToECDSA :: ECDSA.EllipticCurveECDSA curve
+              => proxy curve -> ECC.Signature -> ECDSA.Signature curve
+sigECCToECDSA prx (ECC.Signature r s) =
+    ECDSA.Signature (throwCryptoError $ ECDSA.scalarFromInteger prx r)
+                    (throwCryptoError $ ECDSA.scalarFromInteger prx s)
+
+tests = localOption (QuickCheckTests 5) $ testGroup "ECDSA"
+    [ testProperty "SHA1"   $ propertyECDSA SHA1
+    , testProperty "SHA224" $ propertyECDSA SHA224
+    , testProperty "SHA256" $ propertyECDSA SHA256
+    , testProperty "SHA384" $ propertyECDSA SHA384
+    , testProperty "SHA512" $ propertyECDSA SHA512
+    ]
+  where
+    propertyECDSA hashAlg (Curve c curve _) (ArbitraryBS0_2901 msg) = do
+        d    <- arbitraryScalar curve
+        kECC <- arbitraryScalar curve
+        let privECC   = ECC.PrivateKey curve d
+            prx       = Just c -- using Maybe as Proxy
+            kECDSA    = throwCryptoError $ ECDSA.scalarFromInteger prx kECC
+            privECDSA = throwCryptoError $ ECDSA.scalarFromInteger prx d
+            pubECDSA  = ECDSA.toPublic prx privECDSA
+            Just sigECC   = ECC.signWith kECC privECC hashAlg msg
+            Just sigECDSA = ECDSA.signWith prx kECDSA privECDSA hashAlg msg
+            sigECDSA' = sigECCToECDSA prx sigECC
+            msg' = msg `B.append` B.singleton 42
+        return $ propertyHold [ eqTest "signature" sigECDSA sigECDSA'
+                              , eqTest "verification" True (ECDSA.verify prx hashAlg pubECDSA sigECDSA' msg)
+                              , eqTest "alteration"  False (ECDSA.verify prx hashAlg pubECDSA sigECDSA msg')
+                              ]

tests/KAT_PubKey/P256.hs

@@ -102,7 +102,21 @@ tests = testGroup "P256"
         , testProperty "inv" $ \r' ->
             let inv  = inverseCoprimes (unP256 r') curveN
                 inv' = P256.scalarInv (unP256Scalar r')
-             in if unP256 r' == 0 then True else inv `propertyEq` p256ScalarToInteger inv'
+             in unP256 r' /= 0 ==> inv `propertyEq` p256ScalarToInteger inv'
+        , testProperty "inv-safe" $ \r' ->
+            let inv  = P256.scalarInv (unP256Scalar r')
+                inv' = P256.scalarInvSafe (unP256Scalar r')
+             in unP256 r' /= 0 ==> inv `propertyEq` inv'
+        , testProperty "inv-safe-mul" $ \r' ->
+            let inv = P256.scalarInvSafe (unP256Scalar r')
+                res = P256.scalarMul (unP256Scalar r') inv
+             in unP256 r' /= 0 ==> 1 `propertyEq` p256ScalarToInteger res
+        , testProperty "inv-safe-zero" $
+            let inv0 = P256.scalarInvSafe P256.scalarZero
+                invN = P256.scalarInvSafe P256.scalarN
+             in propertyHold [ eqTest "scalarZero" P256.scalarZero inv0
+                             , eqTest "scalarN"    P256.scalarZero invN
+                             ]
         ]
     , testGroup "point"
         [ testProperty "marshalling" $ \rx ry ->
@@ -126,6 +140,12 @@ tests = testGroup "P256"
         , testProperty "point-add" propertyPointAdd
         , testProperty "point-negate" propertyPointNegate
         , testProperty "point-mul" propertyPointMul
+        , testProperty "infinity" $
+            let gN = P256.toPoint P256.scalarN
+                g1 = P256.pointBase
+             in propertyHold [ eqTest "zero" True  (P256.pointIsAtInfinity gN)
+                             , eqTest "base" False (P256.pointIsAtInfinity g1)
+                             ]
         ]
     ]
   where

tests/Tests.hs

@@ -11,6 +11,7 @@ import qualified BCrypt
 import qualified BCryptPBKDF
 import qualified ECC
 import qualified ECC.Edwards25519
+import qualified ECDSA
 import qualified Hash
 import qualified Poly1305
 import qualified Salsa
@@ -96,6 +97,7 @@ tests = testGroup "cryptonite"
     , KAT_AFIS.tests
     , ECC.tests
     , ECC.Edwards25519.tests
+    , ECDSA.tests
     ]
 
 main = defaultMain tests