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

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

import Control.Monad.Trans.Reader (Reader, runReader)
import Data.Conduit (ConduitT)
import qualified Data.Conduit.List as CL
import Data.Typeable (Typeable, eqT, (:~:) (Refl))
import Data.Void (Void)

import Codec.Encryption.OpenPGP.Types

data FilterPredicates r a
    = -- | fp for transferable keys
      RTKFilterPredicate (Reader TKUnknown Bool)
    | -- | fp for context-less packets
      RPFilterPredicate (Reader Pkt Bool)
    | -- | generic filter predicate
      RFilterPredicate (Reader a Bool)
    | -- | generic filter predicate with additional context
      RPairFilterPredicate (Reader (r, a) Bool)
{-# DEPRECATED RTKFilterPredicate "Use RFilterPredicate with SomeTK instead" #-}

runPredicate
    :: forall r a. Typeable a => FilterPredicates r a -> a -> Bool
runPredicate :: forall r a. Typeable a => FilterPredicates r a -> a -> Bool
runPredicate (RTKFilterPredicate Reader TKUnknown Bool
e) = case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @a @TKUnknown of
    Just a :~: TKUnknown
Refl -> Reader a Bool -> a -> Bool
forall r a. Reader r a -> r -> a
runReader Reader a Bool
Reader TKUnknown Bool
e
    Maybe (a :~: TKUnknown)
Nothing -> Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
False
runPredicate (RFilterPredicate Reader a Bool
e) = Reader a Bool -> a -> Bool
forall r a. Reader r a -> r -> a
runReader Reader a Bool
e
runPredicate FilterPredicates r a
_ = Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
False

conduitPktFilter
    :: Monad m => FilterPredicates Void Pkt -> ConduitT Pkt Pkt m ()
conduitPktFilter :: forall (m :: * -> *).
Monad m =>
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 Reader Pkt Bool
e) Pkt
p = Reader Pkt Bool -> Pkt -> Bool
forall r a. Reader r a -> r -> a
runReader Reader Pkt Bool
e Pkt
p
superPredicate (RFilterPredicate Reader Pkt Bool
e) Pkt
p = Reader Pkt Bool -> Pkt -> Bool
forall r a. Reader r a -> r -> a
runReader Reader Pkt Bool
e Pkt
p
superPredicate FilterPredicates Void Pkt
_ Pkt
_ = Bool
False -- do not match incorrect type of packet

{-# DEPRECATED
    conduitTKFilter
    "Use (CL.filter . runPredicate) with RFilterPredicate instead"
    #-}
conduitTKFilter
    :: Monad m
    => FilterPredicates Void TKUnknown
    -> ConduitT TKUnknown TKUnknown m ()
conduitTKFilter :: forall (m :: * -> *).
Monad m =>
FilterPredicates Void TKUnknown
-> ConduitT TKUnknown TKUnknown m ()
conduitTKFilter = (TKUnknown -> Bool) -> ConduitT TKUnknown TKUnknown m ()
forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
CL.filter ((TKUnknown -> Bool) -> ConduitT TKUnknown TKUnknown m ())
-> (FilterPredicates Void TKUnknown -> TKUnknown -> Bool)
-> FilterPredicates Void TKUnknown
-> ConduitT TKUnknown TKUnknown m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilterPredicates Void TKUnknown -> TKUnknown -> Bool
superTKPredicate

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

conduitPktWithExtraFilter
    :: Monad m => r -> FilterPredicates r Pkt -> ConduitT Pkt Pkt m ()
conduitPktWithExtraFilter :: forall (m :: * -> *) r.
Monad m =>
r -> FilterPredicates r Pkt -> ConduitT Pkt Pkt m ()
conduitPktWithExtraFilter 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 :: forall r a. r -> FilterPredicates r a -> a -> Bool
superPairPredicate r
r (RPairFilterPredicate Reader (r, a) Bool
e) 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)