From 1cb2cd2f12e1565d744fc1f4e28df7bf7b80c83b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 8 Feb 2020 11:17:10 +0100 Subject: [PATCH] Ability to select the hash algorithm --- Crypto/PubKey/EdDSA.hs | 138 +++++++++++++++++++++++++++-------------- benchs/Bench.hs | 18 +++--- 2 files changed, 102 insertions(+), 54 deletions(-) diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs index 95e187b..eeffa7b 100644 --- a/Crypto/PubKey/EdDSA.hs +++ b/Crypto/PubKey/EdDSA.hs @@ -19,7 +19,10 @@ module Crypto.PubKey.EdDSA , PublicKey , Signature -- * Curves with EdDSA implementation - , EllipticCurveEdDSA(publicKeySize, secretKeySize, signatureSize) + , EllipticCurveEdDSA(CurveDigestSize) + , publicKeySize + , secretKeySize + , signatureSize -- * Smart constructors , signature , publicKey @@ -34,16 +37,19 @@ module Crypto.PubKey.EdDSA import Data.Bits import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes) import qualified Data.ByteArray as B +import Data.Proxy import Crypto.ECC import qualified Crypto.ECC.Edwards25519 as Edwards25519 import Crypto.Error -import Crypto.Hash.Algorithms import Crypto.Hash.IO import Crypto.Random +import GHC.TypeLits (KnownNat, Nat) + import Crypto.Internal.Compat import Crypto.Internal.Imports +import Crypto.Internal.Nat (integralNatVal) import Foreign.Storable @@ -55,49 +61,63 @@ newtype SecretKey curve = SecretKey ScrubbedBytes deriving (Show,Eq,ByteArrayAccess,NFData) -- | An EdDSA public key -newtype PublicKey curve = PublicKey Bytes +newtype PublicKey curve hash = PublicKey Bytes deriving (Show,Eq,ByteArrayAccess,NFData) -- | An EdDSA signature -newtype Signature curve = Signature Bytes +newtype Signature curve hash = Signature Bytes deriving (Show,Eq,ByteArrayAccess,NFData) -- | Elliptic curves with an implementation of EdDSA class ( EllipticCurveBasepointArith curve - , HashAlgorithm (HashAlg curve) + , KnownNat (CurveDigestSize curve) ) => EllipticCurveEdDSA curve where - -- | Size of public keys for this curve (in bytes) - publicKeySize :: proxy curve -> Int + -- | Size of the digest for this curve (in bytes) + type CurveDigestSize curve :: Nat -- | Size of secret keys for this curve (in bytes) secretKeySize :: proxy curve -> Int - -- | Size of signatures for this curve (in bytes) - signatureSize :: proxy curve -> Int - -- hash with a given prefix - type HashAlg curve :: * - hashWithDom :: ByteArrayAccess msg => proxy curve -> [Bytes] -> msg -> Bytes + hashWithDom :: (HashAlgorithm hash, ByteArrayAccess msg) + => proxy curve -> hash -> [Bytes] -> msg -> Bytes -- conversion between scalar, point and public key - pointPublic :: proxy curve -> Point curve -> PublicKey curve - publicPoint :: proxy curve -> PublicKey curve -> CryptoFailable (Point curve) + pointPublic :: proxy curve -> Point curve -> PublicKey curve hash + publicPoint :: proxy curve -> PublicKey curve hash -> CryptoFailable (Point curve) encodeScalarLE :: ByteArray bs => proxy curve -> Scalar curve -> bs decodeScalarLE :: ByteArrayAccess bs => proxy curve -> bs -> CryptoFailable (Scalar curve) -- how to use bits in a secret key - scheduleSecret :: proxy curve + scheduleSecret :: ( HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + ) + => proxy curve + -> hash -> SecretKey curve -> (Scalar curve, Bytes) +-- | Size of public keys for this curve (in bytes) +publicKeySize :: EllipticCurveEdDSA curve => proxy curve -> Int +publicKeySize prx = signatureSize prx `div` 2 + +-- | Size of signatures for this curve (in bytes) +signatureSize :: forall proxy curve . EllipticCurveEdDSA curve + => proxy curve -> Int +signatureSize _ = integralNatVal (Proxy :: Proxy (CurveDigestSize curve)) + -- Constructors -- | Try to build a public key from a bytearray -publicKey :: (EllipticCurveEdDSA curve, ByteArrayAccess ba) - => proxy curve -> ba -> CryptoFailable (PublicKey curve) -publicKey prx bs +publicKey :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ba + ) + => proxy curve -> hash -> ba -> CryptoFailable (PublicKey curve hash) +publicKey prx _ bs | B.length bs == publicKeySize prx = CryptoPassed (PublicKey $ B.convert bs) | otherwise = @@ -113,9 +133,13 @@ secretKey prx bs CryptoFailed CryptoError_SecretKeyStructureInvalid -- | Try to build a signature from a bytearray -signature :: (EllipticCurveEdDSA curve, ByteArrayAccess ba) - => proxy curve -> ba -> CryptoFailable (Signature curve) -signature prx bs +signature :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ba + ) + => proxy curve -> hash -> ba -> CryptoFailable (Signature curve hash) +signature prx _ bs | B.length bs == signatureSize prx = CryptoPassed (Signature $ B.convert bs) | otherwise = @@ -130,25 +154,37 @@ generateSecretKey :: (EllipticCurveEdDSA curve, MonadRandom m) generateSecretKey prx = SecretKey <$> getRandomBytes (secretKeySize prx) -- | Create a public key from a secret key -toPublic :: EllipticCurveEdDSA curve - => proxy curve -> SecretKey curve -> PublicKey curve -toPublic prx priv = - let p = pointBaseSmul prx (secretScalar prx priv) +toPublic :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + ) + => proxy curve -> hash -> SecretKey curve -> PublicKey curve hash +toPublic prx alg priv = + let p = pointBaseSmul prx (secretScalar prx alg priv) in pointPublic prx p -secretScalar :: EllipticCurveEdDSA curve - => proxy curve -> SecretKey curve -> Scalar curve -secretScalar prx priv = fst (scheduleSecret prx priv) +secretScalar :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + ) + => proxy curve -> hash -> SecretKey curve -> Scalar curve +secretScalar prx alg priv = fst (scheduleSecret prx alg priv) -- EdDSA signature generation & verification -- | Sign a message using the key pair -sign :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) - => proxy curve -> SecretKey curve -> PublicKey curve -> msg -> Signature curve +sign :: forall proxy curve hash msg . + ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , ByteArrayAccess msg + , HashDigestSize hash ~ CurveDigestSize curve + ) + => proxy curve -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash sign prx priv pub msg = - let (s, prefix) = scheduleSecret prx priv - digR = hashWithDom prx [prefix] msg + let alg = undefined :: hash + (s, prefix) = scheduleSecret prx alg priv + digR = hashWithDom prx alg [prefix] msg r = decodeScalarNoErr prx digR pR = pointBaseSmul prx r bsR = encodePoint prx pR @@ -157,8 +193,12 @@ sign prx priv pub msg = in encodeSignature prx (bsR, pR, sS) -- | Verify a message -verify :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) - => proxy curve -> PublicKey curve -> msg -> Signature curve -> Bool +verify :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess msg + ) + => proxy curve -> PublicKey curve hash -> msg -> Signature curve hash -> Bool verify prx pub msg sig = case doVerify of CryptoPassed verified -> verified @@ -171,16 +211,22 @@ verify prx pub msg sig = pR' = pointsSmulVarTime prx sS sK nPub return (pR == pR') -getK :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) - => proxy curve -> PublicKey curve -> Bytes -> msg -> Scalar curve +getK :: forall proxy curve hash msg . + ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess msg + ) + => proxy curve -> PublicKey curve hash -> Bytes -> msg -> Scalar curve getK prx (PublicKey pub) bsR msg = - let digK = hashWithDom prx [bsR, pub] msg + let alg = undefined :: hash + digK = hashWithDom prx alg [bsR, pub] msg in decodeScalarNoErr prx digK encodeSignature :: EllipticCurveEdDSA curve => proxy curve -> (Bytes, Point curve, Scalar curve) - -> Signature curve + -> Signature curve hash encodeSignature prx (bsR, _, sS) = Signature $ if len0 > 0 then B.concat [ bsR, bsS, pad0 ] else B.append bsR bsS where @@ -188,9 +234,11 @@ encodeSignature prx (bsR, _, sS) = Signature $ len0 = signatureSize prx - B.length bsR - B.length bsS pad0 = B.zero len0 -decodeSignature :: EllipticCurveEdDSA curve +decodeSignature :: ( EllipticCurveEdDSA curve + , HashDigestSize hash ~ CurveDigestSize curve + ) => proxy curve - -> Signature curve + -> Signature curve hash -> CryptoFailable (Bytes, Point curve, Scalar curve) decodeSignature prx (Signature bs) = do let (bsR, bsS) = B.splitAt (publicKeySize prx) bs @@ -211,22 +259,20 @@ unwrap _ (CryptoPassed x) = x -- Ed25519 implementation instance EllipticCurveEdDSA Curve_Edwards25519 where - publicKeySize _ = 32 + type CurveDigestSize Curve_Edwards25519 = 64 secretKeySize _ = 32 - signatureSize _ = 64 - type HashAlg Curve_Edwards25519 = SHA512 - hashWithDom _ = digestDomMsg SHA512 + hashWithDom _ = digestDomMsg pointPublic _ = PublicKey . Edwards25519.pointEncode publicPoint _ = Edwards25519.pointDecode encodeScalarLE _ = Edwards25519.scalarEncode decodeScalarLE _ = Edwards25519.scalarDecodeLong - scheduleSecret prx priv = + scheduleSecret prx alg priv = (decodeScalarNoErr prx clamped, B.drop 32 hashed) where - hashed = digest SHA512 ($ priv) + hashed = digest alg ($ priv) clamped :: Bytes clamped = B.copyAndFreeze (B.takeView hashed 32) $ \p -> do diff --git a/benchs/Bench.hs b/benchs/Bench.hs index f2a4f2a..5f7dca0 100644 --- a/benchs/Bench.hs +++ b/benchs/Bench.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} module Main where import Gauge.Main @@ -328,25 +329,26 @@ benchECDSA = map doECDSABench curveHashes ] benchEdDSA = - [ bgroup "EdDSA-Ed25519" $ benchGeneric (Just Curve_Edwards25519) - , bgroup "Ed25519" benchEd25519 + [ bgroup "EdDSA-Ed25519" benchGenEd25519 + , bgroup "Ed25519" benchEd25519 ] where - benchGeneric prx = - [ bench "sign" $ perBatchEnv (genEnv prx) (run_gen_sign prx) - , bench "verify" $ perBatchEnv (genEnv prx) (run_gen_verify prx) + benchGen prx alg = + [ bench "sign" $ perBatchEnv (genEnv prx alg) (run_gen_sign prx) + , bench "verify" $ perBatchEnv (genEnv prx alg) (run_gen_verify prx) ] - benchEd25519 = + benchGenEd25519 = benchGen (Just Curve_Edwards25519) SHA512 + benchEd25519 = [ bench "sign" $ perBatchEnv ed25519Env run_ed25519_sign , bench "verify" $ perBatchEnv ed25519Env run_ed25519_verify ] msg = B.empty -- empty message = worst-case scenario showing API overhead - genEnv prx _ = do + genEnv prx alg _ = do sec <- EdDSA.generateSecretKey prx - let pub = EdDSA.toPublic prx sec + let pub = EdDSA.toPublic prx alg sec sig = EdDSA.sign prx sec pub msg return (sec, pub, sig)