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
    , keyIdFromFingerprint
    ) 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 ->
            keyIdFromFingerprint (fingerprintV4 pkpV4)
        FingerprintingV6 pkpV6 ->
            keyIdFromFingerprint (fingerprintV6 pkpV6)

keyIdFromFingerprint
    :: Fingerprint -> Either String EightOctetKeyId
keyIdFromFingerprint (Fingerprint bs)
    | B.length bs == 20 = Right (EightOctetKeyId (B.drop 12 bs))
    | B.length bs == 32 = Right (EightOctetKeyId (B.take 8 bs))
    | otherwise =
        Left "cannot derive key ID from fingerprint of unexpected length"

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
        . B.reverse
        . B.take 8
        . B.reverse
        . 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 (BA.convert digest)

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

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