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

module Codec.Encryption.OpenPGP.Ontology
    ( -- * for signature payloads
      isCertRevocationSig
    , isRevokerP
    , isPKBindingSig
    , isSKBindingSig
    , isSubkeyBindingSig
    , isSubkeyRevocation
    , isTrustPkt

      -- * for signature subpackets
    , isCT
    , isIssuerSSP
    , isIssuerFPSSP
    , isKET
    , isKUF
    , isPHA
    , isRevocationKeySSP
    , isSigCreationTime
    ) where

import Control.Applicative ((<|>))
import Control.Lens (preview, _1)

import Codec.Encryption.OpenPGP.Types

{- | Test whether a 'SignaturePayload' has the given 'SigType'.
Returns 'False' for V3 and 'SigVOther' payloads; V3 signatures are excluded
from structural predicate checks since they lack subpacket support and are
not used in V4/V6 keyring contexts.
-}
isSigTypeFor :: SigType -> SignaturePayload -> Bool
isSigTypeFor :: SigType -> SignaturePayload -> Bool
isSigTypeFor SigType
expected SignaturePayload
sig =
    Bool -> (SigType -> Bool) -> Maybe SigType -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (SigType -> SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType
expected) (Maybe SigType -> Bool) -> Maybe SigType -> Bool
forall a b. (a -> b) -> a -> b
$
        Getting (First SigType) SignaturePayload SigType
-> SignaturePayload -> Maybe SigType
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (((SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
  [SigSubPacket], Word16, NonEmpty MPI)
 -> Const
      (First SigType)
      (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
       [SigSubPacket], Word16, NonEmpty MPI))
-> SignaturePayload -> Const (First SigType) SignaturePayload
Prism'
  SignaturePayload
  (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
   [SigSubPacket], Word16, NonEmpty MPI)
_SigV4 (((SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
   [SigSubPacket], Word16, NonEmpty MPI)
  -> Const
       (First SigType)
       (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
        [SigSubPacket], Word16, NonEmpty MPI))
 -> SignaturePayload -> Const (First SigType) SignaturePayload)
-> ((SigType -> Const (First SigType) SigType)
    -> (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
        [SigSubPacket], Word16, NonEmpty MPI)
    -> Const
         (First SigType)
         (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
          [SigSubPacket], Word16, NonEmpty MPI))
-> Getting (First SigType) SignaturePayload SigType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SigType -> Const (First SigType) SigType)
-> (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
    [SigSubPacket], Word16, NonEmpty MPI)
-> Const
     (First SigType)
     (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
      [SigSubPacket], Word16, NonEmpty MPI)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
   [SigSubPacket], Word16, NonEmpty MPI)
  (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
   [SigSubPacket], Word16, NonEmpty MPI)
  SigType
  SigType
_1) SignaturePayload
sig Maybe SigType -> Maybe SigType -> Maybe SigType
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Getting (First SigType) SignaturePayload SigType
-> SignaturePayload -> Maybe SigType
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (((SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
  [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI)
 -> Const
      (First SigType)
      (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
       [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI))
-> SignaturePayload -> Const (First SigType) SignaturePayload
Prism'
  SignaturePayload
  (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
   [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI)
_SigV6 (((SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
   [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI)
  -> Const
       (First SigType)
       (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
        [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI))
 -> SignaturePayload -> Const (First SigType) SignaturePayload)
-> ((SigType -> Const (First SigType) SigType)
    -> (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
        [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI)
    -> Const
         (First SigType)
         (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
          [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI))
-> Getting (First SigType) SignaturePayload SigType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SigType -> Const (First SigType) SigType)
-> (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
    [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI)
-> Const
     (First SigType)
     (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
      [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
   [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI)
  (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
   [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI)
  SigType
  SigType
_1) SignaturePayload
sig

isCertRevocationSig :: SignaturePayload -> Bool
isCertRevocationSig :: SignaturePayload -> Bool
isCertRevocationSig = SigType -> SignaturePayload -> Bool
isSigTypeFor SigType
CertRevocationSig

isRevokerP :: SignaturePayload -> Bool
isRevokerP :: SignaturePayload -> Bool
isRevokerP SignaturePayload
sig =
    case Getting
  (First
     (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
      [SigSubPacket], Word16, NonEmpty MPI))
  SignaturePayload
  (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
   [SigSubPacket], Word16, NonEmpty MPI)
-> SignaturePayload
-> Maybe
     (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
      [SigSubPacket], Word16, NonEmpty MPI)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting
  (First
     (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
      [SigSubPacket], Word16, NonEmpty MPI))
  SignaturePayload
  (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
   [SigSubPacket], Word16, NonEmpty MPI)
Prism'
  SignaturePayload
  (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
   [SigSubPacket], Word16, NonEmpty MPI)
_SigV4 SignaturePayload
sig of
        Just (SigType
st, PubKeyAlgorithm
_, HashAlgorithm
_, [SigSubPacket]
h, [SigSubPacket]
u, Word16
_, NonEmpty MPI
_) ->
            SigType
st SigType -> SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType
SignatureDirectlyOnAKey Bool -> Bool -> Bool
&& [SigSubPacket] -> [SigSubPacket] -> Bool
hasRevokerSubpackets [SigSubPacket]
h [SigSubPacket]
u
        Maybe
  (SigType, PubKeyAlgorithm, HashAlgorithm, [SigSubPacket],
   [SigSubPacket], Word16, NonEmpty MPI)
Nothing ->
            case Getting
  (First
     (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
      [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI))
  SignaturePayload
  (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
   [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI)
-> SignaturePayload
-> Maybe
     (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
      [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting
  (First
     (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
      [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI))
  SignaturePayload
  (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
   [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI)
Prism'
  SignaturePayload
  (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
   [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI)
_SigV6 SignaturePayload
sig of
                Just (SigType
st, PubKeyAlgorithm
_, HashAlgorithm
_, SignatureSalt
_, [SigSubPacket]
h, [SigSubPacket]
u, Word16
_, NonEmpty MPI
_) ->
                    SigType
st SigType -> SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType
SignatureDirectlyOnAKey Bool -> Bool -> Bool
&& [SigSubPacket] -> [SigSubPacket] -> Bool
hasRevokerSubpackets [SigSubPacket]
h [SigSubPacket]
u
                Maybe
  (SigType, PubKeyAlgorithm, HashAlgorithm, SignatureSalt,
   [SigSubPacket], [SigSubPacket], Word16, NonEmpty MPI)
Nothing -> Bool
False

hasRevokerSubpackets :: [SigSubPacket] -> [SigSubPacket] -> Bool
hasRevokerSubpackets :: [SigSubPacket] -> [SigSubPacket] -> Bool
hasRevokerSubpackets [SigSubPacket]
h [SigSubPacket]
u = (SigSubPacket -> Bool) -> [SigSubPacket] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any SigSubPacket -> Bool
isRevocationKeySSP [SigSubPacket]
h Bool -> Bool -> Bool
&& (SigSubPacket -> Bool) -> [SigSubPacket] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any SigSubPacket -> Bool
isIssuerSSP [SigSubPacket]
u

isPKBindingSig :: SignaturePayload -> Bool
isPKBindingSig :: SignaturePayload -> Bool
isPKBindingSig = SigType -> SignaturePayload -> Bool
isSigTypeFor SigType
PrimaryKeyBindingSig

isSKBindingSig :: SignaturePayload -> Bool
isSKBindingSig :: SignaturePayload -> Bool
isSKBindingSig = SigType -> SignaturePayload -> Bool
isSigTypeFor SigType
SubkeyBindingSig

isSubkeyRevocation :: SignaturePayload -> Bool
isSubkeyRevocation :: SignaturePayload -> Bool
isSubkeyRevocation = SigType -> SignaturePayload -> Bool
isSigTypeFor SigType
SubkeyRevocationSig

isSubkeyBindingSig :: SignaturePayload -> Bool
isSubkeyBindingSig :: SignaturePayload -> Bool
isSubkeyBindingSig = SigType -> SignaturePayload -> Bool
isSigTypeFor SigType
SubkeyBindingSig

isTrustPkt :: Pkt -> Bool
isTrustPkt :: Pkt -> Bool
isTrustPkt (TrustPkt ByteString
_) = Bool
True
isTrustPkt Pkt
_ = Bool
False

isCT :: SigSubPacket -> Bool
isCT :: SigSubPacket -> Bool
isCT (SigSubPacket Bool
_ (SigCreationTime ThirtyTwoBitTimeStamp
_)) = Bool
True
isCT SigSubPacket
_ = Bool
False

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

isIssuerFPSSP :: SigSubPacket -> Bool
isIssuerFPSSP :: SigSubPacket -> Bool
isIssuerFPSSP (SigSubPacket Bool
_ (IssuerFingerprint IssuerFingerprintVersion
_ Fingerprint
_)) = Bool
True
isIssuerFPSSP SigSubPacket
_ = Bool
False

isKET :: SigSubPacket -> Bool
isKET :: SigSubPacket -> Bool
isKET (SigSubPacket Bool
_ (KeyExpirationTime ThirtyTwoBitDuration
_)) = Bool
True
isKET SigSubPacket
_ = Bool
False

isKUF :: SigSubPacket -> Bool
isKUF :: SigSubPacket -> Bool
isKUF (SigSubPacket Bool
_ (KeyFlags Set KeyFlag
_)) = Bool
True
isKUF SigSubPacket
_ = Bool
False

isPHA :: SigSubPacket -> Bool
isPHA :: SigSubPacket -> Bool
isPHA (SigSubPacket Bool
_ (PreferredHashAlgorithms [HashAlgorithm]
_)) = Bool
True
isPHA SigSubPacket
_ = Bool
False

isRevocationKeySSP :: SigSubPacket -> Bool
isRevocationKeySSP :: SigSubPacket -> Bool
isRevocationKeySSP (SigSubPacket Bool
_ RevocationKey {}) = Bool
True
isRevocationKeySSP SigSubPacket
_ = Bool
False

isSigCreationTime :: SigSubPacket -> Bool
isSigCreationTime :: SigSubPacket -> Bool
isSigCreationTime (SigSubPacket Bool
_ (SigCreationTime ThirtyTwoBitTimeStamp
_)) = Bool
True
isSigCreationTime SigSubPacket
_ = Bool
False