ECDSA support and build-for-jessie

2 files changed, 47 insertions, 8 deletions

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 1f0ff34..74aae5f 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -74,17 +74,18 @@ import Data.Bits
 import Data.Word
 import Data.Char
 import Data.List
+import Data.Maybe
 import Data.OpenPGP.Internal
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LZ
 
 #ifdef CEREAL
-import Data.Serialize hiding (decode)
+import Data.Serialize
 import qualified Data.ByteString as B
 import qualified Data.ByteString.UTF8 as B (toString, fromString)
 #define BINARY_CLASS Serialize
 #else
-import Data.Binary hiding (decode)
+import Data.Binary
 import Data.Binary.Get
 import Data.Binary.Put
 import qualified Data.ByteString.Lazy as B
@@ -135,12 +136,17 @@ getSomeByteString = getLazyByteString . fromIntegral
 putSomeByteString :: B.ByteString -> Put
 putSomeByteString = putLazyByteString
 
+#if MIN_VERSION_binary(0,6,4)
 localGet :: Get a -> B.ByteString -> Get a
 localGet g bs = case runGetOrFail g bs of
         Left (_,_,s) -> fail s
         Right (leftover,_,v)
                 | B.null leftover -> return v
                 | otherwise -> fail $ "Leftover in localGet: " ++ show leftover
+#else
+localGet :: Get a -> B.ByteString -> Get a
+localGet g bs = return $ runGet g bs
+#endif
 
 compress :: CompressionAlgorithm -> B.ByteString -> B.ByteString
 compress = lazyCompress
@@ -335,6 +341,7 @@ 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
 
 -- http://tools.ietf.org/html/rfc4880#section-5.5.3
@@ -344,6 +351,7 @@ secret_key_fields RSA_E   = secret_key_fields RSA
 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
 
 (!) :: (Eq k) => [(k,v)] -> k -> v
@@ -395,6 +403,38 @@ calculate_signature_trailer p@(SignaturePacket {version = 4}) =
 calculate_signature_trailer x =
         error ("Trying to calculate signature trailer for: " ++ show x)
 
+
+encode_public_key_material :: Packet -> [B.ByteString]
+encode_public_key_material k | key_algorithm k == ECDSA  = 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)
+    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 = 4*(4^l) + x*(2^l) + y
+    [ len8 `B.cons` oid, encode (MPI xy) ]
+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
+    oidlen <- get :: Get Word8
+    oidbytes <- getSomeByteString (fromIntegral oidlen)
+    let mpiFromBytes bytes = MPI (B.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0 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 algorithm = mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm)
+
 put_packet :: Packet -> (B.ByteString, Word8)
 put_packet (AsymmetricSessionKeyPacket version key_id key_algorithm dta) =
         (B.concat [
@@ -491,7 +531,7 @@ put_packet p@(PublicKeyPacket { version = v, timestamp = timestamp,
         where
         Just v3_days = v3_days_of_validity p
         final x = (x, if is_subkey then 14 else 6)
-        material = map (encode . (key !)) (public_key_fields algorithm)
+        material = encode_public_key_material p
 put_packet (CompressedDataPacket { compression_algorithm = algorithm,
                                    message = message }) =
         (B.append (encode algorithm) $ compress algorithm $ encode message, 8)
@@ -632,7 +672,7 @@ parse_packet  6 = do
                         timestamp <- get
                         days <- get
                         algorithm <- get
-                        key <- mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm)
+                        key <- decode_public_key_material algorithm
                         return PublicKeyPacket {
                                 version = version,
                                 timestamp = timestamp,
@@ -644,7 +684,7 @@ parse_packet  6 = do
                 4 -> do
                         timestamp <- get
                         algorithm <- get
-                        key <- mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm)
+                        key <- decode_public_key_material algorithm
                         return PublicKeyPacket {
                                 version = 4,
                                 timestamp = timestamp,
@@ -710,8 +750,7 @@ fingerprint_material p | version p == 4 =
                 material
         ]
         where
-        material = B.concat $ map (encode . (key p !))
-                (public_key_fields $ key_algorithm p)
+        material = B.concat $ encode_public_key_material p
 fingerprint_material p | version p `elem` [2, 3] = [n, e]
         where
         n = B.drop 2 (encode (key p ! 'n'))
diff --git a/openpgp.cabal b/openpgp.cabal
index 7214bf5..d9af124 100644
--- a/openpgp.cabal
+++ b/openpgp.cabal
@@ -138,7 +138,7 @@ library
                 base == 4.*,
                 bytestring,
                 utf8-string,
-                binary >= 0.6.4.0,
+                binary >= 0.5.1.1,
                 zlib,
                 bzlib