Minimal support for cv25519 parsing.

1 files changed, 71 insertions, 9 deletions

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 8fef50a..2fab94a 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -62,7 +62,8 @@ module Data.OpenPGP (
         signatures,
         signature_issuer,
         public_key_fields,
-        secret_key_fields
+        secret_key_fields,
+        eccOID
 ) where
 
 import Numeric
@@ -288,7 +289,7 @@ instance BINARY_CLASS Packet where
         get = do
                 tag <- get
                 let (t, l) =
-                        if testBit tag 6 then
+                        if testBit (tag :: Word8) 6 then
                                 (tag .&. 63, parse_new_length)
                         else
                                 ((tag `shiftR` 2) .&. 15, (,) <$> parse_old_length tag <*> pure False)
@@ -342,8 +343,10 @@ public_key_fields RSA_E   = public_key_fields RSA
 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']
-public_key_fields _       = undefined -- Nothing in the spec. Maybe empty
+public_key_fields ECDSA   = ['c','l','x', 'y'] -- TODO: These probably need special fingerprint handling.
+public_key_fields Ed25519 = ['c','l','x', 'y'] -- TODO: These probably need special fingerprint handling.
+public_key_fields ECC     = ['c','l','x', 'y'] -- TODO: These probably need special fingerprint handling.
+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
 secret_key_fields :: KeyAlgorithm -> [Char]
@@ -353,7 +356,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 _       = undefined -- Nothing in the spec. Maybe empty
+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
@@ -405,6 +408,16 @@ calculate_signature_trailer x =
         error ("Trying to calculate signature trailer for: " ++ show x)
 
 
+-- 0x2b06010401da470f01
+-- common/openpgp-oid.c    50 { "Ed25519",    "1.3.6.1.4.1.11591.15.1", 255, "ed25519", PUBKEY_ALGO_EDDSA },
+--
+-- 0x2b060104019755010501
+-- common/openpgp-oid.c    49 { "Curve25519", "1.3.6.1.4.1.3029.1.5.1", 255, "cv25519", PUBKEY_ALGO_ECDH },
+eccOID :: Packet -> Maybe BS.ByteString
+eccOID PublicKeyPacket { key = k } = lookup 'c' k >>= \(MPI oid) -> Just (snd $ putBigNum oid)
+eccOID SecretKeyPacket { key = k } = lookup 'c' k >>= \(MPI oid) -> Just (snd $ putBigNum oid)
+eccOID _ = Nothing
+
 encode_public_key_material :: Packet -> [B.ByteString]
 encode_public_key_material k | key_algorithm k == ECDSA  = do
     -- http://tools.ietf.org/html/rfc6637
@@ -421,13 +434,30 @@ encode_public_key_material k | key_algorithm k == ECDSA  = do
 encode_public_key_material k = map (encode . (key k !)) (public_key_fields $ key_algorithm k)
 
 decode_public_key_material :: KeyAlgorithm -> Get [(Char,MPI)]
-decode_public_key_material ECDSA = do
-    -- http://tools.ietf.org/html/rfc6637
+decode_public_key_material algorithm | algorithm `elem` [ECDSA, Ed25519] = do
+    -- http://tools.ietf.org/html/rfc6637 (9) Algorithm-Specific Fields for ECDSA keys
+    oidlen <- get :: Get Word8
+    oidbytes <- getSomeByteString (fromIntegral oidlen)
+    let mpiFromBytes bytes = MPI (getBigNum $ B.toStrict bytes)
+        oid = mpiFromBytes oidbytes
+    MPI xy <- get
+    let integerBytesize i = fromIntegral $ LZ.length (encode (MPI i)) - 2
+        width = ( integerBytesize xy - 1 ) `div` 2
+        (fx,y) = xy `quotRem` (256^width)
+        x = fx `rem` (256^width)
+        l = width*8
+    return [('c',oid), ('l',MPI l), ('x',MPI x), ('y',MPI y)]
+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 (B.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0 bytes)
+    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
     let integerBytesize i = fromIntegral $ LZ.length (encode (MPI i)) - 2
         width = ( integerBytesize xy - 1 ) `div` 2
         (fx,y) = xy `quotRem` (256^width)
@@ -556,6 +586,36 @@ put_packet (ModificationDetectionCodePacket bstr) = (bstr, 19)
 put_packet (UnsupportedPacket tag bytes) = (bytes, fromIntegral tag)
 put_packet x = error ("Unsupported Packet version or type in put_packet: " ++ show x)
 
+-- For reference, GnuPG (as of commit 3a403ab04) uses this:
+-- typedef enum
+--   {
+--     PKT_NONE          = 0,
+--     PKT_PUBKEY_ENC    = 1,  /* Public key encrypted packet. */
+--     PKT_SIGNATURE     = 2,  /* Secret key encrypted packet. */
+--     PKT_SYMKEY_ENC    = 3,  /* Session key packet. */
+--     PKT_ONEPASS_SIG   = 4,  /* One pass sig packet. */
+--     PKT_SECRET_KEY    = 5,  /* Secret key. */
+--     PKT_PUBLIC_KEY    = 6,  /* Public key. */
+--     PKT_SECRET_SUBKEY = 7,  /* Secret subkey. */
+--     PKT_COMPRESSED    = 8,  /* Compressed data packet. */
+--     PKT_ENCRYPTED     = 9,  /* Conventional encrypted data. */
+--     PKT_MARKER        = 10, /* Marker packet. */
+--     PKT_PLAINTEXT     = 11, /* Literal data packet. */
+--     PKT_RING_TRUST    = 12, /* Keyring trust packet. */
+--     PKT_USER_ID       = 13, /* User id packet. */
+--     PKT_PUBLIC_SUBKEY = 14, /* Public subkey. */
+--     PKT_OLD_COMMENT   = 16, /* Comment packet from an OpenPGP draft. */
+--     PKT_ATTRIBUTE     = 17, /* PGP's attribute packet. */
+--     PKT_ENCRYPTED_MDC = 18, /* Integrity protected encrypted data. */
+--     PKT_MDC           = 19, /* Manipulation detection code packet. */
+--     PKT_ENCRYPTED_AEAD= 20, /* AEAD encrypted data packet. */
+--     PKT_COMMENT       = 61, /* new comment packet (GnuPG specific). */
+--     PKT_GPG_CONTROL   = 63  /* internal control packet (GnuPG specific). */
+--   }
+-- pkttype_t;
+--
+-- PKT_OLD_COMMENT, PKT_ATTRIBUTE, PKT_ENCRYPTED_AEAD, are not implemented here.
+-- Also ommitted are GnuPG-specific packets: PKT_COMMENT and PKT_GPG_CONTROL.
 parse_packet :: Word8 -> Get Packet
 -- AsymmetricSessionKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.1
 parse_packet  1 = AsymmetricSessionKeyPacket
@@ -832,7 +892,7 @@ instance BINARY_CLASS HashAlgorithm where
         put = put . enum_to_word8
         get = fmap enum_from_word8 get
 
-data KeyAlgorithm = RSA | RSA_E | RSA_S | ELGAMAL | DSA | ECC | ECDSA | DH | KeyAlgorithm Word8
+data KeyAlgorithm = RSA | RSA_E | RSA_S | ELGAMAL | DSA | ECC | ECDSA | DH | Ed25519 | KeyAlgorithm Word8
         deriving (Show, Read, Eq)
 
 instance Enum KeyAlgorithm where
@@ -844,6 +904,7 @@ instance Enum KeyAlgorithm where
         toEnum 18 = ECC
         toEnum 19 = ECDSA
         toEnum 21 = DH
+        toEnum 22 = Ed25519
         toEnum x  = KeyAlgorithm $ fromIntegral x
         fromEnum RSA     = 01
         fromEnum RSA_E   = 02
@@ -853,6 +914,7 @@ instance Enum KeyAlgorithm where
         fromEnum ECC     = 18
         fromEnum ECDSA   = 19
         fromEnum DH      = 21
+        fromEnum Ed25519 = 22
         fromEnum (KeyAlgorithm x) = fromIntegral x
 
 instance BINARY_CLASS KeyAlgorithm where