haskell/cryptonite
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Ability to select the hash algorithm

Browse Source
This commit is contained in:
Olivier Chéron 2020-02-08 11:17:10 +01:00
parent 436b9abc13
commit 1cb2cd2f12
2 changed files with 102 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

138
Crypto/PubKey/EdDSA.hs
View File

@ -19,7 +19,10 @@ module Crypto.PubKey.EdDSA
, PublicKey , PublicKey
, Signature , Signature
-- * Curves with EdDSA implementation -- * Curves with EdDSA implementation
, EllipticCurveEdDSA(publicKeySize, secretKeySize, signatureSize) , EllipticCurveEdDSA(CurveDigestSize)
, publicKeySize
, secretKeySize
, signatureSize
-- * Smart constructors -- * Smart constructors
, signature , signature
, publicKey , publicKey
@ -34,16 +37,19 @@ module Crypto.PubKey.EdDSA
import Data.Bits import Data.Bits
import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes) import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes)
import qualified Data.ByteArray as B import qualified Data.ByteArray as B
import Data.Proxy
import Crypto.ECC import Crypto.ECC
import qualified Crypto.ECC.Edwards25519 as Edwards25519 import qualified Crypto.ECC.Edwards25519 as Edwards25519
import Crypto.Error import Crypto.Error
import Crypto.Hash.Algorithms
import Crypto.Hash.IO import Crypto.Hash.IO
import Crypto.Random import Crypto.Random
import GHC.TypeLits (KnownNat, Nat)
import Crypto.Internal.Compat import Crypto.Internal.Compat
import Crypto.Internal.Imports import Crypto.Internal.Imports
import Crypto.Internal.Nat (integralNatVal)
import Foreign.Storable import Foreign.Storable
@ -55,49 +61,63 @@ newtype SecretKey curve = SecretKey ScrubbedBytes
deriving (Show,Eq,ByteArrayAccess,NFData) deriving (Show,Eq,ByteArrayAccess,NFData)
-- | An EdDSA public key -- | An EdDSA public key
newtype PublicKey curve = PublicKey Bytes newtype PublicKey curve hash = PublicKey Bytes
deriving (Show,Eq,ByteArrayAccess,NFData) deriving (Show,Eq,ByteArrayAccess,NFData)
-- | An EdDSA signature -- | An EdDSA signature
newtype Signature curve = Signature Bytes newtype Signature curve hash = Signature Bytes
deriving (Show,Eq,ByteArrayAccess,NFData) deriving (Show,Eq,ByteArrayAccess,NFData)
-- | Elliptic curves with an implementation of EdDSA -- | Elliptic curves with an implementation of EdDSA
class ( EllipticCurveBasepointArith curve class ( EllipticCurveBasepointArith curve
, HashAlgorithm (HashAlg curve) , KnownNat (CurveDigestSize curve)
) => EllipticCurveEdDSA curve where ) => EllipticCurveEdDSA curve where
-- | Size of public keys for this curve (in bytes) -- | Size of the digest for this curve (in bytes)
publicKeySize :: proxy curve -> Int type CurveDigestSize curve :: Nat
-- | Size of secret keys for this curve (in bytes) -- | Size of secret keys for this curve (in bytes)
secretKeySize :: proxy curve -> Int secretKeySize :: proxy curve -> Int
-- | Size of signatures for this curve (in bytes)
signatureSize :: proxy curve -> Int
-- hash with a given prefix -- hash with a given prefix
type HashAlg curve :: * hashWithDom :: (HashAlgorithm hash, ByteArrayAccess msg)
hashWithDom :: ByteArrayAccess msg => proxy curve -> [Bytes] -> msg -> Bytes => proxy curve -> hash -> [Bytes] -> msg -> Bytes
-- conversion between scalar, point and public key -- conversion between scalar, point and public key
pointPublic :: proxy curve -> Point curve -> PublicKey curve pointPublic :: proxy curve -> Point curve -> PublicKey curve hash
publicPoint :: proxy curve -> PublicKey curve -> CryptoFailable (Point curve) publicPoint :: proxy curve -> PublicKey curve hash -> CryptoFailable (Point curve)
encodeScalarLE :: ByteArray bs => proxy curve -> Scalar curve -> bs encodeScalarLE :: ByteArray bs => proxy curve -> Scalar curve -> bs
decodeScalarLE :: ByteArrayAccess bs => proxy curve -> bs -> CryptoFailable (Scalar curve) decodeScalarLE :: ByteArrayAccess bs => proxy curve -> bs -> CryptoFailable (Scalar curve)
-- how to use bits in a secret key -- how to use bits in a secret key
scheduleSecret :: proxy curve scheduleSecret :: ( HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
)
=> proxy curve
-> hash
-> SecretKey curve -> SecretKey curve
-> (Scalar curve, Bytes) -> (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 -- Constructors
-- | Try to build a public key from a bytearray -- | Try to build a public key from a bytearray
publicKey :: (EllipticCurveEdDSA curve, ByteArrayAccess ba) publicKey :: ( EllipticCurveEdDSA curve
=> proxy curve -> ba -> CryptoFailable (PublicKey curve) , HashAlgorithm hash
publicKey prx bs , HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ba
)
=> proxy curve -> hash -> ba -> CryptoFailable (PublicKey curve hash)
publicKey prx _ bs
| B.length bs == publicKeySize prx = | B.length bs == publicKeySize prx =
CryptoPassed (PublicKey $ B.convert bs) CryptoPassed (PublicKey $ B.convert bs)
| otherwise = | otherwise =
@ -113,9 +133,13 @@ secretKey prx bs
CryptoFailed CryptoError_SecretKeyStructureInvalid CryptoFailed CryptoError_SecretKeyStructureInvalid
-- | Try to build a signature from a bytearray -- | Try to build a signature from a bytearray
signature :: (EllipticCurveEdDSA curve, ByteArrayAccess ba) signature :: ( EllipticCurveEdDSA curve
=> proxy curve -> ba -> CryptoFailable (Signature curve) , HashAlgorithm hash
signature prx bs , HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess ba
)
=> proxy curve -> hash -> ba -> CryptoFailable (Signature curve hash)
signature prx _ bs
| B.length bs == signatureSize prx = | B.length bs == signatureSize prx =
CryptoPassed (Signature $ B.convert bs) CryptoPassed (Signature $ B.convert bs)
| otherwise = | otherwise =
@ -130,25 +154,37 @@ generateSecretKey :: (EllipticCurveEdDSA curve, MonadRandom m)
generateSecretKey prx = SecretKey <$> getRandomBytes (secretKeySize prx) generateSecretKey prx = SecretKey <$> getRandomBytes (secretKeySize prx)
-- | Create a public key from a secret key -- | Create a public key from a secret key
toPublic :: EllipticCurveEdDSA curve toPublic :: ( EllipticCurveEdDSA curve
=> proxy curve -> SecretKey curve -> PublicKey curve , HashAlgorithm hash
toPublic prx priv = , HashDigestSize hash ~ CurveDigestSize curve
let p = pointBaseSmul prx (secretScalar prx priv) )
=> proxy curve -> hash -> SecretKey curve -> PublicKey curve hash
toPublic prx alg priv =
let p = pointBaseSmul prx (secretScalar prx alg priv)
in pointPublic prx p in pointPublic prx p
secretScalar :: EllipticCurveEdDSA curve secretScalar :: ( EllipticCurveEdDSA curve
=> proxy curve -> SecretKey curve -> Scalar curve , HashAlgorithm hash
secretScalar prx priv = fst (scheduleSecret prx priv) , HashDigestSize hash ~ CurveDigestSize curve
)
=> proxy curve -> hash -> SecretKey curve -> Scalar curve
secretScalar prx alg priv = fst (scheduleSecret prx alg priv)
-- EdDSA signature generation & verification -- EdDSA signature generation & verification
-- | Sign a message using the key pair -- | Sign a message using the key pair
sign :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) sign :: forall proxy curve hash msg .
=> proxy curve -> SecretKey curve -> PublicKey curve -> msg -> Signature curve ( 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 = sign prx priv pub msg =
let (s, prefix) = scheduleSecret prx priv let alg = undefined :: hash
digR = hashWithDom prx [prefix] msg (s, prefix) = scheduleSecret prx alg priv
digR = hashWithDom prx alg [prefix] msg
r = decodeScalarNoErr prx digR r = decodeScalarNoErr prx digR
pR = pointBaseSmul prx r pR = pointBaseSmul prx r
bsR = encodePoint prx pR bsR = encodePoint prx pR
@ -157,8 +193,12 @@ sign prx priv pub msg =
in encodeSignature prx (bsR, pR, sS) in encodeSignature prx (bsR, pR, sS)
-- | Verify a message -- | Verify a message
verify :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) verify :: ( EllipticCurveEdDSA curve
=> proxy curve -> PublicKey curve -> msg -> Signature curve -> Bool , HashAlgorithm hash
, HashDigestSize hash ~ CurveDigestSize curve
, ByteArrayAccess msg
)
=> proxy curve -> PublicKey curve hash -> msg -> Signature curve hash -> Bool
verify prx pub msg sig = verify prx pub msg sig =
case doVerify of case doVerify of
CryptoPassed verified -> verified CryptoPassed verified -> verified
@ -171,16 +211,22 @@ verify prx pub msg sig =
pR' = pointsSmulVarTime prx sS sK nPub pR' = pointsSmulVarTime prx sS sK nPub
return (pR == pR') return (pR == pR')
getK :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) getK :: forall proxy curve hash msg .
=> proxy curve -> PublicKey curve -> Bytes -> msg -> Scalar curve ( 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 = 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 in decodeScalarNoErr prx digK
encodeSignature :: EllipticCurveEdDSA curve encodeSignature :: EllipticCurveEdDSA curve
=> proxy curve => proxy curve
-> (Bytes, Point curve, Scalar curve) -> (Bytes, Point curve, Scalar curve)
-> Signature curve -> Signature curve hash
encodeSignature prx (bsR, _, sS) = Signature $ encodeSignature prx (bsR, _, sS) = Signature $
if len0 > 0 then B.concat [ bsR, bsS, pad0 ] else B.append bsR bsS if len0 > 0 then B.concat [ bsR, bsS, pad0 ] else B.append bsR bsS
where where
@ -188,9 +234,11 @@ encodeSignature prx (bsR, _, sS) = Signature $
len0 = signatureSize prx - B.length bsR - B.length bsS len0 = signatureSize prx - B.length bsR - B.length bsS
pad0 = B.zero len0 pad0 = B.zero len0
decodeSignature :: EllipticCurveEdDSA curve decodeSignature :: ( EllipticCurveEdDSA curve
, HashDigestSize hash ~ CurveDigestSize curve
)
=> proxy curve => proxy curve
-> Signature curve -> Signature curve hash
-> CryptoFailable (Bytes, Point curve, Scalar curve) -> CryptoFailable (Bytes, Point curve, Scalar curve)
decodeSignature prx (Signature bs) = do decodeSignature prx (Signature bs) = do
let (bsR, bsS) = B.splitAt (publicKeySize prx) bs let (bsR, bsS) = B.splitAt (publicKeySize prx) bs
@ -211,22 +259,20 @@ unwrap _ (CryptoPassed x) = x
-- Ed25519 implementation -- Ed25519 implementation
instance EllipticCurveEdDSA Curve_Edwards25519 where instance EllipticCurveEdDSA Curve_Edwards25519 where
publicKeySize _ = 32 type CurveDigestSize Curve_Edwards25519 = 64
secretKeySize _ = 32 secretKeySize _ = 32
signatureSize _ = 64
type HashAlg Curve_Edwards25519 = SHA512 hashWithDom _ = digestDomMsg
hashWithDom _ = digestDomMsg SHA512
pointPublic _ = PublicKey . Edwards25519.pointEncode pointPublic _ = PublicKey . Edwards25519.pointEncode
publicPoint _ = Edwards25519.pointDecode publicPoint _ = Edwards25519.pointDecode
encodeScalarLE _ = Edwards25519.scalarEncode encodeScalarLE _ = Edwards25519.scalarEncode
decodeScalarLE _ = Edwards25519.scalarDecodeLong decodeScalarLE _ = Edwards25519.scalarDecodeLong
scheduleSecret prx priv = scheduleSecret prx alg priv =
(decodeScalarNoErr prx clamped, B.drop 32 hashed) (decodeScalarNoErr prx clamped, B.drop 32 hashed)
where where
hashed = digest SHA512 ($ priv) hashed = digest alg ($ priv)
clamped :: Bytes clamped :: Bytes
clamped = B.copyAndFreeze (B.takeView hashed 32) $ \p -> do clamped = B.copyAndFreeze (B.takeView hashed 32) $ \p -> do

18
benchs/Bench.hs
View File

@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module Main where module Main where
import Gauge.Main import Gauge.Main
@ -328,25 +329,26 @@ benchECDSA = map doECDSABench curveHashes
] ]
benchEdDSA = benchEdDSA =
[ bgroup "EdDSA-Ed25519" $ benchGeneric (Just Curve_Edwards25519) [ bgroup "EdDSA-Ed25519" benchGenEd25519
, bgroup "Ed25519" benchEd25519 , bgroup "Ed25519" benchEd25519
] ]
where where
benchGeneric prx = benchGen prx alg =
[ bench "sign" $ perBatchEnv (genEnv prx) (run_gen_sign prx) [ bench "sign" $ perBatchEnv (genEnv prx alg) (run_gen_sign prx)
, bench "verify" $ perBatchEnv (genEnv prx) (run_gen_verify 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 "sign" $ perBatchEnv ed25519Env run_ed25519_sign
, bench "verify" $ perBatchEnv ed25519Env run_ed25519_verify , bench "verify" $ perBatchEnv ed25519Env run_ed25519_verify
] ]
msg = B.empty -- empty message = worst-case scenario showing API overhead msg = B.empty -- empty message = worst-case scenario showing API overhead
genEnv prx _ = do genEnv prx alg _ = do
sec <- EdDSA.generateSecretKey prx sec <- EdDSA.generateSecretKey prx
let pub = EdDSA.toPublic prx sec let pub = EdDSA.toPublic prx alg sec
sig = EdDSA.sign prx sec pub msg sig = EdDSA.sign prx sec pub msg
return (sec, pub, sig) return (sec, pub, sig)