Adapted to new ecc solutoin for OpenPGP-Haskell

1 files changed, 76 insertions, 67 deletions

diff --git a/Data/OpenPGP/Util/Sign.hs b/Data/OpenPGP/Util/Sign.hs
index e492f95..4a6eb4f 100644
--- a/Data/OpenPGP/Util/Sign.hs
+++ b/Data/OpenPGP/Util/Sign.hs
@@ -17,9 +17,15 @@ import qualified Crypto.Random as Vincent
 import qualified Crypto.PubKey.DSA as Vincent.DSA
 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
 
 import Data.OpenPGP.Util.Base
 
+privateECDSAkey :: OpenPGP.Packet -> Vincent.ECDSA.PrivateKey
+privateECDSAkey k = Vincent.ECDSA.PrivateKey curve d
+ where
+    d = keyParam 'd' k
+    curve = curveFromOID (keyParam 'c' k)
 
 privateDSAkey :: OpenPGP.Packet -> Vincent.DSA.PrivateKey
 privateDSAkey k = Vincent.DSA.PrivateKey
@@ -46,74 +52,77 @@ privateRSAkey k =
 -- Operation is unsafe in that it silently re-uses "random" bytes when
 -- entropy runs out.  Use pgpSign for a safer interface.
 unsafeSign :: (Vincent.CPRG g) => -- CryptoRandomGen g) =>
-        OpenPGP.Message          -- ^ SecretKeys, one of which will be used
-        -> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet
-        -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature
-        -> String                -- ^ KeyID of key to choose
-        -> Integer               -- ^ Timestamp for signature (unless sig supplied)
-        -> g                     -- ^ Random number generator
-        -> (OpenPGP.SignatureOver, g)
+    OpenPGP.Message          -- ^ SecretKeys, one of which will be used
+    -> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet
+    -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature
+    -> String                -- ^ KeyID of key to choose
+    -> Integer               -- ^ Timestamp for signature (unless sig supplied)
+    -> g                     -- ^ Random number generator
+    -> (OpenPGP.SignatureOver, g)
 unsafeSign keys over hsh keyid timestamp g = (over {OpenPGP.signatures_over = [sig]}, g')
-        where
-        (final, g') = case OpenPGP.key_algorithm sig of
-                OpenPGP.DSA -> ([dsaR, dsaS], dsaG)
-                kalgo | kalgo `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> ([toNum rsaFinal], g)
-                      | otherwise ->
-                        error ("Unsupported key algorithm " ++ show kalgo ++ "in sign")
-        (Vincent.DSA.Signature dsaR dsaS,dsaG) = let k' = privateDSAkey k in
-                Vincent.DSA.sign g k' (dsaTruncate k' . bhash) dta
-        (Right rsaFinal,_) = Vincent.RSA.signSafer g desc (privateRSAkey k) dta
-        dsaTruncate (Vincent.DSA.PrivateKey (Vincent.DSA.Params _ _ q) _) = BS.take (integerBytesize q)
-        dta     = toStrictBS $ encode over `LZ.append` OpenPGP.trailer sig
-        sig     = findSigOrDefault (listToMaybe $ OpenPGP.signatures_over over)
-        -- padding = emsa_pkcs1_v1_5_hash_padding hsh
-        desc = hashAlgoDesc hsh
-        bhash   = hashBySymbol hsh . toLazyBS
-        toNum   = BS.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0
-        Just k  = find_key keys keyid
-
-        -- Either a SignaturePacket was found, or we need to make one
-        findSigOrDefault (Just s) = OpenPGP.signaturePacket
-                (OpenPGP.version s)
-                (OpenPGP.signature_type s)
-                (OpenPGP.key_algorithm k) -- force to algo of key
-                hsh -- force hash algorithm
-                (OpenPGP.hashed_subpackets s)
-                (OpenPGP.unhashed_subpackets s)
-                (OpenPGP.hash_head s)
-                (map OpenPGP.MPI final)
-        findSigOrDefault Nothing  = OpenPGP.signaturePacket
-                4
-                defaultStype
-                (OpenPGP.key_algorithm k) -- force to algo of key
-                hsh
-                ([
-                        -- Do we really need to pass in timestamp just for the default?
-                        OpenPGP.SignatureCreationTimePacket $ fromIntegral timestamp,
-                        OpenPGP.IssuerPacket $ fingerprint k
-                ] ++ (case over of
-                        OpenPGP.KeySignature  {} -> [OpenPGP.KeyFlagsPacket {
-                                        OpenPGP.certify_keys = True,
-                                        OpenPGP.sign_data = True,
-                                        OpenPGP.encrypt_communication = False,
-                                        OpenPGP.encrypt_storage = False,
-                                        OpenPGP.split_key = False,
-                                        OpenPGP.authentication = False,
-                                        OpenPGP.group_key = False
-                                }]
-                        _ -> []
-                ))
-                []
-                0 -- TODO
-                (map OpenPGP.MPI final)
-
-        defaultStype = case over of
-                OpenPGP.DataSignature ld _
-                        | OpenPGP.format ld == 'b'     -> 0x00
-                        | otherwise                    -> 0x01
-                OpenPGP.KeySignature {}           -> 0x1F
-                OpenPGP.SubkeySignature {}        -> 0x18
-                OpenPGP.CertificationSignature {} -> 0x13
+    where
+    (final, g') = case OpenPGP.key_algorithm sig of
+        OpenPGP.DSA -> ([dsaR, dsaS], dsaG)
+        OpenPGP.ECDSA -> ([ecdsaR,ecdsaS],ecdsaG)
+        kalgo | kalgo `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> ([toNum rsaFinal], g)
+              | otherwise ->
+            error ("Unsupported key algorithm " ++ show kalgo ++ " in sign")
+    (Vincent.DSA.Signature dsaR dsaS,dsaG) = let k' = privateDSAkey k in
+        Vincent.DSA.sign g k' (dsaTruncate k' . bhash) dta
+    (Vincent.ECDSA.Signature ecdsaR ecdsaS,ecdsaG) = let k' = privateECDSAkey k in
+        Vincent.ECDSA.sign g k' bhash dta
+    (Right rsaFinal,_) = Vincent.RSA.signSafer g desc (privateRSAkey k) dta
+    dsaTruncate (Vincent.DSA.PrivateKey (Vincent.DSA.Params _ _ q) _) = BS.take (integerBytesize q)
+    dta     = toStrictBS $ encode over `LZ.append` OpenPGP.trailer sig
+    sig     = findSigOrDefault (listToMaybe $ OpenPGP.signatures_over over)
+    -- padding = emsa_pkcs1_v1_5_hash_padding hsh
+    desc = hashAlgoDesc hsh
+    bhash   = hashBySymbol hsh . toLazyBS
+    toNum   = BS.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0
+    Just k  = find_key keys keyid
+
+    -- Either a SignaturePacket was found, or we need to make one
+    findSigOrDefault (Just s) = OpenPGP.signaturePacket
+        (OpenPGP.version s)
+        (OpenPGP.signature_type s)
+        (OpenPGP.key_algorithm k) -- force to algo of key
+        hsh -- force hash algorithm
+        (OpenPGP.hashed_subpackets s)
+        (OpenPGP.unhashed_subpackets s)
+        (OpenPGP.hash_head s)
+        (map OpenPGP.MPI final)
+    findSigOrDefault Nothing  = OpenPGP.signaturePacket
+        4
+        defaultStype
+        (OpenPGP.key_algorithm k) -- force to algo of key
+        hsh
+        ([
+            -- Do we really need to pass in timestamp just for the default?
+            OpenPGP.SignatureCreationTimePacket $ fromIntegral timestamp,
+            OpenPGP.IssuerPacket $ fingerprint k
+        ] ++ (case over of
+            OpenPGP.KeySignature  {} -> [OpenPGP.KeyFlagsPacket {
+                    OpenPGP.certify_keys = True,
+                    OpenPGP.sign_data = True,
+                    OpenPGP.encrypt_communication = False,
+                    OpenPGP.encrypt_storage = False,
+                    OpenPGP.split_key = False,
+                    OpenPGP.authentication = False,
+                    OpenPGP.group_key = False
+                }]
+            _ -> []
+        ))
+        []
+        0 -- TODO
+        (map OpenPGP.MPI final)
+
+    defaultStype = case over of
+        OpenPGP.DataSignature ld _
+            | OpenPGP.format ld == 'b'     -> 0x00
+            | otherwise                    -> 0x01
+        OpenPGP.KeySignature {}           -> 0x1F
+        OpenPGP.SubkeySignature {}        -> 0x18
+        OpenPGP.CertificationSignature {} -> 0x13