module Data.Conduit.OpenPGP.Filter (
conduitFilter
, FilterPredicates(..)
, Expr(..)
, PKPPredicate(..)
, PKPVar(..)
, PKPOp(..)
, PKPValue(..)
, SPPredicate(..)
, SPVar(..)
, SPOp(..)
, SPValue(..)
, OPredicate(..)
, OVar(..)
, OOp(..)
, OValue(..)
) where
import Control.Error.Util (hush)
import Control.Monad.Trans.Resource (MonadResource)
import qualified Data.ByteString as B
import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.Maybe (fromMaybe)
import Codec.Encryption.OpenPGP.Internal (sigType, sigPKA, sigHA)
import Codec.Encryption.OpenPGP.KeyInfo (pubkeySize)
import Codec.Encryption.OpenPGP.Types
data FilterPredicates = FilterPredicates {
_pubKeyPktPredicate :: Expr PKPPredicate
, _sigPktPredicate :: Expr SPPredicate
, _otherPredicate :: Expr OPredicate
}
data Expr a = EAny
| E a
| EAnd (Expr a) (Expr a)
| EOr (Expr a) (Expr a)
| ENot (Expr a)
eval :: (a -> v -> Bool) -> Expr a -> v -> Bool
eval t e v = ev e
where
ev EAny = True
ev (EAnd e1 e2) = ev e1 && ev e2
ev (EOr e1 e2) = ev e1 || ev e2
ev (ENot e1) = (not . ev) e1
ev (E e') = t e' v
data PKPOp = PKEquals | PKLessThan | PKGreaterThan
data PKPPredicate = PKPPredicate PKPVar PKPOp PKPValue
data PKPVar = PKPVVersion
| PKPVPKA
| PKPVKeysize
| PKPVTimestamp
data PKPValue = PKPInt Int
| PKPPKA PubKeyAlgorithm
deriving Eq
instance Ord PKPValue where
compare i j = compare (pkvToInt i) (pkvToInt j)
pkvToInt (PKPInt i) = i
pkvToInt (PKPPKA i) = fromIntegral (fromFVal i)
data SPOp = SPEquals | SPLessThan | SPGreaterThan
data SPPredicate = SPPredicate SPVar SPOp SPValue
data SPVar = SPVVersion
| SPVSigType
| SPVPKA
| SPVHA
data SPValue = SPInt Int
| SPSigType SigType
| SPPKA PubKeyAlgorithm
| SPHA HashAlgorithm
deriving Eq
instance Ord SPValue where
compare i j = compare (spvToInt i) (spvToInt j)
spvToInt (SPInt i) = i
spvToInt (SPSigType i) = fromIntegral (fromFVal i)
spvToInt (SPPKA i) = fromIntegral (fromFVal i)
spvToInt (SPHA i) = fromIntegral (fromFVal i)
data OOp = OEquals | OLessThan | OGreaterThan
data OPredicate = OPredicate OVar OOp OValue
data OVar = OVTag
data OValue = OInt Int
deriving Eq
instance Ord OValue where
compare i j = compare (ovToInt i) (ovToInt j)
ovToInt (OInt i) = i
conduitFilter :: Monad m => FilterPredicates -> Conduit Pkt m Pkt
conduitFilter = CL.filter . superPredicate
superPredicate :: FilterPredicates -> Pkt -> Bool
superPredicate fp (PublicKeyPkt pkp) = eval pkpEval (_pubKeyPktPredicate fp) pkp
superPredicate fp (SignaturePkt sp) = eval spEval (_sigPktPredicate fp) sp
superPredicate fp p = eval oEval (_otherPredicate fp) p
pkpEval :: PKPPredicate -> PKPayload -> Bool
pkpEval (PKPPredicate lhs o rhs) pkp = uncurry (opreduce o) (vreduce (lhs,pkp),rhs)
where
opreduce PKEquals = (==)
opreduce PKLessThan = (<)
opreduce PKGreaterThan = (>)
vreduce (PKPVVersion, p) = PKPInt (kv (_keyVersion p))
vreduce (PKPVPKA, p) = PKPPKA (_pkalgo p)
vreduce (PKPVKeysize, p) = PKPInt (fromMaybe 0 . hush . pubkeySize . _pubkey $ p)
vreduce (PKPVTimestamp, p) = PKPInt (fromIntegral (_timestamp p))
kv DeprecatedV3 = 3
kv V4 = 4
spEval :: SPPredicate -> SignaturePayload -> Bool
spEval (SPPredicate lhs o rhs) pkp = case vreduce (lhs, pkp) >>= \x -> return (uncurry (opreduce o) (x,rhs)) of
Just True -> True
_ -> False
where
opreduce SPEquals = (==)
opreduce SPLessThan = (<)
opreduce SPGreaterThan = (>)
vreduce (SPVVersion, s) = Just (SPInt (sigVersion s))
vreduce (SPVSigType, s) = fmap SPSigType (sigType s)
vreduce (SPVPKA, s) = fmap SPPKA (sigPKA s)
vreduce (SPVHA, s) = fmap SPHA (sigHA s)
sigVersion (SigV3 {}) = 3
sigVersion (SigV4 {}) = 4
sigVersion (SigVOther v _) = fromIntegral v
oEval :: OPredicate -> Pkt -> Bool
oEval (OPredicate lhs o rhs) pkp = uncurry (opreduce o) (vreduce (lhs,pkp),rhs)
where
opreduce OEquals = (==)
opreduce OLessThan = (<)
opreduce OGreaterThan = (>)
vreduce (OVTag, p) = OInt (fromIntegral (pktTag p))