-- 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 :: 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 ->
      EightOctetKeyId -> Either String EightOctetKeyId
forall a b. b -> Either a b
Right (ByteString -> EightOctetKeyId
EightOctetKeyId (Int64 -> ByteString -> ByteString
BL.drop Int64
12 (Fingerprint -> ByteString
unFingerprint (PKPayload 'V4 -> Fingerprint
fingerprintV4 PKPayload 'V4
pkpV4))))
    FingerprintingV6 PKPayload 'V6
pkpV6 ->
      EightOctetKeyId -> Either String EightOctetKeyId
forall a b. b -> Either a b
Right (ByteString -> EightOctetKeyId
EightOctetKeyId (Int64 -> ByteString -> ByteString
BL.take Int64
8 (Fingerprint -> ByteString
unFingerprint (PKPayload 'V6 -> Fingerprint
fingerprintV6 PKPayload 'V6
pkpV6))))

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
BL.reverse (ByteString -> ByteString)
-> (PublicKey -> ByteString) -> PublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString -> ByteString
BL.take Int64
8 (ByteString -> ByteString)
-> (PublicKey -> ByteString) -> PublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.reverse (ByteString -> ByteString)
-> (PublicKey -> ByteString) -> PublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (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 (ByteString -> ByteString
BL.fromStrict (Digest MD5 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Digest MD5
digest :: B.ByteString))

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 (ByteString -> ByteString
BL.fromStrict (Digest SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Digest SHA1
digest :: B.ByteString))

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 (ByteString -> ByteString
BL.fromStrict (Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Digest SHA256
digest :: B.ByteString))