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

module Data.Conduit.OpenPGP.Keyring
  ( conduitToUnknownTKs
  , TypedTKConduitError(..)
  , conduitToSomeTKsEither
  , conduitToSomeTKsDropping
  , conduitToSomeTKsDroppingEither
  , conduitToTKs
  , conduitToPublicTKs
  , conduitToPublicViewTKs
  , conduitToSecretTKs
  , AuthSecretSubkeyUID(..)
  , AuthSecretSubkeyAtTime(..)
  , AuthSecretSubkeyRejectionReason(..)
  , AuthSecretSubkeyRejectedAtTime(..)
  , AuthSecretSubkeysAtReport(..)
  , authSecretSubkeysAt
  , authSecretSubkeysAtReport
  , conduitToAuthSecretSubkeysAt
  , conduitToAuthSecretSubkeysAtReport
  , conduitToTKsDropping
  , conduitToTKsEither
  , conduitToTKsDroppingEither
  , conduitToTKsWithWireRep
  , conduitToTKsDroppingWithWireRep
  , conduitToTKsWithWireRepEither
  , conduitToTKsDroppingWithWireRepEither
  , KeyringChunkParseError(..)
  , sinkPublicKeyringMap
  , sinkSecretKeyringMap
  , publicTKToKeyring
  , secretTKToKeyring
  , partitionSomeTKs
  ) where

import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.Bifunctor (first)
import Data.List (find)
import Data.Maybe (maybeToList)
import qualified Data.Set as Set
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Data.IxSet.Typed (empty, insert)

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

-- | Deprecated: this conduit silently drops parse failures and parse-time
-- omissions. Prefer 'conduitToTKsEither' and handle errors explicitly.
conduitToUnknownTKs :: Monad m => ConduitT Pkt TKUnknown m ()
conduitToUnknownTKs :: forall (m :: * -> *). Monad m => ConduitT Pkt TKUnknown m ()
conduitToUnknownTKs =
  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)) TKUnknown m ()
-> ConduitT Pkt TKUnknown m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
  ConduitT
  (Either KeyringChunkParseError (Maybe TKUnknown)) TKUnknown m ()
forall (m :: * -> *) e a.
Monad m =>
ConduitT (Either e (Maybe a)) a m ()
conduitDropErrorsAndNothings
{-# DEPRECATED conduitToUnknownTKs "Use conduitToTKsEither and handle Left/Maybe explicitly." #-}

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

-- | Deprecated: this conduit silently drops parse+conversion failures.
-- Prefer 'conduitToSomeTKsEither' and handle errors explicitly.
conduitToSomeTKsDropping :: Monad m => ConduitT Pkt SomeTK m ()
conduitToSomeTKsDropping :: forall (m :: * -> *). Monad m => ConduitT Pkt SomeTK m ()
conduitToSomeTKsDropping =
  ConduitT Pkt (Either TypedTKConduitError (Maybe SomeTK)) m ()
forall (m :: * -> *).
Monad m =>
ConduitT Pkt (Either TypedTKConduitError (Maybe SomeTK)) m ()
conduitToSomeTKsDroppingEither ConduitT Pkt (Either TypedTKConduitError (Maybe SomeTK)) m ()
-> ConduitT (Either TypedTKConduitError (Maybe SomeTK)) SomeTK m ()
-> ConduitT Pkt SomeTK m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
  ConduitT (Either TypedTKConduitError (Maybe SomeTK)) SomeTK m ()
forall (m :: * -> *) e a.
Monad m =>
ConduitT (Either e (Maybe a)) a m ()
conduitDropErrorsAndNothings
{-# DEPRECATED conduitToSomeTKsDropping "Use conduitToSomeTKsEither and handle Left/Maybe explicitly." #-}

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

-- | Deprecated: this conduit silently drops parse+conversion failures.
-- Prefer 'conduitToSomeTKsEither' and handle errors explicitly.
conduitToTKs :: Monad m => ConduitT Pkt SomeTK m ()
conduitToTKs :: forall (m :: * -> *). Monad m => ConduitT Pkt SomeTK m ()
conduitToTKs =
  ConduitT Pkt TKUnknown m ()
forall (m :: * -> *). Monad m => ConduitT Pkt TKUnknown m ()
conduitToUnknownTKs ConduitT Pkt TKUnknown m ()
-> ConduitT TKUnknown SomeTK m () -> ConduitT Pkt SomeTK m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
  (TKUnknown -> Maybe SomeTK) -> ConduitT TKUnknown SomeTK m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> Maybe b) -> ConduitT a b m ()
CL.mapMaybe ((TKConversionError -> Maybe SomeTK)
-> (SomeTK -> Maybe SomeTK)
-> Either TKConversionError SomeTK
-> Maybe SomeTK
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe SomeTK -> TKConversionError -> Maybe SomeTK
forall a b. a -> b -> a
const Maybe SomeTK
forall a. Maybe a
Nothing) SomeTK -> Maybe SomeTK
forall a. a -> Maybe a
Just (Either TKConversionError SomeTK -> Maybe SomeTK)
-> (TKUnknown -> Either TKConversionError SomeTK)
-> TKUnknown
-> Maybe SomeTK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TKUnknown -> Either TKConversionError SomeTK
fromUnknownToTKEither)
{-# DEPRECATED conduitToTKs "Use conduitToSomeTKsEither and handle Left/Maybe explicitly." #-}

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

conduitToPublicTKs :: Monad m => ConduitT Pkt (TK 'PublicTK) m ()
conduitToPublicTKs :: forall (m :: * -> *). Monad m => ConduitT Pkt (TK 'PublicTK) m ()
conduitToPublicTKs =
  ConduitT Pkt SomeTK m ()
forall (m :: * -> *). Monad m => ConduitT Pkt SomeTK m ()
conduitToTKs ConduitT Pkt SomeTK m ()
-> ConduitT SomeTK (TK 'PublicTK) m ()
-> ConduitT Pkt (TK 'PublicTK) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
  (SomeTK -> Maybe (TK 'PublicTK))
-> ConduitT SomeTK (TK 'PublicTK) m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> Maybe b) -> ConduitT a b m ()
CL.mapMaybe SomeTK -> Maybe (TK 'PublicTK)
someTKToPublicTK
{-# DEPRECATED conduitToPublicTKs "Use conduitToSomeTKsEither and perform explicit projection/filtering." #-}

-- | Yield public TKs from any input: native public TKs pass through,
-- secret TKs are stripped to their public view
conduitToPublicViewTKs :: Monad m => ConduitT Pkt (TK 'PublicTK) m ()
conduitToPublicViewTKs :: forall (m :: * -> *). Monad m => ConduitT Pkt (TK 'PublicTK) m ()
conduitToPublicViewTKs =
  ConduitT Pkt SomeTK m ()
forall (m :: * -> *). Monad m => ConduitT Pkt SomeTK m ()
conduitToTKs ConduitT Pkt SomeTK m ()
-> ConduitT SomeTK (TK 'PublicTK) m ()
-> ConduitT Pkt (TK 'PublicTK) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
  (SomeTK -> TK 'PublicTK) -> ConduitT SomeTK (TK 'PublicTK) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map SomeTK -> TK 'PublicTK
someTKToPublicViewTK
{-# DEPRECATED conduitToPublicViewTKs "Use conduitToSomeTKsEither and perform explicit projection." #-}

conduitToSecretTKs :: Monad m => ConduitT Pkt (TK 'SecretTK) m ()
conduitToSecretTKs :: forall (m :: * -> *). Monad m => ConduitT Pkt (TK 'SecretTK) m ()
conduitToSecretTKs =
  ConduitT Pkt SomeTK m ()
forall (m :: * -> *). Monad m => ConduitT Pkt SomeTK m ()
conduitToTKs ConduitT Pkt SomeTK m ()
-> ConduitT SomeTK (TK 'SecretTK) m ()
-> ConduitT Pkt (TK 'SecretTK) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
  (SomeTK -> Maybe (TK 'SecretTK))
-> ConduitT SomeTK (TK 'SecretTK) m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> Maybe b) -> ConduitT a b m ()
CL.mapMaybe SomeTK -> Maybe (TK 'SecretTK)
someTKToSecretTK
{-# DEPRECATED conduitToSecretTKs "Use conduitToSomeTKsEither and perform explicit projection/filtering." #-}

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 ((Pkt
 -> Maybe UTCTime
 -> ByteString
 -> Either VerificationError Verification)
-> Pkt
-> PktStreamContext
-> Maybe UTCTime
-> Either VerificationError Verification
verifySigWith ([TKUnknown]
-> Pkt
-> Maybe UTCTime
-> ByteString
-> Either VerificationError Verification
verifyAgainstKeys [TKUnknown
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 -> TKUnknown -> Bool
isTKTimeValid UTCTime
validationTime (TK 'SecretTK -> TKUnknown
forall (k :: TKKind). TK k -> TKUnknown
tkToUnknown TK 'SecretTK
verifiedTk)) ->
          let uids :: [AuthSecretSubkeyUID]
uids = UTCTime -> TKUnknown -> [AuthSecretSubkeyUID]
uidContextsAt UTCTime
validationTime (TK 'SecretTK -> TKUnknown
forall (k :: TKKind). TK k -> TKUnknown
tkToUnknown 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 -> TKUnknown -> [AuthSecretSubkeyUID]
uidContextsAt UTCTime
validationTime (TK 'SecretTK -> TKUnknown
forall (k :: TKKind). TK k -> TKUnknown
tkToUnknown 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 :: TKUnknown
untyped = TK 'SecretTK -> TKUnknown
forall (k :: TKKind). TK k -> TKUnknown
tkToUnknown 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 -> TKUnknown -> [AuthSecretSubkeyUID]
uidContextsAt :: UTCTime -> TKUnknown -> [AuthSecretSubkeyUID]
uidContextsAt UTCTime
validationTime TKUnknown
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
         })
    (TKUnknown -> [(Text, [SignaturePayload])]
_tkuUIDs TKUnknown
tk)
  where
    primaryUid :: Maybe Text
primaryUid = UTCTime -> [(Text, [SignaturePayload])] -> Maybe Text
primaryUIDAt UTCTime
validationTime (TKUnknown -> [(Text, [SignaturePayload])]
_tkuUIDs TKUnknown
tk)

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)

latestEffectiveBindingSignatureAt :: UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestEffectiveBindingSignatureAt :: UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestEffectiveBindingSignatureAt 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
isSubkeyBindingSig 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)
    ]

latestEffectiveCertificationAt :: UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestEffectiveCertificationAt :: UTCTime -> [SignaturePayload] -> Maybe SignaturePayload
latestEffectiveCertificationAt 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
isCertificationSig 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)
    ]

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)

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 -> Bool) -> [SigSubPacket] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
    (\SigSubPacket
sp ->
       case SigSubPacket
sp of
         SigSubPacket Bool
_ (PrimaryUserId Bool
True) -> Bool
True
         SigSubPacket
_ -> Bool
False)
    ([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))

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: this conduit silently drops parse failures and parse-time
-- omissions. Prefer 'conduitToTKsDroppingEither' when tolerant parsing is
-- needed, or 'conduitToTKsEither' for strict parsing.
conduitToTKsDropping :: Monad m => ConduitT Pkt TKUnknown m ()
conduitToTKsDropping :: forall (m :: * -> *). Monad m => ConduitT Pkt TKUnknown m ()
conduitToTKsDropping =
  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)) TKUnknown m ()
-> ConduitT Pkt TKUnknown m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
  ConduitT
  (Either KeyringChunkParseError (Maybe TKUnknown)) TKUnknown m ()
forall (m :: * -> *) e a.
Monad m =>
ConduitT (Either e (Maybe a)) a m ()
conduitDropErrorsAndNothings
{-# DEPRECATED conduitToTKsDropping "Use conduitToTKsDroppingEither or conduitToTKsEither and handle Left/Maybe explicitly." #-}

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

conduitToTKsWithWireRep :: Monad m => ConduitT PktWithWireRep TKWithWireRep m ()
conduitToTKsWithWireRep :: forall (m :: * -> *).
Monad m =>
ConduitT PktWithWireRep TKWithWireRep m ()
conduitToTKsWithWireRep =
  ConduitT
  PktWithWireRep
  (Either KeyringChunkParseError (Maybe TKWithWireRep))
  m
  ()
forall (m :: * -> *).
Monad m =>
ConduitT
  PktWithWireRep
  (Either KeyringChunkParseError (Maybe TKWithWireRep))
  m
  ()
conduitToTKsWithWireRepEither ConduitT
  PktWithWireRep
  (Either KeyringChunkParseError (Maybe TKWithWireRep))
  m
  ()
-> ConduitT
     (Either KeyringChunkParseError (Maybe TKWithWireRep))
     TKWithWireRep
     m
     ()
-> ConduitT PktWithWireRep TKWithWireRep m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
  ConduitT
  (Either KeyringChunkParseError (Maybe TKWithWireRep))
  TKWithWireRep
  m
  ()
forall (m :: * -> *) e a.
Monad m =>
ConduitT (Either e (Maybe a)) a m ()
conduitDropErrorsAndNothings
{-# DEPRECATED conduitToTKsWithWireRep "Use conduitToTKsWithWireRepEither and handle Left/Maybe explicitly." #-}

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

conduitToTKsDroppingWithWireRep ::
     Monad m => ConduitT PktWithWireRep TKWithWireRep m ()
conduitToTKsDroppingWithWireRep :: forall (m :: * -> *).
Monad m =>
ConduitT PktWithWireRep TKWithWireRep m ()
conduitToTKsDroppingWithWireRep =
  ConduitT
  PktWithWireRep
  (Either KeyringChunkParseError (Maybe TKWithWireRep))
  m
  ()
forall (m :: * -> *).
Monad m =>
ConduitT
  PktWithWireRep
  (Either KeyringChunkParseError (Maybe TKWithWireRep))
  m
  ()
conduitToTKsDroppingWithWireRepEither ConduitT
  PktWithWireRep
  (Either KeyringChunkParseError (Maybe TKWithWireRep))
  m
  ()
-> ConduitT
     (Either KeyringChunkParseError (Maybe TKWithWireRep))
     TKWithWireRep
     m
     ()
-> ConduitT PktWithWireRep TKWithWireRep m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.|
  ConduitT
  (Either KeyringChunkParseError (Maybe TKWithWireRep))
  TKWithWireRep
  m
  ()
forall (m :: * -> *) e a.
Monad m =>
ConduitT (Either e (Maybe a)) a m ()
conduitDropErrorsAndNothings
{-# DEPRECATED conduitToTKsDroppingWithWireRep "Use conduitToTKsDroppingWithWireRepEither or conduitToTKsWithWireRepEither and handle Left/Maybe explicitly." #-}

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 ((e -> Maybe a)
-> (Maybe a -> Maybe a) -> Either e (Maybe a) -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> e -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) Maybe a -> Maybe a
forall a. a -> a
id)

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