1 files changed, 51 insertions, 24 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)