Ed25519 support.

6 files changed, 136 insertions, 38 deletions

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 35298c8..4627d4e 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -64,7 +64,9 @@ module Data.OpenPGP (
         signature_issuer,
         public_key_fields,
         secret_key_fields,
-        eccOID
+        eccOID,
+        encode_public_key_material,
+        decode_public_key_material
 ) where
 
 import Control.Applicative
@@ -80,6 +82,7 @@ import Data.Maybe
 import Data.Monoid
 import Data.OpenPGP.Internal
 import Data.Word
+import GHC.Stack
 import Numeric
 
 #ifdef CEREAL
@@ -345,8 +348,8 @@ public_key_fields RSA_S   = public_key_fields RSA
 public_key_fields ELGAMAL = ['p', 'g', 'y']
 public_key_fields DSA     = ['p', 'q', 'g', 'y']
 public_key_fields ECDSA   = ['c','l','x', 'y', 'f']
-public_key_fields Ed25519 = ['c','l','x', 'y', 'f']
-public_key_fields ECC     = ['c','l','x', 'y', 'f']
+public_key_fields Ed25519 = ['c','l','x', 'y', 'n', 'f']
+public_key_fields ECC     = ['c','l','x', 'y', 'n', 'f', 'e']
 public_key_fields alg     = error ("Unknown key fields for "++show alg) -- Nothing in the spec. Maybe empty
 
 -- http://tools.ietf.org/html/rfc4880#section-5.5.3
@@ -359,8 +362,10 @@ secret_key_fields DSA     = ['x']
 secret_key_fields ECDSA   = ['d']
 secret_key_fields alg     = error ("Unkown secret fields for "++show alg) -- Nothing in the spec. Maybe empty
 
-(!) :: (Eq k) => [(k,v)] -> k -> v
-(!) xs k = let Just x = lookup k xs in x
+(!) :: (HasCallStack, Show k, Eq k) => [(k,v)] -> k -> v
+(!) xs k = case lookup k xs of
+            Just v  -> v
+            Nothing -> error ("Missing field "++show k++" at "++prettyCallStack callStack)
 
 -- Need this seperate for trailer calculation
 signature_packet_start :: Packet -> B.ByteString
@@ -420,19 +425,28 @@ eccOID SecretKeyPacket { key = k } = lookup 'c' k >>= \(MPI oid) -> Just (snd $
 eccOID _ = Nothing
 
 encode_public_key_material :: Packet -> [B.ByteString]
-encode_public_key_material k | key_algorithm k `elem` [ECDSA,Ed25519]  = do
+encode_public_key_material k | key_algorithm k `elem` [ECDSA,Ed25519,ECC]  = do
     -- http://tools.ietf.org/html/rfc6637
     c <- maybeToList $ lookup 'c' (key k)
     MPI l <- maybeToList $ lookup 'l' (key k)
-    MPI x <- maybeToList $ lookup 'x' (key k)
-    MPI y <- maybeToList $ lookup 'y' (key k)
     MPI flag <- maybeToList $ lookup 'f' (key k)
     let (bitlen,oid) = B.splitAt 2 (encode c)
         len16 = decode bitlen :: Word16
         (fullbytes,rembits) = len16 `quotRem` 8
         len8 = fromIntegral (fullbytes + if rembits/=0 then 1 else 0) :: Word8
-        xy = flag*(4^l) + x*(2^l) + y -- flag could be 0x04 or 0x40
-    [ len8 `B.cons` oid, encode (MPI xy) ]
+        eccstuff = case lookup 'e' (key k) of
+            Just stuff -> encode stuff
+            Nothing    -> B.empty
+    case flag of
+        0x40 -> do
+            MPI n <- maybeToList $ lookup 'n' (key k)
+            let xy = flag*(4^l) + n
+            [ len8 `B.cons` oid, encode (MPI xy), eccstuff ]
+        _ -> do
+            MPI x <- maybeToList $ lookup 'x' (key k)
+            MPI y <- maybeToList $ lookup 'y' (key k)
+            let xy = flag*(4^l) + x*(2^l) + y
+            [ len8 `B.cons` oid, encode (MPI xy), eccstuff ]
 encode_public_key_material k = map (encode . (key k !)) (public_key_fields $ key_algorithm k)
 
 decode_public_key_material :: KeyAlgorithm -> Get [(Char,MPI)]
@@ -442,30 +456,42 @@ decode_public_key_material algorithm | algorithm `elem` [ECDSA, Ed25519] = do
     oidbytes <- getSomeByteString (fromIntegral oidlen)
     let mpiFromBytes bytes = MPI (getBigNum $ B.toStrict bytes)
         oid = mpiFromBytes oidbytes
-    MPI xy <- get
+    MPI fxy <- get
     let integerBytesize i = fromIntegral $ LZ.length (encode (MPI i)) - 2
-        width = ( integerBytesize xy - 1 ) `div` 2
-        (fx,y) = xy `quotRem` (256^width)
-        (flag,x) = fx `quotRem` (256^width)
+        width = ( integerBytesize fxy - 1 ) `div` 2
         l = width*8
-    return [('c',oid), ('l',MPI l), ('x',MPI x), ('y',MPI y), ('f',MPI flag)]
+        (flag,xy) = fxy `quotRem` (256^(2*width))
+    return $ case flag of
+        0x40 -> [('c',oid), ('l',MPI l), ('n',MPI xy), ('f',MPI flag)]
+        _    -> let (x,y) = xy `quotRem` (256^width)
+                    -- (fx,y) = xy `quotRem` (256^width)
+                    -- (flag,x) = fx `quotRem` (256^width)
+                in [('c',oid), ('l',MPI l), ('x',MPI x), ('y',MPI y), ('f',MPI flag)]
 decode_public_key_material ECC = do
     -- http://tools.ietf.org/html/rfc6637 (9) Algorithm-Specific Fields for ECDH keys:
     oidlen <- get :: Get Word8
     oidbytes <- getSomeByteString (fromIntegral oidlen)
     let mpiFromBytes bytes = MPI (getBigNum $ B.toStrict bytes)
         oid = mpiFromBytes oidbytes
-    MPI xy <- get
-    flen <- get :: Get Word8
-    one <- get :: Get Word8
-    hashid <- get :: Get Word8
-    algoid <- get :: Get Word8
+    MPI fxy <- get
+    eccstuff <- get :: Get Word32
+        {- eccstuff is 4 one-byte fields:
+                flen <- get :: Get Word8
+                one <- get :: Get Word8 -- always 0x01
+                hashid <- get :: Get Word8
+                algoid <- get :: Get Word8
+        -}
     let integerBytesize i = fromIntegral $ LZ.length (encode (MPI i)) - 2
-        width = ( integerBytesize xy - 1 ) `div` 2
-        (fx,y) = xy `quotRem` (256^width)
-        (flag,x) = fx `quotRem` (256^width)
+        width = ( integerBytesize fxy - 1 ) `div` 2
         l = width*8
-    return [('c',oid), ('l',MPI l), ('x',MPI x), ('y',MPI y), ('f',MPI flag)]
+        (flag,xy) = fxy `quotRem` (256^(2*width))
+        result = case flag of
+            0x40 -> [('c',oid), ('l',MPI l), ('n',MPI xy), ('f',MPI flag)]
+            _    -> let (x,y) = xy `quotRem` (256^width)
+                        -- (fx,y) = xy `quotRem` (256^width)
+                        -- (flag,x) = fx `quotRem` (256^width)
+                    in [('c',oid), ('l',MPI l), ('x',MPI x), ('y',MPI y), ('f',MPI flag)]
+    return $ result ++ [('e',MPI (fromIntegral eccstuff))]
 decode_public_key_material algorithm = mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm)
 
 put_packet :: Packet -> (B.ByteString, Word8)
@@ -1130,6 +1156,7 @@ data SignatureSubpacket =
                 hash                  :: B.ByteString
         } |
         EmbeddedSignaturePacket Packet |
+        -- TODO: IssuerFingerprintPacket (tag=33)
         UnsupportedSignatureSubpacket Word8 B.ByteString
         deriving (Show, Read, Eq)
 
diff --git a/Data/OpenPGP/Internal.hs b/Data/OpenPGP/Internal.hs
index 175a62e..f9a8803 100644
--- a/Data/OpenPGP/Internal.hs
+++ b/Data/OpenPGP/Internal.hs
@@ -16,20 +16,20 @@ import           System.IO.Unsafe
 
 
 decode_s2k_count :: Word8 -> Word32
-decode_s2k_count c =  (16 + (fromIntegral c .&. 15)) `shiftL`
-        ((fromIntegral c `shiftR` 4) + 6)
+decode_s2k_count c = shiftL (16 + (fromIntegral c .&. 15))
+                            ((fromIntegral c `shiftR` 4) + 6)
 
 encode_s2k_count :: Word32 -> Word8
 encode_s2k_count iterations
-        | iterations >= 65011712 = 255
-        | decode_s2k_count result < iterations = result+1
-        | otherwise = result
-        where
-        result = fromIntegral $ (fromIntegral c `shiftL` 4) .|. (count - 16)
-        (count, c) = encode_s2k_count' (iterations `shiftR` 6) (0::Word8)
-        encode_s2k_count' count c
-                | count < 32 = (count, c)
-                | otherwise = encode_s2k_count' (count `shiftR` 1) (c+1)
+    | iterations >= 65011712 = 255
+    | decode_s2k_count result < iterations = result+1
+    | otherwise = result
+    where
+    result = fromIntegral $ (fromIntegral c `shiftL` 4) .|. (count - 16)
+    (count, c) = encode_s2k_count' (iterations `shiftR` 6) (0::Word8)
+    encode_s2k_count' count c
+        | count < 32 = (count, c)
+        | otherwise = encode_s2k_count' (count `shiftR` 1) (c+1)
 
 {-
 getBigNum :: BS.ByteString -> Integer
@@ -70,8 +70,26 @@ putBigNum i = ( (fromIntegral (BS.length bytes) - 1) * 8 + sigBit
     sigBit = fromIntegral $ 8 - countLeadingZeros (BS.index bytes 0)
     bytes = integerToBS i
 
+-- big-endian
 integerToBS :: Integer -> BS.ByteString
 integerToBS i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \ptr -> do
         let Ptr addr = ptr
-        cnt <- exportIntegerToAddr i addr 1#
+        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
+    in withForeignPtr fptr $ \ptr -> do
+        let Ptr addr = ptr `plusPtr` offset :: Ptr Word64
+            I# n = len
+        importIntegerFromAddr addr (int2Word# n) 0#
+
+-- little-endian
+integerToLE :: Integer -> BS.ByteString
+integerToLE i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \ptr -> do
+        let Ptr addr = ptr
+        cnt <- exportIntegerToAddr i addr 0#
+        return ()
+-}
diff --git a/Data/OpenPGP/Util/Base.hs b/Data/OpenPGP/Util/Base.hs
index 5b3e159..0c888ca 100644
--- a/Data/OpenPGP/Util/Base.hs
+++ b/Data/OpenPGP/Util/Base.hs
@@ -85,7 +85,6 @@ find_key :: OpenPGP.Message -> String -> Maybe OpenPGP.Packet
 find_key = OpenPGP.find_key (show . fingerprint)
 
 
-
 keyParam :: Char -> OpenPGP.Packet -> Integer
 keyParam c k = fromJustMPI $ lookup c (OpenPGP.key k)
  where
diff --git a/Data/OpenPGP/Util/Ed25519.hs b/Data/OpenPGP/Util/Ed25519.hs
new file mode 100644
index 0000000..ed277c8
--- /dev/null
+++ b/Data/OpenPGP/Util/Ed25519.hs
@@ -0,0 +1,51 @@
+module Data.OpenPGP.Util.Ed25519 where
+
+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 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 Data.OpenPGP.Util.Base
+
+import Text.Printf
+import Numeric
+import Data.Char
+import System.IO
+
+import Foreign.Ptr
+import System.IO.Unsafe
+
+import Crypto.Cipher.SBox
+
+ed25519Key :: OpenPGP.Packet -> Maybe Ed25519.PublicKey
+ed25519Key k = case Ed25519.publicKey $ integerToBS $ keyParam 'n' k of
+    CryptoPassed ed25519 -> Just ed25519
+    CryptoFailed err     -> Nothing
+
+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'
+    in case Ed25519.signature (rbs <> sbs) of
+        CryptoPassed sig -> Just sig
+        CryptoFailed err -> Nothing
+
+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
+
diff --git a/Data/OpenPGP/Util/Verify.hs b/Data/OpenPGP/Util/Verify.hs
index fd83485..5eea260 100644
--- a/Data/OpenPGP/Util/Verify.hs
+++ b/Data/OpenPGP/Util/Verify.hs
@@ -19,6 +19,7 @@ import Crypto.PubKey.HashDescr
 #endif
 
 import Data.OpenPGP.Util.Base
+import Data.OpenPGP.Util.Ed25519
 
 
 dsaKey :: OpenPGP.Packet -> Vincent.DSA.PublicKey
@@ -43,6 +44,7 @@ verify ::
 verify keys over =
     over {OpenPGP.signatures_over = mapMaybe (uncurry $ verifyOne keys) sigs}
     where
+    sigs :: [(OpenPGP.Packet,BS.ByteString)]
     sigs = map (\s -> (s, toStrictBS $ encode over `LZ.append` OpenPGP.trailer s))
         (OpenPGP.signatures_over over)
 
@@ -52,6 +54,7 @@ verifyOne keys sig over = fmap (const sig) $ maybeKey >>= verification >>= guard
     verification = case OpenPGP.key_algorithm sig of
         OpenPGP.DSA -> dsaVerify
         OpenPGP.ECDSA -> ecdsaVerify
+        OpenPGP.Ed25519 -> ed25519Verify sig over
         alg | alg `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> rsaVerify
             | otherwise -> const Nothing
 
@@ -97,4 +100,3 @@ verifyOne keys sig over = fmap (const sig) $ maybeKey >>= verification >>= guard
     hash_algo = OpenPGP.hash_algorithm sig
     maybeKey = OpenPGP.signature_issuer sig >>= find_key keys
                -- in trace ("maybeKey="++show (fmap OpenPGP.key_algorithm r)) r
-
diff --git a/openpgp-util.cabal b/openpgp-util.cabal
index 33b5ff6..b0d7f53 100644
--- a/openpgp-util.cabal
+++ b/openpgp-util.cabal
@@ -136,6 +136,7 @@ library
                 Data.OpenPGP.Util.Sign
                 Data.OpenPGP.Util.Gen
                 Data.OpenPGP.Util.DecryptSecretKey
+                Data.OpenPGP.Util.Ed25519
         build-depends:
                 base == 4.*,
                 transformers,