    -- Filter.hs: OpenPGP (RFC4880) packet filtering
    -- Copyright © 2014-2020  Clint Adams
    -- This software is released under the terms of the Expat license.
    -- (See the LICENSE file).
    {-# LANGUAGE GADTs #-}

    module Data.Conduit.OpenPGP.Filter
      ( conduitPktFilter
      , conduitPktWithExtraFilter
      , conduitTKFilter
      , FilterPredicates(..)
      ) where

    import Control.Monad.Trans.Reader (Reader, runReader)
    import Data.Conduit (ConduitT)
    import qualified Data.Conduit.List as CL
    import Data.Void (Void)

    import Codec.Encryption.OpenPGP.Types

    data FilterPredicates r a
      = RTKFilterPredicate (Reader TK Bool) -- ^ fp for transferable keys
      | RPFilterPredicate (Reader Pkt Bool) -- ^ fp for context-less packets
      | RFilterPredicate (Reader a Bool) -- ^ generic filter predicate
      | RPairFilterPredicate (Reader (r, a) Bool) -- ^ generic filter predicate with additional context

    conduitPktFilter ::
         Monad m => FilterPredicates Void Pkt -> ConduitT Pkt Pkt m ()
    conduitPktFilter :: FilterPredicates Void Pkt -> ConduitT Pkt Pkt m ()
    conduitPktFilter = (Pkt -> Bool) -> ConduitT Pkt Pkt m ()
    forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
    CL.filter ((Pkt -> Bool) -> ConduitT Pkt Pkt m ())
    -> (FilterPredicates Void Pkt -> Pkt -> Bool)
    -> FilterPredicates Void Pkt
    -> ConduitT Pkt Pkt m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilterPredicates Void Pkt -> Pkt -> Bool
    superPredicate

    superPredicate :: FilterPredicates Void Pkt -> Pkt -> Bool
    superPredicate :: FilterPredicates Void Pkt -> Pkt -> Bool
    superPredicate (RPFilterPredicate e :: Reader Pkt Bool
    e) p :: Pkt
    p = Reader Pkt Bool -> Pkt -> Bool
    forall r a. Reader r a -> r -> a
    runReader Reader Pkt Bool
    e Pkt
    p
    superPredicate (RFilterPredicate e :: Reader Pkt Bool
    e) p :: Pkt
    p = Reader Pkt Bool -> Pkt -> Bool
    forall r a. Reader r a -> r -> a
    runReader Reader Pkt Bool
    e Pkt
    p
    superPredicate _ _ = Bool
    False -- do not match incorrect type of packet

    conduitTKFilter :: Monad m => FilterPredicates Void TK -> ConduitT TK TK m ()
    conduitTKFilter :: FilterPredicates Void TK -> ConduitT TK TK m ()
    conduitTKFilter = (TK -> Bool) -> ConduitT TK TK m ()
    forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
    CL.filter ((TK -> Bool) -> ConduitT TK TK m ())
    -> (FilterPredicates Void TK -> TK -> Bool)
    -> FilterPredicates Void TK
    -> ConduitT TK TK m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilterPredicates Void TK -> TK -> Bool
    superTKPredicate

    superTKPredicate :: FilterPredicates Void TK -> TK -> Bool
    superTKPredicate :: FilterPredicates Void TK -> TK -> Bool
    superTKPredicate (RTKFilterPredicate e :: Reader TK Bool
    e) = Reader TK Bool -> TK -> Bool
    forall r a. Reader r a -> r -> a
    runReader Reader TK Bool
    e
    superTKPredicate (RFilterPredicate e :: Reader TK Bool
    e) = Reader TK Bool -> TK -> Bool
    forall r a. Reader r a -> r -> a
    runReader Reader TK Bool
    e

    conduitPktWithExtraFilter ::
         Monad m => r -> FilterPredicates r Pkt -> ConduitT Pkt Pkt m ()
    conduitPktWithExtraFilter :: r -> FilterPredicates r Pkt -> ConduitT Pkt Pkt m ()
    conduitPktWithExtraFilter extra :: r
    extra = (Pkt -> Bool) -> ConduitT Pkt Pkt m ()
    forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
    CL.filter ((Pkt -> Bool) -> ConduitT Pkt Pkt m ())
    -> (FilterPredicates r Pkt -> Pkt -> Bool)
    -> FilterPredicates r Pkt
    -> ConduitT Pkt Pkt m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . r -> FilterPredicates r Pkt -> Pkt -> Bool
    forall r a. r -> FilterPredicates r a -> a -> Bool
    superPairPredicate r
    extra

    superPairPredicate :: r -> FilterPredicates r a -> a -> Bool
    superPairPredicate :: r -> FilterPredicates r a -> a -> Bool
    superPairPredicate r :: r
    r (RPairFilterPredicate e :: Reader (r, a) Bool
    e) p :: a
    p = Reader (r, a) Bool -> (r, a) -> Bool
    forall r a. Reader r a -> r -> a
    runReader Reader (r, a) Bool
    e (r
    r, a
    p)