XEd25519 signature algorithm. (Signatures using montgomery cv25519 keys).

5 files changed, 260 insertions, 3 deletions

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: