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

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) -- FIXME: a Left here should invalidate the predicate or something
        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))