From 47fdd273f68e0af73595daa1f3a9cdff2c8a9320 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Sun, 10 May 2020 20:03:30 -0400
Subject: Compute v5 fingerprints for v4 keys.

---
 Data/OpenPGP.hs                  | 20 +++++++++++++++-----
 Data/OpenPGP/Util.hs             |  1 +
 Data/OpenPGP/Util/Fingerprint.hs | 20 ++++++++++++--------
 3 files changed, 28 insertions(+), 13 deletions(-)

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 3064dc5..bee718a 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -59,6 +59,8 @@ module Data.OpenPGP (
         MPI(..),
         find_key,
         fingerprint_material,
+        auto_fp_version,
+        fingerprint_materialv,
         SignatureOver(..),
         signatures,
         signature_issuer,
@@ -843,9 +845,17 @@ parse_packet 19 =
 -- Represent unsupported packets as their tag and literal bytes
 parse_packet tag = fmap (UnsupportedPacket tag) getRemainingByteString
 
+auto_fp_version :: Packet -> Word8
+auto_fp_version p | version p == 2  = 3
+                  | otherwise       = version p
+
+-- | Helper method for fingerprints and such
+fingerprint_material :: HasCallStack => Packet -> [B.ByteString]
+fingerprint_material p = fingerprint_materialv (auto_fp_version p) p
+
 -- | Helper method for fingerprints and such
-fingerprint_material :: Packet -> [B.ByteString]
-fingerprint_material p | version p == 5 =
+fingerprint_materialv :: HasCallStack => Word8 -> Packet -> [B.ByteString]
+fingerprint_materialv 5 p =
         [
                 B.singleton 0x9A,
                 encode (10 + fromIntegral (B.length material) :: Word32),
@@ -855,7 +865,7 @@ fingerprint_material p | version p == 5 =
         ]
         where
         material = B.concat $ encode_public_key_material p
-fingerprint_material p | version p == 4 =
+fingerprint_materialv 4 p =
         [
                 B.singleton 0x99,
                 encode (6 + fromIntegral (B.length material) :: Word16),
@@ -864,11 +874,11 @@ fingerprint_material p | version p == 4 =
         ]
         where
         material = B.concat $ encode_public_key_material p
-fingerprint_material p | version p `elem` [2, 3] = [n, e]
+fingerprint_materialv 3 p | key_algorithm p == RSA = [n, e]
         where
         n = B.drop 2 (encode (key p ! 'n'))
         e = B.drop 2 (encode (key p ! 'e'))
-fingerprint_material _ =
+fingerprint_materialv _ _ =
         error "Unsupported Packet version or type in fingerprint_material."
 
 enum_to_word8 :: (Enum a) => a -> Word8
diff --git a/Data/OpenPGP/Util.hs b/Data/OpenPGP/Util.hs
index 1781d6d..889ff10 100644
--- a/Data/OpenPGP/Util.hs
+++ b/Data/OpenPGP/Util.hs
@@ -1,5 +1,6 @@
 module Data.OpenPGP.Util
     ( fingerprint
+    , fingerprintv
     , Fingerprint(..)
     , hex
     , decryptSecretKey
diff --git a/Data/OpenPGP/Util/Fingerprint.hs b/Data/OpenPGP/Util/Fingerprint.hs
index d88661b..cda25f6 100644
--- a/Data/OpenPGP/Util/Fingerprint.hs
+++ b/Data/OpenPGP/Util/Fingerprint.hs
@@ -1,11 +1,12 @@
 {-# LANGUAGE CPP #-}
-module Data.OpenPGP.Util.Fingerprint (fingerprint,Fingerprint(..),hex) where
+module Data.OpenPGP.Util.Fingerprint (fingerprint,fingerprintv,Fingerprint(..),hex) where
 
 import qualified Data.OpenPGP as OpenPGP
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LZ
 import Data.Char (toUpper)
 import Data.Word (Word8)
+import GHC.Stack
 import Numeric (showHex)
 
 #if defined(VERSION_cryptonite)
@@ -39,12 +40,15 @@ hex (Fingerprint bs) = hexify bs
 
 -- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket
 -- <http://tools.ietf.org/html/rfc4880#section-12.2>
-fingerprint :: OpenPGP.Packet -> Fingerprint
-fingerprint p
-    | OpenPGP.version p == 5 = Fingerprint $ sha256 material
-    | OpenPGP.version p == 4 = Fingerprint $ sha1 material
-    | OpenPGP.version p `elem` [2, 3] = Fingerprint $ md5 material
-    | otherwise = error "Unsupported Packet version or type in fingerprint"
+fingerprint :: HasCallStack => OpenPGP.Packet -> Fingerprint
+fingerprint p = fingerprintv (OpenPGP.auto_fp_version p) p
+
+fingerprintv :: HasCallStack => Word8 -> OpenPGP.Packet -> Fingerprint
+fingerprintv v p = case v of
+    5 -> Fingerprint $ sha256 material
+    4 -> Fingerprint $ sha1 material
+    3 -> Fingerprint $ md5 material
+    _ -> error "Unsupported Packet version or type in fingerprint"
     where
 
 #if defined(VERSION_cryptonite)
@@ -57,4 +61,4 @@ fingerprint p
     md5 = MD5.hashlazy
 #endif
 
-    material = LZ.concat $ OpenPGP.fingerprint_material p
+    material = LZ.concat $ OpenPGP.fingerprint_materialv v p
-- 
cgit v1.2.3