-- Expirations.hs: OpenPGP (RFC9580) expiration checking
-- Copyright © 2014-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE GADTs #-}

module Codec.Encryption.OpenPGP.Expirations
    ( KeyState (..)
    , keyStateAt
    , effectiveKeyPreferencesAt
    , effectiveUIDPreferencesAt
    , effectiveKeyPreferencesAtTimestamp
    , effectiveUIDPreferencesAtTimestamp
    , isTKTimeValid
    , isPKTimeValidWithSelfSignatures
    , getKeyExpirationTimesFromSignature
    , isCertificationSig
    , signatureCreationTime
    , signatureExpirationTime
    , signatureExpirationDuration
    , firstSignatureExpirationDuration
    , signatureEffectiveAt
    , addDurationToTime
    , newestByCreationTime
    ) where

import Control.Error.Util (hush)
import Control.Lens ((&), (^.), _1)
import Data.List (maximumBy)
import Data.Maybe (listToMaybe, mapMaybe)
import Data.Ord (comparing)
import Data.Text (Text)
import Data.Time.Clock (UTCTime, addUTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)

import Codec.Encryption.OpenPGP.Fingerprint
    ( eightOctetKeyID
    , fingerprint
    )
import Codec.Encryption.OpenPGP.Internal (issuer, issuerFP)
import Codec.Encryption.OpenPGP.Ontology (isKET)
import Codec.Encryption.OpenPGP.SignatureQualities
    ( sigCT
    , sigType
    , signatureHashedSubpacketsKnown
    )
import Codec.Encryption.OpenPGP.Types
import Codec.Encryption.OpenPGP.Types.Internal.Pkt
    ( keyPktPKPayload
    )

data KeyState
    = KeyState
    { KeyState -> Bool
keyStateValid :: Bool
    , KeyState -> Bool
keyStateSelfSignaturesKnown :: Bool
    , KeyState -> Bool
keyStateHasEffectiveSelfSignature :: Bool
    , KeyState -> Maybe UTCTime
keyStateExpirationTime :: Maybe UTCTime
    }
    deriving (KeyState -> KeyState -> Bool
(KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> Bool) -> Eq KeyState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyState -> KeyState -> Bool
== :: KeyState -> KeyState -> Bool
$c/= :: KeyState -> KeyState -> Bool
/= :: KeyState -> KeyState -> Bool
Eq, Int -> KeyState -> ShowS
[KeyState] -> ShowS
KeyState -> String
(Int -> KeyState -> ShowS)
-> (KeyState -> String) -> ([KeyState] -> ShowS) -> Show KeyState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyState -> ShowS
showsPrec :: Int -> KeyState -> ShowS
$cshow :: KeyState -> String
show :: KeyState -> String
$cshowList :: [KeyState] -> ShowS
showList :: [KeyState] -> ShowS
Show)

-- this assumes that all key expiration time subpackets are valid
isTKTimeValid :: UTCTime -> TK k -> Bool
isTKTimeValid :: forall (k :: TKKind). UTCTime -> TK k -> Bool
isTKTimeValid UTCTime
ct = KeyState -> Bool
keyStateValid (KeyState -> Bool) -> (TK k -> KeyState) -> TK k -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> TK k -> KeyState
forall (k :: TKKind). UTCTime -> TK k -> KeyState
keyStateAt UTCTime
ct

keyStateAt :: UTCTime -> TK k -> KeyState
keyStateAt :: forall (k :: TKKind). UTCTime -> TK k -> KeyState
keyStateAt UTCTime
ct TK k
tk =
    KeyState
baseState
        { keyStateValid =
            keyStateValid baseState && bindingStateAllowsValidation
        }
  where
    baseState :: KeyState
baseState =
        UTCTime -> SomePKPayload -> [SignaturePayload] -> KeyState
keyStateFromSelfSignaturesAt
            UTCTime
ct
            (KeyPkt (TKKindToKeyPktKind k) -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload (TK k
tk TK k
-> Getting
     (KeyPkt (TKKindToKeyPktKind k))
     (TK k)
     (KeyPkt (TKKindToKeyPktKind k))
-> KeyPkt (TKKindToKeyPktKind k)
forall s a. s -> Getting a s a -> a
^. Getting
  (KeyPkt (TKKindToKeyPktKind k))
  (TK k)
  (KeyPkt (TKKindToKeyPktKind k))
forall (k :: TKKind) (f :: * -> *).
Functor f =>
(KeyPkt (TKKindToKeyPktKind k)
 -> f (KeyPkt (TKKindToKeyPktKind k)))
-> TK k -> f (TK k)
tkPrimaryKey))
            [SignaturePayload]
relevantSelfSignatures
    relevantSelfSignatures :: [SignaturePayload]
relevantSelfSignatures =
        (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter (SomePKPayload -> SignaturePayload -> Bool
isDirectKeySelfSigFor SomePKPayload
primaryKey) (TK k
tk TK k
-> Getting [SignaturePayload] (TK k) [SignaturePayload]
-> [SignaturePayload]
forall s a. s -> Getting a s a -> a
^. Getting [SignaturePayload] (TK k) [SignaturePayload]
forall (k :: TKKind) (f :: * -> *).
Functor f =>
([SignaturePayload] -> f [SignaturePayload]) -> TK k -> f (TK k)
tkRevs)
            [SignaturePayload] -> [SignaturePayload] -> [SignaturePayload]
forall a. [a] -> [a] -> [a]
++ (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter
                (SomePKPayload -> SignaturePayload -> Bool
isSelfCertificationFor SomePKPayload
primaryKey)
                (((Text, [SignaturePayload]) -> [SignaturePayload])
-> [(Text, [SignaturePayload])] -> [SignaturePayload]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, [SignaturePayload]) -> [SignaturePayload]
forall a b. (a, b) -> b
snd (TK k
tk TK k
-> Getting
     [(Text, [SignaturePayload])] (TK k) [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Text, [SignaturePayload])] (TK k) [(Text, [SignaturePayload])]
forall (k :: TKKind) (f :: * -> *).
Functor f =>
([(Text, [SignaturePayload])] -> f [(Text, [SignaturePayload])])
-> TK k -> f (TK k)
tkUIDs))
            [SignaturePayload] -> [SignaturePayload] -> [SignaturePayload]
forall a. [a] -> [a] -> [a]
++ (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter
                (SomePKPayload -> SignaturePayload -> Bool
isSelfCertificationFor SomePKPayload
primaryKey)
                ((([UserAttrSubPacket], [SignaturePayload]) -> [SignaturePayload])
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [SignaturePayload]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([UserAttrSubPacket], [SignaturePayload]) -> [SignaturePayload]
forall a b. (a, b) -> b
snd (TK k
tk TK k
-> Getting
     [([UserAttrSubPacket], [SignaturePayload])]
     (TK k)
     [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [([UserAttrSubPacket], [SignaturePayload])]
  (TK k)
  [([UserAttrSubPacket], [SignaturePayload])]
forall (k :: TKKind) (f :: * -> *).
Functor f =>
([([UserAttrSubPacket], [SignaturePayload])]
 -> f [([UserAttrSubPacket], [SignaturePayload])])
-> TK k -> f (TK k)
tkUAts))
    selfCertificationGroups :: [[SignaturePayload]]
selfCertificationGroups =
        ((Text, [SignaturePayload]) -> [SignaturePayload])
-> [(Text, [SignaturePayload])] -> [[SignaturePayload]]
forall a b. (a -> b) -> [a] -> [b]
map ((SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter (SomePKPayload -> SignaturePayload -> Bool
isSelfSignatureFor SomePKPayload
primaryKey) ([SignaturePayload] -> [SignaturePayload])
-> ((Text, [SignaturePayload]) -> [SignaturePayload])
-> (Text, [SignaturePayload])
-> [SignaturePayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [SignaturePayload]) -> [SignaturePayload]
forall a b. (a, b) -> b
snd) (TK k
tk TK k
-> Getting
     [(Text, [SignaturePayload])] (TK k) [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Text, [SignaturePayload])] (TK k) [(Text, [SignaturePayload])]
forall (k :: TKKind) (f :: * -> *).
Functor f =>
([(Text, [SignaturePayload])] -> f [(Text, [SignaturePayload])])
-> TK k -> f (TK k)
tkUIDs)
            [[SignaturePayload]]
-> [[SignaturePayload]] -> [[SignaturePayload]]
forall a. [a] -> [a] -> [a]
++ (([UserAttrSubPacket], [SignaturePayload]) -> [SignaturePayload])
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [[SignaturePayload]]
forall a b. (a -> b) -> [a] -> [b]
map ((SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter (SomePKPayload -> SignaturePayload -> Bool
isSelfSignatureFor SomePKPayload
primaryKey) ([SignaturePayload] -> [SignaturePayload])
-> (([UserAttrSubPacket], [SignaturePayload])
    -> [SignaturePayload])
-> ([UserAttrSubPacket], [SignaturePayload])
-> [SignaturePayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([UserAttrSubPacket], [SignaturePayload]) -> [SignaturePayload]
forall a b. (a, b) -> b
snd) (TK k
tk TK k
-> Getting
     [([UserAttrSubPacket], [SignaturePayload])]
     (TK k)
     [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [([UserAttrSubPacket], [SignaturePayload])]
  (TK k)
  [([UserAttrSubPacket], [SignaturePayload])]
forall (k :: TKKind) (f :: * -> *).
Functor f =>
([([UserAttrSubPacket], [SignaturePayload])]
 -> f [([UserAttrSubPacket], [SignaturePayload])])
-> TK k -> f (TK k)
tkUAts)
    hasAnySelfCertification :: Bool
hasAnySelfCertification = ([SignaturePayload] -> Bool) -> [[SignaturePayload]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((SignaturePayload -> Bool) -> [SignaturePayload] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any SignaturePayload -> Bool
isCertificationSig) [[SignaturePayload]]
selfCertificationGroups
    hasAnyActiveSelfCertification :: Bool
hasAnyActiveSelfCertification =
        ([SignaturePayload] -> Bool) -> [[SignaturePayload]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (UTCTime -> [SignaturePayload] -> Bool
selfCertificationGroupActiveAt UTCTime
ct) [[SignaturePayload]]
selfCertificationGroups
    bindingStateAllowsValidation :: Bool
bindingStateAllowsValidation =
        Bool -> Bool
not Bool
hasAnySelfCertification Bool -> Bool -> Bool
|| Bool
hasAnyActiveSelfCertification
    primaryKey :: SomePKPayload
primaryKey = KeyPkt (TKKindToKeyPktKind k) -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload (TK k
tk TK k
-> Getting
     (KeyPkt (TKKindToKeyPktKind k))
     (TK k)
     (KeyPkt (TKKindToKeyPktKind k))
-> KeyPkt (TKKindToKeyPktKind k)
forall s a. s -> Getting a s a -> a
^. Getting
  (KeyPkt (TKKindToKeyPktKind k))
  (TK k)
  (KeyPkt (TKKindToKeyPktKind k))
forall (k :: TKKind) (f :: * -> *).
Functor f =>
(KeyPkt (TKKindToKeyPktKind k)
 -> f (KeyPkt (TKKindToKeyPktKind k)))
-> TK k -> f (TK k)
tkPrimaryKey)

effectiveKeyPreferencesAt
    :: UTCTime -> TK k -> Maybe [SigSubPacketPayload]
effectiveKeyPreferencesAt :: forall (k :: TKKind).
UTCTime -> TK k -> Maybe [SigSubPacketPayload]
effectiveKeyPreferencesAt UTCTime
ct TK k
tk
    | Bool -> Bool
not (KeyState -> Bool
keyStateValid (UTCTime -> TK k -> KeyState
forall (k :: TKKind). UTCTime -> TK k -> KeyState
keyStateAt UTCTime
ct TK k
tk)) = Maybe [SigSubPacketPayload]
forall a. Maybe a
Nothing
    | Bool
otherwise = do
        sig <- UTCTime -> TK k -> Maybe SignaturePayload
forall (k :: TKKind). UTCTime -> TK k -> Maybe SignaturePayload
latestEffectivePreferenceCarrierAt UTCTime
ct TK k
tk
        let prefs = SignaturePayload -> [SigSubPacketPayload]
preferencePayloadsFromSignature SignaturePayload
sig
        if null prefs
            then Nothing
            else Just prefs

effectiveUIDPreferencesAt
    :: UTCTime -> Text -> TK k -> Maybe [SigSubPacketPayload]
effectiveUIDPreferencesAt :: forall (k :: TKKind).
UTCTime -> Text -> TK k -> Maybe [SigSubPacketPayload]
effectiveUIDPreferencesAt UTCTime
ct Text
uid TK k
tk
    | Bool -> Bool
not (KeyState -> Bool
keyStateValid (UTCTime -> TK k -> KeyState
forall (k :: TKKind). UTCTime -> TK k -> KeyState
keyStateAt UTCTime
ct TK k
tk)) = Maybe [SigSubPacketPayload]
forall a. Maybe a
Nothing
    | Bool
otherwise = do
        sigs <- Text -> [(Text, [SignaturePayload])] -> Maybe [SignaturePayload]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
uid (TK k
tk TK k
-> Getting
     [(Text, [SignaturePayload])] (TK k) [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Text, [SignaturePayload])] (TK k) [(Text, [SignaturePayload])]
forall (k :: TKKind) (f :: * -> *).
Functor f =>
([(Text, [SignaturePayload])] -> f [(Text, [SignaturePayload])])
-> TK k -> f (TK k)
tkUIDs)
        cert <-
            latestActiveSelfCertificationAt
                ct
                (filter (isSelfSignatureFor primaryKey) sigs)
        let prefs = SignaturePayload -> [SigSubPacketPayload]
preferencePayloadsFromSignature SignaturePayload
cert
        if null prefs
            then Nothing
            else Just prefs
  where
    primaryKey :: SomePKPayload
primaryKey = KeyPkt (TKKindToKeyPktKind k) -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload (TK k
tk TK k
-> Getting
     (KeyPkt (TKKindToKeyPktKind k))
     (TK k)
     (KeyPkt (TKKindToKeyPktKind k))
-> KeyPkt (TKKindToKeyPktKind k)
forall s a. s -> Getting a s a -> a
^. Getting
  (KeyPkt (TKKindToKeyPktKind k))
  (TK k)
  (KeyPkt (TKKindToKeyPktKind k))
forall (k :: TKKind) (f :: * -> *).
Functor f =>
(KeyPkt (TKKindToKeyPktKind k)
 -> f (KeyPkt (TKKindToKeyPktKind k)))
-> TK k -> f (TK k)
tkPrimaryKey)

effectiveKeyPreferencesAtTimestamp
    :: ThirtyTwoBitTimeStamp -> TK k -> Maybe [SigSubPacketPayload]
effectiveKeyPreferencesAtTimestamp :: forall (k :: TKKind).
ThirtyTwoBitTimeStamp -> TK k -> Maybe [SigSubPacketPayload]
effectiveKeyPreferencesAtTimestamp ThirtyTwoBitTimeStamp
ts =
    UTCTime -> TK k -> Maybe [SigSubPacketPayload]
forall (k :: TKKind).
UTCTime -> TK k -> Maybe [SigSubPacketPayload]
effectiveKeyPreferencesAt
        (NominalDiffTime -> UTCTime
posixSecondsToUTCTime (Word32 -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (ThirtyTwoBitTimeStamp -> Word32
unThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp
ts)))

effectiveUIDPreferencesAtTimestamp
    :: ThirtyTwoBitTimeStamp
    -> Text
    -> TK k
    -> Maybe [SigSubPacketPayload]
effectiveUIDPreferencesAtTimestamp :: forall (k :: TKKind).
ThirtyTwoBitTimeStamp
-> Text -> TK k -> Maybe [SigSubPacketPayload]
effectiveUIDPreferencesAtTimestamp ThirtyTwoBitTimeStamp
ts Text
uid =
    UTCTime -> Text -> TK k -> Maybe [SigSubPacketPayload]
forall (k :: TKKind).
UTCTime -> Text -> TK k -> Maybe [SigSubPacketPayload]
effectiveUIDPreferencesAt
        (NominalDiffTime -> UTCTime
posixSecondsToUTCTime (Word32 -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (ThirtyTwoBitTimeStamp -> Word32
unThirtyTwoBitTimeStamp ThirtyTwoBitTimeStamp
ts)))
        Text
uid

isPKTimeValidWithSelfSignatures
    :: UTCTime -> SomePKPayload -> [SignaturePayload] -> Bool
isPKTimeValidWithSelfSignatures :: UTCTime -> SomePKPayload -> [SignaturePayload] -> Bool
isPKTimeValidWithSelfSignatures UTCTime
ct SomePKPayload
pkp [SignaturePayload]
sigs =
    KeyState -> Bool
keyStateValid (UTCTime -> SomePKPayload -> [SignaturePayload] -> KeyState
keyStateFromSelfSignaturesAt UTCTime
ct SomePKPayload
pkp [SignaturePayload]
sigs)

keyStateFromSelfSignaturesAt
    :: UTCTime -> SomePKPayload -> [SignaturePayload] -> KeyState
keyStateFromSelfSignaturesAt :: UTCTime -> SomePKPayload -> [SignaturePayload] -> KeyState
keyStateFromSelfSignaturesAt UTCTime
ct SomePKPayload
pkp [SignaturePayload]
sigs =
    KeyState
        { keyStateValid :: Bool
keyStateValid =
            UTCTime
ct UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>= UTCTime
keyCreationTime
                Bool -> Bool -> Bool
&& Bool
selfSignatureStateAllowsValidation
                Bool -> Bool -> Bool
&& Bool -> (UTCTime -> Bool) -> Maybe UTCTime -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (UTCTime
ct UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<) Maybe UTCTime
keyExpirationTime
        , keyStateSelfSignaturesKnown :: Bool
keyStateSelfSignaturesKnown =
            Bool
-> (SignaturePayload -> Bool) -> Maybe SignaturePayload -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> SignaturePayload -> Bool
forall a b. a -> b -> a
const Bool
True) Maybe SignaturePayload
latestKnownSelfSignature
        , keyStateHasEffectiveSelfSignature :: Bool
keyStateHasEffectiveSelfSignature =
            Bool
-> (SignaturePayload -> Bool) -> Maybe SignaturePayload -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt UTCTime
ct) Maybe SignaturePayload
latestKnownSelfSignature
        , keyStateExpirationTime :: Maybe UTCTime
keyStateExpirationTime = Maybe UTCTime
keyExpirationTime
        }
  where
    keyCreationTime :: UTCTime
keyCreationTime = SomePKPayload -> ThirtyTwoBitTimeStamp
_timestamp SomePKPayload
pkp ThirtyTwoBitTimeStamp
-> (ThirtyTwoBitTimeStamp -> UTCTime) -> UTCTime
forall a b. a -> (a -> b) -> b
& NominalDiffTime -> UTCTime
posixSecondsToUTCTime (NominalDiffTime -> UTCTime)
-> (ThirtyTwoBitTimeStamp -> NominalDiffTime)
-> ThirtyTwoBitTimeStamp
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitTimeStamp -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac
    knownSelfSignatures :: [SignaturePayload]
knownSelfSignatures = (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter (UTCTime -> SignaturePayload -> Bool
signatureCreatedAtOrBefore UTCTime
ct) [SignaturePayload]
sigs
    selfSignatureStateAllowsValidation :: Bool
selfSignatureStateAllowsValidation =
        Bool
-> (SignaturePayload -> Bool) -> Maybe SignaturePayload -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            ([SignaturePayload] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SignaturePayload]
sigs)
            (UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt UTCTime
ct)
            Maybe SignaturePayload
latestKnownSelfSignature
    latestKnownSelfSignature :: Maybe SignaturePayload
latestKnownSelfSignature =
        (UTCTime, SignaturePayload) -> SignaturePayload
forall a b. (a, b) -> b
snd
            ((UTCTime, SignaturePayload) -> SignaturePayload)
-> Maybe (UTCTime, SignaturePayload) -> Maybe SignaturePayload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UTCTime, SignaturePayload)] -> Maybe (UTCTime, SignaturePayload)
forall a. [(UTCTime, a)] -> Maybe (UTCTime, a)
newestByCreationTime
                ([SignaturePayload] -> [(UTCTime, SignaturePayload)]
mapMaybeSignatureCreationTime [SignaturePayload]
knownSelfSignatures)
    keyExpirationTime :: Maybe UTCTime
keyExpirationTime = UTCTime -> SomePKPayload -> [SignaturePayload] -> Maybe UTCTime
effectiveKeyExpirationTime UTCTime
ct SomePKPayload
pkp [SignaturePayload]
sigs

effectiveKeyExpirationTime
    :: UTCTime -> SomePKPayload -> [SignaturePayload] -> Maybe UTCTime
effectiveKeyExpirationTime :: UTCTime -> SomePKPayload -> [SignaturePayload] -> Maybe UTCTime
effectiveKeyExpirationTime UTCTime
ct SomePKPayload
pkp [SignaturePayload]
sigs =
    SomePKPayload -> ThirtyTwoBitDuration -> Maybe UTCTime
signatureExpirationDurationToUTCTime SomePKPayload
pkp
        (ThirtyTwoBitDuration -> Maybe UTCTime)
-> Maybe ThirtyTwoBitDuration -> Maybe UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UTCTime -> [SignaturePayload] -> Maybe ThirtyTwoBitDuration
latestKnownExpirationDuration UTCTime
ct [SignaturePayload]
sigs

latestKnownExpirationDuration
    :: UTCTime -> [SignaturePayload] -> Maybe ThirtyTwoBitDuration
latestKnownExpirationDuration :: UTCTime -> [SignaturePayload] -> Maybe ThirtyTwoBitDuration
latestKnownExpirationDuration UTCTime
ct [SignaturePayload]
sigs =
    UTCTime -> SignaturePayload -> Maybe ThirtyTwoBitDuration
latestKnownSelfSignatureExpirationDuration UTCTime
ct
        (SignaturePayload -> Maybe ThirtyTwoBitDuration)
-> Maybe SignaturePayload -> Maybe ThirtyTwoBitDuration
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ( (UTCTime, SignaturePayload) -> SignaturePayload
forall a b. (a, b) -> b
snd
                ((UTCTime, SignaturePayload) -> SignaturePayload)
-> Maybe (UTCTime, SignaturePayload) -> Maybe SignaturePayload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UTCTime, SignaturePayload)] -> Maybe (UTCTime, SignaturePayload)
forall a. [(UTCTime, a)] -> Maybe (UTCTime, a)
newestByCreationTime
                    ( [SignaturePayload] -> [(UTCTime, SignaturePayload)]
mapMaybeSignatureCreationTime
                        ((SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter (UTCTime -> SignaturePayload -> Bool
signatureCreatedAtOrBefore UTCTime
ct) [SignaturePayload]
sigs)
                    )
            )

latestKnownSelfSignatureExpirationDuration
    :: UTCTime -> SignaturePayload -> Maybe ThirtyTwoBitDuration
latestKnownSelfSignatureExpirationDuration :: UTCTime -> SignaturePayload -> Maybe ThirtyTwoBitDuration
latestKnownSelfSignatureExpirationDuration UTCTime
ct SignaturePayload
sig
    | UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt UTCTime
ct SignaturePayload
sig =
        [ThirtyTwoBitDuration] -> Maybe ThirtyTwoBitDuration
forall a. [a] -> Maybe a
listToMaybe (SignaturePayload -> [ThirtyTwoBitDuration]
getKeyExpirationTimesFromSignature SignaturePayload
sig)
    | Bool
otherwise = Maybe ThirtyTwoBitDuration
forall a. Maybe a
Nothing

signatureEffectiveAt :: UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt :: UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt UTCTime
ct SignaturePayload
sig =
    Bool -> (UTCTime -> Bool) -> Maybe UTCTime -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
ct) (SignaturePayload -> Maybe UTCTime
signatureCreationTime SignaturePayload
sig)
        Bool -> Bool -> Bool
&& Bool -> (UTCTime -> Bool) -> Maybe UTCTime -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (UTCTime
ct UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<) (SignaturePayload -> Maybe UTCTime
signatureExpirationTime SignaturePayload
sig)

signatureCreatedAtOrBefore :: UTCTime -> SignaturePayload -> Bool
signatureCreatedAtOrBefore :: UTCTime -> SignaturePayload -> Bool
signatureCreatedAtOrBefore UTCTime
ct SignaturePayload
sig =
    Bool -> (UTCTime -> Bool) -> Maybe UTCTime -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
ct) (SignaturePayload -> Maybe UTCTime
signatureCreationTime SignaturePayload
sig)

signatureCreationTime :: SignaturePayload -> Maybe UTCTime
signatureCreationTime :: SignaturePayload -> Maybe UTCTime
signatureCreationTime =
    (ThirtyTwoBitTimeStamp -> UTCTime)
-> Maybe ThirtyTwoBitTimeStamp -> Maybe UTCTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (NominalDiffTime -> UTCTime
posixSecondsToUTCTime (NominalDiffTime -> UTCTime)
-> (ThirtyTwoBitTimeStamp -> NominalDiffTime)
-> ThirtyTwoBitTimeStamp
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Word32 -> NominalDiffTime)
-> (ThirtyTwoBitTimeStamp -> Word32)
-> ThirtyTwoBitTimeStamp
-> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitTimeStamp -> Word32
unThirtyTwoBitTimeStamp)
        (Maybe ThirtyTwoBitTimeStamp -> Maybe UTCTime)
-> (SignaturePayload -> Maybe ThirtyTwoBitTimeStamp)
-> SignaturePayload
-> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe ThirtyTwoBitTimeStamp
sigCT

signatureExpirationTime :: SignaturePayload -> Maybe UTCTime
signatureExpirationTime :: SignaturePayload -> Maybe UTCTime
signatureExpirationTime SignaturePayload
sig =
    UTCTime -> ThirtyTwoBitDuration -> UTCTime
addDurationToTime
        (UTCTime -> ThirtyTwoBitDuration -> UTCTime)
-> Maybe UTCTime -> Maybe (ThirtyTwoBitDuration -> UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SignaturePayload -> Maybe UTCTime
signatureCreationTime SignaturePayload
sig
        Maybe (ThirtyTwoBitDuration -> UTCTime)
-> Maybe ThirtyTwoBitDuration -> Maybe UTCTime
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SignaturePayload -> Maybe ThirtyTwoBitDuration
signatureExpirationDuration SignaturePayload
sig

signatureExpirationDuration
    :: SignaturePayload -> Maybe ThirtyTwoBitDuration
signatureExpirationDuration :: SignaturePayload -> Maybe ThirtyTwoBitDuration
signatureExpirationDuration SignaturePayload
sig =
    SignaturePayload -> Maybe [SigSubPacket]
signatureHashedSubpacketsKnown SignaturePayload
sig
        Maybe [SigSubPacket]
-> ([SigSubPacket] -> Maybe ThirtyTwoBitDuration)
-> Maybe ThirtyTwoBitDuration
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SigSubPacket] -> Maybe ThirtyTwoBitDuration
firstSignatureExpirationDuration

firstSignatureExpirationDuration
    :: [SigSubPacket] -> Maybe ThirtyTwoBitDuration
firstSignatureExpirationDuration :: [SigSubPacket] -> Maybe ThirtyTwoBitDuration
firstSignatureExpirationDuration =
    (SigSubPacket
 -> Maybe ThirtyTwoBitDuration -> Maybe ThirtyTwoBitDuration)
-> Maybe ThirtyTwoBitDuration
-> [SigSubPacket]
-> Maybe ThirtyTwoBitDuration
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
        ( \SigSubPacket
subpacket Maybe ThirtyTwoBitDuration
acc ->
            case SigSubPacket
subpacket of
                SigSubPacket Bool
_ (SigExpirationTime ThirtyTwoBitDuration
duration) -> ThirtyTwoBitDuration -> Maybe ThirtyTwoBitDuration
forall a. a -> Maybe a
Just ThirtyTwoBitDuration
duration
                SigSubPacket
_ -> Maybe ThirtyTwoBitDuration
acc
        )
        Maybe ThirtyTwoBitDuration
forall a. Maybe a
Nothing

signatureExpirationDurationToUTCTime
    :: SomePKPayload -> ThirtyTwoBitDuration -> Maybe UTCTime
signatureExpirationDurationToUTCTime :: SomePKPayload -> ThirtyTwoBitDuration -> Maybe UTCTime
signatureExpirationDurationToUTCTime SomePKPayload
_ (ThirtyTwoBitDuration Word32
0) = Maybe UTCTime
forall a. Maybe a
Nothing
signatureExpirationDurationToUTCTime SomePKPayload
pkp ThirtyTwoBitDuration
duration =
    UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> UTCTime -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$
        UTCTime -> ThirtyTwoBitDuration -> UTCTime
addDurationToTime
            (SomePKPayload -> ThirtyTwoBitTimeStamp
_timestamp SomePKPayload
pkp ThirtyTwoBitTimeStamp
-> (ThirtyTwoBitTimeStamp -> UTCTime) -> UTCTime
forall a b. a -> (a -> b) -> b
& NominalDiffTime -> UTCTime
posixSecondsToUTCTime (NominalDiffTime -> UTCTime)
-> (ThirtyTwoBitTimeStamp -> NominalDiffTime)
-> ThirtyTwoBitTimeStamp
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitTimeStamp -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac)
            ThirtyTwoBitDuration
duration

addDurationToTime :: UTCTime -> ThirtyTwoBitDuration -> UTCTime
addDurationToTime :: UTCTime -> ThirtyTwoBitDuration -> UTCTime
addDurationToTime UTCTime
baseTime ThirtyTwoBitDuration
duration =
    NominalDiffTime -> UTCTime -> UTCTime
addUTCTime
        (Word32 -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ThirtyTwoBitDuration -> Word32
unThirtyTwoBitDuration ThirtyTwoBitDuration
duration))
        UTCTime
baseTime

newestByCreationTime :: [(UTCTime, a)] -> Maybe (UTCTime, a)
newestByCreationTime :: forall a. [(UTCTime, a)] -> Maybe (UTCTime, a)
newestByCreationTime [] = Maybe (UTCTime, a)
forall a. Maybe a
Nothing
newestByCreationTime [(UTCTime, a)]
xs = (UTCTime, a) -> Maybe (UTCTime, a)
forall a. a -> Maybe a
Just (((UTCTime, a) -> (UTCTime, a) -> Ordering)
-> [(UTCTime, a)] -> (UTCTime, a)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((UTCTime, a) -> UTCTime)
-> (UTCTime, a) -> (UTCTime, a) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (UTCTime, a) -> UTCTime
forall a b. (a, b) -> a
fst) [(UTCTime, a)]
xs)

mapMaybeSignatureCreationTime
    :: [SignaturePayload] -> [(UTCTime, SignaturePayload)]
mapMaybeSignatureCreationTime :: [SignaturePayload] -> [(UTCTime, SignaturePayload)]
mapMaybeSignatureCreationTime =
    (SignaturePayload
 -> [(UTCTime, SignaturePayload)] -> [(UTCTime, SignaturePayload)])
-> [(UTCTime, SignaturePayload)]
-> [SignaturePayload]
-> [(UTCTime, SignaturePayload)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
        ( \SignaturePayload
sig [(UTCTime, SignaturePayload)]
acc ->
            case SignaturePayload -> Maybe UTCTime
signatureCreationTime SignaturePayload
sig of
                Just UTCTime
ct -> (UTCTime
ct, SignaturePayload
sig) (UTCTime, SignaturePayload)
-> [(UTCTime, SignaturePayload)] -> [(UTCTime, SignaturePayload)]
forall a. a -> [a] -> [a]
: [(UTCTime, SignaturePayload)]
acc
                Maybe UTCTime
Nothing -> [(UTCTime, SignaturePayload)]
acc
        )
        []

selfCertificationGroupActiveAt
    :: UTCTime -> [SignaturePayload] -> Bool
selfCertificationGroupActiveAt :: UTCTime -> [SignaturePayload] -> Bool
selfCertificationGroupActiveAt UTCTime
ct [SignaturePayload]
sigs =
    Bool
-> (SignaturePayload -> Bool) -> Maybe SignaturePayload -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Bool
False
        (Bool -> SignaturePayload -> Bool
forall a b. a -> b -> a
const Bool
True)
        (UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestActiveSelfCertificationAt UTCTime
ct [SignaturePayload]
sigs)

latestActiveSelfCertificationAt
    :: UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestActiveSelfCertificationAt :: UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestActiveSelfCertificationAt UTCTime
ct [SignaturePayload]
sigs =
    case Maybe SignaturePayload
latestKnownSelfCertification of
        Maybe SignaturePayload
Nothing -> Maybe SignaturePayload
forall a. Maybe a
Nothing
        Just SignaturePayload
certification ->
            if UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt UTCTime
ct SignaturePayload
certification
                Bool -> Bool -> Bool
&& Bool -> Bool
not
                    ( (SignaturePayload -> Bool) -> [SignaturePayload] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
                        (\SignaturePayload
revocation -> UTCTime -> SignaturePayload -> SignaturePayload -> Bool
revokesCertificationAt UTCTime
ct SignaturePayload
revocation SignaturePayload
certification)
                        [SignaturePayload]
certRevocations
                    )
                then SignaturePayload -> Maybe SignaturePayload
forall a. a -> Maybe a
Just SignaturePayload
certification
                else Maybe SignaturePayload
forall a. Maybe a
Nothing
  where
    latestKnownSelfCertification :: Maybe SignaturePayload
latestKnownSelfCertification =
        (UTCTime, SignaturePayload) -> SignaturePayload
forall a b. (a, b) -> b
snd
            ((UTCTime, SignaturePayload) -> SignaturePayload)
-> Maybe (UTCTime, SignaturePayload) -> Maybe SignaturePayload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UTCTime, SignaturePayload)] -> Maybe (UTCTime, SignaturePayload)
forall a. [(UTCTime, a)] -> Maybe (UTCTime, a)
newestByCreationTime
                ([SignaturePayload] -> [(UTCTime, SignaturePayload)]
mapMaybeSignatureCreationTime [SignaturePayload]
knownCertifications)
    knownCertifications :: [SignaturePayload]
knownCertifications =
        (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter
            ( \SignaturePayload
sig -> SignaturePayload -> Bool
isCertificationSig SignaturePayload
sig Bool -> Bool -> Bool
&& UTCTime -> SignaturePayload -> Bool
signatureCreatedAtOrBefore UTCTime
ct SignaturePayload
sig
            )
            [SignaturePayload]
sigs
    certRevocations :: [SignaturePayload]
certRevocations =
        (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter (\SignaturePayload
sig -> UTCTime -> SignaturePayload -> Bool
isCertRevocationForTime UTCTime
ct SignaturePayload
sig) [SignaturePayload]
sigs

latestEffectivePreferenceCarrierAt
    :: UTCTime -> TK k -> Maybe SignaturePayload
latestEffectivePreferenceCarrierAt :: forall (k :: TKKind). UTCTime -> TK k -> Maybe SignaturePayload
latestEffectivePreferenceCarrierAt UTCTime
ct TK k
tk =
    (UTCTime, SignaturePayload) -> SignaturePayload
forall a b. (a, b) -> b
snd
        ((UTCTime, SignaturePayload) -> SignaturePayload)
-> Maybe (UTCTime, SignaturePayload) -> Maybe SignaturePayload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UTCTime, SignaturePayload)] -> Maybe (UTCTime, SignaturePayload)
forall a. [(UTCTime, a)] -> Maybe (UTCTime, a)
newestByCreationTime ([SignaturePayload] -> [(UTCTime, SignaturePayload)]
mapMaybeSignatureCreationTime [SignaturePayload]
candidates)
  where
    primaryKey :: SomePKPayload
primaryKey = KeyPkt (TKKindToKeyPktKind k) -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload (TK k
tk TK k
-> Getting
     (KeyPkt (TKKindToKeyPktKind k))
     (TK k)
     (KeyPkt (TKKindToKeyPktKind k))
-> KeyPkt (TKKindToKeyPktKind k)
forall s a. s -> Getting a s a -> a
^. Getting
  (KeyPkt (TKKindToKeyPktKind k))
  (TK k)
  (KeyPkt (TKKindToKeyPktKind k))
forall (k :: TKKind) (f :: * -> *).
Functor f =>
(KeyPkt (TKKindToKeyPktKind k)
 -> f (KeyPkt (TKKindToKeyPktKind k)))
-> TK k -> f (TK k)
tkPrimaryKey)
    directKeySigs :: [SignaturePayload]
directKeySigs =
        (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter
            ( \SignaturePayload
sig ->
                SomePKPayload -> SignaturePayload -> Bool
isDirectKeySelfSigFor SomePKPayload
primaryKey SignaturePayload
sig
                    Bool -> Bool -> Bool
&& UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt UTCTime
ct SignaturePayload
sig
            )
            (TK k
tk TK k
-> Getting [SignaturePayload] (TK k) [SignaturePayload]
-> [SignaturePayload]
forall s a. s -> Getting a s a -> a
^. Getting [SignaturePayload] (TK k) [SignaturePayload]
forall (k :: TKKind) (f :: * -> *).
Functor f =>
([SignaturePayload] -> f [SignaturePayload]) -> TK k -> f (TK k)
tkRevs)
    uidSelfCerts :: [SignaturePayload]
uidSelfCerts =
        ((Text, [SignaturePayload]) -> Maybe SignaturePayload)
-> [(Text, [SignaturePayload])] -> [SignaturePayload]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
            ( UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestActiveSelfCertificationAt UTCTime
ct
                ([SignaturePayload] -> Maybe SignaturePayload)
-> ((Text, [SignaturePayload]) -> [SignaturePayload])
-> (Text, [SignaturePayload])
-> Maybe SignaturePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter (SomePKPayload -> SignaturePayload -> Bool
isSelfSignatureFor SomePKPayload
primaryKey)
                ([SignaturePayload] -> [SignaturePayload])
-> ((Text, [SignaturePayload]) -> [SignaturePayload])
-> (Text, [SignaturePayload])
-> [SignaturePayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [SignaturePayload]) -> [SignaturePayload]
forall a b. (a, b) -> b
snd
            )
            (TK k
tk TK k
-> Getting
     [(Text, [SignaturePayload])] (TK k) [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Text, [SignaturePayload])] (TK k) [(Text, [SignaturePayload])]
forall (k :: TKKind) (f :: * -> *).
Functor f =>
([(Text, [SignaturePayload])] -> f [(Text, [SignaturePayload])])
-> TK k -> f (TK k)
tkUIDs)
    uatSelfCerts :: [SignaturePayload]
uatSelfCerts =
        (([UserAttrSubPacket], [SignaturePayload])
 -> Maybe SignaturePayload)
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [SignaturePayload]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
            ( UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestActiveSelfCertificationAt UTCTime
ct
                ([SignaturePayload] -> Maybe SignaturePayload)
-> (([UserAttrSubPacket], [SignaturePayload])
    -> [SignaturePayload])
-> ([UserAttrSubPacket], [SignaturePayload])
-> Maybe SignaturePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter (SomePKPayload -> SignaturePayload -> Bool
isSelfSignatureFor SomePKPayload
primaryKey)
                ([SignaturePayload] -> [SignaturePayload])
-> (([UserAttrSubPacket], [SignaturePayload])
    -> [SignaturePayload])
-> ([UserAttrSubPacket], [SignaturePayload])
-> [SignaturePayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([UserAttrSubPacket], [SignaturePayload]) -> [SignaturePayload]
forall a b. (a, b) -> b
snd
            )
            (TK k
tk TK k
-> Getting
     [([UserAttrSubPacket], [SignaturePayload])]
     (TK k)
     [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [([UserAttrSubPacket], [SignaturePayload])]
  (TK k)
  [([UserAttrSubPacket], [SignaturePayload])]
forall (k :: TKKind) (f :: * -> *).
Functor f =>
([([UserAttrSubPacket], [SignaturePayload])]
 -> f [([UserAttrSubPacket], [SignaturePayload])])
-> TK k -> f (TK k)
tkUAts)
    candidates :: [SignaturePayload]
candidates = [SignaturePayload]
directKeySigs [SignaturePayload] -> [SignaturePayload] -> [SignaturePayload]
forall a. [a] -> [a] -> [a]
++ [SignaturePayload]
uidSelfCerts [SignaturePayload] -> [SignaturePayload] -> [SignaturePayload]
forall a. [a] -> [a] -> [a]
++ [SignaturePayload]
uatSelfCerts

preferencePayloadsFromSignature
    :: SignaturePayload -> [SigSubPacketPayload]
preferencePayloadsFromSignature :: SignaturePayload -> [SigSubPacketPayload]
preferencePayloadsFromSignature =
    (SigSubPacket -> SigSubPacketPayload)
-> [SigSubPacket] -> [SigSubPacketPayload]
forall a b. (a -> b) -> [a] -> [b]
map
        (\(SigSubPacket Bool
_ SigSubPacketPayload
payload) -> SigSubPacketPayload
payload)
        ([SigSubPacket] -> [SigSubPacketPayload])
-> (SignaturePayload -> [SigSubPacket])
-> SignaturePayload
-> [SigSubPacketPayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SigSubPacket -> Bool) -> [SigSubPacket] -> [SigSubPacket]
forall a. (a -> Bool) -> [a] -> [a]
filter SigSubPacket -> Bool
isPreferenceSubpacket
        ([SigSubPacket] -> [SigSubPacket])
-> (SignaturePayload -> [SigSubPacket])
-> SignaturePayload
-> [SigSubPacket]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> [SigSubPacket]
signatureHashedSubpackets

signatureHashedSubpackets :: SignaturePayload -> [SigSubPacket]
signatureHashedSubpackets :: SignaturePayload -> [SigSubPacket]
signatureHashedSubpackets SignaturePayload
sig =
    [SigSubPacket]
-> ([SigSubPacket] -> [SigSubPacket])
-> Maybe [SigSubPacket]
-> [SigSubPacket]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [SigSubPacket] -> [SigSubPacket]
forall a. a -> a
id (SignaturePayload -> Maybe [SigSubPacket]
signatureHashedSubpacketsKnown SignaturePayload
sig)

isPreferenceSubpacket :: SigSubPacket -> Bool
isPreferenceSubpacket :: SigSubPacket -> Bool
isPreferenceSubpacket (SigSubPacket Bool
_ (PreferredSymmetricAlgorithms [SymmetricAlgorithm]
_)) = Bool
True
isPreferenceSubpacket (SigSubPacket Bool
_ (PreferredHashAlgorithms [HashAlgorithm]
_)) = Bool
True
isPreferenceSubpacket (SigSubPacket Bool
_ (PreferredCompressionAlgorithms [CompressionAlgorithm]
_)) = Bool
True
isPreferenceSubpacket (SigSubPacket Bool
_ (KeyServerPreferences Set KSPFlag
_)) = Bool
True
isPreferenceSubpacket (SigSubPacket Bool
_ (PreferredKeyServer KeyServer
_)) = Bool
True
isPreferenceSubpacket (SigSubPacket Bool
_ (Features Set FeatureFlag
_)) = Bool
True
isPreferenceSubpacket (SigSubPacket Bool
_ (OtherSigSub Word8
subpacketType KeyServer
_)) =
    Word8
subpacketType Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
39
isPreferenceSubpacket SigSubPacket
_ = Bool
False

revokesCertificationAt
    :: UTCTime -> SignaturePayload -> SignaturePayload -> Bool
revokesCertificationAt :: UTCTime -> SignaturePayload -> SignaturePayload -> Bool
revokesCertificationAt UTCTime
ct SignaturePayload
revocation SignaturePayload
certification =
    UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt UTCTime
ct SignaturePayload
revocation
        Bool -> Bool -> Bool
&& case ( SignaturePayload -> Maybe UTCTime
signatureCreationTime SignaturePayload
certification
                , SignaturePayload -> Maybe UTCTime
signatureCreationTime SignaturePayload
revocation
                ) of
            (Just UTCTime
certificationTime, Just UTCTime
revocationTime) -> UTCTime
certificationTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
revocationTime
            (Maybe UTCTime, Maybe UTCTime)
_ -> Bool
False

isCertRevocationForTime :: UTCTime -> SignaturePayload -> Bool
isCertRevocationForTime :: UTCTime -> SignaturePayload -> Bool
isCertRevocationForTime UTCTime
ct SignaturePayload
sig =
    SignaturePayload -> Maybe SigType
sigType SignaturePayload
sig Maybe SigType -> Maybe SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
CertRevocationSig
        Bool -> Bool -> Bool
&& UTCTime -> SignaturePayload -> Bool
signatureCreatedAtOrBefore UTCTime
ct SignaturePayload
sig

isCertificationSig :: SignaturePayload -> Bool
isCertificationSig :: SignaturePayload -> Bool
isCertificationSig SignaturePayload
sig =
    SignaturePayload -> Maybe SigType
sigType SignaturePayload
sig
        Maybe SigType -> [Maybe SigType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
GenericCert
               , SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
PersonaCert
               , SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
CasualCert
               , SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
PositiveCert
               ]

isDirectKeySelfSigFor
    :: SomePKPayload -> SignaturePayload -> Bool
isDirectKeySelfSigFor :: SomePKPayload -> SignaturePayload -> Bool
isDirectKeySelfSigFor SomePKPayload
pkp SignaturePayload
sig =
    SignaturePayload -> Maybe SigType
sigType SignaturePayload
sig Maybe SigType -> Maybe SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
SignatureDirectlyOnAKey
        Bool -> Bool -> Bool
&& SomePKPayload -> SignaturePayload -> Bool
isSelfSignatureFor SomePKPayload
pkp SignaturePayload
sig

isSelfCertificationFor
    :: SomePKPayload -> SignaturePayload -> Bool
isSelfCertificationFor :: SomePKPayload -> SignaturePayload -> Bool
isSelfCertificationFor SomePKPayload
pkp SignaturePayload
sig =
    SignaturePayload -> Bool
isCertificationSig SignaturePayload
sig Bool -> Bool -> Bool
&& SomePKPayload -> SignaturePayload -> Bool
isSelfSignatureFor SomePKPayload
pkp SignaturePayload
sig

isSelfSignatureFor :: SomePKPayload -> SignaturePayload -> Bool
isSelfSignatureFor :: SomePKPayload -> SignaturePayload -> Bool
isSelfSignatureFor SomePKPayload
pkp SignaturePayload
sig =
    ( ((Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== SomePKPayload -> Fingerprint
fingerprint SomePKPayload
pkp) (Fingerprint -> Bool) -> Maybe Fingerprint -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pkt -> Maybe Fingerprint
issuerFP (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sig))
        Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    )
        Bool -> Bool -> Bool
|| ( (EightOctetKeyId -> EightOctetKeyId -> Bool
forall a. Eq a => a -> a -> Bool
(==) (EightOctetKeyId -> EightOctetKeyId -> Bool)
-> Maybe EightOctetKeyId -> Maybe (EightOctetKeyId -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pkt -> Maybe EightOctetKeyId
issuer (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sig) Maybe (EightOctetKeyId -> Bool)
-> Maybe EightOctetKeyId -> Maybe Bool
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String EightOctetKeyId -> Maybe EightOctetKeyId
forall a b. Either a b -> Maybe b
hush (SomePKPayload -> Either String EightOctetKeyId
eightOctetKeyID SomePKPayload
pkp))
                Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
           )

getKeyExpirationTimesFromSignature
    :: SignaturePayload -> [ThirtyTwoBitDuration]
getKeyExpirationTimesFromSignature :: SignaturePayload -> [ThirtyTwoBitDuration]
getKeyExpirationTimesFromSignature SignaturePayload
sig =
    (SigSubPacket -> ThirtyTwoBitDuration)
-> [SigSubPacket] -> [ThirtyTwoBitDuration]
forall a b. (a -> b) -> [a] -> [b]
map (\(SigSubPacket Bool
_ (KeyExpirationTime ThirtyTwoBitDuration
x)) -> ThirtyTwoBitDuration
x) ([SigSubPacket] -> [ThirtyTwoBitDuration])
-> [SigSubPacket] -> [ThirtyTwoBitDuration]
forall a b. (a -> b) -> a -> b
$
        (SigSubPacket -> Bool) -> [SigSubPacket] -> [SigSubPacket]
forall a. (a -> Bool) -> [a] -> [a]
filter SigSubPacket -> Bool
isKET (SignaturePayload -> [SigSubPacket]
signatureHashedSubpackets SignaturePayload
sig)