module Data.Conduit.OpenPGP.Keyring
( conduitToTKs
, conduitToTKsDropping
, sinkKeyringMap
) where
import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.IxSet.Typed (empty, insert)
import Codec.Encryption.OpenPGP.KeyringParser
( anyTK
, finalizeParsing
, parseAChunk
)
import Codec.Encryption.OpenPGP.Ontology (isTrustPkt)
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
/= :: Phase -> Phase -> Bool
$c/= :: Phase -> Phase -> Bool
== :: Phase -> Phase -> Bool
$c== :: 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
min :: Phase -> Phase -> Phase
$cmin :: Phase -> Phase -> Phase
max :: Phase -> Phase -> Phase
$cmax :: Phase -> Phase -> Phase
>= :: Phase -> Phase -> Bool
$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
compare :: Phase -> Phase -> Ordering
$ccompare :: Phase -> Phase -> Ordering
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
showList :: [Phase] -> ShowS
$cshowList :: [Phase] -> ShowS
show :: Phase -> String
$cshow :: Phase -> String
showsPrec :: Int -> Phase -> ShowS
$cshowsPrec :: Int -> Phase -> ShowS
Show)
conduitToTKs :: Monad m => ConduitT Pkt TK m ()
conduitToTKs :: forall (m :: * -> *). Monad m => ConduitT Pkt TK m ()
conduitToTKs = Bool -> ConduitT Pkt TK m ()
forall (m :: * -> *). Monad m => Bool -> ConduitT Pkt TK m ()
conduitToTKs' Bool
True
conduitToTKsDropping :: Monad m => ConduitT Pkt TK m ()
conduitToTKsDropping :: forall (m :: * -> *). Monad m => ConduitT Pkt TK m ()
conduitToTKsDropping = Bool -> ConduitT Pkt TK m ()
forall (m :: * -> *). Monad m => Bool -> ConduitT Pkt TK m ()
conduitToTKs' Bool
False
fakecmAccum ::
Monad m
=> (accum -> (accum, [b]))
-> (a -> accum -> (accum, [b]))
-> accum
-> ConduitT a b m ()
fakecmAccum :: forall (m :: * -> *) accum b a.
Monad m =>
(accum -> (accum, [b]))
-> (a -> accum -> (accum, [b])) -> accum -> ConduitT a b m ()
fakecmAccum accum -> (accum, [b])
finalizer a -> accum -> (accum, [b])
f = accum -> ConduitT a b m ()
forall {m :: * -> *}. Monad m => accum -> ConduitT a b m ()
loop
where
loop :: accum -> ConduitT a b m ()
loop accum
accum = ConduitT a b m (Maybe a)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT a b m (Maybe a)
-> (Maybe a -> ConduitT a b m ()) -> ConduitT a b m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT a b m ()
-> (a -> ConduitT a b m ()) -> Maybe a -> ConduitT a b m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((b -> ConduitT a b m ()) -> [b] -> ConduitT a b m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> ConduitT a b m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ((accum, [b]) -> [b]
forall a b. (a, b) -> b
snd (accum -> (accum, [b])
finalizer accum
accum))) a -> ConduitT a b m ()
go
where
go :: a -> ConduitT a b m ()
go a
a = do
let (accum
accum', [b]
bs) = a -> accum -> (accum, [b])
f a
a accum
accum
(b -> ConduitT a b m ()) -> [b] -> ConduitT a b m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> ConduitT a b m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [b]
bs
accum -> ConduitT a b m ()
loop accum
accum'
conduitToTKs' :: Monad m => Bool -> ConduitT Pkt TK m ()
conduitToTKs' :: forall (m :: * -> *). Monad m => Bool -> ConduitT Pkt TK m ()
conduitToTKs' 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 ()
-> ConduitM Pkt TK m () -> ConduitM Pkt TK m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM 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 ()
-> ConduitM [Pkt] TK m () -> ConduitM Pkt TK m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
(([(Maybe TK, [Pkt])],
Maybe (Maybe (Maybe TK -> Maybe TK), Parser [Pkt] (Maybe TK)))
-> (([(Maybe TK, [Pkt])],
Maybe (Maybe (Maybe TK -> Maybe TK), Parser [Pkt] (Maybe TK))),
[Maybe TK]))
-> ([Pkt]
-> ([(Maybe TK, [Pkt])],
Maybe (Maybe (Maybe TK -> Maybe TK), Parser [Pkt] (Maybe TK)))
-> (([(Maybe TK, [Pkt])],
Maybe (Maybe (Maybe TK -> Maybe TK), Parser [Pkt] (Maybe TK))),
[Maybe TK]))
-> ([(Maybe TK, [Pkt])],
Maybe (Maybe (Maybe TK -> Maybe TK), Parser [Pkt] (Maybe TK)))
-> ConduitT [Pkt] (Maybe TK) m ()
forall (m :: * -> *) accum b a.
Monad m =>
(accum -> (accum, [b]))
-> (a -> accum -> (accum, [b])) -> accum -> ConduitT a b m ()
fakecmAccum
([(Maybe TK, [Pkt])],
Maybe (Maybe (Maybe TK -> Maybe TK), Parser [Pkt] (Maybe TK)))
-> (([(Maybe TK, [Pkt])],
Maybe (Maybe (Maybe TK -> Maybe TK), Parser [Pkt] (Maybe TK))),
[Maybe TK])
forall s r.
Monoid s =>
([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
finalizeParsing
(Parser [Pkt] (Maybe TK)
-> [Pkt]
-> ([(Maybe TK, [Pkt])],
Maybe (Maybe (Maybe TK -> Maybe TK), Parser [Pkt] (Maybe TK)))
-> (([(Maybe TK, [Pkt])],
Maybe (Maybe (Maybe TK -> Maybe TK), Parser [Pkt] (Maybe TK))),
[Maybe TK])
forall s r.
(Monoid s, Show s) =>
Parser s r
-> s
-> ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
parseAChunk (Bool -> Parser [Pkt] (Maybe TK)
anyTK Bool
intolerant))
([], (Maybe (Maybe TK -> Maybe TK), Parser [Pkt] (Maybe TK))
-> Maybe (Maybe (Maybe TK -> Maybe TK), Parser [Pkt] (Maybe TK))
forall a. a -> Maybe a
Just (Maybe (Maybe TK -> Maybe TK)
forall a. Maybe a
Nothing, Bool -> Parser [Pkt] (Maybe TK)
anyTK Bool
intolerant)) ConduitT [Pkt] (Maybe TK) m ()
-> ConduitM (Maybe TK) TK m () -> ConduitM [Pkt] TK m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
ConduitM (Maybe TK) TK m ()
forall (m :: * -> *) a. Monad m => ConduitT (Maybe a) a m ()
CL.catMaybes
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
sinkKeyringMap :: Monad m => ConduitT TK Void m Keyring
sinkKeyringMap :: forall (m :: * -> *). Monad m => ConduitT TK Void m Keyring
sinkKeyringMap = (Keyring -> TK -> Keyring) -> Keyring -> ConduitT TK Void m Keyring
forall (m :: * -> *) b a o.
Monad m =>
(b -> a -> b) -> b -> ConduitT a o m b
CL.fold ((TK -> Keyring -> Keyring) -> Keyring -> TK -> Keyring
forall a b c. (a -> b -> c) -> b -> a -> c
flip TK -> Keyring -> Keyring
forall (ixs :: [*]) a.
Indexable ixs a =>
a -> IxSet ixs a -> IxSet ixs a
insert) Keyring
forall (ixs :: [*]) a. Indexable ixs a => IxSet ixs a
empty