-- Encrypt.hs: OpenPGP (RFC9580) packet-level encryption helpers
-- Copyright © 2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}

module Codec.Encryption.OpenPGP.Encrypt
  ( PKESKEncryptError(..)
  , RecipientCapabilityNegotiationMode(..)
  , RecipientCapabilityError(..)
  , renderRecipientCapabilityError
  , RecipientCapabilities(..)
  , recipientCapabilitiesFromSubpacketPayloads
  , recipientCapabilitySupportsEncryption
  , RecipientTargetRejectionReason(..)
  , RecipientEncryptionTargetRejected(..)
  , RecipientEncryptionTargetsReport(..)
  , recipientEncryptionTargetsReportFromTKAtTimestamp
  , recipientEncryptionTargetsReportFromTK
  , recipientEncryptionTargetFromTKAtTimestamp
  , recipientEncryptionTargetFromTKAtTimestampWithPolicy
  , recipientEncryptionTargetsFromTKAtTimestamp
  , recipientEncryptionTargetFromTK
  , recipientEncryptionTargetFromTKWithPolicy
  , recipientEncryptionTargetsFromTK
  , RecipientTargetSelectionPolicy(..)
  , PassphraseSKESKVersionPolicy(..)
  , PassphraseEncryptRequest(..)
  , encryptPassphraseWithPolicy
  , PKESKVersionPolicy(..)
  , RecipientPKESKVersionStrategy(..)
  , RecipientPKESKVersionStrategyW(..)
  , SomeRecipientPKESKVersionStrategyW(..)
  , RecipientPKESKVersionSelector
  , RecipientPKESKVersionSelectorTyped
  , EncryptCompatibilityProfile(..)
  , EncryptCompatibilityProfileW(..)
  , SomeEncryptCompatibilityProfileW(..)
  , RecipientEncryptionTarget(..)
  , recipientEncryptionTarget
  , recipientEncryptionTargetWithStrategy
  , recipientEncryptionTargetWithCapabilities
  , recipientEncryptionTargetWithStrategyTyped
  , recipientVersionStrategyForProfile
  , recipientVersionStrategyForProfileTyped
  , RecipientPayloadShape(..)
  , defaultRecipientPayloadShape
  , SEIPDVersion(..)
  , RecipientEncryptResult(..)
  , RecipientEncryptRequest(..)
  , RecipientEncryptRequestOverrides(..)
  , encryptForRecipients
  , encryptForRecipientsLegacy
  , encryptForRecipientsWithCapabilityNegotiation
  , PKESKV3SessionMaterial
  , PKESKV6RawSessionMaterial
  , PKESKSessionMaterial
  , pkeskSessionAlgorithm
  , pkeskSessionKey
  , mkPKESKSessionMaterial
  , mkPKESKV3SessionMaterial
  , mkPKESKV6RawSessionMaterial
  , pkeskV3SessionMaterial
  , pkeskV6RawSessionMaterial
  , encodeOpenPGPSessionMaterial
  , generateSessionKeyMaterial
  , canonicalizePKESKRecipientId
  , canonicalizePKESKPacketRecipientIds
  , buildPKESKv3PayloadForRecipient
  , buildPKESKv3PktForRecipient
  , buildPKESKPayloadForRecipient
  , buildPKESKPktForRecipient
  , buildPKESKPktsForRecipientTargetsWithSelector
  , buildPKESKPktsForRecipientTargetsWithSelectorTyped
  , encryptSEIPDv2Payload
  , encryptSEIPDv1Payload
  , encryptSEIPDv2WithSKESK
  , encryptSEIPDv2WithSKESKBlock
  , encryptSEIPDv2LiteralDataWithSKESK
  , composeMessageWithSEIPDv2
  ) where

import Codec.Encryption.OpenPGP.BlockCipher (CipherError, renderCipherError, keySize, withSymmetricCipher)
import Codec.Encryption.OpenPGP.CFB
  ( OpenPGPCFBModeW(..)
  , encryptOpenPGPCfbRaw
  , mdcTrailerForSEIPDv1
  )
import Codec.Encryption.OpenPGP.Internal.HOBlockCipher (HOBlockCipher(..))
import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)
import Codec.Encryption.OpenPGP.Internal (leftPadTo, point2MBS)
import Codec.Encryption.OpenPGP.Internal.CryptoAES (withAESCipher)
import Codec.Encryption.OpenPGP.Internal.CryptoECDH
  ( normalizeMontgomeryPublic
  , buildECDHKDFParam
  , deriveECDHKek
  )
import Codec.Encryption.OpenPGP.Internal.CryptoSEIPDv2
  ( aeadModeAndNonceSizeForSEIPDv2
  , deriveSKESK6KEK
  , encryptSKESK6SessionKey
  , seipdv2SymmetricKeySize
  )
import Codec.Encryption.OpenPGP.Policy
  ( PKESKVersionPolicy(..)
  , OpenPGPRFC(..)
  , MessageEncryptionPolicy
  , policyForRFC
  , policyMessageEncryption
  , messageDefaultSymmetricAlgorithm
  , messageSEIPDv2SymmetricAlgorithms
  , messageDefaultAEADAlgorithm
  , messageDefaultChunkSize
  , messageSEIPDv2SaltOctets
  , defaultPKESKVersionPolicy
  )
import Codec.Encryption.OpenPGP.Expirations
  ( effectiveKeyPreferencesAtTimestamp
  , isPKTimeValidWithSelfSignatures
  , keyStateAt
  , keyStateValid
  , signatureEffectiveAt
  )
import Codec.Encryption.OpenPGP.Ontology (isSubkeyBindingSig, isSubkeyRevocation)
import Codec.Encryption.OpenPGP.SignatureQualities (sigCT, signatureHashedSubpacketsKnown)
import Codec.Encryption.OpenPGP.Serialize ()
import Codec.Encryption.OpenPGP.S2K (renderS2KError, string2Key)
import Codec.Encryption.OpenPGP.Types
import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as BTypes
import Codec.Encryption.OpenPGP.Internal.RFC7253OCB (encryptWithOCBRFC7253)
import Control.Applicative ((<|>))
import Control.Lens ((.~), ix)
import Control.Monad (when)
import Data.List (find, foldl', maximumBy)
import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
import Data.Ord (comparing)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import qualified "crypton" Crypto.Cipher.Types as CCT
import qualified Crypto.Error as CE
import qualified Crypto.Hash.Algorithms as CHAlg
import Crypto.KDF.HKDF (expand, extract)
import Crypto.Number.Serialize (i2osp, os2ip)
import qualified Crypto.PubKey.Curve25519 as C25519
import qualified Crypto.PubKey.Curve448 as C448
import qualified Crypto.PubKey.ECC.DH as ECCDH
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.ECC.Generate as ECCGen
import qualified Crypto.PubKey.RSA.PKCS15 as RSA15
import Crypto.Random.Types (MonadRandom, getRandomBytes)
import Data.Binary (put)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Bits ((.&.), shiftL, shiftR, xor)
import Data.Binary.Put (putWord64be, runPut)
import Data.Bifunctor (first)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Set as Set
import Data.Word (Word8, Word16, Word64)
import Data.Int (Int64)

-- | Typed failures from one-pass signature packet construction.
data OPSBuildError
  = OPSBuildMissingIssuerKeyId
  | OPSBuildMissingIssuerFingerprint
  | OPSBuildFingerprintWrongLength Int64
  | OPSBuildUnsupportedSigVersion PacketVersion
  deriving (Eq, Show)

renderOPSBuildError :: OPSBuildError -> String
renderOPSBuildError OPSBuildMissingIssuerKeyId =
  "cannot build OPS3 packet from v4 signature without issuer metadata"
renderOPSBuildError OPSBuildMissingIssuerFingerprint =
  "cannot build OPS6 packet from v6 signature without issuer fingerprint"
renderOPSBuildError (OPSBuildFingerprintWrongLength n) =
  "cannot build OPS6 packet: issuer fingerprint must be 32 octets, got " ++ show n
renderOPSBuildError (OPSBuildUnsupportedSigVersion v) =
  "cannot build one-pass signature packet for unsupported signature version " ++ show v

-- | Typed failures surfaced by encrypt-side PKESK and SEIPD-v2 helpers.
data PKESKEncryptError
  = UnsupportedSessionKeyAlgorithm SymmetricAlgorithm String
  | InvalidSessionKeyLength SymmetricAlgorithm Int Int
  | InvalidRecipientIdentifier String
  | UnsupportedRecipientAlgorithm PubKeyAlgorithm
  | InvalidRecipientKeyMaterial PubKeyAlgorithm String
  | RecipientKdfFailure PubKeyAlgorithm String
  | RecipientKeyWrapFailure PubKeyAlgorithm String
  | RecipientCapabilitySelectionFailure RecipientCapabilityError
  | PayloadBuildFailure String
  | NoRecipientsProvided
  deriving (Eq, Show)

renderPKESKEncryptError :: PKESKEncryptError -> String
renderPKESKEncryptError (UnsupportedSessionKeyAlgorithm algo reason) =
  "unsupported session key algorithm " ++ show algo ++ ": " ++ reason
renderPKESKEncryptError (InvalidSessionKeyLength algo expected actual) =
  "invalid session key length for " ++ show algo ++ ": expected " ++ show expected ++ ", got " ++ show actual
renderPKESKEncryptError (InvalidRecipientIdentifier reason) =
  "invalid recipient identifier: " ++ reason
renderPKESKEncryptError (UnsupportedRecipientAlgorithm algo) =
  "unsupported recipient public-key algorithm: " ++ show algo
renderPKESKEncryptError (InvalidRecipientKeyMaterial algo reason) =
  "invalid recipient key material for " ++ show algo ++ ": " ++ reason
renderPKESKEncryptError (RecipientKdfFailure algo reason) =
  "KDF failure for recipient algorithm " ++ show algo ++ ": " ++ reason
renderPKESKEncryptError (RecipientKeyWrapFailure algo reason) =
  "key wrap failure for recipient algorithm " ++ show algo ++ ": " ++ reason
renderPKESKEncryptError (RecipientCapabilitySelectionFailure err) =
  renderRecipientCapabilityError err
renderPKESKEncryptError (PayloadBuildFailure reason) =
  "payload build failure: " ++ reason
renderPKESKEncryptError NoRecipientsProvided =
  "no recipients provided"

data RecipientCapabilityNegotiationMode
  = RecipientCapabilityNegotiationOff
  | RecipientCapabilityNegotiationOn
  deriving (Eq, Show)

data RecipientCapabilityError
  = RecipientCapabilityMissingEncryptionFlags SomePKPayload (Set.Set KeyFlag)
  | RecipientCapabilityNoEncryptableKeyMaterialInTK
  | RecipientCapabilityMissingSEIPDv1Support [SomePKPayload]
  | RecipientCapabilityMissingSEIPDv2Support [SomePKPayload]
  | RecipientCapabilityNoCommonSymmetricAlgorithms [SymmetricAlgorithm]
  | RecipientCapabilityNoCommonAEADAlgorithms [AEADAlgorithm]
  deriving (Eq, Show)

renderRecipientCapabilityError :: RecipientCapabilityError -> String
renderRecipientCapabilityError (RecipientCapabilityMissingEncryptionFlags recipient flags) =
  "recipient " ++ show (_keyVersion recipient, _pkalgo recipient) ++
  " does not advertise encryption-capable key flags; observed flags: " ++
  show (Set.toList flags)
renderRecipientCapabilityError RecipientCapabilityNoEncryptableKeyMaterialInTK =
  "no encryption-capable primary key or subkey was found in transferable key material"
renderRecipientCapabilityError (RecipientCapabilityMissingSEIPDv1Support recipients) =
  "recipient set does not advertise SEIPDv1 (MDC) support: " ++
  show (map (\r -> (_keyVersion r, _pkalgo r)) recipients)
renderRecipientCapabilityError (RecipientCapabilityMissingSEIPDv2Support recipients) =
  "recipient set does not advertise SEIPDv2 support: " ++
  show (map (\r -> (_keyVersion r, _pkalgo r)) recipients)
renderRecipientCapabilityError (RecipientCapabilityNoCommonSymmetricAlgorithms syms) =
  "no common recipient-supported symmetric algorithms: " ++ show syms
renderRecipientCapabilityError (RecipientCapabilityNoCommonAEADAlgorithms aeads) =
  "no common recipient-supported AEAD algorithms: " ++ show aeads

data RecipientCapabilities =
  RecipientCapabilities
    { recipientCapabilityKeyVersion :: KeyVersion
    , recipientCapabilityPublicKeyAlgorithm :: PubKeyAlgorithm
    , recipientCapabilityKeyFlags :: Set.Set KeyFlag
    , recipientCapabilityFeatures :: Set.Set FeatureFlag
    , recipientCapabilityPreferredSymmetricAlgorithms :: [SymmetricAlgorithm]
    , recipientCapabilityPreferredAEADAlgorithms :: [AEADAlgorithm]
    }
  deriving (Eq, Show)

data RecipientTargetRejectionReason
  = RecipientTargetUnsupportedAlgorithm PubKeyAlgorithm
  | RecipientTargetMissingEncryptionFlags SomePKPayload (Set.Set KeyFlag)
  | RecipientTargetRevoked SomePKPayload
  | RecipientTargetNotValidAtTimestamp SomePKPayload ThirtyTwoBitTimeStamp
  deriving (Eq, Show)

data RecipientEncryptionTargetRejected =
  RecipientEncryptionTargetRejected
    { recipientEncryptionTargetRejectedKey :: SomePKPayload
    , recipientEncryptionTargetRejectedCapabilities :: Maybe RecipientCapabilities
    , recipientEncryptionTargetRejectedReason :: RecipientTargetRejectionReason
    }
  deriving (Eq, Show)

data RecipientEncryptionTargetsReport =
  RecipientEncryptionTargetsReport
    { recipientEncryptionTargetsAccepted :: [RecipientEncryptionTarget]
    , recipientEncryptionTargetsRejected :: [RecipientEncryptionTargetRejected]
    }
  deriving (Eq, Show)

-- | Extract encrypt-relevant recipient capabilities from effective
-- self-signature subpackets.
--
-- RFC 9580 preferred AEAD ciphersuites are currently carried through
-- 'OtherSigSub' type 39 and decoded into AEAD preferences here.
recipientCapabilitiesFromSubpacketPayloads ::
     SomePKPayload
  -> [SigSubPacketPayload]
  -> RecipientCapabilities
recipientCapabilitiesFromSubpacketPayloads recipient payloads =
  foldl' step (emptyRecipientCapabilities recipient) payloads
  where
    preferredAEADCiphersuitesSubpacketType :: Word8
    preferredAEADCiphersuitesSubpacketType = 39

    step caps payload =
      case payload of
        KeyFlags flags ->
          caps
            { recipientCapabilityKeyFlags =
                recipientCapabilityKeyFlags caps `Set.union` flags
            }
        Features features ->
          caps
            { recipientCapabilityFeatures =
                recipientCapabilityFeatures caps `Set.union` features
            }
        PreferredSymmetricAlgorithms syms ->
          caps
            { recipientCapabilityPreferredSymmetricAlgorithms =
                recipientCapabilityPreferredSymmetricAlgorithms caps ++ syms
            }
        OtherSigSub subpacketType rawPayload
          | subpacketType == preferredAEADCiphersuitesSubpacketType ->
              caps
                { recipientCapabilityPreferredAEADAlgorithms =
                    recipientCapabilityPreferredAEADAlgorithms caps ++
                    preferredAEADAlgorithmsFromCiphersuites rawPayload
                }
        _ -> caps

    emptyRecipientCapabilities key =
      RecipientCapabilities
        { recipientCapabilityKeyVersion = _keyVersion key
        , recipientCapabilityPublicKeyAlgorithm = _pkalgo key
        , recipientCapabilityKeyFlags = Set.empty
        , recipientCapabilityFeatures = Set.empty
        , recipientCapabilityPreferredSymmetricAlgorithms = []
        , recipientCapabilityPreferredAEADAlgorithms = []
        }

    preferredAEADAlgorithmsFromCiphersuites :: BL.ByteString -> [AEADAlgorithm]
    preferredAEADAlgorithmsFromCiphersuites =
      dedupePreservingOrder . parsePairs . BL.unpack
      where
        parsePairs (_symAlgo:aeadAlgo:rest) =
          (toFVal aeadAlgo :: AEADAlgorithm) : parsePairs rest
        parsePairs _ = []

        dedupePreservingOrder = foldl' addIfMissing []
        addIfMissing acc x
          | x `elem` acc = acc
          | otherwise = acc ++ [x]

recipientCapabilitySupportsEncryption :: RecipientCapabilities -> Bool
recipientCapabilitySupportsEncryption caps =
  let flags = recipientCapabilityKeyFlags caps
   in Set.null flags ||
      Set.member EncryptStorageKey flags ||
      Set.member EncryptCommunicationsKey flags

recipientCapabilityAdvertisesSEIPDv1Support :: RecipientCapabilities -> Bool
recipientCapabilityAdvertisesSEIPDv1Support caps =
  let features = recipientCapabilityFeatures caps
   in Set.null features || Set.member FeatureSEIPDv1 features

recipientCapabilityAdvertisesSEIPDv2Support :: RecipientCapabilities -> Bool
recipientCapabilityAdvertisesSEIPDv2Support caps =
  recipientCapabilityAdvertisesSEIPDv1Support caps &&
  Set.member FeatureSEIPDv2 (recipientCapabilityFeatures caps)

recipientEncryptionTargetFromTKAtTimestamp ::
     ThirtyTwoBitTimeStamp
  -> TKUnknown
  -> Either RecipientCapabilityError RecipientEncryptionTarget
recipientEncryptionTargetFromTKAtTimestamp timestamp tk =
  recipientEncryptionTargetFromTKAtTimestampWithPolicy
    RecipientTargetSelectionFirstValid
    timestamp
    tk

data RecipientTargetSelectionPolicy
  = RecipientTargetSelectionFirstValid
  | RecipientTargetSelectionPreferPrimary
  | RecipientTargetSelectionPreferSubkey
  | RecipientTargetSelectionPreferNewestCreationTime
  deriving (Eq, Show)

recipientEncryptionTargetFromTKAtTimestampWithPolicy ::
     RecipientTargetSelectionPolicy
  -> ThirtyTwoBitTimeStamp
  -> TKUnknown
  -> Either RecipientCapabilityError RecipientEncryptionTarget
recipientEncryptionTargetFromTKAtTimestampWithPolicy policy timestamp tk =
  case chooseRecipientTarget policy tk acceptedTargets of
    Just target -> Right target
    Nothing -> Left RecipientCapabilityNoEncryptableKeyMaterialInTK
  where
    acceptedTargets =
      recipientEncryptionTargetsAccepted
        (recipientEncryptionTargetsReportFromTKAtTimestamp timestamp tk)

recipientEncryptionTargetFromTK :: TK 'PublicTK -> Either RecipientCapabilityError RecipientEncryptionTarget
recipientEncryptionTargetFromTK tk =
  recipientEncryptionTargetFromTKAtTimestampWithPolicy
    RecipientTargetSelectionFirstValid
    (_timestamp (keyPktPKPayload (_tkPrimaryKey tk)))
    (tkToUnknown tk)

recipientEncryptionTargetFromTKWithPolicy ::
     RecipientTargetSelectionPolicy
  -> TK 'PublicTK
  -> Either RecipientCapabilityError RecipientEncryptionTarget
recipientEncryptionTargetFromTKWithPolicy policy tk =
  recipientEncryptionTargetFromTKAtTimestampWithPolicy
    policy
    (_timestamp (keyPktPKPayload (_tkPrimaryKey tk)))
    (tkToUnknown tk)

recipientEncryptionTargetsFromTKAtTimestamp ::
     ThirtyTwoBitTimeStamp
  -> TKUnknown
  -> [RecipientEncryptionTarget]
recipientEncryptionTargetsFromTKAtTimestamp timestamp tk =
  recipientEncryptionTargetsAccepted (recipientEncryptionTargetsReportFromTKAtTimestamp timestamp tk)

recipientEncryptionTargetsReportFromTKAtTimestamp ::
     ThirtyTwoBitTimeStamp
  -> TKUnknown
  -> RecipientEncryptionTargetsReport
recipientEncryptionTargetsReportFromTKAtTimestamp timestamp tk =
  foldr classifyCandidate emptyReport (subkeyCandidates ++ [primaryCandidate])
  where
    emptyReport = RecipientEncryptionTargetsReport [] []
    primaryCandidate = fst (_tkuKey tk)
    primaryPreferencePayloads =
      fromMaybe [] (effectiveKeyPreferencesAtTimestamp timestamp tk)
    subkeyCandidates =
      mapMaybe
        (\(pkt, _) ->
           case pkt of
             PublicSubkeyPkt pkp -> Just pkp
             SecretSubkeyPkt pkp _ -> Just pkp
             _ -> Nothing)
        (_tkuSubs tk)
    classifyCandidate key report =
      let caps =
            recipientCapabilitiesFromSubpacketPayloads
              key
              (primaryPreferencePayloads ++ subkeyBindingCapabilityPayloads timestamp tk key)
          keyStateRejection = recipientValidityRejectionReason timestamp tk key
       in case keyStateRejection of
            Just rejectionReason ->
             report
               { recipientEncryptionTargetsRejected =
                   RecipientEncryptionTargetRejected
                     { recipientEncryptionTargetRejectedKey = key
                     , recipientEncryptionTargetRejectedCapabilities = Just caps
                     , recipientEncryptionTargetRejectedReason = rejectionReason
                     } :
                   recipientEncryptionTargetsRejected report
               }
            Nothing ->
             if not (supportsPKESKRecipientAlgorithm key)
               then
                 report
                   { recipientEncryptionTargetsRejected =
                       RecipientEncryptionTargetRejected
                         { recipientEncryptionTargetRejectedKey = key
                         , recipientEncryptionTargetRejectedCapabilities = Just caps
                         , recipientEncryptionTargetRejectedReason =
                             RecipientTargetUnsupportedAlgorithm (_pkalgo key)
                         } :
                       recipientEncryptionTargetsRejected report
                   }
               else
                 if recipientCapabilitySupportsEncryption caps
                   then
                     report
                       { recipientEncryptionTargetsAccepted =
                           recipientEncryptionTargetWithCapabilities key caps :
                           recipientEncryptionTargetsAccepted report
                       }
                   else
                     report
                       { recipientEncryptionTargetsRejected =
                           RecipientEncryptionTargetRejected
                             { recipientEncryptionTargetRejectedKey = key
                             , recipientEncryptionTargetRejectedCapabilities = Just caps
                             , recipientEncryptionTargetRejectedReason =
                                 RecipientTargetMissingEncryptionFlags key (recipientCapabilityKeyFlags caps)
                             } :
                           recipientEncryptionTargetsRejected report
                       }

recipientEncryptionTargetsFromTK :: TK 'PublicTK -> [RecipientEncryptionTarget]
recipientEncryptionTargetsFromTK tk =
  recipientEncryptionTargetsFromTKAtTimestamp
    (_timestamp (keyPktPKPayload (_tkPrimaryKey tk)))
    (tkToUnknown tk)

recipientEncryptionTargetsReportFromTK :: TK 'PublicTK -> RecipientEncryptionTargetsReport
recipientEncryptionTargetsReportFromTK tk =
  recipientEncryptionTargetsReportFromTKAtTimestamp
    (_timestamp (keyPktPKPayload (_tkPrimaryKey tk)))
    (tkToUnknown tk)

subkeyBindingCapabilityPayloads ::
     ThirtyTwoBitTimeStamp
  -> TKUnknown
  -> SomePKPayload
  -> [SigSubPacketPayload]
subkeyBindingCapabilityPayloads timestamp tk recipient =
  maybe [] latestEffectiveBindingPayloads matchingSubkey
  where
    matchingSubkey =
      find
        (\(pkt, _) ->
           case pkt of
             PublicSubkeyPkt pkp -> fingerprint pkp == fingerprint recipient
             SecretSubkeyPkt pkp _ -> fingerprint pkp == fingerprint recipient
             _ -> False)
        (_tkuSubs tk)
    latestEffectiveBindingPayloads (_, sigs) =
      maybe [] signaturePayloadsFromSignature (latestEffectiveSubkeyBindingSignature timestamp sigs)

latestEffectiveSubkeyBindingSignature ::
     ThirtyTwoBitTimeStamp
  -> [SignaturePayload]
  -> Maybe SignaturePayload
latestEffectiveSubkeyBindingSignature timestamp sigs =
  case filter (isEffectiveSubkeyBindingSignature timestamp) sigs of
    [] -> Nothing
    candidates -> Just (maximumBy (comparing signatureCreationTimestamp) candidates)

isEffectiveSubkeyBindingSignature ::
     ThirtyTwoBitTimeStamp
  -> SignaturePayload
  -> Bool
isEffectiveSubkeyBindingSignature timestamp sig =
  isSubkeyBindingSig sig &&
  maybe False
    (\created ->
       let tsValue = toInteger (unThirtyTwoBitTimeStamp timestamp)
           createdValue = toInteger (unThirtyTwoBitTimeStamp created)
        in createdValue <= tsValue &&
           maybe True
             (\duration ->
                if unThirtyTwoBitDuration duration == 0
                  then True
                  else tsValue < createdValue + toInteger (unThirtyTwoBitDuration duration))
             (signatureExpirationDuration sig))
    (sigCT sig)

signatureCreationTimestamp :: SignaturePayload -> ThirtyTwoBitTimeStamp
signatureCreationTimestamp sig =
  fromMaybe (ThirtyTwoBitTimeStamp 0) (sigCT sig)

signatureExpirationDuration :: SignaturePayload -> Maybe ThirtyTwoBitDuration
signatureExpirationDuration sig =
  case signatureHashedSubpacketsKnown sig of
    Just hashed ->
      foldr
        (\subpacket acc ->
           case subpacket of
             SigSubPacket _ (SigExpirationTime duration) -> Just duration
             _ -> acc)
        Nothing
        hashed
    Nothing -> Nothing

signaturePayloadsFromSignature :: SignaturePayload -> [SigSubPacketPayload]
signaturePayloadsFromSignature sig =
  case signatureHashedSubpacketsKnown sig of
    Just hashed -> map (\(SigSubPacket _ payload) -> payload) hashed
    Nothing -> []

recipientValidityRejectionReason ::
     ThirtyTwoBitTimeStamp
  -> TKUnknown
  -> SomePKPayload
  -> Maybe RecipientTargetRejectionReason
recipientValidityRejectionReason timestamp tk key
  | fingerprint key == fingerprint (fst (_tkuKey tk)) =
      if keyStateValid (keyStateAt (timestampToUTC timestamp) tk)
        then Nothing
        else Just (RecipientTargetNotValidAtTimestamp key timestamp)
  | otherwise =
      case findMatchingSubkeySignatures tk key of
        Nothing -> Nothing
        Just sigs
          | subkeyRevokedAtTimestamp timestamp sigs ->
              Just (RecipientTargetRevoked key)
          | isPKTimeValidWithSelfSignatures (timestampToUTC timestamp) key sigs ->
              Nothing
          | otherwise ->
              Just (RecipientTargetNotValidAtTimestamp key timestamp)

findMatchingSubkeySignatures :: TKUnknown -> SomePKPayload -> Maybe [SignaturePayload]
findMatchingSubkeySignatures tk recipient =
  snd <$>
  find
    (\(pkt, _) ->
       case pkt of
         PublicSubkeyPkt pkp -> fingerprint pkp == fingerprint recipient
         SecretSubkeyPkt pkp _ -> fingerprint pkp == fingerprint recipient
         _ -> False)
    (_tkuSubs tk)

subkeyRevokedAtTimestamp :: ThirtyTwoBitTimeStamp -> [SignaturePayload] -> Bool
subkeyRevokedAtTimestamp timestamp =
  any (\sig -> isSubkeyRevocation sig && signatureEffectiveAt (timestampToUTC timestamp) sig)

timestampToUTC :: ThirtyTwoBitTimeStamp -> UTCTime
timestampToUTC =
  posixSecondsToUTCTime . realToFrac . unThirtyTwoBitTimeStamp

supportsPKESKRecipientAlgorithm :: SomePKPayload -> Bool
supportsPKESKRecipientAlgorithm recipient =
  case _pkalgo recipient of
    RSA -> True
    DeprecatedRSAEncryptOnly -> True
    ECDH -> True
    X25519 -> True
    X448 -> True
    _ -> False

chooseRecipientTarget ::
     RecipientTargetSelectionPolicy
  -> TKUnknown
  -> [RecipientEncryptionTarget]
  -> Maybe RecipientEncryptionTarget
chooseRecipientTarget policy tk targets =
  case policy of
    RecipientTargetSelectionFirstValid -> listToMaybe targets
    RecipientTargetSelectionPreferPrimary ->
      listToMaybe (filter (isPrimaryTarget tk) targets) <|> listToMaybe targets
    RecipientTargetSelectionPreferSubkey ->
      listToMaybe (filter (not . isPrimaryTarget tk) targets) <|> listToMaybe targets
    RecipientTargetSelectionPreferNewestCreationTime ->
      case targets of
        [] -> Nothing
        (target:rest) ->
          Just
            (foldl'
               (\best candidate ->
                  if _timestamp (recipientEncryptionTargetKey candidate) >
                     _timestamp (recipientEncryptionTargetKey best)
                    then candidate
                    else best)
               target
               rest)
  where
    isPrimaryTarget currentTK target =
      fingerprint (recipientEncryptionTargetKey target) ==
      fingerprint (fst (_tkuKey currentTK))

-- | Session-key bundle for PKESK/SKESK packet construction.
newtype PKESKV3SessionMaterial =
  PKESKV3SessionMaterial
    { unPKESKV3SessionMaterial :: B.ByteString
    }
  deriving (Eq, Show)

newtype PKESKV6RawSessionMaterial =
  PKESKV6RawSessionMaterial
    { unPKESKV6RawSessionMaterial :: B.ByteString
    }
  deriving (Eq, Show)

data PKESKSessionMaterial =
  PKESKSessionMaterial
    { pkeskSessionAlgorithm :: SymmetricAlgorithm
    , pkeskSessionKey :: SessionKey
    , pkeskEncodedSessionMaterial :: B.ByteString
    }
  deriving (Eq, Show)

mkPKESKSessionMaterial ::
     SymmetricAlgorithm
  -> SessionKey
  -> Either PKESKEncryptError PKESKSessionMaterial
mkPKESKSessionMaterial symalgo sessionKey = do
  v3Material <- mkPKESKV3SessionMaterial symalgo sessionKey
  _v6Material <- mkPKESKV6RawSessionMaterial symalgo sessionKey
  pure
    PKESKSessionMaterial
      { pkeskSessionAlgorithm = symalgo
      , pkeskSessionKey = sessionKey
      , pkeskEncodedSessionMaterial = unPKESKV3SessionMaterial v3Material
      }

mkPKESKV3SessionMaterial ::
     SymmetricAlgorithm
  -> SessionKey
  -> Either PKESKEncryptError PKESKV3SessionMaterial
mkPKESKV3SessionMaterial symalgo sessionKey = do
  keyBytes <- validatedSessionKeyBytes symalgo sessionKey
  pure $
    PKESKV3SessionMaterial
      (B.singleton (fromFVal symalgo) <> keyBytes <> checksum16Bytes keyBytes)

mkPKESKV6RawSessionMaterial ::
     SymmetricAlgorithm
  -> SessionKey
  -> Either PKESKEncryptError PKESKV6RawSessionMaterial
mkPKESKV6RawSessionMaterial symalgo sessionKey =
  PKESKV6RawSessionMaterial <$> validatedSessionKeyBytes symalgo sessionKey

pkeskV3SessionMaterial :: PKESKSessionMaterial -> PKESKV3SessionMaterial
pkeskV3SessionMaterial =
  PKESKV3SessionMaterial . pkeskEncodedSessionMaterial

pkeskV6RawSessionMaterial :: PKESKSessionMaterial -> PKESKV6RawSessionMaterial
pkeskV6RawSessionMaterial =
  PKESKV6RawSessionMaterial . unSessionKey . pkeskSessionKey

validatedSessionKeyBytes ::
     SymmetricAlgorithm
  -> SessionKey
  -> Either PKESKEncryptError B.ByteString
validatedSessionKeyBytes symalgo (SessionKey sessionKey) = do
  keyLen <-
    first
      (UnsupportedSessionKeyAlgorithm symalgo . renderCipherError)
      (keySize symalgo)
  let actualLen = B.length sessionKey
  if actualLen /= keyLen
    then Left (InvalidSessionKeyLength symalgo keyLen actualLen)
    else Right sessionKey

data RecipientPKESKVersionStrategy
  = RecipientPreferV6
  | RecipientForceV3Interop
  deriving (Eq, Show)

data RecipientPKESKVersionStrategyW (strategy :: RecipientPKESKVersionStrategy) where
  RecipientPreferV6W :: RecipientPKESKVersionStrategyW 'RecipientPreferV6
  RecipientForceV3InteropW :: RecipientPKESKVersionStrategyW 'RecipientForceV3Interop

data SomeRecipientPKESKVersionStrategyW where
  SomeRecipientPKESKVersionStrategyW ::
       RecipientPKESKVersionStrategyW strategy
    -> SomeRecipientPKESKVersionStrategyW

type RecipientPKESKVersionSelector =
  SomePKPayload -> Either PKESKEncryptError RecipientPKESKVersionStrategy

type RecipientPKESKVersionSelectorTyped =
  SomePKPayload -> Either PKESKEncryptError SomeRecipientPKESKVersionStrategyW

data EncryptCompatibilityProfile
  = EncryptStrictDefault
  | EncryptInteropLegacy
  deriving (Eq, Show)

data EncryptCompatibilityProfileW (profile :: EncryptCompatibilityProfile) where
  EncryptStrictDefaultW :: EncryptCompatibilityProfileW 'EncryptStrictDefault
  EncryptInteropLegacyW :: EncryptCompatibilityProfileW 'EncryptInteropLegacy

data SomeEncryptCompatibilityProfileW where
  SomeEncryptCompatibilityProfileW ::
       EncryptCompatibilityProfileW profile
    -> SomeEncryptCompatibilityProfileW

data SEIPDVersion
  = SEIPDv1
  | SEIPDv2
  deriving (Eq, Show)

type family PayloadVersionForProfile (profile :: EncryptCompatibilityProfile) :: SEIPDVersion where
  PayloadVersionForProfile 'EncryptStrictDefault = 'SEIPDv2
  PayloadVersionForProfile 'EncryptInteropLegacy = 'SEIPDv1

type family ProfileForPayloadVersion (version :: SEIPDVersion) :: EncryptCompatibilityProfile where
  ProfileForPayloadVersion 'SEIPDv1 = 'EncryptInteropLegacy
  ProfileForPayloadVersion 'SEIPDv2 = 'EncryptStrictDefault

data RecipientEncryptionTarget =
  RecipientEncryptionTarget
    { -- | Recipient key packet selected for PKESK wrapping.
      recipientEncryptionTargetKey :: SomePKPayload
      -- | Optional explicit PKESK version strategy hint.
      --   When absent, profile defaults and auto-detection apply.
    , recipientEncryptionTargetStrategy :: Maybe RecipientPKESKVersionStrategy
      -- | Optional recipient capability hints used by negotiation-enabled
      --   encryption to choose common symmetric/AEAD algorithms.
    , recipientEncryptionTargetCapabilities :: Maybe RecipientCapabilities
    }
  deriving (Eq, Show)

recipientEncryptionTarget :: SomePKPayload -> RecipientEncryptionTarget
recipientEncryptionTarget recipient =
  RecipientEncryptionTarget recipient Nothing Nothing

recipientEncryptionTargetWithStrategy :: SomePKPayload -> RecipientPKESKVersionStrategy -> RecipientEncryptionTarget
recipientEncryptionTargetWithStrategy recipient strategy =
  RecipientEncryptionTarget recipient (Just strategy) Nothing

recipientEncryptionTargetWithCapabilities ::
     SomePKPayload
  -> RecipientCapabilities
  -> RecipientEncryptionTarget
recipientEncryptionTargetWithCapabilities recipient capabilities =
  RecipientEncryptionTarget recipient Nothing (Just capabilities)

recipientEncryptionTargetWithStrategyTyped :: SomePKPayload
  -> RecipientPKESKVersionStrategyW strategy
  -> RecipientEncryptionTarget
recipientEncryptionTargetWithStrategyTyped recipient strategyW =
  recipientEncryptionTargetWithStrategy recipient (demoteRecipientStrategy strategyW)

recipientVersionStrategyForProfile ::
     EncryptCompatibilityProfile
  -> RecipientEncryptionTarget
  -> Either PKESKEncryptError RecipientPKESKVersionStrategy
recipientVersionStrategyForProfile profile target =
  case promoteEncryptCompatibilityProfile profile of
    SomeEncryptCompatibilityProfileW profileW ->
      demoteSomeRecipientStrategy <$>
      recipientVersionStrategyForProfileTyped profileW target

recipientVersionStrategyForProfileTyped ::
     EncryptCompatibilityProfileW profile
  -> RecipientEncryptionTarget
  -> Either PKESKEncryptError SomeRecipientPKESKVersionStrategyW
recipientVersionStrategyForProfileTyped profile target =
  Right $
    case recipientEncryptionTargetStrategy target of
      Just strategy ->
        promoteRecipientStrategy strategy
      Nothing ->
        case profile of
          EncryptStrictDefaultW ->
            autoDetectRecipientVersionStrategy
              (recipientEncryptionTargetKey target)
          EncryptInteropLegacyW ->
            SomeRecipientPKESKVersionStrategyW RecipientForceV3InteropW

profileForPayloadVersionW ::
     RecipientEncryptRequestOverrides version
  -> EncryptCompatibilityProfileW (ProfileForPayloadVersion version)
profileForPayloadVersionW overrides =
  case overrides of
    RecipientEncryptRequestSEIPDv2Overrides {} -> EncryptStrictDefaultW
    RecipientEncryptRequestSEIPDv1Overrides {} -> EncryptInteropLegacyW

autoDetectRecipientVersionStrategy :: SomePKPayload
  -> SomeRecipientPKESKVersionStrategyW
autoDetectRecipientVersionStrategy recipient
  | _keyVersion recipient == V6 =
      SomeRecipientPKESKVersionStrategyW RecipientPreferV6W
  | _pkalgo recipient `elem` [X25519, X448] =
      SomeRecipientPKESKVersionStrategyW RecipientPreferV6W
  | otherwise =
      SomeRecipientPKESKVersionStrategyW RecipientForceV3InteropW

data RecipientPayloadShape =
  RecipientPayloadShape
    { recipientPayloadDataType :: DataType
    , recipientPayloadFileName :: FileName
    , recipientPayloadTimestamp :: ThirtyTwoBitTimeStamp
    , recipientPayloadUseOnePassSignatures :: Bool
    , recipientPayloadSignatures :: [SignaturePayload]
    }
  deriving (Eq, Show)

data PassphraseSKESKVersionPolicy
  = PassphraseSKESKPreferV6
  | PassphraseSKESKForceV4Interop
  deriving (Eq, Show)

data PassphraseEncryptRequest =
  PassphraseEncryptRequest
    { passphraseEncryptVersionPolicy :: PassphraseSKESKVersionPolicy
    , passphraseEncryptSymmetricAlgorithm :: SymmetricAlgorithm
    , passphraseEncryptS2K :: S2K
    , passphraseEncryptPassphrase :: BL.ByteString
    , passphraseEncryptPayload :: B.ByteString
    , passphraseEncryptSEIPDv1IVOverride :: Maybe IV
    , passphraseEncryptSEIPDv2AEADOverride :: Maybe AEADAlgorithm
    , passphraseEncryptSEIPDv2ChunkSizeOverride :: Maybe Word8
    , passphraseEncryptSEIPDv2SaltOverride :: Maybe Salt
    }
  deriving (Eq, Show)

encryptPassphraseWithPolicy ::
     MonadRandom m
  => PassphraseEncryptRequest
  -> m (Either String [Pkt])
encryptPassphraseWithPolicy request =
  case passphraseEncryptVersionPolicy request of
    PassphraseSKESKForceV4Interop ->
      encryptSEIPDv1WithSKESK
        (passphraseEncryptSymmetricAlgorithm request)
        (passphraseEncryptS2K request)
        (passphraseEncryptSEIPDv1IVOverride request)
        (passphraseEncryptPassphrase request)
        (passphraseEncryptPayload request)
    PassphraseSKESKPreferV6 -> do
      let messagePolicy = policyMessageEncryption (policyForRFC RFC9580)
          aead =
            fromMaybe
              (messageDefaultAEADAlgorithm messagePolicy)
              (passphraseEncryptSEIPDv2AEADOverride request)
          chunkSize =
            fromMaybe
              (messageDefaultChunkSize messagePolicy)
              (passphraseEncryptSEIPDv2ChunkSizeOverride request)
      salt <-
        maybe
          (Salt <$> getRandomBytes (messageSEIPDv2SaltOctets messagePolicy))
          pure
          (passphraseEncryptSEIPDv2SaltOverride request)
      pure $
        encryptSEIPDv2WithSKESK
          (passphraseEncryptSymmetricAlgorithm request)
          aead
          chunkSize
          salt
          (passphraseEncryptS2K request)
          (passphraseEncryptPassphrase request)
          (passphraseEncryptPayload request)

defaultRecipientPayloadShape :: RecipientPayloadShape
defaultRecipientPayloadShape =
  RecipientPayloadShape
    { recipientPayloadDataType = BinaryData
    , recipientPayloadFileName = BL.empty
    , recipientPayloadTimestamp = 0
    , recipientPayloadUseOnePassSignatures = False
    , recipientPayloadSignatures = []
    }

data RecipientEncryptResult =
  RecipientEncryptResult
    { recipientEncryptPackets :: [Pkt]
    , recipientEncryptSessionMaterial :: PKESKSessionMaterial
    }
  deriving (Eq, Show)

data RecipientEncryptRequestOverrides (v :: SEIPDVersion) where
  RecipientEncryptRequestSEIPDv1Overrides ::
    { recipientEncryptRequestIVOverride :: Maybe IV
    } -> RecipientEncryptRequestOverrides 'SEIPDv1
  -- | For SEIPDv2 requests:
  --   - when AEAD override is 'Nothing', encrypt-side capability negotiation
  --     selects a common recipient-supported AEAD algorithm (if enabled).
  --   - when AEAD override is 'Just', the explicit AEAD wins.
  RecipientEncryptRequestSEIPDv2Overrides ::
    { recipientEncryptRequestAEADOverride :: Maybe AEADAlgorithm
    , recipientEncryptRequestChunkSizeOverride :: Maybe Word8
    , recipientEncryptRequestSaltOverride :: Maybe Salt
    } -> RecipientEncryptRequestOverrides 'SEIPDv2

data RecipientEncryptRequest (v :: SEIPDVersion) =
  RecipientEncryptRequest
    { -- | Recipient encryption targets. At least one target is required.
      recipientEncryptRequestTargets :: [RecipientEncryptionTarget]
    , recipientEncryptRequestPayloadShape :: RecipientPayloadShape
    , recipientEncryptRequestPayload :: B.ByteString
      -- | Explicit symmetric algorithm override. When 'Nothing', the selected
      --   mode (negotiated or legacy) determines algorithm selection.
    , recipientEncryptRequestSymmetricOverride :: Maybe SymmetricAlgorithm
    , recipientEncryptRequestOverrides :: RecipientEncryptRequestOverrides v
    }

deriving instance Eq (RecipientEncryptRequestOverrides v)
deriving instance Show (RecipientEncryptRequestOverrides v)
deriving instance Eq (RecipientEncryptRequest v)
deriving instance Show (RecipientEncryptRequest v)

-- | Encode the RFC 9580 PKESK/SKESK session-key material:
--   one-octet algorithm ID, raw session key, then 16-bit checksum.
encodeOpenPGPSessionMaterial ::
     SymmetricAlgorithm -> SessionKey -> Either PKESKEncryptError B.ByteString
encodeOpenPGPSessionMaterial symalgo sessionKey =
  unPKESKV3SessionMaterial <$> mkPKESKV3SessionMaterial symalgo sessionKey

-- | Generate a fresh session key and return both raw and encoded forms.
generateSessionKeyMaterial ::
     MonadRandom m
  => SymmetricAlgorithm
  -> m (Either PKESKEncryptError PKESKSessionMaterial)
generateSessionKeyMaterial symalgo =
  case keySize symalgo of
    Left err -> pure (Left (UnsupportedSessionKeyAlgorithm symalgo (renderCipherError err)))
    Right keyLen -> do
      sessionKeyBytes <- getRandomBytes keyLen
      let sessionKey = SessionKey sessionKeyBytes
      pure (mkPKESKSessionMaterial symalgo sessionKey)

canonicalizePKESKRecipientId ::
     PKESKPayload -> Either PKESKEncryptError PKESKPayload
canonicalizePKESKRecipientId payload =
  case payload of
    PKESKPayloadV6Packet payloadV6 ->
      PKESKPayloadV6Packet <$> canonicalizePKESKRecipientIdV6 payloadV6
    _ -> Right payload

canonicalizePKESKRecipientIdV6 ::
     PKESKPayloadV6 -> Either PKESKEncryptError PKESKPayloadV6
canonicalizePKESKRecipientIdV6 (PKESKPayloadV6 rid pka esk) =
  (\normalizedRid -> PKESKPayloadV6 normalizedRid pka esk) <$>
  canonicalizeRecipientKeyIdentifier rid

canonicalizeRecipientKeyIdentifier ::
     BL.ByteString -> Either PKESKEncryptError BL.ByteString
canonicalizeRecipientKeyIdentifier rid
  | BL.length rid == 20 || BL.length rid == 32 = Right rid
  | BL.length rid == 21 && BL.head rid == 0x04 = Right (BL.tail rid)
  | BL.length rid == 33 && BL.head rid == 0x06 = Right (BL.tail rid)
  | otherwise =
      Left
        (InvalidRecipientIdentifier
           ("unsupported PKESK recipient identifier length/prefix: " ++
            show (BL.length rid)))

canonicalizePKESKPacketRecipientIds ::
     [Pkt] -> Either PKESKEncryptError [Pkt]
canonicalizePKESKPacketRecipientIds =
  mapM
    (\pkt ->
       case pkt of
         PKESKPkt payload -> fmap PKESKPkt (canonicalizePKESKRecipientId payload)
         _ -> Right pkt)

-- | Build a v6 PKESK payload for one recipient key according to the selected version policy.
buildPKESKPayloadForRecipient ::
     MonadRandom m
  => PKESKVersionPolicy
  -> SomePKPayload
  -> PKESKSessionMaterial
  -> m (Either PKESKEncryptError PKESKPayload)
buildPKESKPayloadForRecipient policy recipient material =
  case policy of
    ForceV3Interop ->
      buildPKESKv3PayloadForRecipient recipient (pkeskV3SessionMaterial material)
    PreferV6 ->
      case _pkalgo recipient of
        RSA -> fmap (fmap PKESKPayloadV6Packet) (buildRsaPKESKv6 recipient material)
        ECDH -> fmap (fmap PKESKPayloadV6Packet) (buildECDHPKESKv6 recipient material)
        X25519 ->
          fmap
            (fmap PKESKPayloadV6Packet)
            (buildX25519PKESKv6 recipient (pkeskV6RawSessionMaterial material))
        X448 ->
          fmap
            (fmap PKESKPayloadV6Packet)
            (buildX448PKESKv6 recipient (pkeskV6RawSessionMaterial material))
        pka -> pure (Left (UnsupportedRecipientAlgorithm pka))


-- | Build a PKESK packet for one recipient key according to the selected version policy.
buildPKESKPktForRecipient ::
     MonadRandom m
  => PKESKVersionPolicy
  -> SomePKPayload
  -> PKESKSessionMaterial
  -> m (Either PKESKEncryptError Pkt)
buildPKESKPktForRecipient policy recipient material =
  fmap
    (fmap PKESKPkt)
    (buildPKESKPayloadForRecipient policy recipient material)


-- | Build a legacy PKESKv3 payload for v4/v3 RSA recipient interop.
buildPKESKv3PayloadForRecipient ::
     MonadRandom m
  => SomePKPayload
  -> PKESKV3SessionMaterial
  -> m (Either PKESKEncryptError PKESKPayload)
buildPKESKv3PayloadForRecipient recipient material =
  fmap (fmap PKESKPayloadV3Packet) (buildPKESKv3PayloadForRecipientTyped recipient material)

buildPKESKv3PayloadForRecipientTyped ::
     MonadRandom m
  => SomePKPayload
  -> PKESKV3SessionMaterial
  -> m (Either PKESKEncryptError PKESKPayloadV3)
buildPKESKv3PayloadForRecipientTyped recipient material =
  case _pkalgo recipient of
    RSA -> buildRsaPKESKv3 recipient material
    DeprecatedRSAEncryptOnly -> buildRsaPKESKv3 recipient material
    ECDH -> buildECDHPKESKv3 recipient material
    pka -> pure (Left (UnsupportedRecipientAlgorithm pka))

-- | Build a legacy PKESKv3 packet for v4/v3 RSA recipient interop.
buildPKESKv3PktForRecipient ::
     MonadRandom m
  => SomePKPayload
  -> PKESKV3SessionMaterial
  -> m (Either PKESKEncryptError Pkt)
buildPKESKv3PktForRecipient recipient material =
  fmap (fmap PKESKPkt) (buildPKESKv3PayloadForRecipient recipient material)

-- | Build PKESK packets for all recipients with a single shared session key.

buildPKESKPktsForRecipientTargetsWithSelector ::
     MonadRandom m
  => (RecipientEncryptionTarget -> Either PKESKEncryptError RecipientPKESKVersionStrategy)
  -> [RecipientEncryptionTarget]
  -> PKESKSessionMaterial
  -> m (Either PKESKEncryptError [Pkt])
buildPKESKPktsForRecipientTargetsWithSelector selector targets material
  = buildPKESKPktsForRecipientTargetsWithSelectorTyped
      (\target ->
         promoteRecipientStrategy <$> selector target)
      targets
      material

buildPKESKPktsForRecipientTargetsWithSelectorTyped ::
     MonadRandom m
  => (RecipientEncryptionTarget -> Either PKESKEncryptError SomeRecipientPKESKVersionStrategyW)
  -> [RecipientEncryptionTarget]
  -> PKESKSessionMaterial
  -> m (Either PKESKEncryptError [Pkt])
buildPKESKPktsForRecipientTargetsWithSelectorTyped selector targets material
  | null targets = pure (Left NoRecipientsProvided)
  | otherwise =
      case preparePKESKVersionedMaterial material of
        Left err -> pure (Left err)
        Right (v3Material, v6RawMaterial) -> do
          pkeskResults <-
            mapM
              (\target ->
                 case selector target of
                   Left err -> pure (Left err)
                   Right (SomeRecipientPKESKVersionStrategyW RecipientPreferV6W) ->
                     buildPKESKPktForRecipientWithPreparedPayload
                       RecipientPreferV6W
                       (recipientEncryptionTargetKey target)
                       (RecipientPreferV6Payload material v6RawMaterial)
                   Right (SomeRecipientPKESKVersionStrategyW RecipientForceV3InteropW) ->
                     buildPKESKPktForRecipientWithPreparedPayload
                       RecipientForceV3InteropW
                       (recipientEncryptionTargetKey target)
                       (RecipientForceV3Payload v3Material))
              targets
          pure (sequence pkeskResults >>= canonicalizePKESKPacketRecipientIds)

preparePKESKVersionedMaterial ::
     PKESKSessionMaterial
  -> Either PKESKEncryptError (PKESKV3SessionMaterial, PKESKV6RawSessionMaterial)
preparePKESKVersionedMaterial material = do
  v3Material <-
    mkPKESKV3SessionMaterial
      (pkeskSessionAlgorithm material)
      (pkeskSessionKey material)
  v6RawMaterial <-
    mkPKESKV6RawSessionMaterial
      (pkeskSessionAlgorithm material)
      (pkeskSessionKey material)
  pure (v3Material, v6RawMaterial)

data RecipientPKESKRequestPayload (strategy :: RecipientPKESKVersionStrategy) where
  RecipientForceV3Payload ::
       PKESKV3SessionMaterial
    -> RecipientPKESKRequestPayload 'RecipientForceV3Interop
  RecipientPreferV6Payload ::
       PKESKSessionMaterial
    -> PKESKV6RawSessionMaterial
    -> RecipientPKESKRequestPayload 'RecipientPreferV6

buildPKESKPktForRecipientWithPreparedPayload ::
     MonadRandom m
  => RecipientPKESKVersionStrategyW strategy
  -> SomePKPayload
  -> RecipientPKESKRequestPayload strategy
  -> m (Either PKESKEncryptError Pkt)
buildPKESKPktForRecipientWithPreparedPayload strategy recipient payload =
  fmap fmapPKESKPkt payloadResult
  where
    fmapPKESKPkt = fmap PKESKPkt
    payloadResult =
      case (strategy, payload) of
        (RecipientForceV3InteropW, RecipientForceV3Payload v3Material) ->
          buildPKESKv3PayloadForRecipient recipient v3Material
        (RecipientPreferV6W, RecipientPreferV6Payload material v6RawMaterial) ->
          case _pkalgo recipient of
            RSA ->
              fmap (fmap PKESKPayloadV6Packet) (buildRsaPKESKv6 recipient material)
            ECDH ->
              fmap (fmap PKESKPayloadV6Packet) (buildECDHPKESKv6 recipient material)
            X25519 ->
              fmap
                (fmap PKESKPayloadV6Packet)
                (buildX25519PKESKv6 recipient v6RawMaterial)
            X448 ->
              fmap
                (fmap PKESKPayloadV6Packet)
                (buildX448PKESKv6 recipient v6RawMaterial)
            pka ->
              pure (Left (UnsupportedRecipientAlgorithm pka))

-- | Encrypt for recipient targets with capability negotiation enabled.
--
-- By default this negotiates a common symmetric and (for SEIPDv2) AEAD
-- algorithm from recipient capabilities when available. Explicit request
-- overrides still take precedence.
encryptForRecipients ::
     MonadRandom m
  => RecipientEncryptRequest v
  -> m (Either PKESKEncryptError RecipientEncryptResult)
encryptForRecipients =
  encryptForRecipientsWithCapabilityNegotiation RecipientCapabilityNegotiationOn

-- | Encrypt for recipient targets without recipient capability negotiation.
--
-- This preserves legacy behavior by using policy defaults unless request
-- overrides are provided.
encryptForRecipientsLegacy ::
     MonadRandom m
  => RecipientEncryptRequest v
  -> m (Either PKESKEncryptError RecipientEncryptResult)
encryptForRecipientsLegacy =
  encryptForRecipientsWithCapabilityNegotiation RecipientCapabilityNegotiationOff

-- | Encrypt for recipient targets with an explicit capability-negotiation mode.
--
-- When negotiation is on, symmetric and AEAD selection use the common
-- intersection of recipient preferences constrained by the active policy.
-- When off, policy defaults are used.
encryptForRecipientsWithCapabilityNegotiation ::
     MonadRandom m
  => RecipientCapabilityNegotiationMode
  -> RecipientEncryptRequest v
  -> m (Either PKESKEncryptError RecipientEncryptResult)
encryptForRecipientsWithCapabilityNegotiation negotiationMode request
  | null targets = pure (Left NoRecipientsProvided)
  | otherwise =
      case selectSymmetricAlgorithm negotiationMode request messagePolicy targets of
        Left err -> pure (Left err)
        Right symalgo -> do
          sessionMaterialResult <- generateSessionKeyMaterial symalgo
          case sessionMaterialResult of
            Left err -> pure (Left err)
            Right sessionMaterial -> do
              pkeskResult <-
                buildPKESKPktsForRecipientTargetsWithSelectorTyped
                  (recipientVersionStrategyForProfileTyped profileW)
                  targets
                  sessionMaterial
              case pkeskResult of
                Left err -> pure (Left err)
                Right pkeskPkts -> do
                  payloadResult <- case recipientEncryptRequestOverrides request of
                    RecipientEncryptRequestSEIPDv2Overrides
                      { recipientEncryptRequestAEADOverride = aeadOverride
                      , recipientEncryptRequestChunkSizeOverride = chunkSizeOverride
                      , recipientEncryptRequestSaltOverride = saltOverride
                      } ->
                        case recipientsMissingSEIPDv2Support targets of
                          [] -> do
                            case selectAEADAlgorithm negotiationMode messagePolicy targets aeadOverride of
                              Left err -> pure (Left err)
                              Right aead -> do
                                salt <- maybe (Salt <$> getRandomBytes 32) pure saltOverride
                                let chunkSize =
                                      maybe
                                        (messageDefaultChunkSize messagePolicy)
                                        id
                                        chunkSizeOverride
                                pure $
                                  buildEncryptedPacketSequenceWithShape
                                    symalgo
                                    aead
                                    chunkSize
                                    (recipientEncryptRequestPayloadShape request)
                                    salt
                                    (pkeskSessionKey sessionMaterial)
                                    pkeskPkts
                                    (recipientEncryptRequestPayload request)
                          _missingSEIPDv2 ->
                            case recipientsMissingSEIPDv1Support targets of
                              [] ->
                                buildSEIPDv1PayloadWithIV
                                  symalgo
                                  sessionMaterial
                                  pkeskPkts
                                  Nothing
                              missingSEIPDv1 ->
                                pure
                                  (Left
                                     (RecipientCapabilitySelectionFailure
                                        (RecipientCapabilityMissingSEIPDv1Support missingSEIPDv1)))
                    RecipientEncryptRequestSEIPDv1Overrides
                      { recipientEncryptRequestIVOverride = ivOverride } ->
                        case recipientsMissingSEIPDv1Support targets of
                          [] ->
                            buildSEIPDv1PayloadWithIV
                              symalgo
                              sessionMaterial
                              pkeskPkts
                              ivOverride
                          missingSEIPDv1 ->
                            pure
                              (Left
                                 (RecipientCapabilitySelectionFailure
                                    (RecipientCapabilityMissingSEIPDv1Support missingSEIPDv1)))
                  pure $
                    fmap
                      (\pkts ->
                         RecipientEncryptResult
                           { recipientEncryptPackets = pkts
                           , recipientEncryptSessionMaterial = sessionMaterial
                           })
                      payloadResult
  where
    targets = recipientEncryptRequestTargets request
    profileW =
      profileForPayloadVersionW (recipientEncryptRequestOverrides request)
    messagePolicy =
      case profileW of
        EncryptStrictDefaultW ->
          policyMessageEncryption (policyForRFC RFC9580)
        EncryptInteropLegacyW ->
          policyMessageEncryption (policyForRFC RFC4880)

    buildSEIPDv1PayloadWithIV ::
         MonadRandom m
      => SymmetricAlgorithm
      -> PKESKSessionMaterial
      -> [Pkt]
      -> Maybe IV
      -> m (Either PKESKEncryptError [Pkt])
    buildSEIPDv1PayloadWithIV symalgo sessionMaterial pkeskPkts ivOverride = do
      ivResult <-
        case ivOverride of
          Just iv -> pure (Right iv)
          Nothing ->
            let keyBytes = unSessionKey (pkeskSessionKey sessionMaterial)
             in case withSymmetricCipher symalgo keyBytes (\c -> Right (blockSize c)) of
                  Left err -> pure (Left (PayloadBuildFailure (renderCipherError err)))
                  Right n -> fmap (Right . IV) (getRandomBytes n)
      case ivResult of
        Left err -> pure (Left err)
        Right iv ->
          pure $
            buildEncryptedPacketSequenceWithShapeSEIPDv1
              symalgo
              iv
              (recipientEncryptRequestPayloadShape request)
              (pkeskSessionKey sessionMaterial)
              pkeskPkts
              (recipientEncryptRequestPayload request)

    recipientsMissingSEIPDv1Support :: [RecipientEncryptionTarget] -> [SomePKPayload]
    recipientsMissingSEIPDv1Support =
      map recipientEncryptionTargetKey .
      filter (not . targetAdvertisesSEIPDv1Support)

    recipientsMissingSEIPDv2Support :: [RecipientEncryptionTarget] -> [SomePKPayload]
    recipientsMissingSEIPDv2Support =
      map recipientEncryptionTargetKey .
      filter (not . targetAdvertisesSEIPDv2Support)

    targetAdvertisesSEIPDv1Support :: RecipientEncryptionTarget -> Bool
    targetAdvertisesSEIPDv1Support target =
      case recipientEncryptionTargetCapabilities target of
        Nothing -> True
        Just caps -> recipientCapabilityAdvertisesSEIPDv1Support caps

    targetAdvertisesSEIPDv2Support :: RecipientEncryptionTarget -> Bool
    targetAdvertisesSEIPDv2Support target =
      case recipientEncryptionTargetCapabilities target of
        Nothing -> True
        Just caps -> recipientCapabilityAdvertisesSEIPDv2Support caps

selectSymmetricAlgorithm ::
     RecipientCapabilityNegotiationMode
  -> RecipientEncryptRequest v
  -> MessageEncryptionPolicy
  -> [RecipientEncryptionTarget]
  -> Either PKESKEncryptError SymmetricAlgorithm
selectSymmetricAlgorithm negotiationMode request messagePolicy targets =
  case recipientEncryptRequestSymmetricOverride request of
    Just override -> Right override
    Nothing ->
      case negotiationMode of
        RecipientCapabilityNegotiationOff ->
          Right (messageDefaultSymmetricAlgorithm messagePolicy)
        RecipientCapabilityNegotiationOn ->
          negotiateSymmetricAlgorithm messagePolicy targets

selectAEADAlgorithm ::
     RecipientCapabilityNegotiationMode
  -> MessageEncryptionPolicy
  -> [RecipientEncryptionTarget]
  -> Maybe AEADAlgorithm
  -> Either PKESKEncryptError AEADAlgorithm
selectAEADAlgorithm negotiationMode messagePolicy targets override =
  case override of
    Just explicit -> Right explicit
    Nothing ->
      case negotiationMode of
        RecipientCapabilityNegotiationOff ->
          Right (messageDefaultAEADAlgorithm messagePolicy)
        RecipientCapabilityNegotiationOn ->
          negotiateAEADAlgorithm messagePolicy targets

negotiateSymmetricAlgorithm ::
     MessageEncryptionPolicy
  -> [RecipientEncryptionTarget]
  -> Either PKESKEncryptError SymmetricAlgorithm
negotiateSymmetricAlgorithm messagePolicy targets =
  chooseCommonAlgorithm
    policyOrder
    recipientChoices
    (RecipientCapabilityNoCommonSymmetricAlgorithms (concat recipientChoices))
  where
    policyOrder =
      case messageSEIPDv2SymmetricAlgorithms messagePolicy of
        [] -> [messageDefaultSymmetricAlgorithm messagePolicy]
        syms -> syms
    recipientChoices = map choicesForTarget targets
    choicesForTarget target =
      case recipientEncryptionTargetCapabilities target of
        Just caps ->
          let preferred = recipientCapabilityPreferredSymmetricAlgorithms caps
              allowed = [alg | alg <- policyOrder, alg `elem` preferred]
           in if null allowed
                then policyOrder
                else allowed
        Nothing -> policyOrder

negotiateAEADAlgorithm ::
     MessageEncryptionPolicy
  -> [RecipientEncryptionTarget]
  -> Either PKESKEncryptError AEADAlgorithm
negotiateAEADAlgorithm messagePolicy targets =
  chooseCommonAlgorithm
    policyOrder
    recipientChoices
    (RecipientCapabilityNoCommonAEADAlgorithms (concat recipientChoices))
  where
    policyOrder = foldl' addIfMissing [] (messageDefaultAEADAlgorithm messagePolicy : [OCB, EAX, GCM])
    recipientChoices = map choicesForTarget targets
    choicesForTarget target =
      case recipientEncryptionTargetCapabilities target of
        Just caps ->
          let preferred = recipientCapabilityPreferredAEADAlgorithms caps
              allowed = [alg | alg <- policyOrder, alg `elem` preferred]
           in if null allowed
                then policyOrder
                else allowed
        Nothing -> policyOrder
    addIfMissing acc x
      | x `elem` acc = acc
      | otherwise = acc ++ [x]

chooseCommonAlgorithm ::
     Eq a
  => [a]
  -> [[a]]
  -> RecipientCapabilityError
  -> Either PKESKEncryptError a
chooseCommonAlgorithm policyOrder recipientChoices err =
  case recipientChoices of
    [] -> Left (RecipientCapabilitySelectionFailure err)
    (firstChoices:restChoices) ->
      let common = foldl' intersectOrdered firstChoices restChoices
          orderedCommon = [alg | alg <- policyOrder, alg `elem` common]
       in case orderedCommon of
            (selected:_) -> Right selected
            [] -> Left (RecipientCapabilitySelectionFailure err)
  where
    intersectOrdered as bs = [a | a <- as, a `elem` bs]

promoteRecipientStrategy ::
     RecipientPKESKVersionStrategy
  -> SomeRecipientPKESKVersionStrategyW
promoteRecipientStrategy RecipientPreferV6 =
  SomeRecipientPKESKVersionStrategyW RecipientPreferV6W
promoteRecipientStrategy RecipientForceV3Interop =
  SomeRecipientPKESKVersionStrategyW RecipientForceV3InteropW

demoteRecipientStrategy ::
     RecipientPKESKVersionStrategyW strategy
  -> RecipientPKESKVersionStrategy
demoteRecipientStrategy RecipientPreferV6W = RecipientPreferV6
demoteRecipientStrategy RecipientForceV3InteropW = RecipientForceV3Interop

demoteSomeRecipientStrategy ::
     SomeRecipientPKESKVersionStrategyW
  -> RecipientPKESKVersionStrategy
demoteSomeRecipientStrategy (SomeRecipientPKESKVersionStrategyW strategyW) =
  demoteRecipientStrategy strategyW

promoteEncryptCompatibilityProfile ::
     EncryptCompatibilityProfile
  -> SomeEncryptCompatibilityProfileW
promoteEncryptCompatibilityProfile EncryptStrictDefault =
  SomeEncryptCompatibilityProfileW EncryptStrictDefaultW
promoteEncryptCompatibilityProfile EncryptInteropLegacy =
  SomeEncryptCompatibilityProfileW EncryptInteropLegacyW

-- | High-level encrypt-side helper for public-key recipient encryption.
--
-- Returns a complete packet sequence:
-- @[PKESK ..., SEIPD2 ...]@.









buildEncryptedPacketSequence ::
     SymmetricAlgorithm
  -> AEADAlgorithm
  -> Word8
  -> RecipientPayloadShape
  -> Salt
  -> SessionKey
  -> [Pkt]
  -> B.ByteString
  -> Either String [Pkt]
buildEncryptedPacketSequence symalgo aead chunkSize payloadShape salt sessionKey pkesks payload =
  first renderPKESKEncryptError
    (buildEncryptedPacketSequenceWithShape symalgo aead chunkSize payloadShape salt sessionKey pkesks payload)

buildEncryptedPacketSequenceWithShape ::
     SymmetricAlgorithm
  -> AEADAlgorithm
  -> Word8
  -> RecipientPayloadShape
  -> Salt
  -> SessionKey
  -> [Pkt]
  -> B.ByteString
  -> Either PKESKEncryptError [Pkt]
buildEncryptedPacketSequenceWithShape symalgo aead chunkSize payloadShape salt sessionKey pkesks payload = do
  onePassSignatures <- first (PayloadBuildFailure . renderOPSBuildError) (buildOnePassSignaturePackets payloadShape)
  let signatures = recipientPayloadSignatures payloadShape
      literalBlock =
        Block
          (onePassSignatures ++
           [ LiteralDataPkt
               (recipientPayloadDataType payloadShape)
               (recipientPayloadFileName payloadShape)
               (recipientPayloadTimestamp payloadShape)
               (BL.fromStrict payload)
           ] ++
           map SignaturePkt signatures)
  ciphertext <-
    first PayloadBuildFailure $
    encryptSEIPDv2Payload
      symalgo
      aead
      chunkSize
      salt
      sessionKey
      (BL.toStrict (runPut (put literalBlock)))
  Right
    (pkesks ++
     [SymEncIntegrityProtectedDataPkt (SEIPD2 symalgo aead chunkSize salt (BL.fromStrict ciphertext))])

-- | Encrypt a plaintext block with OpenPGP CFB + MDC to produce a SEIPDv1 ciphertext.
encryptSEIPDv1Payload ::
     SymmetricAlgorithm
  -> IV
  -> SessionKey
  -> B.ByteString  -- ^ inner packet block plaintext
  -> Either String B.ByteString
encryptSEIPDv1Payload symalgo iv (SessionKey keyBytes) plaintext =
  let cleartextWithMDC = plaintext <> mdcTrailerForSEIPDv1 iv plaintext
  in first
       renderCipherError
       (encryptOpenPGPCfbRaw OpenPGPCFBNoResyncW symalgo iv cleartextWithMDC keyBytes)

-- | Build a complete RFC 4880-conformant packet sequence using SEIPDv1 (CFB + MDC).
buildEncryptedPacketSequenceWithShapeSEIPDv1 ::
     SymmetricAlgorithm
  -> IV
  -> RecipientPayloadShape
  -> SessionKey
  -> [Pkt]
  -> B.ByteString
  -> Either PKESKEncryptError [Pkt]
buildEncryptedPacketSequenceWithShapeSEIPDv1 symalgo iv payloadShape sessionKey pkesks payload = do
  onePassSignatures <- first (PayloadBuildFailure . renderOPSBuildError) (buildOnePassSignaturePackets payloadShape)
  let signatures = recipientPayloadSignatures payloadShape
      literalBlock =
        Block
          (onePassSignatures ++
           [ LiteralDataPkt
               (recipientPayloadDataType payloadShape)
               (recipientPayloadFileName payloadShape)
               (recipientPayloadTimestamp payloadShape)
               (BL.fromStrict payload)
           ] ++
           map SignaturePkt signatures)
  ciphertext <-
    first PayloadBuildFailure $
    encryptSEIPDv1Payload symalgo iv sessionKey (BL.toStrict (runPut (put literalBlock)))
  Right
    (pkesks ++
     [SymEncIntegrityProtectedDataPkt (SEIPD1 1 (BL.fromStrict ciphertext))])

buildOnePassSignaturePackets :: RecipientPayloadShape -> Either OPSBuildError [Pkt]
buildOnePassSignaturePackets payloadShape
  | not (recipientPayloadUseOnePassSignatures payloadShape) = Right []
  | null signatures = Right []
  | otherwise =
      fmap (map OnePassSignaturePkt) $
      sequence (zipWith buildOnePassSignature nestedFlags (reverse signatures))
  where
    signatures = recipientPayloadSignatures payloadShape
    nestedFlags = replicate (length signatures - 1) True ++ [False]

data OnePassSignatureBuildCase where
  OnePassSignatureBuildCaseV3 ::
       SignaturePayloadV 'SigPayloadV3 -> OnePassSignatureBuildCase
  OnePassSignatureBuildCaseV4 ::
       SignaturePayloadV 'SigPayloadV4 -> OnePassSignatureBuildCase
  OnePassSignatureBuildCaseV6 ::
       SignaturePayloadV 'SigPayloadV6 -> OnePassSignatureBuildCase
  OnePassSignatureBuildCaseOther ::
       PacketVersion -> OnePassSignatureBuildCase

onePassSignatureBuildCase :: SignaturePayload -> OnePassSignatureBuildCase
onePassSignatureBuildCase sig =
  case toSomeSignaturePayload sig of
    SomeSignaturePayload (payload@SigPayloadV3Data {}) ->
      OnePassSignatureBuildCaseV3 payload
    SomeSignaturePayload (payload@SigPayloadV4Data {}) ->
      OnePassSignatureBuildCaseV4 payload
    SomeSignaturePayload (payload@SigPayloadV6Data {}) ->
      OnePassSignatureBuildCaseV6 payload
    SomeSignaturePayload (SigPayloadOtherData version _) ->
      OnePassSignatureBuildCaseOther version

buildOnePassSignature :: NestedFlag -> SignaturePayload -> Either OPSBuildError OnePassSignaturePayload
buildOnePassSignature nestedFlag sig =
  case onePassSignatureBuildCase sig of
    OnePassSignatureBuildCaseV3 (SigPayloadV3Data sigType _ issuerKeyId pubkeyAlgo hashAlgo _ _) ->
      Right
        (OPSPayloadV3Packet
           (OPSPayloadV3 3 sigType hashAlgo pubkeyAlgo issuerKeyId nestedFlag))
    OnePassSignatureBuildCaseV4 (SigPayloadV4Data sigType pubkeyAlgo hashAlgo hashedSubpackets unhashedSubpackets _ _) ->
      case signatureIssuerKeyId hashedSubpackets unhashedSubpackets of
        Just issuerKeyId ->
          Right
            (OPSPayloadV3Packet
               (OPSPayloadV3 3 sigType hashAlgo pubkeyAlgo issuerKeyId nestedFlag))
        Nothing ->
          Left OPSBuildMissingIssuerKeyId
    OnePassSignatureBuildCaseV6 (SigPayloadV6Data sigType pubkeyAlgo hashAlgo salt hashedSubpackets unhashedSubpackets _ _) ->
      case signatureIssuerFingerprint (BTypes.issuerFingerprintVersionToPacketVersion BTypes.IssuerFingerprintV6) hashedSubpackets unhashedSubpackets of
        Just signerFingerprint
          | BL.length signerFingerprint == 32 ->
              Right
                (OPSPayloadV6Packet
                   (OPSPayloadV6 sigType hashAlgo pubkeyAlgo salt signerFingerprint nestedFlag))
          | otherwise ->
              Left (OPSBuildFingerprintWrongLength (BL.length signerFingerprint))
        Nothing ->
          Left OPSBuildMissingIssuerFingerprint
    OnePassSignatureBuildCaseOther version ->
      Left (OPSBuildUnsupportedSigVersion version)

signatureIssuerKeyId :: [SigSubPacket] -> [SigSubPacket] -> Maybe EightOctetKeyId
signatureIssuerKeyId hashedSubpackets unhashedSubpackets =
  case findIssuerKeyId hashedSubpackets of
    Just issuerKeyId -> Just issuerKeyId
    Nothing ->
      case findIssuerKeyId unhashedSubpackets of
        Just issuerKeyId -> Just issuerKeyId
        Nothing ->
          case signatureIssuerFingerprint (BTypes.issuerFingerprintVersionToPacketVersion BTypes.IssuerFingerprintV4) hashedSubpackets unhashedSubpackets of
            Just issuerFingerprintBytes ->
              if BL.length issuerFingerprintBytes >= 8
                    then
                      Just
                        (EightOctetKeyId
                           (BL.drop (BL.length issuerFingerprintBytes - 8) issuerFingerprintBytes))
                    else Nothing
            Nothing -> Nothing

signatureIssuerFingerprint ::
     PacketVersion -> [SigSubPacket] -> [SigSubPacket] -> Maybe BL.ByteString
signatureIssuerFingerprint expectedVersion hashedSubpackets unhashedSubpackets =
  unFingerprint <$> findIssuerFingerprint expectedVersion hashedSubpackets unhashedSubpackets

findIssuerKeyId :: [SigSubPacket] -> Maybe EightOctetKeyId
findIssuerKeyId subpackets =
  case find isIssuerKeyIdSubpacket subpackets of
    Just (SigSubPacket _ (Issuer issuerKeyId)) -> Just issuerKeyId
    _ -> Nothing

findIssuerFingerprint ::
     PacketVersion -> [SigSubPacket] -> [SigSubPacket] -> Maybe Fingerprint
findIssuerFingerprint expectedVersion hashedSubpackets unhashedSubpackets =
  case findIssuerFingerprintIn expectedVersion hashedSubpackets of
    Just issuerFingerprint -> Just issuerFingerprint
    Nothing -> findIssuerFingerprintIn expectedVersion unhashedSubpackets

findIssuerFingerprintIn :: PacketVersion -> [SigSubPacket] -> Maybe Fingerprint
findIssuerFingerprintIn expectedVersion subpackets =
  case find (isIssuerFingerprintSubpacket expectedVersion) subpackets of
    Just (SigSubPacket _ (IssuerFingerprint _ issuerFingerprint)) -> Just issuerFingerprint
    _ -> Nothing

isIssuerKeyIdSubpacket :: SigSubPacket -> Bool
isIssuerKeyIdSubpacket (SigSubPacket _ (Issuer _)) = True
isIssuerKeyIdSubpacket _ = False

isIssuerFingerprintSubpacket :: PacketVersion -> SigSubPacket -> Bool
isIssuerFingerprintSubpacket expectedVersion (SigSubPacket _ (IssuerFingerprint version _)) =
  BTypes.issuerFingerprintVersionToPacketVersion version == expectedVersion
isIssuerFingerprintSubpacket _ _ = False

buildRsaPKESKv6 ::
     MonadRandom m
  => SomePKPayload
  -> PKESKSessionMaterial
  -> m (Either PKESKEncryptError PKESKPayloadV6)
buildRsaPKESKv6 recipient material =
  case _pubkey recipient of
    RSAPubKey (RSA_PublicKey publicKey) -> do
      encrypted <- RSA15.encrypt publicKey (pkeskEncodedSessionMaterial material)
      pure $
        fmap
          (\esk ->
             let mpiEsk = runPut (put (MPI (os2ip esk)))
              in PKESKPayloadV6 (recipientKeyIdentifier recipient) RSA mpiEsk)
          (first (RecipientKeyWrapFailure RSA . show) encrypted)
    _ ->
      pure
        (Left
           (InvalidRecipientKeyMaterial
              RSA
              "recipient PKPayload does not contain an RSA public key"))

buildRsaPKESKv3 ::
     MonadRandom m
  => SomePKPayload
  -> PKESKV3SessionMaterial
  -> m (Either PKESKEncryptError PKESKPayloadV3)
buildRsaPKESKv3 recipient material =
  case _pubkey recipient of
    RSAPubKey (RSA_PublicKey publicKey) ->
      case eightOctetKeyID recipient of
        Left err ->
          pure
            (Left
              (InvalidRecipientKeyMaterial
                 (_pkalgo recipient)
                 ("failed to derive PKESKv3 recipient key ID: " ++ err)))
        Right eoki -> do
          encrypted <- RSA15.encrypt publicKey (unPKESKV3SessionMaterial material)
          pure $
            fmap
              (\esk ->
                PKESKPayloadV3
                  3
                  eoki
                  (_pkalgo recipient)
                  (MPI (os2ip esk) :| []))
              (first (RecipientKeyWrapFailure (_pkalgo recipient) . show) encrypted)
    _ ->
      pure
        (Left
           (InvalidRecipientKeyMaterial
              (_pkalgo recipient)
              "recipient PKPayload does not contain an RSA public key"))

buildECDHPKESKv3 ::
     MonadRandom m
  => SomePKPayload
  -> PKESKV3SessionMaterial
  -> m (Either PKESKEncryptError PKESKPayloadV3)
buildECDHPKESKv3 recipient material =
  case _pubkey recipient of
    ECDHPubKey ecdhPub kdfHA kdfSA ->
      case eightOctetKeyID recipient of
        Left err ->
          pure
           (Left
              (InvalidRecipientKeyMaterial
                 ECDH
                 ("failed to derive PKESKv3 recipient key ID: " ++ err)))
        Right eoki ->
          case ecdhPub of
           ECDSAPubKey (ECDSA_PublicKey recipientPub) -> do
             (ephemeralPub, ephemeralPriv) <- ECCGen.generate (ECDSA.public_curve recipientPub)
             case point2MBS (ECDSA.public_q ephemeralPub) of
               Nothing ->
                 pure
                   (Left
                      (InvalidRecipientKeyMaterial
                         ECDH
                         "failed to serialize ECDH ephemeral point"))
               Just ephemeralBytes ->
                 pure $
                 buildEcdhV3Payload
                   recipient
                   eoki
                   ECDH
                   ecdhPub
                   kdfHA
                   kdfSA
                   ephemeralBytes
                   (BA.convert
                      (ECCDH.getShared
                         (ECDSA.public_curve recipientPub)
                         (ECDSA.private_d ephemeralPriv)
                         (ECDSA.public_q recipientPub)) ::
                    B.ByteString)
                   material
           EdDSAPubKey Ed25519 recipientPoint -> do
             ephSecretRaw <- getRandomBytes 32
             pure $
               do recipientPublicBytes <- normalizeX25519Public (edPointBytes recipientPoint)
                  ephSecret <-
                    first (RecipientKeyWrapFailure ECDH . show) .
                    CE.eitherCryptoError $
                    C25519.secretKey (leftPadTo 32 ephSecretRaw)
                  recipientPub <-
                    first (RecipientKeyWrapFailure ECDH . show) .
                    CE.eitherCryptoError $
                    C25519.publicKey recipientPublicBytes
                  let ephPublicBytes =
                        B.cons 0x40 (BA.convert (C25519.toPublic ephSecret) :: B.ByteString)
                      sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString
                  buildEcdhV3Payload
                    recipient
                    eoki
                    ECDH
                    ecdhPub
                    kdfHA
                    kdfSA
                    ephPublicBytes
                    sharedSecret
                    material
           _ ->
             pure
               (Left
                  (InvalidRecipientKeyMaterial
                     ECDH
                     "recipient ECDH public key is not RFC6637-compatible"))
    _ ->
      pure
        (Left
           (InvalidRecipientKeyMaterial
             ECDH
             "recipient PKPayload does not contain ECDH public key material"))

buildECDHPKESKv6 ::
     MonadRandom m
  => SomePKPayload
  -> PKESKSessionMaterial
  -> m (Either PKESKEncryptError PKESKPayloadV6)
buildECDHPKESKv6 recipient material =
  case _pubkey recipient of
    ECDHPubKey ecdhPub kdfHA kdfSA ->
      case ecdhPub of
        ECDSAPubKey (ECDSA_PublicKey recipientPub) -> do
          (ephemeralPub, ephemeralPriv) <- ECCGen.generate (ECDSA.public_curve recipientPub)
          case point2MBS (ECDSA.public_q ephemeralPub) of
            Nothing ->
              pure
                (Left
                   (InvalidRecipientKeyMaterial
                      ECDH
                      "failed to serialize ECDH ephemeral point"))
            Just ephemeralBytes ->
              pure $
              buildEcdhV6Esk
                recipient
                ECDH
                ecdhPub
                kdfHA
                kdfSA
                ephemeralBytes
                (BA.convert
                   (ECCDH.getShared
                      (ECDSA.public_curve recipientPub)
                      (ECDSA.private_d ephemeralPriv)
                      (ECDSA.public_q recipientPub)) ::
                 B.ByteString)
                material
        EdDSAPubKey Ed25519 recipientPoint -> do
          ephSecretRaw <- getRandomBytes 32
          pure $
            do recipientPublicBytes <- normalizeX25519Public (edPointBytes recipientPoint)
               ephSecret <-
                 first (RecipientKeyWrapFailure ECDH . show) .
                 CE.eitherCryptoError $
                 C25519.secretKey (leftPadTo 32 ephSecretRaw)
               recipientPub <-
                 first (RecipientKeyWrapFailure ECDH . show) .
                 CE.eitherCryptoError $
                 C25519.publicKey recipientPublicBytes
               let ephPublicBytes = BA.convert (C25519.toPublic ephSecret) :: B.ByteString
                   sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString
               buildEcdhV6Esk recipient ECDH ecdhPub kdfHA kdfSA ephPublicBytes sharedSecret material
        EdDSAPubKey Ed448 recipientPoint -> do
          ephSecretRaw <- getRandomBytes 56
          pure $
            do recipientPublicBytes <- normalizeX448Public (edPointBytes recipientPoint)
               ephSecret <-
                 first (RecipientKeyWrapFailure ECDH . show) .
                 CE.eitherCryptoError $
                 C448.secretKey (leftPadTo 56 ephSecretRaw)
               recipientPub <-
                 first (RecipientKeyWrapFailure ECDH . show) .
                 CE.eitherCryptoError $
                 C448.publicKey recipientPublicBytes
               let ephPublicBytes = BA.convert (C448.toPublic ephSecret) :: B.ByteString
                   sharedSecret = BA.convert (C448.dh recipientPub ephSecret) :: B.ByteString
               buildEcdhV6Esk recipient ECDH ecdhPub kdfHA kdfSA ephPublicBytes sharedSecret material
        _ ->
          pure
            (Left
               (InvalidRecipientKeyMaterial
                  ECDH
                  "recipient ECDH public key is not ECDSA/X25519/X448-compatible"))
    _ ->
      pure
        (Left
           (InvalidRecipientKeyMaterial
              ECDH
              "recipient PKPayload does not contain ECDH public key material"))

buildX25519PKESKv6 ::
     MonadRandom m
  => SomePKPayload
  -> PKESKV6RawSessionMaterial
  -> m (Either PKESKEncryptError PKESKPayloadV6)
buildX25519PKESKv6 recipient material = do
  ephSecretRaw <- getRandomBytes 32
  pure $
    do recipientPublic <- extractX25519RecipientPublic recipient
       ephSecret <-
         first (RecipientKeyWrapFailure X25519 . show) .
         CE.eitherCryptoError $
         C25519.secretKey (leftPadTo 32 ephSecretRaw)
       recipientPub <-
         first (RecipientKeyWrapFailure X25519 . show) .
         CE.eitherCryptoError $
         C25519.publicKey recipientPublic
       let ephPublicBytes = BA.convert (C25519.toPublic ephSecret) :: B.ByteString
           sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString
           kek = deriveX25519Kek ephPublicBytes recipientPublic sharedSecret
       wrapped <-
         first (RecipientKeyWrapFailure X25519) .
         aesKeyWrapRFC3394 AES128 kek $
         unPKESKV6RawSessionMaterial material
       esk <- encodeV6X25519Esk ephPublicBytes wrapped
       Right (PKESKPayloadV6 (recipientKeyIdentifier recipient) X25519 (BL.fromStrict esk))

buildX448PKESKv6 ::
     MonadRandom m
  => SomePKPayload
  -> PKESKV6RawSessionMaterial
  -> m (Either PKESKEncryptError PKESKPayloadV6)
buildX448PKESKv6 recipient material = do
  ephSecretRaw <- getRandomBytes 56
  pure $
    do recipientPublic <- extractX448RecipientPublic recipient
       ephSecret <-
         first (RecipientKeyWrapFailure X448 . show) .
         CE.eitherCryptoError $
         C448.secretKey (leftPadTo 56 ephSecretRaw)
       recipientPub <-
         first (RecipientKeyWrapFailure X448 . show) .
         CE.eitherCryptoError $
         C448.publicKey recipientPublic
       let ephPublicBytes = BA.convert (C448.toPublic ephSecret) :: B.ByteString
           sharedSecret = BA.convert (C448.dh recipientPub ephSecret) :: B.ByteString
           kek = deriveX448Kek ephPublicBytes recipientPublic sharedSecret
       wrapped <-
         first (RecipientKeyWrapFailure X448) .
         aesKeyWrapRFC3394 AES256 kek $
         unPKESKV6RawSessionMaterial material
       esk <- encodeV6X448Esk ephPublicBytes wrapped
       Right (PKESKPayloadV6 (recipientKeyIdentifier recipient) X448 (BL.fromStrict esk))

buildEcdhV6Esk :: SomePKPayload
  -> PubKeyAlgorithm
  -> PKey
  -> HashAlgorithm
  -> SymmetricAlgorithm
  -> B.ByteString
  -> B.ByteString
  -> PKESKSessionMaterial
  -> Either PKESKEncryptError PKESKPayloadV6
buildEcdhV6Esk recipient pka ecdhPub kdfHA kdfSA ephemeralBytes sharedSecret material = do
  kdfParam <-
    first (RecipientKdfFailure pka) $
    buildECDHKDFParam recipient pka ecdhPub kdfHA kdfSA
  kek <- first (RecipientKdfFailure pka) $ deriveECDHKek kdfHA kdfSA sharedSecret kdfParam
  wrapped <-
    first (RecipientKeyWrapFailure pka) .
    aesKeyWrapRFC3394 kdfSA kek $
    padToMultipleOf8 (pkeskEncodedSessionMaterial material)
  esk <- encodeV6EcdhEsk ephemeralBytes wrapped
  Right (PKESKPayloadV6 (recipientKeyIdentifier recipient) pka (BL.fromStrict esk))

buildEcdhV3Payload :: SomePKPayload
  -> EightOctetKeyId
  -> PubKeyAlgorithm
  -> PKey
  -> HashAlgorithm
  -> SymmetricAlgorithm
  -> B.ByteString
  -> B.ByteString
  -> PKESKV3SessionMaterial
  -> Either PKESKEncryptError PKESKPayloadV3
buildEcdhV3Payload recipient eoki pka ecdhPub kdfHA kdfSA ephemeralBytes sharedSecret material = do
  kdfParam <-
    first (RecipientKdfFailure pka) $
    buildECDHKDFParam recipient pka ecdhPub kdfHA kdfSA
  kek <- first (RecipientKdfFailure pka) $ deriveECDHKek kdfHA kdfSA sharedSecret kdfParam
  wrapped <-
    first (RecipientKeyWrapFailure pka) .
    aesKeyWrapRFC3394 kdfSA kek $
    padToMultipleOf8 (unPKESKV3SessionMaterial material)
  Right
    (PKESKPayloadV3
       3
       eoki
       pka
       (MPI (os2ip ephemeralBytes) :| [MPI (os2ip wrapped)]))

recipientKeyIdentifier :: SomePKPayload -> BL.ByteString
recipientKeyIdentifier = unFingerprint . fingerprint

encodeV6EcdhEsk :: B.ByteString -> B.ByteString -> Either PKESKEncryptError B.ByteString
encodeV6EcdhEsk ephemeral wrapped = do
  let ephLen = B.length ephemeral
  if ephLen > 255
    then Left (RecipientKeyWrapFailure ECDH "ephemeral key encoding is too large")
    else Right (B.singleton (fromIntegral ephLen) <> ephemeral <> wrapped)

encodeV6X25519Esk :: B.ByteString -> B.ByteString -> Either PKESKEncryptError B.ByteString
encodeV6X25519Esk ephemeral wrapped
  | B.length ephemeral /= 32 =
      Left (RecipientKeyWrapFailure X25519 "X25519 ephemeral key must be exactly 32 octets")
  | B.length wrapped > 255 =
      Left (RecipientKeyWrapFailure X25519 "wrapped session key encoding is too large")
  | otherwise =
      Right (ephemeral <> B.singleton (fromIntegral (B.length wrapped)) <> wrapped)

encodeV6X448Esk :: B.ByteString -> B.ByteString -> Either PKESKEncryptError B.ByteString
encodeV6X448Esk ephemeral wrapped
  | B.length ephemeral /= 56 =
      Left (RecipientKeyWrapFailure X448 "X448 ephemeral key must be exactly 56 octets")
  | B.length wrapped > 255 =
      Left (RecipientKeyWrapFailure X448 "wrapped session key encoding is too large")
  | otherwise =
      Right (ephemeral <> B.singleton (fromIntegral (B.length wrapped)) <> wrapped)

extractX25519RecipientPublic :: SomePKPayload -> Either PKESKEncryptError B.ByteString
extractX25519RecipientPublic recipient =
  case _pubkey recipient of
    EdDSAPubKey Ed25519 point ->
      normalizeX25519Public (edPointBytes point)
    ECDHPubKey (EdDSAPubKey Ed25519 point) _ _ ->
      normalizeX25519Public (edPointBytes point)
    other ->
      Left
        (InvalidRecipientKeyMaterial
           X25519
           ("expected X25519-compatible recipient key, got " ++ show other))

extractX448RecipientPublic :: SomePKPayload -> Either PKESKEncryptError B.ByteString
extractX448RecipientPublic recipient =
  case _pubkey recipient of
    EdDSAPubKey Ed448 point ->
      normalizeX448Public (edPointBytes point)
    ECDHPubKey (EdDSAPubKey Ed448 point) _ _ ->
      normalizeX448Public (edPointBytes point)
    other ->
      Left
        (InvalidRecipientKeyMaterial
           X448
           ("expected X448-compatible recipient key, got " ++ show other))

normalizeX25519Public :: B.ByteString -> Either PKESKEncryptError B.ByteString
normalizeX25519Public =
  first (InvalidRecipientKeyMaterial X25519) .
  normalizeMontgomeryPublic
    32
    "invalid X25519 public key length/prefix: "

normalizeX448Public :: B.ByteString -> Either PKESKEncryptError B.ByteString
normalizeX448Public =
  first (InvalidRecipientKeyMaterial X448) .
  normalizeMontgomeryPublic
    56
    "invalid X448 public key length/prefix: "

edPointBytes :: EdPoint -> B.ByteString
edPointBytes (PrefixedNativeEPoint (EPoint x)) = i2osp x
edPointBytes (NativeEPoint (EPoint x)) = i2osp x

deriveX25519Kek :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString
deriveX25519Kek ephemeralPublic recipientPublic sharedSecret =
  let ikm = ephemeralPublic <> recipientPublic <> sharedSecret
      prk = extract @CHAlg.SHA256 B.empty ikm
      info = "OpenPGP X25519" :: B.ByteString
   in expand @CHAlg.SHA256 prk info 16

deriveX448Kek :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString
deriveX448Kek ephemeralPublic recipientPublic sharedSecret =
  let ikm = ephemeralPublic <> recipientPublic <> sharedSecret
      prk = extract @CHAlg.SHA512 B.empty ikm
      info = "OpenPGP X448" :: B.ByteString
   in expand @CHAlg.SHA512 prk info 32

padToMultipleOf8 :: B.ByteString -> B.ByteString
padToMultipleOf8 bs
  | padLen == 0 = bs
  | otherwise = bs <> B.replicate padLen (fromIntegral padLen)
  where
    rem8 = B.length bs `mod` 8
    padLen = if rem8 == 0 then 0 else 8 - rem8

checksum16 :: B.ByteString -> Word16
checksum16 =
  fromIntegral .
  B.foldl' (\acc octet -> (acc + fromIntegral octet) `mod` (65536 :: Integer)) 0

checksum16Bytes :: B.ByteString -> B.ByteString
checksum16Bytes bs =
  B.pack
    [ fromIntegral ((chk `shiftR` 8) .&. 0xff)
    , fromIntegral (chk .&. 0xff)
    ]
  where
    chk = checksum16 bs

aesKeyWrapRFC3394 ::
     SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String B.ByteString
aesKeyWrapRFC3394 sa kek plain =
  withAESCipher "ECDH PKESK currently supports AES KEK algorithms only" sa kek wrapWithCipher
  where
    wrapWithCipher :: CCT.BlockCipher cipher => cipher -> Either String B.ByteString
    wrapWithCipher cipher = do
      if B.length plain < 16 || B.length plain `mod` 8 /= 0
        then Left "ECDH key wrap input must be at least 16 octets and a multiple of 8"
        else Right ()
      let rs = chunksOf8 plain
      if length rs < 2
        then Left "ECDH key wrap input must contain at least two 64-bit blocks"
        else Right ()
      (aFinal, rFinal) <- wrapRounds cipher (B.replicate 8 0xA6) rs
      Right (aFinal <> B.concat rFinal)
    wrapRounds :: CCT.BlockCipher cipher => cipher -> B.ByteString -> [B.ByteString] -> Either String (B.ByteString, [B.ByteString])
    wrapRounds cipher aInit rsInit = goJ 0 aInit rsInit
      where
        n = length rsInit
        goJ j a rs
          | j > 5 = Right (a, rs)
          | otherwise = do
              (a', rs') <- goI 1 a rs
              goJ (j + 1) a' rs'
          where
            goI i curA curRs
              | i > n = Right (curA, curRs)
              | otherwise = do
                  let t = fromIntegral (n * j + i) :: Word64
                      rI = curRs !! (i - 1)
                      block = CCT.ecbEncrypt cipher (curA <> rI)
                      (msb, lsb) = B.splitAt 8 block
                      aNext = xorBS msb (encodeWord64be t)
                      rsNext = (ix (i - 1) .~ lsb) curRs
                  goI (i + 1) aNext rsNext

chunksOf8 :: B.ByteString -> [B.ByteString]
chunksOf8 bs
  | B.null bs = []
  | otherwise =
      let (h, t) = B.splitAt 8 bs
       in h : chunksOf8 t

xorBS :: B.ByteString -> B.ByteString -> B.ByteString
xorBS a b = B.pack (B.zipWith xor a b)

encryptSEIPDv1WithSKESK ::
     MonadRandom m
  => SymmetricAlgorithm
  -> S2K
  -> Maybe IV
  -> BL.ByteString
  -> B.ByteString
  -> m (Either String [Pkt])
encryptSEIPDv1WithSKESK symalgo s2k ivOverride passphrase literalPayload = do
  let eSessionKey = do
        keyLen <- symKeySize symalgo
        first renderS2KError (string2Key s2k keyLen passphrase)
  case eSessionKey of
    Left err -> pure (Left err)
    Right sessionKeyMaterial ->
      case
        first
          renderCipherError
          (withSymmetricCipher symalgo sessionKeyMaterial (pure . blockSize)) of
        Left err -> pure (Left err)
        Right ivLength -> do
          ivBytes <-
            maybe
              (getRandomBytes ivLength)
              (pure . unIV)
              ivOverride
          let iv = IV ivBytes
          let sessionKey = SessionKey sessionKeyMaterial
          case encryptSEIPDv1Payload symalgo iv sessionKey literalPayload of
            Left err -> pure (Left err)
            Right encrypted ->
              pure
                (Right
                   [ SKESKPkt
                       (SKESKPayloadV4Packet
                          (SKESKPayloadV4 symalgo s2k Nothing))
                   , SymEncIntegrityProtectedDataPkt
                       (SEIPD1 1 (BL.fromStrict encrypted))
                   ])

encryptSEIPDv2WithSKESK ::
     SymmetricAlgorithm
  -> AEADAlgorithm
  -> Word8
  -> Salt
  -> S2K
  -> BL.ByteString
  -> B.ByteString
  -> Either String [Pkt]
encryptSEIPDv2WithSKESK symalgo aead chunkSize salt s2k passphrase literalPayload = do
  keyLen <- symKeySize symalgo
  sessionKeyMaterial <- first renderS2KError (string2Key s2k keyLen passphrase)
  (_, nonceSize) <-
    aeadModeAndNonceSizeForSEIPDv2
      "unsupported AEAD algorithm for SKESK v6 encrypt"
      aead
  when (B.length (unSalt salt) < nonceSize) $
    Left "SEIPD v2 salt is too short to derive the SKESK v6 IV"
  let skeskIV = B.take nonceSize (unSalt salt)
  kek <- deriveSKESK6KEK symalgo aead sessionKeyMaterial
  (wrappedSessionKey, skeskTag) <-
    encryptSKESK6SessionKey symalgo aead kek skeskIV sessionKeyMaterial
  let sessionKey = SessionKey sessionKeyMaterial
  encrypted <- encryptSEIPDv2Payload symalgo aead chunkSize salt sessionKey literalPayload
  return
    [ SKESKPkt
        (SKESKPayloadV6Packet
           (SKESKPayloadV6
           symalgo
           aead
           s2k
           (BL.fromStrict skeskIV)
           (BL.fromStrict wrappedSessionKey)
           (BL.fromStrict skeskTag)))
    , SymEncIntegrityProtectedDataPkt (SEIPD2 symalgo aead chunkSize salt (BL.fromStrict encrypted))
    ]

encryptSEIPDv2WithSKESKBlock ::
     SymmetricAlgorithm
  -> AEADAlgorithm
  -> Word8
  -> Salt
  -> S2K
  -> BL.ByteString
  -> Block Pkt
  -> Either String [Pkt]
encryptSEIPDv2WithSKESKBlock symalgo aead chunkSize salt s2k passphrase packetBlock =
  encryptSEIPDv2WithSKESK
    symalgo
    aead
    chunkSize
    salt
    s2k
    passphrase
    (BL.toStrict (runPut (put packetBlock)))

encryptSEIPDv2LiteralDataWithSKESK ::
     SymmetricAlgorithm
  -> AEADAlgorithm
  -> Word8
  -> Salt
  -> S2K
  -> BL.ByteString
  -> B.ByteString
  -> Either String [Pkt]
encryptSEIPDv2LiteralDataWithSKESK symalgo aead chunkSize salt s2k passphrase payload =
  encryptSEIPDv2WithSKESKBlock
    symalgo
    aead
    chunkSize
    salt
    s2k
    passphrase
    (Block [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) (BL.fromStrict payload)])

encryptSEIPDv2Payload ::
     SymmetricAlgorithm
  -> AEADAlgorithm
  -> Word8
  -> Salt
  -> SessionKey
  -> B.ByteString
  -> Either String B.ByteString
encryptSEIPDv2Payload symalgo aead chunkSize salt (SessionKey sessionKey) plaintext = do
  (mode, nonceSize) <- aeadModeAndNonceSize aead
  keyLen <- symKeySize symalgo
  let outputLen = keyLen + nonceSize - 8
      info = B.pack [0xd2, 2, fromFVal symalgo, fromFVal aead, chunkSize]
      prk = extract @CHAlg.SHA256 (unSalt salt) sessionKey
      okm = expand @CHAlg.SHA256 prk info outputLen :: B.ByteString
      messageKey = B.take keyLen okm
      noncePrefix = B.take (nonceSize - 8) (B.drop keyLen okm)
  withAESCipher
    "SEIPD v2 encrypt currently supports AES-128/192/256 only"
    symalgo
    messageKey
    (encryptChunks mode info chunkSize noncePrefix plaintext)

encryptChunks ::
     CCT.BlockCipher cipher
  => CCT.AEADMode
  -> B.ByteString
  -> Word8
  -> B.ByteString
  -> B.ByteString
  -> cipher
  -> Either String B.ByteString
encryptChunks mode info chunkSize noncePrefix plaintext cipher = go 0 plaintext [] 0
  where
    chunkLen = 1 `shiftL` (fromIntegral chunkSize + 6)
    go idx remaining acc totalPlain
      | B.null remaining = do
        (finalTag, finalCipher) <-
          if mode == CCT.AEAD_OCB
            then
              encryptWithOCBRFC7253
                cipher
                (noncePrefix <> encodeWord64be idx)
                (info <> encodeWord64be (fromIntegral totalPlain))
                B.empty
            else do
              aead <- initAEAD idx
              let (tag, out) =
                    CCT.aeadSimpleEncrypt
                      aead
                      (info <> encodeWord64be (fromIntegral totalPlain))
                      B.empty
                      16
              Right (tag, out)
        if B.null finalCipher
          then return (B.concat (reverse acc) <> authTagToBS finalTag)
          else Left "expected empty ciphertext for final SEIPD v2 tag"
      | otherwise = do
        let (chunkPlain, rest) = B.splitAt chunkLen remaining
        (tag, chunkCipher) <-
          if mode == CCT.AEAD_OCB
            then
              encryptWithOCBRFC7253
                cipher
                (noncePrefix <> encodeWord64be idx)
                info
                chunkPlain
            else do
              aead <- initAEAD idx
              pure (CCT.aeadSimpleEncrypt aead info chunkPlain 16)
        let chunkOut = chunkCipher <> authTagToBS tag
        go
          (idx + 1)
          rest
          (chunkOut : acc)
          (totalPlain + B.length chunkPlain)

    initAEAD idx =
      first show . CE.eitherCryptoError $
      CCT.aeadInit mode cipher (noncePrefix <> encodeWord64be idx)

aeadModeAndNonceSize :: AEADAlgorithm -> Either String (CCT.AEADMode, Int)
aeadModeAndNonceSize =
  aeadModeAndNonceSizeForSEIPDv2
    "unsupported AEAD algorithm for SEIPD v2 encrypt"

symKeySize :: SymmetricAlgorithm -> Either String Int
symKeySize =
  seipdv2SymmetricKeySize
    "unsupported symmetric algorithm for SEIPD v2 encrypt"

authTagToBS :: CCT.AuthTag -> B.ByteString
authTagToBS = BA.convert . CCT.unAuthTag

encodeWord64be :: Word64 -> B.ByteString
encodeWord64be = BL.toStrict . runPut . putWord64be

-- | Compose a complete AEAD-encrypted message with optional literal data and signature.
-- Returns a packet list (SKESK, SEIPD v2, optional signature) ready for serialization.
--
-- Example: @composeMessageWithSEIPDv2 AES256 OCB 6 (Salt 32 bytes)
--            (SimpleS2K SHA256) passphrase payload Nothing@
-- returns @[SKESK v6, SEIPD v2, <ciphertext>]@
--
-- If the signature is provided, it will be included in the encrypted payload.
composeMessageWithSEIPDv2 ::
     SymmetricAlgorithm
  -> AEADAlgorithm
  -> Word8
  -> Salt
  -> S2K
  -> BL.ByteString
  -> B.ByteString
  -> Maybe [Pkt]
  -> Either String [Pkt]
composeMessageWithSEIPDv2 symalgo aead chunkSize salt s2k passphrase payload mSigs = do
  let packets = case mSigs of
        Nothing -> [LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) (BL.fromStrict payload)]
        Just sigs -> LiteralDataPkt BinaryData BL.empty (ThirtyTwoBitTimeStamp 0) (BL.fromStrict payload) : sigs
      blockPayload = Block packets
  encryptSEIPDv2WithSKESKBlock symalgo aead chunkSize salt s2k passphrase blockPayload
