-- 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

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 -> TKUnknown -> Bool
isTKTimeValid :: UTCTime -> TKUnknown -> Bool
isTKTimeValid UTCTime
ct = KeyState -> Bool
keyStateValid (KeyState -> Bool) -> (TKUnknown -> KeyState) -> TKUnknown -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> TKUnknown -> KeyState
keyStateAt UTCTime
ct

keyStateAt :: UTCTime -> TKUnknown -> KeyState
keyStateAt :: UTCTime -> TKUnknown -> KeyState
keyStateAt UTCTime
ct TKUnknown
tk =
  KeyState
baseState {keyStateValid = keyStateValid baseState && bindingStateAllowsValidation}
  where
    baseState :: KeyState
baseState =
      UTCTime -> SomePKPayload -> [SignaturePayload] -> KeyState
keyStateFromSelfSignaturesAt UTCTime
ct (TKUnknown
tk TKUnknown
-> Getting SomePKPayload TKUnknown SomePKPayload -> SomePKPayload
forall s a. s -> Getting a s a -> a
^. ((SomePKPayload, Maybe SKAddendum)
 -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> TKUnknown -> Const SomePKPayload TKUnknown
Lens' TKUnknown (SomePKPayload, Maybe SKAddendum)
tkuKey (((SomePKPayload, Maybe SKAddendum)
  -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
 -> TKUnknown -> Const SomePKPayload TKUnknown)
-> ((SomePKPayload -> Const SomePKPayload SomePKPayload)
    -> (SomePKPayload, Maybe SKAddendum)
    -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> Getting SomePKPayload TKUnknown SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomePKPayload -> Const SomePKPayload SomePKPayload)
-> (SomePKPayload, Maybe SKAddendum)
-> Const SomePKPayload (SomePKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (SomePKPayload, Maybe SKAddendum)
  (SomePKPayload, Maybe SKAddendum)
  SomePKPayload
  SomePKPayload
_1) [SignaturePayload]
relevantSelfSignatures
    relevantSelfSignatures :: [SignaturePayload]
relevantSelfSignatures =
      (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter (SomePKPayload -> SignaturePayload -> Bool
isDirectKeySelfSigFor SomePKPayload
primaryKey) (TKUnknown
tk TKUnknown
-> Getting [SignaturePayload] TKUnknown [SignaturePayload]
-> [SignaturePayload]
forall s a. s -> Getting a s a -> a
^. Getting [SignaturePayload] TKUnknown [SignaturePayload]
Lens' TKUnknown [SignaturePayload]
tkuRevs) [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 (TKUnknown
tk TKUnknown
-> Getting
     [(Text, [SignaturePayload])] TKUnknown [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Text, [SignaturePayload])] TKUnknown [(Text, [SignaturePayload])]
Lens' TKUnknown [(Text, [SignaturePayload])]
tkuUIDs)) [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 (TKUnknown
tk TKUnknown
-> Getting
     [([UserAttrSubPacket], [SignaturePayload])]
     TKUnknown
     [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [([UserAttrSubPacket], [SignaturePayload])]
  TKUnknown
  [([UserAttrSubPacket], [SignaturePayload])]
Lens' TKUnknown [([UserAttrSubPacket], [SignaturePayload])]
tkuUAts))
    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) (TKUnknown
tk TKUnknown
-> Getting
     [(Text, [SignaturePayload])] TKUnknown [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Text, [SignaturePayload])] TKUnknown [(Text, [SignaturePayload])]
Lens' TKUnknown [(Text, [SignaturePayload])]
tkuUIDs) [[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) (TKUnknown
tk TKUnknown
-> Getting
     [([UserAttrSubPacket], [SignaturePayload])]
     TKUnknown
     [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [([UserAttrSubPacket], [SignaturePayload])]
  TKUnknown
  [([UserAttrSubPacket], [SignaturePayload])]
Lens' TKUnknown [([UserAttrSubPacket], [SignaturePayload])]
tkuUAts)
    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 = TKUnknown
tk TKUnknown
-> Getting SomePKPayload TKUnknown SomePKPayload -> SomePKPayload
forall s a. s -> Getting a s a -> a
^. ((SomePKPayload, Maybe SKAddendum)
 -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> TKUnknown -> Const SomePKPayload TKUnknown
Lens' TKUnknown (SomePKPayload, Maybe SKAddendum)
tkuKey (((SomePKPayload, Maybe SKAddendum)
  -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
 -> TKUnknown -> Const SomePKPayload TKUnknown)
-> ((SomePKPayload -> Const SomePKPayload SomePKPayload)
    -> (SomePKPayload, Maybe SKAddendum)
    -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> Getting SomePKPayload TKUnknown SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomePKPayload -> Const SomePKPayload SomePKPayload)
-> (SomePKPayload, Maybe SKAddendum)
-> Const SomePKPayload (SomePKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (SomePKPayload, Maybe SKAddendum)
  (SomePKPayload, Maybe SKAddendum)
  SomePKPayload
  SomePKPayload
_1

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

effectiveUIDPreferencesAt :: UTCTime -> Text -> TKUnknown -> Maybe [SigSubPacketPayload]
effectiveUIDPreferencesAt :: UTCTime -> Text -> TKUnknown -> Maybe [SigSubPacketPayload]
effectiveUIDPreferencesAt UTCTime
ct Text
uid TKUnknown
tk
  | Bool -> Bool
not (KeyState -> Bool
keyStateValid (UTCTime -> TKUnknown -> KeyState
keyStateAt UTCTime
ct TKUnknown
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 (TKUnknown
tk TKUnknown
-> Getting
     [(Text, [SignaturePayload])] TKUnknown [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Text, [SignaturePayload])] TKUnknown [(Text, [SignaturePayload])]
Lens' TKUnknown [(Text, [SignaturePayload])]
tkuUIDs)
      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 = TKUnknown
tk TKUnknown
-> Getting SomePKPayload TKUnknown SomePKPayload -> SomePKPayload
forall s a. s -> Getting a s a -> a
^. ((SomePKPayload, Maybe SKAddendum)
 -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> TKUnknown -> Const SomePKPayload TKUnknown
Lens' TKUnknown (SomePKPayload, Maybe SKAddendum)
tkuKey (((SomePKPayload, Maybe SKAddendum)
  -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
 -> TKUnknown -> Const SomePKPayload TKUnknown)
-> ((SomePKPayload -> Const SomePKPayload SomePKPayload)
    -> (SomePKPayload, Maybe SKAddendum)
    -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> Getting SomePKPayload TKUnknown SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomePKPayload -> Const SomePKPayload SomePKPayload)
-> (SomePKPayload, Maybe SKAddendum)
-> Const SomePKPayload (SomePKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (SomePKPayload, Maybe SKAddendum)
  (SomePKPayload, Maybe SKAddendum)
  SomePKPayload
  SomePKPayload
_1

effectiveKeyPreferencesAtTimestamp ::
     ThirtyTwoBitTimeStamp -> TKUnknown -> Maybe [SigSubPacketPayload]
effectiveKeyPreferencesAtTimestamp :: ThirtyTwoBitTimeStamp -> TKUnknown -> Maybe [SigSubPacketPayload]
effectiveKeyPreferencesAtTimestamp ThirtyTwoBitTimeStamp
ts =
  UTCTime -> TKUnknown -> 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 -> TKUnknown -> Maybe [SigSubPacketPayload]
effectiveUIDPreferencesAtTimestamp :: ThirtyTwoBitTimeStamp
-> Text -> TKUnknown -> Maybe [SigSubPacketPayload]
effectiveUIDPreferencesAtTimestamp ThirtyTwoBitTimeStamp
ts Text
uid =
  UTCTime -> Text -> TKUnknown -> 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 -> TKUnknown -> Maybe SignaturePayload
latestEffectivePreferenceCarrierAt :: UTCTime -> TKUnknown -> Maybe SignaturePayload
latestEffectivePreferenceCarrierAt UTCTime
ct TKUnknown
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 = TKUnknown
tk TKUnknown
-> Getting SomePKPayload TKUnknown SomePKPayload -> SomePKPayload
forall s a. s -> Getting a s a -> a
^. ((SomePKPayload, Maybe SKAddendum)
 -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> TKUnknown -> Const SomePKPayload TKUnknown
Lens' TKUnknown (SomePKPayload, Maybe SKAddendum)
tkuKey (((SomePKPayload, Maybe SKAddendum)
  -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
 -> TKUnknown -> Const SomePKPayload TKUnknown)
-> ((SomePKPayload -> Const SomePKPayload SomePKPayload)
    -> (SomePKPayload, Maybe SKAddendum)
    -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> Getting SomePKPayload TKUnknown SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomePKPayload -> Const SomePKPayload SomePKPayload)
-> (SomePKPayload, Maybe SKAddendum)
-> Const SomePKPayload (SomePKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (SomePKPayload, Maybe SKAddendum)
  (SomePKPayload, Maybe SKAddendum)
  SomePKPayload
  SomePKPayload
_1
    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)
        (TKUnknown
tk TKUnknown
-> Getting [SignaturePayload] TKUnknown [SignaturePayload]
-> [SignaturePayload]
forall s a. s -> Getting a s a -> a
^. Getting [SignaturePayload] TKUnknown [SignaturePayload]
Lens' TKUnknown [SignaturePayload]
tkuRevs)
    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)
        (TKUnknown
tk TKUnknown
-> Getting
     [(Text, [SignaturePayload])] TKUnknown [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Text, [SignaturePayload])] TKUnknown [(Text, [SignaturePayload])]
Lens' TKUnknown [(Text, [SignaturePayload])]
tkuUIDs)
    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)
        (TKUnknown
tk TKUnknown
-> Getting
     [([UserAttrSubPacket], [SignaturePayload])]
     TKUnknown
     [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [([UserAttrSubPacket], [SignaturePayload])]
  TKUnknown
  [([UserAttrSubPacket], [SignaturePayload])]
Lens' TKUnknown [([UserAttrSubPacket], [SignaturePayload])]
tkuUAts)
    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)