Fingerprint.hs

-- Fingerprint.hs: OpenPGP (RFC9580) fingerprinting methods
-- Copyright © 2012-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}

module Codec.Encryption.OpenPGP.Fingerprint
  ( eightOctetKeyID
  , fingerprint
  ) where

import Crypto.Hash (Digest, hashlazy)
import Crypto.Hash.Algorithms (MD5, SHA1, SHA256)
import Crypto.Number.Serialize (i2osp)
import qualified Crypto.PubKey.RSA as RSA
import Data.Binary.Put (runPut)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL

import Codec.Encryption.OpenPGP.SerializeForSigs (putPKPforFingerprinting)
import Codec.Encryption.OpenPGP.Types

eightOctetKeyID :: SomePKPayload -> Either String EightOctetKeyId
eightOctetKeyID pkp =
  case classifyFingerprintingKey pkp of
    FingerprintingV3RSA _ rp -> Right (v3RSAKeyId rp)
    FingerprintingV3NonRSA _ ->
      Left "Cannot calculate the key ID of a non-RSA V3 key"
    FingerprintingV4 pkpV4 ->
      Right (EightOctetKeyId (BL.drop 12 (unFingerprint (fingerprintV4 pkpV4))))
    FingerprintingV6 pkpV6 ->
      Right (EightOctetKeyId (BL.take 8 (unFingerprint (fingerprintV6 pkpV6))))

fingerprint :: SomePKPayload -> Fingerprint
fingerprint pkp =
  case classifyFingerprintingKey pkp of
    FingerprintingV3RSA pkpV3 _ -> fingerprintV3 pkpV3
    FingerprintingV3NonRSA pkpV3 -> fingerprintV3 pkpV3
    FingerprintingV4 pkpV4 -> fingerprintV4 pkpV4
    FingerprintingV6 pkpV6 -> fingerprintV6 pkpV6

data FingerprintingKey where
  FingerprintingV3RSA ::
       PKPayload 'DeprecatedV3
    -> RSA.PublicKey
    -> FingerprintingKey
  FingerprintingV3NonRSA :: PKPayload 'DeprecatedV3 -> FingerprintingKey
  FingerprintingV4 :: PKPayload 'V4 -> FingerprintingKey
  FingerprintingV6 :: PKPayload 'V6 -> FingerprintingKey

classifyFingerprintingKey :: SomePKPayload -> FingerprintingKey
classifyFingerprintingKey (SomePKPayload pkp@(PKPayloadV3 _ _ pka (RSAPubKey (RSA_PublicKey rp))))
  | pka == RSA || pka == DeprecatedRSAEncryptOnly || pka == DeprecatedRSASignOnly =
      FingerprintingV3RSA pkp rp
classifyFingerprintingKey (SomePKPayload pkp@PKPayloadV3 {}) =
  FingerprintingV3NonRSA pkp
classifyFingerprintingKey (SomePKPayload pkp@PKPayloadV4 {}) =
  FingerprintingV4 pkp
classifyFingerprintingKey (SomePKPayload pkp@PKPayloadV6 {}) =
  FingerprintingV6 pkp

v3RSAKeyId :: RSA.PublicKey -> EightOctetKeyId
v3RSAKeyId =
  EightOctetKeyId .
  BL.reverse . BL.take 8 . BL.reverse . BL.fromStrict . i2osp . RSA.public_n

fingerprintV3 :: PKPayload 'DeprecatedV3 -> Fingerprint
fingerprintV3 = fingerprintFromDigestMD5 . serializeForFingerprinting

fingerprintV4 :: PKPayload 'V4 -> Fingerprint
fingerprintV4 = fingerprintFromDigestSHA1 . serializeForFingerprinting

fingerprintV6 :: PKPayload 'V6 -> Fingerprint
fingerprintV6 = fingerprintFromDigestSHA256 . serializeForFingerprinting

serializeForFingerprinting :: PKPayload v -> BL.ByteString
serializeForFingerprinting =
  runPut . putPKPforFingerprinting . PublicKeyPkt . SomePKPayload

fingerprintFromDigestMD5 :: BL.ByteString -> Fingerprint
fingerprintFromDigestMD5 serialized =
  let digest = hashlazy serialized :: Digest MD5
   in Fingerprint (BL.fromStrict (BA.convert digest :: B.ByteString))

fingerprintFromDigestSHA1 :: BL.ByteString -> Fingerprint
fingerprintFromDigestSHA1 serialized =
  let digest = hashlazy serialized :: Digest SHA1
   in Fingerprint (BL.fromStrict (BA.convert digest :: B.ByteString))

fingerprintFromDigestSHA256 :: BL.ByteString -> Fingerprint
fingerprintFromDigestSHA256 serialized =
  let digest = hashlazy serialized :: Digest SHA256
   in Fingerprint (BL.fromStrict (BA.convert digest :: B.ByteString))