-- 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 (Eq, 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 RFC2440W = RFC2440
demoteOpenPGPRFCW RFC4880W = RFC4880
demoteOpenPGPRFCW RFC9580W = RFC9580

promoteOpenPGPRFC :: OpenPGPRFC -> SomeOpenPGPRFCW
promoteOpenPGPRFC RFC2440 = SomeOpenPGPRFCW RFC2440W
promoteOpenPGPRFC RFC4880 = SomeOpenPGPRFCW RFC4880W
promoteOpenPGPRFC RFC9580 = SomeOpenPGPRFCW 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 DeprecatedMD5W = DeprecatedMD5
demoteHashAlgorithmW SHA1W = SHA1
demoteHashAlgorithmW RIPEMD160W = RIPEMD160
demoteHashAlgorithmW SHA256W = SHA256
demoteHashAlgorithmW SHA384W = SHA384
demoteHashAlgorithmW SHA512W = SHA512
demoteHashAlgorithmW SHA224W = SHA224
demoteHashAlgorithmW SHA3_256W = SHA3_256
demoteHashAlgorithmW SHA3_512W = SHA3_512

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

signatureV6SaltSizeForHashAlgorithm :: HashAlgorithm -> Maybe Word8
signatureV6SaltSizeForHashAlgorithm SHA224 = Just 16
signatureV6SaltSizeForHashAlgorithm SHA256 = Just 16
signatureV6SaltSizeForHashAlgorithm SHA384 = Just 24
signatureV6SaltSizeForHashAlgorithm SHA512 = Just 32
signatureV6SaltSizeForHashAlgorithm SHA3_256 = Just 16
signatureV6SaltSizeForHashAlgorithm SHA3_512 = Just 32
signatureV6SaltSizeForHashAlgorithm _ = 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 (Eq, Show)

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

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

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

data VerificationDefaults = VerificationDefaults
  { verificationDefaultStrict :: 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.
    decryptAllowSEDNoIntegrity :: Bool
    -- | When 'False', receiving a SEIPDv1 (MDC-protected) packet is rejected.
    -- Defaults to 'True' for interoperability with RFC4880 senders.
  , decryptAllowSEIPDv1 :: Bool
    -- | Allowed symmetric algorithms for session keys.  'Nothing' means
    -- unrestricted.  The RFC9580 default restricts to AES-128/192/256.
  , decryptAllowedSymmetricAlgos :: Maybe [SymmetricAlgorithm]
    -- | Allowed AEAD algorithms for SEIPDv2 payloads.  'Nothing' means
    -- unrestricted.  The RFC9580 default allows EAX, OCB, and GCM.
  , decryptAllowedAEADAlgos :: Maybe [AEADAlgorithm]
    -- | When 'True' (RFC9580 default), reject SKESK packets that use Simple
    -- or Salted S2K specifiers (both deprecated since RFC9580).
  , 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').
  , 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.
  , decryptRejectESKVersionMismatch :: Bool
  } deriving (Eq, Show)

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

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

requireSalt8 :: String -> Salt -> Salt8
requireSalt8 context salt =
  case salt8FromSalt salt of
    Just salt8 -> salt8
    Nothing -> error (context ++ " requires an 8-octet salt")

requireSalt16 :: String -> Salt -> Salt16
requireSalt16 context salt =
  case salt16FromSalt salt of
    Just salt16 -> salt16
    Nothing -> error (context ++ " requires a 16-octet salt")

defaultPolicy :: OpenPGPPolicy
defaultPolicy = policyForRFC RFC9580

defaultPKESKVersionPolicy :: PKESKVersionPolicy
defaultPKESKVersionPolicy = PreferV6

defaultVerificationDefaults :: VerificationDefaults
defaultVerificationDefaults =
  VerificationDefaults
    { verificationDefaultStrict = True
    , verificationDefaultStreaming = 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
    { decryptAllowSEDNoIntegrity = False
    , decryptAllowSEIPDv1 = True
    , decryptAllowedSymmetricAlgos = Just [AES128, AES192, AES256]
    , decryptAllowedAEADAlgos = Just [EAX, OCB, GCM]
    , decryptRejectDeprecatedSKESK = True
    , decryptRejectTrailingData = True
    , decryptRejectESKVersionMismatch = True
    }

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

supportsSEIPDv2Symmetric :: OpenPGPPolicy -> SymmetricAlgorithm -> Bool
supportsSEIPDv2Symmetric policy sa =
  sa `elem` messageSEIPDv2SymmetricAlgorithms (policyMessageEncryption policy)

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

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

validateTable30PolicyForRecipient ::
     SomePKPayload -> HashAlgorithm -> SymmetricAlgorithm -> Either String ()
validateTable30PolicyForRecipient recipientPKP kdfHA kdfSA =
  case allowedTable30EcdhParameterSets recipientPKP (_pubkey recipientPKP) of
    Nothing -> Right ()
    Just (curveName, allowedParams) ->
      if (kdfHA, kdfSA) `elem` allowedParams
        then Right ()
        else
          Left
            ("RFC9580 Table 30 policy violation for " ++
             show (_keyVersion recipientPKP) ++
             " ECDH key on " ++
             curveName ++
             ": expected one of " ++
             show allowedParams ++
             ", got (" ++
             show kdfHA ++
             ", " ++
             show kdfSA ++
             ")")

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

legacySecretKeyProtectionErrorMessage :: String
legacySecretKeyProtectionErrorMessage =
  "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 = maybe False isAllowedPrimaryKeySigType . sigType

-- | RFC9580 §3.3: Subkey can only have SubkeyBindingSig or SubkeyRevocationSig
isAllowedSubkeySig :: SignaturePayload -> Bool
isAllowedSubkeySig = maybe False isAllowedSubkeySigType . sigType

-- | RFC9580 §3.4: User ID can only have various certification types or CertRevocationSig
isAllowedUIDSig :: SignaturePayload -> Bool
isAllowedUIDSig = maybe False isAllowedUIDSigType . sigType

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

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

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