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

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Codec.Encryption.OpenPGP.Signatures
  ( SignError(..)
  , renderSignError
  , CertificationState(..)
  , certificationStateAt
  , VerificationError(..)
  , renderVerificationError
  , verifySigWith
  , verifyAgainstKeyring
  , verifyAgainstKeys
  , verifyTKWith
  , verifyUnknownTKWith
  , signCertificationWithRSA
  , signDirectKeyWithRSA
  , signKeyRevocationWithRSA
  , signSubkeyRevocationWithRSA
  , signCertRevocationWithRSA
  , signUserIDwithRSA
  , crossSignSubkeyWithRSA
  , signDataWithEd25519
  , signDataWithEd25519V6
  , signDataWithEd448
  , signDataWithEd448V6
  , signDataWithRSA
  , signDataWithRSAV6
  -- * Builder-based API (Phase 2)
  , signDataWithRSABuilder
  , signDataWithRSAV6Builder
  , signDataWithEd25519Builder
  , signDataWithEd25519V6Builder
  , signDataWithEd448Builder
  , signDataWithEd448V6Builder
  , signDataWithAlgorithmicBuilder
  -- * Text normalization mode
  , TextNormalizationMode(..)
  ) where

import Control.Applicative ((<|>))
import Control.Error.Util (hush)
import Control.Lens ((&), (^.), _1)
import Control.Monad (liftM2, when)

import Crypto.Error (eitherCryptoError)
import Crypto.Hash (hashWith)
import qualified Crypto.Hash.Algorithms as CHA
import Crypto.Number.Serialize (i2osp, os2ip)
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Crypto.PubKey.Ed448 as Ed448
import qualified Crypto.PubKey.RSA.PKCS15 as P15
import qualified Crypto.PubKey.RSA.Types as RSATypes

import Data.Bifunctor (first)
import Data.Binary.Put (runPut)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Either (isRight, lefts, rights)
import Data.Function (on)
import Data.IxSet.Typed ((@=))
import qualified Data.IxSet.Typed as IxSet
import qualified Data.Set as Set
import Data.List (find, intercalate, nub)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Maybe (isJust, mapMaybe)
import Data.Text (Text)
import Data.Time.Clock (UTCTime(..), addUTCTime, diffUTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Word (Word16, Word8)
import GHC.TypeLits (TypeError, ErrorMessage(..))

import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)
import Codec.Encryption.OpenPGP.Expirations
  ( isPKTimeValidWithSelfSignatures
  , keyStateAt
  , keyStateValid
  )
import Codec.Encryption.OpenPGP.Internal
  ( PktStreamContext(..)
  , emptyPSC
  , issuer
  , issuerFP
  )
import Codec.Encryption.OpenPGP.Ontology
  ( isCertRevocationSig
  , isRevocationKeySSP
  , isRevokerP
  , isSubkeyBindingSig
  , isSubkeyRevocation
  )
import Codec.Encryption.OpenPGP.SignatureQualities
  ( sigCT
  , sigHA
  , sigPKA
  , sigType
  , signatureHashedSubpacketsKnown
  , signatureSubpacketListsKnown
  )

import Codec.Encryption.OpenPGP.SerializeForSigs
  ( payloadForSig
  , putKeyforSigning
  , putPartialSigforSigning
  , putSigTrailer
  , putUforSigning
  )
import Codec.Encryption.OpenPGP.Policy (signatureV6SaltSizeForHashAlgorithm)
import Codec.Encryption.OpenPGP.Subpackets
  ( SigBuilder
  , TextNormalizationMode(..)
  , sbSigType
  , sbHashAlgo
  , sbHashedSubs
  , sbUnhashedSubs
  , sbSalt
  , sbTextNormMode
  , PrivateKeyFor
  )
import qualified Codec.Encryption.OpenPGP.Subpackets as SP
import Codec.Encryption.OpenPGP.Types
import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA
import Data.Conduit.OpenPGP.Keyring.Instances ()

data VerificationError
  = IssuerSubpacketMismatch
  | IssuerSubpacketUncheckable String
  | IssuerKeyIdProhibitedInV6Signature
  | IssuerFingerprintSubpacketMismatch
  | UnsupportedCriticalSubpacket SigType
  | UnknownCriticalPacketInStream Word8
  | BrokenCriticalPacketInStream Word8 String
  | ExternalVerificationError String
  | NonSignaturePacket
  | UnexpectedSignaturePayloadShape
  | MissingHashAlgorithm
  | HashComputationFailed String
  | UnexpectedKeyVersion
  | SignatureHashUnsupportedByAlgorithm HashAlgorithm PubKeyAlgorithm
  | KeyRevoked
  | SigningKeyUnavailableAtSignatureTime
  | MissingIssuer
  | SigningKeyNotFound (Maybe EightOctetKeyId) (Maybe Fingerprint)
  | MultipleVerificationSuccesses Int
  | UnsupportedKeyType PubKeyAlgorithm
  | SignatureMismatch PubKeyAlgorithm Fingerprint
  | SignatureShapeMismatch PubKeyAlgorithm
  | SignatureEncodingInvalid PubKeyAlgorithm String
  | SignaturePolicyHashUnsupported HashAlgorithm
  | SignaturePolicyPKAMismatch PubKeyAlgorithm PubKeyAlgorithm
  | SignatureExpired
  | CandidateKeyFailures [VerificationError]
  | InvalidSubkeyBackSignature VerificationError
    -- ^ An embedded primary-key back-signature (type 0x19) in a subkey
    -- binding signature failed to verify.
  deriving (Eq, Show)

data CertificationState
  = CertificationNotYetKnown
  | CertificationActive
  | CertificationRevoked
  deriving (Eq, Show)

renderVerificationError :: VerificationError -> String
renderVerificationError IssuerSubpacketMismatch =
  "verification failed: issuer subpacket does not match the actual signer"
renderVerificationError (IssuerSubpacketUncheckable err) =
  "verification failed: issuer subpacket cannot be checked (" ++ err ++ ")"
renderVerificationError IssuerKeyIdProhibitedInV6Signature =
  "verification failed: Issuer Key ID subpacket is prohibited in v6 signatures"
renderVerificationError IssuerFingerprintSubpacketMismatch =
  "verification failed: issuer fingerprint subpacket does not match the actual signer"
renderVerificationError (UnsupportedCriticalSubpacket sigType) =
  "verification failed: unsupported critical hashed subpacket in " ++
  show sigType ++ " signature"
renderVerificationError (UnknownCriticalPacketInStream t) =
  "verification failed: unknown critical packet type in packet sequence (" ++ show t ++ ")"
renderVerificationError (BrokenCriticalPacketInStream t err) =
  "verification failed: broken critical packet type " ++ show t ++ ": " ++ err
renderVerificationError (ExternalVerificationError err) = err
renderVerificationError NonSignaturePacket =
  "verification failed: non-signature packet encountered where signature was expected"
renderVerificationError UnexpectedSignaturePayloadShape =
  "verification failed: unexpected signature payload shape"
renderVerificationError MissingHashAlgorithm =
  "verification failed: signature payload is missing hash algorithm"
renderVerificationError (HashComputationFailed err) =
  "verification failed: hash computation error (" ++ err ++ ")"
renderVerificationError UnexpectedKeyVersion =
  "verification failed: signing key has unexpected version (only v4 and v6 are supported)"
renderVerificationError (SignatureHashUnsupportedByAlgorithm ha pka) =
  "verification failed: hash algorithm " ++ show ha ++
  " is not supported by " ++ show pka ++ " signing backend"
renderVerificationError KeyRevoked =
  "verification failed: signing key is revoked"
renderVerificationError SigningKeyUnavailableAtSignatureTime =
  "verification failed: signing key was not valid at the signature creation time"
renderVerificationError MissingIssuer =
  "verification failed: signature is missing issuer information"
renderVerificationError (SigningKeyNotFound meoki mfp) =
  "verification failed: signing key not found in keyring" ++ issuerContext meoki mfp
renderVerificationError (MultipleVerificationSuccesses n) =
  "verification failed: multiple successful key matches (" ++ show n ++ ")"
renderVerificationError (UnsupportedKeyType pka) =
  "verification failed: unsupported public key algorithm for verification (" ++ show pka ++ ")"
renderVerificationError (SignatureMismatch pka fpr) =
  "verification failed: " ++ show pka ++ " signature mismatch (signer " ++ show fpr ++ ")"
renderVerificationError (SignatureShapeMismatch pka) =
  "verification failed: malformed " ++ show pka ++ " signature encoding"
renderVerificationError (SignatureEncodingInvalid pka err) =
  "verification failed: invalid " ++ show pka ++ " key/signature encoding (" ++ err ++ ")"
renderVerificationError (SignaturePolicyHashUnsupported ha) =
  "verification failed: unsupported signature hash policy (" ++ show ha ++ ")"
renderVerificationError (SignaturePolicyPKAMismatch sigPka keyPka) =
  "verification failed: signature public-key algorithm " ++
  show sigPka ++ " does not match key algorithm " ++ show keyPka
renderVerificationError SignatureExpired =
  "verification failed: signature expired"
renderVerificationError (CandidateKeyFailures errs) =
  "verification failed: no candidate key validated the signature (" ++
  intercalate "; " (nub (map renderVerificationError errs)) ++
  ")"
renderVerificationError (InvalidSubkeyBackSignature err) =
  "verification failed: embedded primary-key back-signature verification failed: " ++
  renderVerificationError err

issuerContext ::
     Maybe EightOctetKeyId -> Maybe Fingerprint -> String
issuerContext meoki mfp =
  case (meoki, mfp) of
    (Nothing, Nothing) -> ""
    _ ->
      " (issuer-keyid=" ++
      maybe "unknown" show meoki ++
      ", issuer-fingerprint=" ++
      maybe "unknown" show mfp ++
      ")"

verificationError :: VerificationError -> Either VerificationError a
verificationError = Left

renderVerificationResult :: Either VerificationError a -> Either String a
renderVerificationResult = first renderVerificationError

data SignError
  = SignBackendError String
  | SignUnsupportedCertificationType SigType
  | SignUnsupportedKeySignatureType SigType
  | SignV6SaltSizeMismatch HashAlgorithm Word8 Int
  | SignProducedWrongLength String Int Int
  deriving (Eq, Show)

renderSignError :: SignError -> String
renderSignError (SignBackendError err) =
  "signature backend error: " ++ err
renderSignError (SignUnsupportedCertificationType st) =
  "unsupported certification signature type: " ++
  show st ++
  " (expected one of GenericCert/PersonaCert/CasualCert/PositiveCert)"
renderSignError (SignUnsupportedKeySignatureType st) =
  "unsupported key signature type: " ++
  show st ++
  " (expected SignatureDirectlyOnAKey or KeyRevocationSig)"
renderSignError (SignV6SaltSizeMismatch ha expected actual) =
  "v6 signature salt size mismatch for " ++
  show ha ++
  ": expected " ++ show expected ++ ", got " ++ show actual
renderSignError (SignProducedWrongLength algo expected actual) =
  algo ++ " produced a non-" ++ show expected ++ "-byte signature (got " ++ show actual ++ ")"

data VerifiableSignatureV where
  VerifiableSignatureV4 :: SignaturePayloadV 'SigPayloadV4 -> VerifiableSignatureV
  VerifiableSignatureV6 :: SignaturePayloadV 'SigPayloadV6 -> VerifiableSignatureV

fromSignaturePayloadVerifiableSignatureV ::
     SignaturePayload -> Maybe VerifiableSignatureV
fromSignaturePayloadVerifiableSignatureV sigPayload =
  case toSomeSignaturePayload sigPayload of
    SomeSignaturePayload (payload@SigPayloadV4Data {}) ->
      Just (VerifiableSignatureV4 payload)
    SomeSignaturePayload (payload@SigPayloadV6Data {}) ->
      Just (VerifiableSignatureV6 payload)
    _ -> Nothing

isVerifiableSignaturePayload :: SignaturePayload -> Bool
isVerifiableSignaturePayload = isJust . fromSignaturePayloadVerifiableSignatureV

toSignaturePayloadFromVerifiable :: VerifiableSignatureV -> SignaturePayload
toSignaturePayloadFromVerifiable (VerifiableSignatureV4 payload) =
  toSignaturePayload payload
toSignaturePayloadFromVerifiable (VerifiableSignatureV6 payload) =
  toSignaturePayload payload

fromPktEitherVerifiableSignatureV :: Pkt -> Either VerificationError VerifiableSignatureV
fromPktEitherVerifiableSignatureV (SignaturePkt sigPayload) =
  case fromSignaturePayloadVerifiableSignatureV sigPayload of
    Just verifiableSig -> Right verifiableSig
    Nothing ->
      verificationError UnexpectedSignaturePayloadShape
fromPktEitherVerifiableSignatureV _ =
  verificationError NonSignaturePacket

signaturePKAAndMPIsFromClass ::
     SomeSignatureV
  -> Either VerificationError (PubKeyAlgorithm, NonEmpty MPI)
signaturePKAAndMPIsFromClass =
  fmap (\(pka, _, mpis) -> (pka, mpis)) . signatureVerificationMaterialFromClass

signatureLeft16FromClass :: SomeSignatureV -> Either VerificationError Word16
signatureLeft16FromClass =
  fmap (\(_, l16, _) -> l16) . signatureVerificationMaterialFromClass

signatureVerificationMaterialFromClass ::
     SomeSignatureV
  -> Either VerificationError (PubKeyAlgorithm, Word16, NonEmpty MPI)
signatureVerificationMaterialFromClass (SomeSignatureV typedSig) =
  case typedSig of
    SignatureV3Packet (SigPayloadV3Data _ _ _ pka _ l16 mpis) ->
      Right (pka, l16, mpis)
    SignatureV4Packet (SigPayloadV4Data _ pka _ _ _ l16 mpis) ->
      Right (pka, l16, mpis)
    SignatureV6Packet (SigPayloadV6Data _ pka _ _ _ _ l16 mpis) ->
      Right (pka, l16, mpis)
    _ ->
      verificationError UnexpectedSignaturePayloadShape

verifySigWith ::
     (Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification)
  -> Pkt
  -> PktStreamContext
  -> Maybe UTCTime
  -> Either VerificationError Verification
verifySigWith vf sig@(SignaturePkt _) state mt =
  case fromPktEitherVerifiableSignatureV sig of
    Right verifiableSig ->
      let (st, hs, us, checkSubpacket, checkUnhashedSubpackets) =
            verifiableSignatureVerificationInputs verifiableSig
       in checkUnhashedSubpackets us *>
          verifyWithSubpacketChecks vf sig state mt st hs checkSubpacket
    Left err ->
      Left err
  where
    checkV4Subpacket signer i@Issuer {} = checkIssuerSubpacket (eightOctetKeyID signer) i
    checkV4Subpacket signer i@IssuerFingerprint {} =
      checkIssuerFingerprintSubpacket PKA.IssuerFingerprintV4 (fingerprint signer) i
    checkV4Subpacket _ _ = Right True
    -- RFC 9580 §5.2.3.35: v6 signatures MUST NOT include an Issuer Key ID subpacket.
    -- Treat any such subpacket as a verification error rather than merely uncheckable.
    checkV6Subpacket _ Issuer {} =
      verificationError IssuerKeyIdProhibitedInV6Signature
    checkV6Subpacket signer i@IssuerFingerprint {} =
      checkIssuerFingerprintSubpacket PKA.IssuerFingerprintV6 (fingerprint signer) i
    checkV6Subpacket _ _ = Right True
    rejectV6UnhashedIssuer (SigSubPacket _ Issuer {}) =
      verificationError IssuerKeyIdProhibitedInV6Signature
    rejectV6UnhashedIssuer _ = Right ()
    verifiableSignatureVerificationInputs ::
         VerifiableSignatureV
      ->
         ( SigType
         , [SigSubPacket]
         , [SigSubPacket]
         , SomePKPayload -> SigSubPacketPayload -> Either VerificationError Bool
         , [SigSubPacket] -> Either VerificationError ()
         )
    verifiableSignatureVerificationInputs
      (VerifiableSignatureV4 (SigPayloadV4Data st _ _ hs us _ _)) =
        (st, hs, us, checkV4Subpacket, const (Right ()))
    verifiableSignatureVerificationInputs
      (VerifiableSignatureV6 (SigPayloadV6Data st _ _ _ hs us _ _)) =
        (st, hs, us, checkV6Subpacket, mapM_ rejectV6UnhashedIssuer)
verifySigWith _ _ _ _ =
  verificationError NonSignaturePacket

verifyWithSubpacketChecks ::
     (Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification)
  -> Pkt
  -> PktStreamContext
  -> Maybe UTCTime
  -> SigType
  -> [SigSubPacket]
  -> (SomePKPayload -> SigSubPacketPayload -> Either VerificationError Bool)
  -> Either VerificationError Verification
verifyWithSubpacketChecks vf sig state mt sigType hashedSubpackets checkSubpacket = do
  mapM_ (rejectUnsupportedCriticalSubpacket sigType) hashedSubpackets
  v <- vf sig mt (payloadForSig sigType state)
  mapM_ (checkSubpacket (v ^. verificationSigner) . _sspPayload) hashedSubpackets
  warnings <-
    if sigType == SubkeyBindingSig
      then verifySubkeyBackSignatures state mt hashedSubpackets
      else Right []
  isSignatureExpired sig mt *>
    pure
      (v
         { _verificationWarnings =
             _verificationWarnings v ++ warnings
         })

-- | Verify embedded primary-key back-signatures (PrimaryKeyBindingSig, 0x19)
-- found in the hashed subpackets of a SubkeyBindingSig.
--
-- Per RFC 9580 §5.2.3.3, a signing-capable subkey MUST include an embedded
-- PrimaryKeyBindingSig (0x19) made by the subkey.  This requirement is
-- enforced strictly for v6 subkeys.  For v4 subkeys we still verify any
-- embedded back-sigs that are present, but do not reject a missing one —
-- real-world v4 signing subkeys predate the strict cross-certification
-- mandate and widespread interoperability requires accepting them.
verifySubkeyBackSignatures ::
     PktStreamContext
  -> Maybe UTCTime
  -> [SigSubPacket]
  -> Either VerificationError [VerificationWarning]
verifySubkeyBackSignatures state mt hashedSubpackets = do
  subkeyPKP <-
    maybe
      (verificationError NonSignaturePacket)
      Right
      (subkeyPKPFromPkt (lastSubkey state))
  let embeddedSigs =
        [ sp
        | SigSubPacket _ (EmbeddedSignature sp) <- hashedSubpackets
        ]
      isSigningCapable =
        any
          (\(SigSubPacket _ payload) ->
             case payload of
               KeyFlags flags -> SignDataKey `Set.member` flags
               _ -> False)
          hashedSubpackets
      isV6Subkey = _keyVersion subkeyPKP == V6
  case embeddedSigs of
    [] ->
      -- Require back-sig only for v6 signing subkeys (RFC 9580 §5.2.3.3).
      if isSigningCapable && isV6Subkey
        then Right [MissingSubkeyBackSignatureWarning]
        else Right []
    _ ->
      -- Always verify back-sigs that are present, regardless of key version.
      mapM_ (verifyOneBackSig subkeyPKP) embeddedSigs *> Right []
  where
    verifyOneBackSig subkeyPKP embSigPayload = do
      let embSigPkt = SignaturePkt embSigPayload
          backSigContext =
            emptyPSC
              { lastPrimaryKey = lastPrimaryKey state
              , lastSubkey = lastSubkey state
              }
      case verifyAgainstKey' subkeyPKP embSigPkt mt
             (payloadForSig PrimaryKeyBindingSig backSigContext) of
        Left err -> verificationError (InvalidSubkeyBackSignature err)
        Right _ -> Right ()

rejectUnsupportedCriticalSubpacket :: SigType -> SigSubPacket -> Either VerificationError ()
rejectUnsupportedCriticalSubpacket sigType (SigSubPacket isCritical payload)
  | not isCritical = Right ()
  | not (isBindingSignatureType sigType) = Right ()
  | otherwise =
      case payload of
        UserDefinedSigSub {} -> verificationError (UnsupportedCriticalSubpacket sigType)
        OtherSigSub {} -> verificationError (UnsupportedCriticalSubpacket sigType)
        _ -> Right ()

isBindingSignatureType :: SigType -> Bool
isBindingSignatureType SubkeyBindingSig = True
isBindingSignatureType PrimaryKeyBindingSig = True
isBindingSignatureType _ = False

checkIssuerSubpacket ::
     Either String EightOctetKeyId
  -> SigSubPacketPayload
  -> Either VerificationError Bool
checkIssuerSubpacket (Right signer) (Issuer i)
  | signer == i = Right True
  | otherwise = verificationError IssuerSubpacketMismatch
checkIssuerSubpacket (Left err) (Issuer _) =
  verificationError (IssuerSubpacketUncheckable err)
checkIssuerSubpacket _ _ = Right True

checkIssuerFingerprintSubpacket ::
     IssuerFingerprintVersion -> Fingerprint -> SigSubPacketPayload -> Either VerificationError Bool
checkIssuerFingerprintSubpacket expectedVersion signer (IssuerFingerprint kv i)
  | kv /= expectedVersion = verificationError IssuerFingerprintSubpacketMismatch
  | signer == i = Right True
  | otherwise = verificationError IssuerFingerprintSubpacketMismatch
checkIssuerFingerprintSubpacket _ _ _ = Right True

verifyTKWith ::
     (Pkt -> PktStreamContext -> Maybe UTCTime -> Either VerificationError Verification)
  -> Maybe UTCTime
  -> TK k
  -> Either VerificationError (TK k)
verifyTKWith vsf mt tk = do
  verifiedUnknown <- verifyUnknownTKWith vsf mt (tkToUnknown tk)
  let typedSubkeys = Map.fromList [ (keyPktToPkt kp, kp) | (kp, _) <- tk ^. tkSubs ]
      verifiedTypedSubkeys =
        mapMaybe
          (\(pkt, sigs) -> (\kp -> (kp, sigs)) <$> Map.lookup pkt typedSubkeys)
          (verifiedUnknown ^. tkuSubs)
  pure
    TK
      { _tkPrimaryKey = tk ^. tkPrimaryKey
      , _tkRevs = verifiedUnknown ^. tkuRevs
      , _tkUIDs = verifiedUnknown ^. tkuUIDs
      , _tkUAts = verifiedUnknown ^. tkuUAts
      , _tkSubs = verifiedTypedSubkeys
      }

verifyUnknownTKWith ::
     (Pkt -> PktStreamContext -> Maybe UTCTime -> Either VerificationError Verification)
  -> Maybe UTCTime
  -> TKUnknown
  -> Either VerificationError TKUnknown
verifyUnknownTKWith vsf mt tk = do
  revokers <- checkRevokers tk
  revs <- checkKeyRevocations revokers tk
  let uids = filter (not . null . snd) . checkUidSigs $ tk ^. tkuUIDs
  let uats = filter (not . null . snd) . checkUAtSigs $ tk ^. tkuUAts
  let subs = concatMap checkSub $ tk ^. tkuSubs
  return (TKUnknown (tk ^. tkuKey) revs uids uats subs)
  where
    checkRevokers =
      Right . concat . rights . map verifyRevoker . filter isRevokerP . _tkuRevs
    checkKeyRevocations ::
         [(PubKeyAlgorithm, Fingerprint)]
      -> TKUnknown
      -> Either VerificationError [SignaturePayload]
    checkKeyRevocations rs k =
      Prelude.sequence . concatMap (filterRevs rs) . rights .
      map (liftM2 fmap (,) vSig) $
      k ^.
      tkuRevs
    checkUidSigs :: [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]
    checkUidSigs =
      map
        (\(uid, sps) ->
           let verified = rights . map (\sp -> fmap ((,) sp) (vUid (uid, sp))) $ sps
            in (uid, retainNonRevokedCertifications mt verified))
    checkUAtSigs ::
        [([UserAttrSubPacket], [SignaturePayload])]
      -> [([UserAttrSubPacket], [SignaturePayload])]
    checkUAtSigs =
      map
       (\(uat, sps) ->
          let verified = rights . map (\sp -> fmap ((,) sp) (vUAt (uat, sp))) $ sps
           in (uat, retainNonRevokedCertifications mt verified))
    checkSub :: (Pkt, [SignaturePayload]) -> [(Pkt, [SignaturePayload])]
    checkSub (pkt, sps) =
      if revokedSub pkt sps
       then []
       else checkSub' pkt sps
    revokedSub :: Pkt -> [SignaturePayload] -> Bool
    revokedSub _ [] = False
    revokedSub p sigs =
      any (vSubSig p) (filter subkeyRevocationEffective sigs)
    checkSub' :: Pkt -> [SignaturePayload] -> [(Pkt, [SignaturePayload])]
    checkSub' p sps =
      let goodsigs =
           filter (vSubSig p) .
           filter signatureKnown .
           filter isSubkeyBindingSig $
           sps
      in if null goodsigs
           then []
           else [(p, goodsigs)]
    getHasheds = signatureHashedSubpackets
    filterRevs ::
         [(PubKeyAlgorithm, Fingerprint)]
      -> (SignaturePayload, Verification)
      -> [Either VerificationError SignaturePayload]
    filterRevs vokers spv =
      case spv of
       (s, _)
         | isV4OrV6Sig s && sigType s == Just SignatureDirectlyOnAKey ->
            [Right s | signatureKnown s]
       (s, v)
         | isV4OrV6Sig s
            , sigType s == Just KeyRevocationSig
            , Just pka <- sigPKA s ->
          if (v ^. verificationSigner == tk ^. tkuKey . _1) ||
             any
               (\(p, f) ->
                  p == pka && f == fingerprint (v ^. verificationSigner))
                vokers
             then
               if keyRevocationEffective s
                 then [verificationError KeyRevoked]
                 else [Right s | signatureKnown s]
             else [Right s | signatureKnown s]
       _ -> []
    isV4OrV6Sig = isVerifiableSignaturePayload
    vUid :: (Text, SignaturePayload) -> Either VerificationError Verification
    vUid (uid, sp) =
      vsf
        (SignaturePkt sp)
        emptyPSC
          { lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)
          , lastUIDorUAt = UserIdPkt uid
          }
        Nothing
    vUAt ::
         ([UserAttrSubPacket], SignaturePayload) -> Either VerificationError Verification
    vUAt (uat, sp) =
      vsf
        (SignaturePkt sp)
        emptyPSC
          { lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)
          , lastUIDorUAt = UserAttributePkt uat
          }
        Nothing
    vSig :: SignaturePayload -> Either VerificationError Verification
    vSig sp =
      vsf
        (SignaturePkt sp)
        emptyPSC {lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)}
        Nothing
    vSubSig :: Pkt -> SignaturePayload -> Bool
    vSubSig sk sp =
      isRight
        (vsf
           (SignaturePkt sp)
           emptyPSC
             { lastPrimaryKey = PublicKeyPkt (tk ^. tkuKey . _1)
             , lastSubkey = sk
             }
           mt)
    verifyRevoker ::
         SignaturePayload
      -> Either VerificationError [(PubKeyAlgorithm, Fingerprint)]
    verifyRevoker sp =
      vSig sp *>
      pure
        (map (\(SigSubPacket _ (RevocationKey _ pka fp)) -> (pka, fp)) .
         filter isRevocationKeySSP $
         getHasheds sp)
    retainNonRevokedCertifications ::
         Maybe UTCTime -> [(SignaturePayload, Verification)] -> [SignaturePayload]
    retainNonRevokedCertifications validationTime verified =
      map fst $
      filter
        ((== CertificationActive) . certificationStateAt validationTime verified)
        certifications
      where
        certifications = filter (not . isCertRevocationSig . fst) verified
    signatureKnown = signatureKnownAt mt
    subkeyRevocationEffective sp = isSubkeyRevocation sp && signatureEffectiveAt mt sp
    keyRevocationEffective sp
      | isHistoricalKeyRevocation sp = signatureEffectiveAt mt sp
      | otherwise = signatureUnexpiredAt mt sp

verifyAgainstKeyring ::
     PublicKeyring -> Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification
verifyAgainstKeyring kr sig mt payload = do
  let allKeys = map tkToUnknown (IxSet.toList kr)
      signerValidationTime = signatureCreationTimeFromPacket sig
      ikeys = (kr @=) <$> issuer sig
      ifpkeys = (kr @=) <$> issuerFP sig
      hintedKeys = maybe [] (map tkToUnknown . IxSet.toList) (ifpkeys <|> ikeys)
      hintedResult =
        if null hintedKeys
          then Left MissingIssuer
          else verifyFromCandidates allKeys hintedKeys sig signerValidationTime mt payload
   in case hintedResult of
        Right v -> Right v
        Left hintedErr ->
          let fallbackResult =
                verifyFromCandidates allKeys allKeys sig signerValidationTime mt payload
           in if null hintedKeys
                then
                  case fallbackResult of
                    Right v -> Right v
                    Left _ ->
                      verificationError (SigningKeyNotFound (issuer sig) (issuerFP sig))
                else
                  case fallbackResult of
                    Right v -> Right v
                    Left _ -> Left hintedErr

verifyFromCandidates ::
     [TKUnknown]
  -> [TKUnknown]
  -> Pkt
  -> Maybe UTCTime
  -> Maybe UTCTime
  -> ByteString
  -> Either VerificationError Verification
verifyFromCandidates allKeys candidateTks sig signerValidationTime verificationTime payload =
  let candidateResults =
        map
          (resolveCandidateSignerPKPs allKeys sig signerValidationTime (const True))
          candidateTks
      candidateErrors = concatMap fst candidateResults
      usablePkps = concatMap snd candidateResults
   in if null usablePkps
        then
          if null candidateErrors
            then verificationError (SigningKeyNotFound (issuer sig) (issuerFP sig))
            else verificationError (CandidateKeyFailures candidateErrors)
        else
          case verifyAgainstPKPs usablePkps sig verificationTime payload of
            Left (CandidateKeyFailures errs)
              | not (null candidateErrors) ->
                  verificationError (CandidateKeyFailures (candidateErrors ++ errs))
            other -> other

verifyAgainstKeys ::
     [TKUnknown] -> Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification
verifyAgainstKeys ks sig mt payload = do
  let allpkps =
        filter
          (\x ->
             (((fingerprint x ==) <$> issuerFP sig) == Just True) ||
             ((==) <$> issuer sig <*> hush (eightOctetKeyID x)) ==
             Just True)
          (concatMap (\x -> (x ^. tkuKey . _1) : mapMaybe (subkeyPKPFromPkt . fst) (_tkuSubs x)) ks)
      allCandidatePkps =
        concatMap (\x -> (x ^. tkuKey . _1) : mapMaybe (subkeyPKPFromPkt . fst) (_tkuSubs x)) ks
      normalizedCandidates
        | null allpkps = allCandidatePkps
        | otherwise = allpkps
  verifyAgainstPKPs normalizedCandidates sig mt payload

verifyAgainstPKPs ::
     [SomePKPayload] -> Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification
verifyAgainstPKPs pkps sig mt payload =
  case rights results of
    [] -> verificationError (CandidateKeyFailures (lefts results))
    [r] -> isSignatureExpired sig mt *> pure r
    rs -> verificationError (MultipleVerificationSuccesses (length rs))
  where
    results = map (\pkp -> verifyAgainstKey' pkp sig mt payload) pkps

resolveCandidateSignerPKPs ::
     [TKUnknown]
  -> Pkt
  -> Maybe UTCTime
  -> (SomePKPayload -> Bool)
  -> TKUnknown
  -> ([VerificationError], [SomePKPayload])
resolveCandidateSignerPKPs _ _ Nothing matchesP tk =
  ([], filter matchesP (candidatePKPs tk))
resolveCandidateSignerPKPs allKeys _ (Just validationTime) matchesP tk =
  let rawMatches = filter matchesP (candidatePKPs tk)
  in case verifyUnknownTKWith (verifySigWith (verifyAgainstKeys allKeys)) (Just validationTime) tk of
        Left err -> (replicate (length rawMatches) err, [])
        Right verifiedTK ->
          let verifiedMatches =
               map
                 (\pkp ->
                    case historicallyValidSigner validationTime (timelineValidationTK pkp verifiedTK) pkp of
                      Right () -> Right pkp
                      Left err -> Left err)
                 rawMatches
          in (lefts verifiedMatches, rights verifiedMatches)
        where
          timelineValidationTK pkp verifiedTK'
            | fingerprint pkp == fingerprint (tk ^. tkuKey . _1) = tk
            | otherwise = verifiedTK'

candidatePKPs :: TKUnknown -> [SomePKPayload]
candidatePKPs tk = (tk ^. tkuKey . _1) : mapMaybe (subkeyPKPFromPkt . fst) (tk ^. tkuSubs)

historicallyValidSigner ::   
     UTCTime -> TKUnknown -> SomePKPayload -> Either VerificationError ()
historicallyValidSigner validationTime tk pkp
  | fingerprint pkp == fingerprint (tk ^. tkuKey . _1) =
      if keyStateValid (keyStateAt validationTime tk)
         then Right ()
         else verificationError SigningKeyUnavailableAtSignatureTime
  | otherwise =
      case find (\(pkt, _) -> maybe False ((== fingerprint pkp) . fingerprint) (subkeyPKPFromPkt pkt)) (tk ^. tkuSubs) of
        Nothing -> verificationError SigningKeyUnavailableAtSignatureTime
        Just (subPkt, sigs) ->
          case subkeyPKPFromPkt subPkt of
            Nothing -> verificationError SigningKeyUnavailableAtSignatureTime
            Just subPKP ->
              if isPKTimeValidWithSelfSignatures validationTime subPKP sigs
                then Right ()
                else verificationError SigningKeyUnavailableAtSignatureTime

signatureCreationTimeFromPacket :: Pkt -> Maybe UTCTime
signatureCreationTimeFromPacket (SignaturePkt sigPayload) = signatureCreationTime sigPayload
signatureCreationTimeFromPacket _ = Nothing

signatureCreationTime :: SignaturePayload -> Maybe UTCTime
signatureCreationTime =
  fmap (posixSecondsToUTCTime . realToFrac . unThirtyTwoBitTimeStamp) . sigCT

signatureKnownAt :: Maybe UTCTime -> SignaturePayload -> Bool
signatureKnownAt Nothing _ = True
signatureKnownAt (Just validationTime) sigPayload =
  maybe False (<= validationTime) (signatureCreationTime sigPayload)

signatureEffectiveAt :: Maybe UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt Nothing _ = True
signatureEffectiveAt (Just validationTime) sigPayload =
  signatureKnownAt (Just validationTime) sigPayload &&
  maybe True (validationTime <) (signatureExpirationTime sigPayload)

signatureUnexpiredAt :: Maybe UTCTime -> SignaturePayload -> Bool
signatureUnexpiredAt Nothing _ = True
signatureUnexpiredAt (Just validationTime) sigPayload =
  maybe True (validationTime <) (signatureExpirationTime sigPayload)

signatureExpirationTime :: SignaturePayload -> Maybe UTCTime
signatureExpirationTime sigPayload =
  addDurationToTime <$>
  signatureCreationTime sigPayload <*>
  signatureExpirationDuration sigPayload

signatureExpirationDuration :: SignaturePayload -> Maybe ThirtyTwoBitDuration
signatureExpirationDuration sigPayload =
  signatureHashedSubpacketsKnown sigPayload >>= firstSignatureExpirationDuration

firstSignatureExpirationDuration :: [SigSubPacket] -> Maybe ThirtyTwoBitDuration
firstSignatureExpirationDuration =
  foldr
    (\subpacket acc ->
       case subpacket of
         SigSubPacket _ (SigExpirationTime duration) -> Just duration
         _ -> acc)
    Nothing

addDurationToTime :: UTCTime -> ThirtyTwoBitDuration -> UTCTime
addDurationToTime baseTime duration =
  addUTCTime (fromIntegral (unThirtyTwoBitDuration duration)) baseTime

certificationStateAt ::
     Maybe UTCTime
  -> [(SignaturePayload, Verification)]
  -> (SignaturePayload, Verification)
  -> CertificationState
certificationStateAt validationTime verified certification@(certificationSig, _)
  | not (signatureKnownAt validationTime certificationSig) = CertificationNotYetKnown
  | not (signatureEffectiveAt validationTime certificationSig) = CertificationRevoked
  | any (`revokesCertification` certification) visibleRevocations = CertificationRevoked
  | otherwise = CertificationActive
  where
    visibleRevocations =
      filter
        (signatureEffectiveAt validationTime . fst)
        (filter (isCertRevocationSig . fst) verified)

revokesCertification ::
     (SignaturePayload, Verification)
  -> (SignaturePayload, Verification)
  -> Bool
revokesCertification (revocationSig, revocationVerification) (certificationSig, certificationVerification) =
  sameSigner && certificationPrecedesRevocation certificationSig revocationSig
  where
    sameSigner =
      fingerprint (revocationVerification ^. verificationSigner) ==
      fingerprint (certificationVerification ^. verificationSigner)

certificationPrecedesRevocation ::
     SignaturePayload -> SignaturePayload -> Bool
certificationPrecedesRevocation certificationSig revocationSig =
  case (signatureCreationTime certificationSig, signatureCreationTime revocationSig) of
    (Just certificationTime, Just revocationTime) ->
      certificationTime < revocationTime
    _ -> False

isHistoricalKeyRevocation :: SignaturePayload -> Bool
isHistoricalKeyRevocation sigPayload =
  case revocationReasonCode sigPayload of
    Just KeySuperseded -> True
    Just KeyRetiredAndNoLongerUsed -> True
    Just UserIdInfoNoLongerValid -> True
    _ -> False

revocationReasonCode :: SignaturePayload -> Maybe RevocationCode
revocationReasonCode sigPayload =
  (\(SigSubPacket _ (ReasonForRevocation reasonCode _)) -> reasonCode) <$>
  find isReasonForRevocation (signatureSubpackets sigPayload)
  where
    isReasonForRevocation (SigSubPacket _ ReasonForRevocation {}) = True
    isReasonForRevocation _ = False

signatureSubpackets :: SignaturePayload -> [SigSubPacket]
signatureSubpackets sigPayload =
  case signatureSubpacketListsKnown sigPayload of
    Just (hashed, unhashed) -> hashed ++ unhashed
    Nothing -> []

signatureHashedSubpackets :: SignaturePayload -> [SigSubPacket]
signatureHashedSubpackets sigPayload =
  maybe [] id (signatureHashedSubpacketsKnown sigPayload)

subkeyPKPFromPkt :: Pkt -> Maybe SomePKPayload
subkeyPKPFromPkt (PublicSubkeyPkt p) = Just p
subkeyPKPFromPkt (SecretSubkeyPkt p _) = Just p
subkeyPKPFromPkt _ = Nothing

verifyAgainstKey' :: SomePKPayload -> Pkt -> Maybe UTCTime -> ByteString -> Either VerificationError Verification
verifyAgainstKey' pkp sig mt payload = do
      sigClass <-
        either
          (verificationError . const NonSignaturePacket)
          Right
          (fromPktEitherSomeSignatureV sig)
      let sigPayload =
            case sigClass of
              SomeSignatureV typedSig -> signaturePayloadFromSignatureV typedSig
      sigHash <-
        maybe
          (verificationError MissingHashAlgorithm)
          Right
          (sigHA sigPayload)
      sigDetails <- signaturePKAAndMPIsFromClass sigClass
      enforcePKACompatibility sigPayload
      enforceSignatureHashPolicy sigHash
      _ <- isSignatureExpired sig mt
      let signedPayload = BL.toStrict (finalPayload sig payload)
      enforceLeft16Prefix sigClass sigHash signedPayload
      (\verifiedSigner -> Verification verifiedSigner sigPayload []) <$>
        verify' sigDetails pkp sigHash signedPayload
  where
    enforcePKACompatibility sigPayload =
      let sigPka = maybe (OtherPKA 0) id (sigPKA sigPayload)
          keyPka = _pkalgo pkp
       in if pkaCompatible sigPka keyPka
            then Right ()
            else verificationError (SignaturePolicyPKAMismatch sigPka keyPka)
    enforceSignatureHashPolicy sigHash =
      case sigHash of
        OtherHA {} -> verificationError (SignaturePolicyHashUnsupported sigHash)
        _ -> Right ()
    enforceLeft16Prefix sigClass sigHash signedPayload = do
      expectedLeft16 <-
        either
          (verificationError . HashComputationFailed)
          Right
          (left16FromSignedPayload sigHash signedPayload)
      actualLeft16 <- signatureLeft16FromClass sigClass
      if actualLeft16 == expectedLeft16
        then Right ()
        else
          verificationError
            (SignatureMismatch (_pkalgo pkp) (fingerprint pkp))
    pkaCompatible RSA keyPka =
      keyPka `elem` [RSA, DeprecatedRSAEncryptOnly, DeprecatedRSASignOnly]
    pkaCompatible DeprecatedRSASignOnly keyPka =
      keyPka `elem` [RSA, DeprecatedRSASignOnly]
    pkaCompatible PKA.EdDSA keyPka =
      keyPka `elem` [PKA.EdDSA, PKA.Ed25519, PKA.Ed448]
    pkaCompatible PKA.Ed25519 keyPka =
      keyPka `elem` [PKA.EdDSA, PKA.Ed25519]
    pkaCompatible PKA.Ed448 keyPka =
      keyPka `elem` [PKA.EdDSA, PKA.Ed448]
    pkaCompatible sigPka keyPka = sigPka == keyPka
    verify' details pub@(PKPayload V4 _ _ _ pkey) ha pl =
      verifyByHash details pub pkey ha pl
    verify' details pub@(PKPayload V6 _ _ _ pkey) ha pl =
      verifyByHash details pub pkey ha pl
    verify' _ _ _ _ =
      verificationError UnexpectedKeyVersion
    verifyByHash details pub pkey ha pl =
      case ha of
        SHA1 -> verify'' details CHA.SHA1 pub pkey pl
        RIPEMD160 -> verify'' details CHA.RIPEMD160 pub pkey pl
        SHA224 -> verify'' details CHA.SHA224 pub pkey pl
        SHA256 -> verify'' details CHA.SHA256 pub pkey pl
        SHA384 -> verify'' details CHA.SHA384 pub pkey pl
        SHA512 -> verify'' details CHA.SHA512 pub pkey pl
        SHA3_256 -> verifyNoRSA SHA3_256 details CHA.SHA3_256 pub pkey pl
        SHA3_512 -> verifyNoRSA SHA3_512 details CHA.SHA3_512 pub pkey pl
        DeprecatedMD5 -> verify'' details CHA.MD5 pub pkey pl
        _ ->
          verificationError (SignaturePolicyHashUnsupported ha)
    verify'' (DSA, mpis) hd pub (DSAPubKey (DSA_PublicKey pkey)) bs =
      dsaVerify pub mpis hd pkey bs
    verify'' (ECDSA, mpis) hd pub (ECDSAPubKey (ECDSA_PublicKey pkey)) bs =
      ecdsaVerify pub mpis hd pkey bs
    verify'' (sigPka, mpis) hd pub (EdDSAPubKey Ed25519 pkey) bs
      | sigPka `elem` [EdDSA, PKA.Ed25519] =
          ed25519Verify sigPka pub mpis hd pkey bs
    verify'' (sigPka, mpis) hd pub (EdDSAPubKey Ed448 pkey) bs
      | sigPka `elem` [EdDSA, PKA.Ed448] =
          ed448Verify sigPka pub mpis hd pkey bs
    verify'' (RSA, mpis) hd pub (RSAPubKey (RSA_PublicKey pkey)) bs =
      rsaVerify pub mpis hd pkey bs
    verify'' (pka, _) _ _ _ _ = verificationError (UnsupportedKeyType pka)
    verifyNoRSA ha' (DSA, mpis) hd pub (DSAPubKey (DSA_PublicKey pkey)) bs =
      dsaVerify pub mpis hd pkey bs
    verifyNoRSA ha' (ECDSA, mpis) hd pub (ECDSAPubKey (ECDSA_PublicKey pkey)) bs =
      ecdsaVerify pub mpis hd pkey bs
    verifyNoRSA ha' (sigPka, mpis) hd pub (EdDSAPubKey Ed25519 pkey) bs
      | sigPka `elem` [EdDSA, PKA.Ed25519] =
          ed25519Verify sigPka pub mpis hd pkey bs
    verifyNoRSA ha' (sigPka, mpis) hd pub (EdDSAPubKey Ed448 pkey) bs
      | sigPka `elem` [EdDSA, PKA.Ed448] =
          ed448Verify sigPka pub mpis hd pkey bs
    verifyNoRSA ha' (RSA, _) _ _ _ _ =
      verificationError (SignatureHashUnsupportedByAlgorithm ha' RSA)
    verifyNoRSA _ (pka, _) _ _ _ _ = verificationError (UnsupportedKeyType pka)
    dsaVerify pub (r :| [s]) hd pkey bs =
      if DSA.verify hd pkey (dsaMPIsToSig r s) bs
        then Right pub
        else verificationError (SignatureMismatch DSA (fingerprint pub))
    dsaVerify _ _ _ _ _ = verificationError (SignatureShapeMismatch DSA)
    ecdsaVerify pub (r :| [s]) hd pkey bs =
      if ECDSA.verify hd pkey (ecdsaMPIsToSig r s) bs
        then Right pub
        else verificationError (SignatureMismatch ECDSA (fingerprint pub))
    ecdsaVerify _ _ _ _ _ = verificationError (SignatureShapeMismatch ECDSA)
    ed25519Verify sigPka pub (r :| [s]) hd pkey bs =
      case edPointToRawPublic 32 pkey of
        Left err ->
          verificationError (SignatureEncodingInvalid sigPka err)
        Right rawPub ->
          case cf2es (Ed25519.publicKey rawPub) of
            Left err ->
              verificationError (SignatureEncodingInvalid sigPka err)
            Right ep ->
              case cf2es (Ed25519.signature (pad32 (i2osp (unMPI r)) <> pad32 (i2osp (unMPI s)))) of
                Left err ->
                  verificationError (SignatureEncodingInvalid sigPka err)
                Right es ->
                  let prehash = crazyHash hd bs :: B.ByteString
                   in if Ed25519.verify ep prehash es
                        then Right pub
                        else verificationError (SignatureMismatch sigPka (fingerprint pub))
    ed25519Verify sigPka _ _ _ _ _ =
      verificationError (SignatureShapeMismatch sigPka)
    ed448Verify sigPka pub (r :| [s]) hd pkey bs =
      case edPointToRawPublic 57 pkey of
        Left err ->
          verificationError (SignatureEncodingInvalid sigPka err)
        Right rawPub ->
          case cf2es (Ed448.publicKey rawPub) of
            Left err ->
              verificationError (SignatureEncodingInvalid sigPka err)
            Right ep ->
              case cf2es (Ed448.signature (padN 57 (i2osp (unMPI r)) <> padN 57 (i2osp (unMPI s)))) of
                Left err ->
                  verificationError (SignatureEncodingInvalid sigPka err)
                Right es ->
                  let prehash = crazyHash hd bs :: B.ByteString
                   in if Ed448.verify ep prehash es
                        then Right pub
                        else verificationError (SignatureMismatch sigPka (fingerprint pub))
    ed448Verify sigPka _ _ _ _ _ =
      verificationError (SignatureShapeMismatch sigPka)
    edPointToRawPublic expectedLen (NativeEPoint (EPoint x)) =
      exactLengthPublic expectedLen "native" (i2osp x)
    edPointToRawPublic expectedLen (PrefixedNativeEPoint (EPoint x)) = do
      prefixed <- exactLengthPublic (expectedLen + 1) "prefixed-native" (i2osp x)
      if B.head prefixed /= 0x40
        then Left "prefixed-native EdDSA public key is missing the 0x40 prefix"
        else Right (B.tail prefixed)
    exactLengthPublic expectedLen label bs
      | B.length bs == expectedLen = Right bs
      | otherwise =
          Left
            ("invalid " ++ label ++ " EdDSA public key length: expected " ++
             show expectedLen ++ " octets, got " ++ show (B.length bs))
    pad32 bs =
      let l = B.length bs
       in if l >= 32
            then bs
            else B.replicate (32 - l) 0 <> bs
    padN n bs =
      let l = B.length bs
       in if l >= n
            then bs
            else B.replicate (n - l) 0 <> bs
    cf2es = either (Left . show) return . eitherCryptoError
    rsaVerify pub mpis hd pkey bs =
      if P15.verify (Just hd) pkey bs (rsaMPItoSig pkey mpis)
        then Right pub
        else verificationError (SignatureMismatch RSA (fingerprint pub))
    dsaMPIsToSig r s = DSA.Signature (unMPI r) (unMPI s)
    ecdsaMPIsToSig r s = ECDSA.Signature (unMPI r) (unMPI s)
    rsaMPItoSig pkey (s :| []) =
      let sz  = RSATypes.public_size pkey
          raw = i2osp (unMPI s)
          pad = sz - B.length raw
      in B.replicate pad 0 <> raw
    crazyHash h = BA.convert . hashWith h

isSignatureExpired :: Pkt -> Maybe UTCTime -> Either VerificationError Bool
isSignatureExpired _ Nothing = return False
isSignatureExpired s (Just t) =
      do
        sigClass <-
          either
            (verificationError . const NonSignaturePacket)
            Right
            (fromPktEitherSomeSignatureV s)
        if any
             (expiredBefore t)
             (signatureHashedSubpackets
                (case sigClass of
                   SomeSignatureV typedSig -> signaturePayloadFromSignatureV typedSig))
          then verificationError SignatureExpired
          else return True
  where
    expiredBefore :: UTCTime -> SigSubPacket -> Bool
    expiredBefore ct (SigSubPacket _ (SigExpirationTime et)) =
      fromEnum ((posixSecondsToUTCTime . toEnum . fromEnum) et `diffUTCTime` ct) <
      0
    expiredBefore _ _ = False

finalPayload :: Pkt -> ByteString -> ByteString
finalPayload s pl = BL.concat [pl, sigbit, trailer s]
  where
    sigbit = runPut $ putPartialSigforSigning s
    trailer :: Pkt -> ByteString
    trailer (SignaturePkt sigPayload) =
      maybe
        BL.empty
        (const (runPut $ putSigTrailer s))
        (fromSignaturePayloadVerifiableSignatureV sigPayload)
    trailer _ = BL.empty

normalizePayloadForSigType :: SigType -> ByteString -> ByteString
normalizePayloadForSigType CanonicalTextSig =
  stripTrailingWhitespacePerLine . canonicalizeLineEndings
normalizePayloadForSigType _ = id

normalizePayloadForSigTypeWith :: TextNormalizationMode -> SigType -> ByteString -> ByteString
normalizePayloadForSigTypeWith CleartextCompat st = normalizePayloadForSigType st
normalizePayloadForSigTypeWith RFC9580Strict CanonicalTextSig = canonicalizeLineEndings
normalizePayloadForSigTypeWith RFC9580Strict _ = id

canonicalizeLineEndings :: ByteString -> ByteString
canonicalizeLineEndings = BL.pack . go . BL.unpack
  where
    go [] = []
    go (0x0d:0x0a:rest) = 0x0d : 0x0a : go rest
    go (0x0d:rest) = 0x0d : 0x0a : go rest
    go (0x0a:rest) = 0x0d : 0x0a : go rest
    go (w:rest) = w : go rest

stripTrailingWhitespacePerLine :: ByteString -> ByteString
stripTrailingWhitespacePerLine = BL.pack . go [] . BL.unpack
  where
    go lineRev [] = reverseTrimmed lineRev
    go lineRev (0x0d:0x0a:rest) =
      reverseTrimmed lineRev ++ [0x0d, 0x0a] ++ go [] rest
    go lineRev (w:rest) = go (w : lineRev) rest

    reverseTrimmed :: [Word8] -> [Word8]
    reverseTrimmed = reverse . dropWhile isTrailingWhitespace

    isTrailingWhitespace :: Word8 -> Bool
    isTrailingWhitespace w = w == 0x20 || w == 0x09

hashWithSHA512 :: B.ByteString -> B.ByteString
hashWithSHA512 = BA.convert . hashWith CHA.SHA512

hashForSignatureAlgorithm :: HashAlgorithm -> B.ByteString -> Either String B.ByteString
hashForSignatureAlgorithm ha bs =
  case ha of
    SHA1 -> Right (BA.convert (hashWith CHA.SHA1 bs))
    RIPEMD160 -> Right (BA.convert (hashWith CHA.RIPEMD160 bs))
    SHA224 -> Right (BA.convert (hashWith CHA.SHA224 bs))
    SHA256 -> Right (BA.convert (hashWith CHA.SHA256 bs))
    SHA384 -> Right (BA.convert (hashWith CHA.SHA384 bs))
    SHA512 -> Right (BA.convert (hashWith CHA.SHA512 bs))
    SHA3_256 -> Right (BA.convert (hashWith CHA.SHA3_256 bs))
    SHA3_512 -> Right (BA.convert (hashWith CHA.SHA3_512 bs))
    DeprecatedMD5 -> Right (BA.convert (hashWith CHA.MD5 bs))
    _ -> Left ("unsupported hash algorithm for left16 derivation: " ++ show ha)

left16FromHashPrefix :: B.ByteString -> Either String Word16
left16FromHashPrefix bs
  | B.length bs >= 2 = Right (fromIntegral (os2ip (B.take 2 bs)))
  | otherwise = Left "hash output too short to derive left16"

left16FromSignedPayload :: HashAlgorithm -> B.ByteString -> Either String Word16
left16FromSignedPayload ha signedPayload = do
  digest <- hashForSignatureAlgorithm ha signedPayload
  left16FromHashPrefix digest

left16FromSignedPayloadForSign :: HashAlgorithm -> B.ByteString -> Either SignError Word16
left16FromSignedPayloadForSign ha =
  first SignBackendError . left16FromSignedPayload ha

ed25519Signer :: Ed25519.SecretKey -> B.ByteString -> B.ByteString
ed25519Signer sk prehash =
  BA.convert (Ed25519.sign sk (Ed25519.toPublic sk) prehash)

ed448Signer :: Ed448.SecretKey -> B.ByteString -> B.ByteString
ed448Signer sk prehash =
  BA.convert (Ed448.sign sk (Ed448.toPublic sk) prehash)

rsaPKCS15Sign ::
     HashAlgorithm
  -> RSATypes.PrivateKey
  -> B.ByteString
  -> Either SignError B.ByteString
rsaPKCS15Sign ha prv bytes =
  case ha of
    SHA1 -> first (SignBackendError . show) (P15.sign Nothing (Just CHA.SHA1) prv bytes)
    SHA224 -> first (SignBackendError . show) (P15.sign Nothing (Just CHA.SHA224) prv bytes)
    SHA256 -> first (SignBackendError . show) (P15.sign Nothing (Just CHA.SHA256) prv bytes)
    SHA384 -> first (SignBackendError . show) (P15.sign Nothing (Just CHA.SHA384) prv bytes)
    SHA512 -> first (SignBackendError . show) (P15.sign Nothing (Just CHA.SHA512) prv bytes)
    _ ->
      Left
        (SignBackendError
           ("signature hash algorithm is not supported by RSA PKCS#1 v1.5 backend: " ++
            show ha))

validateV6SaltSize :: HashAlgorithm -> SignatureSalt -> Either SignError ()
validateV6SaltSize ha salt =
  let saltBytes = BL.toStrict (unSignatureSalt salt)
      actualSaltLen = B.length saltBytes
   in case signatureV6SaltSizeForHashAlgorithm ha of
        Nothing ->
          Left
            (SignBackendError
               ("signature hash algorithm does not define a V6 salt size: " ++ show ha))
        Just expectedSaltLen ->
          if actualSaltLen == fromIntegral expectedSaltLen
            then Right ()
            else Left (SignV6SaltSizeMismatch ha expectedSaltLen actualSaltLen)

signEdDSAV4 ::
     String
  -> Int
  -> Int
  -> (B.ByteString -> B.ByteString)
  -> TextNormalizationMode
  -> SigType
  -> PubKeyAlgorithm
  -> HashAlgorithm
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signEdDSAV4 algoName sigLen limbLen signer mode st pka ha has uhas payload = do
  let normalizedPayload = normalizePayloadForSigTypeWith mode st payload
      sig0 = SigV4 st pka ha has [] 0 (NE.fromList [MPI 0, MPI 0])
      prehash =
        hashWithSHA512
          (BL.toStrict (finalPayload (SignaturePkt sig0) normalizedPayload))
      sigBytes = signer prehash
  if B.length sigBytes /= sigLen
    then Left (SignProducedWrongLength algoName sigLen (B.length sigBytes))
    else
      let (r, s) = B.splitAt limbLen sigBytes
       in (\left16 ->
             SigV4
               st
               pka
               ha
               has
               uhas
               left16
               (NE.fromList [MPI (os2ip r), MPI (os2ip s)]))
            <$> first SignBackendError (left16FromHashPrefix prehash)

signEdDSAV6 ::
     String
  -> Int
  -> Int
  -> (B.ByteString -> B.ByteString)
  -> TextNormalizationMode
  -> SigType
  -> PubKeyAlgorithm
  -> HashAlgorithm
  -> SignatureSalt
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signEdDSAV6 algoName sigLen limbLen signer mode st pka ha salt has uhas payload = do
  validateV6SaltSize ha salt
  let normalizedPayload = normalizePayloadForSigTypeWith mode st payload
      sig0 = SigV6 st pka ha salt has [] 0 (NE.fromList [MPI 0, MPI 0])
      prehash =
        hashWithSHA512
          (BL.toStrict (finalPayload (SignaturePkt sig0) normalizedPayload))
      sigBytes = signer prehash
  if B.length sigBytes /= sigLen
    then Left (SignProducedWrongLength algoName sigLen (B.length sigBytes))
    else
      let (r, s) = B.splitAt limbLen sigBytes
       in (\left16 ->
             SigV6
               st
               pka
               ha
               salt
               has
               uhas
               left16
               (NE.fromList [MPI (os2ip r), MPI (os2ip s)]))
            <$> first SignBackendError (left16FromHashPrefix prehash)

signUserIDwithRSA :: SomePKPayload -- ^ public key "payload" of user ID being signed
  -> UserId -- ^ user ID being signed
  -> [SigSubPacket] -- ^ hashed signature subpackets
  -> [SigSubPacket] -- ^ unhashed signature subpackets
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> Either SignError SignaturePayload
signUserIDwithRSA = signCertificationWithRSA PositiveCert

signCertificationWithRSA ::
     SigType -- ^ certification type (GenericCert, PersonaCert, CasualCert, PositiveCert)
  -> SomePKPayload -- ^ public key "payload" of user ID being signed
  -> UserId -- ^ user ID being signed
  -> [SigSubPacket] -- ^ hashed signature subpackets
  -> [SigSubPacket] -- ^ unhashed signature subpackets
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> Either SignError SignaturePayload
signCertificationWithRSA st pkp uid hsigsubs usigsubs prv
  | st `elem` [GenericCert, PersonaCert, CasualCert, PositiveCert] = do
  let payloadToSign = BL.toStrict (finalPayload (SignaturePkt uidsigp) uidpayload)
  uidsigp'
    <$> left16FromSignedPayloadForSign SHA512 payloadToSign
    <*> first
          (SignBackendError . show)
          (P15.sign
             Nothing
             (Just CHA.SHA512)
             prv
             payloadToSign)
  | otherwise =
    Left (SignUnsupportedCertificationType st)
  where
    uidpayload =
      runPut
        (sequence_
           [putKeyforSigning (PublicKeyPkt pkp), putUforSigning (toPkt uid)])
    uidsigp =
      SigV4 st RSA SHA512 hsigsubs usigsubs 0 (NE.fromList [MPI 0])
    uidsigp' left16 us =
      SigV4
        st
        RSA
        SHA512
        hsigsubs
        usigsubs
        left16
        (NE.fromList [MPI (os2ip us)])

signDirectKeyWithRSA ::
     SigType -- ^ key-scoped signature type (SignatureDirectlyOnAKey or KeyRevocationSig)
  -> SomePKPayload -- ^ primary key "payload" being signed
  -> [SigSubPacket] -- ^ hashed signature subpackets
  -> [SigSubPacket] -- ^ unhashed signature subpackets
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> Either SignError SignaturePayload
signDirectKeyWithRSA st pkp hsigsubs usigsubs prv
  | st `elem` [SignatureDirectlyOnAKey, KeyRevocationSig] =
    signDataWithRSA st prv hsigsubs usigsubs keypayload
  | otherwise =
    Left (SignUnsupportedKeySignatureType st)
  where
    keypayload = runPut (putKeyforSigning (PublicKeyPkt pkp))

signKeyRevocationWithRSA :: SomePKPayload -- ^ primary key "payload" being revoked
  -> [SigSubPacket] -- ^ hashed signature subpackets
  -> [SigSubPacket] -- ^ unhashed signature subpackets
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> Either SignError SignaturePayload
signKeyRevocationWithRSA = signDirectKeyWithRSA KeyRevocationSig

signSubkeyRevocationWithRSA :: SomePKPayload -- ^ primary key "payload"
  -> SomePKPayload -- ^ public subkey "payload" being revoked
  -> [SigSubPacket] -- ^ hashed signature subpackets
  -> [SigSubPacket] -- ^ unhashed signature subpackets
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> Either SignError SignaturePayload
signSubkeyRevocationWithRSA pkp subpkp hsigsubs usigsubs prv =
  signDataWithRSA SubkeyRevocationSig prv hsigsubs usigsubs subkeypayload
  where
    subkeypayload =
      runPut
        (sequence_
           [ putKeyforSigning (PublicKeyPkt pkp)
           , putKeyforSigning (PublicSubkeyPkt subpkp)
           ])

signCertRevocationWithRSA :: SomePKPayload -- ^ primary key "payload"
  -> UserId -- ^ user ID certification being revoked
  -> [SigSubPacket] -- ^ hashed signature subpackets
  -> [SigSubPacket] -- ^ unhashed signature subpackets
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> Either SignError SignaturePayload
signCertRevocationWithRSA pkp uid hsigsubs usigsubs prv =
  signDataWithRSA CertRevocationSig prv hsigsubs usigsubs certpayload
  where
    certpayload =
      runPut
        (sequence_
           [putKeyforSigning (PublicKeyPkt pkp), putUforSigning (toPkt uid)])

crossSignSubkeyWithRSA :: SomePKPayload -- ^ public key "payload" of key being signed
  -> SomePKPayload -- ^ public subkey "payload" of key being signed
  -> [SigSubPacket] -- ^ hashed signature subpackets for binding sig
  -> [SigSubPacket] -- ^ unhashed signature subpackets for binding sig
  -> [SigSubPacket] -- ^ hashed signature subpackets for embedded sig
  -> [SigSubPacket] -- ^ unhashed signature subpackets for embedded sig
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> RSATypes.PrivateKey -- ^ RSA signing subkey
  -> Either SignError SignaturePayload
crossSignSubkeyWithRSA pkp subpkp subhsigsubs subusigsubs embhsigsubs embusigsubs prv ssb = do
  let embPayloadToSign = BL.toStrict (finalPayload (SignaturePkt embsigp) subkeypayload)
      subPayloadToSign = BL.toStrict (finalPayload (SignaturePkt subsigp) subkeypayload)
  (\embleft16 subleft16 embsig subsig ->
     subsigp' (embsigp' embleft16 embsig) subleft16 subsig)
    <$> left16FromSignedPayloadForSign SHA512 embPayloadToSign
    <*> left16FromSignedPayloadForSign SHA512 subPayloadToSign
    <*> first
          (SignBackendError . show)
          (P15.sign
             Nothing
             (Just CHA.SHA512)
             ssb
             embPayloadToSign)
    <*> first
          (SignBackendError . show)
          (P15.sign
             Nothing
             (Just CHA.SHA512)
             prv
             subPayloadToSign)
  where
    subkeypayload =
      runPut
        (sequence_
           [ putKeyforSigning (PublicKeyPkt pkp)
           , putKeyforSigning (PublicSubkeyPkt subpkp)
           ])
    embsigp =
      SigV4
        PrimaryKeyBindingSig
        RSA
        SHA512
        embhsigsubs
        embusigsubs
        0
        (NE.fromList [MPI 0])
    embsigp' left16 es =
      SigV4
        PrimaryKeyBindingSig
        RSA
        SHA512
        embhsigsubs
        embusigsubs
        left16
        (NE.fromList [MPI (os2ip es)])
    subsigp =
      SigV4 SubkeyBindingSig RSA SHA512 subhsigsubs [] 0 (NE.fromList [MPI 0])
    sspes es = SigSubPacket False (EmbeddedSignature es)
    subsigp' es left16 ss =
      SigV4
        SubkeyBindingSig
        RSA
        SHA512
        subhsigsubs
        (sspes es : subusigsubs)
        left16
        (NE.fromList [MPI (os2ip ss)])

signRSAV4Core ::
     TextNormalizationMode
  -> SigType
  -> HashAlgorithm
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> RSATypes.PrivateKey
  -> ByteString
  -> Either SignError SignaturePayload
signRSAV4Core mode st ha has uhas prv payload =
  (\left16 ss -> SigV4 st RSA ha has uhas left16 (NE.fromList [MPI (os2ip ss)]))
    <$> left16FromSignedPayloadForSign ha payloadToSign
    <*> rsaPKCS15Sign ha prv payloadToSign
  where
    sig0 = SigV4 st RSA ha has [] 0 (NE.fromList [MPI 0])
    payloadToSign = BL.toStrict (finalPayload (SignaturePkt sig0) (normalizePayloadForSigTypeWith mode st payload))

signRSAV6Core ::
     TextNormalizationMode
  -> SigType
  -> HashAlgorithm
  -> SignatureSalt
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> RSATypes.PrivateKey
  -> ByteString
  -> Either SignError SignaturePayload
signRSAV6Core mode st ha salt has uhas prv payload = do
  validateV6SaltSize ha salt
  (\left16 sigBytes -> SigV6 st RSA ha salt has uhas left16 (NE.fromList [MPI (os2ip sigBytes)]))
    <$> left16FromSignedPayloadForSign ha payloadToSign
    <*> rsaPKCS15Sign ha prv payloadToSign
  where
    sig0 = SigV6 st RSA ha salt has [] 0 (NE.fromList [MPI 0])
    payloadToSign = BL.toStrict (finalPayload (SignaturePkt sig0) (normalizePayloadForSigTypeWith mode st payload))

signDataWithRSA ::
     SigType
  -> RSATypes.PrivateKey
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithRSA st prv has uhas payload =
  signRSAV4Core CleartextCompat st SHA512 has uhas prv payload

signDataWithRSAV6 ::
     SigType
  -> SignatureSalt
  -> RSATypes.PrivateKey
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithRSAV6 st salt prv has uhas payload =
  signRSAV6Core CleartextCompat st SHA512 salt has uhas prv payload

ed25519Params :: (String, Int, Int, PubKeyAlgorithm)
ed25519Params = ("Ed25519", 64, 32, PKA.Ed25519)

ed448Params :: (String, Int, Int, PubKeyAlgorithm)
ed448Params = ("Ed448", 114, 57, PKA.Ed448)

signDataWithEdDSAV4Generic ::
     (String, Int, Int, PubKeyAlgorithm)
  -> (B.ByteString -> B.ByteString)
  -> TextNormalizationMode
  -> HashAlgorithm
  -> SigType
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEdDSAV4Generic (algoName, sigLen, limbLen, pka) signer mode ha st has uhas payload =
  signEdDSAV4 algoName sigLen limbLen signer mode st pka ha has uhas payload

signDataWithEdDSAV6Generic ::
     (String, Int, Int, PubKeyAlgorithm)
  -> (B.ByteString -> B.ByteString)
  -> TextNormalizationMode
  -> HashAlgorithm
  -> SigType
  -> SignatureSalt
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEdDSAV6Generic (algoName, sigLen, limbLen, pka) signer mode ha st salt has uhas payload =
  signEdDSAV6 algoName sigLen limbLen signer mode st pka ha salt has uhas payload

signDataWithEd25519 ::
     SigType
  -> Ed25519.SecretKey
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd25519 st sk has uhas payload =
  signDataWithEdDSAV4Generic ed25519Params (ed25519Signer sk) CleartextCompat SHA512 st has uhas payload

signDataWithEd25519V6 ::
     SigType
  -> SignatureSalt
  -> Ed25519.SecretKey
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd25519V6 st salt sk has uhas payload =
  signDataWithEdDSAV6Generic ed25519Params (ed25519Signer sk) CleartextCompat SHA512 st salt has uhas payload

signDataWithEd448 ::
     SigType
  -> Ed448.SecretKey
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd448 st sk has uhas payload =
  signDataWithEdDSAV4Generic ed448Params (ed448Signer sk) CleartextCompat SHA512 st has uhas payload

signDataWithEd448V6 ::
     SigType
  -> SignatureSalt
  -> Ed448.SecretKey
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd448V6 st salt sk has uhas payload =
  signDataWithEdDSAV6Generic ed448Params (ed448Signer sk) CleartextCompat SHA512 st salt has uhas payload

-- | Builder-based signature creation for RSA
-- 
-- Example usage:
--   builder <- sigBuilderInit BinarySig RSA SHA512
--   builder' <- addHashedSubs hashedSubpackets builder
--   builder'' <- addUnhashedSubs unhashedSubpackets builder'
--   sig <- signDataWithRSABuilder builder'' rsaPrivateKey payload
signDataWithRSABuilder ::
     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V4Sig 'PKA.RSA
  -> RSATypes.PrivateKey
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithRSABuilder builder prv payload =
  signRSAV4Core
    (sbTextNormMode builder)
    (sbSigType builder)
    (sbHashAlgo builder)
    (sbHashedSubs builder)
    (sbUnhashedSubs builder)
    prv
    payload

-- | Builder-based signature creation for RSA (v6)
signDataWithRSAV6Builder ::
     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V6Sig 'PKA.RSA
  -> RSATypes.PrivateKey
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithRSAV6Builder builder prv payload =
  signRSAV6Core
    (sbTextNormMode builder)
    (sbSigType builder)
    (sbHashAlgo builder)
    (sbSalt builder)
    (sbHashedSubs builder)
    (sbUnhashedSubs builder)
    prv
    payload

-- | Builder-based signature creation for Ed25519 (v4)
--
-- Example usage:
--   builder <- sigBuilderInit BinarySig Ed25519 SHA512
--   builder' <- addHashedSubs hashedSubpackets builder
--   builder'' <- addUnhashedSubs unhashedSubpackets builder'
--   sig <- signDataWithEd25519Builder builder'' ed25519PrivateKey payload
signDataWithEd25519Builder ::
     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V4Sig 'PKA.Ed25519
  -> Ed25519.SecretKey
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd25519Builder builder sk payload =
  signDataWithEdDSAV4Generic ed25519Params (ed25519Signer sk)
    (sbTextNormMode builder) (sbHashAlgo builder) (sbSigType builder)
    (sbHashedSubs builder) (sbUnhashedSubs builder) payload

-- | Builder-based signature creation for Ed25519 (v6)
--
-- Example usage:
--   builder <- sigBuilderInitV6 BinarySig Ed25519 SHA512 salt
--   builder' <- addHashedSubs hashedSubpackets builder
--   builder'' <- addUnhashedSubs unhashedSubpackets builder'
--   sig <- signDataWithEd25519V6Builder builder'' ed25519PrivateKey payload
signDataWithEd25519V6Builder ::
     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V6Sig 'PKA.Ed25519
  -> Ed25519.SecretKey
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd25519V6Builder builder sk payload =
  signDataWithEdDSAV6Generic ed25519Params (ed25519Signer sk)
    (sbTextNormMode builder) (sbHashAlgo builder) (sbSigType builder)
    (sbSalt builder) (sbHashedSubs builder) (sbUnhashedSubs builder) payload

-- | Builder-based signature creation for Ed448 (v4)
--
-- Example usage:
--   builder <- sigBuilderInit BinarySig Ed448 SHA512
--   builder' <- addHashedSubs hashedSubpackets builder
--   builder'' <- addUnhashedSubs unhashedSubpackets builder'
--   sig <- signDataWithEd448Builder builder'' ed448PrivateKey payload
signDataWithEd448Builder ::
     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V4Sig 'PKA.Ed448
  -> Ed448.SecretKey
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd448Builder builder sk payload =
  signDataWithEdDSAV4Generic ed448Params (ed448Signer sk)
    (sbTextNormMode builder) (sbHashAlgo builder) (sbSigType builder)
    (sbHashedSubs builder) (sbUnhashedSubs builder) payload

-- | Builder-based signature creation for Ed448 (v6)
signDataWithEd448V6Builder ::
     SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V6Sig 'PKA.Ed448
  -> Ed448.SecretKey
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithEd448V6Builder builder sk payload =
  signDataWithEdDSAV6Generic ed448Params (ed448Signer sk)
    (sbTextNormMode builder) (sbHashAlgo builder) (sbSigType builder)
    (sbSalt builder) (sbHashedSubs builder) (sbUnhashedSubs builder) payload

-- | Algorithm-agnostic signature builder dispatcher (Phase 2)
-- 
-- Dispatches to the appropriate signing function based on the private key type.
-- The private key type (PrivateKeyFor algo) encodes the algorithm at the type level,
-- allowing compile-time verification that the key and builder algorithm match.
--
-- Example usage:
class BuilderSigningAlgorithm (algo :: PKA.PubKeyAlgorithm) where
  signDataWithAlgorithmicBuilderImpl
    :: SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V4Sig algo
    -> PrivateKeyFor algo
    -> ByteString
    -> Either SignError SignaturePayload

instance BuilderSigningAlgorithm 'PKA.RSA where
  signDataWithAlgorithmicBuilderImpl builder (SP.RSAPrivateKey prv) payload =
    signDataWithRSABuilder builder prv payload

instance BuilderSigningAlgorithm 'PKA.Ed25519 where
  signDataWithAlgorithmicBuilderImpl builder (SP.Ed25519PrivateKey sk) payload =
    signDataWithEd25519Builder builder sk payload

instance BuilderSigningAlgorithm 'PKA.Ed448 where
  signDataWithAlgorithmicBuilderImpl builder (SP.Ed448PrivateKey sk) payload =
    signDataWithEd448Builder builder sk payload

-- | Catch-all instance that produces a compile-time error for any algorithm
-- that is not supported by the algorithmic builder (e.g. DSA, ECDSA).
instance {-# OVERLAPPABLE #-}
  TypeError
    ( 'Text "signDataWithAlgorithmicBuilder does not support this algorithm."
    ':$$: 'Text "Supported algorithms: RSA, Ed25519, Ed448."
    ':$$: 'Text "For DSA or ECDSA, use signDataWith{DSA,ECDSA}Builder directly."
    )
  => BuilderSigningAlgorithm algo where
  signDataWithAlgorithmicBuilderImpl = error "unreachable: TypeError fires at compile time"

signDataWithAlgorithmicBuilder
  :: forall (algo :: PKA.PubKeyAlgorithm)
   . BuilderSigningAlgorithm algo
  => SigBuilder Codec.Encryption.OpenPGP.Types.Unhashed Codec.Encryption.OpenPGP.Types.V4Sig algo
  -> PrivateKeyFor algo
  -> ByteString
  -> Either SignError SignaturePayload
signDataWithAlgorithmicBuilder =
  signDataWithAlgorithmicBuilderImpl
