-- Keyring.hs: OpenPGP (RFC9580) transferable keys parsing
-- Copyright © 2012-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}

module Data.Conduit.OpenPGP.Keyring
    ( TypedTKConduitError (..)
    , conduitToSomeTKsEither
    , conduitToSomeTKsDroppingEither
    , AuthSecretSubkeyUID (..)
    , AuthSecretSubkeyAtTime (..)
    , AuthSecretSubkeyRejectionReason (..)
    , AuthSecretSubkeyRejectedAtTime (..)
    , AuthSecretSubkeysAtReport (..)
    , authSecretSubkeysAt
    , authSecretSubkeysAtReport
    , conduitToAuthSecretSubkeysAt
    , conduitToAuthSecretSubkeysAtReport
    , conduitToTKsEither
    , conduitToTKsDroppingEither
    , conduitToTKsWithWireRepEither
    , conduitToTKsDroppingWithWireRepEither
    , conduitDropErrorsAndNothings
    , KeyringChunkParseError (..)
    , sinkPublicKeyringMap
    , sinkSecretKeyringMap
    , publicTKToKeyring
    , secretTKToKeyring
    , partitionSomeTKs
    ) where

import Control.Error.Util (hush)
import Control.Lens ((^.))
import Control.Monad (join)
import Data.Bifunctor (first)
import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.IxSet.Typed (empty, insert)
import Data.List (find)
import Data.Maybe (mapMaybe, maybeToList)
import qualified Data.Set as Set
import Data.Text (Text)
import Data.Time.Clock (UTCTime)

import Codec.Encryption.OpenPGP.Expirations
    ( isCertificationSig
    , isPKTimeValidWithSelfSignatures
    , isTKTimeValid
    , newestByCreationTime
    , signatureCreationTime
    , signatureEffectiveAt
    )
import Codec.Encryption.OpenPGP.KeyringParser
    ( KeyringChunkParseError (..)
    , anyTK
    , anyTKWithWireRep
    , finalizeParsingEither
    , parseAChunkEither
    )
import Codec.Encryption.OpenPGP.Ontology
    ( isSubkeyBindingSig
    , isTrustPkt
    )
import Codec.Encryption.OpenPGP.Policy
    ( defaultVerificationPolicy
    )
import Codec.Encryption.OpenPGP.SignatureQualities
    ( signatureHashedSubpacketsKnown
    )
import Codec.Encryption.OpenPGP.Signatures
    ( verifyAgainstKeys
    , verifySigWith
    , verifyTKWith
    )
import Codec.Encryption.OpenPGP.Types
import Data.Conduit.OpenPGP.Keyring.Instances ()

data Phase
    = MainKey
    | Revs
    | Uids
    | UAts
    | Subs
    | SkippingBroken
    deriving (Phase -> Phase -> Bool
(Phase -> Phase -> Bool) -> (Phase -> Phase -> Bool) -> Eq Phase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Phase -> Phase -> Bool
== :: Phase -> Phase -> Bool
$c/= :: Phase -> Phase -> Bool
/= :: Phase -> Phase -> Bool
Eq, Eq Phase
Eq Phase =>
(Phase -> Phase -> Ordering)
-> (Phase -> Phase -> Bool)
-> (Phase -> Phase -> Bool)
-> (Phase -> Phase -> Bool)
-> (Phase -> Phase -> Bool)
-> (Phase -> Phase -> Phase)
-> (Phase -> Phase -> Phase)
-> Ord Phase
Phase -> Phase -> Bool
Phase -> Phase -> Ordering
Phase -> Phase -> Phase
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Phase -> Phase -> Ordering
compare :: Phase -> Phase -> Ordering
$c< :: Phase -> Phase -> Bool
< :: Phase -> Phase -> Bool
$c<= :: Phase -> Phase -> Bool
<= :: Phase -> Phase -> Bool
$c> :: Phase -> Phase -> Bool
> :: Phase -> Phase -> Bool
$c>= :: Phase -> Phase -> Bool
>= :: Phase -> Phase -> Bool
$cmax :: Phase -> Phase -> Phase
max :: Phase -> Phase -> Phase
$cmin :: Phase -> Phase -> Phase
min :: Phase -> Phase -> Phase
Ord, Int -> Phase -> ShowS
[Phase] -> ShowS
Phase -> String
(Int -> Phase -> ShowS)
-> (Phase -> String) -> ([Phase] -> ShowS) -> Show Phase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Phase -> ShowS
showsPrec :: Int -> Phase -> ShowS
$cshow :: Phase -> String
show :: Phase -> String
$cshowList :: [Phase] -> ShowS
showList :: [Phase] -> ShowS
Show)

data TypedTKConduitError
    = TypedTKParseError KeyringChunkParseError
    | TypedTKConversionError TKConversionError
    deriving (TypedTKConduitError -> TypedTKConduitError -> Bool
(TypedTKConduitError -> TypedTKConduitError -> Bool)
-> (TypedTKConduitError -> TypedTKConduitError -> Bool)
-> Eq TypedTKConduitError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypedTKConduitError -> TypedTKConduitError -> Bool
== :: TypedTKConduitError -> TypedTKConduitError -> Bool
$c/= :: TypedTKConduitError -> TypedTKConduitError -> Bool
/= :: TypedTKConduitError -> TypedTKConduitError -> Bool
Eq, Int -> TypedTKConduitError -> ShowS
[TypedTKConduitError] -> ShowS
TypedTKConduitError -> String
(Int -> TypedTKConduitError -> ShowS)
-> (TypedTKConduitError -> String)
-> ([TypedTKConduitError] -> ShowS)
-> Show TypedTKConduitError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypedTKConduitError -> ShowS
showsPrec :: Int -> TypedTKConduitError -> ShowS
$cshow :: TypedTKConduitError -> String
show :: TypedTKConduitError -> String
$cshowList :: [TypedTKConduitError] -> ShowS
showList :: [TypedTKConduitError] -> ShowS
Show)

-- | Canonical strict typed conduit with explicit parse+conversion error channel.
conduitToSomeTKsEither
    :: (Monad m)
    => ConduitT Pkt (Either TypedTKConduitError (Maybe SomeTK)) m ()
conduitToSomeTKsEither :: forall (m :: * -> *).
Monad m =>
ConduitT Pkt (Either TypedTKConduitError (Maybe SomeTK)) m ()
conduitToSomeTKsEither =
    ConduitT Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
forall (m :: * -> *).
Monad m =>
ConduitT Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
conduitToTKsEither
        ConduitT Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
-> ConduitT
     (Either KeyringChunkParseError (Maybe TKUnknown))
     (Either TypedTKConduitError (Maybe SomeTK))
     m
     ()
-> ConduitT Pkt (Either TypedTKConduitError (Maybe SomeTK)) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Either KeyringChunkParseError (Maybe TKUnknown)
 -> Either TypedTKConduitError (Maybe SomeTK))
-> ConduitT
     (Either KeyringChunkParseError (Maybe TKUnknown))
     (Either TypedTKConduitError (Maybe SomeTK))
     m
     ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map Either KeyringChunkParseError (Maybe TKUnknown)
-> Either TypedTKConduitError (Maybe SomeTK)
toTypedSomeTKEither

{- | Tolerant typed conduit (broken transferable-key chunks may be omitted),
while still surfacing parse+conversion failures.
-}
conduitToSomeTKsDroppingEither
    :: (Monad m)
    => ConduitT Pkt (Either TypedTKConduitError (Maybe SomeTK)) m ()
conduitToSomeTKsDroppingEither :: forall (m :: * -> *).
Monad m =>
ConduitT Pkt (Either TypedTKConduitError (Maybe SomeTK)) m ()
conduitToSomeTKsDroppingEither =
    ConduitT Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
forall (m :: * -> *).
Monad m =>
ConduitT Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
conduitToTKsDroppingEither
        ConduitT Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
-> ConduitT
     (Either KeyringChunkParseError (Maybe TKUnknown))
     (Either TypedTKConduitError (Maybe SomeTK))
     m
     ()
-> ConduitT Pkt (Either TypedTKConduitError (Maybe SomeTK)) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Either KeyringChunkParseError (Maybe TKUnknown)
 -> Either TypedTKConduitError (Maybe SomeTK))
-> ConduitT
     (Either KeyringChunkParseError (Maybe TKUnknown))
     (Either TypedTKConduitError (Maybe SomeTK))
     m
     ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map Either KeyringChunkParseError (Maybe TKUnknown)
-> Either TypedTKConduitError (Maybe SomeTK)
toTypedSomeTKEither

toTypedSomeTKEither
    :: Either KeyringChunkParseError (Maybe TKUnknown)
    -> Either TypedTKConduitError (Maybe SomeTK)
toTypedSomeTKEither :: Either KeyringChunkParseError (Maybe TKUnknown)
-> Either TypedTKConduitError (Maybe SomeTK)
toTypedSomeTKEither =
    (KeyringChunkParseError
 -> Either TypedTKConduitError (Maybe SomeTK))
-> (Maybe TKUnknown -> Either TypedTKConduitError (Maybe SomeTK))
-> Either KeyringChunkParseError (Maybe TKUnknown)
-> Either TypedTKConduitError (Maybe SomeTK)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (TypedTKConduitError -> Either TypedTKConduitError (Maybe SomeTK)
forall a b. a -> Either a b
Left (TypedTKConduitError -> Either TypedTKConduitError (Maybe SomeTK))
-> (KeyringChunkParseError -> TypedTKConduitError)
-> KeyringChunkParseError
-> Either TypedTKConduitError (Maybe SomeTK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyringChunkParseError -> TypedTKConduitError
TypedTKParseError)
        ( \Maybe TKUnknown
maybeUnknown ->
            case Maybe TKUnknown
maybeUnknown of
                Maybe TKUnknown
Nothing -> Maybe SomeTK -> Either TypedTKConduitError (Maybe SomeTK)
forall a b. b -> Either a b
Right Maybe SomeTK
forall a. Maybe a
Nothing
                Just TKUnknown
unknown ->
                    (TKConversionError -> TypedTKConduitError)
-> Either TKConversionError (Maybe SomeTK)
-> Either TypedTKConduitError (Maybe SomeTK)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
                        TKConversionError -> TypedTKConduitError
TypedTKConversionError
                        (SomeTK -> Maybe SomeTK
forall a. a -> Maybe a
Just (SomeTK -> Maybe SomeTK)
-> Either TKConversionError SomeTK
-> Either TKConversionError (Maybe SomeTK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TKUnknown -> Either TKConversionError SomeTK
fromUnknownToTKEither TKUnknown
unknown)
        )

data AuthSecretSubkeyUID
    = AuthSecretSubkeyUID
    { AuthSecretSubkeyUID -> Text
authSecretSubkeyUIDValue :: Text
    , AuthSecretSubkeyUID -> Bool
authSecretSubkeyUIDIsPrimary :: Bool
    }
    deriving (AuthSecretSubkeyUID -> AuthSecretSubkeyUID -> Bool
(AuthSecretSubkeyUID -> AuthSecretSubkeyUID -> Bool)
-> (AuthSecretSubkeyUID -> AuthSecretSubkeyUID -> Bool)
-> Eq AuthSecretSubkeyUID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthSecretSubkeyUID -> AuthSecretSubkeyUID -> Bool
== :: AuthSecretSubkeyUID -> AuthSecretSubkeyUID -> Bool
$c/= :: AuthSecretSubkeyUID -> AuthSecretSubkeyUID -> Bool
/= :: AuthSecretSubkeyUID -> AuthSecretSubkeyUID -> Bool
Eq, Int -> AuthSecretSubkeyUID -> ShowS
[AuthSecretSubkeyUID] -> ShowS
AuthSecretSubkeyUID -> String
(Int -> AuthSecretSubkeyUID -> ShowS)
-> (AuthSecretSubkeyUID -> String)
-> ([AuthSecretSubkeyUID] -> ShowS)
-> Show AuthSecretSubkeyUID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthSecretSubkeyUID -> ShowS
showsPrec :: Int -> AuthSecretSubkeyUID -> ShowS
$cshow :: AuthSecretSubkeyUID -> String
show :: AuthSecretSubkeyUID -> String
$cshowList :: [AuthSecretSubkeyUID] -> ShowS
showList :: [AuthSecretSubkeyUID] -> ShowS
Show)

data AuthSecretSubkeyAtTime
    = AuthSecretSubkeyAtTime
    { AuthSecretSubkeyAtTime -> KeyPkt 'SecretPkt
authSecretSubkeyPrimaryKey :: KeyPkt 'SecretPkt
    , AuthSecretSubkeyAtTime -> KeyPkt 'SecretPkt
authSecretSubkeyValue :: KeyPkt 'SecretPkt
    , AuthSecretSubkeyAtTime -> [AuthSecretSubkeyUID]
authSecretSubkeyUIDs :: [AuthSecretSubkeyUID]
    , AuthSecretSubkeyAtTime -> Maybe Text
authSecretSubkeyPrimaryUID :: Maybe Text
    }
    deriving (AuthSecretSubkeyAtTime -> AuthSecretSubkeyAtTime -> Bool
(AuthSecretSubkeyAtTime -> AuthSecretSubkeyAtTime -> Bool)
-> (AuthSecretSubkeyAtTime -> AuthSecretSubkeyAtTime -> Bool)
-> Eq AuthSecretSubkeyAtTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthSecretSubkeyAtTime -> AuthSecretSubkeyAtTime -> Bool
== :: AuthSecretSubkeyAtTime -> AuthSecretSubkeyAtTime -> Bool
$c/= :: AuthSecretSubkeyAtTime -> AuthSecretSubkeyAtTime -> Bool
/= :: AuthSecretSubkeyAtTime -> AuthSecretSubkeyAtTime -> Bool
Eq, Int -> AuthSecretSubkeyAtTime -> ShowS
[AuthSecretSubkeyAtTime] -> ShowS
AuthSecretSubkeyAtTime -> String
(Int -> AuthSecretSubkeyAtTime -> ShowS)
-> (AuthSecretSubkeyAtTime -> String)
-> ([AuthSecretSubkeyAtTime] -> ShowS)
-> Show AuthSecretSubkeyAtTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthSecretSubkeyAtTime -> ShowS
showsPrec :: Int -> AuthSecretSubkeyAtTime -> ShowS
$cshow :: AuthSecretSubkeyAtTime -> String
show :: AuthSecretSubkeyAtTime -> String
$cshowList :: [AuthSecretSubkeyAtTime] -> ShowS
showList :: [AuthSecretSubkeyAtTime] -> ShowS
Show)

data AuthSecretSubkeyRejectionReason
    = AuthSecretSubkeyTKVerificationFailed
    | AuthSecretSubkeyPrimaryKeyInvalidAtTime
    | AuthSecretSubkeyNotSecretSubkeyPacket
    | AuthSecretSubkeyNotSubkeyPacket
    | AuthSecretSubkeySubkeyInvalidAtTime
    | AuthSecretSubkeyMissingAuthCapability
    deriving (AuthSecretSubkeyRejectionReason
-> AuthSecretSubkeyRejectionReason -> Bool
(AuthSecretSubkeyRejectionReason
 -> AuthSecretSubkeyRejectionReason -> Bool)
-> (AuthSecretSubkeyRejectionReason
    -> AuthSecretSubkeyRejectionReason -> Bool)
-> Eq AuthSecretSubkeyRejectionReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthSecretSubkeyRejectionReason
-> AuthSecretSubkeyRejectionReason -> Bool
== :: AuthSecretSubkeyRejectionReason
-> AuthSecretSubkeyRejectionReason -> Bool
$c/= :: AuthSecretSubkeyRejectionReason
-> AuthSecretSubkeyRejectionReason -> Bool
/= :: AuthSecretSubkeyRejectionReason
-> AuthSecretSubkeyRejectionReason -> Bool
Eq, Int -> AuthSecretSubkeyRejectionReason -> ShowS
[AuthSecretSubkeyRejectionReason] -> ShowS
AuthSecretSubkeyRejectionReason -> String
(Int -> AuthSecretSubkeyRejectionReason -> ShowS)
-> (AuthSecretSubkeyRejectionReason -> String)
-> ([AuthSecretSubkeyRejectionReason] -> ShowS)
-> Show AuthSecretSubkeyRejectionReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthSecretSubkeyRejectionReason -> ShowS
showsPrec :: Int -> AuthSecretSubkeyRejectionReason -> ShowS
$cshow :: AuthSecretSubkeyRejectionReason -> String
show :: AuthSecretSubkeyRejectionReason -> String
$cshowList :: [AuthSecretSubkeyRejectionReason] -> ShowS
showList :: [AuthSecretSubkeyRejectionReason] -> ShowS
Show)

data AuthSecretSubkeyRejectedAtTime
    = AuthSecretSubkeyRejectedAtTime
    { AuthSecretSubkeyRejectedAtTime -> KeyPkt 'SecretPkt
authSecretSubkeyRejectedPrimaryKey :: KeyPkt 'SecretPkt
    , AuthSecretSubkeyRejectedAtTime -> Maybe (KeyPkt 'SecretPkt)
authSecretSubkeyRejectedValue :: Maybe (KeyPkt 'SecretPkt)
    , AuthSecretSubkeyRejectedAtTime -> [AuthSecretSubkeyUID]
authSecretSubkeyRejectedUIDs :: [AuthSecretSubkeyUID]
    , AuthSecretSubkeyRejectedAtTime -> Maybe Text
authSecretSubkeyRejectedPrimaryUID :: Maybe Text
    , AuthSecretSubkeyRejectedAtTime -> AuthSecretSubkeyRejectionReason
authSecretSubkeyRejectedReason :: AuthSecretSubkeyRejectionReason
    }
    deriving (AuthSecretSubkeyRejectedAtTime
-> AuthSecretSubkeyRejectedAtTime -> Bool
(AuthSecretSubkeyRejectedAtTime
 -> AuthSecretSubkeyRejectedAtTime -> Bool)
-> (AuthSecretSubkeyRejectedAtTime
    -> AuthSecretSubkeyRejectedAtTime -> Bool)
-> Eq AuthSecretSubkeyRejectedAtTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthSecretSubkeyRejectedAtTime
-> AuthSecretSubkeyRejectedAtTime -> Bool
== :: AuthSecretSubkeyRejectedAtTime
-> AuthSecretSubkeyRejectedAtTime -> Bool
$c/= :: AuthSecretSubkeyRejectedAtTime
-> AuthSecretSubkeyRejectedAtTime -> Bool
/= :: AuthSecretSubkeyRejectedAtTime
-> AuthSecretSubkeyRejectedAtTime -> Bool
Eq, Int -> AuthSecretSubkeyRejectedAtTime -> ShowS
[AuthSecretSubkeyRejectedAtTime] -> ShowS
AuthSecretSubkeyRejectedAtTime -> String
(Int -> AuthSecretSubkeyRejectedAtTime -> ShowS)
-> (AuthSecretSubkeyRejectedAtTime -> String)
-> ([AuthSecretSubkeyRejectedAtTime] -> ShowS)
-> Show AuthSecretSubkeyRejectedAtTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthSecretSubkeyRejectedAtTime -> ShowS
showsPrec :: Int -> AuthSecretSubkeyRejectedAtTime -> ShowS
$cshow :: AuthSecretSubkeyRejectedAtTime -> String
show :: AuthSecretSubkeyRejectedAtTime -> String
$cshowList :: [AuthSecretSubkeyRejectedAtTime] -> ShowS
showList :: [AuthSecretSubkeyRejectedAtTime] -> ShowS
Show)

data AuthSecretSubkeysAtReport
    = AuthSecretSubkeysAtReport
    { AuthSecretSubkeysAtReport -> [AuthSecretSubkeyAtTime]
authSecretSubkeysAccepted :: [AuthSecretSubkeyAtTime]
    , AuthSecretSubkeysAtReport -> [AuthSecretSubkeyRejectedAtTime]
authSecretSubkeysRejected :: [AuthSecretSubkeyRejectedAtTime]
    }
    deriving (AuthSecretSubkeysAtReport -> AuthSecretSubkeysAtReport -> Bool
(AuthSecretSubkeysAtReport -> AuthSecretSubkeysAtReport -> Bool)
-> (AuthSecretSubkeysAtReport -> AuthSecretSubkeysAtReport -> Bool)
-> Eq AuthSecretSubkeysAtReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthSecretSubkeysAtReport -> AuthSecretSubkeysAtReport -> Bool
== :: AuthSecretSubkeysAtReport -> AuthSecretSubkeysAtReport -> Bool
$c/= :: AuthSecretSubkeysAtReport -> AuthSecretSubkeysAtReport -> Bool
/= :: AuthSecretSubkeysAtReport -> AuthSecretSubkeysAtReport -> Bool
Eq, Int -> AuthSecretSubkeysAtReport -> ShowS
[AuthSecretSubkeysAtReport] -> ShowS
AuthSecretSubkeysAtReport -> String
(Int -> AuthSecretSubkeysAtReport -> ShowS)
-> (AuthSecretSubkeysAtReport -> String)
-> ([AuthSecretSubkeysAtReport] -> ShowS)
-> Show AuthSecretSubkeysAtReport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthSecretSubkeysAtReport -> ShowS
showsPrec :: Int -> AuthSecretSubkeysAtReport -> ShowS
$cshow :: AuthSecretSubkeysAtReport -> String
show :: AuthSecretSubkeysAtReport -> String
$cshowList :: [AuthSecretSubkeysAtReport] -> ShowS
showList :: [AuthSecretSubkeysAtReport] -> ShowS
Show)

conduitToAuthSecretSubkeysAtReport
    :: Monad m
    => UTCTime
    -> ConduitT (TK 'SecretTK) AuthSecretSubkeysAtReport m ()
conduitToAuthSecretSubkeysAtReport :: forall (m :: * -> *).
Monad m =>
UTCTime -> ConduitT (TK 'SecretTK) AuthSecretSubkeysAtReport m ()
conduitToAuthSecretSubkeysAtReport UTCTime
validationTime =
    (TK 'SecretTK -> AuthSecretSubkeysAtReport)
-> ConduitT (TK 'SecretTK) AuthSecretSubkeysAtReport m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map (UTCTime -> TK 'SecretTK -> AuthSecretSubkeysAtReport
authSecretSubkeysAtReport UTCTime
validationTime)

conduitToAuthSecretSubkeysAt
    :: Monad m
    => UTCTime
    -> ConduitT (TK 'SecretTK) AuthSecretSubkeyAtTime m ()
conduitToAuthSecretSubkeysAt :: forall (m :: * -> *).
Monad m =>
UTCTime -> ConduitT (TK 'SecretTK) AuthSecretSubkeyAtTime m ()
conduitToAuthSecretSubkeysAt UTCTime
validationTime =
    (TK 'SecretTK -> [AuthSecretSubkeyAtTime])
-> ConduitT (TK 'SecretTK) AuthSecretSubkeyAtTime m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> [b]) -> ConduitT a b m ()
CL.concatMap
        ( AuthSecretSubkeysAtReport -> [AuthSecretSubkeyAtTime]
authSecretSubkeysAccepted
            (AuthSecretSubkeysAtReport -> [AuthSecretSubkeyAtTime])
-> (TK 'SecretTK -> AuthSecretSubkeysAtReport)
-> TK 'SecretTK
-> [AuthSecretSubkeyAtTime]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> TK 'SecretTK -> AuthSecretSubkeysAtReport
authSecretSubkeysAtReport UTCTime
validationTime
        )

authSecretSubkeysAt
    :: UTCTime -> TK 'SecretTK -> [AuthSecretSubkeyAtTime]
authSecretSubkeysAt :: UTCTime -> TK 'SecretTK -> [AuthSecretSubkeyAtTime]
authSecretSubkeysAt UTCTime
validationTime =
    AuthSecretSubkeysAtReport -> [AuthSecretSubkeyAtTime]
authSecretSubkeysAccepted
        (AuthSecretSubkeysAtReport -> [AuthSecretSubkeyAtTime])
-> (TK 'SecretTK -> AuthSecretSubkeysAtReport)
-> TK 'SecretTK
-> [AuthSecretSubkeyAtTime]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> TK 'SecretTK -> AuthSecretSubkeysAtReport
authSecretSubkeysAtReport UTCTime
validationTime

authSecretSubkeysAtReport
    :: UTCTime -> TK 'SecretTK -> AuthSecretSubkeysAtReport
authSecretSubkeysAtReport :: UTCTime -> TK 'SecretTK -> AuthSecretSubkeysAtReport
authSecretSubkeysAtReport UTCTime
validationTime TK 'SecretTK
typedTk =
    case (Pkt
 -> PktStreamContext
 -> Maybe UTCTime
 -> Either VerificationError Verification)
-> Maybe UTCTime
-> TK 'SecretTK
-> Either VerificationError (TK 'SecretTK)
forall (k :: TKKind).
(Pkt
 -> PktStreamContext
 -> Maybe UTCTime
 -> Either VerificationError Verification)
-> Maybe UTCTime -> TK k -> Either VerificationError (TK k)
verifyTKWith
        ( VerificationPolicy
-> (Pkt
    -> Maybe UTCTime
    -> ByteString
    -> Either VerificationError Verification)
-> Pkt
-> PktStreamContext
-> Maybe UTCTime
-> Either VerificationError Verification
verifySigWith
            VerificationPolicy
defaultVerificationPolicy
            ([TK 'PublicTK]
-> Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
verifyAgainstKeys [TK 'PublicTK
untyped])
        )
        (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
validationTime)
        TK 'SecretTK
typedTk of
        Left VerificationError
_ ->
            [AuthSecretSubkeyAtTime]
-> [AuthSecretSubkeyRejectedAtTime] -> AuthSecretSubkeysAtReport
AuthSecretSubkeysAtReport
                []
                [ AuthSecretSubkeyRejectedAtTime
                    { authSecretSubkeyRejectedPrimaryKey :: KeyPkt 'SecretPkt
authSecretSubkeyRejectedPrimaryKey = KeyPkt 'SecretPkt
primaryKey
                    , authSecretSubkeyRejectedValue :: Maybe (KeyPkt 'SecretPkt)
authSecretSubkeyRejectedValue = Maybe (KeyPkt 'SecretPkt)
forall a. Maybe a
Nothing
                    , authSecretSubkeyRejectedUIDs :: [AuthSecretSubkeyUID]
authSecretSubkeyRejectedUIDs = []
                    , authSecretSubkeyRejectedPrimaryUID :: Maybe Text
authSecretSubkeyRejectedPrimaryUID = Maybe Text
forall a. Maybe a
Nothing
                    , authSecretSubkeyRejectedReason :: AuthSecretSubkeyRejectionReason
authSecretSubkeyRejectedReason =
                        AuthSecretSubkeyRejectionReason
AuthSecretSubkeyTKVerificationFailed
                    }
                ]
        Right TK 'SecretTK
verifiedTk
            | Bool -> Bool
not (UTCTime -> TK 'SecretTK -> Bool
forall (k :: TKKind). UTCTime -> TK k -> Bool
isTKTimeValid UTCTime
validationTime TK 'SecretTK
verifiedTk) ->
                let uids :: [AuthSecretSubkeyUID]
uids = UTCTime -> TK 'SecretTK -> [AuthSecretSubkeyUID]
forall (k :: TKKind). UTCTime -> TK k -> [AuthSecretSubkeyUID]
uidContextsAt UTCTime
validationTime TK 'SecretTK
verifiedTk
                    primaryUid :: Maybe Text
primaryUid =
                        AuthSecretSubkeyUID -> Text
authSecretSubkeyUIDValue
                            (AuthSecretSubkeyUID -> Text)
-> Maybe AuthSecretSubkeyUID -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AuthSecretSubkeyUID -> Bool)
-> [AuthSecretSubkeyUID] -> Maybe AuthSecretSubkeyUID
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find AuthSecretSubkeyUID -> Bool
authSecretSubkeyUIDIsPrimary [AuthSecretSubkeyUID]
uids
                 in [AuthSecretSubkeyAtTime]
-> [AuthSecretSubkeyRejectedAtTime] -> AuthSecretSubkeysAtReport
AuthSecretSubkeysAtReport
                        []
                        [ AuthSecretSubkeyRejectedAtTime
                            { authSecretSubkeyRejectedPrimaryKey :: KeyPkt 'SecretPkt
authSecretSubkeyRejectedPrimaryKey = KeyPkt 'SecretPkt
primaryKey
                            , authSecretSubkeyRejectedValue :: Maybe (KeyPkt 'SecretPkt)
authSecretSubkeyRejectedValue = Maybe (KeyPkt 'SecretPkt)
forall a. Maybe a
Nothing
                            , authSecretSubkeyRejectedUIDs :: [AuthSecretSubkeyUID]
authSecretSubkeyRejectedUIDs = [AuthSecretSubkeyUID]
uids
                            , authSecretSubkeyRejectedPrimaryUID :: Maybe Text
authSecretSubkeyRejectedPrimaryUID = Maybe Text
primaryUid
                            , authSecretSubkeyRejectedReason :: AuthSecretSubkeyRejectionReason
authSecretSubkeyRejectedReason =
                                AuthSecretSubkeyRejectionReason
AuthSecretSubkeyPrimaryKeyInvalidAtTime
                            }
                        ]
            | Bool
otherwise ->
                let uids :: [AuthSecretSubkeyUID]
uids = UTCTime -> TK 'SecretTK -> [AuthSecretSubkeyUID]
forall (k :: TKKind). UTCTime -> TK k -> [AuthSecretSubkeyUID]
uidContextsAt UTCTime
validationTime TK 'SecretTK
verifiedTk
                    primaryUid :: Maybe Text
primaryUid =
                        AuthSecretSubkeyUID -> Text
authSecretSubkeyUIDValue
                            (AuthSecretSubkeyUID -> Text)
-> Maybe AuthSecretSubkeyUID -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AuthSecretSubkeyUID -> Bool)
-> [AuthSecretSubkeyUID] -> Maybe AuthSecretSubkeyUID
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find AuthSecretSubkeyUID -> Bool
authSecretSubkeyUIDIsPrimary [AuthSecretSubkeyUID]
uids
                 in ((KeyPkt 'SecretPkt, [SignaturePayload])
 -> AuthSecretSubkeysAtReport -> AuthSecretSubkeysAtReport)
-> AuthSecretSubkeysAtReport
-> [(KeyPkt 'SecretPkt, [SignaturePayload])]
-> AuthSecretSubkeysAtReport
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                        ( \(KeyPkt 'SecretPkt, [SignaturePayload])
subCandidate AuthSecretSubkeysAtReport
acc ->
                            case UTCTime
-> KeyPkt 'SecretPkt
-> [AuthSecretSubkeyUID]
-> Maybe Text
-> (KeyPkt 'SecretPkt, [SignaturePayload])
-> Either AuthSecretSubkeyRejectedAtTime AuthSecretSubkeyAtTime
classifySecretSubkeyAtTime
                                UTCTime
validationTime
                                KeyPkt 'SecretPkt
primaryKey
                                [AuthSecretSubkeyUID]
uids
                                Maybe Text
primaryUid
                                (KeyPkt 'SecretPkt, [SignaturePayload])
subCandidate of
                                Left AuthSecretSubkeyRejectedAtTime
rejected ->
                                    AuthSecretSubkeysAtReport
acc
                                        { authSecretSubkeysRejected =
                                            rejected : authSecretSubkeysRejected acc
                                        }
                                Right AuthSecretSubkeyAtTime
accepted ->
                                    AuthSecretSubkeysAtReport
acc
                                        { authSecretSubkeysAccepted =
                                            accepted : authSecretSubkeysAccepted acc
                                        }
                        )
                        ([AuthSecretSubkeyAtTime]
-> [AuthSecretSubkeyRejectedAtTime] -> AuthSecretSubkeysAtReport
AuthSecretSubkeysAtReport [] [])
                        (TK 'SecretTK
-> [(KeyPkt (TKKindToKeyPktKind 'SecretTK), [SignaturePayload])]
forall (k :: TKKind).
TK k -> [(KeyPkt (TKKindToKeyPktKind k), [SignaturePayload])]
_tkSubs TK 'SecretTK
verifiedTk)
  where
    untyped :: TK 'PublicTK
untyped = TK 'SecretTK -> TK 'PublicTK
publicViewTK TK 'SecretTK
typedTk
    primaryKey :: KeyPkt (TKKindToKeyPktKind 'SecretTK)
primaryKey = TK 'SecretTK -> KeyPkt (TKKindToKeyPktKind 'SecretTK)
forall (k :: TKKind). TK k -> KeyPkt (TKKindToKeyPktKind k)
_tkPrimaryKey TK 'SecretTK
typedTk

classifySecretSubkeyAtTime
    :: UTCTime
    -> KeyPkt 'SecretPkt
    -> [AuthSecretSubkeyUID]
    -> Maybe Text
    -> (KeyPkt 'SecretPkt, [SignaturePayload])
    -> Either AuthSecretSubkeyRejectedAtTime AuthSecretSubkeyAtTime
classifySecretSubkeyAtTime :: UTCTime
-> KeyPkt 'SecretPkt
-> [AuthSecretSubkeyUID]
-> Maybe Text
-> (KeyPkt 'SecretPkt, [SignaturePayload])
-> Either AuthSecretSubkeyRejectedAtTime AuthSecretSubkeyAtTime
classifySecretSubkeyAtTime UTCTime
validationTime KeyPkt 'SecretPkt
primaryKey [AuthSecretSubkeyUID]
uids Maybe Text
primaryUid (KeyPkt 'SecretPkt
subkey, [SignaturePayload]
sigs)
    | KeyPkt 'SecretPkt -> KeyPktRole
forall (k :: KeyPktKind). KeyPkt k -> KeyPktRole
keyPktRole KeyPkt 'SecretPkt
subkey KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
/= KeyPktRole
KeyPktSubkey =
        AuthSecretSubkeyRejectedAtTime
-> Either AuthSecretSubkeyRejectedAtTime AuthSecretSubkeyAtTime
forall a b. a -> Either a b
Left
            AuthSecretSubkeyRejectedAtTime
                { authSecretSubkeyRejectedPrimaryKey :: KeyPkt 'SecretPkt
authSecretSubkeyRejectedPrimaryKey = KeyPkt 'SecretPkt
primaryKey
                , authSecretSubkeyRejectedValue :: Maybe (KeyPkt 'SecretPkt)
authSecretSubkeyRejectedValue = KeyPkt 'SecretPkt -> Maybe (KeyPkt 'SecretPkt)
forall a. a -> Maybe a
Just KeyPkt 'SecretPkt
subkey
                , authSecretSubkeyRejectedUIDs :: [AuthSecretSubkeyUID]
authSecretSubkeyRejectedUIDs = [AuthSecretSubkeyUID]
uids
                , authSecretSubkeyRejectedPrimaryUID :: Maybe Text
authSecretSubkeyRejectedPrimaryUID = Maybe Text
primaryUid
                , authSecretSubkeyRejectedReason :: AuthSecretSubkeyRejectionReason
authSecretSubkeyRejectedReason = AuthSecretSubkeyRejectionReason
AuthSecretSubkeyNotSubkeyPacket
                }
    | Bool -> Bool
not
        ( UTCTime -> SomePKPayload -> [SignaturePayload] -> Bool
isPKTimeValidWithSelfSignatures
            UTCTime
validationTime
            (KeyPkt 'SecretPkt -> SomePKPayload
forall (k :: KeyPktKind). KeyPkt k -> SomePKPayload
keyPktPKPayload KeyPkt 'SecretPkt
subkey)
            [SignaturePayload]
sigs
        ) =
        AuthSecretSubkeyRejectedAtTime
-> Either AuthSecretSubkeyRejectedAtTime AuthSecretSubkeyAtTime
forall a b. a -> Either a b
Left
            AuthSecretSubkeyRejectedAtTime
                { authSecretSubkeyRejectedPrimaryKey :: KeyPkt 'SecretPkt
authSecretSubkeyRejectedPrimaryKey = KeyPkt 'SecretPkt
primaryKey
                , authSecretSubkeyRejectedValue :: Maybe (KeyPkt 'SecretPkt)
authSecretSubkeyRejectedValue = KeyPkt 'SecretPkt -> Maybe (KeyPkt 'SecretPkt)
forall a. a -> Maybe a
Just KeyPkt 'SecretPkt
subkey
                , authSecretSubkeyRejectedUIDs :: [AuthSecretSubkeyUID]
authSecretSubkeyRejectedUIDs = [AuthSecretSubkeyUID]
uids
                , authSecretSubkeyRejectedPrimaryUID :: Maybe Text
authSecretSubkeyRejectedPrimaryUID = Maybe Text
primaryUid
                , authSecretSubkeyRejectedReason :: AuthSecretSubkeyRejectionReason
authSecretSubkeyRejectedReason =
                    AuthSecretSubkeyRejectionReason
AuthSecretSubkeySubkeyInvalidAtTime
                }
    | Bool -> Bool
not (UTCTime -> [SignaturePayload] -> Bool
subkeyAuthCapableAt UTCTime
validationTime [SignaturePayload]
sigs) =
        AuthSecretSubkeyRejectedAtTime
-> Either AuthSecretSubkeyRejectedAtTime AuthSecretSubkeyAtTime
forall a b. a -> Either a b
Left
            AuthSecretSubkeyRejectedAtTime
                { authSecretSubkeyRejectedPrimaryKey :: KeyPkt 'SecretPkt
authSecretSubkeyRejectedPrimaryKey = KeyPkt 'SecretPkt
primaryKey
                , authSecretSubkeyRejectedValue :: Maybe (KeyPkt 'SecretPkt)
authSecretSubkeyRejectedValue = KeyPkt 'SecretPkt -> Maybe (KeyPkt 'SecretPkt)
forall a. a -> Maybe a
Just KeyPkt 'SecretPkt
subkey
                , authSecretSubkeyRejectedUIDs :: [AuthSecretSubkeyUID]
authSecretSubkeyRejectedUIDs = [AuthSecretSubkeyUID]
uids
                , authSecretSubkeyRejectedPrimaryUID :: Maybe Text
authSecretSubkeyRejectedPrimaryUID = Maybe Text
primaryUid
                , authSecretSubkeyRejectedReason :: AuthSecretSubkeyRejectionReason
authSecretSubkeyRejectedReason =
                    AuthSecretSubkeyRejectionReason
AuthSecretSubkeyMissingAuthCapability
                }
    | Bool
otherwise =
        AuthSecretSubkeyAtTime
-> Either AuthSecretSubkeyRejectedAtTime AuthSecretSubkeyAtTime
forall a b. b -> Either a b
Right
            AuthSecretSubkeyAtTime
                { authSecretSubkeyPrimaryKey :: KeyPkt 'SecretPkt
authSecretSubkeyPrimaryKey = KeyPkt 'SecretPkt
primaryKey
                , authSecretSubkeyValue :: KeyPkt 'SecretPkt
authSecretSubkeyValue = KeyPkt 'SecretPkt
subkey
                , authSecretSubkeyUIDs :: [AuthSecretSubkeyUID]
authSecretSubkeyUIDs = [AuthSecretSubkeyUID]
uids
                , authSecretSubkeyPrimaryUID :: Maybe Text
authSecretSubkeyPrimaryUID = Maybe Text
primaryUid
                }

uidContextsAt :: UTCTime -> TK k -> [AuthSecretSubkeyUID]
uidContextsAt :: forall (k :: TKKind). UTCTime -> TK k -> [AuthSecretSubkeyUID]
uidContextsAt UTCTime
validationTime TK k
tk =
    ((Text, [SignaturePayload]) -> AuthSecretSubkeyUID)
-> [(Text, [SignaturePayload])] -> [AuthSecretSubkeyUID]
forall a b. (a -> b) -> [a] -> [b]
map
        ( \(Text
uid, [SignaturePayload]
_) ->
            AuthSecretSubkeyUID
                { authSecretSubkeyUIDValue :: Text
authSecretSubkeyUIDValue = Text
uid
                , authSecretSubkeyUIDIsPrimary :: Bool
authSecretSubkeyUIDIsPrimary = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
uid Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
primaryUid
                }
        )
        (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)
  where
    primaryUid :: Maybe Text
primaryUid = UTCTime -> [(Text, [SignaturePayload])] -> Maybe Text
primaryUIDAt UTCTime
validationTime (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)

primaryUIDAt
    :: UTCTime -> [(Text, [SignaturePayload])] -> Maybe Text
primaryUIDAt :: UTCTime -> [(Text, [SignaturePayload])] -> Maybe Text
primaryUIDAt UTCTime
validationTime [(Text, [SignaturePayload])]
uids =
    (UTCTime, Text) -> Text
forall a b. (a, b) -> b
snd ((UTCTime, Text) -> Text) -> Maybe (UTCTime, Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UTCTime, Text)] -> Maybe (UTCTime, Text)
forall a. [(UTCTime, a)] -> Maybe (UTCTime, a)
newestByCreationTime [(UTCTime, Text)]
candidates
  where
    candidates :: [(UTCTime, Text)]
candidates =
        [ (UTCTime
createdAt, Text
uid)
        | (Text
uid, [SignaturePayload]
sigs) <- [(Text, [SignaturePayload])]
uids
        , SignaturePayload
cert <-
            Maybe SignaturePayload -> [SignaturePayload]
forall a. Maybe a -> [a]
maybeToList (UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestEffectiveCertificationAt UTCTime
validationTime [SignaturePayload]
sigs)
        , SignaturePayload -> Bool
signatureMarksPrimaryUID SignaturePayload
cert
        , UTCTime
createdAt <- Maybe UTCTime -> [UTCTime]
forall a. Maybe a -> [a]
maybeToList (SignaturePayload -> Maybe UTCTime
signatureCreationTime SignaturePayload
cert)
        ]

subkeyAuthCapableAt :: UTCTime -> [SignaturePayload] -> Bool
subkeyAuthCapableAt :: UTCTime -> [SignaturePayload] -> Bool
subkeyAuthCapableAt UTCTime
validationTime [SignaturePayload]
sigs =
    Bool
-> (SignaturePayload -> Bool) -> Maybe SignaturePayload -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Bool
False
        SignaturePayload -> Bool
signatureHasAuthKeyFlag
        (UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestEffectiveBindingSignatureAt UTCTime
validationTime [SignaturePayload]
sigs)

latestEffectiveSignatureAt
    :: (SignaturePayload -> Bool)
    -> UTCTime
    -> [SignaturePayload]
    -> Maybe SignaturePayload
latestEffectiveSignatureAt :: (SignaturePayload -> Bool)
-> UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestEffectiveSignatureAt SignaturePayload -> Bool
typePred UTCTime
validationTime [SignaturePayload]
sigs =
    (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
            [ (UTCTime
createdAt, SignaturePayload
sig)
            | SignaturePayload
sig <- [SignaturePayload]
sigs
            , SignaturePayload -> Bool
typePred SignaturePayload
sig
            , UTCTime -> SignaturePayload -> Bool
signatureEffectiveAt UTCTime
validationTime SignaturePayload
sig
            , UTCTime
createdAt <- Maybe UTCTime -> [UTCTime]
forall a. Maybe a -> [a]
maybeToList (SignaturePayload -> Maybe UTCTime
signatureCreationTime SignaturePayload
sig)
            ]

latestEffectiveBindingSignatureAt
    :: UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestEffectiveBindingSignatureAt :: UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestEffectiveBindingSignatureAt =
    (SignaturePayload -> Bool)
-> UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestEffectiveSignatureAt SignaturePayload -> Bool
isSubkeyBindingSig

latestEffectiveCertificationAt
    :: UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestEffectiveCertificationAt :: UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestEffectiveCertificationAt =
    (SignaturePayload -> Bool)
-> UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestEffectiveSignatureAt SignaturePayload -> Bool
isCertificationSig

signatureHasAuthKeyFlag :: SignaturePayload -> Bool
signatureHasAuthKeyFlag :: SignaturePayload -> Bool
signatureHasAuthKeyFlag SignaturePayload
sig =
    KeyFlag -> Set KeyFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member KeyFlag
AuthKey (SignaturePayload -> Set KeyFlag
signatureKeyFlags SignaturePayload
sig)

foldHasSubPacket
    :: (SigSubPacket -> Maybe b)
    -> (b -> Bool)
    -> SignaturePayload
    -> Bool
foldHasSubPacket :: forall b.
(SigSubPacket -> Maybe b)
-> (b -> Bool) -> SignaturePayload -> Bool
foldHasSubPacket SigSubPacket -> Maybe b
extract b -> Bool
predicate SignaturePayload
sig =
    (b -> Bool) -> [b] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
        b -> Bool
predicate
        ( (SigSubPacket -> Maybe b) -> [SigSubPacket] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
            SigSubPacket -> Maybe b
extract
            ([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))
        )

signatureKeyFlags :: SignaturePayload -> Set.Set KeyFlag
signatureKeyFlags :: SignaturePayload -> Set KeyFlag
signatureKeyFlags SignaturePayload
sig =
    (SigSubPacket -> Set KeyFlag -> Set KeyFlag)
-> Set KeyFlag -> [SigSubPacket] -> Set KeyFlag
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
        ( \SigSubPacket
sp Set KeyFlag
acc ->
            case SigSubPacket
sp of
                SigSubPacket Bool
_ (KeyFlags Set KeyFlag
flags) -> Set KeyFlag -> Set KeyFlag -> Set KeyFlag
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set KeyFlag
flags Set KeyFlag
acc
                SigSubPacket
_ -> Set KeyFlag
acc
        )
        Set KeyFlag
forall a. Set a
Set.empty
        ([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))

signatureMarksPrimaryUID :: SignaturePayload -> Bool
signatureMarksPrimaryUID :: SignaturePayload -> Bool
signatureMarksPrimaryUID SignaturePayload
sig =
    (SigSubPacket -> Maybe Bool)
-> (Bool -> Bool) -> SignaturePayload -> Bool
forall b.
(SigSubPacket -> Maybe b)
-> (b -> Bool) -> SignaturePayload -> Bool
foldHasSubPacket
        (\case SigSubPacket Bool
_ (PrimaryUserId Bool
p) -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
p; SigSubPacket
_ -> Maybe Bool
forall a. Maybe a
Nothing)
        Bool -> Bool
forall a. a -> a
id
        SignaturePayload
sig

{-# DEPRECATED conduitToTKsEither "Use conduitToSomeTKsEither instead" #-}
conduitToTKsEither
    :: Monad m
    => ConduitT
        Pkt
        (Either KeyringChunkParseError (Maybe TKUnknown))
        m
        ()
conduitToTKsEither :: forall (m :: * -> *).
Monad m =>
ConduitT Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
conduitToTKsEither = Bool
-> ConduitT
     Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
forall (m :: * -> *).
Monad m =>
Bool
-> ConduitT
     Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
conduitToTKsEither' Bool
True

{-# DEPRECATED
    conduitToTKsDroppingEither
    "Use conduitToSomeTKsDroppingEither instead"
    #-}
conduitToTKsDroppingEither
    :: Monad m
    => ConduitT
        Pkt
        (Either KeyringChunkParseError (Maybe TKUnknown))
        m
        ()
conduitToTKsDroppingEither :: forall (m :: * -> *).
Monad m =>
ConduitT Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
conduitToTKsDroppingEither = Bool
-> ConduitT
     Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
forall (m :: * -> *).
Monad m =>
Bool
-> ConduitT
     Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
conduitToTKsEither' Bool
False

conduitToTKsWithWireRepEither
    :: Monad m
    => ConduitT
        PktWithWireRep
        (Either KeyringChunkParseError (Maybe TKWithWireRep))
        m
        ()
conduitToTKsWithWireRepEither :: forall (m :: * -> *).
Monad m =>
ConduitT
  PktWithWireRep
  (Either KeyringChunkParseError (Maybe TKWithWireRep))
  m
  ()
conduitToTKsWithWireRepEither = Bool
-> ConduitT
     PktWithWireRep
     (Either KeyringChunkParseError (Maybe TKWithWireRep))
     m
     ()
forall (m :: * -> *).
Monad m =>
Bool
-> ConduitT
     PktWithWireRep
     (Either KeyringChunkParseError (Maybe TKWithWireRep))
     m
     ()
conduitToTKsWithWireRepEither' Bool
True

conduitToTKsDroppingWithWireRepEither
    :: Monad m
    => ConduitT
        PktWithWireRep
        (Either KeyringChunkParseError (Maybe TKWithWireRep))
        m
        ()
conduitToTKsDroppingWithWireRepEither :: forall (m :: * -> *).
Monad m =>
ConduitT
  PktWithWireRep
  (Either KeyringChunkParseError (Maybe TKWithWireRep))
  m
  ()
conduitToTKsDroppingWithWireRepEither = Bool
-> ConduitT
     PktWithWireRep
     (Either KeyringChunkParseError (Maybe TKWithWireRep))
     m
     ()
forall (m :: * -> *).
Monad m =>
Bool
-> ConduitT
     PktWithWireRep
     (Either KeyringChunkParseError (Maybe TKWithWireRep))
     m
     ()
conduitToTKsWithWireRepEither' Bool
False

fakecmAccumEither
    :: Monad m
    => (accum -> Either e (accum, [b]))
    -> (a -> accum -> Either e (accum, [b]))
    -> accum
    -> ConduitT a (Either e b) m ()
fakecmAccumEither :: forall (m :: * -> *) accum e b a.
Monad m =>
(accum -> Either e (accum, [b]))
-> (a -> accum -> Either e (accum, [b]))
-> accum
-> ConduitT a (Either e b) m ()
fakecmAccumEither accum -> Either e (accum, [b])
finalizer a -> accum -> Either e (accum, [b])
f accum
initialAccum = accum -> ConduitT a (Either e b) m ()
forall {m :: * -> *}.
Monad m =>
accum -> ConduitT a (Either e b) m ()
loop accum
initialAccum
  where
    loop :: accum -> ConduitT a (Either e b) m ()
loop accum
accum =
        ConduitT a (Either e b) m (Maybe a)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
            ConduitT a (Either e b) m (Maybe a)
-> (Maybe a -> ConduitT a (Either e b) m ())
-> ConduitT a (Either e b) m ()
forall a b.
ConduitT a (Either e b) m a
-> (a -> ConduitT a (Either e b) m b)
-> ConduitT a (Either e b) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT a (Either e b) m ()
-> (a -> ConduitT a (Either e b) m ())
-> Maybe a
-> ConduitT a (Either e b) m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                ( case accum -> Either e (accum, [b])
finalizer accum
accum of
                    Left e
err -> Either e b -> ConduitT a (Either e b) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (e -> Either e b
forall a b. a -> Either a b
Left e
err)
                    Right (accum
_, [b]
bs) -> (b -> ConduitT a (Either e b) m ())
-> [b] -> ConduitT a (Either e b) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Either e b -> ConduitT a (Either e b) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either e b -> ConduitT a (Either e b) m ())
-> (b -> Either e b) -> b -> ConduitT a (Either e b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either e b
forall a b. b -> Either a b
Right) [b]
bs
                )
                a -> ConduitT a (Either e b) m ()
go
      where
        go :: a -> ConduitT a (Either e b) m ()
go a
a = do
            case a -> accum -> Either e (accum, [b])
f a
a accum
accum of
                Left e
err -> do
                    Either e b -> ConduitT a (Either e b) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (e -> Either e b
forall a b. a -> Either a b
Left e
err)
                    accum -> ConduitT a (Either e b) m ()
loop accum
initialAccum
                Right (accum
accum', [b]
bs) -> do
                    (b -> ConduitT a (Either e b) m ())
-> [b] -> ConduitT a (Either e b) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Either e b -> ConduitT a (Either e b) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either e b -> ConduitT a (Either e b) m ())
-> (b -> Either e b) -> b -> ConduitT a (Either e b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either e b
forall a b. b -> Either a b
Right) [b]
bs
                    accum -> ConduitT a (Either e b) m ()
loop accum
accum'

conduitDropErrorsAndNothings
    :: Monad m => ConduitT (Either e (Maybe a)) a m ()
conduitDropErrorsAndNothings :: forall (m :: * -> *) e a.
Monad m =>
ConduitT (Either e (Maybe a)) a m ()
conduitDropErrorsAndNothings =
    (Either e (Maybe a) -> Maybe a)
-> ConduitT (Either e (Maybe a)) a m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> Maybe b) -> ConduitT a b m ()
CL.mapMaybe (Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe a) -> Maybe a)
-> (Either e (Maybe a) -> Maybe (Maybe a))
-> Either e (Maybe a)
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either e (Maybe a) -> Maybe (Maybe a)
forall a b. Either a b -> Maybe b
hush)

conduitToTKsEither'
    :: Monad m
    => Bool
    -> ConduitT
        Pkt
        (Either KeyringChunkParseError (Maybe TKUnknown))
        m
        ()
conduitToTKsEither' :: forall (m :: * -> *).
Monad m =>
Bool
-> ConduitT
     Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
conduitToTKsEither' Bool
intolerant =
    (Pkt -> Bool) -> ConduitT Pkt Pkt m ()
forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
CL.filter Pkt -> Bool
notTrustPacket
        ConduitT Pkt Pkt m ()
-> ConduitT
     Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
-> ConduitT
     Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Pkt -> [Pkt]) -> ConduitT Pkt [Pkt] m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map (Pkt -> [Pkt] -> [Pkt]
forall a. a -> [a] -> [a]
: [])
        ConduitT Pkt [Pkt] m ()
-> ConduitT
     [Pkt] (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
-> ConduitT
     Pkt (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (([(Maybe TKUnknown, [Pkt])],
  Maybe
    (Maybe (Maybe TKUnknown -> Maybe TKUnknown),
     Parser [Pkt] (Maybe TKUnknown)))
 -> Either
      KeyringChunkParseError
      (([(Maybe TKUnknown, [Pkt])],
        Maybe
          (Maybe (Maybe TKUnknown -> Maybe TKUnknown),
           Parser [Pkt] (Maybe TKUnknown))),
       [Maybe TKUnknown]))
-> ([Pkt]
    -> ([(Maybe TKUnknown, [Pkt])],
        Maybe
          (Maybe (Maybe TKUnknown -> Maybe TKUnknown),
           Parser [Pkt] (Maybe TKUnknown)))
    -> Either
         KeyringChunkParseError
         (([(Maybe TKUnknown, [Pkt])],
           Maybe
             (Maybe (Maybe TKUnknown -> Maybe TKUnknown),
              Parser [Pkt] (Maybe TKUnknown))),
          [Maybe TKUnknown]))
-> ([(Maybe TKUnknown, [Pkt])],
    Maybe
      (Maybe (Maybe TKUnknown -> Maybe TKUnknown),
       Parser [Pkt] (Maybe TKUnknown)))
-> ConduitT
     [Pkt] (Either KeyringChunkParseError (Maybe TKUnknown)) m ()
forall (m :: * -> *) accum e b a.
Monad m =>
(accum -> Either e (accum, [b]))
-> (a -> accum -> Either e (accum, [b]))
-> accum
-> ConduitT a (Either e b) m ()
fakecmAccumEither
            ([(Maybe TKUnknown, [Pkt])],
 Maybe
   (Maybe (Maybe TKUnknown -> Maybe TKUnknown),
    Parser [Pkt] (Maybe TKUnknown)))
-> Either
     KeyringChunkParseError
     (([(Maybe TKUnknown, [Pkt])],
       Maybe
         (Maybe (Maybe TKUnknown -> Maybe TKUnknown),
          Parser [Pkt] (Maybe TKUnknown))),
      [Maybe TKUnknown])
forall s r.
Monoid s =>
([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
finalizeParsingEither
            (Parser [Pkt] (Maybe TKUnknown)
-> [Pkt]
-> ([(Maybe TKUnknown, [Pkt])],
    Maybe
      (Maybe (Maybe TKUnknown -> Maybe TKUnknown),
       Parser [Pkt] (Maybe TKUnknown)))
-> Either
     KeyringChunkParseError
     (([(Maybe TKUnknown, [Pkt])],
       Maybe
         (Maybe (Maybe TKUnknown -> Maybe TKUnknown),
          Parser [Pkt] (Maybe TKUnknown))),
      [Maybe TKUnknown])
forall s r.
(Monoid s, Show s) =>
Parser s r
-> s
-> ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
parseAChunkEither (Bool -> Parser [Pkt] (Maybe TKUnknown)
anyTK Bool
intolerant))
            ([], (Maybe (Maybe TKUnknown -> Maybe TKUnknown),
 Parser [Pkt] (Maybe TKUnknown))
-> Maybe
     (Maybe (Maybe TKUnknown -> Maybe TKUnknown),
      Parser [Pkt] (Maybe TKUnknown))
forall a. a -> Maybe a
Just (Maybe (Maybe TKUnknown -> Maybe TKUnknown)
forall a. Maybe a
Nothing, Bool -> Parser [Pkt] (Maybe TKUnknown)
anyTK Bool
intolerant))
  where
    notTrustPacket :: Pkt -> Bool
notTrustPacket = Bool -> Bool
not (Bool -> Bool) -> (Pkt -> Bool) -> Pkt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Bool
isTrustPkt

conduitToTKsWithWireRepEither'
    :: Monad m
    => Bool
    -> ConduitT
        PktWithWireRep
        (Either KeyringChunkParseError (Maybe TKWithWireRep))
        m
        ()
conduitToTKsWithWireRepEither' :: forall (m :: * -> *).
Monad m =>
Bool
-> ConduitT
     PktWithWireRep
     (Either KeyringChunkParseError (Maybe TKWithWireRep))
     m
     ()
conduitToTKsWithWireRepEither' Bool
intolerant =
    (PktWithWireRep -> Bool)
-> ConduitT PktWithWireRep PktWithWireRep m ()
forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
CL.filter PktWithWireRep -> Bool
notTrustPacket
        ConduitT PktWithWireRep PktWithWireRep m ()
-> ConduitT
     PktWithWireRep
     (Either KeyringChunkParseError (Maybe TKWithWireRep))
     m
     ()
-> ConduitT
     PktWithWireRep
     (Either KeyringChunkParseError (Maybe TKWithWireRep))
     m
     ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (PktWithWireRep -> [PktWithWireRep])
-> ConduitT PktWithWireRep [PktWithWireRep] m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map (PktWithWireRep -> [PktWithWireRep] -> [PktWithWireRep]
forall a. a -> [a] -> [a]
: [])
        ConduitT PktWithWireRep [PktWithWireRep] m ()
-> ConduitT
     [PktWithWireRep]
     (Either KeyringChunkParseError (Maybe TKWithWireRep))
     m
     ()
-> ConduitT
     PktWithWireRep
     (Either KeyringChunkParseError (Maybe TKWithWireRep))
     m
     ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (([(Maybe TKWithWireRep, [PktWithWireRep])],
  Maybe
    (Maybe (Maybe TKWithWireRep -> Maybe TKWithWireRep),
     Parser [PktWithWireRep] (Maybe TKWithWireRep)))
 -> Either
      KeyringChunkParseError
      (([(Maybe TKWithWireRep, [PktWithWireRep])],
        Maybe
          (Maybe (Maybe TKWithWireRep -> Maybe TKWithWireRep),
           Parser [PktWithWireRep] (Maybe TKWithWireRep))),
       [Maybe TKWithWireRep]))
-> ([PktWithWireRep]
    -> ([(Maybe TKWithWireRep, [PktWithWireRep])],
        Maybe
          (Maybe (Maybe TKWithWireRep -> Maybe TKWithWireRep),
           Parser [PktWithWireRep] (Maybe TKWithWireRep)))
    -> Either
         KeyringChunkParseError
         (([(Maybe TKWithWireRep, [PktWithWireRep])],
           Maybe
             (Maybe (Maybe TKWithWireRep -> Maybe TKWithWireRep),
              Parser [PktWithWireRep] (Maybe TKWithWireRep))),
          [Maybe TKWithWireRep]))
-> ([(Maybe TKWithWireRep, [PktWithWireRep])],
    Maybe
      (Maybe (Maybe TKWithWireRep -> Maybe TKWithWireRep),
       Parser [PktWithWireRep] (Maybe TKWithWireRep)))
-> ConduitT
     [PktWithWireRep]
     (Either KeyringChunkParseError (Maybe TKWithWireRep))
     m
     ()
forall (m :: * -> *) accum e b a.
Monad m =>
(accum -> Either e (accum, [b]))
-> (a -> accum -> Either e (accum, [b]))
-> accum
-> ConduitT a (Either e b) m ()
fakecmAccumEither
            ([(Maybe TKWithWireRep, [PktWithWireRep])],
 Maybe
   (Maybe (Maybe TKWithWireRep -> Maybe TKWithWireRep),
    Parser [PktWithWireRep] (Maybe TKWithWireRep)))
-> Either
     KeyringChunkParseError
     (([(Maybe TKWithWireRep, [PktWithWireRep])],
       Maybe
         (Maybe (Maybe TKWithWireRep -> Maybe TKWithWireRep),
          Parser [PktWithWireRep] (Maybe TKWithWireRep))),
      [Maybe TKWithWireRep])
forall s r.
Monoid s =>
([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
finalizeParsingEither
            (Parser [PktWithWireRep] (Maybe TKWithWireRep)
-> [PktWithWireRep]
-> ([(Maybe TKWithWireRep, [PktWithWireRep])],
    Maybe
      (Maybe (Maybe TKWithWireRep -> Maybe TKWithWireRep),
       Parser [PktWithWireRep] (Maybe TKWithWireRep)))
-> Either
     KeyringChunkParseError
     (([(Maybe TKWithWireRep, [PktWithWireRep])],
       Maybe
         (Maybe (Maybe TKWithWireRep -> Maybe TKWithWireRep),
          Parser [PktWithWireRep] (Maybe TKWithWireRep))),
      [Maybe TKWithWireRep])
forall s r.
(Monoid s, Show s) =>
Parser s r
-> s
-> ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
parseAChunkEither (Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
anyTKWithWireRep Bool
intolerant))
            ([], (Maybe (Maybe TKWithWireRep -> Maybe TKWithWireRep),
 Parser [PktWithWireRep] (Maybe TKWithWireRep))
-> Maybe
     (Maybe (Maybe TKWithWireRep -> Maybe TKWithWireRep),
      Parser [PktWithWireRep] (Maybe TKWithWireRep))
forall a. a -> Maybe a
Just (Maybe (Maybe TKWithWireRep -> Maybe TKWithWireRep)
forall a. Maybe a
Nothing, Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
anyTKWithWireRep Bool
intolerant))
  where
    notTrustPacket :: PktWithWireRep -> Bool
notTrustPacket = Bool -> Bool
not (Bool -> Bool)
-> (PktWithWireRep -> Bool) -> PktWithWireRep -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Bool
isTrustPkt (Pkt -> Bool) -> (PktWithWireRep -> Pkt) -> PktWithWireRep -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue)

sinkPublicKeyringMap
    :: Monad m => ConduitT (TK 'PublicTK) Void m PublicKeyring
sinkPublicKeyringMap :: forall (m :: * -> *).
Monad m =>
ConduitT (TK 'PublicTK) Void m PublicKeyring
sinkPublicKeyringMap = (PublicKeyring -> TK 'PublicTK -> PublicKeyring)
-> PublicKeyring -> ConduitT (TK 'PublicTK) Void m PublicKeyring
forall (m :: * -> *) b a o.
Monad m =>
(b -> a -> b) -> b -> ConduitT a o m b
CL.fold ((TK 'PublicTK -> PublicKeyring -> PublicKeyring)
-> PublicKeyring -> TK 'PublicTK -> PublicKeyring
forall a b c. (a -> b -> c) -> b -> a -> c
flip TK 'PublicTK -> PublicKeyring -> PublicKeyring
forall (ixs :: [*]) a.
Indexable ixs a =>
a -> IxSet ixs a -> IxSet ixs a
insert) PublicKeyring
forall (ixs :: [*]) a. Indexable ixs a => IxSet ixs a
empty

sinkSecretKeyringMap
    :: Monad m => ConduitT (TK 'SecretTK) Void m SecretKeyring
sinkSecretKeyringMap :: forall (m :: * -> *).
Monad m =>
ConduitT (TK 'SecretTK) Void m SecretKeyring
sinkSecretKeyringMap = (SecretKeyring -> TK 'SecretTK -> SecretKeyring)
-> SecretKeyring -> ConduitT (TK 'SecretTK) Void m SecretKeyring
forall (m :: * -> *) b a o.
Monad m =>
(b -> a -> b) -> b -> ConduitT a o m b
CL.fold ((TK 'SecretTK -> SecretKeyring -> SecretKeyring)
-> SecretKeyring -> TK 'SecretTK -> SecretKeyring
forall a b c. (a -> b -> c) -> b -> a -> c
flip TK 'SecretTK -> SecretKeyring -> SecretKeyring
forall (ixs :: [*]) a.
Indexable ixs a =>
a -> IxSet ixs a -> IxSet ixs a
insert) SecretKeyring
forall (ixs :: [*]) a. Indexable ixs a => IxSet ixs a
empty

-- | Lift a single typed TK into its kinded keyring
publicTKToKeyring :: TK 'PublicTK -> PublicKeyring
publicTKToKeyring :: TK 'PublicTK -> PublicKeyring
publicTKToKeyring TK 'PublicTK
tk = TK 'PublicTK -> PublicKeyring -> PublicKeyring
forall (ixs :: [*]) a.
Indexable ixs a =>
a -> IxSet ixs a -> IxSet ixs a
insert TK 'PublicTK
tk PublicKeyring
forall (ixs :: [*]) a. Indexable ixs a => IxSet ixs a
empty

secretTKToKeyring :: TK 'SecretTK -> SecretKeyring
secretTKToKeyring :: TK 'SecretTK -> SecretKeyring
secretTKToKeyring TK 'SecretTK
tk = TK 'SecretTK -> SecretKeyring -> SecretKeyring
forall (ixs :: [*]) a.
Indexable ixs a =>
a -> IxSet ixs a -> IxSet ixs a
insert TK 'SecretTK
tk SecretKeyring
forall (ixs :: [*]) a. Indexable ixs a => IxSet ixs a
empty

-- | Partition a list of SomeTK into homogeneous public and secret keyrings
partitionSomeTKs :: [SomeTK] -> (PublicKeyring, SecretKeyring)
partitionSomeTKs :: [SomeTK] -> (PublicKeyring, SecretKeyring)
partitionSomeTKs = (SomeTK
 -> (PublicKeyring, SecretKeyring)
 -> (PublicKeyring, SecretKeyring))
-> (PublicKeyring, SecretKeyring)
-> [SomeTK]
-> (PublicKeyring, SecretKeyring)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SomeTK
-> (PublicKeyring, SecretKeyring) -> (PublicKeyring, SecretKeyring)
forall {ixs :: [*]} {ixs :: [*]}.
(Indexable ixs (TK 'PublicTK), Indexable ixs (TK 'SecretTK)) =>
SomeTK
-> (IxSet ixs (TK 'PublicTK), IxSet ixs (TK 'SecretTK))
-> (IxSet ixs (TK 'PublicTK), IxSet ixs (TK 'SecretTK))
step (PublicKeyring
forall (ixs :: [*]) a. Indexable ixs a => IxSet ixs a
empty, SecretKeyring
forall (ixs :: [*]) a. Indexable ixs a => IxSet ixs a
empty)
  where
    step :: SomeTK
-> (IxSet ixs (TK 'PublicTK), IxSet ixs (TK 'SecretTK))
-> (IxSet ixs (TK 'PublicTK), IxSet ixs (TK 'SecretTK))
step (SomePublicTK TK 'PublicTK
tk) (IxSet ixs (TK 'PublicTK)
pub, IxSet ixs (TK 'SecretTK)
sec) = (TK 'PublicTK
-> IxSet ixs (TK 'PublicTK) -> IxSet ixs (TK 'PublicTK)
forall (ixs :: [*]) a.
Indexable ixs a =>
a -> IxSet ixs a -> IxSet ixs a
insert TK 'PublicTK
tk IxSet ixs (TK 'PublicTK)
pub, IxSet ixs (TK 'SecretTK)
sec)
    step (SomeSecretTK TK 'SecretTK
tk) (IxSet ixs (TK 'PublicTK)
pub, IxSet ixs (TK 'SecretTK)
sec) = (IxSet ixs (TK 'PublicTK)
pub, TK 'SecretTK
-> IxSet ixs (TK 'SecretTK) -> IxSet ixs (TK 'SecretTK)
forall (ixs :: [*]) a.
Indexable ixs a =>
a -> IxSet ixs a -> IxSet ixs a
insert TK 'SecretTK
tk IxSet ixs (TK 'SecretTK)
sec)