From 76bf7e08bccbb1a3a689068016b8a9c29d1e060e Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Sun, 10 Nov 2019 14:27:48 -0500
Subject: Ed25519 secret portion (create + sign).

---
 Data/OpenPGP.hs              |   1 +
 Data/OpenPGP/Internal.hs     |   2 -
 Data/OpenPGP/Util/Ed25519.hs | 116 +++++++++++++++++++++++++++++++------------
 Data/OpenPGP/Util/Gen.hs     |  16 ++++--
 Data/OpenPGP/Util/Sign.hs    |   2 +
 5 files changed, 100 insertions(+), 37 deletions(-)

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 3fc4311..45ca27e 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -360,6 +360,7 @@ secret_key_fields RSA_S   = secret_key_fields RSA
 secret_key_fields ELGAMAL = ['x']
 secret_key_fields DSA     = ['x']
 secret_key_fields ECDSA   = ['d']
+secret_key_fields Ed25519 = ['d']
 secret_key_fields alg     = error ("Unkown secret fields for "++show alg) -- Nothing in the spec. Maybe empty
 
 (!) :: (HasCallStack, Show k, Eq k) => [(k,v)] -> k -> v
diff --git a/Data/OpenPGP/Internal.hs b/Data/OpenPGP/Internal.hs
index f9a8803..a4cdc10 100644
--- a/Data/OpenPGP/Internal.hs
+++ b/Data/OpenPGP/Internal.hs
@@ -77,7 +77,6 @@ integerToBS i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \p
         cnt <- exportIntegerToAddr i addr 1# -- 1# for big-endian (use 0# for little-endian)
         return ()
 
-{-
 getBigNumLE :: BS.ByteString -> Integer
 getBigNumLE bytes = unsafeDupablePerformIO $
     let (fptr,offset,len) = BS.toForeignPtr bytes
@@ -92,4 +91,3 @@ integerToLE i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \p
         let Ptr addr = ptr
         cnt <- exportIntegerToAddr i addr 0#
         return ()
--}
diff --git a/Data/OpenPGP/Util/Ed25519.hs b/Data/OpenPGP/Util/Ed25519.hs
index ed277c8..7504e7e 100644
--- a/Data/OpenPGP/Util/Ed25519.hs
+++ b/Data/OpenPGP/Util/Ed25519.hs
@@ -1,51 +1,103 @@
 module Data.OpenPGP.Util.Ed25519 where
 
+import Control.Monad
 import Crypto.Error
 import qualified Crypto.PubKey.Ed25519 as Ed25519
-import Data.OpenPGP.Internal -- (integerToBS,integerToLE,getBigNumLE)
-import qualified Data.OpenPGP as OpenPGP
-import Crypto.ECC.Edwards25519
+import Data.Bits
+import qualified Data.ByteArray        as BA
+import qualified Data.ByteString       as BS
+import qualified Data.ByteString.Lazy  as BL
 
-import qualified Data.ByteArray as BA
-import Control.Monad
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as BL
-import Data.List
-import Data.Int
-import Data.Word
+import qualified Data.OpenPGP as OpenPGP
+import Data.OpenPGP (MPI(..))
+import Data.OpenPGP.Internal
 import Data.OpenPGP.Util.Base
+-- import Crypto.ECC.Edwards25519
 
-import Text.Printf
-import Numeric
-import Data.Char
-import System.IO
+oid_ed25516 = 0x2B06010401DA470F01
 
-import Foreign.Ptr
-import System.IO.Unsafe
+zeroExtend :: Int -> BS.ByteString -> BS.ByteString
+zeroExtend n bs = case compare (BS.length bs) n of
+    GT -> BS.take n bs
+    EQ -> bs
+    LT -> bs <> BS.replicate (n - BS.length bs) 0
 
-import Crypto.Cipher.SBox
+zeroPad :: Int -> BS.ByteString -> BS.ByteString
+zeroPad n bs = case compare (BS.length bs) n of
+    GT -> BS.take n bs
+    EQ -> bs
+    LT -> BS.replicate (n - BS.length bs) 0 <> bs
 
 ed25519Key :: OpenPGP.Packet -> Maybe Ed25519.PublicKey
-ed25519Key k = case Ed25519.publicKey $ integerToBS $ keyParam 'n' k of
-    CryptoPassed ed25519 -> Just ed25519
-    CryptoFailed err     -> Nothing
+ed25519Key k =
+    let n = case keyParam 'f' k of
+                0x40 -> zeroPad 32 $ integerToBS $ keyParam 'n' k
+                _    ->
+                    -- From Bernstein's "High-speed high-security signatures"
+                    --
+                    -- An element (x, y) ∈ E is encoded as a b-bit string (x, y), namely the (b −
+                    -- 1)- bit encoding of y followed by a sign bit; the sign bit is 1 iff x is
+                    -- negative.  This encoding immediately determines y, and it determines x via
+                    -- the equation x = ± √(y² − 1)/(dy² + 1).
+                    let y = keyParam 'y' k
+                        x = keyParam 'x' k
+                        ybs = zeroExtend 32 $ integerToLE y
+                        lb = BS.last ybs
+                    in if x < 0 then BS.take 31 ybs `BS.snoc` (lb .|. 1)
+                                else BS.take 31 ybs `BS.snoc` (lb .&. 0xFE)
+    in case Ed25519.publicKey n of
+            CryptoPassed ed25519 -> Just ed25519
+            CryptoFailed _       -> Nothing
 
+ed25519sig :: OpenPGP.Packet -> Maybe Ed25519.Signature
 ed25519sig sig =
-    let [OpenPGP.MPI r,OpenPGP.MPI s] = OpenPGP.signature sig
-        -- rbs = BS.pack $ take 32 $ rbytes r ++ repeat 0
-        -- sbs = BS.pack $ take 32 $ rbytes s ++ repeat 0
-        rbs = let r' = integerToBS r in BS.replicate (32 - BS.length r') 0 <> r'
-        sbs = let s' = integerToBS s in BS.replicate (32 - BS.length s') 0 <> s'
+    let [MPI r,MPI s] = OpenPGP.signature sig
+        rbs = zeroPad 32 $ integerToBS r
+        sbs = zeroPad 32 $ integerToBS s
     in case Ed25519.signature (rbs <> sbs) of
-        CryptoPassed sig -> Just sig
-        CryptoFailed err -> Nothing
+        CryptoPassed sig25519 -> Just sig25519
+        CryptoFailed _        -> Nothing
+
+privateEd25519Key :: OpenPGP.Packet -> Ed25519.SecretKey
+privateEd25519Key k = case Ed25519.secretKey $ zeroExtend 32 $ integerToLE (keyParam 'd' k) of
+    CryptoPassed ed25519sec -> ed25519sec
+    CryptoFailed err        -> error $ "Ed25519.secretKey: " ++ show err
 
 ed25519Verify :: OpenPGP.Packet -> BS.ByteString -> OpenPGP.Packet -> Maybe Bool
 ed25519Verify sig over k = do
     let hashbs = hashBySymbol (OpenPGP.hash_algorithm sig) $ BL.fromChunks [over]
-    guard $ 0x2B06010401DA470F01 == keyParam 'c' k -- Only Ed25519 curve.
-    k' <- ed25519Key k -- SecretKeyPacket ???
-    sig' <- ed25519sig sig
-    let result = Ed25519.verify k' hashbs sig'
-    Just result
+    guard $ oid_ed25516 == keyParam 'c' k -- Only Ed25519 curve.
+    ek <- ed25519Key k
+    esig <- ed25519sig sig
+    Just $ Ed25519.verify ek hashbs esig
+
+ed25519Sign :: OpenPGP.Packet -> OpenPGP.HashAlgorithm -> BS.ByteString -> [Integer]
+ed25519Sign k hsh dta = [ getBigNum rbs, getBigNum sbs ]
+ where
+    hashbs = hashBySymbol hsh $ BL.fromChunks [dta]
+    sec = privateEd25519Key k
+    Just pub = ed25519Key k
+    sig = Ed25519.sign sec pub hashbs
+    (rbs,sbs) = BS.splitAt 32 $ BA.convert sig
+
+importSecretEd25519 :: Ed25519.SecretKey -> [(Char,MPI)]
+importSecretEd25519 k =
+    [ ('c', MPI oid_ed25516)
+    , ('l', MPI 128)
+    , ('n', MPI pub)
+    , ('f', MPI 0x40)
+    , ('d', MPI sec)
+    ]
+ where
+    pub = getBigNum $ BA.convert $ Ed25519.toPublic k
+    sec = getBigNumLE $ BA.convert k
 
+importPublicEd25519 :: Ed25519.PublicKey -> [(Char,MPI)]
+importPublicEd25519 k =
+    [ ('c', MPI oid_ed25516)
+    , ('l', MPI 128)
+    , ('n', MPI pub)
+    , ('f', MPI 0x40)
+    ]
+ where
+    pub = getBigNum $ BA.convert k
diff --git a/Data/OpenPGP/Util/Gen.hs b/Data/OpenPGP/Util/Gen.hs
index c5d0159..ca3c684 100644
--- a/Data/OpenPGP/Util/Gen.hs
+++ b/Data/OpenPGP/Util/Gen.hs
@@ -14,6 +14,8 @@ import qualified Crypto.PubKey.RSA as Vincent.RSA
 import qualified Crypto.PubKey.RSA.PKCS15 as Vincent.RSA
 import qualified Crypto.PubKey.ECC.ECDSA as Vincent.ECDSA
 #if defined(VERSION_cryptonite)
+import qualified Crypto.PubKey.Ed25519 as Ed25519
+import Data.OpenPGP.Util.Ed25519
 import Control.Arrow (second)
 import Data.Binary
 #endif
@@ -22,7 +24,7 @@ import Data.OpenPGP.Util.Base
 
 data GenerateKeyParams = GenRSA Int -- keysize
                        | GenDSA (Maybe DSAParams)
-
+                       | GenEd25519
  deriving (Eq,Ord,Show)
 
 data DSAParams = DSAParams
@@ -32,8 +34,9 @@ data DSAParams = DSAParams
  deriving (Eq,Ord,Show)
 
 genKeyAlg :: GenerateKeyParams -> KeyAlgorithm
-genKeyAlg (GenRSA _) = RSA
-genKeyAlg (GenDSA _) = DSA
+genKeyAlg (GenRSA _)      = RSA
+genKeyAlg (GenDSA _)      = DSA
+genKeyAlg (GenEd25519 {}) = Ed25519
 
 -- | Generate a secret key pgp packet from system entropy.
 generateKey :: GenerateKeyParams -> IO Packet
@@ -115,6 +118,13 @@ generateKey' (GenDSA mbparams) g =
         vincent (DSAParams p g q) = Vincent.DSA.Params p g q
         (priv,g') = withDRG g $ Vincent.DSA.generatePrivate dsa_params
     in ( dsaFields (Vincent.DSA.PrivateKey dsa_params priv), g' )
+generateKey' (GenEd25519 {}) g = withDRG g $ do
+    k <- Ed25519.generateSecretKey
+    return $ importSecretEd25519 k
+    -- file:///usr/share/doc/libghc-cryptonite-doc/html/Crypto-PubKey-Ed25519.html#v:generateSecretKey
+    -- generateSecretKey :: MonadRandom m => m SecretKey
+    -- n = public key used to verify signatures.
+    -- public_key_fields Ed25519 = ['c','l','x', 'y', 'n', 'f']
 
 #endif
 
diff --git a/Data/OpenPGP/Util/Sign.hs b/Data/OpenPGP/Util/Sign.hs
index d96c3a7..085d545 100644
--- a/Data/OpenPGP/Util/Sign.hs
+++ b/Data/OpenPGP/Util/Sign.hs
@@ -17,6 +17,7 @@ import Data.Time.Clock.POSIX
 #endif
 import Control.Exception as Exception (IOException(..),catch)
 
+import Data.OpenPGP.Util.Ed25519
 import Data.OpenPGP.Util.Fingerprint (fingerprint)
 import Data.OpenPGP.Util.Gen
 
@@ -69,6 +70,7 @@ unsafeSign keys over hsh keyid timestamp g = (over {OpenPGP.signatures_over = [s
     (final, g') = case OpenPGP.key_algorithm sig of
         OpenPGP.DSA -> ([dsaR, dsaS], dsaG)
         OpenPGP.ECDSA -> ([ecdsaR,ecdsaS],ecdsaG)
+        OpenPGP.Ed25519 -> (ed25519Sign k hsh dta, g)
         kalgo | kalgo `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> ([toNum rsaFinal], g)
               | otherwise ->
             error ("Unsupported key algorithm " ++ show kalgo ++ " in sign")
-- 
cgit v1.2.3