From 6252bdbd0531feaa6ac9e881dffe5c92b8b40197 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Thu, 14 Nov 2019 18:49:43 -0500 Subject: XEd25519 signature algorithm. (Signatures using montgomery cv25519 keys). --- Crypto/XEd25519.hs | 193 ++++++++++++++++++++++++++++++++++++++++ Crypto/XEd25519/FieldElement.hs | 49 ++++++++++ Data/OpenPGP/Util/Cv25519.hs | 2 +- Data/OpenPGP/Util/Verify.hs | 14 ++- openpgp-util.cabal | 5 +- 5 files changed, 260 insertions(+), 3 deletions(-) create mode 100644 Crypto/XEd25519.hs create mode 100644 Crypto/XEd25519/FieldElement.hs diff --git a/Crypto/XEd25519.hs b/Crypto/XEd25519.hs new file mode 100644 index 0000000..1088347 --- /dev/null +++ b/Crypto/XEd25519.hs @@ -0,0 +1,193 @@ +module Crypto.XEd25519 where + +import Control.Arrow +import Data.Bits +import Data.ByteArray as BA +import Data.Memory.PtrMethods (memCopy) +import Crypto.Hash +import Crypto.ECC.Edwards25519 +import Crypto.Error +import qualified Crypto.PubKey.Ed25519 as Ed25519 +import Foreign.Marshal +import Foreign.Ptr +import Foreign.Storable +import qualified Crypto.PubKey.Curve25519 as X25519 + +import Crypto.XEd25519.FieldElement +-- import Crypto.Nonce + + +data SecretKey = SecretKey { secretScalar :: Scalar } + +data PublicKey = PublicKey Ed25519.PublicKey + deriving Eq + +-- type Nonce = Nonce32 +type Nonce = Bytes -- 32 bytes + +newtype EncodedPoint = EncodedPoint Point + +instance ByteArrayAccess SecretKey where + length _ = 32 + withByteArray (SecretKey scalar) = withByteArray (scalarEncode scalar :: Bytes) + +instance ByteArrayAccess PublicKey where + length _ = 32 + withByteArray (PublicKey edpub) = withByteArray edpub + +instance ByteArrayAccess EncodedPoint where + length _ = 32 + withByteArray (EncodedPoint pt) f = + withByteArray (pointEncode pt :: Bytes) f + + +data Signature = Signature EncodedPoint Scalar + +instance ByteArrayAccess Signature where + length _ = 64 + withByteArray (Signature pt scalar) f = + withByteArray pt $ \ptptr -> do + withByteArray (SecretKey scalar) $ \scalarptr -> do + allocaBytes 64 $ \ptr -> do + memCopy ptr ptptr 32 + memCopy (ptr `plusPtr` 32) scalarptr 32 + f (castPtr ptr) + +signatureDecode :: ByteArrayAccess ba => ba -> Maybe Signature +signatureDecode bs = do + let (ptbs,scbs) = BA.splitAt 32 ( BA.convert bs :: Bytes) + pt <- maybeCryptoError $ pointDecode ptbs + sc <- maybeCryptoError $ scalarDecodeLong scbs + return $ Signature (ge_p3_tobytes pt) sc + + +padding :: Bytes +padding = 0xFE `BA.cons` BA.replicate 31 0xFF + +sign :: ByteArrayAccess dta => dta -> Nonce -> SecretKey -> PublicKey -> Signature +sign dta nonce sec pub = Signature rB s + where + rB = ge_p3_tobytes $ ge_scalarmult_base r + + r = sc_reduce $ hashFinalize $ (`hashUpdate` padding) + >>> (`hashUpdate` sec) + >>> (`hashUpdate` dta) + >>> (`hashUpdate` nonce) $ hashInit + + h = sc_reduce $ hashFinalize $ (`hashUpdate` rB) + >>> (`hashUpdate` pub) + >>> (`hashUpdate` dta) $ hashInit + + -- s = r + ha (mod q) + s = sc_muladd h (secretScalar sec) r + + + +ge_p3_tobytes :: Point -> EncodedPoint +ge_p3_tobytes = EncodedPoint + +ge_scalarmult_base :: Scalar -> Point +ge_scalarmult_base = toPoint + +sc_muladd :: Scalar -> Scalar -> Scalar -> Scalar +sc_muladd a b c = scalarAdd (scalarMul a b) c + +sc_reduce :: Digest SHA512 -> Scalar +sc_reduce digest = x where CryptoPassed x = scalarDecodeLong digest -- ??? + +-- Scalar is internally, at least on 64bit machines, represented as 5 +-- 56-bit words in little-endian order, each encoded as a Word64. +sc_neg :: Scalar -> Scalar +sc_neg = scalarMul sc_neg1 + +verify :: ByteArrayAccess dta => PublicKey -> dta -> Signature -> Bool +verify pub dta signature = Ed25519.verify ed_pub dta ed_sig + where + CryptoPassed ed_pub = Ed25519.publicKey pub' + CryptoPassed ed_sig = Ed25519.signature signature' + + -- Get the sign bit from the s part of the signature. + sign_bit = BA.index signature 63 .&. 0x80 + + -- Set the sign bit to zero in the s part of the signature. + signature' :: Bytes + signature' = BA.copyAndFreeze signature $ \ptr -> do + let at63 = plusPtr ptr 63 + byte63 <- peek at63 + poke at63 $ byte63 .&. (0x7F `asTypeOf` sign_bit) + + -- Restore the sign bit on the verification key, which should have 0 as its + -- current sign bit. + pub' :: Bytes + pub' = BA.copyAndFreeze pub $ \ptr -> do + let at31 = plusPtr ptr 31 + byte31 <- peek at31 + poke at31 $ (byte31 .&. 0x7F) .|. sign_bit + + +-- typedef crypto_int32 fe[10]; +-- +-- fe means field element. Here the field is \Z/(2^255-19). +-- An element t, entries t[0]...t[9], represents the integer +-- t[0]+2^26 t[1]+2^51 t[2]+2^77 t[3]+2^102 t[4]+...+2^230 t[9]. +-- Bounds on each t[i] vary depending on context. + +-- mont_pub_to_ed_pub +toSigningKey :: X25519.PublicKey -> PublicKey +toSigningKey mont_pub0 = PublicKey ed_pub + where + -- Read the public key as a field element + mont_pub = fe_frombytes mont_pub0 + + -- Convert the Montgomery public key to a twisted Edwards public key + fe_ONE = fe_1 + + -- Calculate the parameters (u - 1) and (u + 1) + mont_pub_minus_one = fe_sub mont_pub fe_ONE + mont_pub_plus_one0 = fe_add mont_pub fe_ONE + + -- Prepare inv(u + 1) + mont_pub_plus_one = fe_invert mont_pub_plus_one0 + + -- Calculate y = (u - 1) * inv(u + 1) (mod p) + ed_pub0 = fe_mul mont_pub_minus_one mont_pub_plus_one + ed_pub = fe_tobytes ed_pub0 + +-- mont_priv_to_ed_pair +toSigningKeyPair :: X25519.SecretKey -> (SecretKey,PublicKey) +toSigningKeyPair mont_priv0 = (SecretKey ed_priv, PublicKey ed_pub) + where + -- Prepare a buffer for the twisted Edwards private key + ed_priv1 = (throwCryptoError . scalarDecodeLong :: X25519.SecretKey -> Scalar) mont_priv0 + + -- Get the twisted edwards public key, including the sign bit + ed_pub0 = ge_p3_tobytes $ ge_scalarmult_base ed_priv1 + + -- Save the sign bit for later + sign_bit = (BA.index ed_pub0 31 `shiftR` 7) .&. 1 + + -- Force the sign bit to zero + pub' :: Bytes + pub' = BA.copyAndFreeze ed_pub0 $ \ptr -> do + let at31 = plusPtr ptr 31 + byte31 <- peek at31 + poke at31 $ (byte31 .&. 0x7F) `asTypeOf` sign_bit + + CryptoPassed ed_pub = Ed25519.publicKey pub' + + + -- Prepare the negated private key + ed_priv_neg = sc_neg ed_priv1 + + -- Get the correct private key based on the sign stored above + ed_priv = if sign_bit/=0 then ed_priv_neg + else ed_priv1 + +-- sc_zero = throwCryptoError $ scalarDecodeLong (b::Bytes) +-- where +-- b = BA.pack $ encodeLittleEndian $ 2^252 + 27742317777372353535851937790883648493 + +sc_neg1 :: Scalar +sc_neg1 = throwCryptoError $ scalarDecodeLong (b::Bytes) + where + b = BA.pack $ encodeLittleEndian $ 2^252 + 27742317777372353535851937790883648492 diff --git a/Crypto/XEd25519/FieldElement.hs b/Crypto/XEd25519/FieldElement.hs new file mode 100644 index 0000000..7a91610 --- /dev/null +++ b/Crypto/XEd25519/FieldElement.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +module Crypto.XEd25519.FieldElement where + +import Crypto.Error +import qualified Crypto.PubKey.Curve25519 as X25519 +import qualified Crypto.PubKey.Ed25519 as Ed25519 +import Data.ByteArray as BA (pack,unpack,Bytes) +import Data.Modular +import Data.Word + +-- 2^255 - 19 +type P25519 = 57896044618658097711785492504343953926634992332820282019728792003956564819949 + +newtype FieldElement = FE (ℤ / P25519) + + +fe_frombytes :: X25519.PublicKey -> FieldElement +fe_frombytes pub = FE $ toMod $ decodeLittleEndian $ BA.unpack pub + +fe_tobytes :: FieldElement -> Ed25519.PublicKey +fe_tobytes (FE x) = throwCryptoError $ Ed25519.publicKey (b :: Bytes) + where + b = BA.pack $ take 32 $ (encodeLittleEndian $ unMod x) ++ repeat 0 + +fe_1 :: FieldElement +fe_1 = FE $ toMod 1 + +fe_sub :: FieldElement -> FieldElement -> FieldElement +fe_sub (FE x) (FE y) = FE $ x - y + +fe_add :: FieldElement -> FieldElement -> FieldElement +fe_add (FE x) (FE y) = FE $ x + y + +fe_invert :: FieldElement -> FieldElement +fe_invert (FE x) = FE $ inv x + +fe_mul :: FieldElement -> FieldElement -> FieldElement +fe_mul (FE x) (FE y) = FE (x * y) + +decodeLittleEndian :: [Word8] -> Integer +decodeLittleEndian [] = 0 +decodeLittleEndian (x:xs) = fromIntegral x + 256 * decodeLittleEndian xs + +encodeLittleEndian :: Integer -> [Word8] +encodeLittleEndian 0 = [] +encodeLittleEndian x = let (bs,b) = divMod x 256 + in fromIntegral b : encodeLittleEndian bs + diff --git a/Data/OpenPGP/Util/Cv25519.hs b/Data/OpenPGP/Util/Cv25519.hs index aef3521..4900b2f 100644 --- a/Data/OpenPGP/Util/Cv25519.hs +++ b/Data/OpenPGP/Util/Cv25519.hs @@ -17,7 +17,7 @@ import Numeric import Data.Int import Data.OpenPGP.Internal -import Data.OpenPGP.Util +import Data.OpenPGP.Util.Fingerprint import Data.OpenPGP.Util.Base import Data.OpenPGP as OpenPGP import Crypto.Cipher.SBox diff --git a/Data/OpenPGP/Util/Verify.hs b/Data/OpenPGP/Util/Verify.hs index 5eea260..66db2ab 100644 --- a/Data/OpenPGP/Util/Verify.hs +++ b/Data/OpenPGP/Util/Verify.hs @@ -20,7 +20,8 @@ import Crypto.PubKey.HashDescr import Data.OpenPGP.Util.Base import Data.OpenPGP.Util.Ed25519 - +import Data.OpenPGP.Util.Cv25519 as Cv25519 +import Crypto.XEd25519 as Xed25519 dsaKey :: OpenPGP.Packet -> Vincent.DSA.PublicKey dsaKey k = Vincent.DSA.PublicKey @@ -55,9 +56,20 @@ verifyOne keys sig over = fmap (const sig) $ maybeKey >>= verification >>= guard OpenPGP.DSA -> dsaVerify OpenPGP.ECDSA -> ecdsaVerify OpenPGP.Ed25519 -> ed25519Verify sig over + OpenPGP.ECC -> xed25519Verify alg | alg `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> rsaVerify | otherwise -> const Nothing + xed25519Verify k = do + guard $ oid_cv25519 == keyParam 'c' k + cvk <- cv25519Key $ OpenPGP.key k + let xed = Xed25519.toSigningKey cvk + -- verify :: ByteArrayAccess dta => PublicKey -> dta -> Signature -> Bool + let hashbs = hashBySymbol (OpenPGP.hash_algorithm sig) $ LZ.fromChunks [over] + edsig <- ed25519sig sig + xedsig <- Xed25519.signatureDecode edsig + Just $ Xed25519.verify xed hashbs xedsig + #if defined(VERSION_cryptonite) dsaVerify k = let k' = dsaKey k in -- XXX: What happened to dsaTruncate? diff --git a/openpgp-util.cabal b/openpgp-util.cabal index ae8d373..132cb05 100644 --- a/openpgp-util.cabal +++ b/openpgp-util.cabal @@ -130,6 +130,8 @@ library Crypto.Cipher.SBox Crypto.Cipher.ThomasToVincent Crypto.JOSE.AESKW + Crypto.XEd25519 + Crypto.XEd25519.FieldElement other-modules: Data.OpenPGP.Internal Data.OpenPGP.Util.Fingerprint @@ -153,7 +155,8 @@ library vector >=0.9, tagged >=0.4.2.1, cereal >=0.3.0, - integer-gmp + integer-gmp, + modular-arithmetic if flag(cryptonite) build-depends: -- cgit v1.2.3