From 0aaa6a9e9ac744f142e006f1bcb03b7615760bee Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Sun, 19 Apr 2015 09:24:37 +0100 Subject: [PATCH] [Ed25519] Add haskell bindings and tests --- Crypto/PubKey/Ed25519.hs | 139 +++++++++++++++++++++++++++++++++++++++ cryptonite.cabal | 2 + tests/KAT_Ed25519.hs | 38 +++++++++++ tests/Tests.hs | 2 + 4 files changed, 181 insertions(+) create mode 100644 Crypto/PubKey/Ed25519.hs create mode 100644 tests/KAT_Ed25519.hs diff --git a/Crypto/PubKey/Ed25519.hs b/Crypto/PubKey/Ed25519.hs new file mode 100644 index 0000000..45651a3 --- /dev/null +++ b/Crypto/PubKey/Ed25519.hs @@ -0,0 +1,139 @@ +-- | +-- Module : Crypto.PubKey.Ed25519 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- Ed25519 support +-- +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE BangPatterns #-} +module Crypto.PubKey.Ed25519 + ( SecretKey + , PublicKey + , Signature + -- * Smart constructors + , signature + , publicKey + , secretKey + -- * methods + , toPublic + , sign + , verify + ) where + +import Data.Word +import Foreign.Ptr +import Foreign.C.Types + +import Crypto.Internal.Compat +import Crypto.Internal.Imports +import Crypto.Internal.Memory +import Crypto.Internal.ByteArray +import Crypto.Error +import Data.ByteString (ByteString) + +-- | An Ed25519 Secret key +newtype SecretKey = SecretKey SecureBytes + deriving (Eq,ByteArrayAccess) + +-- | An Ed25519 public key +newtype PublicKey = PublicKey Bytes + deriving (Show,Eq,ByteArrayAccess) + +-- | An Ed25519 signature +newtype Signature = Signature Bytes + deriving (Show,Eq,ByteArrayAccess) + +-- | Try to build a public key from a bytearray +publicKey :: ByteArrayAccess ba => ba -> CryptoFailable PublicKey +publicKey bs + | byteArrayLength bs == publicKeySize = + CryptoPassed $ PublicKey $ byteArrayCopyAndFreeze bs (\_ -> return ()) + | otherwise = + CryptoFailed $ CryptoError_PublicKeySizeInvalid + +-- | Try to build a secret key from a bytearray +secretKey :: ByteArrayAccess ba => ba -> CryptoFailable SecretKey +secretKey bs + | byteArrayLength bs == secretKeySize = unsafeDoIO $ do + withByteArray bs $ \inp -> do + valid <- isValidPtr inp + if valid + then CryptoPassed . SecretKey <$> byteArrayCopy bs (\_ -> return ()) + else return $ CryptoFailed CryptoError_SecretKeyStructureInvalid + | otherwise = CryptoFailed CryptoError_SecretKeyStructureInvalid + where + isValidPtr :: Ptr Word8 -> IO Bool + isValidPtr _ = do + return True +{-# NOINLINE secretKey #-} + +-- | Try to build a signature from a bytearray +signature :: ByteArrayAccess ba => ba -> CryptoFailable Signature +signature bs + | byteArrayLength bs == signatureSize = + CryptoPassed $ Signature $ byteArrayCopyAndFreeze bs (\_ -> return ()) + | otherwise = + CryptoFailed CryptoError_SecretKeyStructureInvalid + +-- | Create a public key from a secret key +toPublic :: SecretKey -> PublicKey +toPublic (SecretKey sec) = PublicKey <$> + byteArrayAllocAndFreeze publicKeySize $ \result -> + withByteArray sec $ \psec -> + ccryptonite_ed25519_publickey psec result +{-# NOINLINE toPublic #-} + +-- | Sign a message using the key pair +sign :: ByteArrayAccess ba => SecretKey -> PublicKey -> ba -> Signature +sign secret public message = + Signature $ byteArrayAllocAndFreeze signatureSize $ \sig -> + withByteArray secret $ \sec -> + withByteArray public $ \pub -> + withByteArray message $ \msg -> + ccryptonite_ed25519_sign msg (fromIntegral msgLen) sec pub sig + where + !msgLen = byteArrayLength 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 <- ccryptonite_ed25519_sign_open msg (fromIntegral msgLen) pub sig + return (r == 0) + where + !msgLen = byteArrayLength message + +publicKeySize :: Int +publicKeySize = 32 + +secretKeySize :: Int +secretKeySize = 32 + +signatureSize :: Int +signatureSize = 64 + +foreign import ccall "cryptonite_ed25519_publickey" + ccryptonite_ed25519_publickey :: Ptr SecretKey -- secret key + -> Ptr PublicKey -- public key + -> IO () + +foreign import ccall "cryptonite_ed25519_sign_open" + ccryptonite_ed25519_sign_open :: Ptr Word8 -- message + -> CSize -- message len + -> Ptr PublicKey -- public + -> Ptr Signature -- signature + -> IO CInt + +foreign import ccall "cryptonite_ed25519_sign" + ccryptonite_ed25519_sign :: Ptr Word8 -- message + -> CSize -- message len + -> Ptr SecretKey -- secret + -> Ptr PublicKey -- public + -> Ptr Signature -- signature + -> IO () diff --git a/cryptonite.cabal b/cryptonite.cabal index c5b69b3..a35cb54 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -76,6 +76,7 @@ Library Crypto.PubKey.ECC.DH Crypto.PubKey.ECC.ECDSA Crypto.PubKey.ECC.Types + Crypto.PubKey.Ed25519 Crypto.PubKey.RSA Crypto.PubKey.RSA.PKCS15 Crypto.PubKey.RSA.Prim @@ -129,6 +130,7 @@ Library Crypto.Internal.CompatPrim Crypto.Internal.Bytes Crypto.Internal.Endian + Crypto.Internal.Hex Crypto.Internal.Imports Crypto.Internal.Memory Crypto.Internal.Words diff --git a/tests/KAT_Ed25519.hs b/tests/KAT_Ed25519.hs new file mode 100644 index 0000000..522f88f --- /dev/null +++ b/tests/KAT_Ed25519.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE BangPatterns #-} +module KAT_Ed25519 ( tests ) where + +import Crypto.Error +import qualified Crypto.PubKey.Ed25519 as Ed25519 +import Imports + +data Vec = Vec + { vecSec :: ByteString + , vecPub :: ByteString + , vecMsg :: ByteString + , vecSig :: ByteString + } deriving (Show,Eq) + +vec1 = Vec + { 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" + } + +testVec :: String -> Vec -> [TestTree] +testVec s vec = + [ testCase (s ++ " gen publickey") (pub @=? Ed25519.toPublic sec) + , testCase (s ++ " gen signature") (sig @=? Ed25519.sign sec pub (vecMsg vec)) + ] + where + !sig = throwCryptoError $ Ed25519.signature (vecSig vec) + !pub = throwCryptoError $ Ed25519.publicKey (vecPub vec) + !sec = throwCryptoError $ Ed25519.secretKey (vecSec vec) + +katTests :: [TestTree] +katTests = testVec "vec 1" vec1 + +tests = testGroup "Ed25519" + [ testGroup "KATs" katTests + ] diff --git a/tests/Tests.hs b/tests/Tests.hs index 258228d..c781a71 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -14,6 +14,7 @@ import qualified KATHash import qualified KAT_HMAC import qualified KAT_PBKDF2 import qualified KAT_Curve25519 +import qualified KAT_Ed25519 import qualified KAT_PubKey import qualified KAT_Scrypt -- symmetric cipher -------------------- @@ -80,6 +81,7 @@ tests = testGroup "cryptonite" , KATHash.tests , KAT_HMAC.tests , KAT_Curve25519.tests + , KAT_Ed25519.tests , KAT_PubKey.tests , KAT_PBKDF2.tests , KAT_Scrypt.tests