From 6075b698e12453123dd618b2d8acd97975ef6b2d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 7 Nov 2017 13:58:30 +0100 Subject: [PATCH 01/12] Generic EdDSA implementation --- Crypto/PubKey/EdDSA.hs | 231 +++++++++++++++++++++++++++++++++++++++++ cryptonite.cabal | 1 + 2 files changed, 232 insertions(+) create mode 100644 Crypto/PubKey/EdDSA.hs diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs new file mode 100644 index 0000000..3ae7854 --- /dev/null +++ b/Crypto/PubKey/EdDSA.hs @@ -0,0 +1,231 @@ +-- | +-- Module : Crypto.PubKey.EdDSA +-- License : BSD-style +-- Maintainer : Olivier Chéron +-- Stability : experimental +-- Portability : unknown +-- +-- EdDSA signature generation and verification. +-- +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +module Crypto.PubKey.EdDSA + ( SecretKey + , PublicKey + , Signature + -- * Curves with EdDSA implementation + , EllipticCurveEdDSA(publicKeySize, secretKeySize, signatureSize) + -- * Smart constructors + , signature + , publicKey + , secretKey + -- * Methods + , toPublic + , sign + , verify + , generateSecretKey + ) where + +import Data.Bits +import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes, View) +import qualified Data.ByteArray as B + +import Crypto.ECC +import qualified Crypto.ECC.Edwards25519 as Edwards25519 +import Crypto.Error +import Crypto.Hash +import Crypto.Random + +import Crypto.Internal.Imports + +import Foreign.Storable + + +-- API + +-- | An EdDSA Secret key +newtype SecretKey curve = SecretKey ScrubbedBytes + deriving (Show,Eq,ByteArrayAccess,NFData) + +-- | An EdDSA public key +newtype PublicKey curve = PublicKey Bytes + deriving (Show,Eq,ByteArrayAccess,NFData) + +-- | An EdDSA signature +newtype Signature curve = Signature Bytes + deriving (Show,Eq,ByteArrayAccess,NFData) + +-- | Elliptic curves with an implementation of EdDSA +class ( EllipticCurveBasepointArith curve + , HashAlgorithm (HashAlg curve) + ) => EllipticCurveEdDSA curve where + + -- | Size of public keys for this curve (in bytes) + publicKeySize :: proxy curve -> Int + + -- | 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 + + -- prepare hash context with specified parameters + type HashAlg curve :: * + hashInitWithDom :: proxy curve -> Context (HashAlg curve) + + -- conversion between scalar, point and public key + pointPublic :: proxy curve -> Point curve -> PublicKey curve + publicPoint :: proxy curve -> PublicKey curve -> 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 + -> SecretKey curve + -> (Scalar curve, View (Digest (HashAlg 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 + | B.length bs == publicKeySize prx = + CryptoPassed (PublicKey $ B.convert bs) + | otherwise = + CryptoFailed CryptoError_PublicKeySizeInvalid + +-- | Try to build a secret key from a bytearray +secretKey :: (EllipticCurveEdDSA curve, ByteArrayAccess ba) + => proxy curve -> ba -> CryptoFailable (SecretKey curve) +secretKey prx bs + | B.length bs == secretKeySize prx = + CryptoPassed (SecretKey $ B.convert bs) + | otherwise = + 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 + | B.length bs == signatureSize prx = + CryptoPassed (Signature $ B.convert bs) + | otherwise = + CryptoFailed CryptoError_SecretKeyStructureInvalid + + +-- Conversions + +-- | Generate a secret key +generateSecretKey :: (EllipticCurveEdDSA curve, MonadRandom m) + => proxy curve -> m (SecretKey curve) +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) + in pointPublic prx p + +secretScalar :: EllipticCurveEdDSA curve + => proxy curve -> SecretKey curve -> Scalar curve +secretScalar prx priv = fst (scheduleSecret prx 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 prx priv pub msg = + let (s, prefix) = scheduleSecret prx priv + digR = hashFinalize $ hashUpdate (hashUpdate (hashInitWithDom prx) prefix) msg + r = decodeScalarNoErr prx digR + pR = pointBaseSmul prx r + sK = getK prx pub pR msg + sS = scalarAdd prx r (scalarMul prx sK s) + in encodeSignature prx (pR, sS) + +-- | Verify a message +verify :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) + => proxy curve -> PublicKey curve -> msg -> Signature curve -> Bool +verify prx pub msg sig = + case doVerify of + CryptoPassed verified -> verified + CryptoFailed _ -> False + where + doVerify = do + (pR, sS) <- decodeSignature prx sig + nPub <- pointNegate prx `fmap` publicPoint prx pub + let sK = getK prx pub pR msg + pR' = pointsSmulVarTime prx sS sK nPub + return (pR == pR') + +getK :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) + => proxy curve -> PublicKey curve -> Point curve -> msg -> Scalar curve +getK prx pub pR msg = + let bsR = encodePoint prx pR :: Bytes + digK = hashFinalize $ hashUpdate (hashUpdate (hashUpdate (hashInitWithDom prx) bsR) pub) msg + in decodeScalarNoErr prx digK + +encodeSignature :: EllipticCurveEdDSA curve + => proxy curve + -> (Point curve, Scalar curve) + -> Signature curve +encodeSignature prx (pR, sS) = + let bsS = encodeScalarLE prx sS :: Bytes + len0 = signatureSize prx - publicKeySize prx - B.length bsS + in Signature $ B.concat [ encodePoint prx pR, bsS, B.zero len0 ] + +decodeSignature :: EllipticCurveEdDSA curve + => proxy curve + -> Signature curve + -> CryptoFailable (Point curve, Scalar curve) +decodeSignature prx (Signature bs) = do + let (bsR, bsS) = B.splitAt (publicKeySize prx) bs + pR <- decodePoint prx bsR + sS <- decodeScalarLE prx bsS + return (pR, sS) + +-- implementations are supposed to decode any scalar up to the size of the digest +decodeScalarNoErr :: (EllipticCurveEdDSA curve, ByteArrayAccess bs) + => proxy curve -> bs -> Scalar curve +decodeScalarNoErr prx = unwrap "decodeScalarNoErr" . decodeScalarLE prx + +unwrap :: String -> CryptoFailable a -> a +unwrap name (CryptoFailed _) = error (name ++ ": assumption failed") +unwrap _ (CryptoPassed x) = x + + +-- Ed25519 implementation + +instance EllipticCurveEdDSA Curve_Edwards25519 where + publicKeySize _ = 32 + secretKeySize _ = 32 + signatureSize _ = 64 + + type HashAlg Curve_Edwards25519 = SHA512 + hashInitWithDom _ = hashInitWith SHA512 + + pointPublic _ = PublicKey . Edwards25519.pointEncode + publicPoint _ = Edwards25519.pointDecode + encodeScalarLE _ = Edwards25519.scalarEncode + decodeScalarLE _ = Edwards25519.scalarDecodeLong + + scheduleSecret prx priv = + (decodeScalarNoErr prx clamped, B.dropView hashed 32) + where + hashed = hashWith SHA512 priv + + clamped :: Bytes + clamped = B.copyAndFreeze (B.takeView hashed 32) $ \p -> do + b0 <- peekElemOff p 0 :: IO Word8 + b31 <- peekElemOff p 31 :: IO Word8 + pokeElemOff p 31 ((b31 .&. 0x7F) .|. 0x40) + pokeElemOff p 0 (b0 .&. 0xF8) diff --git a/cryptonite.cabal b/cryptonite.cabal index 31bd64f..119c8ab 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -164,6 +164,7 @@ Library Crypto.PubKey.ECIES Crypto.PubKey.Ed25519 Crypto.PubKey.Ed448 + Crypto.PubKey.EdDSA Crypto.PubKey.RSA Crypto.PubKey.RSA.PKCS15 Crypto.PubKey.RSA.Prim From 633879f8016d886875a20799e81d5a49693bef35 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 4 Feb 2020 21:23:29 +0100 Subject: [PATCH 02/12] Avoid repeated point encoding --- Crypto/PubKey/EdDSA.hs | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs index 3ae7854..7754bcc 100644 --- a/Crypto/PubKey/EdDSA.hs +++ b/Crypto/PubKey/EdDSA.hs @@ -148,9 +148,10 @@ sign prx priv pub msg = digR = hashFinalize $ hashUpdate (hashUpdate (hashInitWithDom prx) prefix) msg r = decodeScalarNoErr prx digR pR = pointBaseSmul prx r - sK = getK prx pub pR msg + bsR = encodePoint prx pR + sK = getK prx pub bsR msg sS = scalarAdd prx r (scalarMul prx sK s) - in encodeSignature prx (pR, sS) + in encodeSignature prx (bsR, pR, sS) -- | Verify a message verify :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) @@ -161,37 +162,36 @@ verify prx pub msg sig = CryptoFailed _ -> False where doVerify = do - (pR, sS) <- decodeSignature prx sig + (bsR, pR, sS) <- decodeSignature prx sig nPub <- pointNegate prx `fmap` publicPoint prx pub - let sK = getK prx pub pR msg + let sK = getK prx pub bsR msg pR' = pointsSmulVarTime prx sS sK nPub return (pR == pR') getK :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) - => proxy curve -> PublicKey curve -> Point curve -> msg -> Scalar curve -getK prx pub pR msg = - let bsR = encodePoint prx pR :: Bytes - digK = hashFinalize $ hashUpdate (hashUpdate (hashUpdate (hashInitWithDom prx) bsR) pub) msg + => proxy curve -> PublicKey curve -> Bytes -> msg -> Scalar curve +getK prx pub bsR msg = + let digK = hashFinalize $ hashUpdate (hashUpdate (hashUpdate (hashInitWithDom prx) bsR) pub) msg in decodeScalarNoErr prx digK encodeSignature :: EllipticCurveEdDSA curve => proxy curve - -> (Point curve, Scalar curve) + -> (Bytes, Point curve, Scalar curve) -> Signature curve -encodeSignature prx (pR, sS) = +encodeSignature prx (bsR, _, sS) = let bsS = encodeScalarLE prx sS :: Bytes - len0 = signatureSize prx - publicKeySize prx - B.length bsS - in Signature $ B.concat [ encodePoint prx pR, bsS, B.zero len0 ] + len0 = signatureSize prx - B.length bsR - B.length bsS + in Signature $ B.concat [ bsR, bsS, B.zero len0 ] decodeSignature :: EllipticCurveEdDSA curve => proxy curve -> Signature curve - -> CryptoFailable (Point curve, Scalar curve) + -> CryptoFailable (Bytes, Point curve, Scalar curve) decodeSignature prx (Signature bs) = do let (bsR, bsS) = B.splitAt (publicKeySize prx) bs pR <- decodePoint prx bsR sS <- decodeScalarLE prx bsS - return (pR, sS) + return (bsR, pR, sS) -- implementations are supposed to decode any scalar up to the size of the digest decodeScalarNoErr :: (EllipticCurveEdDSA curve, ByteArrayAccess bs) From 6f70986cb17dd2248a3eb73760834d7941baadc5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 4 Feb 2020 21:39:50 +0100 Subject: [PATCH 03/12] Avoid signature padding when not required --- Crypto/PubKey/EdDSA.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs index 7754bcc..fc69a06 100644 --- a/Crypto/PubKey/EdDSA.hs +++ b/Crypto/PubKey/EdDSA.hs @@ -178,10 +178,12 @@ encodeSignature :: EllipticCurveEdDSA curve => proxy curve -> (Bytes, Point curve, Scalar curve) -> Signature curve -encodeSignature prx (bsR, _, sS) = - let bsS = encodeScalarLE prx sS :: Bytes - len0 = signatureSize prx - B.length bsR - B.length bsS - in Signature $ B.concat [ bsR, bsS, B.zero len0 ] +encodeSignature prx (bsR, _, sS) = Signature $ + if len0 > 0 then B.concat [ bsR, bsS, pad0 ] else B.append bsR bsS + where + bsS = encodeScalarLE prx sS + len0 = signatureSize prx - B.length bsR - B.length bsS + pad0 = B.zero len0 decodeSignature :: EllipticCurveEdDSA curve => proxy curve From bd84c75f3ee5f5e7762023ff905720c53a921171 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 5 Feb 2020 21:15:58 +0100 Subject: [PATCH 04/12] Use unsafe FFI calls Changed Edwards primitives to unsafe when overhead of FFI call is approximately 5% or more of total execution time. --- Crypto/ECC/Edwards25519.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/Crypto/ECC/Edwards25519.hs b/Crypto/ECC/Edwards25519.hs index 92a0516..589fc55 100644 --- a/Crypto/ECC/Edwards25519.hs +++ b/Crypto/ECC/Edwards25519.hs @@ -283,45 +283,45 @@ pointsMulVarTime (Scalar s1) (Scalar s2) (Point p) = withByteArray p $ \pp -> ed25519_base_double_scalarmul_vartime out ps1 pp ps2 -foreign import ccall "cryptonite_ed25519_scalar_eq" +foreign import ccall unsafe "cryptonite_ed25519_scalar_eq" ed25519_scalar_eq :: Ptr Scalar -> Ptr Scalar -> IO CInt -foreign import ccall "cryptonite_ed25519_scalar_encode" +foreign import ccall unsafe "cryptonite_ed25519_scalar_encode" ed25519_scalar_encode :: Ptr Word8 -> Ptr Scalar -> IO () -foreign import ccall "cryptonite_ed25519_scalar_decode_long" +foreign import ccall unsafe "cryptonite_ed25519_scalar_decode_long" ed25519_scalar_decode_long :: Ptr Scalar -> Ptr Word8 -> CSize -> IO () -foreign import ccall "cryptonite_ed25519_scalar_add" +foreign import ccall unsafe "cryptonite_ed25519_scalar_add" ed25519_scalar_add :: Ptr Scalar -- sum -> Ptr Scalar -- a -> Ptr Scalar -- b -> IO () -foreign import ccall "cryptonite_ed25519_scalar_mul" +foreign import ccall unsafe "cryptonite_ed25519_scalar_mul" ed25519_scalar_mul :: Ptr Scalar -- out -> Ptr Scalar -- a -> Ptr Scalar -- b -> IO () -foreign import ccall "cryptonite_ed25519_point_encode" +foreign import ccall unsafe "cryptonite_ed25519_point_encode" ed25519_point_encode :: Ptr Word8 -> Ptr Point -> IO () -foreign import ccall "cryptonite_ed25519_point_decode_vartime" +foreign import ccall unsafe "cryptonite_ed25519_point_decode_vartime" ed25519_point_decode_vartime :: Ptr Point -> Ptr Word8 -> IO CInt -foreign import ccall "cryptonite_ed25519_point_eq" +foreign import ccall unsafe "cryptonite_ed25519_point_eq" ed25519_point_eq :: Ptr Point -> Ptr Point -> IO CInt @@ -330,23 +330,23 @@ 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" +foreign import ccall unsafe "cryptonite_ed25519_point_negate" ed25519_point_negate :: Ptr Point -- minus_a -> Ptr Point -- a -> IO () -foreign import ccall "cryptonite_ed25519_point_add" +foreign import ccall unsafe "cryptonite_ed25519_point_add" ed25519_point_add :: Ptr Point -- sum -> Ptr Point -- a -> Ptr Point -- b -> IO () -foreign import ccall "cryptonite_ed25519_point_double" +foreign import ccall unsafe "cryptonite_ed25519_point_double" ed25519_point_double :: Ptr Point -- two_a -> Ptr Point -- a -> IO () -foreign import ccall "cryptonite_ed25519_point_mul_by_cofactor" +foreign import ccall unsafe "cryptonite_ed25519_point_mul_by_cofactor" ed25519_point_mul_by_cofactor :: Ptr Point -- eight_a -> Ptr Point -- a -> IO () From 6f932998adc13d40e2679934f71f411655a71bb5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Fri, 7 Feb 2020 06:58:44 +0100 Subject: [PATCH 05/12] Fast hashing for EdDSA --- Crypto/PubKey/EdDSA.hs | 52 +++++++++++++++++++++++++++++++++--------- 1 file changed, 41 insertions(+), 11 deletions(-) diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs index fc69a06..95e187b 100644 --- a/Crypto/PubKey/EdDSA.hs +++ b/Crypto/PubKey/EdDSA.hs @@ -11,6 +11,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} module Crypto.PubKey.EdDSA @@ -31,15 +32,17 @@ module Crypto.PubKey.EdDSA ) where import Data.Bits -import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes, View) +import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes) import qualified Data.ByteArray as B import Crypto.ECC import qualified Crypto.ECC.Edwards25519 as Edwards25519 import Crypto.Error -import Crypto.Hash +import Crypto.Hash.Algorithms +import Crypto.Hash.IO import Crypto.Random +import Crypto.Internal.Compat import Crypto.Internal.Imports import Foreign.Storable @@ -73,9 +76,9 @@ class ( EllipticCurveBasepointArith curve -- | Size of signatures for this curve (in bytes) signatureSize :: proxy curve -> Int - -- prepare hash context with specified parameters + -- hash with a given prefix type HashAlg curve :: * - hashInitWithDom :: proxy curve -> Context (HashAlg curve) + hashWithDom :: ByteArrayAccess msg => proxy curve -> [Bytes] -> msg -> Bytes -- conversion between scalar, point and public key pointPublic :: proxy curve -> Point curve -> PublicKey curve @@ -86,7 +89,7 @@ class ( EllipticCurveBasepointArith curve -- how to use bits in a secret key scheduleSecret :: proxy curve -> SecretKey curve - -> (Scalar curve, View (Digest (HashAlg curve))) + -> (Scalar curve, Bytes) -- Constructors @@ -145,7 +148,7 @@ sign :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) => proxy curve -> SecretKey curve -> PublicKey curve -> msg -> Signature curve sign prx priv pub msg = let (s, prefix) = scheduleSecret prx priv - digR = hashFinalize $ hashUpdate (hashUpdate (hashInitWithDom prx) prefix) msg + digR = hashWithDom prx [prefix] msg r = decodeScalarNoErr prx digR pR = pointBaseSmul prx r bsR = encodePoint prx pR @@ -170,8 +173,8 @@ verify prx pub msg sig = getK :: (EllipticCurveEdDSA curve, ByteArrayAccess msg) => proxy curve -> PublicKey curve -> Bytes -> msg -> Scalar curve -getK prx pub bsR msg = - let digK = hashFinalize $ hashUpdate (hashUpdate (hashUpdate (hashInitWithDom prx) bsR) pub) msg +getK prx (PublicKey pub) bsR msg = + let digK = hashWithDom prx [bsR, pub] msg in decodeScalarNoErr prx digK encodeSignature :: EllipticCurveEdDSA curve @@ -213,7 +216,7 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where signatureSize _ = 64 type HashAlg Curve_Edwards25519 = SHA512 - hashInitWithDom _ = hashInitWith SHA512 + hashWithDom _ = digestDomMsg SHA512 pointPublic _ = PublicKey . Edwards25519.pointEncode publicPoint _ = Edwards25519.pointDecode @@ -221,9 +224,9 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where decodeScalarLE _ = Edwards25519.scalarDecodeLong scheduleSecret prx priv = - (decodeScalarNoErr prx clamped, B.dropView hashed 32) + (decodeScalarNoErr prx clamped, B.drop 32 hashed) where - hashed = hashWith SHA512 priv + hashed = digest SHA512 ($ priv) clamped :: Bytes clamped = B.copyAndFreeze (B.takeView hashed 32) $ \p -> do @@ -231,3 +234,30 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where b31 <- peekElemOff p 31 :: IO Word8 pokeElemOff p 31 ((b31 .&. 0x7F) .|. 0x40) pokeElemOff p 0 (b0 .&. 0xF8) + + +{- + Optimize hashing by limiting the number of roundtrips between Haskell and C. + Hash "update" functions do not use unsafe FFI call, so better concanetate + small fragments together and call the update function once. + + Using the IO hash interface avoids context buffer copies. + + Data type Digest is not used directly but converted to Bytes early. Any use of + withByteArray on the unpinned Digest backend would require copy through a + pinned trampoline. +-} + +digestDomMsg :: (HashAlgorithm alg, ByteArrayAccess msg) + => alg -> [Bytes] -> msg -> Bytes +digestDomMsg alg bss bs = digest alg $ \update -> + update (B.concat bss :: Bytes) >> update bs + +digest :: HashAlgorithm alg + => alg + -> ((forall bs . ByteArrayAccess bs => bs -> IO ()) -> IO ()) + -> Bytes +digest alg fn = B.convert $ unsafeDoIO $ do + mc <- hashMutableInitWith alg + fn (hashMutableUpdate mc) + hashMutableFinalize mc From 436b9abc1381990057992a4d90264fca939f9b80 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 12 Nov 2017 14:54:14 +0100 Subject: [PATCH 06/12] Benchmark EdDSA implementations --- benchs/Bench.hs | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/benchs/Bench.hs b/benchs/Bench.hs index e111a0d..f2a4f2a 100644 --- a/benchs/Bench.hs +++ b/benchs/Bench.hs @@ -24,6 +24,8 @@ 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 qualified Crypto.PubKey.Ed25519 as Ed25519 +import qualified Crypto.PubKey.EdDSA as EdDSA import Crypto.Random import Control.DeepSeq (NFData) @@ -325,6 +327,43 @@ benchECDSA = map doECDSABench curveHashes , ("secp521r1_sha512", CurveHashECDSA Curve_P521R1 SHA512) ] +benchEdDSA = + [ bgroup "EdDSA-Ed25519" $ benchGeneric (Just Curve_Edwards25519) + , bgroup "Ed25519" benchEd25519 + ] + where + benchGeneric prx = + [ bench "sign" $ perBatchEnv (genEnv prx) (run_gen_sign prx) + , bench "verify" $ perBatchEnv (genEnv prx) (run_gen_verify prx) + ] + + 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 + sec <- EdDSA.generateSecretKey prx + let pub = EdDSA.toPublic prx sec + sig = EdDSA.sign prx sec pub msg + return (sec, pub, sig) + + run_gen_sign prx (sec, pub, _) = return (EdDSA.sign prx sec pub msg) + + run_gen_verify prx (_, pub, sig) = return (EdDSA.verify prx pub msg sig) + + ed25519Env _ = do + sec <- Ed25519.generateSecretKey + let pub = Ed25519.toPublic sec + sig = Ed25519.sign sec pub msg + return (sec, pub, sig) + + run_ed25519_sign (sec, pub, _) = return (Ed25519.sign sec pub msg) + + run_ed25519_verify (_, pub, sig) = return (Ed25519.verify pub msg sig) + main = defaultMain [ bgroup "hash" benchHash , bgroup "block-cipher" benchBlockCipher @@ -338,5 +377,6 @@ main = defaultMain , bgroup "ECDH" benchECDH ] , bgroup "ECDSA" benchECDSA + , bgroup "EdDSA" benchEdDSA , bgroup "F2m" benchF2m ] 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 07/12] 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) From 977c72cac94383a454535bb7df448551568bba33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 8 Feb 2020 15:55:05 +0100 Subject: [PATCH 08/12] Test EdDSA with both SHA-2 and BLAKE2 --- cryptonite.cabal | 1 + tests/KAT_EdDSA.hs | 131 +++++++++++++++++++++++++++++++++++++++++++++ tests/Tests.hs | 2 + 3 files changed, 134 insertions(+) create mode 100644 tests/KAT_EdDSA.hs diff --git a/cryptonite.cabal b/cryptonite.cabal index 119c8ab..245d8c2 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -416,6 +416,7 @@ Test-Suite test-cryptonite KAT_DES KAT_Ed25519 KAT_Ed448 + KAT_EdDSA KAT_CMAC KAT_HKDF KAT_HMAC diff --git a/tests/KAT_EdDSA.hs b/tests/KAT_EdDSA.hs new file mode 100644 index 0000000..b21b5d5 --- /dev/null +++ b/tests/KAT_EdDSA.hs @@ -0,0 +1,131 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module KAT_EdDSA ( tests ) where + +import Crypto.Error +import Crypto.ECC +import Crypto.Hash.Algorithms +import Crypto.Hash.IO +import qualified Crypto.PubKey.EdDSA as EdDSA +import Imports + +data Vec = forall curve hash . + ( EdDSA.EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ EdDSA.CurveDigestSize curve + ) => Vec + { vecPrx :: Maybe curve + , vecAlg :: hash + , vecSec :: ByteString + , vecPub :: ByteString + , vecMsg :: ByteString + , vecSig :: ByteString + } + +vectors = + [ Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = SHA512 + , vecSec = "\x9d\x61\xb1\x9d\xef\xfd\x5a\x60\xba\x84\x4a\xf4\x92\xec\x2c\xc4\x44\x49\xc5\x69\x7b\x32\x69\x19\x70\x3b\xac\x03\x1c\xae\x7f\x60" + , vecPub = "\xd7\x5a\x98\x01\x82\xb1\x0a\xb7\xd5\x4b\xfe\xd3\xc9\x64\x07\x3a\x0e\xe1\x72\xf3\xda\xa6\x23\x25\xaf\x02\x1a\x68\xf7\x07\x51\x1a" + , vecMsg = "" + , vecSig = "\xe5\x56\x43\x00\xc3\x60\xac\x72\x90\x86\xe2\xcc\x80\x6e\x82\x8a\x84\x87\x7f\x1e\xb8\xe5\xd9\x74\xd8\x73\xe0\x65\x22\x49\x01\x55\x5f\xb8\x82\x15\x90\xa3\x3b\xac\xc6\x1e\x39\x70\x1c\xf9\xb4\x6b\xd2\x5b\xf5\xf0\x59\x5b\xbe\x24\x65\x51\x41\x43\x8e\x7a\x10\x0b" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = SHA512 + , vecSec = "\x4c\xcd\x08\x9b\x28\xff\x96\xda\x9d\xb6\xc3\x46\xec\x11\x4e\x0f\x5b\x8a\x31\x9f\x35\xab\xa6\x24\xda\x8c\xf6\xed\x4f\xb8\xa6\xfb" + , vecPub = "\x3d\x40\x17\xc3\xe8\x43\x89\x5a\x92\xb7\x0a\xa7\x4d\x1b\x7e\xbc\x9c\x98\x2c\xcf\x2e\xc4\x96\x8c\xc0\xcd\x55\xf1\x2a\xf4\x66\x0c" + , vecMsg = "\x72" + , vecSig = "\x92\xa0\x09\xa9\xf0\xd4\xca\xb8\x72\x0e\x82\x0b\x5f\x64\x25\x40\xa2\xb2\x7b\x54\x16\x50\x3f\x8f\xb3\x76\x22\x23\xeb\xdb\x69\xda\x08\x5a\xc1\xe4\x3e\x15\x99\x6e\x45\x8f\x36\x13\xd0\xf1\x1d\x8c\x38\x7b\x2e\xae\xb4\x30\x2a\xee\xb0\x0d\x29\x16\x12\xbb\x0c\x00" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = SHA512 + , vecSec = "\xc5\xaa\x8d\xf4\x3f\x9f\x83\x7b\xed\xb7\x44\x2f\x31\xdc\xb7\xb1\x66\xd3\x85\x35\x07\x6f\x09\x4b\x85\xce\x3a\x2e\x0b\x44\x58\xf7" + , vecPub = "\xfc\x51\xcd\x8e\x62\x18\xa1\xa3\x8d\xa4\x7e\xd0\x02\x30\xf0\x58\x08\x16\xed\x13\xba\x33\x03\xac\x5d\xeb\x91\x15\x48\x90\x80\x25" + , vecMsg = "\xaf\x82" + , vecSig = "\x62\x91\xd6\x57\xde\xec\x24\x02\x48\x27\xe6\x9c\x3a\xbe\x01\xa3\x0c\xe5\x48\xa2\x84\x74\x3a\x44\x5e\x36\x80\xd7\xdb\x5a\xc3\xac\x18\xff\x9b\x53\x8d\x16\xf2\x90\xae\x67\xf7\x60\x98\x4d\xc6\x59\x4a\x7c\x15\xe9\x71\x6e\xd2\x8d\xc0\x27\xbe\xce\xea\x1e\xc4\x0a" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = SHA512 + , vecSec = "\xf5\xe5\x76\x7c\xf1\x53\x31\x95\x17\x63\x0f\x22\x68\x76\xb8\x6c\x81\x60\xcc\x58\x3b\xc0\x13\x74\x4c\x6b\xf2\x55\xf5\xcc\x0e\xe5" + , vecPub = "\x27\x81\x17\xfc\x14\x4c\x72\x34\x0f\x67\xd0\xf2\x31\x6e\x83\x86\xce\xff\xbf\x2b\x24\x28\xc9\xc5\x1f\xef\x7c\x59\x7f\x1d\x42\x6e" + , vecMsg = "\x08\xb8\xb2\xb7\x33\x42\x42\x43\x76\x0f\xe4\x26\xa4\xb5\x49\x08\x63\x21\x10\xa6\x6c\x2f\x65\x91\xea\xbd\x33\x45\xe3\xe4\xeb\x98\xfa\x6e\x26\x4b\xf0\x9e\xfe\x12\xee\x50\xf8\xf5\x4e\x9f\x77\xb1\xe3\x55\xf6\xc5\x05\x44\xe2\x3f\xb1\x43\x3d\xdf\x73\xbe\x84\xd8\x79\xde\x7c\x00\x46\xdc\x49\x96\xd9\xe7\x73\xf4\xbc\x9e\xfe\x57\x38\x82\x9a\xdb\x26\xc8\x1b\x37\xc9\x3a\x1b\x27\x0b\x20\x32\x9d\x65\x86\x75\xfc\x6e\xa5\x34\xe0\x81\x0a\x44\x32\x82\x6b\xf5\x8c\x94\x1e\xfb\x65\xd5\x7a\x33\x8b\xbd\x2e\x26\x64\x0f\x89\xff\xbc\x1a\x85\x8e\xfc\xb8\x55\x0e\xe3\xa5\xe1\x99\x8b\xd1\x77\xe9\x3a\x73\x63\xc3\x44\xfe\x6b\x19\x9e\xe5\xd0\x2e\x82\xd5\x22\xc4\xfe\xba\x15\x45\x2f\x80\x28\x8a\x82\x1a\x57\x91\x16\xec\x6d\xad\x2b\x3b\x31\x0d\xa9\x03\x40\x1a\xa6\x21\x00\xab\x5d\x1a\x36\x55\x3e\x06\x20\x3b\x33\x89\x0c\xc9\xb8\x32\xf7\x9e\xf8\x05\x60\xcc\xb9\xa3\x9c\xe7\x67\x96\x7e\xd6\x28\xc6\xad\x57\x3c\xb1\x16\xdb\xef\xef\xd7\x54\x99\xda\x96\xbd\x68\xa8\xa9\x7b\x92\x8a\x8b\xbc\x10\x3b\x66\x21\xfc\xde\x2b\xec\xa1\x23\x1d\x20\x6b\xe6\xcd\x9e\xc7\xaf\xf6\xf6\xc9\x4f\xcd\x72\x04\xed\x34\x55\xc6\x8c\x83\xf4\xa4\x1d\xa4\xaf\x2b\x74\xef\x5c\x53\xf1\xd8\xac\x70\xbd\xcb\x7e\xd1\x85\xce\x81\xbd\x84\x35\x9d\x44\x25\x4d\x95\x62\x9e\x98\x55\xa9\x4a\x7c\x19\x58\xd1\xf8\xad\xa5\xd0\x53\x2e\xd8\xa5\xaa\x3f\xb2\xd1\x7b\xa7\x0e\xb6\x24\x8e\x59\x4e\x1a\x22\x97\xac\xbb\xb3\x9d\x50\x2f\x1a\x8c\x6e\xb6\xf1\xce\x22\xb3\xde\x1a\x1f\x40\xcc\x24\x55\x41\x19\xa8\x31\xa9\xaa\xd6\x07\x9c\xad\x88\x42\x5d\xe6\xbd\xe1\xa9\x18\x7e\xbb\x60\x92\xcf\x67\xbf\x2b\x13\xfd\x65\xf2\x70\x88\xd7\x8b\x7e\x88\x3c\x87\x59\xd2\xc4\xf5\xc6\x5a\xdb\x75\x53\x87\x8a\xd5\x75\xf9\xfa\xd8\x78\xe8\x0a\x0c\x9b\xa6\x3b\xcb\xcc\x27\x32\xe6\x94\x85\xbb\xc9\xc9\x0b\xfb\xd6\x24\x81\xd9\x08\x9b\xec\xcf\x80\xcf\xe2\xdf\x16\xa2\xcf\x65\xbd\x92\xdd\x59\x7b\x07\x07\xe0\x91\x7a\xf4\x8b\xbb\x75\xfe\xd4\x13\xd2\x38\xf5\x55\x5a\x7a\x56\x9d\x80\xc3\x41\x4a\x8d\x08\x59\xdc\x65\xa4\x61\x28\xba\xb2\x7a\xf8\x7a\x71\x31\x4f\x31\x8c\x78\x2b\x23\xeb\xfe\x80\x8b\x82\xb0\xce\x26\x40\x1d\x2e\x22\xf0\x4d\x83\xd1\x25\x5d\xc5\x1a\xdd\xd3\xb7\x5a\x2b\x1a\xe0\x78\x45\x04\xdf\x54\x3a\xf8\x96\x9b\xe3\xea\x70\x82\xff\x7f\xc9\x88\x8c\x14\x4d\xa2\xaf\x58\x42\x9e\xc9\x60\x31\xdb\xca\xd3\xda\xd9\xaf\x0d\xcb\xaa\xaf\x26\x8c\xb8\xfc\xff\xea\xd9\x4f\x3c\x7c\xa4\x95\xe0\x56\xa9\xb4\x7a\xcd\xb7\x51\xfb\x73\xe6\x66\xc6\xc6\x55\xad\xe8\x29\x72\x97\xd0\x7a\xd1\xba\x5e\x43\xf1\xbc\xa3\x23\x01\x65\x13\x39\xe2\x29\x04\xcc\x8c\x42\xf5\x8c\x30\xc0\x4a\xaf\xdb\x03\x8d\xda\x08\x47\xdd\x98\x8d\xcd\xa6\xf3\xbf\xd1\x5c\x4b\x4c\x45\x25\x00\x4a\xa0\x6e\xef\xf8\xca\x61\x78\x3a\xac\xec\x57\xfb\x3d\x1f\x92\xb0\xfe\x2f\xd1\xa8\x5f\x67\x24\x51\x7b\x65\xe6\x14\xad\x68\x08\xd6\xf6\xee\x34\xdf\xf7\x31\x0f\xdc\x82\xae\xbf\xd9\x04\xb0\x1e\x1d\xc5\x4b\x29\x27\x09\x4b\x2d\xb6\x8d\x6f\x90\x3b\x68\x40\x1a\xde\xbf\x5a\x7e\x08\xd7\x8f\xf4\xef\x5d\x63\x65\x3a\x65\x04\x0c\xf9\xbf\xd4\xac\xa7\x98\x4a\x74\xd3\x71\x45\x98\x67\x80\xfc\x0b\x16\xac\x45\x16\x49\xde\x61\x88\xa7\xdb\xdf\x19\x1f\x64\xb5\xfc\x5e\x2a\xb4\x7b\x57\xf7\xf7\x27\x6c\xd4\x19\xc1\x7a\x3c\xa8\xe1\xb9\x39\xae\x49\xe4\x88\xac\xba\x6b\x96\x56\x10\xb5\x48\x01\x09\xc8\xb1\x7b\x80\xe1\xb7\xb7\x50\xdf\xc7\x59\x8d\x5d\x50\x11\xfd\x2d\xcc\x56\x00\xa3\x2e\xf5\xb5\x2a\x1e\xcc\x82\x0e\x30\x8a\xa3\x42\x72\x1a\xac\x09\x43\xbf\x66\x86\xb6\x4b\x25\x79\x37\x65\x04\xcc\xc4\x93\xd9\x7e\x6a\xed\x3f\xb0\xf9\xcd\x71\xa4\x3d\xd4\x97\xf0\x1f\x17\xc0\xe2\xcb\x37\x97\xaa\x2a\x2f\x25\x66\x56\x16\x8e\x6c\x49\x6a\xfc\x5f\xb9\x32\x46\xf6\xb1\x11\x63\x98\xa3\x46\xf1\xa6\x41\xf3\xb0\x41\xe9\x89\xf7\x91\x4f\x90\xcc\x2c\x7f\xff\x35\x78\x76\xe5\x06\xb5\x0d\x33\x4b\xa7\x7c\x22\x5b\xc3\x07\xba\x53\x71\x52\xf3\xf1\x61\x0e\x4e\xaf\xe5\x95\xf6\xd9\xd9\x0d\x11\xfa\xa9\x33\xa1\x5e\xf1\x36\x95\x46\x86\x8a\x7f\x3a\x45\xa9\x67\x68\xd4\x0f\xd9\xd0\x34\x12\xc0\x91\xc6\x31\x5c\xf4\xfd\xe7\xcb\x68\x60\x69\x37\x38\x0d\xb2\xea\xaa\x70\x7b\x4c\x41\x85\xc3\x2e\xdd\xcd\xd3\x06\x70\x5e\x4d\xc1\xff\xc8\x72\xee\xee\x47\x5a\x64\xdf\xac\x86\xab\xa4\x1c\x06\x18\x98\x3f\x87\x41\xc5\xef\x68\xd3\xa1\x01\xe8\xa3\xb8\xca\xc6\x0c\x90\x5c\x15\xfc\x91\x08\x40\xb9\x4c\x00\xa0\xb9\xd0" + , vecSig = "\x0a\xab\x4c\x90\x05\x01\xb3\xe2\x4d\x7c\xdf\x46\x63\x32\x6a\x3a\x87\xdf\x5e\x48\x43\xb2\xcb\xdb\x67\xcb\xf6\xe4\x60\xfe\xc3\x50\xaa\x53\x71\xb1\x50\x8f\x9f\x45\x28\xec\xea\x23\xc4\x36\xd9\x4b\x5e\x8f\xcd\x4f\x68\x1e\x30\xa6\xac\x00\xa9\x70\x4a\x18\x8a\x03" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = SHA512 + , vecSec = "\x83\x3f\xe6\x24\x09\x23\x7b\x9d\x62\xec\x77\x58\x75\x20\x91\x1e\x9a\x75\x9c\xec\x1d\x19\x75\x5b\x7d\xa9\x01\xb9\x6d\xca\x3d\x42" + , vecPub = "\xec\x17\x2b\x93\xad\x5e\x56\x3b\xf4\x93\x2c\x70\xe1\x24\x50\x34\xc3\x54\x67\xef\x2e\xfd\x4d\x64\xeb\xf8\x19\x68\x34\x67\xe2\xbf" + , vecMsg = "\xdd\xaf\x35\xa1\x93\x61\x7a\xba\xcc\x41\x73\x49\xae\x20\x41\x31\x12\xe6\xfa\x4e\x89\xa9\x7e\xa2\x0a\x9e\xee\xe6\x4b\x55\xd3\x9a\x21\x92\x99\x2a\x27\x4f\xc1\xa8\x36\xba\x3c\x23\xa3\xfe\xeb\xbd\x45\x4d\x44\x23\x64\x3c\xe8\x0e\x2a\x9a\xc9\x4f\xa5\x4c\xa4\x9f" + , vecSig = "\xdc\x2a\x44\x59\xe7\x36\x96\x33\xa5\x2b\x1b\xf2\x77\x83\x9a\x00\x20\x10\x09\xa3\xef\xbf\x3e\xcb\x69\xbe\xa2\x18\x6c\x26\xb5\x89\x09\x35\x1f\xc9\xac\x90\xb3\xec\xfd\xfb\xc7\xc6\x64\x31\xe0\x30\x3d\xca\x17\x9c\x13\x8a\xc1\x7a\xd9\xbe\xf1\x17\x73\x31\xa7\x04" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = Blake2b_512 + , vecSec = "\x9d\x61\xb1\x9d\xef\xfd\x5a\x60\xba\x84\x4a\xf4\x92\xec\x2c\xc4\x44\x49\xc5\x69\x7b\x32\x69\x19\x70\x3b\xac\x03\x1c\xae\x7f\x60" + , vecPub = "\x78\xe6\x5b\xf3\x0f\x89\x3d\x32\xfc\x57\xef\x05\x1c\x34\x1b\xde\xde\x24\x25\x44\xfc\x2a\x21\x12\xf0\xfa\x2c\x7a\xfd\xeb\xc0\x2f" + , vecMsg = "" + , vecSig = "\x99\xa5\x23\xbd\x46\x16\xc8\x16\x11\x44\xd6\xa9\x9d\x3c\x32\x40\x0c\xb4\xa3\x26\xf4\xd7\x9e\x30\x73\x40\xf6\xaf\xa1\x17\x50\xa0\x08\x5d\x7d\x84\x62\x6b\xc9\xe4\xb1\x53\xfc\x0e\x39\x6d\x15\xce\x44\xc3\x9b\xae\x45\x33\x80\x4d\xb1\xfe\x5b\x52\xf2\xb1\xb8\x05" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = Blake2b_512 + , vecSec = "\x4c\xcd\x08\x9b\x28\xff\x96\xda\x9d\xb6\xc3\x46\xec\x11\x4e\x0f\x5b\x8a\x31\x9f\x35\xab\xa6\x24\xda\x8c\xf6\xed\x4f\xb8\xa6\xfb" + , vecPub = "\x5e\x71\x39\x2d\x91\xe6\xa5\x8f\xed\xeb\x08\x50\x36\x4f\x56\xcd\x15\x8a\x60\x44\x75\x57\xd7\x89\x03\x89\xc9\xb3\xd4\x57\x6d\x4d" + , vecMsg = "\x72" + , vecSig = "\x6d\xa7\x5e\x15\xb5\x70\x7f\x4d\xe5\xa1\x53\xc4\x8a\x5d\x83\x9f\xb8\x50\x74\xc3\x8a\xeb\x62\x85\x97\x7f\x03\xa1\x39\x77\x59\x7f\x97\x60\x69\xfd\xb9\x03\xf1\x83\x47\x4a\xaa\x5e\xd0\xcf\xe8\x78\xba\x8e\xf8\x68\xc5\xe4\x7c\xa3\xf9\x6c\xcf\xb3\xa8\x9b\x2a\x06" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = Blake2b_512 + , vecSec = "\xc5\xaa\x8d\xf4\x3f\x9f\x83\x7b\xed\xb7\x44\x2f\x31\xdc\xb7\xb1\x66\xd3\x85\x35\x07\x6f\x09\x4b\x85\xce\x3a\x2e\x0b\x44\x58\xf7" + , vecPub = "\x8d\x53\xca\x70\xf0\xea\xb2\x3b\x91\x78\x34\x57\x85\xfc\xdb\x69\xed\x67\x23\xf8\x14\x8f\x7e\x33\x9e\x88\x65\x37\x00\xb7\x18\xda" + , vecMsg = "\xaf\x82" + , vecSig = "\x7c\xc3\xc1\x38\x52\xbd\x12\xab\xf3\xce\x4c\xa8\xca\x28\x36\xcb\xf8\x6d\xa9\x6c\x46\x34\xc5\x0d\xf3\xfb\x80\xdc\x80\x9e\x29\xdb\x0e\x10\x9c\x36\x13\x53\x40\x7c\x12\x36\xa9\x04\xf6\x36\x86\x8a\xa3\x39\x77\xa9\x9d\x3f\x84\x45\x98\xdb\x15\x38\xb4\x29\x52\x03" + } + , Vec + { vecPrx = Just Curve_Edwards25519 + , vecAlg = Blake2b_512 + , vecSec = "\xf5\xe5\x76\x7c\xf1\x53\x31\x95\x17\x63\x0f\x22\x68\x76\xb8\x6c\x81\x60\xcc\x58\x3b\xc0\x13\x74\x4c\x6b\xf2\x55\xf5\xcc\x0e\xe5" + , vecPub = "\x9e\x3c\xa4\x9b\xb2\xd9\xe3\x6b\x8f\x0c\x94\x4a\x7b\x1c\x29\x26\x45\xda\x87\xce\x6f\xa6\xb4\x28\x86\xe5\xd7\xc8\x68\x33\xa7\x14" + , vecMsg = "\x08\xb8\xb2\xb7\x33\x42\x42\x43\x76\x0f\xe4\x26\xa4\xb5\x49\x08\x63\x21\x10\xa6\x6c\x2f\x65\x91\xea\xbd\x33\x45\xe3\xe4\xeb\x98\xfa\x6e\x26\x4b\xf0\x9e\xfe\x12\xee\x50\xf8\xf5\x4e\x9f\x77\xb1\xe3\x55\xf6\xc5\x05\x44\xe2\x3f\xb1\x43\x3d\xdf\x73\xbe\x84\xd8\x79\xde\x7c\x00\x46\xdc\x49\x96\xd9\xe7\x73\xf4\xbc\x9e\xfe\x57\x38\x82\x9a\xdb\x26\xc8\x1b\x37\xc9\x3a\x1b\x27\x0b\x20\x32\x9d\x65\x86\x75\xfc\x6e\xa5\x34\xe0\x81\x0a\x44\x32\x82\x6b\xf5\x8c\x94\x1e\xfb\x65\xd5\x7a\x33\x8b\xbd\x2e\x26\x64\x0f\x89\xff\xbc\x1a\x85\x8e\xfc\xb8\x55\x0e\xe3\xa5\xe1\x99\x8b\xd1\x77\xe9\x3a\x73\x63\xc3\x44\xfe\x6b\x19\x9e\xe5\xd0\x2e\x82\xd5\x22\xc4\xfe\xba\x15\x45\x2f\x80\x28\x8a\x82\x1a\x57\x91\x16\xec\x6d\xad\x2b\x3b\x31\x0d\xa9\x03\x40\x1a\xa6\x21\x00\xab\x5d\x1a\x36\x55\x3e\x06\x20\x3b\x33\x89\x0c\xc9\xb8\x32\xf7\x9e\xf8\x05\x60\xcc\xb9\xa3\x9c\xe7\x67\x96\x7e\xd6\x28\xc6\xad\x57\x3c\xb1\x16\xdb\xef\xef\xd7\x54\x99\xda\x96\xbd\x68\xa8\xa9\x7b\x92\x8a\x8b\xbc\x10\x3b\x66\x21\xfc\xde\x2b\xec\xa1\x23\x1d\x20\x6b\xe6\xcd\x9e\xc7\xaf\xf6\xf6\xc9\x4f\xcd\x72\x04\xed\x34\x55\xc6\x8c\x83\xf4\xa4\x1d\xa4\xaf\x2b\x74\xef\x5c\x53\xf1\xd8\xac\x70\xbd\xcb\x7e\xd1\x85\xce\x81\xbd\x84\x35\x9d\x44\x25\x4d\x95\x62\x9e\x98\x55\xa9\x4a\x7c\x19\x58\xd1\xf8\xad\xa5\xd0\x53\x2e\xd8\xa5\xaa\x3f\xb2\xd1\x7b\xa7\x0e\xb6\x24\x8e\x59\x4e\x1a\x22\x97\xac\xbb\xb3\x9d\x50\x2f\x1a\x8c\x6e\xb6\xf1\xce\x22\xb3\xde\x1a\x1f\x40\xcc\x24\x55\x41\x19\xa8\x31\xa9\xaa\xd6\x07\x9c\xad\x88\x42\x5d\xe6\xbd\xe1\xa9\x18\x7e\xbb\x60\x92\xcf\x67\xbf\x2b\x13\xfd\x65\xf2\x70\x88\xd7\x8b\x7e\x88\x3c\x87\x59\xd2\xc4\xf5\xc6\x5a\xdb\x75\x53\x87\x8a\xd5\x75\xf9\xfa\xd8\x78\xe8\x0a\x0c\x9b\xa6\x3b\xcb\xcc\x27\x32\xe6\x94\x85\xbb\xc9\xc9\x0b\xfb\xd6\x24\x81\xd9\x08\x9b\xec\xcf\x80\xcf\xe2\xdf\x16\xa2\xcf\x65\xbd\x92\xdd\x59\x7b\x07\x07\xe0\x91\x7a\xf4\x8b\xbb\x75\xfe\xd4\x13\xd2\x38\xf5\x55\x5a\x7a\x56\x9d\x80\xc3\x41\x4a\x8d\x08\x59\xdc\x65\xa4\x61\x28\xba\xb2\x7a\xf8\x7a\x71\x31\x4f\x31\x8c\x78\x2b\x23\xeb\xfe\x80\x8b\x82\xb0\xce\x26\x40\x1d\x2e\x22\xf0\x4d\x83\xd1\x25\x5d\xc5\x1a\xdd\xd3\xb7\x5a\x2b\x1a\xe0\x78\x45\x04\xdf\x54\x3a\xf8\x96\x9b\xe3\xea\x70\x82\xff\x7f\xc9\x88\x8c\x14\x4d\xa2\xaf\x58\x42\x9e\xc9\x60\x31\xdb\xca\xd3\xda\xd9\xaf\x0d\xcb\xaa\xaf\x26\x8c\xb8\xfc\xff\xea\xd9\x4f\x3c\x7c\xa4\x95\xe0\x56\xa9\xb4\x7a\xcd\xb7\x51\xfb\x73\xe6\x66\xc6\xc6\x55\xad\xe8\x29\x72\x97\xd0\x7a\xd1\xba\x5e\x43\xf1\xbc\xa3\x23\x01\x65\x13\x39\xe2\x29\x04\xcc\x8c\x42\xf5\x8c\x30\xc0\x4a\xaf\xdb\x03\x8d\xda\x08\x47\xdd\x98\x8d\xcd\xa6\xf3\xbf\xd1\x5c\x4b\x4c\x45\x25\x00\x4a\xa0\x6e\xef\xf8\xca\x61\x78\x3a\xac\xec\x57\xfb\x3d\x1f\x92\xb0\xfe\x2f\xd1\xa8\x5f\x67\x24\x51\x7b\x65\xe6\x14\xad\x68\x08\xd6\xf6\xee\x34\xdf\xf7\x31\x0f\xdc\x82\xae\xbf\xd9\x04\xb0\x1e\x1d\xc5\x4b\x29\x27\x09\x4b\x2d\xb6\x8d\x6f\x90\x3b\x68\x40\x1a\xde\xbf\x5a\x7e\x08\xd7\x8f\xf4\xef\x5d\x63\x65\x3a\x65\x04\x0c\xf9\xbf\xd4\xac\xa7\x98\x4a\x74\xd3\x71\x45\x98\x67\x80\xfc\x0b\x16\xac\x45\x16\x49\xde\x61\x88\xa7\xdb\xdf\x19\x1f\x64\xb5\xfc\x5e\x2a\xb4\x7b\x57\xf7\xf7\x27\x6c\xd4\x19\xc1\x7a\x3c\xa8\xe1\xb9\x39\xae\x49\xe4\x88\xac\xba\x6b\x96\x56\x10\xb5\x48\x01\x09\xc8\xb1\x7b\x80\xe1\xb7\xb7\x50\xdf\xc7\x59\x8d\x5d\x50\x11\xfd\x2d\xcc\x56\x00\xa3\x2e\xf5\xb5\x2a\x1e\xcc\x82\x0e\x30\x8a\xa3\x42\x72\x1a\xac\x09\x43\xbf\x66\x86\xb6\x4b\x25\x79\x37\x65\x04\xcc\xc4\x93\xd9\x7e\x6a\xed\x3f\xb0\xf9\xcd\x71\xa4\x3d\xd4\x97\xf0\x1f\x17\xc0\xe2\xcb\x37\x97\xaa\x2a\x2f\x25\x66\x56\x16\x8e\x6c\x49\x6a\xfc\x5f\xb9\x32\x46\xf6\xb1\x11\x63\x98\xa3\x46\xf1\xa6\x41\xf3\xb0\x41\xe9\x89\xf7\x91\x4f\x90\xcc\x2c\x7f\xff\x35\x78\x76\xe5\x06\xb5\x0d\x33\x4b\xa7\x7c\x22\x5b\xc3\x07\xba\x53\x71\x52\xf3\xf1\x61\x0e\x4e\xaf\xe5\x95\xf6\xd9\xd9\x0d\x11\xfa\xa9\x33\xa1\x5e\xf1\x36\x95\x46\x86\x8a\x7f\x3a\x45\xa9\x67\x68\xd4\x0f\xd9\xd0\x34\x12\xc0\x91\xc6\x31\x5c\xf4\xfd\xe7\xcb\x68\x60\x69\x37\x38\x0d\xb2\xea\xaa\x70\x7b\x4c\x41\x85\xc3\x2e\xdd\xcd\xd3\x06\x70\x5e\x4d\xc1\xff\xc8\x72\xee\xee\x47\x5a\x64\xdf\xac\x86\xab\xa4\x1c\x06\x18\x98\x3f\x87\x41\xc5\xef\x68\xd3\xa1\x01\xe8\xa3\xb8\xca\xc6\x0c\x90\x5c\x15\xfc\x91\x08\x40\xb9\x4c\x00\xa0\xb9\xd0" + , vecSig = "\xd0\x39\x65\xac\x31\x6a\x20\xf5\xa4\x7a\xb2\xd6\x18\x5e\xb3\xf0\xae\xea\x9c\x2e\xb8\xab\xe9\x22\xe9\x6d\x31\x7b\x3b\xd0\xef\x02\xe8\xd4\x7f\xd9\x23\x84\xe2\x86\x15\xeb\x33\x14\xad\xbc\x71\xc4\x67\x59\x96\x09\x9e\x48\x4c\xeb\x16\x28\x47\xc4\x0c\x32\x44\x0e" + } + ] + + +doPublicKeyTest :: Int -> Vec -> TestTree +doPublicKeyTest i Vec{..} = + testCase (show i) (pub @=? EdDSA.toPublic vecPrx vecAlg sec) + where + !pub = throwCryptoError $ EdDSA.publicKey vecPrx vecAlg vecPub + !sec = throwCryptoError $ EdDSA.secretKey vecPrx vecSec + +doSignatureTest :: Int -> Vec -> TestTree +doSignatureTest i Vec{..} = + testCase (show i) (sig @=? EdDSA.sign vecPrx sec pub vecMsg) + where + !sig = throwCryptoError $ EdDSA.signature vecPrx vecAlg vecSig + !pub = throwCryptoError $ EdDSA.publicKey vecPrx vecAlg vecPub + !sec = throwCryptoError $ EdDSA.secretKey vecPrx vecSec + +doVerifyTest :: Int -> Vec -> TestTree +doVerifyTest i Vec{..} = + testCase (show i) (True @=? EdDSA.verify vecPrx pub vecMsg sig) + where + !sig = throwCryptoError $ EdDSA.signature vecPrx vecAlg vecSig + !pub = throwCryptoError $ EdDSA.publicKey vecPrx vecAlg vecPub + + +tests = testGroup "EdDSA" + [ testGroup "gen publickey" $ zipWith doPublicKeyTest [katZero..] vectors + , testGroup "gen signature" $ zipWith doSignatureTest [katZero..] vectors + , testGroup "verify sig" $ zipWith doVerifyTest [katZero..] vectors + ] diff --git a/tests/Tests.hs b/tests/Tests.hs index f379fc8..b3b0b27 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -29,6 +29,7 @@ import qualified KAT_Curve25519 import qualified KAT_Curve448 import qualified KAT_Ed25519 import qualified KAT_Ed448 +import qualified KAT_EdDSA import qualified KAT_OTP import qualified KAT_PubKey import qualified KAT_Scrypt @@ -67,6 +68,7 @@ tests = testGroup "cryptonite" , KAT_Curve448.tests , KAT_Ed25519.tests , KAT_Ed448.tests + , KAT_EdDSA.tests , KAT_PubKey.tests , KAT_OTP.tests , testGroup "KDF" From ef880291e32cf1fd85416644d927d71975e60fa7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 8 Nov 2017 11:52:18 +0100 Subject: [PATCH 09/12] Add EdDSA 'ctx' and 'ph' variants --- Crypto/PubKey/EdDSA.hs | 130 +++++++++++++++++++++++++++++++++-------- 1 file changed, 106 insertions(+), 24 deletions(-) diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs index eeffa7b..f0fd8ec 100644 --- a/Crypto/PubKey/EdDSA.hs +++ b/Crypto/PubKey/EdDSA.hs @@ -5,7 +5,16 @@ -- Stability : experimental -- Portability : unknown -- --- EdDSA signature generation and verification. +-- EdDSA signature generation and verification, implemented in Haskell and +-- parameterized with elliptic curve and hash algorithm. Only edwards25519 is +-- supported at the moment. +-- +-- The module provides \"context\" and \"prehash\" variants defined in +-- . +-- +-- This implementation is most useful when wanting to customize the hash +-- algorithm. See module "Crypto.PubKey.Ed25519" for faster Ed25519 with +-- SHA-512. -- {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} @@ -30,18 +39,24 @@ module Crypto.PubKey.EdDSA -- * Methods , toPublic , sign + , signCtx + , signPh , verify + , verifyCtx + , verifyPh , generateSecretKey ) where import Data.Bits import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes) import qualified Data.ByteArray as B +import Data.ByteString (ByteString) import Data.Proxy import Crypto.ECC import qualified Crypto.ECC.Edwards25519 as Edwards25519 import Crypto.Error +import Crypto.Hash (Digest) import Crypto.Hash.IO import Crypto.Random @@ -79,9 +94,9 @@ class ( EllipticCurveBasepointArith curve -- | Size of secret keys for this curve (in bytes) secretKeySize :: proxy curve -> Int - -- hash with a given prefix - hashWithDom :: (HashAlgorithm hash, ByteArrayAccess msg) - => proxy curve -> hash -> [Bytes] -> msg -> Bytes + -- hash with specified parameters + hashWithDom :: (HashAlgorithm hash, ByteArrayAccess ctx, ByteArrayAccess msg) + => proxy curve -> hash -> Bool -> ctx -> [Bytes] -> msg -> Bytes -- conversion between scalar, point and public key pointPublic :: proxy curve -> Point curve -> PublicKey curve hash @@ -174,23 +189,13 @@ secretScalar prx alg priv = fst (scheduleSecret prx alg priv) -- EdDSA signature generation & verification -- | Sign a message using the key pair -sign :: forall proxy curve hash msg . - ( EllipticCurveEdDSA curve +sign :: ( EllipticCurveEdDSA curve , HashAlgorithm hash - , ByteArrayAccess msg , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess msg ) => proxy curve -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash -sign prx priv pub 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 - sK = getK prx pub bsR msg - sS = scalarAdd prx r (scalarMul prx sK s) - in encodeSignature prx (bsR, pR, sS) +sign prx = signCtx prx emptyCtx -- | Verify a message verify :: ( EllipticCurveEdDSA curve @@ -199,7 +204,73 @@ verify :: ( EllipticCurveEdDSA curve , ByteArrayAccess msg ) => proxy curve -> PublicKey curve hash -> msg -> Signature curve hash -> Bool -verify prx pub msg sig = +verify prx = verifyCtx prx emptyCtx + +-- | Sign a message using the key pair under context @ctx@ +signCtx :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ctx + , ByteArrayAccess msg + ) + => proxy curve -> ctx -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash +signCtx prx = signPhCtx prx False + +-- | Verify a message under context @ctx@ +verifyCtx :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ctx + , ByteArrayAccess msg + ) + => proxy curve -> ctx -> PublicKey curve hash -> msg -> Signature curve hash -> Bool +verifyCtx prx = verifyPhCtx prx False + +-- | Sign a prehashed message using the key pair under context @ctx@ +signPh :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ctx + ) + => proxy curve -> ctx -> SecretKey curve -> PublicKey curve hash -> Digest prehash -> Signature curve hash +signPh prx = signPhCtx prx True + +-- | Verify a prehashed message under context @ctx@ +verifyPh :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ctx + ) + => proxy curve -> ctx -> PublicKey curve hash -> Digest prehash -> Signature curve hash -> Bool +verifyPh prx = verifyPhCtx prx True + +signPhCtx :: forall proxy curve hash ctx msg . + ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ctx + , ByteArrayAccess msg + ) + => proxy curve -> Bool -> ctx -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash +signPhCtx prx ph ctx priv pub msg = + let alg = undefined :: hash + (s, prefix) = scheduleSecret prx alg priv + digR = hashWithDom prx alg ph ctx [prefix] msg + r = decodeScalarNoErr prx digR + pR = pointBaseSmul prx r + bsR = encodePoint prx pR + sK = getK prx ph ctx pub bsR msg + sS = scalarAdd prx r (scalarMul prx sK s) + in encodeSignature prx (bsR, pR, sS) + +verifyPhCtx :: ( EllipticCurveEdDSA curve + , HashAlgorithm hash + , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ctx + , ByteArrayAccess msg + ) + => proxy curve -> Bool -> ctx -> PublicKey curve hash -> msg -> Signature curve hash -> Bool +verifyPhCtx prx ph ctx pub msg sig = case doVerify of CryptoPassed verified -> verified CryptoFailed _ -> False @@ -207,20 +278,24 @@ verify prx pub msg sig = doVerify = do (bsR, pR, sS) <- decodeSignature prx sig nPub <- pointNegate prx `fmap` publicPoint prx pub - let sK = getK prx pub bsR msg + let sK = getK prx ph ctx pub bsR msg pR' = pointsSmulVarTime prx sS sK nPub return (pR == pR') -getK :: forall proxy curve hash msg . +emptyCtx :: Bytes +emptyCtx = B.empty + +getK :: forall proxy curve hash ctx msg . ( EllipticCurveEdDSA curve , HashAlgorithm hash , HashDigestSize hash ~ CurveDigestSize curve + , ByteArrayAccess ctx , ByteArrayAccess msg ) - => proxy curve -> PublicKey curve hash -> Bytes -> msg -> Scalar curve -getK prx (PublicKey pub) bsR msg = + => proxy curve -> Bool -> ctx -> PublicKey curve hash -> Bytes -> msg -> Scalar curve +getK prx ph ctx (PublicKey pub) bsR msg = let alg = undefined :: hash - digK = hashWithDom prx alg [bsR, pub] msg + digK = hashWithDom prx alg ph ctx [bsR, pub] msg in decodeScalarNoErr prx digK encodeSignature :: EllipticCurveEdDSA curve @@ -262,7 +337,14 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where type CurveDigestSize Curve_Edwards25519 = 64 secretKeySize _ = 32 - hashWithDom _ = digestDomMsg + hashWithDom _ alg ph ctx bss + | not ph && B.null ctx = digestDomMsg alg bss + | otherwise = digestDomMsg alg (bs:bss) + where bs = B.concat [ "SigEd25519 no Ed25519 collisions" :: ByteString + , B.singleton $ if ph then 1 else 0 + , B.singleton $ fromIntegral $ B.length ctx + , B.convert ctx + ] pointPublic _ = PublicKey . Edwards25519.pointEncode publicPoint _ = Edwards25519.pointDecode From b01f610aa2014f3350a8c1f3e274e261193a17aa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 9 Feb 2020 13:41:37 +0100 Subject: [PATCH 10/12] Add and use Builder module Avoids intermediate allocations and conversions when concatenating byte arrays of different types. --- Crypto/Internal/Builder.hs | 50 ++++++++++++++++++++++++++++++++++++++ Crypto/MAC/KMAC.hs | 38 +++++------------------------ Crypto/PubKey/EdDSA.hs | 35 +++++++++++++------------- cryptonite.cabal | 1 + 4 files changed, 74 insertions(+), 50 deletions(-) create mode 100644 Crypto/Internal/Builder.hs diff --git a/Crypto/Internal/Builder.hs b/Crypto/Internal/Builder.hs new file mode 100644 index 0000000..d33ebfd --- /dev/null +++ b/Crypto/Internal/Builder.hs @@ -0,0 +1,50 @@ +-- | +-- Module : Crypto.Internal.Builder +-- License : BSD-style +-- Maintainer : Olivier Chéron +-- Stability : stable +-- Portability : Good +-- +-- Delaying and merging ByteArray allocations. This is similar to module +-- "Data.ByteArray.Pack" except the total length is computed automatically based +-- on what is appended. +-- +{-# LANGUAGE BangPatterns #-} +module Crypto.Internal.Builder + ( Builder + , buildAndFreeze + , builderLength + , (<+>) + , byte + , bytes + , zero + ) where + +import Data.ByteArray (ByteArray, ByteArrayAccess) +import qualified Data.ByteArray as B +import Data.Memory.PtrMethods (memSet) +import Data.Word (Word8) + +import Foreign.Ptr (Ptr, plusPtr) +import Foreign.Storable (poke) + +data Builder = Builder !Int (Ptr Word8 -> IO ()) -- size and initializer + +(<+>) :: Builder -> Builder -> Builder +(Builder s1 f1) <+> (Builder s2 f2) = Builder (s1 + s2) f + where f p = f1 p >> f2 (p `plusPtr` s1) + +builderLength :: Builder -> Int +builderLength (Builder s _) = s + +buildAndFreeze :: ByteArray ba => Builder -> ba +buildAndFreeze (Builder s f) = B.allocAndFreeze s f + +byte :: Word8 -> Builder +byte !b = Builder 1 (`poke` b) + +bytes :: ByteArrayAccess ba => ba -> Builder +bytes bs = Builder (B.length bs) (B.copyByteArrayToPtr bs) + +zero :: Int -> Builder +zero s = Builder s (\p -> memSet p 0 s) diff --git a/Crypto/MAC/KMAC.hs b/Crypto/MAC/KMAC.hs index f07e9e9..def8b98 100644 --- a/Crypto/MAC/KMAC.hs +++ b/Crypto/MAC/KMAC.hs @@ -27,13 +27,11 @@ import qualified Crypto.Hash as H import Crypto.Hash.SHAKE (HashSHAKE(..)) import Crypto.Hash.Types (HashAlgorithm(..), Digest(..)) import qualified Crypto.Hash.Types as H -import Foreign.Ptr (Ptr, plusPtr) -import Foreign.Storable (poke) +import Crypto.Internal.Builder +import Foreign.Ptr (Ptr) import Data.Bits (shiftR) -import Data.ByteArray (ByteArray, ByteArrayAccess) +import Data.ByteArray (ByteArrayAccess) import qualified Data.ByteArray as B -import Data.Word (Word8) -import Data.Memory.PtrMethods (memSet) -- cSHAKE @@ -48,7 +46,7 @@ cshakeInit n s p = H.Context $ B.allocAndFreeze c $ \(ptr :: Ptr (H.Context a)) c = hashInternalContextSize (undefined :: a) w = hashBlockSize (undefined :: a) x = encodeString n <+> encodeString s - b = builderAllocAndFreeze (bytepad x w) :: B.Bytes + b = buildAndFreeze (bytepad x w) :: B.Bytes cshakeUpdate :: (HashSHAKE a, ByteArrayAccess ba) => H.Context a -> ba -> H.Context a @@ -99,7 +97,7 @@ initialize str key = Context $ cshakeInit n str p where n = B.pack [75,77,65,67] :: B.Bytes -- "KMAC" w = hashBlockSize (undefined :: a) - p = builderAllocAndFreeze (bytepad (encodeString key) w) :: B.ScrubbedBytes + p = buildAndFreeze (bytepad (encodeString key) w) :: B.ScrubbedBytes -- | Incrementally update a KMAC context. update :: (HashSHAKE a, ByteArrayAccess ba) => Context a -> ba -> Context a @@ -114,7 +112,7 @@ finalize :: forall a . HashSHAKE a => Context a -> KMAC a finalize (Context ctx) = KMAC $ cshakeFinalize ctx suffix where l = cshakeOutputLength (undefined :: a) - suffix = builderAllocAndFreeze (rightEncode l) :: B.Bytes + suffix = buildAndFreeze (rightEncode l) :: B.Bytes -- Utilities @@ -143,27 +141,3 @@ rightEncode x = digits <+> byte len i2osp :: Int -> Builder i2osp i | i >= 256 = i2osp (shiftR i 8) <+> byte (fromIntegral i) | otherwise = byte (fromIntegral i) - - --- Delaying and merging ByteArray allocations - -data Builder = Builder !Int (Ptr Word8 -> IO ()) -- size and initializer - -(<+>) :: Builder -> Builder -> Builder -(Builder s1 f1) <+> (Builder s2 f2) = Builder (s1 + s2) f - where f p = f1 p >> f2 (p `plusPtr` s1) - -builderLength :: Builder -> Int -builderLength (Builder s _) = s - -builderAllocAndFreeze :: ByteArray ba => Builder -> ba -builderAllocAndFreeze (Builder s f) = B.allocAndFreeze s f - -byte :: Word8 -> Builder -byte !b = Builder 1 (`poke` b) - -bytes :: ByteArrayAccess ba => ba -> Builder -bytes bs = Builder (B.length bs) (B.copyByteArrayToPtr bs) - -zero :: Int -> Builder -zero s = Builder s (\p -> memSet p 0 s) diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs index f0fd8ec..67b733c 100644 --- a/Crypto/PubKey/EdDSA.hs +++ b/Crypto/PubKey/EdDSA.hs @@ -48,7 +48,7 @@ module Crypto.PubKey.EdDSA ) where import Data.Bits -import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes) +import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes, View) import qualified Data.ByteArray as B import Data.ByteString (ByteString) import Data.Proxy @@ -62,6 +62,7 @@ import Crypto.Random import GHC.TypeLits (KnownNat, Nat) +import Crypto.Internal.Builder import Crypto.Internal.Compat import Crypto.Internal.Imports import Crypto.Internal.Nat (integralNatVal) @@ -96,7 +97,7 @@ class ( EllipticCurveBasepointArith curve -- hash with specified parameters hashWithDom :: (HashAlgorithm hash, ByteArrayAccess ctx, ByteArrayAccess msg) - => proxy curve -> hash -> Bool -> ctx -> [Bytes] -> msg -> Bytes + => proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes -- conversion between scalar, point and public key pointPublic :: proxy curve -> Point curve -> PublicKey curve hash @@ -111,7 +112,7 @@ class ( EllipticCurveBasepointArith curve => proxy curve -> hash -> SecretKey curve - -> (Scalar curve, Bytes) + -> (Scalar curve, View Bytes) -- | Size of public keys for this curve (in bytes) publicKeySize :: EllipticCurveEdDSA curve => proxy curve -> Int @@ -255,7 +256,7 @@ signPhCtx :: forall proxy curve hash ctx msg . signPhCtx prx ph ctx priv pub msg = let alg = undefined :: hash (s, prefix) = scheduleSecret prx alg priv - digR = hashWithDom prx alg ph ctx [prefix] msg + digR = hashWithDom prx alg ph ctx (bytes prefix) msg r = decodeScalarNoErr prx digR pR = pointBaseSmul prx r bsR = encodePoint prx pR @@ -295,19 +296,18 @@ getK :: forall proxy curve hash ctx msg . => proxy curve -> Bool -> ctx -> PublicKey curve hash -> Bytes -> msg -> Scalar curve getK prx ph ctx (PublicKey pub) bsR msg = let alg = undefined :: hash - digK = hashWithDom prx alg ph ctx [bsR, pub] msg + digK = hashWithDom prx alg ph ctx (bytes bsR <+> bytes pub) msg in decodeScalarNoErr prx digK encodeSignature :: EllipticCurveEdDSA curve => proxy curve -> (Bytes, Point curve, Scalar curve) -> Signature curve hash -encodeSignature prx (bsR, _, sS) = Signature $ - if len0 > 0 then B.concat [ bsR, bsS, pad0 ] else B.append bsR bsS +encodeSignature prx (bsR, _, sS) = Signature $ buildAndFreeze $ + bytes bsR <+> bytes bsS <+> zero len0 where - bsS = encodeScalarLE prx sS + bsS = encodeScalarLE prx sS :: Bytes len0 = signatureSize prx - B.length bsR - B.length bsS - pad0 = B.zero len0 decodeSignature :: ( EllipticCurveEdDSA curve , HashDigestSize hash ~ CurveDigestSize curve @@ -339,12 +339,11 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where hashWithDom _ alg ph ctx bss | not ph && B.null ctx = digestDomMsg alg bss - | otherwise = digestDomMsg alg (bs:bss) - where bs = B.concat [ "SigEd25519 no Ed25519 collisions" :: ByteString - , B.singleton $ if ph then 1 else 0 - , B.singleton $ fromIntegral $ B.length ctx - , B.convert ctx - ] + | otherwise = digestDomMsg alg (dom <+> bss) + where dom = bytes ("SigEd25519 no Ed25519 collisions" :: ByteString) <+> + byte (if ph then 1 else 0) <+> + byte (fromIntegral $ B.length ctx) <+> + bytes ctx pointPublic _ = PublicKey . Edwards25519.pointEncode publicPoint _ = Edwards25519.pointDecode @@ -352,7 +351,7 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where decodeScalarLE _ = Edwards25519.scalarDecodeLong scheduleSecret prx alg priv = - (decodeScalarNoErr prx clamped, B.drop 32 hashed) + (decodeScalarNoErr prx clamped, B.dropView hashed 32) where hashed = digest alg ($ priv) @@ -377,9 +376,9 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where -} digestDomMsg :: (HashAlgorithm alg, ByteArrayAccess msg) - => alg -> [Bytes] -> msg -> Bytes + => alg -> Builder -> msg -> Bytes digestDomMsg alg bss bs = digest alg $ \update -> - update (B.concat bss :: Bytes) >> update bs + update (buildAndFreeze bss :: Bytes) >> update bs digest :: HashAlgorithm alg => alg diff --git a/cryptonite.cabal b/cryptonite.cabal index 245d8c2..619c0f3 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -230,6 +230,7 @@ Library Crypto.PubKey.ElGamal Crypto.ECC.Simple.Types Crypto.ECC.Simple.Prim + Crypto.Internal.Builder Crypto.Internal.ByteArray Crypto.Internal.Compat Crypto.Internal.CompatPrim From 2e0a60f7f737eab2ab8113bdb011bf37aac2deab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 23 Feb 2020 09:02:10 +0100 Subject: [PATCH 11/12] Use Semigroup API --- Crypto/Internal/Builder.hs | 10 +++++----- Crypto/Internal/Imports.hs | 4 ++++ Crypto/MAC/KMAC.hs | 15 ++++++++------- Crypto/PubKey/EdDSA.hs | 12 ++++++------ 4 files changed, 23 insertions(+), 18 deletions(-) diff --git a/Crypto/Internal/Builder.hs b/Crypto/Internal/Builder.hs index d33ebfd..fd5b920 100644 --- a/Crypto/Internal/Builder.hs +++ b/Crypto/Internal/Builder.hs @@ -14,7 +14,6 @@ module Crypto.Internal.Builder ( Builder , buildAndFreeze , builderLength - , (<+>) , byte , bytes , zero @@ -23,16 +22,17 @@ module Crypto.Internal.Builder import Data.ByteArray (ByteArray, ByteArrayAccess) import qualified Data.ByteArray as B import Data.Memory.PtrMethods (memSet) -import Data.Word (Word8) import Foreign.Ptr (Ptr, plusPtr) import Foreign.Storable (poke) +import Crypto.Internal.Imports + data Builder = Builder !Int (Ptr Word8 -> IO ()) -- size and initializer -(<+>) :: Builder -> Builder -> Builder -(Builder s1 f1) <+> (Builder s2 f2) = Builder (s1 + s2) f - where f p = f1 p >> f2 (p `plusPtr` s1) +instance Semigroup Builder where + (Builder s1 f1) <> (Builder s2 f2) = Builder (s1 + s2) f + where f p = f1 p >> f2 (p `plusPtr` s1) builderLength :: Builder -> Int builderLength (Builder s _) = s diff --git a/Crypto/Internal/Imports.hs b/Crypto/Internal/Imports.hs index 4ed44e1..6d551e9 100644 --- a/Crypto/Internal/Imports.hs +++ b/Crypto/Internal/Imports.hs @@ -5,11 +5,15 @@ -- Stability : experimental -- Portability : unknown -- +{-# LANGUAGE CPP #-} module Crypto.Internal.Imports ( module X ) where import Data.Word as X +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup as X (Semigroup(..)) +#endif import Control.Applicative as X import Control.Monad as X (forM, forM_, void) import Control.Arrow as X (first, second) diff --git a/Crypto/MAC/KMAC.hs b/Crypto/MAC/KMAC.hs index def8b98..b7ad88e 100644 --- a/Crypto/MAC/KMAC.hs +++ b/Crypto/MAC/KMAC.hs @@ -28,6 +28,7 @@ import Crypto.Hash.SHAKE (HashSHAKE(..)) import Crypto.Hash.Types (HashAlgorithm(..), Digest(..)) import qualified Crypto.Hash.Types as H import Crypto.Internal.Builder +import Crypto.Internal.Imports import Foreign.Ptr (Ptr) import Data.Bits (shiftR) import Data.ByteArray (ByteArrayAccess) @@ -45,7 +46,7 @@ cshakeInit n s p = H.Context $ B.allocAndFreeze c $ \(ptr :: Ptr (H.Context a)) where c = hashInternalContextSize (undefined :: a) w = hashBlockSize (undefined :: a) - x = encodeString n <+> encodeString s + x = encodeString n <> encodeString s b = buildAndFreeze (bytepad x w) :: B.Bytes cshakeUpdate :: (HashSHAKE a, ByteArrayAccess ba) @@ -75,7 +76,7 @@ cshakeFinalize !c s = -- The Eq instance is constant time. No Show instance is provided, to avoid -- printing by mistake. newtype KMAC a = KMAC { kmacGetDigest :: Digest a } - deriving ByteArrayAccess + deriving (ByteArrayAccess,NFData) instance Eq (KMAC a) where (KMAC b1) == (KMAC b2) = B.constEq b1 b2 @@ -118,26 +119,26 @@ finalize (Context ctx) = KMAC $ cshakeFinalize ctx suffix -- Utilities bytepad :: Builder -> Int -> Builder -bytepad x w = prefix <+> x <+> zero padLen +bytepad x w = prefix <> x <> zero padLen where prefix = leftEncode w padLen = (w - builderLength prefix - builderLength x) `mod` w encodeString :: ByteArrayAccess bin => bin -> Builder -encodeString s = leftEncode (8 * B.length s) <+> bytes s +encodeString s = leftEncode (8 * B.length s) <> bytes s leftEncode :: Int -> Builder -leftEncode x = byte len <+> digits +leftEncode x = byte len <> digits where digits = i2osp x len = fromIntegral (builderLength digits) rightEncode :: Int -> Builder -rightEncode x = digits <+> byte len +rightEncode x = digits <> byte len where digits = i2osp x len = fromIntegral (builderLength digits) i2osp :: Int -> Builder -i2osp i | i >= 256 = i2osp (shiftR i 8) <+> byte (fromIntegral i) +i2osp i | i >= 256 = i2osp (shiftR i 8) <> byte (fromIntegral i) | otherwise = byte (fromIntegral i) diff --git a/Crypto/PubKey/EdDSA.hs b/Crypto/PubKey/EdDSA.hs index 67b733c..95fa7fd 100644 --- a/Crypto/PubKey/EdDSA.hs +++ b/Crypto/PubKey/EdDSA.hs @@ -296,7 +296,7 @@ getK :: forall proxy curve hash ctx msg . => proxy curve -> Bool -> ctx -> PublicKey curve hash -> Bytes -> msg -> Scalar curve getK prx ph ctx (PublicKey pub) bsR msg = let alg = undefined :: hash - digK = hashWithDom prx alg ph ctx (bytes bsR <+> bytes pub) msg + digK = hashWithDom prx alg ph ctx (bytes bsR <> bytes pub) msg in decodeScalarNoErr prx digK encodeSignature :: EllipticCurveEdDSA curve @@ -304,7 +304,7 @@ encodeSignature :: EllipticCurveEdDSA curve -> (Bytes, Point curve, Scalar curve) -> Signature curve hash encodeSignature prx (bsR, _, sS) = Signature $ buildAndFreeze $ - bytes bsR <+> bytes bsS <+> zero len0 + bytes bsR <> bytes bsS <> zero len0 where bsS = encodeScalarLE prx sS :: Bytes len0 = signatureSize prx - B.length bsR - B.length bsS @@ -339,10 +339,10 @@ instance EllipticCurveEdDSA Curve_Edwards25519 where hashWithDom _ alg ph ctx bss | not ph && B.null ctx = digestDomMsg alg bss - | otherwise = digestDomMsg alg (dom <+> bss) - where dom = bytes ("SigEd25519 no Ed25519 collisions" :: ByteString) <+> - byte (if ph then 1 else 0) <+> - byte (fromIntegral $ B.length ctx) <+> + | otherwise = digestDomMsg alg (dom <> bss) + where dom = bytes ("SigEd25519 no Ed25519 collisions" :: ByteString) <> + byte (if ph then 1 else 0) <> + byte (fromIntegral $ B.length ctx) <> bytes ctx pointPublic _ = PublicKey . Edwards25519.pointEncode From 981b97a132a4110aeb5a15f986b1bdf3631c274b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 23 Feb 2020 09:06:00 +0100 Subject: [PATCH 12/12] Protect against negative argument --- Crypto/Internal/Builder.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/Crypto/Internal/Builder.hs b/Crypto/Internal/Builder.hs index fd5b920..bc072e3 100644 --- a/Crypto/Internal/Builder.hs +++ b/Crypto/Internal/Builder.hs @@ -26,7 +26,7 @@ import Data.Memory.PtrMethods (memSet) import Foreign.Ptr (Ptr, plusPtr) import Foreign.Storable (poke) -import Crypto.Internal.Imports +import Crypto.Internal.Imports hiding (empty) data Builder = Builder !Int (Ptr Word8 -> IO ()) -- size and initializer @@ -47,4 +47,7 @@ bytes :: ByteArrayAccess ba => ba -> Builder bytes bs = Builder (B.length bs) (B.copyByteArrayToPtr bs) zero :: Int -> Builder -zero s = Builder s (\p -> memSet p 0 s) +zero s = if s > 0 then Builder s (\p -> memSet p 0 s) else empty + +empty :: Builder +empty = Builder 0 (const $ return ())