-- 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 :: SomePKPayload -> Either String EightOctetKeyId
eightOctetKeyID SomePKPayload
pkp =
    case SomePKPayload -> FingerprintingKey
classifyFingerprintingKey SomePKPayload
pkp of
        FingerprintingV3RSA PKPayload 'DeprecatedV3
_ PublicKey
rp -> EightOctetKeyId -> Either String EightOctetKeyId
forall a b. b -> Either a b
Right (PublicKey -> EightOctetKeyId
v3RSAKeyId PublicKey
rp)
        FingerprintingV3NonRSA PKPayload 'DeprecatedV3
_ ->
            String -> Either String EightOctetKeyId
forall a b. a -> Either a b
Left String
"Cannot calculate the key ID of a non-RSA V3 key"
        FingerprintingV4 PKPayload 'V4
pkpV4 ->
            Fingerprint -> Either String EightOctetKeyId
keyIdFromFingerprint (PKPayload 'V4 -> Fingerprint
fingerprintV4 PKPayload 'V4
pkpV4)
        FingerprintingV6 PKPayload 'V6
pkpV6 ->
            Fingerprint -> Either String EightOctetKeyId
keyIdFromFingerprint (PKPayload 'V6 -> Fingerprint
fingerprintV6 PKPayload 'V6
pkpV6)

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

fingerprint :: SomePKPayload -> Fingerprint
fingerprint :: SomePKPayload -> Fingerprint
fingerprint SomePKPayload
pkp =
    case SomePKPayload -> FingerprintingKey
classifyFingerprintingKey SomePKPayload
pkp of
        FingerprintingV3RSA PKPayload 'DeprecatedV3
pkpV3 PublicKey
_ -> PKPayload 'DeprecatedV3 -> Fingerprint
fingerprintV3 PKPayload 'DeprecatedV3
pkpV3
        FingerprintingV3NonRSA PKPayload 'DeprecatedV3
pkpV3 -> PKPayload 'DeprecatedV3 -> Fingerprint
fingerprintV3 PKPayload 'DeprecatedV3
pkpV3
        FingerprintingV4 PKPayload 'V4
pkpV4 -> PKPayload 'V4 -> Fingerprint
fingerprintV4 PKPayload 'V4
pkpV4
        FingerprintingV6 PKPayload 'V6
pkpV6 -> PKPayload 'V6 -> Fingerprint
fingerprintV6 PKPayload 'V6
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 -> FingerprintingKey
classifyFingerprintingKey
    ( SomePKPayload
            pkp :: PKPayload v
pkp@(PKPayloadV3 ThirtyTwoBitTimeStamp
_ V3Expiration
_ PubKeyAlgorithm
pka (RSAPubKey (RSA_PublicKey PublicKey
rp)))
        )
        | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
RSA
            Bool -> Bool -> Bool
|| PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
DeprecatedRSAEncryptOnly
            Bool -> Bool -> Bool
|| PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
DeprecatedRSASignOnly =
            PKPayload 'DeprecatedV3 -> PublicKey -> FingerprintingKey
FingerprintingV3RSA PKPayload v
PKPayload 'DeprecatedV3
pkp PublicKey
rp
classifyFingerprintingKey (SomePKPayload pkp :: PKPayload v
pkp@PKPayloadV3 {}) =
    PKPayload 'DeprecatedV3 -> FingerprintingKey
FingerprintingV3NonRSA PKPayload v
PKPayload 'DeprecatedV3
pkp
classifyFingerprintingKey (SomePKPayload pkp :: PKPayload v
pkp@PKPayloadV4 {}) =
    PKPayload 'V4 -> FingerprintingKey
FingerprintingV4 PKPayload v
PKPayload 'V4
pkp
classifyFingerprintingKey (SomePKPayload pkp :: PKPayload v
pkp@PKPayloadV6 {}) =
    PKPayload 'V6 -> FingerprintingKey
FingerprintingV6 PKPayload v
PKPayload 'V6
pkp

v3RSAKeyId :: RSA.PublicKey -> EightOctetKeyId
v3RSAKeyId :: PublicKey -> EightOctetKeyId
v3RSAKeyId =
    ByteString -> EightOctetKeyId
EightOctetKeyId
        (ByteString -> EightOctetKeyId)
-> (PublicKey -> ByteString) -> PublicKey -> EightOctetKeyId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.reverse
        (ByteString -> ByteString)
-> (PublicKey -> ByteString) -> PublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.take Int
8
        (ByteString -> ByteString)
-> (PublicKey -> ByteString) -> PublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.reverse
        (ByteString -> ByteString)
-> (PublicKey -> ByteString) -> PublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp
        (Integer -> ByteString)
-> (PublicKey -> Integer) -> PublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Integer
RSA.public_n

fingerprintV3 :: PKPayload 'DeprecatedV3 -> Fingerprint
fingerprintV3 :: PKPayload 'DeprecatedV3 -> Fingerprint
fingerprintV3 = ByteString -> Fingerprint
fingerprintFromDigestMD5 (ByteString -> Fingerprint)
-> (PKPayload 'DeprecatedV3 -> ByteString)
-> PKPayload 'DeprecatedV3
-> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKPayload 'DeprecatedV3 -> ByteString
forall (v :: KeyVersion). PKPayload v -> ByteString
serializeForFingerprinting

fingerprintV4 :: PKPayload 'V4 -> Fingerprint
fingerprintV4 :: PKPayload 'V4 -> Fingerprint
fingerprintV4 = ByteString -> Fingerprint
fingerprintFromDigestSHA1 (ByteString -> Fingerprint)
-> (PKPayload 'V4 -> ByteString) -> PKPayload 'V4 -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKPayload 'V4 -> ByteString
forall (v :: KeyVersion). PKPayload v -> ByteString
serializeForFingerprinting

fingerprintV6 :: PKPayload 'V6 -> Fingerprint
fingerprintV6 :: PKPayload 'V6 -> Fingerprint
fingerprintV6 = ByteString -> Fingerprint
fingerprintFromDigestSHA256 (ByteString -> Fingerprint)
-> (PKPayload 'V6 -> ByteString) -> PKPayload 'V6 -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKPayload 'V6 -> ByteString
forall (v :: KeyVersion). PKPayload v -> ByteString
serializeForFingerprinting

serializeForFingerprinting :: PKPayload v -> BL.ByteString
serializeForFingerprinting :: forall (v :: KeyVersion). PKPayload v -> ByteString
serializeForFingerprinting =
    Put -> ByteString
runPut (Put -> ByteString)
-> (PKPayload v -> Put) -> PKPayload v -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Put
putPKPforFingerprinting (Pkt -> Put) -> (PKPayload v -> Pkt) -> PKPayload v -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomePKPayload -> Pkt
PublicKeyPkt (SomePKPayload -> Pkt)
-> (PKPayload v -> SomePKPayload) -> PKPayload v -> Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKPayload v -> SomePKPayload
forall (v :: KeyVersion). PKPayload v -> SomePKPayload
SomePKPayload

fingerprintFromDigestMD5 :: BL.ByteString -> Fingerprint
fingerprintFromDigestMD5 :: ByteString -> Fingerprint
fingerprintFromDigestMD5 ByteString
serialized =
    let digest :: Digest MD5
digest = ByteString -> Digest MD5
forall a. HashAlgorithm a => ByteString -> Digest a
hashlazy ByteString
serialized :: Digest MD5
     in ByteString -> Fingerprint
Fingerprint (Digest MD5 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Digest MD5
digest)

fingerprintFromDigestSHA1 :: BL.ByteString -> Fingerprint
fingerprintFromDigestSHA1 :: ByteString -> Fingerprint
fingerprintFromDigestSHA1 ByteString
serialized =
    let digest :: Digest SHA1
digest = ByteString -> Digest SHA1
forall a. HashAlgorithm a => ByteString -> Digest a
hashlazy ByteString
serialized :: Digest SHA1
     in ByteString -> Fingerprint
Fingerprint (Digest SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Digest SHA1
digest)

fingerprintFromDigestSHA256 :: BL.ByteString -> Fingerprint
fingerprintFromDigestSHA256 :: ByteString -> Fingerprint
fingerprintFromDigestSHA256 ByteString
serialized =
    let digest :: Digest SHA256
digest = ByteString -> Digest SHA256
forall a. HashAlgorithm a => ByteString -> Digest a
hashlazy ByteString
serialized :: Digest SHA256
     in ByteString -> Fingerprint
Fingerprint (Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Digest SHA256
digest)