From 6805ddd4f72ac33002337802217058c9b0f1e10d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 8 Jan 2017 15:04:22 +0100 Subject: [PATCH] Add support for Ed448 This replaces the Diffie-Hellman API that was previously exported. --- Crypto/PubKey/Ed448.hs | 157 +++++++++++++++++++++++++++++++++++++++-- README.md | 1 + cryptonite.cabal | 3 +- tests/KAT_Ed448.hs | 40 +++++++++++ tests/Tests.hs | 2 + 5 files changed, 195 insertions(+), 8 deletions(-) create mode 100644 tests/KAT_Ed448.hs diff --git a/Crypto/PubKey/Ed448.hs b/Crypto/PubKey/Ed448.hs index 9efc6a5..acd751c 100644 --- a/Crypto/PubKey/Ed448.hs +++ b/Crypto/PubKey/Ed448.hs @@ -1,20 +1,163 @@ -- | -- Module : Crypto.PubKey.Ed448 -- License : BSD-style --- Maintainer : John Galt +-- Maintainer : Olivier Chéron -- Stability : experimental -- Portability : unknown -- -- Ed448 support -- --- /Functions and types exported here will be DEPRECATED in a future version./ --- For Diffie-Hellman over curve448 please use module "Crypto.PubKey.Curve448" --- instead. +-- Internally uses Decaf point compression to omit the cofactor +-- and implementation by Mike Hamburg. Externally API and +-- data types are compatible with the encoding specified in RFC 8032. -- +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MagicHash #-} module Crypto.PubKey.Ed448 - ( module Crypto.PubKey.Curve448 + ( SecretKey + , PublicKey + , Signature + -- * Size constants + , publicKeySize + , secretKeySize + , signatureSize + -- * Smart constructors + , signature + , publicKey + , secretKey + -- * methods + , toPublic + , sign + , verify + , generateSecretKey ) where -import Crypto.PubKey.Curve448 +import Data.Word +import Foreign.C.Types +import Foreign.Ptr + +import Crypto.Error +import Crypto.Internal.ByteArray (ByteArrayAccess, Bytes, + ScrubbedBytes, withByteArray) +import qualified Crypto.Internal.ByteArray as B +import Crypto.Internal.Compat +import Crypto.Internal.Imports +import Crypto.Random + +-- | An Ed448 Secret key +newtype SecretKey = SecretKey ScrubbedBytes + deriving (Eq,ByteArrayAccess,NFData) + +-- | An Ed448 public key +newtype PublicKey = PublicKey Bytes + deriving (Show,Eq,ByteArrayAccess,NFData) + +-- | An Ed448 signature +newtype Signature = Signature Bytes + deriving (Show,Eq,ByteArrayAccess,NFData) + +-- | Try to build a public key from a bytearray +publicKey :: ByteArrayAccess ba => ba -> CryptoFailable PublicKey +publicKey bs + | B.length bs == publicKeySize = + CryptoPassed $ PublicKey $ B.copyAndFreeze bs (\_ -> return ()) + | otherwise = + CryptoFailed $ CryptoError_PublicKeySizeInvalid + +-- | Try to build a secret key from a bytearray +secretKey :: ByteArrayAccess ba => ba -> CryptoFailable SecretKey +secretKey bs + | B.length bs == secretKeySize = unsafeDoIO $ withByteArray bs initialize + | otherwise = CryptoFailed CryptoError_SecretKeyStructureInvalid + where + initialize inp = do + valid <- isValidPtr inp + if valid + then (CryptoPassed . SecretKey) <$> B.copy bs (\_ -> return ()) + else return $ CryptoFailed CryptoError_SecretKeyStructureInvalid + isValidPtr _ = + return True +{-# NOINLINE secretKey #-} + +-- | Try to build a signature from a bytearray +signature :: ByteArrayAccess ba => ba -> CryptoFailable Signature +signature bs + | B.length bs == signatureSize = + CryptoPassed $ Signature $ B.copyAndFreeze bs (\_ -> return ()) + | otherwise = + CryptoFailed CryptoError_SecretKeyStructureInvalid + +-- | Create a public key from a secret key +toPublic :: SecretKey -> PublicKey +toPublic (SecretKey sec) = PublicKey <$> + B.allocAndFreeze publicKeySize $ \result -> + withByteArray sec $ \psec -> + decaf_ed448_derive_public_key result psec +{-# NOINLINE toPublic #-} + +-- | Sign a message using the key pair +sign :: ByteArrayAccess ba => SecretKey -> PublicKey -> ba -> Signature +sign secret public message = + Signature $ B.allocAndFreeze signatureSize $ \sig -> + withByteArray secret $ \sec -> + withByteArray public $ \pub -> + withByteArray message $ \msg -> + decaf_ed448_sign sig sec pub msg (fromIntegral msgLen) 0 no_context 0 + where + !msgLen = B.length message + +-- | Verify a message +verify :: ByteArrayAccess ba => PublicKey -> ba -> Signature -> Bool +verify public message signatureVal = unsafeDoIO $ + withByteArray signatureVal $ \sig -> + withByteArray public $ \pub -> + withByteArray message $ \msg -> do + r <- decaf_ed448_verify sig pub msg (fromIntegral msgLen) 0 no_context 0 + return (r /= 0) + where + !msgLen = B.length message + +-- | Generate a secret key +generateSecretKey :: MonadRandom m => m SecretKey +generateSecretKey = SecretKey <$> getRandomBytes secretKeySize + +-- | A public key is 57 bytes +publicKeySize :: Int +publicKeySize = 57 + +-- | A secret key is 57 bytes +secretKeySize :: Int +secretKeySize = 57 + +-- | A signature is 114 bytes +signatureSize :: Int +signatureSize = 114 + +no_context :: Ptr Word8 +no_context = nullPtr -- not supported yet + +foreign import ccall "cryptonite_decaf_ed448_derive_public_key" + decaf_ed448_derive_public_key :: Ptr PublicKey -- public key + -> Ptr SecretKey -- secret key + -> IO () + +foreign import ccall "cryptonite_decaf_ed448_sign" + decaf_ed448_sign :: Ptr Signature -- signature + -> Ptr SecretKey -- secret + -> Ptr PublicKey -- public + -> Ptr Word8 -- message + -> CSize -- message len + -> Word8 -- prehashed + -> Ptr Word8 -- context + -> Word8 -- context len + -> IO () + +foreign import ccall "cryptonite_decaf_ed448_verify" + decaf_ed448_verify :: Ptr Signature -- signature + -> Ptr PublicKey -- public + -> Ptr Word8 -- message + -> CSize -- message len + -> Word8 -- prehashed + -> Ptr Word8 -- context + -> Word8 -- context len + -> IO CInt diff --git a/README.md b/README.md index 3c4a20a..417fc92 100644 --- a/README.md +++ b/README.md @@ -100,5 +100,6 @@ Links * [Scrypt](http://www.tarsnap.com/scrypt.html) * [Curve25519](http://cr.yp.to/ecdh.html) * [Ed25519](http://ed25519.cr.yp.to/papers.html) +* [Ed448-Goldilocks](http://ed448goldilocks.sourceforge.net/) * [AFIS](http://clemens.endorphin.org/cryptography) diff --git a/cryptonite.cabal b/cryptonite.cabal index 88f931d..9694876 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -10,7 +10,7 @@ Description: . * MAC: HMAC, Poly1305 . - * Asymmetric crypto: DSA, RSA, DH, ECDH, ECDSA, ECC, Curve25519, Curve448, Ed25519 + * Asymmetric crypto: DSA, RSA, DH, ECDH, ECDSA, ECC, Curve25519, Curve448, Ed25519, Ed448 . * Key Derivation Function: PBKDF2, Scrypt, HKDF, Argon2 . @@ -375,6 +375,7 @@ Test-Suite test-cryptonite KAT_Curve448 KAT_DES KAT_Ed25519 + KAT_Ed448 KAT_CMAC KAT_HKDF KAT_HMAC diff --git a/tests/KAT_Ed448.hs b/tests/KAT_Ed448.hs new file mode 100644 index 0000000..655ce11 --- /dev/null +++ b/tests/KAT_Ed448.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE BangPatterns #-} +module KAT_Ed448 ( tests ) where + +import Crypto.Error +import qualified Crypto.PubKey.Ed448 as Ed448 +import Imports + +data Vec = Vec + { vecSec :: ByteString + , vecPub :: ByteString + , vecMsg :: ByteString + , vecSig :: ByteString + } deriving (Show,Eq) + +vec1 = Vec + { vecSec = "\xc4\xea\xb0\x5d\x35\x70\x07\xc6\x32\xf3\xdb\xb4\x84\x89\x92\x4d\x55\x2b\x08\xfe\x0c\x35\x3a\x0d\x4a\x1f\x00\xac\xda\x2c\x46\x3a\xfb\xea\x67\xc5\xe8\xd2\x87\x7c\x5e\x3b\xc3\x97\xa6\x59\x94\x9e\xf8\x02\x1e\x95\x4e\x0a\x12\x27\x4e" + , vecPub = "\x43\xba\x28\xf4\x30\xcd\xff\x45\x6a\xe5\x31\x54\x5f\x7e\xcd\x0a\xc8\x34\xa5\x5d\x93\x58\xc0\x37\x2b\xfa\x0c\x6c\x67\x98\xc0\x86\x6a\xea\x01\xeb\x00\x74\x28\x02\xb8\x43\x8e\xa4\xcb\x82\x16\x9c\x23\x51\x60\x62\x7b\x4c\x3a\x94\x80" + , vecMsg = "\x03" + , vecSig = "\x26\xb8\xf9\x17\x27\xbd\x62\x89\x7a\xf1\x5e\x41\xeb\x43\xc3\x77\xef\xb9\xc6\x10\xd4\x8f\x23\x35\xcb\x0b\xd0\x08\x78\x10\xf4\x35\x25\x41\xb1\x43\xc4\xb9\x81\xb7\xe1\x8f\x62\xde\x8c\xcd\xf6\x33\xfc\x1b\xf0\x37\xab\x7c\xd7\x79\x80\x5e\x0d\xbc\xc0\xaa\xe1\xcb\xce\xe1\xaf\xb2\xe0\x27\xdf\x36\xbc\x04\xdc\xec\xbf\x15\x43\x36\xc1\x9f\x0a\xf7\xe0\xa6\x47\x29\x05\xe7\x99\xf1\x95\x3d\x2a\x0f\xf3\x34\x8a\xb2\x1a\xa4\xad\xaf\xd1\xd2\x34\x44\x1c\xf8\x07\xc0\x3a\x00" + } + +testVec :: String -> Vec -> [TestTree] +testVec s vec = + [ testCase (s ++ " gen publickey") (pub @=? Ed448.toPublic sec) + , testCase (s ++ " gen secretkey") (Ed448.generateSecretKey *> pure ()) + , testCase (s ++ " gen signature") (sig @=? Ed448.sign sec pub (vecMsg vec)) + , testCase (s ++ " verify sig") (True @=? Ed448.verify pub (vecMsg vec) sig) + ] + where + !sig = throwCryptoError $ Ed448.signature (vecSig vec) + !pub = throwCryptoError $ Ed448.publicKey (vecPub vec) + !sec = throwCryptoError $ Ed448.secretKey (vecSec vec) + +katTests :: [TestTree] +katTests = testVec "vec 1" vec1 + +tests = testGroup "Ed448" + [ testGroup "KATs" katTests + ] diff --git a/tests/Tests.hs b/tests/Tests.hs index b6ecf3a..cae8f46 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -21,6 +21,7 @@ import qualified KAT_PBKDF2 import qualified KAT_Curve25519 import qualified KAT_Curve448 import qualified KAT_Ed25519 +import qualified KAT_Ed448 import qualified KAT_OTP import qualified KAT_PubKey import qualified KAT_Scrypt @@ -52,6 +53,7 @@ tests = testGroup "cryptonite" , KAT_Curve25519.tests , KAT_Curve448.tests , KAT_Ed25519.tests + , KAT_Ed448.tests , KAT_PubKey.tests , KAT_OTP.tests , testGroup "KDF"