-- Filter.hs: OpenPGP (RFC4880) packet filtering
-- Copyright © 2014-2018  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
  , conduitTKFilter
  , FilterPredicates(..)
  ) where

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

import Codec.Encryption.OpenPGP.Types

data FilterPredicates
  = RTKFilterPredicate (Reader TK Bool) -- ^ fp for transferable keys
  | RPFilterPredicate (Reader Pkt Bool) -- ^ fp for context-less packets

conduitPktFilter :: Monad m => FilterPredicates -> ConduitT Pkt Pkt m ()
conduitPktFilter :: FilterPredicates -> 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 -> Pkt -> Bool)
-> FilterPredicates
-> ConduitT Pkt Pkt m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilterPredicates -> Pkt -> Bool
superPredicate

superPredicate :: FilterPredicates -> Pkt -> Bool
superPredicate :: FilterPredicates -> 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 _ _ = Bool
False -- do not match incorrect type of packet

conduitTKFilter :: Monad m => FilterPredicates -> ConduitT TK TK m ()
conduitTKFilter :: FilterPredicates -> 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 -> TK -> Bool)
-> FilterPredicates
-> ConduitT TK TK m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilterPredicates -> TK -> Bool
superTKPredicate

superTKPredicate :: FilterPredicates -> TK -> Bool
superTKPredicate :: FilterPredicates -> 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