-- Policy.hs: OpenPGP standards policy profiles
-- Copyright © 2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}

module Codec.Encryption.OpenPGP.Policy
  ( OpenPGPRFC(..)
  , OpenPGPRFCW(..)
  , SomeOpenPGPRFCW(..)
  , promoteOpenPGPRFC
  , demoteOpenPGPRFCW
  , HashAlgorithmW(..)
  , SomeHashAlgorithmW(..)
  , promoteHashAlgorithm
  , demoteHashAlgorithmW
  , HashAlgoStatus(..)
  , HashAlgoStatusFor
  , HashAlgoAllowedFor
  , HashAlgoVerifiableFor
  , PKESKVersionPolicy(..)
  , MessageEncryptionPolicy(..)
  , SecretKeyProtectionPolicy(..)
  , GenerationDeprecationPolicy(..)
  , VerificationDefaults(..)
  , DecryptPolicy(..)
  , OpenPGPPolicy(..)
  , policyForRFC
  , defaultPolicy
  , defaultPKESKVersionPolicy
  , defaultVerificationDefaults
  , defaultDecryptPolicy
  , lenientDecryptPolicy
  , supportsSEIPDv2Symmetric
  , secretKeyProtectionPolicyForKeyVersion
  , signatureV6SaltSizeForHashAlgorithm
  , ecdhKdfHashDigest
  , validateTable30PolicyForRecipient
  , legacySecretKeyProtectionErrorMessage
  -- * Signature context validation (RFC9580/RFC4880)
  , isAllowedPrimaryKeySig
  , isAllowedSubkeySig
  , isAllowedUIDSig
  -- * Signature type validation helpers (for parser use)
  , isAllowedPrimaryKeySigType
  , isAllowedSubkeySigType
  , isAllowedUIDSigType
  ) where

import Codec.Encryption.OpenPGP.Types
import Codec.Encryption.OpenPGP.SignatureQualities (sigType)
import qualified Crypto.Hash as CH
import qualified Crypto.Hash.Algorithms as CHAlg
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.ECC.Types as ECCT
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import Data.List (elem)
import Data.Kind (Constraint)
import Data.Word (Word8)
import GHC.TypeLits (ErrorMessage(..), TypeError)

data OpenPGPRFC
  = RFC2440
  | RFC4880
  | RFC9580
  deriving (OpenPGPRFC -> OpenPGPRFC -> Bool
(OpenPGPRFC -> OpenPGPRFC -> Bool)
-> (OpenPGPRFC -> OpenPGPRFC -> Bool) -> Eq OpenPGPRFC
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenPGPRFC -> OpenPGPRFC -> Bool
== :: OpenPGPRFC -> OpenPGPRFC -> Bool
$c/= :: OpenPGPRFC -> OpenPGPRFC -> Bool
/= :: OpenPGPRFC -> OpenPGPRFC -> Bool
Eq, Int -> OpenPGPRFC -> ShowS
[OpenPGPRFC] -> ShowS
OpenPGPRFC -> String
(Int -> OpenPGPRFC -> ShowS)
-> (OpenPGPRFC -> String)
-> ([OpenPGPRFC] -> ShowS)
-> Show OpenPGPRFC
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenPGPRFC -> ShowS
showsPrec :: Int -> OpenPGPRFC -> ShowS
$cshow :: OpenPGPRFC -> String
show :: OpenPGPRFC -> String
$cshowList :: [OpenPGPRFC] -> ShowS
showList :: [OpenPGPRFC] -> ShowS
Show)

data OpenPGPRFCW (rfc :: OpenPGPRFC) where
  RFC2440W :: OpenPGPRFCW 'RFC2440
  RFC4880W :: OpenPGPRFCW 'RFC4880
  RFC9580W :: OpenPGPRFCW 'RFC9580

data SomeOpenPGPRFCW where
  SomeOpenPGPRFCW :: OpenPGPRFCW rfc -> SomeOpenPGPRFCW

demoteOpenPGPRFCW :: OpenPGPRFCW rfc -> OpenPGPRFC
demoteOpenPGPRFCW :: forall (rfc :: OpenPGPRFC). OpenPGPRFCW rfc -> OpenPGPRFC
demoteOpenPGPRFCW OpenPGPRFCW rfc
RFC2440W = OpenPGPRFC
RFC2440
demoteOpenPGPRFCW OpenPGPRFCW rfc
RFC4880W = OpenPGPRFC
RFC4880
demoteOpenPGPRFCW OpenPGPRFCW rfc
RFC9580W = OpenPGPRFC
RFC9580

promoteOpenPGPRFC :: OpenPGPRFC -> SomeOpenPGPRFCW
promoteOpenPGPRFC :: OpenPGPRFC -> SomeOpenPGPRFCW
promoteOpenPGPRFC OpenPGPRFC
RFC2440 = OpenPGPRFCW 'RFC2440 -> SomeOpenPGPRFCW
forall (h :: OpenPGPRFC). OpenPGPRFCW h -> SomeOpenPGPRFCW
SomeOpenPGPRFCW OpenPGPRFCW 'RFC2440
RFC2440W
promoteOpenPGPRFC OpenPGPRFC
RFC4880 = OpenPGPRFCW 'RFC4880 -> SomeOpenPGPRFCW
forall (h :: OpenPGPRFC). OpenPGPRFCW h -> SomeOpenPGPRFCW
SomeOpenPGPRFCW OpenPGPRFCW 'RFC4880
RFC4880W
promoteOpenPGPRFC OpenPGPRFC
RFC9580 = OpenPGPRFCW 'RFC9580 -> SomeOpenPGPRFCW
forall (h :: OpenPGPRFC). OpenPGPRFCW h -> SomeOpenPGPRFCW
SomeOpenPGPRFCW OpenPGPRFCW 'RFC9580
RFC9580W

data HashAlgorithmW (h :: HashAlgorithm) where
  DeprecatedMD5W :: HashAlgorithmW 'DeprecatedMD5
  SHA1W :: HashAlgorithmW 'SHA1
  RIPEMD160W :: HashAlgorithmW 'RIPEMD160
  SHA256W :: HashAlgorithmW 'SHA256
  SHA384W :: HashAlgorithmW 'SHA384
  SHA512W :: HashAlgorithmW 'SHA512
  SHA224W :: HashAlgorithmW 'SHA224
  SHA3_256W :: HashAlgorithmW 'SHA3_256
  SHA3_512W :: HashAlgorithmW 'SHA3_512

data SomeHashAlgorithmW where
  SomeHashAlgorithmW :: HashAlgorithmW h -> SomeHashAlgorithmW

demoteHashAlgorithmW :: HashAlgorithmW h -> HashAlgorithm
demoteHashAlgorithmW :: forall (h :: HashAlgorithm). HashAlgorithmW h -> HashAlgorithm
demoteHashAlgorithmW HashAlgorithmW h
DeprecatedMD5W = HashAlgorithm
DeprecatedMD5
demoteHashAlgorithmW HashAlgorithmW h
SHA1W = HashAlgorithm
SHA1
demoteHashAlgorithmW HashAlgorithmW h
RIPEMD160W = HashAlgorithm
RIPEMD160
demoteHashAlgorithmW HashAlgorithmW h
SHA256W = HashAlgorithm
SHA256
demoteHashAlgorithmW HashAlgorithmW h
SHA384W = HashAlgorithm
SHA384
demoteHashAlgorithmW HashAlgorithmW h
SHA512W = HashAlgorithm
SHA512
demoteHashAlgorithmW HashAlgorithmW h
SHA224W = HashAlgorithm
SHA224
demoteHashAlgorithmW HashAlgorithmW h
SHA3_256W = HashAlgorithm
SHA3_256
demoteHashAlgorithmW HashAlgorithmW h
SHA3_512W = HashAlgorithm
SHA3_512

promoteHashAlgorithm :: HashAlgorithm -> Maybe SomeHashAlgorithmW
promoteHashAlgorithm :: HashAlgorithm -> Maybe SomeHashAlgorithmW
promoteHashAlgorithm HashAlgorithm
DeprecatedMD5 = SomeHashAlgorithmW -> Maybe SomeHashAlgorithmW
forall a. a -> Maybe a
Just (HashAlgorithmW 'DeprecatedMD5 -> SomeHashAlgorithmW
forall (h :: HashAlgorithm). HashAlgorithmW h -> SomeHashAlgorithmW
SomeHashAlgorithmW HashAlgorithmW 'DeprecatedMD5
DeprecatedMD5W)
promoteHashAlgorithm HashAlgorithm
SHA1 = SomeHashAlgorithmW -> Maybe SomeHashAlgorithmW
forall a. a -> Maybe a
Just (HashAlgorithmW 'SHA1 -> SomeHashAlgorithmW
forall (h :: HashAlgorithm). HashAlgorithmW h -> SomeHashAlgorithmW
SomeHashAlgorithmW HashAlgorithmW 'SHA1
SHA1W)
promoteHashAlgorithm HashAlgorithm
RIPEMD160 = SomeHashAlgorithmW -> Maybe SomeHashAlgorithmW
forall a. a -> Maybe a
Just (HashAlgorithmW 'RIPEMD160 -> SomeHashAlgorithmW
forall (h :: HashAlgorithm). HashAlgorithmW h -> SomeHashAlgorithmW
SomeHashAlgorithmW HashAlgorithmW 'RIPEMD160
RIPEMD160W)
promoteHashAlgorithm HashAlgorithm
SHA256 = SomeHashAlgorithmW -> Maybe SomeHashAlgorithmW
forall a. a -> Maybe a
Just (HashAlgorithmW 'SHA256 -> SomeHashAlgorithmW
forall (h :: HashAlgorithm). HashAlgorithmW h -> SomeHashAlgorithmW
SomeHashAlgorithmW HashAlgorithmW 'SHA256
SHA256W)
promoteHashAlgorithm HashAlgorithm
SHA384 = SomeHashAlgorithmW -> Maybe SomeHashAlgorithmW
forall a. a -> Maybe a
Just (HashAlgorithmW 'SHA384 -> SomeHashAlgorithmW
forall (h :: HashAlgorithm). HashAlgorithmW h -> SomeHashAlgorithmW
SomeHashAlgorithmW HashAlgorithmW 'SHA384
SHA384W)
promoteHashAlgorithm HashAlgorithm
SHA512 = SomeHashAlgorithmW -> Maybe SomeHashAlgorithmW
forall a. a -> Maybe a
Just (HashAlgorithmW 'SHA512 -> SomeHashAlgorithmW
forall (h :: HashAlgorithm). HashAlgorithmW h -> SomeHashAlgorithmW
SomeHashAlgorithmW HashAlgorithmW 'SHA512
SHA512W)
promoteHashAlgorithm HashAlgorithm
SHA224 = SomeHashAlgorithmW -> Maybe SomeHashAlgorithmW
forall a. a -> Maybe a
Just (HashAlgorithmW 'SHA224 -> SomeHashAlgorithmW
forall (h :: HashAlgorithm). HashAlgorithmW h -> SomeHashAlgorithmW
SomeHashAlgorithmW HashAlgorithmW 'SHA224
SHA224W)
promoteHashAlgorithm HashAlgorithm
SHA3_256 = SomeHashAlgorithmW -> Maybe SomeHashAlgorithmW
forall a. a -> Maybe a
Just (HashAlgorithmW 'SHA3_256 -> SomeHashAlgorithmW
forall (h :: HashAlgorithm). HashAlgorithmW h -> SomeHashAlgorithmW
SomeHashAlgorithmW HashAlgorithmW 'SHA3_256
SHA3_256W)
promoteHashAlgorithm HashAlgorithm
SHA3_512 = SomeHashAlgorithmW -> Maybe SomeHashAlgorithmW
forall a. a -> Maybe a
Just (HashAlgorithmW 'SHA3_512 -> SomeHashAlgorithmW
forall (h :: HashAlgorithm). HashAlgorithmW h -> SomeHashAlgorithmW
SomeHashAlgorithmW HashAlgorithmW 'SHA3_512
SHA3_512W)
promoteHashAlgorithm (OtherHA Word8
_) = Maybe SomeHashAlgorithmW
forall a. Maybe a
Nothing

signatureV6SaltSizeForHashAlgorithm :: HashAlgorithm -> Maybe Word8
signatureV6SaltSizeForHashAlgorithm :: HashAlgorithm -> Maybe Word8
signatureV6SaltSizeForHashAlgorithm HashAlgorithm
SHA224 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
16
signatureV6SaltSizeForHashAlgorithm HashAlgorithm
SHA256 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
16
signatureV6SaltSizeForHashAlgorithm HashAlgorithm
SHA384 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
24
signatureV6SaltSizeForHashAlgorithm HashAlgorithm
SHA512 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
32
signatureV6SaltSizeForHashAlgorithm HashAlgorithm
SHA3_256 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
16
signatureV6SaltSizeForHashAlgorithm HashAlgorithm
SHA3_512 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
32
signatureV6SaltSizeForHashAlgorithm HashAlgorithm
_ = Maybe Word8
forall a. Maybe a
Nothing

data HashAlgoStatus
  = HashAllowed
  | HashShouldNot
  | HashMustNot

type family HashAlgoStatusFor (rfc :: OpenPGPRFC) (h :: HashAlgorithm) :: HashAlgoStatus where
  HashAlgoStatusFor 'RFC4880 'DeprecatedMD5 = 'HashShouldNot
  HashAlgoStatusFor 'RFC9580 'DeprecatedMD5 = 'HashMustNot
  HashAlgoStatusFor 'RFC9580 'SHA1 = 'HashMustNot
  HashAlgoStatusFor 'RFC9580 'RIPEMD160 = 'HashShouldNot
  HashAlgoStatusFor rfc h = 'HashAllowed

type family AssertHashAllowed (status :: HashAlgoStatus) :: Constraint where
  AssertHashAllowed 'HashAllowed = ()
  AssertHashAllowed 'HashShouldNot =
    TypeError ('Text "Hash algorithm is deprecated (SHOULD NOT) for new signatures under this RFC")
  AssertHashAllowed 'HashMustNot =
    TypeError ('Text "Hash algorithm is disallowed (MUST NOT) for new signatures under this RFC")

type HashAlgoAllowedFor rfc h = AssertHashAllowed (HashAlgoStatusFor rfc h)

type family AssertHashVerifiable (status :: HashAlgoStatus) :: Constraint where
  AssertHashVerifiable 'HashAllowed = ()
  AssertHashVerifiable 'HashShouldNot = ()
  AssertHashVerifiable 'HashMustNot =
    TypeError ('Text "Hash algorithm is disallowed for verification in this RFC context")

type HashAlgoVerifiableFor rfc h = AssertHashVerifiable (HashAlgoStatusFor rfc h)

data PKESKVersionPolicy
  = PreferV6
  | ForceV3Interop
  deriving (PKESKVersionPolicy -> PKESKVersionPolicy -> Bool
(PKESKVersionPolicy -> PKESKVersionPolicy -> Bool)
-> (PKESKVersionPolicy -> PKESKVersionPolicy -> Bool)
-> Eq PKESKVersionPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PKESKVersionPolicy -> PKESKVersionPolicy -> Bool
== :: PKESKVersionPolicy -> PKESKVersionPolicy -> Bool
$c/= :: PKESKVersionPolicy -> PKESKVersionPolicy -> Bool
/= :: PKESKVersionPolicy -> PKESKVersionPolicy -> Bool
Eq, Int -> PKESKVersionPolicy -> ShowS
[PKESKVersionPolicy] -> ShowS
PKESKVersionPolicy -> String
(Int -> PKESKVersionPolicy -> ShowS)
-> (PKESKVersionPolicy -> String)
-> ([PKESKVersionPolicy] -> ShowS)
-> Show PKESKVersionPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PKESKVersionPolicy -> ShowS
showsPrec :: Int -> PKESKVersionPolicy -> ShowS
$cshow :: PKESKVersionPolicy -> String
show :: PKESKVersionPolicy -> String
$cshowList :: [PKESKVersionPolicy] -> ShowS
showList :: [PKESKVersionPolicy] -> ShowS
Show)

data MessageEncryptionPolicy = MessageEncryptionPolicy
  { MessageEncryptionPolicy -> SymmetricAlgorithm
messageDefaultSymmetricAlgorithm :: SymmetricAlgorithm
  , MessageEncryptionPolicy -> AEADAlgorithm
messageDefaultAEADAlgorithm :: AEADAlgorithm
  , MessageEncryptionPolicy -> Word8
messageDefaultChunkSize :: Word8
  , MessageEncryptionPolicy -> Int
messageS2KSaltOctets :: Int
  , MessageEncryptionPolicy -> Int
messageSEIPDv2SaltOctets :: Int
  , MessageEncryptionPolicy -> Salt -> S2K
messageDefaultS2KForSalt :: Salt -> S2K
  , MessageEncryptionPolicy -> [SymmetricAlgorithm]
messageSEIPDv2SymmetricAlgorithms :: [SymmetricAlgorithm]
  }

data SecretKeyProtectionPolicy = SecretKeyProtectionPolicy
  { SecretKeyProtectionPolicy -> SymmetricAlgorithm
secretKeyDefaultSymmetricAlgorithm :: SymmetricAlgorithm
  , SecretKeyProtectionPolicy -> AEADAlgorithm
secretKeyDefaultAEADAlgorithm :: AEADAlgorithm
  , SecretKeyProtectionPolicy -> Salt -> S2K
secretKeyDefaultS2KForSalt :: Salt -> S2K
  , SecretKeyProtectionPolicy -> Int
secretKeyS2KSaltOctets :: Int
  , SecretKeyProtectionPolicy -> Int
secretKeyAEADNonceOctets :: Int
  }

data GenerationDeprecationPolicy = GenerationDeprecationPolicy
  { GenerationDeprecationPolicy -> [HashAlgorithm]
deprecatedHashAlgorithms :: [HashAlgorithm]
  , GenerationDeprecationPolicy -> [SymmetricAlgorithm]
deprecatedSymmetricAlgorithms :: [SymmetricAlgorithm]
  }

data VerificationDefaults = VerificationDefaults
  { VerificationDefaults -> Bool
verificationDefaultStrict :: Bool
  , VerificationDefaults -> Bool
verificationDefaultStreaming :: Bool
  }

-- | Per-message decrypt-side enforcement policy.
--
-- 'defaultDecryptPolicy' applies RFC9580-strict rules: no unauthenticated
-- (SED) ciphertext, modern symmetric algorithms only, and rejection of
-- deprecated S2K specifiers in SKESK.  Use 'lenientDecryptPolicy' when
-- interoperating with older RFC4880 or RFC2440 messages.
data DecryptPolicy = DecryptPolicy
  { -- | When 'False' (RFC9580 default), receiving a Symmetrically Encrypted
    -- Data packet (SED, tag 9) is a hard error.  RFC9580 §5.9 says
    -- implementations SHOULD reject unauthenticated ciphertext.
    DecryptPolicy -> Bool
decryptAllowSEDNoIntegrity :: Bool
    -- | When 'False', receiving a SEIPDv1 (MDC-protected) packet is rejected.
    -- Defaults to 'True' for interoperability with RFC4880 senders.
  , DecryptPolicy -> Bool
decryptAllowSEIPDv1 :: Bool
    -- | Allowed symmetric algorithms for session keys.  'Nothing' means
    -- unrestricted.  The RFC9580 default restricts to AES-128/192/256.
  , DecryptPolicy -> Maybe [SymmetricAlgorithm]
decryptAllowedSymmetricAlgos :: Maybe [SymmetricAlgorithm]
    -- | Allowed AEAD algorithms for SEIPDv2 payloads.  'Nothing' means
    -- unrestricted.  The RFC9580 default allows EAX, OCB, and GCM.
  , DecryptPolicy -> Maybe [AEADAlgorithm]
decryptAllowedAEADAlgos :: Maybe [AEADAlgorithm]
    -- | When 'True' (RFC9580 default), reject SKESK packets that use Simple
    -- or Salted S2K specifiers (both deprecated since RFC9580).
  , DecryptPolicy -> Bool
decryptRejectDeprecatedSKESK :: Bool
    -- | When 'True' (RFC9580 default), any packet received after the
    -- message-integrity boundary (MDC for SEIPDv1, final AEAD tag for
    -- SEIPDv2, or the outer encrypted-data packet for SED) is a hard error.
    -- RFC9580 §5.13.2 requires that implementations detect and reject
    -- data appended after the authenticated payload.  Set to 'False' only
    -- when interoperating with legacy implementations that emit trailing
    -- garbage (implies 'lenientDecryptPolicy').
  , DecryptPolicy -> Bool
decryptRejectTrailingData :: Bool
    -- | When 'True' (RFC9580 default), a payload with no version-aligned
    -- ESK is a hard error even when misaligned ESKs are present.  This is a
    -- distinct concern from trailing-data rejection: a message could have
    -- correct framing yet still carry only v6 PKESKs before a SEIPDv1
    -- payload (or only v4 SKESKs before a SEIPDv2 payload), which indicates
    -- a mis-assembled message rather than an integrity violation.
    -- Set to 'False' only when salvaging malformed legacy messages.
  , DecryptPolicy -> Bool
decryptRejectESKVersionMismatch :: Bool
  } deriving (DecryptPolicy -> DecryptPolicy -> Bool
(DecryptPolicy -> DecryptPolicy -> Bool)
-> (DecryptPolicy -> DecryptPolicy -> Bool) -> Eq DecryptPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecryptPolicy -> DecryptPolicy -> Bool
== :: DecryptPolicy -> DecryptPolicy -> Bool
$c/= :: DecryptPolicy -> DecryptPolicy -> Bool
/= :: DecryptPolicy -> DecryptPolicy -> Bool
Eq, Int -> DecryptPolicy -> ShowS
[DecryptPolicy] -> ShowS
DecryptPolicy -> String
(Int -> DecryptPolicy -> ShowS)
-> (DecryptPolicy -> String)
-> ([DecryptPolicy] -> ShowS)
-> Show DecryptPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecryptPolicy -> ShowS
showsPrec :: Int -> DecryptPolicy -> ShowS
$cshow :: DecryptPolicy -> String
show :: DecryptPolicy -> String
$cshowList :: [DecryptPolicy] -> ShowS
showList :: [DecryptPolicy] -> ShowS
Show)

data OpenPGPPolicy = OpenPGPPolicy
  { OpenPGPPolicy -> OpenPGPRFC
policyRFC :: OpenPGPRFC
  , OpenPGPPolicy -> MessageEncryptionPolicy
policyMessageEncryption :: MessageEncryptionPolicy
  , OpenPGPPolicy -> Maybe SecretKeyProtectionPolicy
policySecretKeyProtection :: Maybe SecretKeyProtectionPolicy
  , OpenPGPPolicy -> GenerationDeprecationPolicy
policyGenerationDeprecations :: GenerationDeprecationPolicy
  , OpenPGPPolicy -> DecryptPolicy
policyDecrypt :: DecryptPolicy
  }

policyForRFC :: OpenPGPRFC -> OpenPGPPolicy
policyForRFC :: OpenPGPRFC -> OpenPGPPolicy
policyForRFC OpenPGPRFC
RFC2440 =
  OpenPGPPolicy
    { policyRFC :: OpenPGPRFC
policyRFC = OpenPGPRFC
RFC2440
    , policyMessageEncryption :: MessageEncryptionPolicy
policyMessageEncryption =
        MessageEncryptionPolicy
          { messageDefaultSymmetricAlgorithm :: SymmetricAlgorithm
messageDefaultSymmetricAlgorithm = SymmetricAlgorithm
TripleDES
          , messageDefaultAEADAlgorithm :: AEADAlgorithm
messageDefaultAEADAlgorithm = AEADAlgorithm
OCB
          , messageDefaultChunkSize :: Word8
messageDefaultChunkSize = Word8
6
          , messageS2KSaltOctets :: Int
messageS2KSaltOctets = Int
8
          , messageSEIPDv2SaltOctets :: Int
messageSEIPDv2SaltOctets = Int
32
          , messageDefaultS2KForSalt :: Salt -> S2K
messageDefaultS2KForSalt = \Salt
salt -> HashAlgorithm -> Salt8 -> IterationCount -> S2K
IteratedSalted HashAlgorithm
SHA1 (String -> Salt -> Salt8
requireSalt8 String
"RFC2440 message S2K" Salt
salt) IterationCount
65536
          , messageSEIPDv2SymmetricAlgorithms :: [SymmetricAlgorithm]
messageSEIPDv2SymmetricAlgorithms = []
          }
    , policySecretKeyProtection :: Maybe SecretKeyProtectionPolicy
policySecretKeyProtection = Maybe SecretKeyProtectionPolicy
forall a. Maybe a
Nothing
    , policyGenerationDeprecations :: GenerationDeprecationPolicy
policyGenerationDeprecations =
        GenerationDeprecationPolicy
          { deprecatedHashAlgorithms :: [HashAlgorithm]
deprecatedHashAlgorithms = []
          , deprecatedSymmetricAlgorithms :: [SymmetricAlgorithm]
deprecatedSymmetricAlgorithms = []
          }
    , policyDecrypt :: DecryptPolicy
policyDecrypt = DecryptPolicy
lenientDecryptPolicy
    }
policyForRFC OpenPGPRFC
RFC4880 =
  OpenPGPPolicy
    { policyRFC :: OpenPGPRFC
policyRFC = OpenPGPRFC
RFC4880
    , policyMessageEncryption :: MessageEncryptionPolicy
policyMessageEncryption =
        MessageEncryptionPolicy
          { messageDefaultSymmetricAlgorithm :: SymmetricAlgorithm
messageDefaultSymmetricAlgorithm = SymmetricAlgorithm
AES128
          , messageDefaultAEADAlgorithm :: AEADAlgorithm
messageDefaultAEADAlgorithm = AEADAlgorithm
OCB
          , messageDefaultChunkSize :: Word8
messageDefaultChunkSize = Word8
6
          , messageS2KSaltOctets :: Int
messageS2KSaltOctets = Int
8
          , messageSEIPDv2SaltOctets :: Int
messageSEIPDv2SaltOctets = Int
32
          , messageDefaultS2KForSalt :: Salt -> S2K
messageDefaultS2KForSalt = \Salt
salt -> HashAlgorithm -> Salt8 -> IterationCount -> S2K
IteratedSalted HashAlgorithm
SHA256 (String -> Salt -> Salt8
requireSalt8 String
"RFC4880 message S2K" Salt
salt) IterationCount
65536
          , messageSEIPDv2SymmetricAlgorithms :: [SymmetricAlgorithm]
messageSEIPDv2SymmetricAlgorithms = []
          }
    , policySecretKeyProtection :: Maybe SecretKeyProtectionPolicy
policySecretKeyProtection = Maybe SecretKeyProtectionPolicy
forall a. Maybe a
Nothing
    , policyGenerationDeprecations :: GenerationDeprecationPolicy
policyGenerationDeprecations =
        GenerationDeprecationPolicy
          { deprecatedHashAlgorithms :: [HashAlgorithm]
deprecatedHashAlgorithms = [HashAlgorithm
DeprecatedMD5]
          , deprecatedSymmetricAlgorithms :: [SymmetricAlgorithm]
deprecatedSymmetricAlgorithms = []
          }
    , policyDecrypt :: DecryptPolicy
policyDecrypt = DecryptPolicy
lenientDecryptPolicy
    }
policyForRFC OpenPGPRFC
RFC9580 =
  OpenPGPPolicy
    { policyRFC :: OpenPGPRFC
policyRFC = OpenPGPRFC
RFC9580
    , policyMessageEncryption :: MessageEncryptionPolicy
policyMessageEncryption =
        MessageEncryptionPolicy
          { messageDefaultSymmetricAlgorithm :: SymmetricAlgorithm
messageDefaultSymmetricAlgorithm = SymmetricAlgorithm
AES256
          , messageDefaultAEADAlgorithm :: AEADAlgorithm
messageDefaultAEADAlgorithm = AEADAlgorithm
OCB
          , messageDefaultChunkSize :: Word8
messageDefaultChunkSize = Word8
6
          , messageS2KSaltOctets :: Int
messageS2KSaltOctets = Int
16
          , messageSEIPDv2SaltOctets :: Int
messageSEIPDv2SaltOctets = Int
32
          , messageDefaultS2KForSalt :: Salt -> S2K
messageDefaultS2KForSalt = \Salt
salt -> Salt16 -> Word8 -> Word8 -> Word8 -> S2K
Argon2 (String -> Salt -> Salt16
requireSalt16 String
"RFC9580 message S2K" Salt
salt) Word8
1 Word8
4 Word8
15
          , messageSEIPDv2SymmetricAlgorithms :: [SymmetricAlgorithm]
messageSEIPDv2SymmetricAlgorithms = [SymmetricAlgorithm
AES128, SymmetricAlgorithm
AES192, SymmetricAlgorithm
AES256]
          }
    , policySecretKeyProtection :: Maybe SecretKeyProtectionPolicy
policySecretKeyProtection =
        SecretKeyProtectionPolicy -> Maybe SecretKeyProtectionPolicy
forall a. a -> Maybe a
Just
          SecretKeyProtectionPolicy
            { secretKeyDefaultSymmetricAlgorithm :: SymmetricAlgorithm
secretKeyDefaultSymmetricAlgorithm = SymmetricAlgorithm
AES256
            , secretKeyDefaultAEADAlgorithm :: AEADAlgorithm
secretKeyDefaultAEADAlgorithm = AEADAlgorithm
OCB
            , secretKeyDefaultS2KForSalt :: Salt -> S2K
secretKeyDefaultS2KForSalt = \Salt
salt -> Salt16 -> Word8 -> Word8 -> Word8 -> S2K
Argon2 (String -> Salt -> Salt16
requireSalt16 String
"RFC9580 secret key S2K" Salt
salt) Word8
1 Word8
4 Word8
15
            , secretKeyS2KSaltOctets :: Int
secretKeyS2KSaltOctets = Int
16
            , secretKeyAEADNonceOctets :: Int
secretKeyAEADNonceOctets = Int
15
            }
    , policyGenerationDeprecations :: GenerationDeprecationPolicy
policyGenerationDeprecations =
        GenerationDeprecationPolicy
          { deprecatedHashAlgorithms :: [HashAlgorithm]
deprecatedHashAlgorithms = [HashAlgorithm
DeprecatedMD5, HashAlgorithm
SHA1, HashAlgorithm
RIPEMD160]
          , deprecatedSymmetricAlgorithms :: [SymmetricAlgorithm]
deprecatedSymmetricAlgorithms = [SymmetricAlgorithm
IDEA, SymmetricAlgorithm
TripleDES, SymmetricAlgorithm
CAST5, SymmetricAlgorithm
Blowfish]
          }
    , policyDecrypt :: DecryptPolicy
policyDecrypt = DecryptPolicy
defaultDecryptPolicy
    }

requireSalt8 :: String -> Salt -> Salt8
requireSalt8 :: String -> Salt -> Salt8
requireSalt8 String
context Salt
salt =
  case Salt -> Maybe Salt8
salt8FromSalt Salt
salt of
    Just Salt8
salt8 -> Salt8
salt8
    Maybe Salt8
Nothing -> String -> Salt8
forall a. HasCallStack => String -> a
error (String
context String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" requires an 8-octet salt")

requireSalt16 :: String -> Salt -> Salt16
requireSalt16 :: String -> Salt -> Salt16
requireSalt16 String
context Salt
salt =
  case Salt -> Maybe Salt16
salt16FromSalt Salt
salt of
    Just Salt16
salt16 -> Salt16
salt16
    Maybe Salt16
Nothing -> String -> Salt16
forall a. HasCallStack => String -> a
error (String
context String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" requires a 16-octet salt")

defaultPolicy :: OpenPGPPolicy
defaultPolicy :: OpenPGPPolicy
defaultPolicy = OpenPGPRFC -> OpenPGPPolicy
policyForRFC OpenPGPRFC
RFC9580

defaultPKESKVersionPolicy :: PKESKVersionPolicy
defaultPKESKVersionPolicy :: PKESKVersionPolicy
defaultPKESKVersionPolicy = PKESKVersionPolicy
PreferV6

defaultVerificationDefaults :: VerificationDefaults
defaultVerificationDefaults :: VerificationDefaults
defaultVerificationDefaults =
  VerificationDefaults
    { verificationDefaultStrict :: Bool
verificationDefaultStrict = Bool
True
    , verificationDefaultStreaming :: Bool
verificationDefaultStreaming = Bool
True
    }

-- | RFC9580-strict decrypt policy.  Rejects unauthenticated SED ciphertext,
-- restricts session-key symmetric algorithms to AES-128/192/256 and AEAD to
-- EAX/OCB/GCM, and rejects SKESK packets carrying deprecated Simple or
-- Salted S2K specifiers.  SEIPDv1 (MDC-protected) is still accepted for
-- interoperability with RFC4880 senders.
defaultDecryptPolicy :: DecryptPolicy
defaultDecryptPolicy :: DecryptPolicy
defaultDecryptPolicy =
  DecryptPolicy
    { decryptAllowSEDNoIntegrity :: Bool
decryptAllowSEDNoIntegrity = Bool
False
    , decryptAllowSEIPDv1 :: Bool
decryptAllowSEIPDv1 = Bool
True
    , decryptAllowedSymmetricAlgos :: Maybe [SymmetricAlgorithm]
decryptAllowedSymmetricAlgos = [SymmetricAlgorithm] -> Maybe [SymmetricAlgorithm]
forall a. a -> Maybe a
Just [SymmetricAlgorithm
AES128, SymmetricAlgorithm
AES192, SymmetricAlgorithm
AES256]
    , decryptAllowedAEADAlgos :: Maybe [AEADAlgorithm]
decryptAllowedAEADAlgos = [AEADAlgorithm] -> Maybe [AEADAlgorithm]
forall a. a -> Maybe a
Just [AEADAlgorithm
EAX, AEADAlgorithm
OCB, AEADAlgorithm
GCM]
    , decryptRejectDeprecatedSKESK :: Bool
decryptRejectDeprecatedSKESK = Bool
True
    , decryptRejectTrailingData :: Bool
decryptRejectTrailingData = Bool
True
    , decryptRejectESKVersionMismatch :: Bool
decryptRejectESKVersionMismatch = Bool
True
    }

-- | Permissive decrypt policy for interoperability with RFC4880 and RFC2440
-- messages.  No algorithm or integrity restrictions are applied.
lenientDecryptPolicy :: DecryptPolicy
lenientDecryptPolicy :: DecryptPolicy
lenientDecryptPolicy =
  DecryptPolicy
    { decryptAllowSEDNoIntegrity :: Bool
decryptAllowSEDNoIntegrity = Bool
True
    , decryptAllowSEIPDv1 :: Bool
decryptAllowSEIPDv1 = Bool
True
    , decryptAllowedSymmetricAlgos :: Maybe [SymmetricAlgorithm]
decryptAllowedSymmetricAlgos = Maybe [SymmetricAlgorithm]
forall a. Maybe a
Nothing
    , decryptAllowedAEADAlgos :: Maybe [AEADAlgorithm]
decryptAllowedAEADAlgos = Maybe [AEADAlgorithm]
forall a. Maybe a
Nothing
    , decryptRejectDeprecatedSKESK :: Bool
decryptRejectDeprecatedSKESK = Bool
False
    , decryptRejectTrailingData :: Bool
decryptRejectTrailingData = Bool
False
    , decryptRejectESKVersionMismatch :: Bool
decryptRejectESKVersionMismatch = Bool
False
    }

supportsSEIPDv2Symmetric :: OpenPGPPolicy -> SymmetricAlgorithm -> Bool
supportsSEIPDv2Symmetric :: OpenPGPPolicy -> SymmetricAlgorithm -> Bool
supportsSEIPDv2Symmetric OpenPGPPolicy
policy SymmetricAlgorithm
sa =
  SymmetricAlgorithm
sa SymmetricAlgorithm -> [SymmetricAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` MessageEncryptionPolicy -> [SymmetricAlgorithm]
messageSEIPDv2SymmetricAlgorithms (OpenPGPPolicy -> MessageEncryptionPolicy
policyMessageEncryption OpenPGPPolicy
policy)

secretKeyProtectionPolicyForKeyVersion :: OpenPGPPolicy -> KeyVersion -> Maybe SecretKeyProtectionPolicy
secretKeyProtectionPolicyForKeyVersion :: OpenPGPPolicy -> KeyVersion -> Maybe SecretKeyProtectionPolicy
secretKeyProtectionPolicyForKeyVersion OpenPGPPolicy
policy KeyVersion
V6 = OpenPGPPolicy -> Maybe SecretKeyProtectionPolicy
policySecretKeyProtection OpenPGPPolicy
policy
secretKeyProtectionPolicyForKeyVersion OpenPGPPolicy
_ KeyVersion
_ = Maybe SecretKeyProtectionPolicy
forall a. Maybe a
Nothing

ecdhKdfHashDigest :: HashAlgorithm -> B.ByteString -> Either String B.ByteString
ecdhKdfHashDigest :: HashAlgorithm -> ByteString -> Either String ByteString
ecdhKdfHashDigest HashAlgorithm
SHA1 ByteString
_ = String -> Either String ByteString
forall a b. a -> Either a b
Left String
"ECDH KDF hash algorithm SHA1 is disallowed by policy"
ecdhKdfHashDigest HashAlgorithm
SHA224 ByteString
bs = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Digest SHA224 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA224
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash ByteString
bs :: CH.Digest CHAlg.SHA224))
ecdhKdfHashDigest HashAlgorithm
SHA256 ByteString
bs = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash ByteString
bs :: CH.Digest CHAlg.SHA256))
ecdhKdfHashDigest HashAlgorithm
SHA384 ByteString
bs = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Digest SHA384 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA384
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash ByteString
bs :: CH.Digest CHAlg.SHA384))
ecdhKdfHashDigest HashAlgorithm
SHA512 ByteString
bs = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Digest SHA512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA512
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash ByteString
bs :: CH.Digest CHAlg.SHA512))
ecdhKdfHashDigest HashAlgorithm
SHA3_256 ByteString
bs = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Digest SHA3_256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA3_256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash ByteString
bs :: CH.Digest CHAlg.SHA3_256))
ecdhKdfHashDigest HashAlgorithm
SHA3_512 ByteString
bs = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Digest SHA3_512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA3_512
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash ByteString
bs :: CH.Digest CHAlg.SHA3_512))
ecdhKdfHashDigest HashAlgorithm
_ ByteString
_ = String -> Either String ByteString
forall a b. a -> Either a b
Left String
"ECDH KDF hash algorithm is unsupported"

validateTable30PolicyForRecipient ::
     SomePKPayload -> HashAlgorithm -> SymmetricAlgorithm -> Either String ()
validateTable30PolicyForRecipient :: SomePKPayload
-> HashAlgorithm -> SymmetricAlgorithm -> Either String ()
validateTable30PolicyForRecipient SomePKPayload
recipientPKP HashAlgorithm
kdfHA SymmetricAlgorithm
kdfSA =
  case SomePKPayload
-> PKey -> Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
allowedTable30EcdhParameterSets SomePKPayload
recipientPKP (SomePKPayload -> PKey
_pubkey SomePKPayload
recipientPKP) of
    Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
Nothing -> () -> Either String ()
forall a b. b -> Either a b
Right ()
    Just (String
curveName, [(HashAlgorithm, SymmetricAlgorithm)]
allowedParams) ->
      if (HashAlgorithm
kdfHA, SymmetricAlgorithm
kdfSA) (HashAlgorithm, SymmetricAlgorithm)
-> [(HashAlgorithm, SymmetricAlgorithm)] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(HashAlgorithm, SymmetricAlgorithm)]
allowedParams
        then () -> Either String ()
forall a b. b -> Either a b
Right ()
        else
          String -> Either String ()
forall a b. a -> Either a b
Left
            (String
"RFC9580 Table 30 policy violation for " String -> ShowS
forall a. [a] -> [a] -> [a]
++
             KeyVersion -> String
forall a. Show a => a -> String
show (SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
recipientPKP) String -> ShowS
forall a. [a] -> [a] -> [a]
++
             String
" ECDH key on " String -> ShowS
forall a. [a] -> [a] -> [a]
++
             String
curveName String -> ShowS
forall a. [a] -> [a] -> [a]
++
             String
": expected one of " String -> ShowS
forall a. [a] -> [a] -> [a]
++
             [(HashAlgorithm, SymmetricAlgorithm)] -> String
forall a. Show a => a -> String
show [(HashAlgorithm, SymmetricAlgorithm)]
allowedParams String -> ShowS
forall a. [a] -> [a] -> [a]
++
             String
", got (" String -> ShowS
forall a. [a] -> [a] -> [a]
++
             HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
kdfHA String -> ShowS
forall a. [a] -> [a] -> [a]
++
             String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++
             SymmetricAlgorithm -> String
forall a. Show a => a -> String
show SymmetricAlgorithm
kdfSA String -> ShowS
forall a. [a] -> [a] -> [a]
++
             String
")")

allowedTable30EcdhParameterSets ::
     SomePKPayload
  -> PKey
  -> Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
allowedTable30EcdhParameterSets :: SomePKPayload
-> PKey -> Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
allowedTable30EcdhParameterSets SomePKPayload
recipientPKP (ECDHPubKey PKey
ecdhPub HashAlgorithm
_ SymmetricAlgorithm
_)
  | SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
recipientPKP KeyVersion -> KeyVersion -> Bool
forall a. Eq a => a -> a -> Bool
== KeyVersion
V4 =
      case PKey
ecdhPub of
        EdDSAPubKey EdSigningCurve
Ed25519 EdPoint
_ ->
          (String, [(HashAlgorithm, SymmetricAlgorithm)])
-> Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
forall a. a -> Maybe a
Just
            ( String
"Curve25519Legacy"
            , [ (HashAlgorithm
ha, SymmetricAlgorithm
sa)
              | HashAlgorithm
ha <- [HashAlgorithm
SHA256, HashAlgorithm
SHA384, HashAlgorithm
SHA512]
              , SymmetricAlgorithm
sa <- [SymmetricAlgorithm
AES128, SymmetricAlgorithm
AES192, SymmetricAlgorithm
AES256]
              ]
            )
        ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey Curve
curve PublicPoint
_))
          | Curve
curve Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== CurveName -> Curve
ECCT.getCurveByName CurveName
ECCT.SEC_p256r1 ->
              (String, [(HashAlgorithm, SymmetricAlgorithm)])
-> Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
forall a. a -> Maybe a
Just (String
"NIST P-256", [(HashAlgorithm
SHA256, SymmetricAlgorithm
AES128)])
          | Curve
curve Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== CurveName -> Curve
ECCT.getCurveByName CurveName
ECCT.SEC_p384r1 ->
              (String, [(HashAlgorithm, SymmetricAlgorithm)])
-> Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
forall a. a -> Maybe a
Just (String
"NIST P-384", [(HashAlgorithm
SHA384, SymmetricAlgorithm
AES192)])
          | Curve
curve Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== CurveName -> Curve
ECCT.getCurveByName CurveName
ECCT.SEC_p521r1 ->
              (String, [(HashAlgorithm, SymmetricAlgorithm)])
-> Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
forall a. a -> Maybe a
Just (String
"NIST P-521", [(HashAlgorithm
SHA512, SymmetricAlgorithm
AES256)])
        PKey
_ -> Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
forall a. Maybe a
Nothing
  | SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
recipientPKP KeyVersion -> KeyVersion -> Bool
forall a. Eq a => a -> a -> Bool
== KeyVersion
V6 =
      case PKey
ecdhPub of
        EdDSAPubKey EdSigningCurve
Ed25519 EdPoint
_ -> (String, [(HashAlgorithm, SymmetricAlgorithm)])
-> Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
forall a. a -> Maybe a
Just (String
"Curve25519Legacy", [(HashAlgorithm
SHA256, SymmetricAlgorithm
AES128)])
        ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey Curve
curve PublicPoint
_))
          | Curve
curve Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== CurveName -> Curve
ECCT.getCurveByName CurveName
ECCT.SEC_p256r1 ->
              (String, [(HashAlgorithm, SymmetricAlgorithm)])
-> Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
forall a. a -> Maybe a
Just (String
"NIST P-256", [(HashAlgorithm
SHA256, SymmetricAlgorithm
AES128)])
          | Curve
curve Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== CurveName -> Curve
ECCT.getCurveByName CurveName
ECCT.SEC_p384r1 ->
              (String, [(HashAlgorithm, SymmetricAlgorithm)])
-> Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
forall a. a -> Maybe a
Just (String
"NIST P-384", [(HashAlgorithm
SHA384, SymmetricAlgorithm
AES192)])
          | Curve
curve Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== CurveName -> Curve
ECCT.getCurveByName CurveName
ECCT.SEC_p521r1 ->
              (String, [(HashAlgorithm, SymmetricAlgorithm)])
-> Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
forall a. a -> Maybe a
Just (String
"NIST P-521", [(HashAlgorithm
SHA512, SymmetricAlgorithm
AES256)])
        PKey
_ -> Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
forall a. Maybe a
Nothing
  | Bool
otherwise = Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
forall a. Maybe a
Nothing
allowedTable30EcdhParameterSets SomePKPayload
_ PKey
_ = Maybe (String, [(HashAlgorithm, SymmetricAlgorithm)])
forall a. Maybe a
Nothing

legacySecretKeyProtectionErrorMessage :: String
legacySecretKeyProtectionErrorMessage :: String
legacySecretKeyProtectionErrorMessage =
  String
"re-encrypting legacy secret keys without SHA-1 protection is unsupported; explicit legacy override required"

-- RFC9580/RFC4880 signature context validation predicates
-- These enforce which signature types are allowed in which structural contexts

-- | RFC9580 §3.2: Primary key can only have KeyRevocationSig or SignatureDirectlyOnAKey
isAllowedPrimaryKeySig :: SignaturePayload -> Bool
isAllowedPrimaryKeySig :: SignaturePayload -> Bool
isAllowedPrimaryKeySig = Bool -> (SigType -> Bool) -> Maybe SigType -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False SigType -> Bool
isAllowedPrimaryKeySigType (Maybe SigType -> Bool)
-> (SignaturePayload -> Maybe SigType) -> SignaturePayload -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe SigType
sigType

-- | RFC9580 §3.3: Subkey can only have SubkeyBindingSig or SubkeyRevocationSig
isAllowedSubkeySig :: SignaturePayload -> Bool
isAllowedSubkeySig :: SignaturePayload -> Bool
isAllowedSubkeySig = Bool -> (SigType -> Bool) -> Maybe SigType -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False SigType -> Bool
isAllowedSubkeySigType (Maybe SigType -> Bool)
-> (SignaturePayload -> Maybe SigType) -> SignaturePayload -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe SigType
sigType

-- | RFC9580 §3.4: User ID can only have various certification types or CertRevocationSig
isAllowedUIDSig :: SignaturePayload -> Bool
isAllowedUIDSig :: SignaturePayload -> Bool
isAllowedUIDSig = Bool -> (SigType -> Bool) -> Maybe SigType -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False SigType -> Bool
isAllowedUIDSigType (Maybe SigType -> Bool)
-> (SignaturePayload -> Maybe SigType) -> SignaturePayload -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe SigType
sigType

-- | Test if a SigType is allowed on a primary key
isAllowedPrimaryKeySigType :: SigType -> Bool
isAllowedPrimaryKeySigType :: SigType -> Bool
isAllowedPrimaryKeySigType SigType
KeyRevocationSig = Bool
True
isAllowedPrimaryKeySigType SigType
SignatureDirectlyOnAKey = Bool
True
isAllowedPrimaryKeySigType SigType
_ = Bool
False

-- | Test if a SigType is allowed on a subkey
isAllowedSubkeySigType :: SigType -> Bool
isAllowedSubkeySigType :: SigType -> Bool
isAllowedSubkeySigType SigType
SubkeyBindingSig = Bool
True
isAllowedSubkeySigType SigType
SubkeyRevocationSig = Bool
True
isAllowedSubkeySigType SigType
_ = Bool
False

-- | Test if a SigType is allowed on a User ID
isAllowedUIDSigType :: SigType -> Bool
isAllowedUIDSigType :: SigType -> Bool
isAllowedUIDSigType SigType
GenericCert = Bool
True
isAllowedUIDSigType SigType
PersonaCert = Bool
True
isAllowedUIDSigType SigType
CasualCert = Bool
True
isAllowedUIDSigType SigType
PositiveCert = Bool
True
isAllowedUIDSigType SigType
CertRevocationSig = Bool
True
isAllowedUIDSigType SigType
_ = Bool
False