{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Auth.Biscuit.Datalog.AST
(
Binary (..)
, Block
, EvalBlock
, Block' (..)
, BlockElement' (..)
, CheckKind (..)
, Check
, EvalCheck
, Check' (..)
, Expression
, Expression' (..)
, Fact
, ToTerm (..)
, FromValue (..)
, Term
, Term' (..)
, IsWithinSet (..)
, Op (..)
, DatalogContext (..)
, EvaluationContext (..)
, Policy
, EvalPolicy
, Policy'
, PolicyType (..)
, Predicate
, Predicate' (..)
, PredicateOrFact (..)
, QQTerm
, Query
, Query'
, QueryItem' (..)
, Rule
, EvalRule
, Rule' (..)
, RuleScope' (..)
, RuleScope
, EvalRuleScope
, SetType
, Slice (..)
, PkOrSlice (..)
, SliceType
, BlockIdType
, Unary (..)
, Value
, VariableType
, Authorizer
, Authorizer' (..)
, AuthorizerElement' (..)
, ToEvaluation (..)
, makeRule
, makeQueryItem
, checkToEvaluation
, policyToEvaluation
, elementToBlock
, elementToAuthorizer
, extractVariables
, fromStack
, listSymbolsInBlock
, listPublicKeysInBlock
, queryHasNoScope
, queryHasNoV4Operators
, ruleHasNoScope
, ruleHasNoV4Operators
, isCheckOne
, renderBlock
, renderAuthorizer
, renderFact
, renderRule
, valueToSetTerm
, toStack
, substituteAuthorizer
, substituteBlock
, substituteCheck
, substituteExpression
, substituteFact
, substitutePolicy
, substitutePredicate
, substitutePTerm
, substituteQuery
, substituteRule
, substituteTerm
) where
import Control.Applicative ((<|>))
import Control.Monad ((<=<))
import Data.ByteString (ByteString)
import Data.Foldable (fold, toList)
import Data.Function (on)
import Data.Int (Int64)
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (mapMaybe)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.String (IsString)
import Data.Text (Text, intercalate, pack, unpack)
import Data.Time (UTCTime, defaultTimeLocale,
formatTime)
import Data.Void (Void, absurd)
import Instances.TH.Lift ()
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Numeric.Natural (Natural)
import Validation (Validation (..), failure)
import Auth.Biscuit.Crypto (PublicKey, pkBytes)
import Auth.Biscuit.Utils (encodeHex)
data IsWithinSet = NotWithinSet | WithinSet
data DatalogContext
= WithSlices
| Representation
data EvaluationContext = Repr | Eval
data PredicateOrFact = InPredicate | InFact
type family VariableType (inSet :: IsWithinSet) (pof :: PredicateOrFact) where
VariableType 'NotWithinSet 'InPredicate = Text
VariableType inSet pof = Void
newtype Slice = Slice Text
deriving newtype (Slice -> Slice -> Bool
(Slice -> Slice -> Bool) -> (Slice -> Slice -> Bool) -> Eq Slice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Slice -> Slice -> Bool
== :: Slice -> Slice -> Bool
$c/= :: Slice -> Slice -> Bool
/= :: Slice -> Slice -> Bool
Eq, Int -> Slice -> ShowS
[Slice] -> ShowS
Slice -> String
(Int -> Slice -> ShowS)
-> (Slice -> String) -> ([Slice] -> ShowS) -> Show Slice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Slice -> ShowS
showsPrec :: Int -> Slice -> ShowS
$cshow :: Slice -> String
show :: Slice -> String
$cshowList :: [Slice] -> ShowS
showList :: [Slice] -> ShowS
Show, Eq Slice
Eq Slice
-> (Slice -> Slice -> Ordering)
-> (Slice -> Slice -> Bool)
-> (Slice -> Slice -> Bool)
-> (Slice -> Slice -> Bool)
-> (Slice -> Slice -> Bool)
-> (Slice -> Slice -> Slice)
-> (Slice -> Slice -> Slice)
-> Ord Slice
Slice -> Slice -> Bool
Slice -> Slice -> Ordering
Slice -> Slice -> Slice
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Slice -> Slice -> Ordering
compare :: Slice -> Slice -> Ordering
$c< :: Slice -> Slice -> Bool
< :: Slice -> Slice -> Bool
$c<= :: Slice -> Slice -> Bool
<= :: Slice -> Slice -> Bool
$c> :: Slice -> Slice -> Bool
> :: Slice -> Slice -> Bool
$c>= :: Slice -> Slice -> Bool
>= :: Slice -> Slice -> Bool
$cmax :: Slice -> Slice -> Slice
max :: Slice -> Slice -> Slice
$cmin :: Slice -> Slice -> Slice
min :: Slice -> Slice -> Slice
Ord, String -> Slice
(String -> Slice) -> IsString Slice
forall a. (String -> a) -> IsString a
$cfromString :: String -> Slice
fromString :: String -> Slice
IsString)
instance Lift Slice where
lift :: forall (m :: * -> *). Quote m => Slice -> m Exp
lift (Slice Text
name) = [| toTerm $(Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Name -> m Exp) -> Name -> m Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
name) |]
#if MIN_VERSION_template_haskell(2,17,0)
liftTyped :: forall (m :: * -> *). Quote m => Slice -> Code m Slice
liftTyped = m (TExp Slice) -> Code m Slice
forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode (m (TExp Slice) -> Code m Slice)
-> (Slice -> m (TExp Slice)) -> Slice -> Code m Slice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Exp -> m (TExp Slice)
forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerce (m Exp -> m (TExp Slice))
-> (Slice -> m Exp) -> Slice -> m (TExp Slice)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slice -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Slice -> m Exp
lift
#else
liftTyped = unsafeTExpCoerce . lift
#endif
type family SliceType (ctx :: DatalogContext) where
SliceType 'Representation = Void
SliceType 'WithSlices = Slice
data PkOrSlice
= PkSlice Text
| Pk PublicKey
deriving (PkOrSlice -> PkOrSlice -> Bool
(PkOrSlice -> PkOrSlice -> Bool)
-> (PkOrSlice -> PkOrSlice -> Bool) -> Eq PkOrSlice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PkOrSlice -> PkOrSlice -> Bool
== :: PkOrSlice -> PkOrSlice -> Bool
$c/= :: PkOrSlice -> PkOrSlice -> Bool
/= :: PkOrSlice -> PkOrSlice -> Bool
Eq, Int -> PkOrSlice -> ShowS
[PkOrSlice] -> ShowS
PkOrSlice -> String
(Int -> PkOrSlice -> ShowS)
-> (PkOrSlice -> String)
-> ([PkOrSlice] -> ShowS)
-> Show PkOrSlice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PkOrSlice -> ShowS
showsPrec :: Int -> PkOrSlice -> ShowS
$cshow :: PkOrSlice -> String
show :: PkOrSlice -> String
$cshowList :: [PkOrSlice] -> ShowS
showList :: [PkOrSlice] -> ShowS
Show, Eq PkOrSlice
Eq PkOrSlice
-> (PkOrSlice -> PkOrSlice -> Ordering)
-> (PkOrSlice -> PkOrSlice -> Bool)
-> (PkOrSlice -> PkOrSlice -> Bool)
-> (PkOrSlice -> PkOrSlice -> Bool)
-> (PkOrSlice -> PkOrSlice -> Bool)
-> (PkOrSlice -> PkOrSlice -> PkOrSlice)
-> (PkOrSlice -> PkOrSlice -> PkOrSlice)
-> Ord PkOrSlice
PkOrSlice -> PkOrSlice -> Bool
PkOrSlice -> PkOrSlice -> Ordering
PkOrSlice -> PkOrSlice -> PkOrSlice
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PkOrSlice -> PkOrSlice -> Ordering
compare :: PkOrSlice -> PkOrSlice -> Ordering
$c< :: PkOrSlice -> PkOrSlice -> Bool
< :: PkOrSlice -> PkOrSlice -> Bool
$c<= :: PkOrSlice -> PkOrSlice -> Bool
<= :: PkOrSlice -> PkOrSlice -> Bool
$c> :: PkOrSlice -> PkOrSlice -> Bool
> :: PkOrSlice -> PkOrSlice -> Bool
$c>= :: PkOrSlice -> PkOrSlice -> Bool
>= :: PkOrSlice -> PkOrSlice -> Bool
$cmax :: PkOrSlice -> PkOrSlice -> PkOrSlice
max :: PkOrSlice -> PkOrSlice -> PkOrSlice
$cmin :: PkOrSlice -> PkOrSlice -> PkOrSlice
min :: PkOrSlice -> PkOrSlice -> PkOrSlice
Ord)
instance Lift PkOrSlice where
lift :: forall (m :: * -> *). Quote m => PkOrSlice -> m Exp
lift (PkSlice Text
name) = [| $(Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Name -> m Exp) -> Name -> m Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
name) |]
lift (Pk PublicKey
pk) = [| pk |]
#if MIN_VERSION_template_haskell(2,17,0)
liftTyped :: forall (m :: * -> *). Quote m => PkOrSlice -> Code m PkOrSlice
liftTyped = m (TExp PkOrSlice) -> Code m PkOrSlice
forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode (m (TExp PkOrSlice) -> Code m PkOrSlice)
-> (PkOrSlice -> m (TExp PkOrSlice))
-> PkOrSlice
-> Code m PkOrSlice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Exp -> m (TExp PkOrSlice)
forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerce (m Exp -> m (TExp PkOrSlice))
-> (PkOrSlice -> m Exp) -> PkOrSlice -> m (TExp PkOrSlice)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkOrSlice -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => PkOrSlice -> m Exp
lift
#else
liftTyped = unsafeTExpCoerce . lift
#endif
type family SetType (inSet :: IsWithinSet) (ctx :: DatalogContext) where
SetType 'NotWithinSet ctx = Set (Term' 'WithinSet 'InFact ctx)
SetType 'WithinSet ctx = Void
type family BlockIdType (evalCtx :: EvaluationContext) (ctx :: DatalogContext) where
BlockIdType 'Repr 'WithSlices = PkOrSlice
BlockIdType 'Repr 'Representation = PublicKey
BlockIdType 'Eval 'Representation = (Set Natural, PublicKey)
data Term' (inSet :: IsWithinSet) (pof :: PredicateOrFact) (ctx :: DatalogContext) =
Variable (VariableType inSet pof)
| LInteger Int64
| LString Text
| LDate UTCTime
| LBytes ByteString
| LBool Bool
| Antiquote (SliceType ctx)
| TermSet (SetType inSet ctx)
deriving instance ( Eq (VariableType inSet pof)
, Eq (SliceType ctx)
, Eq (SetType inSet ctx)
) => Eq (Term' inSet pof ctx)
deriving instance ( Ord (VariableType inSet pof)
, Ord (SliceType ctx)
, Ord (SetType inSet ctx)
) => Ord (Term' inSet pof ctx)
deriving instance ( Show (VariableType inSet pof)
, Show (SliceType ctx)
, Show (SetType inSet ctx)
) => Show (Term' inSet pof ctx)
type Term = Term' 'NotWithinSet 'InPredicate 'Representation
type QQTerm = Term' 'NotWithinSet 'InPredicate 'WithSlices
type Value = Term' 'NotWithinSet 'InFact 'Representation
type SetValue = Term' 'WithinSet 'InFact 'Representation
instance ( Lift (VariableType inSet pof)
, Lift (SetType inSet ctx)
, Lift (SliceType ctx)
)
=> Lift (Term' inSet pof ctx) where
lift :: forall (m :: * -> *). Quote m => Term' inSet pof ctx -> m Exp
lift (Variable VariableType inSet pof
n) = [| Variable n |]
lift (LInteger Int64
i) = [| LInteger i |]
lift (LString Text
s) = [| LString s |]
lift (LBytes ByteString
bs) = [| LBytes bs |]
lift (LBool Bool
b) = [| LBool b |]
lift (TermSet SetType inSet ctx
terms) = [| TermSet terms |]
lift (LDate UTCTime
t) = [| LDate (read $(String -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
lift (String -> m Exp) -> String -> m Exp
forall a b. (a -> b) -> a -> b
$ UTCTime -> String
forall a. Show a => a -> String
show UTCTime
t)) |]
lift (Antiquote SliceType ctx
s) = [| s |]
#if MIN_VERSION_template_haskell(2,17,0)
liftTyped :: forall (m :: * -> *).
Quote m =>
Term' inSet pof ctx -> Code m (Term' inSet pof ctx)
liftTyped = m (TExp (Term' inSet pof ctx)) -> Code m (Term' inSet pof ctx)
forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode (m (TExp (Term' inSet pof ctx)) -> Code m (Term' inSet pof ctx))
-> (Term' inSet pof ctx -> m (TExp (Term' inSet pof ctx)))
-> Term' inSet pof ctx
-> Code m (Term' inSet pof ctx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Exp -> m (TExp (Term' inSet pof ctx))
forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerce (m Exp -> m (TExp (Term' inSet pof ctx)))
-> (Term' inSet pof ctx -> m Exp)
-> Term' inSet pof ctx
-> m (TExp (Term' inSet pof ctx))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term' inSet pof ctx -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Term' inSet pof ctx -> m Exp
lift
#else
liftTyped = unsafeTExpCoerce . lift
#endif
class ToTerm t inSet pof where
toTerm :: t -> Term' inSet pof 'Representation
class FromValue t where
fromValue :: Value -> Maybe t
instance ToTerm Int inSet pof where
toTerm :: Int -> Term' inSet pof 'Representation
toTerm = Int64 -> Term' inSet pof 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Int64 -> Term' inSet pof ctx
LInteger (Int64 -> Term' inSet pof 'Representation)
-> (Int -> Int64) -> Int -> Term' inSet pof 'Representation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance FromValue Int where
fromValue :: Value -> Maybe Int
fromValue (LInteger Int64
v) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v
fromValue Value
_ = Maybe Int
forall a. Maybe a
Nothing
instance ToTerm Integer inSet pof where
toTerm :: Integer -> Term' inSet pof 'Representation
toTerm = Int64 -> Term' inSet pof 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Int64 -> Term' inSet pof ctx
LInteger (Int64 -> Term' inSet pof 'Representation)
-> (Integer -> Int64) -> Integer -> Term' inSet pof 'Representation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance FromValue Integer where
fromValue :: Value -> Maybe Integer
fromValue (LInteger Int64
v) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v)
fromValue Value
_ = Maybe Integer
forall a. Maybe a
Nothing
instance ToTerm Text inSet pof where
toTerm :: Text -> Term' inSet pof 'Representation
toTerm = Text -> Term' inSet pof 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString
instance FromValue Text where
fromValue :: Value -> Maybe Text
fromValue (LString Text
t) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
fromValue Value
_ = Maybe Text
forall a. Maybe a
Nothing
instance ToTerm Bool inSet pof where
toTerm :: Bool -> Term' inSet pof 'Representation
toTerm = Bool -> Term' inSet pof 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool
instance FromValue Bool where
fromValue :: Value -> Maybe Bool
fromValue (LBool Bool
b) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b
fromValue Value
_ = Maybe Bool
forall a. Maybe a
Nothing
instance ToTerm ByteString inSet pof where
toTerm :: ByteString -> Term' inSet pof 'Representation
toTerm = ByteString -> Term' inSet pof 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes
instance FromValue ByteString where
fromValue :: Value -> Maybe ByteString
fromValue (LBytes ByteString
bs) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs
fromValue Value
_ = Maybe ByteString
forall a. Maybe a
Nothing
instance ToTerm UTCTime inSet pof where
toTerm :: UTCTime -> Term' inSet pof 'Representation
toTerm = UTCTime -> Term' inSet pof 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate
instance FromValue UTCTime where
fromValue :: Value -> Maybe UTCTime
fromValue (LDate UTCTime
t) = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
t
fromValue Value
_ = Maybe UTCTime
forall a. Maybe a
Nothing
instance (Foldable f, ToTerm a 'WithinSet 'InFact) => ToTerm (f a) 'NotWithinSet pof where
toTerm :: f a -> Term' 'NotWithinSet pof 'Representation
toTerm f a
vs = Set (Term' 'WithinSet 'InFact 'Representation)
-> Term' 'NotWithinSet pof 'Representation
SetType 'NotWithinSet 'Representation
-> Term' 'NotWithinSet pof 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
SetType inSet ctx -> Term' inSet pof ctx
TermSet (Set (Term' 'WithinSet 'InFact 'Representation)
-> Term' 'NotWithinSet pof 'Representation)
-> ([Term' 'WithinSet 'InFact 'Representation]
-> Set (Term' 'WithinSet 'InFact 'Representation))
-> [Term' 'WithinSet 'InFact 'Representation]
-> Term' 'NotWithinSet pof 'Representation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Term' 'WithinSet 'InFact 'Representation]
-> Set (Term' 'WithinSet 'InFact 'Representation)
forall a. Ord a => [a] -> Set a
Set.fromList ([Term' 'WithinSet 'InFact 'Representation]
-> Term' 'NotWithinSet pof 'Representation)
-> [Term' 'WithinSet 'InFact 'Representation]
-> Term' 'NotWithinSet pof 'Representation
forall a b. (a -> b) -> a -> b
$ a -> Term' 'WithinSet 'InFact 'Representation
forall t (inSet :: IsWithinSet) (pof :: PredicateOrFact).
ToTerm t inSet pof =>
t -> Term' inSet pof 'Representation
toTerm (a -> Term' 'WithinSet 'InFact 'Representation)
-> [a] -> [Term' 'WithinSet 'InFact 'Representation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> [a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
vs
instance FromValue Value where
fromValue :: Value -> Maybe Value
fromValue = Value -> Maybe Value
forall a. a -> Maybe a
Just
valueToSetTerm :: Value
-> Maybe (Term' 'WithinSet 'InFact 'Representation)
valueToSetTerm :: Value -> Maybe (Term' 'WithinSet 'InFact 'Representation)
valueToSetTerm = \case
LInteger Int64
i -> Term' 'WithinSet 'InFact 'Representation
-> Maybe (Term' 'WithinSet 'InFact 'Representation)
forall a. a -> Maybe a
Just (Term' 'WithinSet 'InFact 'Representation
-> Maybe (Term' 'WithinSet 'InFact 'Representation))
-> Term' 'WithinSet 'InFact 'Representation
-> Maybe (Term' 'WithinSet 'InFact 'Representation)
forall a b. (a -> b) -> a -> b
$ Int64 -> Term' 'WithinSet 'InFact 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Int64 -> Term' inSet pof ctx
LInteger Int64
i
LString Text
i -> Term' 'WithinSet 'InFact 'Representation
-> Maybe (Term' 'WithinSet 'InFact 'Representation)
forall a. a -> Maybe a
Just (Term' 'WithinSet 'InFact 'Representation
-> Maybe (Term' 'WithinSet 'InFact 'Representation))
-> Term' 'WithinSet 'InFact 'Representation
-> Maybe (Term' 'WithinSet 'InFact 'Representation)
forall a b. (a -> b) -> a -> b
$ Text -> Term' 'WithinSet 'InFact 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString Text
i
LDate UTCTime
i -> Term' 'WithinSet 'InFact 'Representation
-> Maybe (Term' 'WithinSet 'InFact 'Representation)
forall a. a -> Maybe a
Just (Term' 'WithinSet 'InFact 'Representation
-> Maybe (Term' 'WithinSet 'InFact 'Representation))
-> Term' 'WithinSet 'InFact 'Representation
-> Maybe (Term' 'WithinSet 'InFact 'Representation)
forall a b. (a -> b) -> a -> b
$ UTCTime -> Term' 'WithinSet 'InFact 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate UTCTime
i
LBytes ByteString
i -> Term' 'WithinSet 'InFact 'Representation
-> Maybe (Term' 'WithinSet 'InFact 'Representation)
forall a. a -> Maybe a
Just (Term' 'WithinSet 'InFact 'Representation
-> Maybe (Term' 'WithinSet 'InFact 'Representation))
-> Term' 'WithinSet 'InFact 'Representation
-> Maybe (Term' 'WithinSet 'InFact 'Representation)
forall a b. (a -> b) -> a -> b
$ ByteString -> Term' 'WithinSet 'InFact 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes ByteString
i
LBool Bool
i -> Term' 'WithinSet 'InFact 'Representation
-> Maybe (Term' 'WithinSet 'InFact 'Representation)
forall a. a -> Maybe a
Just (Term' 'WithinSet 'InFact 'Representation
-> Maybe (Term' 'WithinSet 'InFact 'Representation))
-> Term' 'WithinSet 'InFact 'Representation
-> Maybe (Term' 'WithinSet 'InFact 'Representation)
forall a b. (a -> b) -> a -> b
$ Bool -> Term' 'WithinSet 'InFact 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool Bool
i
TermSet SetType 'NotWithinSet 'Representation
_ -> Maybe (Term' 'WithinSet 'InFact 'Representation)
forall a. Maybe a
Nothing
Variable VariableType 'NotWithinSet 'InFact
v -> Void -> Maybe (Term' 'WithinSet 'InFact 'Representation)
forall a. Void -> a
absurd Void
VariableType 'NotWithinSet 'InFact
v
Antiquote SliceType 'Representation
v -> Void -> Maybe (Term' 'WithinSet 'InFact 'Representation)
forall a. Void -> a
absurd Void
SliceType 'Representation
v
valueToTerm :: Value -> Term
valueToTerm :: Value -> Term
valueToTerm = \case
LInteger Int64
i -> Int64 -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Int64 -> Term' inSet pof ctx
LInteger Int64
i
LString Text
i -> Text -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString Text
i
LDate UTCTime
i -> UTCTime -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate UTCTime
i
LBytes ByteString
i -> ByteString -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes ByteString
i
LBool Bool
i -> Bool -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool Bool
i
TermSet SetType 'NotWithinSet 'Representation
i -> SetType 'NotWithinSet 'Representation -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
SetType inSet ctx -> Term' inSet pof ctx
TermSet SetType 'NotWithinSet 'Representation
i
Variable VariableType 'NotWithinSet 'InFact
v -> Void -> Term
forall a. Void -> a
absurd Void
VariableType 'NotWithinSet 'InFact
v
Antiquote SliceType 'Representation
v -> Void -> Term
forall a. Void -> a
absurd Void
SliceType 'Representation
v
renderId' :: (VariableType inSet pof -> Text)
-> (SetType inSet ctx -> Text)
-> (SliceType ctx -> Text)
-> Term' inSet pof ctx -> Text
renderId' :: forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
(VariableType inSet pof -> Text)
-> (SetType inSet ctx -> Text)
-> (SliceType ctx -> Text)
-> Term' inSet pof ctx
-> Text
renderId' VariableType inSet pof -> Text
var SetType inSet ctx -> Text
set SliceType ctx -> Text
slice = \case
Variable VariableType inSet pof
name -> VariableType inSet pof -> Text
var VariableType inSet pof
name
LInteger Int64
int -> String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int64 -> String
forall a. Show a => a -> String
show Int64
int
LString Text
str -> String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. Show a => a -> String
show Text
str
LDate UTCTime
time -> String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%FT%T%Q%Ez" UTCTime
time
LBytes ByteString
bs -> Text
"hex:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
encodeHex ByteString
bs
LBool Bool
True -> Text
"true"
LBool Bool
False -> Text
"false"
TermSet SetType inSet ctx
terms -> SetType inSet ctx -> Text
set SetType inSet ctx
terms
Antiquote SliceType ctx
v -> SliceType ctx -> Text
slice SliceType ctx
v
renderSet :: (SliceType ctx -> Text)
-> Set (Term' 'WithinSet 'InFact ctx)
-> Text
renderSet :: forall (ctx :: DatalogContext).
(SliceType ctx -> Text)
-> Set (Term' 'WithinSet 'InFact ctx) -> Text
renderSet SliceType ctx -> Text
slice Set (Term' 'WithinSet 'InFact ctx)
terms =
Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"," ((VariableType 'WithinSet 'InFact -> Text)
-> (SetType 'WithinSet ctx -> Text)
-> (SliceType ctx -> Text)
-> Term' 'WithinSet 'InFact ctx
-> Text
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
(VariableType inSet pof -> Text)
-> (SetType inSet ctx -> Text)
-> (SliceType ctx -> Text)
-> Term' inSet pof ctx
-> Text
renderId' Void -> Text
VariableType 'WithinSet 'InFact -> Text
forall a. Void -> a
absurd Void -> Text
SetType 'WithinSet ctx -> Text
forall a. Void -> a
absurd SliceType ctx -> Text
slice (Term' 'WithinSet 'InFact ctx -> Text)
-> [Term' 'WithinSet 'InFact ctx] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (Term' 'WithinSet 'InFact ctx)
-> [Term' 'WithinSet 'InFact ctx]
forall a. Set a -> [a]
Set.toList Set (Term' 'WithinSet 'InFact ctx)
terms) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
renderId :: Term -> Text
renderId :: Term -> Text
renderId = (VariableType 'NotWithinSet 'InPredicate -> Text)
-> (SetType 'NotWithinSet 'Representation -> Text)
-> (SliceType 'Representation -> Text)
-> Term
-> Text
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
(VariableType inSet pof -> Text)
-> (SetType inSet ctx -> Text)
-> (SliceType ctx -> Text)
-> Term' inSet pof ctx
-> Text
renderId' (Text
VariableType 'NotWithinSet 'InPredicate
"$" VariableType 'NotWithinSet 'InPredicate
-> VariableType 'NotWithinSet 'InPredicate
-> VariableType 'NotWithinSet 'InPredicate
forall a. Semigroup a => a -> a -> a
<>) ((SliceType 'Representation -> Text)
-> Set (Term' 'WithinSet 'InFact 'Representation) -> Text
forall (ctx :: DatalogContext).
(SliceType ctx -> Text)
-> Set (Term' 'WithinSet 'InFact ctx) -> Text
renderSet Void -> Text
SliceType 'Representation -> Text
forall a. Void -> a
absurd) Void -> Text
SliceType 'Representation -> Text
forall a. Void -> a
absurd
renderFactId :: Term' 'NotWithinSet 'InFact 'Representation -> Text
renderFactId :: Value -> Text
renderFactId = (VariableType 'NotWithinSet 'InFact -> Text)
-> (SetType 'NotWithinSet 'Representation -> Text)
-> (SliceType 'Representation -> Text)
-> Value
-> Text
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
(VariableType inSet pof -> Text)
-> (SetType inSet ctx -> Text)
-> (SliceType ctx -> Text)
-> Term' inSet pof ctx
-> Text
renderId' Void -> Text
VariableType 'NotWithinSet 'InFact -> Text
forall a. Void -> a
absurd ((SliceType 'Representation -> Text)
-> Set (Term' 'WithinSet 'InFact 'Representation) -> Text
forall (ctx :: DatalogContext).
(SliceType ctx -> Text)
-> Set (Term' 'WithinSet 'InFact ctx) -> Text
renderSet Void -> Text
SliceType 'Representation -> Text
forall a. Void -> a
absurd) Void -> Text
SliceType 'Representation -> Text
forall a. Void -> a
absurd
listSymbolsInTerm :: Term -> Set.Set Text
listSymbolsInTerm :: Term -> Set Text
listSymbolsInTerm = \case
LString Text
v -> Text -> Set Text
forall a. a -> Set a
Set.singleton Text
v
Variable VariableType 'NotWithinSet 'InPredicate
name -> Text -> Set Text
forall a. a -> Set a
Set.singleton Text
VariableType 'NotWithinSet 'InPredicate
name
TermSet SetType 'NotWithinSet 'Representation
terms -> (Term' 'WithinSet 'InFact 'Representation -> Set Text)
-> Set (Term' 'WithinSet 'InFact 'Representation) -> Set Text
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' 'WithinSet 'InFact 'Representation -> Set Text
listSymbolsInSetValue Set (Term' 'WithinSet 'InFact 'Representation)
SetType 'NotWithinSet 'Representation
terms
Antiquote SliceType 'Representation
v -> Void -> Set Text
forall a. Void -> a
absurd Void
SliceType 'Representation
v
Term
_ -> Set Text
forall a. Monoid a => a
mempty
listSymbolsInValue :: Value -> Set.Set Text
listSymbolsInValue :: Value -> Set Text
listSymbolsInValue = \case
LString Text
v -> Text -> Set Text
forall a. a -> Set a
Set.singleton Text
v
TermSet SetType 'NotWithinSet 'Representation
terms -> (Term' 'WithinSet 'InFact 'Representation -> Set Text)
-> Set (Term' 'WithinSet 'InFact 'Representation) -> Set Text
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' 'WithinSet 'InFact 'Representation -> Set Text
listSymbolsInSetValue Set (Term' 'WithinSet 'InFact 'Representation)
SetType 'NotWithinSet 'Representation
terms
Variable VariableType 'NotWithinSet 'InFact
v -> Void -> Set Text
forall a. Void -> a
absurd Void
VariableType 'NotWithinSet 'InFact
v
Antiquote SliceType 'Representation
v -> Void -> Set Text
forall a. Void -> a
absurd Void
SliceType 'Representation
v
Value
_ -> Set Text
forall a. Monoid a => a
mempty
listSymbolsInSetValue :: SetValue -> Set.Set Text
listSymbolsInSetValue :: Term' 'WithinSet 'InFact 'Representation -> Set Text
listSymbolsInSetValue = \case
LString Text
v -> Text -> Set Text
forall a. a -> Set a
Set.singleton Text
v
TermSet SetType 'WithinSet 'Representation
v -> Void -> Set Text
forall a. Void -> a
absurd Void
SetType 'WithinSet 'Representation
v
Variable VariableType 'WithinSet 'InFact
v -> Void -> Set Text
forall a. Void -> a
absurd Void
VariableType 'WithinSet 'InFact
v
Antiquote SliceType 'Representation
v -> Void -> Set Text
forall a. Void -> a
absurd Void
SliceType 'Representation
v
Term' 'WithinSet 'InFact 'Representation
_ -> Set Text
forall a. Monoid a => a
mempty
data Predicate' (pof :: PredicateOrFact) (ctx :: DatalogContext) = Predicate
{ forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
name :: Text
, forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
terms :: [Term' 'NotWithinSet pof ctx]
}
deriving instance ( Eq (Term' 'NotWithinSet pof ctx)
) => Eq (Predicate' pof ctx)
deriving instance ( Ord (Term' 'NotWithinSet pof ctx)
) => Ord (Predicate' pof ctx)
deriving instance ( Show (Term' 'NotWithinSet pof ctx)
) => Show (Predicate' pof ctx)
deriving instance Lift (Term' 'NotWithinSet pof ctx) => Lift (Predicate' pof ctx)
type Predicate = Predicate' 'InPredicate 'Representation
type Fact = Predicate' 'InFact 'Representation
renderPredicate :: Predicate -> Text
renderPredicate :: Predicate -> Text
renderPredicate Predicate{Text
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
name :: Text
name,[Term]
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
terms :: [Term]
terms} =
Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " ((Term -> Text) -> [Term] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term -> Text
renderId [Term]
terms) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
renderFact :: Fact -> Text
renderFact :: Fact -> Text
renderFact Predicate{Text
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
name :: Text
name,[Value]
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
terms :: [Value]
terms} =
Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " ((Value -> Text) -> [Value] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Text
renderFactId [Value]
terms) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
listSymbolsInFact :: Fact -> Set.Set Text
listSymbolsInFact :: Fact -> Set Text
listSymbolsInFact Predicate{[Value]
Text
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
name :: Text
terms :: [Value]
..} =
Text -> Set Text
forall a. a -> Set a
Set.singleton Text
name
Set Text -> Set Text -> Set Text
forall a. Semigroup a => a -> a -> a
<> (Value -> Set Text) -> [Value] -> Set Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Set Text
listSymbolsInValue [Value]
terms
listSymbolsInPredicate :: Predicate -> Set.Set Text
listSymbolsInPredicate :: Predicate -> Set Text
listSymbolsInPredicate Predicate{[Term]
Text
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
name :: Text
terms :: [Term]
..} =
Text -> Set Text
forall a. a -> Set a
Set.singleton Text
name
Set Text -> Set Text -> Set Text
forall a. Semigroup a => a -> a -> a
<> (Term -> Set Text) -> [Term] -> Set Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term -> Set Text
listSymbolsInTerm [Term]
terms
data QueryItem' evalCtx ctx = QueryItem
{ forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Predicate' 'InPredicate ctx]
qBody :: [Predicate' 'InPredicate ctx]
, forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Expression' ctx]
qExpressions :: [Expression' ctx]
, forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
qScope :: Set (RuleScope' evalCtx ctx)
}
type Query' evalCtx ctx = [QueryItem' evalCtx ctx]
type Query = Query' 'Repr 'Representation
queryHasNoScope :: Query -> Bool
queryHasNoScope :: Query -> Bool
queryHasNoScope = (QueryItem' 'Repr 'Representation -> Bool) -> Query -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Set RuleScope -> Bool
forall a. Set a -> Bool
Set.null (Set RuleScope -> Bool)
-> (QueryItem' 'Repr 'Representation -> Set RuleScope)
-> QueryItem' 'Repr 'Representation
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryItem' 'Repr 'Representation -> Set RuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
qScope)
queryHasNoV4Operators :: Query -> Bool
queryHasNoV4Operators :: Query -> Bool
queryHasNoV4Operators =
(QueryItem' 'Repr 'Representation -> Bool) -> Query -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Expression -> Bool) -> [Expression] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Expression -> Bool
expressionHasNoV4Operators ([Expression] -> Bool)
-> (QueryItem' 'Repr 'Representation -> [Expression])
-> QueryItem' 'Repr 'Representation
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryItem' 'Repr 'Representation -> [Expression]
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Expression' ctx]
qExpressions)
makeQueryItem :: [Predicate' 'InPredicate ctx]
-> [Expression' ctx]
-> Set (RuleScope' 'Repr ctx)
-> Validation (NonEmpty Text) (QueryItem' 'Repr ctx)
makeQueryItem :: forall (ctx :: DatalogContext).
[Predicate' 'InPredicate ctx]
-> [Expression' ctx]
-> Set (RuleScope' 'Repr ctx)
-> Validation (NonEmpty Text) (QueryItem' 'Repr ctx)
makeQueryItem [Predicate' 'InPredicate ctx]
qBody [Expression' ctx]
qExpressions Set (RuleScope' 'Repr ctx)
qScope =
let boundVariables :: Set Text
boundVariables = [Predicate' 'InPredicate ctx] -> Set Text
forall (ctx :: DatalogContext).
[Predicate' 'InPredicate ctx] -> Set Text
extractVariables [Predicate' 'InPredicate ctx]
qBody
exprVariables :: Set Text
exprVariables = (Expression' ctx -> Set Text) -> [Expression' ctx] -> Set Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Expression' ctx -> Set Text
forall (ctx :: DatalogContext). Expression' ctx -> Set Text
extractExprVariables [Expression' ctx]
qExpressions
unboundVariables :: Set Text
unboundVariables = Set Text
exprVariables Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Text
boundVariables
in case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
unboundVariables) of
Maybe (NonEmpty Text)
Nothing -> QueryItem' 'Repr ctx
-> Validation (NonEmpty Text) (QueryItem' 'Repr ctx)
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryItem{[Expression' ctx]
[Predicate' 'InPredicate ctx]
Set (RuleScope' 'Repr ctx)
qBody :: [Predicate' 'InPredicate ctx]
qExpressions :: [Expression' ctx]
qScope :: Set (RuleScope' 'Repr ctx)
qBody :: [Predicate' 'InPredicate ctx]
qExpressions :: [Expression' ctx]
qScope :: Set (RuleScope' 'Repr ctx)
..}
Just NonEmpty Text
vs -> NonEmpty Text -> Validation (NonEmpty Text) (QueryItem' 'Repr ctx)
forall e a. e -> Validation e a
Failure NonEmpty Text
vs
data CheckKind = One | All
deriving (CheckKind -> CheckKind -> Bool
(CheckKind -> CheckKind -> Bool)
-> (CheckKind -> CheckKind -> Bool) -> Eq CheckKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CheckKind -> CheckKind -> Bool
== :: CheckKind -> CheckKind -> Bool
$c/= :: CheckKind -> CheckKind -> Bool
/= :: CheckKind -> CheckKind -> Bool
Eq, Int -> CheckKind -> ShowS
[CheckKind] -> ShowS
CheckKind -> String
(Int -> CheckKind -> ShowS)
-> (CheckKind -> String)
-> ([CheckKind] -> ShowS)
-> Show CheckKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CheckKind -> ShowS
showsPrec :: Int -> CheckKind -> ShowS
$cshow :: CheckKind -> String
show :: CheckKind -> String
$cshowList :: [CheckKind] -> ShowS
showList :: [CheckKind] -> ShowS
Show, Eq CheckKind
Eq CheckKind
-> (CheckKind -> CheckKind -> Ordering)
-> (CheckKind -> CheckKind -> Bool)
-> (CheckKind -> CheckKind -> Bool)
-> (CheckKind -> CheckKind -> Bool)
-> (CheckKind -> CheckKind -> Bool)
-> (CheckKind -> CheckKind -> CheckKind)
-> (CheckKind -> CheckKind -> CheckKind)
-> Ord CheckKind
CheckKind -> CheckKind -> Bool
CheckKind -> CheckKind -> Ordering
CheckKind -> CheckKind -> CheckKind
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CheckKind -> CheckKind -> Ordering
compare :: CheckKind -> CheckKind -> Ordering
$c< :: CheckKind -> CheckKind -> Bool
< :: CheckKind -> CheckKind -> Bool
$c<= :: CheckKind -> CheckKind -> Bool
<= :: CheckKind -> CheckKind -> Bool
$c> :: CheckKind -> CheckKind -> Bool
> :: CheckKind -> CheckKind -> Bool
$c>= :: CheckKind -> CheckKind -> Bool
>= :: CheckKind -> CheckKind -> Bool
$cmax :: CheckKind -> CheckKind -> CheckKind
max :: CheckKind -> CheckKind -> CheckKind
$cmin :: CheckKind -> CheckKind -> CheckKind
min :: CheckKind -> CheckKind -> CheckKind
Ord, (forall (m :: * -> *). Quote m => CheckKind -> m Exp)
-> (forall (m :: * -> *). Quote m => CheckKind -> Code m CheckKind)
-> Lift CheckKind
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => CheckKind -> m Exp
forall (m :: * -> *). Quote m => CheckKind -> Code m CheckKind
$clift :: forall (m :: * -> *). Quote m => CheckKind -> m Exp
lift :: forall (m :: * -> *). Quote m => CheckKind -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => CheckKind -> Code m CheckKind
liftTyped :: forall (m :: * -> *). Quote m => CheckKind -> Code m CheckKind
Lift)
data Check' evalCtx ctx = Check
{ forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cQueries :: Query' evalCtx ctx
, forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> CheckKind
cKind :: CheckKind
}
deriving instance ( Eq (QueryItem' evalCtx ctx)
) => Eq (Check' evalCtx ctx)
deriving instance ( Ord (QueryItem' evalCtx ctx)
) => Ord (Check' evalCtx ctx)
deriving instance ( Show (QueryItem' evalCtx ctx)
) => Show (Check' evalCtx ctx)
deriving instance ( Lift (QueryItem' evalCtx ctx)
) => Lift (Check' evalCtx ctx)
type Check = Check' 'Repr 'Representation
type EvalCheck = Check' 'Eval 'Representation
isCheckOne :: Check' evalCtx ctx -> Bool
isCheckOne :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Bool
isCheckOne Check{CheckKind
cKind :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> CheckKind
cKind :: CheckKind
cKind} = CheckKind
cKind CheckKind -> CheckKind -> Bool
forall a. Eq a => a -> a -> Bool
== CheckKind
One
data PolicyType = Allow | Deny
deriving (PolicyType -> PolicyType -> Bool
(PolicyType -> PolicyType -> Bool)
-> (PolicyType -> PolicyType -> Bool) -> Eq PolicyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PolicyType -> PolicyType -> Bool
== :: PolicyType -> PolicyType -> Bool
$c/= :: PolicyType -> PolicyType -> Bool
/= :: PolicyType -> PolicyType -> Bool
Eq, Int -> PolicyType -> ShowS
[PolicyType] -> ShowS
PolicyType -> String
(Int -> PolicyType -> ShowS)
-> (PolicyType -> String)
-> ([PolicyType] -> ShowS)
-> Show PolicyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PolicyType -> ShowS
showsPrec :: Int -> PolicyType -> ShowS
$cshow :: PolicyType -> String
show :: PolicyType -> String
$cshowList :: [PolicyType] -> ShowS
showList :: [PolicyType] -> ShowS
Show, Eq PolicyType
Eq PolicyType
-> (PolicyType -> PolicyType -> Ordering)
-> (PolicyType -> PolicyType -> Bool)
-> (PolicyType -> PolicyType -> Bool)
-> (PolicyType -> PolicyType -> Bool)
-> (PolicyType -> PolicyType -> Bool)
-> (PolicyType -> PolicyType -> PolicyType)
-> (PolicyType -> PolicyType -> PolicyType)
-> Ord PolicyType
PolicyType -> PolicyType -> Bool
PolicyType -> PolicyType -> Ordering
PolicyType -> PolicyType -> PolicyType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PolicyType -> PolicyType -> Ordering
compare :: PolicyType -> PolicyType -> Ordering
$c< :: PolicyType -> PolicyType -> Bool
< :: PolicyType -> PolicyType -> Bool
$c<= :: PolicyType -> PolicyType -> Bool
<= :: PolicyType -> PolicyType -> Bool
$c> :: PolicyType -> PolicyType -> Bool
> :: PolicyType -> PolicyType -> Bool
$c>= :: PolicyType -> PolicyType -> Bool
>= :: PolicyType -> PolicyType -> Bool
$cmax :: PolicyType -> PolicyType -> PolicyType
max :: PolicyType -> PolicyType -> PolicyType
$cmin :: PolicyType -> PolicyType -> PolicyType
min :: PolicyType -> PolicyType -> PolicyType
Ord, (forall (m :: * -> *). Quote m => PolicyType -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
PolicyType -> Code m PolicyType)
-> Lift PolicyType
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => PolicyType -> m Exp
forall (m :: * -> *). Quote m => PolicyType -> Code m PolicyType
$clift :: forall (m :: * -> *). Quote m => PolicyType -> m Exp
lift :: forall (m :: * -> *). Quote m => PolicyType -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => PolicyType -> Code m PolicyType
liftTyped :: forall (m :: * -> *). Quote m => PolicyType -> Code m PolicyType
Lift)
type Policy' evalCtx ctx = (PolicyType, Query' evalCtx ctx)
type Policy = Policy' 'Repr 'Representation
type EvalPolicy = Policy' 'Eval 'Representation
deriving instance ( Eq (Predicate' 'InPredicate ctx)
, Eq (Expression' ctx)
, Eq (RuleScope' evalCtx ctx)
) => Eq (QueryItem' evalCtx ctx)
deriving instance ( Ord (Predicate' 'InPredicate ctx)
, Ord (Expression' ctx)
, Ord (RuleScope' evalCtx ctx)
) => Ord (QueryItem' evalCtx ctx)
deriving instance ( Show (Predicate' 'InPredicate ctx)
, Show (Expression' ctx)
, Show (RuleScope' evalCtx ctx)
) => Show (QueryItem' evalCtx ctx)
deriving instance ( Lift (Predicate' 'InPredicate ctx)
, Lift (Expression' ctx)
, Lift (RuleScope' evalCtx ctx)
) => Lift (QueryItem' evalCtx ctx)
renderPolicy :: Policy -> Text
renderPolicy :: Policy -> Text
renderPolicy (PolicyType
pType, Query
query) =
let prefix :: Text
prefix = case PolicyType
pType of
PolicyType
Allow -> Text
"allow if "
PolicyType
Deny -> Text
"deny if "
in Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
" or \n" (QueryItem' 'Repr 'Representation -> Text
renderQueryItem (QueryItem' 'Repr 'Representation -> Text) -> Query -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query
query) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"
renderQueryItem :: QueryItem' 'Repr 'Representation -> Text
renderQueryItem :: QueryItem' 'Repr 'Representation -> Text
renderQueryItem QueryItem{[Expression]
[Predicate]
Set RuleScope
qBody :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Predicate' 'InPredicate ctx]
qExpressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Expression' ctx]
qScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
qBody :: [Predicate]
qExpressions :: [Expression]
qScope :: Set RuleScope
..} =
Text -> [Text] -> Text
intercalate Text
",\n" ([[Text]] -> [Text]
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
[ Predicate -> Text
renderPredicate (Predicate -> Text) -> [Predicate] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Predicate]
qBody
, Expression -> Text
renderExpression (Expression -> Text) -> [Expression] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expression]
qExpressions
])
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Set RuleScope -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set RuleScope
qScope then Text
""
else Text
" trusting " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Set RuleScope -> Text
renderRuleScope Set RuleScope
qScope
renderCheck :: Check -> Text
renderCheck :: Check -> Text
renderCheck Check{Query
CheckKind
cQueries :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cKind :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> CheckKind
cQueries :: Query
cKind :: CheckKind
..} =
let kindToken :: Text
kindToken = case CheckKind
cKind of
CheckKind
One -> Text
"if"
CheckKind
All -> Text
"all"
in Text
"check " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
kindToken Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> [Text] -> Text
intercalate Text
"\n or " (QueryItem' 'Repr 'Representation -> Text
renderQueryItem (QueryItem' 'Repr 'Representation -> Text) -> Query -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query
cQueries)
listSymbolsInQueryItem :: QueryItem' evalCtx 'Representation -> Set.Set Text
listSymbolsInQueryItem :: forall (evalCtx :: EvaluationContext).
QueryItem' evalCtx 'Representation -> Set Text
listSymbolsInQueryItem QueryItem{[Expression]
[Predicate]
Set (RuleScope' evalCtx 'Representation)
qBody :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Predicate' 'InPredicate ctx]
qExpressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Expression' ctx]
qScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
qBody :: [Predicate]
qExpressions :: [Expression]
qScope :: Set (RuleScope' evalCtx 'Representation)
..} =
Text -> Set Text
forall a. a -> Set a
Set.singleton Text
"query"
Set Text -> Set Text -> Set Text
forall a. Semigroup a => a -> a -> a
<> (Predicate -> Set Text) -> [Predicate] -> Set Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Predicate -> Set Text
listSymbolsInPredicate [Predicate]
qBody
Set Text -> Set Text -> Set Text
forall a. Semigroup a => a -> a -> a
<> (Expression -> Set Text) -> [Expression] -> Set Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Expression -> Set Text
listSymbolsInExpression [Expression]
qExpressions
listSymbolsInCheck :: Check -> Set.Set Text
listSymbolsInCheck :: Check -> Set Text
listSymbolsInCheck =
(QueryItem' 'Repr 'Representation -> Set Text) -> Query -> Set Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap QueryItem' 'Repr 'Representation -> Set Text
forall (evalCtx :: EvaluationContext).
QueryItem' evalCtx 'Representation -> Set Text
listSymbolsInQueryItem (Query -> Set Text) -> (Check -> Query) -> Check -> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Check -> Query
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cQueries
listPublicKeysInQueryItem :: QueryItem' 'Repr 'Representation -> Set.Set PublicKey
listPublicKeysInQueryItem :: QueryItem' 'Repr 'Representation -> Set PublicKey
listPublicKeysInQueryItem QueryItem{Set RuleScope
qScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
qScope :: Set RuleScope
qScope} =
Set RuleScope -> Set PublicKey
listPublicKeysInScope Set RuleScope
qScope
listPublicKeysInCheck :: Check -> Set.Set PublicKey
listPublicKeysInCheck :: Check -> Set PublicKey
listPublicKeysInCheck = (QueryItem' 'Repr 'Representation -> Set PublicKey)
-> Query -> Set PublicKey
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap QueryItem' 'Repr 'Representation -> Set PublicKey
listPublicKeysInQueryItem (Query -> Set PublicKey)
-> (Check -> Query) -> Check -> Set PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Check -> Query
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cQueries
type RuleScope = RuleScope' 'Repr 'Representation
type EvalRuleScope = RuleScope' 'Eval 'Representation
data RuleScope' (evalCtx :: EvaluationContext) (ctx :: DatalogContext) =
OnlyAuthority
| Previous
| BlockId (BlockIdType evalCtx ctx)
deriving instance Eq (BlockIdType evalCtx ctx) => Eq (RuleScope' evalCtx ctx)
deriving instance Ord (BlockIdType evalCtx ctx) => Ord (RuleScope' evalCtx ctx)
deriving instance Show (BlockIdType evalCtx ctx) => Show (RuleScope' evalCtx ctx)
deriving instance Lift (BlockIdType evalCtx ctx) => Lift (RuleScope' evalCtx ctx)
listPublicKeysInScope :: Set.Set RuleScope -> Set.Set PublicKey
listPublicKeysInScope :: Set RuleScope -> Set PublicKey
listPublicKeysInScope = (RuleScope -> Set PublicKey) -> Set RuleScope -> Set PublicKey
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((RuleScope -> Set PublicKey) -> Set RuleScope -> Set PublicKey)
-> (RuleScope -> Set PublicKey) -> Set RuleScope -> Set PublicKey
forall a b. (a -> b) -> a -> b
$
\case BlockId BlockIdType 'Repr 'Representation
pk -> PublicKey -> Set PublicKey
forall a. a -> Set a
Set.singleton PublicKey
BlockIdType 'Repr 'Representation
pk
RuleScope
_ -> Set PublicKey
forall a. Set a
Set.empty
data Rule' evalCtx ctx = Rule
{ forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Predicate' 'InPredicate ctx
rhead :: Predicate' 'InPredicate ctx
, forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Predicate' 'InPredicate ctx]
body :: [Predicate' 'InPredicate ctx]
, forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Expression' ctx]
expressions :: [Expression' ctx]
, forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
scope :: Set (RuleScope' evalCtx ctx)
}
deriving instance ( Eq (Predicate' 'InPredicate ctx)
, Eq (Expression' ctx)
, Eq (RuleScope' evalCtx ctx)
) => Eq (Rule' evalCtx ctx)
deriving instance ( Ord (Predicate' 'InPredicate ctx)
, Ord (Expression' ctx)
, Ord (RuleScope' evalCtx ctx)
) => Ord (Rule' evalCtx ctx)
deriving instance ( Show (Predicate' 'InPredicate ctx)
, Show (Expression' ctx)
, Show (RuleScope' evalCtx ctx)
) => Show (Rule' evalCtx ctx)
deriving instance ( Lift (Predicate' 'InPredicate ctx)
, Lift (Expression' ctx)
, Lift (RuleScope' evalCtx ctx)
) => Lift (Rule' evalCtx ctx)
type Rule = Rule' 'Repr 'Representation
type EvalRule = Rule' 'Eval 'Representation
ruleHasNoScope :: Rule -> Bool
ruleHasNoScope :: Rule -> Bool
ruleHasNoScope Rule{Set RuleScope
scope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
scope :: Set RuleScope
scope} = Set RuleScope -> Bool
forall a. Set a -> Bool
Set.null Set RuleScope
scope
expressionHasNoV4Operators :: Expression -> Bool
expressionHasNoV4Operators :: Expression -> Bool
expressionHasNoV4Operators = \case
EBinary Binary
BitwiseAnd Expression
_ Expression
_ -> Bool
False
EBinary Binary
BitwiseOr Expression
_ Expression
_ -> Bool
False
EBinary Binary
BitwiseXor Expression
_ Expression
_ -> Bool
False
EBinary Binary
NotEqual Expression
_ Expression
_ -> Bool
False
EBinary Binary
_ Expression
l Expression
r -> Expression -> Bool
expressionHasNoV4Operators Expression
l Bool -> Bool -> Bool
&& Expression -> Bool
expressionHasNoV4Operators Expression
r
Expression
_ -> Bool
True
ruleHasNoV4Operators :: Rule -> Bool
ruleHasNoV4Operators :: Rule -> Bool
ruleHasNoV4Operators Rule{[Expression]
expressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Expression' ctx]
expressions :: [Expression]
expressions} =
(Expression -> Bool) -> [Expression] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Expression -> Bool
expressionHasNoV4Operators [Expression]
expressions
renderRule :: Rule -> Text
renderRule :: Rule -> Text
renderRule Rule{Predicate
rhead :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Predicate' 'InPredicate ctx
rhead :: Predicate
rhead,[Predicate]
body :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Predicate' 'InPredicate ctx]
body :: [Predicate]
body,[Expression]
expressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Expression' ctx]
expressions :: [Expression]
expressions,Set RuleScope
scope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
scope :: Set RuleScope
scope} =
Predicate -> Text
renderPredicate Predicate
rhead Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" <- "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " ((Predicate -> Text) -> [Predicate] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Predicate -> Text
renderPredicate [Predicate]
body [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Expression -> Text) -> [Expression] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expression -> Text
renderExpression [Expression]
expressions)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Set RuleScope -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set RuleScope
scope then Text
""
else Text
" trusting " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Set RuleScope -> Text
renderRuleScope Set RuleScope
scope
listSymbolsInRule :: Rule -> Set.Set Text
listSymbolsInRule :: Rule -> Set Text
listSymbolsInRule Rule{[Expression]
[Predicate]
Set RuleScope
Predicate
rhead :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Predicate' 'InPredicate ctx
body :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Predicate' 'InPredicate ctx]
expressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Expression' ctx]
scope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
rhead :: Predicate
body :: [Predicate]
expressions :: [Expression]
scope :: Set RuleScope
..} =
Predicate -> Set Text
listSymbolsInPredicate Predicate
rhead
Set Text -> Set Text -> Set Text
forall a. Semigroup a => a -> a -> a
<> (Predicate -> Set Text) -> [Predicate] -> Set Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Predicate -> Set Text
listSymbolsInPredicate [Predicate]
body
Set Text -> Set Text -> Set Text
forall a. Semigroup a => a -> a -> a
<> (Expression -> Set Text) -> [Expression] -> Set Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Expression -> Set Text
listSymbolsInExpression [Expression]
expressions
listPublicKeysInRule :: Rule -> Set.Set PublicKey
listPublicKeysInRule :: Rule -> Set PublicKey
listPublicKeysInRule Rule{Set RuleScope
scope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
scope :: Set RuleScope
scope} = Set RuleScope -> Set PublicKey
listPublicKeysInScope Set RuleScope
scope
extractVariables :: [Predicate' 'InPredicate ctx] -> Set Text
[Predicate' 'InPredicate ctx]
predicates =
let keepVariable :: Term' inSet pof ctx -> Maybe (VariableType inSet pof)
keepVariable = \case
Variable VariableType inSet pof
name -> VariableType inSet pof -> Maybe (VariableType inSet pof)
forall a. a -> Maybe a
Just VariableType inSet pof
name
Term' inSet pof ctx
_ -> Maybe (VariableType inSet pof)
forall a. Maybe a
Nothing
extractVariables' :: Predicate' pof ctx -> [VariableType 'NotWithinSet pof]
extractVariables' Predicate{[Term' 'NotWithinSet pof ctx]
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
terms :: [Term' 'NotWithinSet pof ctx]
terms} = (Term' 'NotWithinSet pof ctx
-> Maybe (VariableType 'NotWithinSet pof))
-> [Term' 'NotWithinSet pof ctx]
-> [VariableType 'NotWithinSet pof]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Term' 'NotWithinSet pof ctx
-> Maybe (VariableType 'NotWithinSet pof)
forall {inSet :: IsWithinSet} {pof :: PredicateOrFact}
{ctx :: DatalogContext}.
Term' inSet pof ctx -> Maybe (VariableType inSet pof)
keepVariable [Term' 'NotWithinSet pof ctx]
terms
in [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Predicate' 'InPredicate ctx -> [Text]
Predicate' 'InPredicate ctx
-> [VariableType 'NotWithinSet 'InPredicate]
forall {pof :: PredicateOrFact} {ctx :: DatalogContext}.
Predicate' pof ctx -> [VariableType 'NotWithinSet pof]
extractVariables' (Predicate' 'InPredicate ctx -> [Text])
-> [Predicate' 'InPredicate ctx] -> [Text]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Predicate' 'InPredicate ctx]
predicates
extractExprVariables :: Expression' ctx -> Set Text
=
let keepVariable :: Term' inSet pof ctx -> Set (VariableType inSet pof)
keepVariable = \case
Variable VariableType inSet pof
name -> VariableType inSet pof -> Set (VariableType inSet pof)
forall a. a -> Set a
Set.singleton VariableType inSet pof
name
Term' inSet pof ctx
_ -> Set (VariableType inSet pof)
forall a. Set a
Set.empty
in \case
EValue Term' 'NotWithinSet 'InPredicate ctx
t -> Term' 'NotWithinSet 'InPredicate ctx
-> Set (VariableType 'NotWithinSet 'InPredicate)
forall {inSet :: IsWithinSet} {pof :: PredicateOrFact}
{ctx :: DatalogContext}.
Term' inSet pof ctx -> Set (VariableType inSet pof)
keepVariable Term' 'NotWithinSet 'InPredicate ctx
t
EUnary Unary
_ Expression' ctx
e -> Expression' ctx -> Set Text
forall (ctx :: DatalogContext). Expression' ctx -> Set Text
extractExprVariables Expression' ctx
e
EBinary Binary
_ Expression' ctx
e Expression' ctx
e' -> (Set Text -> Set Text -> Set Text
forall a. Semigroup a => a -> a -> a
(<>) (Set Text -> Set Text -> Set Text)
-> (Expression' ctx -> Set Text)
-> Expression' ctx
-> Expression' ctx
-> Set Text
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Expression' ctx -> Set Text
forall (ctx :: DatalogContext). Expression' ctx -> Set Text
extractExprVariables) Expression' ctx
e Expression' ctx
e'
makeRule :: Predicate' 'InPredicate ctx
-> [Predicate' 'InPredicate ctx]
-> [Expression' ctx]
-> Set (RuleScope' 'Repr ctx)
-> Validation (NonEmpty Text) (Rule' 'Repr ctx)
makeRule :: forall (ctx :: DatalogContext).
Predicate' 'InPredicate ctx
-> [Predicate' 'InPredicate ctx]
-> [Expression' ctx]
-> Set (RuleScope' 'Repr ctx)
-> Validation (NonEmpty Text) (Rule' 'Repr ctx)
makeRule Predicate' 'InPredicate ctx
rhead [Predicate' 'InPredicate ctx]
body [Expression' ctx]
expressions Set (RuleScope' 'Repr ctx)
scope =
let boundVariables :: Set Text
boundVariables = [Predicate' 'InPredicate ctx] -> Set Text
forall (ctx :: DatalogContext).
[Predicate' 'InPredicate ctx] -> Set Text
extractVariables [Predicate' 'InPredicate ctx]
body
exprVariables :: Set Text
exprVariables = (Expression' ctx -> Set Text) -> [Expression' ctx] -> Set Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Expression' ctx -> Set Text
forall (ctx :: DatalogContext). Expression' ctx -> Set Text
extractExprVariables [Expression' ctx]
expressions
headVariables :: Set Text
headVariables = [Predicate' 'InPredicate ctx] -> Set Text
forall (ctx :: DatalogContext).
[Predicate' 'InPredicate ctx] -> Set Text
extractVariables [Predicate' 'InPredicate ctx
rhead]
unboundVariables :: Set Text
unboundVariables = (Set Text
headVariables Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Text
exprVariables) Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Text
boundVariables
in case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
unboundVariables) of
Maybe (NonEmpty Text)
Nothing -> Rule' 'Repr ctx -> Validation (NonEmpty Text) (Rule' 'Repr ctx)
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rule{[Expression' ctx]
[Predicate' 'InPredicate ctx]
Set (RuleScope' 'Repr ctx)
Predicate' 'InPredicate ctx
rhead :: Predicate' 'InPredicate ctx
body :: [Predicate' 'InPredicate ctx]
expressions :: [Expression' ctx]
scope :: Set (RuleScope' 'Repr ctx)
rhead :: Predicate' 'InPredicate ctx
body :: [Predicate' 'InPredicate ctx]
expressions :: [Expression' ctx]
scope :: Set (RuleScope' 'Repr ctx)
..}
Just NonEmpty Text
vs -> NonEmpty Text -> Validation (NonEmpty Text) (Rule' 'Repr ctx)
forall e a. e -> Validation e a
Failure NonEmpty Text
vs
data Unary =
Negate
| Parens
| Length
deriving (Unary -> Unary -> Bool
(Unary -> Unary -> Bool) -> (Unary -> Unary -> Bool) -> Eq Unary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Unary -> Unary -> Bool
== :: Unary -> Unary -> Bool
$c/= :: Unary -> Unary -> Bool
/= :: Unary -> Unary -> Bool
Eq, Eq Unary
Eq Unary
-> (Unary -> Unary -> Ordering)
-> (Unary -> Unary -> Bool)
-> (Unary -> Unary -> Bool)
-> (Unary -> Unary -> Bool)
-> (Unary -> Unary -> Bool)
-> (Unary -> Unary -> Unary)
-> (Unary -> Unary -> Unary)
-> Ord Unary
Unary -> Unary -> Bool
Unary -> Unary -> Ordering
Unary -> Unary -> Unary
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Unary -> Unary -> Ordering
compare :: Unary -> Unary -> Ordering
$c< :: Unary -> Unary -> Bool
< :: Unary -> Unary -> Bool
$c<= :: Unary -> Unary -> Bool
<= :: Unary -> Unary -> Bool
$c> :: Unary -> Unary -> Bool
> :: Unary -> Unary -> Bool
$c>= :: Unary -> Unary -> Bool
>= :: Unary -> Unary -> Bool
$cmax :: Unary -> Unary -> Unary
max :: Unary -> Unary -> Unary
$cmin :: Unary -> Unary -> Unary
min :: Unary -> Unary -> Unary
Ord, Int -> Unary -> ShowS
[Unary] -> ShowS
Unary -> String
(Int -> Unary -> ShowS)
-> (Unary -> String) -> ([Unary] -> ShowS) -> Show Unary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Unary -> ShowS
showsPrec :: Int -> Unary -> ShowS
$cshow :: Unary -> String
show :: Unary -> String
$cshowList :: [Unary] -> ShowS
showList :: [Unary] -> ShowS
Show, (forall (m :: * -> *). Quote m => Unary -> m Exp)
-> (forall (m :: * -> *). Quote m => Unary -> Code m Unary)
-> Lift Unary
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Unary -> m Exp
forall (m :: * -> *). Quote m => Unary -> Code m Unary
$clift :: forall (m :: * -> *). Quote m => Unary -> m Exp
lift :: forall (m :: * -> *). Quote m => Unary -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Unary -> Code m Unary
liftTyped :: forall (m :: * -> *). Quote m => Unary -> Code m Unary
Lift)
data Binary =
LessThan
| GreaterThan
| LessOrEqual
| GreaterOrEqual
| Equal
| Contains
| Prefix
| Suffix
| Regex
| Add
| Sub
| Mul
| Div
| And
| Or
| Intersection
| Union
| BitwiseAnd
| BitwiseOr
| BitwiseXor
| NotEqual
deriving (Binary -> Binary -> Bool
(Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool) -> Eq Binary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Binary -> Binary -> Bool
== :: Binary -> Binary -> Bool
$c/= :: Binary -> Binary -> Bool
/= :: Binary -> Binary -> Bool
Eq, Eq Binary
Eq Binary
-> (Binary -> Binary -> Ordering)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Binary)
-> (Binary -> Binary -> Binary)
-> Ord Binary
Binary -> Binary -> Bool
Binary -> Binary -> Ordering
Binary -> Binary -> Binary
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Binary -> Binary -> Ordering
compare :: Binary -> Binary -> Ordering
$c< :: Binary -> Binary -> Bool
< :: Binary -> Binary -> Bool
$c<= :: Binary -> Binary -> Bool
<= :: Binary -> Binary -> Bool
$c> :: Binary -> Binary -> Bool
> :: Binary -> Binary -> Bool
$c>= :: Binary -> Binary -> Bool
>= :: Binary -> Binary -> Bool
$cmax :: Binary -> Binary -> Binary
max :: Binary -> Binary -> Binary
$cmin :: Binary -> Binary -> Binary
min :: Binary -> Binary -> Binary
Ord, Int -> Binary -> ShowS
[Binary] -> ShowS
Binary -> String
(Int -> Binary -> ShowS)
-> (Binary -> String) -> ([Binary] -> ShowS) -> Show Binary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Binary -> ShowS
showsPrec :: Int -> Binary -> ShowS
$cshow :: Binary -> String
show :: Binary -> String
$cshowList :: [Binary] -> ShowS
showList :: [Binary] -> ShowS
Show, (forall (m :: * -> *). Quote m => Binary -> m Exp)
-> (forall (m :: * -> *). Quote m => Binary -> Code m Binary)
-> Lift Binary
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Binary -> m Exp
forall (m :: * -> *). Quote m => Binary -> Code m Binary
$clift :: forall (m :: * -> *). Quote m => Binary -> m Exp
lift :: forall (m :: * -> *). Quote m => Binary -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Binary -> Code m Binary
liftTyped :: forall (m :: * -> *). Quote m => Binary -> Code m Binary
Lift)
data Expression' (ctx :: DatalogContext) =
EValue (Term' 'NotWithinSet 'InPredicate ctx)
| EUnary Unary (Expression' ctx)
| EBinary Binary (Expression' ctx) (Expression' ctx)
deriving instance Eq (Term' 'NotWithinSet 'InPredicate ctx) => Eq (Expression' ctx)
deriving instance Ord (Term' 'NotWithinSet 'InPredicate ctx) => Ord (Expression' ctx)
deriving instance Lift (Term' 'NotWithinSet 'InPredicate ctx) => Lift (Expression' ctx)
deriving instance Show (Term' 'NotWithinSet 'InPredicate ctx) => Show (Expression' ctx)
type Expression = Expression' 'Representation
listSymbolsInExpression :: Expression -> Set.Set Text
listSymbolsInExpression :: Expression -> Set Text
listSymbolsInExpression = \case
EValue Term
t -> Term -> Set Text
listSymbolsInTerm Term
t
EUnary Unary
_ Expression
e -> Expression -> Set Text
listSymbolsInExpression Expression
e
EBinary Binary
_ Expression
e Expression
e' -> (Expression -> Set Text) -> [Expression] -> Set Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Expression -> Set Text
listSymbolsInExpression [Expression
e, Expression
e']
data Op =
VOp Term
| UOp Unary
| BOp Binary
fromStack :: [Op] -> Either String Expression
fromStack :: [Op] -> Either String Expression
fromStack =
let go :: [Expression] -> [Op] -> Either a [Expression]
go [Expression]
stack [] = [Expression] -> Either a [Expression]
forall a b. b -> Either a b
Right [Expression]
stack
go [Expression]
stack (VOp Term
t : [Op]
rest) = [Expression] -> [Op] -> Either a [Expression]
go (Term -> Expression
forall (ctx :: DatalogContext).
Term' 'NotWithinSet 'InPredicate ctx -> Expression' ctx
EValue Term
t Expression -> [Expression] -> [Expression]
forall a. a -> [a] -> [a]
: [Expression]
stack) [Op]
rest
go (Expression
e:[Expression]
stack) (UOp Unary
o : [Op]
rest) = [Expression] -> [Op] -> Either a [Expression]
go (Unary -> Expression -> Expression
forall (ctx :: DatalogContext).
Unary -> Expression' ctx -> Expression' ctx
EUnary Unary
o Expression
e Expression -> [Expression] -> [Expression]
forall a. a -> [a] -> [a]
: [Expression]
stack) [Op]
rest
go [] (UOp Unary
_ : [Op]
_) = a -> Either a [Expression]
forall a b. a -> Either a b
Left a
"Empty stack on unary op"
go (Expression
e:Expression
e':[Expression]
stack) (BOp Binary
o : [Op]
rest) = [Expression] -> [Op] -> Either a [Expression]
go (Binary -> Expression -> Expression -> Expression
forall (ctx :: DatalogContext).
Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
EBinary Binary
o Expression
e' Expression
e Expression -> [Expression] -> [Expression]
forall a. a -> [a] -> [a]
: [Expression]
stack) [Op]
rest
go [Expression
_] (BOp Binary
_ : [Op]
_) = a -> Either a [Expression]
forall a b. a -> Either a b
Left a
"Unary stack on binary op"
go [] (BOp Binary
_ : [Op]
_) = a -> Either a [Expression]
forall a b. a -> Either a b
Left a
"Empty stack on binary op"
final :: [b] -> Either a b
final [] = a -> Either a b
forall a b. a -> Either a b
Left a
"Empty stack"
final [b
x] = b -> Either a b
forall a b. b -> Either a b
Right b
x
final [b]
_ = a -> Either a b
forall a b. a -> Either a b
Left a
"Stack containing more than one element"
in [Expression] -> Either String Expression
forall {a} {b}. IsString a => [b] -> Either a b
final ([Expression] -> Either String Expression)
-> ([Op] -> Either String [Expression])
-> [Op]
-> Either String Expression
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [Expression] -> [Op] -> Either String [Expression]
forall {a}.
IsString a =>
[Expression] -> [Op] -> Either a [Expression]
go []
toStack :: Expression -> [Op]
toStack :: Expression -> [Op]
toStack Expression
expr =
let go :: Expression -> [Op] -> [Op]
go Expression
e [Op]
s = case Expression
e of
EValue Term
t -> Term -> Op
VOp Term
t Op -> [Op] -> [Op]
forall a. a -> [a] -> [a]
: [Op]
s
EUnary Unary
o Expression
i -> Expression -> [Op] -> [Op]
go Expression
i ([Op] -> [Op]) -> [Op] -> [Op]
forall a b. (a -> b) -> a -> b
$ Unary -> Op
UOp Unary
o Op -> [Op] -> [Op]
forall a. a -> [a] -> [a]
: [Op]
s
EBinary Binary
o Expression
l Expression
r -> Expression -> [Op] -> [Op]
go Expression
l ([Op] -> [Op]) -> [Op] -> [Op]
forall a b. (a -> b) -> a -> b
$ Expression -> [Op] -> [Op]
go Expression
r ([Op] -> [Op]) -> [Op] -> [Op]
forall a b. (a -> b) -> a -> b
$ Binary -> Op
BOp Binary
o Op -> [Op] -> [Op]
forall a. a -> [a] -> [a]
: [Op]
s
in Expression -> [Op] -> [Op]
go Expression
expr []
renderExpression :: Expression -> Text
renderExpression :: Expression -> Text
renderExpression =
let rOp :: Text -> Expression -> Expression -> Text
rOp Text
t Expression
e Expression
e' = Expression -> Text
renderExpression Expression
e
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
renderExpression Expression
e'
rm :: Text -> Expression -> Expression -> Text
rm Text
m Expression
e Expression
e' = Expression -> Text
renderExpression Expression
e
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"("
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
renderExpression Expression
e'
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
in \case
EValue Term
t -> Term -> Text
renderId Term
t
EUnary Unary
Negate Expression
e -> Text
"!" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
renderExpression Expression
e
EUnary Unary
Parens Expression
e -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
renderExpression Expression
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
EUnary Unary
Length Expression
e -> Expression -> Text
renderExpression Expression
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".length()"
EBinary Binary
LessThan Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rOp Text
"<" Expression
e Expression
e'
EBinary Binary
GreaterThan Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rOp Text
">" Expression
e Expression
e'
EBinary Binary
LessOrEqual Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rOp Text
"<=" Expression
e Expression
e'
EBinary Binary
GreaterOrEqual Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rOp Text
">=" Expression
e Expression
e'
EBinary Binary
Equal Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rOp Text
"==" Expression
e Expression
e'
EBinary Binary
Contains Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rm Text
"contains" Expression
e Expression
e'
EBinary Binary
Prefix Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rm Text
"starts_with" Expression
e Expression
e'
EBinary Binary
Suffix Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rm Text
"ends_with" Expression
e Expression
e'
EBinary Binary
Regex Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rm Text
"matches" Expression
e Expression
e'
EBinary Binary
Intersection Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rm Text
"intersection" Expression
e Expression
e'
EBinary Binary
Union Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rm Text
"union" Expression
e Expression
e'
EBinary Binary
Add Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rOp Text
"+" Expression
e Expression
e'
EBinary Binary
Sub Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rOp Text
"-" Expression
e Expression
e'
EBinary Binary
Mul Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rOp Text
"*" Expression
e Expression
e'
EBinary Binary
Div Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rOp Text
"/" Expression
e Expression
e'
EBinary Binary
And Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rOp Text
"&&" Expression
e Expression
e'
EBinary Binary
Or Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rOp Text
"||" Expression
e Expression
e'
EBinary Binary
BitwiseAnd Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rOp Text
"&" Expression
e Expression
e'
EBinary Binary
BitwiseOr Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rOp Text
"|" Expression
e Expression
e'
EBinary Binary
BitwiseXor Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rOp Text
"^" Expression
e Expression
e'
EBinary Binary
NotEqual Expression
e Expression
e' -> Text -> Expression -> Expression -> Text
rOp Text
"!=" Expression
e Expression
e'
type Block = Block' 'Repr 'Representation
type EvalBlock = Block' 'Eval 'Representation
data Block' (evalCtx :: EvaluationContext) (ctx :: DatalogContext) = Block
{ forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
bRules :: [Rule' evalCtx ctx]
, forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Predicate' 'InFact ctx]
bFacts :: [Predicate' 'InFact ctx]
, forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bChecks :: [Check' evalCtx ctx]
, forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Maybe Text
bContext :: Maybe Text
, forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bScope :: Set (RuleScope' evalCtx ctx)
}
deriving instance ( Eq (Predicate' 'InFact ctx)
, Eq (Rule' evalCtx ctx)
, Eq (QueryItem' evalCtx ctx)
, Eq (RuleScope' evalCtx ctx)
) => Eq (Block' evalCtx ctx)
deriving instance ( Lift (Predicate' 'InFact ctx)
, Lift (Rule' evalCtx ctx)
, Lift (QueryItem' evalCtx ctx)
, Lift (RuleScope' evalCtx ctx)
) => Lift (Block' evalCtx ctx)
instance Show Block where
show :: Block -> String
show = Text -> String
unpack (Text -> String) -> (Block -> Text) -> Block -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Text
renderBlock
instance Semigroup (Block' evalCtx ctx) where
Block' evalCtx ctx
b1 <> :: Block' evalCtx ctx -> Block' evalCtx ctx -> Block' evalCtx ctx
<> Block' evalCtx ctx
b2 = Block { bRules :: [Rule' evalCtx ctx]
bRules = Block' evalCtx ctx -> [Rule' evalCtx ctx]
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
bRules Block' evalCtx ctx
b1 [Rule' evalCtx ctx] -> [Rule' evalCtx ctx] -> [Rule' evalCtx ctx]
forall a. Semigroup a => a -> a -> a
<> Block' evalCtx ctx -> [Rule' evalCtx ctx]
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
bRules Block' evalCtx ctx
b2
, bFacts :: [Predicate' 'InFact ctx]
bFacts = Block' evalCtx ctx -> [Predicate' 'InFact ctx]
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Predicate' 'InFact ctx]
bFacts Block' evalCtx ctx
b1 [Predicate' 'InFact ctx]
-> [Predicate' 'InFact ctx] -> [Predicate' 'InFact ctx]
forall a. Semigroup a => a -> a -> a
<> Block' evalCtx ctx -> [Predicate' 'InFact ctx]
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Predicate' 'InFact ctx]
bFacts Block' evalCtx ctx
b2
, bChecks :: [Check' evalCtx ctx]
bChecks = Block' evalCtx ctx -> [Check' evalCtx ctx]
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bChecks Block' evalCtx ctx
b1 [Check' evalCtx ctx]
-> [Check' evalCtx ctx] -> [Check' evalCtx ctx]
forall a. Semigroup a => a -> a -> a
<> Block' evalCtx ctx -> [Check' evalCtx ctx]
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bChecks Block' evalCtx ctx
b2
, bContext :: Maybe Text
bContext = Block' evalCtx ctx -> Maybe Text
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Maybe Text
bContext Block' evalCtx ctx
b2 Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Block' evalCtx ctx -> Maybe Text
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Maybe Text
bContext Block' evalCtx ctx
b1
, bScope :: Set (RuleScope' evalCtx ctx)
bScope = if Set (RuleScope' evalCtx ctx) -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bScope Block' evalCtx ctx
b1)
then Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bScope Block' evalCtx ctx
b2
else Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bScope Block' evalCtx ctx
b1
}
instance Monoid (Block' evalCtx ctx) where
mempty :: Block' evalCtx ctx
mempty = Block { bRules :: [Rule' evalCtx ctx]
bRules = []
, bFacts :: [Predicate' 'InFact ctx]
bFacts = []
, bChecks :: [Check' evalCtx ctx]
bChecks = []
, bContext :: Maybe Text
bContext = Maybe Text
forall a. Maybe a
Nothing
, bScope :: Set (RuleScope' evalCtx ctx)
bScope = Set (RuleScope' evalCtx ctx)
forall a. Set a
Set.empty
}
renderRuleScope :: Set RuleScope -> Text
renderRuleScope :: Set RuleScope -> Text
renderRuleScope =
let renderScopeElem :: RuleScope -> Text
renderScopeElem = \case
RuleScope
OnlyAuthority -> Text
"authority"
RuleScope
Previous -> Text
"previous"
BlockId BlockIdType 'Repr 'Representation
bs -> Text
"ed25519/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
encodeHex (PublicKey -> ByteString
pkBytes PublicKey
BlockIdType 'Repr 'Representation
bs)
in Text -> [Text] -> Text
intercalate Text
", " ([Text] -> Text)
-> (Set RuleScope -> [Text]) -> Set RuleScope -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Text -> [Text]
forall a. Set a -> [a]
Set.toList (Set Text -> [Text])
-> (Set RuleScope -> Set Text) -> Set RuleScope -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RuleScope -> Text) -> Set RuleScope -> Set Text
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map RuleScope -> Text
renderScopeElem
renderBlock :: Block -> Text
renderBlock :: Block -> Text
renderBlock Block{[Rule]
[Check]
[Fact]
Maybe Text
Set RuleScope
bRules :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
bFacts :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Predicate' 'InFact ctx]
bChecks :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bContext :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Maybe Text
bScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bRules :: [Rule]
bFacts :: [Fact]
bChecks :: [Check]
bContext :: Maybe Text
bScope :: Set RuleScope
..} =
let renderScopeLine :: Set RuleScope -> Text
renderScopeLine = (Text
"trusting " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Set RuleScope -> Text) -> Set RuleScope -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set RuleScope -> Text
renderRuleScope
in (Text -> Text) -> [Text] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";\n") ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [Text]
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
[ [Set RuleScope -> Text
renderScopeLine Set RuleScope
bScope | Bool -> Bool
not (Set RuleScope -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set RuleScope
bScope)]
, Rule -> Text
renderRule (Rule -> Text) -> [Rule] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rule]
bRules
, Fact -> Text
renderFact (Fact -> Text) -> [Fact] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Fact]
bFacts
, Check -> Text
renderCheck (Check -> Text) -> [Check] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Check]
bChecks
]
listSymbolsInBlock :: Block -> Set.Set Text
listSymbolsInBlock :: Block -> Set Text
listSymbolsInBlock Block {[Rule]
[Check]
[Fact]
Maybe Text
Set RuleScope
bRules :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
bFacts :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Predicate' 'InFact ctx]
bChecks :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bContext :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Maybe Text
bScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bRules :: [Rule]
bFacts :: [Fact]
bChecks :: [Check]
bContext :: Maybe Text
bScope :: Set RuleScope
..} = [Set Text] -> Set Text
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
[ (Rule -> Set Text) -> [Rule] -> Set Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Rule -> Set Text
listSymbolsInRule [Rule]
bRules
, (Fact -> Set Text) -> [Fact] -> Set Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Fact -> Set Text
listSymbolsInFact [Fact]
bFacts
, (Check -> Set Text) -> [Check] -> Set Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Check -> Set Text
listSymbolsInCheck [Check]
bChecks
]
listPublicKeysInBlock :: Block -> Set.Set PublicKey
listPublicKeysInBlock :: Block -> Set PublicKey
listPublicKeysInBlock Block{[Rule]
[Check]
[Fact]
Maybe Text
Set RuleScope
bRules :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
bFacts :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Predicate' 'InFact ctx]
bChecks :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bContext :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Maybe Text
bScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bRules :: [Rule]
bFacts :: [Fact]
bChecks :: [Check]
bContext :: Maybe Text
bScope :: Set RuleScope
..} = [Set PublicKey] -> Set PublicKey
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
[ (Rule -> Set PublicKey) -> [Rule] -> Set PublicKey
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Rule -> Set PublicKey
listPublicKeysInRule [Rule]
bRules
, (Check -> Set PublicKey) -> [Check] -> Set PublicKey
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Check -> Set PublicKey
listPublicKeysInCheck [Check]
bChecks
, Set RuleScope -> Set PublicKey
listPublicKeysInScope Set RuleScope
bScope
]
type Authorizer = Authorizer' 'Repr 'Representation
data Authorizer' (evalCtx :: EvaluationContext) (ctx :: DatalogContext) = Authorizer
{ forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> [Policy' evalCtx ctx]
vPolicies :: [Policy' evalCtx ctx]
, forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> Block' evalCtx ctx
vBlock :: Block' evalCtx ctx
}
instance Semigroup (Authorizer' evalCtx ctx) where
Authorizer' evalCtx ctx
v1 <> :: Authorizer' evalCtx ctx
-> Authorizer' evalCtx ctx -> Authorizer' evalCtx ctx
<> Authorizer' evalCtx ctx
v2 = Authorizer { vPolicies :: [Policy' evalCtx ctx]
vPolicies = Authorizer' evalCtx ctx -> [Policy' evalCtx ctx]
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> [Policy' evalCtx ctx]
vPolicies Authorizer' evalCtx ctx
v1 [Policy' evalCtx ctx]
-> [Policy' evalCtx ctx] -> [Policy' evalCtx ctx]
forall a. Semigroup a => a -> a -> a
<> Authorizer' evalCtx ctx -> [Policy' evalCtx ctx]
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> [Policy' evalCtx ctx]
vPolicies Authorizer' evalCtx ctx
v2
, vBlock :: Block' evalCtx ctx
vBlock = Authorizer' evalCtx ctx -> Block' evalCtx ctx
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> Block' evalCtx ctx
vBlock Authorizer' evalCtx ctx
v1 Block' evalCtx ctx -> Block' evalCtx ctx -> Block' evalCtx ctx
forall a. Semigroup a => a -> a -> a
<> Authorizer' evalCtx ctx -> Block' evalCtx ctx
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> Block' evalCtx ctx
vBlock Authorizer' evalCtx ctx
v2
}
instance Monoid (Authorizer' evalCtx ctx) where
mempty :: Authorizer' evalCtx ctx
mempty = Authorizer { vPolicies :: [Policy' evalCtx ctx]
vPolicies = []
, vBlock :: Block' evalCtx ctx
vBlock = Block' evalCtx ctx
forall a. Monoid a => a
mempty
}
deriving instance ( Eq (Block' evalCtx ctx)
, Eq (QueryItem' evalCtx ctx)
) => Eq (Authorizer' evalCtx ctx)
deriving instance ( Show (Block' evalCtx ctx)
, Show (QueryItem' evalCtx ctx)
) => Show (Authorizer' evalCtx ctx)
deriving instance ( Lift (Block' evalCtx ctx)
, Lift (QueryItem' evalCtx ctx)
) => Lift (Authorizer' evalCtx ctx)
renderAuthorizer :: Authorizer -> Text
renderAuthorizer :: Authorizer -> Text
renderAuthorizer Authorizer{[Policy]
Block
vPolicies :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> [Policy' evalCtx ctx]
vBlock :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> Block' evalCtx ctx
vPolicies :: [Policy]
vBlock :: Block
..} =
Block -> Text
renderBlock Block
vBlock Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> [Text] -> Text
intercalate Text
"\n" (Policy -> Text
renderPolicy (Policy -> Text) -> [Policy] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Policy]
vPolicies)
data BlockElement' evalCtx ctx
= BlockFact (Predicate' 'InFact ctx)
| BlockRule (Rule' evalCtx ctx)
| BlockCheck (Check' evalCtx ctx)
|
deriving instance ( Show (Predicate' 'InFact ctx)
, Show (Rule' evalCtx ctx)
, Show (QueryItem' evalCtx ctx)
) => Show (BlockElement' evalCtx ctx)
elementToBlock :: BlockElement' evalCtx ctx -> Block' evalCtx ctx
elementToBlock :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
BlockElement' evalCtx ctx -> Block' evalCtx ctx
elementToBlock = \case
BlockRule Rule' evalCtx ctx
r -> [Rule' evalCtx ctx]
-> [Predicate' 'InFact ctx]
-> [Check' evalCtx ctx]
-> Maybe Text
-> Set (RuleScope' evalCtx ctx)
-> Block' evalCtx ctx
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
[Rule' evalCtx ctx]
-> [Predicate' 'InFact ctx]
-> [Check' evalCtx ctx]
-> Maybe Text
-> Set (RuleScope' evalCtx ctx)
-> Block' evalCtx ctx
Block [Rule' evalCtx ctx
r] [] [] Maybe Text
forall a. Maybe a
Nothing Set (RuleScope' evalCtx ctx)
forall a. Set a
Set.empty
BlockFact Predicate' 'InFact ctx
f -> [Rule' evalCtx ctx]
-> [Predicate' 'InFact ctx]
-> [Check' evalCtx ctx]
-> Maybe Text
-> Set (RuleScope' evalCtx ctx)
-> Block' evalCtx ctx
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
[Rule' evalCtx ctx]
-> [Predicate' 'InFact ctx]
-> [Check' evalCtx ctx]
-> Maybe Text
-> Set (RuleScope' evalCtx ctx)
-> Block' evalCtx ctx
Block [] [Predicate' 'InFact ctx
f] [] Maybe Text
forall a. Maybe a
Nothing Set (RuleScope' evalCtx ctx)
forall a. Set a
Set.empty
BlockCheck Check' evalCtx ctx
c -> [Rule' evalCtx ctx]
-> [Predicate' 'InFact ctx]
-> [Check' evalCtx ctx]
-> Maybe Text
-> Set (RuleScope' evalCtx ctx)
-> Block' evalCtx ctx
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
[Rule' evalCtx ctx]
-> [Predicate' 'InFact ctx]
-> [Check' evalCtx ctx]
-> Maybe Text
-> Set (RuleScope' evalCtx ctx)
-> Block' evalCtx ctx
Block [] [] [Check' evalCtx ctx
c] Maybe Text
forall a. Maybe a
Nothing Set (RuleScope' evalCtx ctx)
forall a. Set a
Set.empty
BlockElement' evalCtx ctx
BlockComment -> Block' evalCtx ctx
forall a. Monoid a => a
mempty
data AuthorizerElement' evalCtx ctx
= AuthorizerPolicy (Policy' evalCtx ctx)
| BlockElement (BlockElement' evalCtx ctx)
deriving instance ( Show (Predicate' 'InFact ctx)
, Show (Rule' evalCtx ctx)
, Show (QueryItem' evalCtx ctx)
) => Show (AuthorizerElement' evalCtx ctx)
elementToAuthorizer :: AuthorizerElement' evalCtx ctx -> Authorizer' evalCtx ctx
elementToAuthorizer :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
AuthorizerElement' evalCtx ctx -> Authorizer' evalCtx ctx
elementToAuthorizer = \case
AuthorizerPolicy Policy' evalCtx ctx
p -> [Policy' evalCtx ctx]
-> Block' evalCtx ctx -> Authorizer' evalCtx ctx
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
[Policy' evalCtx ctx]
-> Block' evalCtx ctx -> Authorizer' evalCtx ctx
Authorizer [Policy' evalCtx ctx
p] Block' evalCtx ctx
forall a. Monoid a => a
mempty
BlockElement BlockElement' evalCtx ctx
be -> [Policy' evalCtx ctx]
-> Block' evalCtx ctx -> Authorizer' evalCtx ctx
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
[Policy' evalCtx ctx]
-> Block' evalCtx ctx -> Authorizer' evalCtx ctx
Authorizer [] (BlockElement' evalCtx ctx -> Block' evalCtx ctx
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
BlockElement' evalCtx ctx -> Block' evalCtx ctx
elementToBlock BlockElement' evalCtx ctx
be)
class ToEvaluation elem where
toEvaluation :: [Maybe PublicKey] -> elem 'Repr 'Representation -> elem 'Eval 'Representation
toRepresentation :: elem 'Eval 'Representation -> elem 'Repr 'Representation
translateScope :: [Maybe PublicKey] -> Set RuleScope -> Set EvalRuleScope
translateScope :: [Maybe PublicKey] -> Set RuleScope -> Set EvalRuleScope
translateScope [Maybe PublicKey]
ePks =
let indexedPks :: Map PublicKey (Set Natural)
indexedPks :: Map PublicKey (Set Natural)
indexedPks =
let makeEntry :: (Maybe a, a) -> [(a, Set a)]
makeEntry (Just a
bPk, a
bId) = [(a
bPk, a -> Set a
forall a. a -> Set a
Set.singleton a
bId)]
makeEntry (Maybe a, a)
_ = []
in (Set Natural -> Set Natural -> Set Natural)
-> [(PublicKey, Set Natural)] -> Map PublicKey (Set Natural)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set Natural -> Set Natural -> Set Natural
forall a. Semigroup a => a -> a -> a
(<>) ([(PublicKey, Set Natural)] -> Map PublicKey (Set Natural))
-> [(PublicKey, Set Natural)] -> Map PublicKey (Set Natural)
forall a b. (a -> b) -> a -> b
$ ((Maybe PublicKey, Natural) -> [(PublicKey, Set Natural)])
-> [(Maybe PublicKey, Natural)] -> [(PublicKey, Set Natural)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe PublicKey, Natural) -> [(PublicKey, Set Natural)]
forall {a} {a}. (Maybe a, a) -> [(a, Set a)]
makeEntry ([(Maybe PublicKey, Natural)] -> [(PublicKey, Set Natural)])
-> [(Maybe PublicKey, Natural)] -> [(PublicKey, Set Natural)]
forall a b. (a -> b) -> a -> b
$ [Maybe PublicKey] -> [Natural] -> [(Maybe PublicKey, Natural)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe PublicKey]
ePks [Natural
0..]
translateElem :: RuleScope -> EvalRuleScope
translateElem = \case
RuleScope
Previous -> EvalRuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
Previous
RuleScope
OnlyAuthority -> EvalRuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
OnlyAuthority
BlockId BlockIdType 'Repr 'Representation
bPk -> BlockIdType 'Eval 'Representation -> EvalRuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
BlockIdType evalCtx ctx -> RuleScope' evalCtx ctx
BlockId (Maybe (Set Natural) -> Set Natural
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe (Set Natural) -> Set Natural)
-> Maybe (Set Natural) -> Set Natural
forall a b. (a -> b) -> a -> b
$ PublicKey -> Map PublicKey (Set Natural) -> Maybe (Set Natural)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PublicKey
BlockIdType 'Repr 'Representation
bPk Map PublicKey (Set Natural)
indexedPks, PublicKey
BlockIdType 'Repr 'Representation
bPk)
in (RuleScope -> EvalRuleScope) -> Set RuleScope -> Set EvalRuleScope
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map RuleScope -> EvalRuleScope
translateElem
renderBlockIds :: Set EvalRuleScope -> Set RuleScope
renderBlockIds :: Set EvalRuleScope -> Set RuleScope
renderBlockIds =
let renderElem :: EvalRuleScope -> RuleScope
renderElem = \case
EvalRuleScope
Previous -> RuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
Previous
EvalRuleScope
OnlyAuthority -> RuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
OnlyAuthority
BlockId (Set Natural
_, BlockIdType 'Repr 'Representation
ePk) -> BlockIdType 'Repr 'Representation -> RuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
BlockIdType evalCtx ctx -> RuleScope' evalCtx ctx
BlockId BlockIdType 'Repr 'Representation
ePk
in (EvalRuleScope -> RuleScope) -> Set EvalRuleScope -> Set RuleScope
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map EvalRuleScope -> RuleScope
renderElem
instance ToEvaluation Rule' where
toEvaluation :: [Maybe PublicKey] -> Rule -> Rule' 'Eval 'Representation
toEvaluation [Maybe PublicKey]
ePks Rule
r = Rule
r { scope :: Set EvalRuleScope
scope = [Maybe PublicKey] -> Set RuleScope -> Set EvalRuleScope
translateScope [Maybe PublicKey]
ePks (Set RuleScope -> Set EvalRuleScope)
-> Set RuleScope -> Set EvalRuleScope
forall a b. (a -> b) -> a -> b
$ Rule -> Set RuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
scope Rule
r }
toRepresentation :: Rule' 'Eval 'Representation -> Rule
toRepresentation Rule' 'Eval 'Representation
r = Rule' 'Eval 'Representation
r { scope :: Set RuleScope
scope = Set EvalRuleScope -> Set RuleScope
renderBlockIds (Set EvalRuleScope -> Set RuleScope)
-> Set EvalRuleScope -> Set RuleScope
forall a b. (a -> b) -> a -> b
$ Rule' 'Eval 'Representation -> Set EvalRuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
scope Rule' 'Eval 'Representation
r }
instance ToEvaluation QueryItem' where
toEvaluation :: [Maybe PublicKey]
-> QueryItem' 'Repr 'Representation
-> QueryItem' 'Eval 'Representation
toEvaluation [Maybe PublicKey]
ePks QueryItem' 'Repr 'Representation
qi = QueryItem' 'Repr 'Representation
qi{ qScope :: Set EvalRuleScope
qScope = [Maybe PublicKey] -> Set RuleScope -> Set EvalRuleScope
translateScope [Maybe PublicKey]
ePks (Set RuleScope -> Set EvalRuleScope)
-> Set RuleScope -> Set EvalRuleScope
forall a b. (a -> b) -> a -> b
$ QueryItem' 'Repr 'Representation -> Set RuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
qScope QueryItem' 'Repr 'Representation
qi}
toRepresentation :: QueryItem' 'Eval 'Representation
-> QueryItem' 'Repr 'Representation
toRepresentation QueryItem' 'Eval 'Representation
qi = QueryItem' 'Eval 'Representation
qi { qScope :: Set RuleScope
qScope = Set EvalRuleScope -> Set RuleScope
renderBlockIds (Set EvalRuleScope -> Set RuleScope)
-> Set EvalRuleScope -> Set RuleScope
forall a b. (a -> b) -> a -> b
$ QueryItem' 'Eval 'Representation -> Set EvalRuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
qScope QueryItem' 'Eval 'Representation
qi}
instance ToEvaluation Check' where
toEvaluation :: [Maybe PublicKey] -> Check -> Check' 'Eval 'Representation
toEvaluation [Maybe PublicKey]
ePks Check
c = Check
c { cQueries :: Query' 'Eval 'Representation
cQueries = (QueryItem' 'Repr 'Representation
-> QueryItem' 'Eval 'Representation)
-> Query -> Query' 'Eval 'Representation
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Maybe PublicKey]
-> QueryItem' 'Repr 'Representation
-> QueryItem' 'Eval 'Representation
forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
[Maybe PublicKey]
-> elem 'Repr 'Representation -> elem 'Eval 'Representation
toEvaluation [Maybe PublicKey]
ePks) (Check -> Query
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cQueries Check
c) }
toRepresentation :: Check' 'Eval 'Representation -> Check
toRepresentation Check' 'Eval 'Representation
c = Check' 'Eval 'Representation
c { cQueries :: Query
cQueries = (QueryItem' 'Eval 'Representation
-> QueryItem' 'Repr 'Representation)
-> Query' 'Eval 'Representation -> Query
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QueryItem' 'Eval 'Representation
-> QueryItem' 'Repr 'Representation
forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
elem 'Eval 'Representation -> elem 'Repr 'Representation
toRepresentation (Check' 'Eval 'Representation -> Query' 'Eval 'Representation
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cQueries Check' 'Eval 'Representation
c) }
instance ToEvaluation Block' where
toEvaluation :: [Maybe PublicKey] -> Block -> Block' 'Eval 'Representation
toEvaluation [Maybe PublicKey]
ePks Block
b = Block
b
{ bScope :: Set EvalRuleScope
bScope = [Maybe PublicKey] -> Set RuleScope -> Set EvalRuleScope
translateScope [Maybe PublicKey]
ePks (Set RuleScope -> Set EvalRuleScope)
-> Set RuleScope -> Set EvalRuleScope
forall a b. (a -> b) -> a -> b
$ Block -> Set RuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bScope Block
b
, bRules :: [Rule' 'Eval 'Representation]
bRules = [Maybe PublicKey] -> Rule -> Rule' 'Eval 'Representation
forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
[Maybe PublicKey]
-> elem 'Repr 'Representation -> elem 'Eval 'Representation
toEvaluation [Maybe PublicKey]
ePks (Rule -> Rule' 'Eval 'Representation)
-> [Rule] -> [Rule' 'Eval 'Representation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block -> [Rule]
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
bRules Block
b
, bChecks :: [Check' 'Eval 'Representation]
bChecks = [Maybe PublicKey] -> Check -> Check' 'Eval 'Representation
checkToEvaluation [Maybe PublicKey]
ePks (Check -> Check' 'Eval 'Representation)
-> [Check] -> [Check' 'Eval 'Representation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block -> [Check]
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bChecks Block
b
}
toRepresentation :: Block' 'Eval 'Representation -> Block
toRepresentation Block' 'Eval 'Representation
b = Block' 'Eval 'Representation
b
{ bScope :: Set RuleScope
bScope = Set EvalRuleScope -> Set RuleScope
renderBlockIds (Set EvalRuleScope -> Set RuleScope)
-> Set EvalRuleScope -> Set RuleScope
forall a b. (a -> b) -> a -> b
$ Block' 'Eval 'Representation -> Set EvalRuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bScope Block' 'Eval 'Representation
b
, bRules :: [Rule]
bRules = Rule' 'Eval 'Representation -> Rule
forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
elem 'Eval 'Representation -> elem 'Repr 'Representation
toRepresentation (Rule' 'Eval 'Representation -> Rule)
-> [Rule' 'Eval 'Representation] -> [Rule]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block' 'Eval 'Representation -> [Rule' 'Eval 'Representation]
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
bRules Block' 'Eval 'Representation
b
, bChecks :: [Check]
bChecks = Check' 'Eval 'Representation -> Check
forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
elem 'Eval 'Representation -> elem 'Repr 'Representation
toRepresentation (Check' 'Eval 'Representation -> Check)
-> [Check' 'Eval 'Representation] -> [Check]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block' 'Eval 'Representation -> [Check' 'Eval 'Representation]
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bChecks Block' 'Eval 'Representation
b
}
instance ToEvaluation Authorizer' where
toEvaluation :: [Maybe PublicKey]
-> Authorizer -> Authorizer' 'Eval 'Representation
toEvaluation [Maybe PublicKey]
ePks Authorizer
a = Authorizer
a
{ vBlock :: Block' 'Eval 'Representation
vBlock = [Maybe PublicKey] -> Block -> Block' 'Eval 'Representation
forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
[Maybe PublicKey]
-> elem 'Repr 'Representation -> elem 'Eval 'Representation
toEvaluation [Maybe PublicKey]
ePks (Authorizer -> Block
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> Block' evalCtx ctx
vBlock Authorizer
a)
, vPolicies :: [Policy' 'Eval 'Representation]
vPolicies = [Maybe PublicKey] -> Policy -> Policy' 'Eval 'Representation
policyToEvaluation [Maybe PublicKey]
ePks (Policy -> Policy' 'Eval 'Representation)
-> [Policy] -> [Policy' 'Eval 'Representation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Authorizer -> [Policy]
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> [Policy' evalCtx ctx]
vPolicies Authorizer
a
}
toRepresentation :: Authorizer' 'Eval 'Representation -> Authorizer
toRepresentation Authorizer' 'Eval 'Representation
a = Authorizer' 'Eval 'Representation
a
{ vBlock :: Block
vBlock = Block' 'Eval 'Representation -> Block
forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
elem 'Eval 'Representation -> elem 'Repr 'Representation
toRepresentation (Authorizer' 'Eval 'Representation -> Block' 'Eval 'Representation
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> Block' evalCtx ctx
vBlock Authorizer' 'Eval 'Representation
a)
, vPolicies :: [Policy]
vPolicies = (Query' 'Eval 'Representation -> Query)
-> Policy' 'Eval 'Representation -> Policy
forall a b. (a -> b) -> (PolicyType, a) -> (PolicyType, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((QueryItem' 'Eval 'Representation
-> QueryItem' 'Repr 'Representation)
-> Query' 'Eval 'Representation -> Query
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QueryItem' 'Eval 'Representation
-> QueryItem' 'Repr 'Representation
forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
elem 'Eval 'Representation -> elem 'Repr 'Representation
toRepresentation) (Policy' 'Eval 'Representation -> Policy)
-> [Policy' 'Eval 'Representation] -> [Policy]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Authorizer' 'Eval 'Representation
-> [Policy' 'Eval 'Representation]
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> [Policy' evalCtx ctx]
vPolicies Authorizer' 'Eval 'Representation
a
}
checkToEvaluation :: [Maybe PublicKey] -> Check -> EvalCheck
checkToEvaluation :: [Maybe PublicKey] -> Check -> Check' 'Eval 'Representation
checkToEvaluation = [Maybe PublicKey] -> Check -> Check' 'Eval 'Representation
forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
[Maybe PublicKey]
-> elem 'Repr 'Representation -> elem 'Eval 'Representation
toEvaluation
policyToEvaluation :: [Maybe PublicKey] -> Policy -> EvalPolicy
policyToEvaluation :: [Maybe PublicKey] -> Policy -> Policy' 'Eval 'Representation
policyToEvaluation [Maybe PublicKey]
ePks = (Query -> Query' 'Eval 'Representation)
-> Policy -> Policy' 'Eval 'Representation
forall a b. (a -> b) -> (PolicyType, a) -> (PolicyType, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((QueryItem' 'Repr 'Representation
-> QueryItem' 'Eval 'Representation)
-> Query -> Query' 'Eval 'Representation
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Maybe PublicKey]
-> QueryItem' 'Repr 'Representation
-> QueryItem' 'Eval 'Representation
forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
[Maybe PublicKey]
-> elem 'Repr 'Representation -> elem 'Eval 'Representation
toEvaluation [Maybe PublicKey]
ePks))
substituteAuthorizer :: Map Text Value
-> Map Text PublicKey
-> Authorizer' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Authorizer
substituteAuthorizer :: Map Text Value
-> Map Text PublicKey
-> Authorizer' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Authorizer
substituteAuthorizer Map Text Value
termMapping Map Text PublicKey
keyMapping Authorizer{[Policy' 'Repr 'WithSlices]
Block' 'Repr 'WithSlices
vPolicies :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> [Policy' evalCtx ctx]
vBlock :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> Block' evalCtx ctx
vPolicies :: [Policy' 'Repr 'WithSlices]
vBlock :: Block' 'Repr 'WithSlices
..} = do
[Policy]
newPolicies <- (Policy' 'Repr 'WithSlices -> Validation (NonEmpty Text) Policy)
-> [Policy' 'Repr 'WithSlices]
-> Validation (NonEmpty Text) [Policy]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text Value
-> Map Text PublicKey
-> Policy' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Policy
substitutePolicy Map Text Value
termMapping Map Text PublicKey
keyMapping) [Policy' 'Repr 'WithSlices]
vPolicies
Block
newBlock <- Map Text Value
-> Map Text PublicKey
-> Block' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Block
substituteBlock Map Text Value
termMapping Map Text PublicKey
keyMapping Block' 'Repr 'WithSlices
vBlock
pure Authorizer{
vPolicies :: [Policy]
vPolicies = [Policy]
newPolicies,
vBlock :: Block
vBlock = Block
newBlock
}
substituteBlock :: Map Text Value
-> Map Text PublicKey
-> Block' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Block
substituteBlock :: Map Text Value
-> Map Text PublicKey
-> Block' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Block
substituteBlock Map Text Value
termMapping Map Text PublicKey
keyMapping Block{[Rule' 'Repr 'WithSlices]
[Check' 'Repr 'WithSlices]
[Predicate' 'InFact 'WithSlices]
Maybe Text
Set (RuleScope' 'Repr 'WithSlices)
bRules :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
bFacts :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Predicate' 'InFact ctx]
bChecks :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bContext :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Maybe Text
bScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bRules :: [Rule' 'Repr 'WithSlices]
bFacts :: [Predicate' 'InFact 'WithSlices]
bChecks :: [Check' 'Repr 'WithSlices]
bContext :: Maybe Text
bScope :: Set (RuleScope' 'Repr 'WithSlices)
..} = do
[Rule]
newRules <- (Rule' 'Repr 'WithSlices -> Validation (NonEmpty Text) Rule)
-> [Rule' 'Repr 'WithSlices] -> Validation (NonEmpty Text) [Rule]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text Value
-> Map Text PublicKey
-> Rule' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Rule
substituteRule Map Text Value
termMapping Map Text PublicKey
keyMapping) [Rule' 'Repr 'WithSlices]
bRules
[Fact]
newFacts <- (Predicate' 'InFact 'WithSlices -> Validation (NonEmpty Text) Fact)
-> [Predicate' 'InFact 'WithSlices]
-> Validation (NonEmpty Text) [Fact]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text Value
-> Predicate' 'InFact 'WithSlices
-> Validation (NonEmpty Text) Fact
substituteFact Map Text Value
termMapping) [Predicate' 'InFact 'WithSlices]
bFacts
[Check]
newChecks <- (Check' 'Repr 'WithSlices -> Validation (NonEmpty Text) Check)
-> [Check' 'Repr 'WithSlices] -> Validation (NonEmpty Text) [Check]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text Value
-> Map Text PublicKey
-> Check' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Check
substituteCheck Map Text Value
termMapping Map Text PublicKey
keyMapping) [Check' 'Repr 'WithSlices]
bChecks
Set RuleScope
newScope <- [RuleScope] -> Set RuleScope
forall a. Ord a => [a] -> Set a
Set.fromList ([RuleScope] -> Set RuleScope)
-> Validation (NonEmpty Text) [RuleScope]
-> Validation (NonEmpty Text) (Set RuleScope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuleScope' 'Repr 'WithSlices
-> Validation (NonEmpty Text) RuleScope)
-> [RuleScope' 'Repr 'WithSlices]
-> Validation (NonEmpty Text) [RuleScope]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text PublicKey
-> RuleScope' 'Repr 'WithSlices
-> Validation (NonEmpty Text) RuleScope
substituteScope Map Text PublicKey
keyMapping) (Set (RuleScope' 'Repr 'WithSlices)
-> [RuleScope' 'Repr 'WithSlices]
forall a. Set a -> [a]
Set.toList Set (RuleScope' 'Repr 'WithSlices)
bScope)
pure Block{
bRules :: [Rule]
bRules = [Rule]
newRules,
bFacts :: [Fact]
bFacts = [Fact]
newFacts,
bChecks :: [Check]
bChecks = [Check]
newChecks,
bScope :: Set RuleScope
bScope = Set RuleScope
newScope,
Maybe Text
bContext :: Maybe Text
bContext :: Maybe Text
..}
substituteRule :: Map Text Value -> Map Text PublicKey
-> Rule' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Rule
substituteRule :: Map Text Value
-> Map Text PublicKey
-> Rule' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Rule
substituteRule Map Text Value
termMapping Map Text PublicKey
keyMapping Rule{[Expression' 'WithSlices]
[Predicate' 'InPredicate 'WithSlices]
Set (RuleScope' 'Repr 'WithSlices)
Predicate' 'InPredicate 'WithSlices
rhead :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Predicate' 'InPredicate ctx
body :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Predicate' 'InPredicate ctx]
expressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Expression' ctx]
scope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
rhead :: Predicate' 'InPredicate 'WithSlices
body :: [Predicate' 'InPredicate 'WithSlices]
expressions :: [Expression' 'WithSlices]
scope :: Set (RuleScope' 'Repr 'WithSlices)
..} = do
Predicate
newHead <- Map Text Value
-> Predicate' 'InPredicate 'WithSlices
-> Validation (NonEmpty Text) Predicate
substitutePredicate Map Text Value
termMapping Predicate' 'InPredicate 'WithSlices
rhead
[Predicate]
newBody <- (Predicate' 'InPredicate 'WithSlices
-> Validation (NonEmpty Text) Predicate)
-> [Predicate' 'InPredicate 'WithSlices]
-> Validation (NonEmpty Text) [Predicate]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text Value
-> Predicate' 'InPredicate 'WithSlices
-> Validation (NonEmpty Text) Predicate
substitutePredicate Map Text Value
termMapping) [Predicate' 'InPredicate 'WithSlices]
body
[Expression]
newExpressions <- (Expression' 'WithSlices -> Validation (NonEmpty Text) Expression)
-> [Expression' 'WithSlices]
-> Validation (NonEmpty Text) [Expression]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text Value
-> Expression' 'WithSlices -> Validation (NonEmpty Text) Expression
substituteExpression Map Text Value
termMapping) [Expression' 'WithSlices]
expressions
Set RuleScope
newScope <- [RuleScope] -> Set RuleScope
forall a. Ord a => [a] -> Set a
Set.fromList ([RuleScope] -> Set RuleScope)
-> Validation (NonEmpty Text) [RuleScope]
-> Validation (NonEmpty Text) (Set RuleScope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuleScope' 'Repr 'WithSlices
-> Validation (NonEmpty Text) RuleScope)
-> [RuleScope' 'Repr 'WithSlices]
-> Validation (NonEmpty Text) [RuleScope]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text PublicKey
-> RuleScope' 'Repr 'WithSlices
-> Validation (NonEmpty Text) RuleScope
substituteScope Map Text PublicKey
keyMapping) (Set (RuleScope' 'Repr 'WithSlices)
-> [RuleScope' 'Repr 'WithSlices]
forall a. Set a -> [a]
Set.toList Set (RuleScope' 'Repr 'WithSlices)
scope)
pure Rule{
rhead :: Predicate
rhead = Predicate
newHead,
body :: [Predicate]
body = [Predicate]
newBody,
expressions :: [Expression]
expressions = [Expression]
newExpressions,
scope :: Set RuleScope
scope = Set RuleScope
newScope
}
substituteCheck :: Map Text Value -> Map Text PublicKey
-> Check' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Check
substituteCheck :: Map Text Value
-> Map Text PublicKey
-> Check' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Check
substituteCheck Map Text Value
termMapping Map Text PublicKey
keyMapping Check{Query' 'Repr 'WithSlices
CheckKind
cQueries :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cKind :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> CheckKind
cQueries :: Query' 'Repr 'WithSlices
cKind :: CheckKind
..} = do
Query
newQueries <- (QueryItem' 'Repr 'WithSlices
-> Validation (NonEmpty Text) (QueryItem' 'Repr 'Representation))
-> Query' 'Repr 'WithSlices -> Validation (NonEmpty Text) Query
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text Value
-> Map Text PublicKey
-> QueryItem' 'Repr 'WithSlices
-> Validation (NonEmpty Text) (QueryItem' 'Repr 'Representation)
substituteQuery Map Text Value
termMapping Map Text PublicKey
keyMapping) Query' 'Repr 'WithSlices
cQueries
pure Check{cQueries :: Query
cQueries = Query
newQueries, CheckKind
cKind :: CheckKind
cKind :: CheckKind
..}
substitutePolicy :: Map Text Value -> Map Text PublicKey
-> Policy' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Policy
substitutePolicy :: Map Text Value
-> Map Text PublicKey
-> Policy' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Policy
substitutePolicy Map Text Value
termMapping Map Text PublicKey
keyMapping =
(Query' 'Repr 'WithSlices -> Validation (NonEmpty Text) Query)
-> Policy' 'Repr 'WithSlices -> Validation (NonEmpty Text) Policy
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (PolicyType, a) -> f (PolicyType, b)
traverse ((QueryItem' 'Repr 'WithSlices
-> Validation (NonEmpty Text) (QueryItem' 'Repr 'Representation))
-> Query' 'Repr 'WithSlices -> Validation (NonEmpty Text) Query
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text Value
-> Map Text PublicKey
-> QueryItem' 'Repr 'WithSlices
-> Validation (NonEmpty Text) (QueryItem' 'Repr 'Representation)
substituteQuery Map Text Value
termMapping Map Text PublicKey
keyMapping))
substituteQuery :: Map Text Value-> Map Text PublicKey
-> QueryItem' 'Repr 'WithSlices
-> Validation (NonEmpty Text) (QueryItem' 'Repr 'Representation)
substituteQuery :: Map Text Value
-> Map Text PublicKey
-> QueryItem' 'Repr 'WithSlices
-> Validation (NonEmpty Text) (QueryItem' 'Repr 'Representation)
substituteQuery Map Text Value
termMapping Map Text PublicKey
keyMapping QueryItem{[Expression' 'WithSlices]
[Predicate' 'InPredicate 'WithSlices]
Set (RuleScope' 'Repr 'WithSlices)
qBody :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Predicate' 'InPredicate ctx]
qExpressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Expression' ctx]
qScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
qBody :: [Predicate' 'InPredicate 'WithSlices]
qExpressions :: [Expression' 'WithSlices]
qScope :: Set (RuleScope' 'Repr 'WithSlices)
..} = do
[Predicate]
newBody <- (Predicate' 'InPredicate 'WithSlices
-> Validation (NonEmpty Text) Predicate)
-> [Predicate' 'InPredicate 'WithSlices]
-> Validation (NonEmpty Text) [Predicate]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text Value
-> Predicate' 'InPredicate 'WithSlices
-> Validation (NonEmpty Text) Predicate
substitutePredicate Map Text Value
termMapping) [Predicate' 'InPredicate 'WithSlices]
qBody
[Expression]
newExpressions <- (Expression' 'WithSlices -> Validation (NonEmpty Text) Expression)
-> [Expression' 'WithSlices]
-> Validation (NonEmpty Text) [Expression]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text Value
-> Expression' 'WithSlices -> Validation (NonEmpty Text) Expression
substituteExpression Map Text Value
termMapping) [Expression' 'WithSlices]
qExpressions
Set RuleScope
newScope <- [RuleScope] -> Set RuleScope
forall a. Ord a => [a] -> Set a
Set.fromList ([RuleScope] -> Set RuleScope)
-> Validation (NonEmpty Text) [RuleScope]
-> Validation (NonEmpty Text) (Set RuleScope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuleScope' 'Repr 'WithSlices
-> Validation (NonEmpty Text) RuleScope)
-> [RuleScope' 'Repr 'WithSlices]
-> Validation (NonEmpty Text) [RuleScope]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text PublicKey
-> RuleScope' 'Repr 'WithSlices
-> Validation (NonEmpty Text) RuleScope
substituteScope Map Text PublicKey
keyMapping) (Set (RuleScope' 'Repr 'WithSlices)
-> [RuleScope' 'Repr 'WithSlices]
forall a. Set a -> [a]
Set.toList Set (RuleScope' 'Repr 'WithSlices)
qScope)
pure QueryItem{
qBody :: [Predicate]
qBody = [Predicate]
newBody,
qExpressions :: [Expression]
qExpressions = [Expression]
newExpressions,
qScope :: Set RuleScope
qScope = Set RuleScope
newScope
}
substitutePredicate :: Map Text Value
-> Predicate' 'InPredicate 'WithSlices
-> Validation (NonEmpty Text) (Predicate' 'InPredicate 'Representation)
substitutePredicate :: Map Text Value
-> Predicate' 'InPredicate 'WithSlices
-> Validation (NonEmpty Text) Predicate
substitutePredicate Map Text Value
termMapping Predicate{[Term' 'NotWithinSet 'InPredicate 'WithSlices]
Text
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
name :: Text
terms :: [Term' 'NotWithinSet 'InPredicate 'WithSlices]
..} = do
[Term]
newTerms <- (Term' 'NotWithinSet 'InPredicate 'WithSlices
-> Validation (NonEmpty Text) Term)
-> [Term' 'NotWithinSet 'InPredicate 'WithSlices]
-> Validation (NonEmpty Text) [Term]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text Value
-> Term' 'NotWithinSet 'InPredicate 'WithSlices
-> Validation (NonEmpty Text) Term
substitutePTerm Map Text Value
termMapping) [Term' 'NotWithinSet 'InPredicate 'WithSlices]
terms
pure Predicate{ terms :: [Term]
terms = [Term]
newTerms, Text
name :: Text
name :: Text
.. }
substituteFact :: Map Text Value
-> Predicate' 'InFact 'WithSlices
-> Validation (NonEmpty Text) Fact
substituteFact :: Map Text Value
-> Predicate' 'InFact 'WithSlices
-> Validation (NonEmpty Text) Fact
substituteFact Map Text Value
termMapping Predicate{[Term' 'NotWithinSet 'InFact 'WithSlices]
Text
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
name :: Text
terms :: [Term' 'NotWithinSet 'InFact 'WithSlices]
..} = do
[Value]
newTerms <- (Term' 'NotWithinSet 'InFact 'WithSlices
-> Validation (NonEmpty Text) Value)
-> [Term' 'NotWithinSet 'InFact 'WithSlices]
-> Validation (NonEmpty Text) [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text Value
-> Term' 'NotWithinSet 'InFact 'WithSlices
-> Validation (NonEmpty Text) Value
substituteTerm Map Text Value
termMapping) [Term' 'NotWithinSet 'InFact 'WithSlices]
terms
pure Predicate{ terms :: [Value]
terms = [Value]
newTerms, Text
name :: Text
name :: Text
.. }
substitutePTerm :: Map Text Value
-> Term' 'NotWithinSet 'InPredicate 'WithSlices
-> Validation (NonEmpty Text) (Term' 'NotWithinSet 'InPredicate 'Representation)
substitutePTerm :: Map Text Value
-> Term' 'NotWithinSet 'InPredicate 'WithSlices
-> Validation (NonEmpty Text) Term
substitutePTerm Map Text Value
termMapping = \case
LInteger Int64
i -> Term -> Validation (NonEmpty Text) Term
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Validation (NonEmpty Text) Term)
-> Term -> Validation (NonEmpty Text) Term
forall a b. (a -> b) -> a -> b
$ Int64 -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Int64 -> Term' inSet pof ctx
LInteger Int64
i
LString Text
i -> Term -> Validation (NonEmpty Text) Term
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Validation (NonEmpty Text) Term)
-> Term -> Validation (NonEmpty Text) Term
forall a b. (a -> b) -> a -> b
$ Text -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString Text
i
LDate UTCTime
i -> Term -> Validation (NonEmpty Text) Term
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Validation (NonEmpty Text) Term)
-> Term -> Validation (NonEmpty Text) Term
forall a b. (a -> b) -> a -> b
$ UTCTime -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate UTCTime
i
LBytes ByteString
i -> Term -> Validation (NonEmpty Text) Term
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Validation (NonEmpty Text) Term)
-> Term -> Validation (NonEmpty Text) Term
forall a b. (a -> b) -> a -> b
$ ByteString -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes ByteString
i
LBool Bool
i -> Term -> Validation (NonEmpty Text) Term
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Validation (NonEmpty Text) Term)
-> Term -> Validation (NonEmpty Text) Term
forall a b. (a -> b) -> a -> b
$ Bool -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool Bool
i
TermSet SetType 'NotWithinSet 'WithSlices
i ->
Set (Term' 'WithinSet 'InFact 'Representation) -> Term
SetType 'NotWithinSet 'Representation -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
SetType inSet ctx -> Term' inSet pof ctx
TermSet (Set (Term' 'WithinSet 'InFact 'Representation) -> Term)
-> ([Term' 'WithinSet 'InFact 'Representation]
-> Set (Term' 'WithinSet 'InFact 'Representation))
-> [Term' 'WithinSet 'InFact 'Representation]
-> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Term' 'WithinSet 'InFact 'Representation]
-> Set (Term' 'WithinSet 'InFact 'Representation)
forall a. Ord a => [a] -> Set a
Set.fromList ([Term' 'WithinSet 'InFact 'Representation] -> Term)
-> Validation
(NonEmpty Text) [Term' 'WithinSet 'InFact 'Representation]
-> Validation (NonEmpty Text) Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term' 'WithinSet 'InFact 'WithSlices
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation))
-> [Term' 'WithinSet 'InFact 'WithSlices]
-> Validation
(NonEmpty Text) [Term' 'WithinSet 'InFact 'Representation]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text Value
-> Term' 'WithinSet 'InFact 'WithSlices
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
substituteSetTerm Map Text Value
termMapping) (Set (Term' 'WithinSet 'InFact 'WithSlices)
-> [Term' 'WithinSet 'InFact 'WithSlices]
forall a. Set a -> [a]
Set.toList Set (Term' 'WithinSet 'InFact 'WithSlices)
SetType 'NotWithinSet 'WithSlices
i)
Variable VariableType 'NotWithinSet 'InPredicate
i -> Term -> Validation (NonEmpty Text) Term
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Validation (NonEmpty Text) Term)
-> Term -> Validation (NonEmpty Text) Term
forall a b. (a -> b) -> a -> b
$ VariableType 'NotWithinSet 'InPredicate -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
VariableType inSet pof -> Term' inSet pof ctx
Variable VariableType 'NotWithinSet 'InPredicate
i
Antiquote (Slice Text
v) -> Validation (NonEmpty Text) Term
-> (Value -> Validation (NonEmpty Text) Term)
-> Maybe Value
-> Validation (NonEmpty Text) Term
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Validation (NonEmpty Text) Term
forall e a. e -> Validation (NonEmpty e) a
failure Text
v) (Term -> Validation (NonEmpty Text) Term
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Validation (NonEmpty Text) Term)
-> (Value -> Term) -> Value -> Validation (NonEmpty Text) Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Term
valueToTerm) (Maybe Value -> Validation (NonEmpty Text) Term)
-> Maybe Value -> Validation (NonEmpty Text) Term
forall a b. (a -> b) -> a -> b
$ Map Text Value
termMapping Map Text Value -> Text -> Maybe Value
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? Text
v
substituteTerm :: Map Text Value
-> Term' 'NotWithinSet 'InFact 'WithSlices
-> Validation (NonEmpty Text) Value
substituteTerm :: Map Text Value
-> Term' 'NotWithinSet 'InFact 'WithSlices
-> Validation (NonEmpty Text) Value
substituteTerm Map Text Value
termMapping = \case
LInteger Int64
i -> Value -> Validation (NonEmpty Text) Value
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Validation (NonEmpty Text) Value)
-> Value -> Validation (NonEmpty Text) Value
forall a b. (a -> b) -> a -> b
$ Int64 -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Int64 -> Term' inSet pof ctx
LInteger Int64
i
LString Text
i -> Value -> Validation (NonEmpty Text) Value
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Validation (NonEmpty Text) Value)
-> Value -> Validation (NonEmpty Text) Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString Text
i
LDate UTCTime
i -> Value -> Validation (NonEmpty Text) Value
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Validation (NonEmpty Text) Value)
-> Value -> Validation (NonEmpty Text) Value
forall a b. (a -> b) -> a -> b
$ UTCTime -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate UTCTime
i
LBytes ByteString
i -> Value -> Validation (NonEmpty Text) Value
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Validation (NonEmpty Text) Value)
-> Value -> Validation (NonEmpty Text) Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes ByteString
i
LBool Bool
i -> Value -> Validation (NonEmpty Text) Value
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Validation (NonEmpty Text) Value)
-> Value -> Validation (NonEmpty Text) Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool Bool
i
TermSet SetType 'NotWithinSet 'WithSlices
i ->
Set (Term' 'WithinSet 'InFact 'Representation) -> Value
SetType 'NotWithinSet 'Representation -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
SetType inSet ctx -> Term' inSet pof ctx
TermSet (Set (Term' 'WithinSet 'InFact 'Representation) -> Value)
-> ([Term' 'WithinSet 'InFact 'Representation]
-> Set (Term' 'WithinSet 'InFact 'Representation))
-> [Term' 'WithinSet 'InFact 'Representation]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Term' 'WithinSet 'InFact 'Representation]
-> Set (Term' 'WithinSet 'InFact 'Representation)
forall a. Ord a => [a] -> Set a
Set.fromList ([Term' 'WithinSet 'InFact 'Representation] -> Value)
-> Validation
(NonEmpty Text) [Term' 'WithinSet 'InFact 'Representation]
-> Validation (NonEmpty Text) Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term' 'WithinSet 'InFact 'WithSlices
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation))
-> [Term' 'WithinSet 'InFact 'WithSlices]
-> Validation
(NonEmpty Text) [Term' 'WithinSet 'InFact 'Representation]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map Text Value
-> Term' 'WithinSet 'InFact 'WithSlices
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
substituteSetTerm Map Text Value
termMapping) (Set (Term' 'WithinSet 'InFact 'WithSlices)
-> [Term' 'WithinSet 'InFact 'WithSlices]
forall a. Set a -> [a]
Set.toList Set (Term' 'WithinSet 'InFact 'WithSlices)
SetType 'NotWithinSet 'WithSlices
i)
Variable VariableType 'NotWithinSet 'InFact
v -> Void -> Validation (NonEmpty Text) Value
forall a. Void -> a
absurd Void
VariableType 'NotWithinSet 'InFact
v
Antiquote (Slice Text
v) -> Validation (NonEmpty Text) Value
-> (Value -> Validation (NonEmpty Text) Value)
-> Maybe Value
-> Validation (NonEmpty Text) Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Validation (NonEmpty Text) Value
forall e a. e -> Validation (NonEmpty e) a
failure Text
v) Value -> Validation (NonEmpty Text) Value
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> Validation (NonEmpty Text) Value)
-> Maybe Value -> Validation (NonEmpty Text) Value
forall a b. (a -> b) -> a -> b
$ Map Text Value
termMapping Map Text Value -> Text -> Maybe Value
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? Text
v
substituteSetTerm :: Map Text Value
-> Term' 'WithinSet 'InFact 'WithSlices
-> Validation (NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
substituteSetTerm :: Map Text Value
-> Term' 'WithinSet 'InFact 'WithSlices
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
substituteSetTerm Map Text Value
termMapping = \case
LInteger Int64
i -> Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation))
-> Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
forall a b. (a -> b) -> a -> b
$ Int64 -> Term' 'WithinSet 'InFact 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Int64 -> Term' inSet pof ctx
LInteger Int64
i
LString Text
i -> Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation))
-> Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
forall a b. (a -> b) -> a -> b
$ Text -> Term' 'WithinSet 'InFact 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString Text
i
LDate UTCTime
i -> Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation))
-> Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
forall a b. (a -> b) -> a -> b
$ UTCTime -> Term' 'WithinSet 'InFact 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate UTCTime
i
LBytes ByteString
i -> Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation))
-> Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
forall a b. (a -> b) -> a -> b
$ ByteString -> Term' 'WithinSet 'InFact 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes ByteString
i
LBool Bool
i -> Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation))
-> Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
forall a b. (a -> b) -> a -> b
$ Bool -> Term' 'WithinSet 'InFact 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool Bool
i
TermSet SetType 'WithinSet 'WithSlices
v -> Void
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
forall a. Void -> a
absurd Void
SetType 'WithinSet 'WithSlices
v
Variable VariableType 'WithinSet 'InFact
v -> Void
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
forall a. Void -> a
absurd Void
VariableType 'WithinSet 'InFact
v
Antiquote (Slice Text
v) ->
let setTerm :: Maybe (Term' 'WithinSet 'InFact 'Representation)
setTerm = Value -> Maybe (Term' 'WithinSet 'InFact 'Representation)
valueToSetTerm (Value -> Maybe (Term' 'WithinSet 'InFact 'Representation))
-> Maybe Value -> Maybe (Term' 'WithinSet 'InFact 'Representation)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Map Text Value
termMapping Map Text Value -> Text -> Maybe Value
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? Text
v
in Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
-> (Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation))
-> Maybe (Term' 'WithinSet 'InFact 'Representation)
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
forall e a. e -> Validation (NonEmpty e) a
failure Text
v) Term' 'WithinSet 'InFact 'Representation
-> Validation
(NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Term' 'WithinSet 'InFact 'Representation)
setTerm
substituteExpression :: Map Text Value
-> Expression' 'WithSlices
-> Validation (NonEmpty Text) Expression
substituteExpression :: Map Text Value
-> Expression' 'WithSlices -> Validation (NonEmpty Text) Expression
substituteExpression Map Text Value
termMapping = \case
EValue Term' 'NotWithinSet 'InPredicate 'WithSlices
v -> Term -> Expression
forall (ctx :: DatalogContext).
Term' 'NotWithinSet 'InPredicate ctx -> Expression' ctx
EValue (Term -> Expression)
-> Validation (NonEmpty Text) Term
-> Validation (NonEmpty Text) Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Value
-> Term' 'NotWithinSet 'InPredicate 'WithSlices
-> Validation (NonEmpty Text) Term
substitutePTerm Map Text Value
termMapping Term' 'NotWithinSet 'InPredicate 'WithSlices
v
EUnary Unary
op Expression' 'WithSlices
e -> Unary -> Expression -> Expression
forall (ctx :: DatalogContext).
Unary -> Expression' ctx -> Expression' ctx
EUnary Unary
op (Expression -> Expression)
-> Validation (NonEmpty Text) Expression
-> Validation (NonEmpty Text) Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Value
-> Expression' 'WithSlices -> Validation (NonEmpty Text) Expression
substituteExpression Map Text Value
termMapping Expression' 'WithSlices
e
EBinary Binary
op Expression' 'WithSlices
e Expression' 'WithSlices
e' -> Binary -> Expression -> Expression -> Expression
forall (ctx :: DatalogContext).
Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
EBinary Binary
op (Expression -> Expression -> Expression)
-> Validation (NonEmpty Text) Expression
-> Validation (NonEmpty Text) (Expression -> Expression)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Value
-> Expression' 'WithSlices -> Validation (NonEmpty Text) Expression
substituteExpression Map Text Value
termMapping Expression' 'WithSlices
e
Validation (NonEmpty Text) (Expression -> Expression)
-> Validation (NonEmpty Text) Expression
-> Validation (NonEmpty Text) Expression
forall a b.
Validation (NonEmpty Text) (a -> b)
-> Validation (NonEmpty Text) a -> Validation (NonEmpty Text) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Text Value
-> Expression' 'WithSlices -> Validation (NonEmpty Text) Expression
substituteExpression Map Text Value
termMapping Expression' 'WithSlices
e'
substituteScope :: Map Text PublicKey
-> RuleScope' 'Repr 'WithSlices
-> Validation (NonEmpty Text) RuleScope
substituteScope :: Map Text PublicKey
-> RuleScope' 'Repr 'WithSlices
-> Validation (NonEmpty Text) RuleScope
substituteScope Map Text PublicKey
keyMapping = \case
RuleScope' 'Repr 'WithSlices
OnlyAuthority -> RuleScope -> Validation (NonEmpty Text) RuleScope
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
OnlyAuthority
RuleScope' 'Repr 'WithSlices
Previous -> RuleScope -> Validation (NonEmpty Text) RuleScope
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
Previous
BlockId (Pk PublicKey
pk) -> RuleScope -> Validation (NonEmpty Text) RuleScope
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RuleScope -> Validation (NonEmpty Text) RuleScope)
-> RuleScope -> Validation (NonEmpty Text) RuleScope
forall a b. (a -> b) -> a -> b
$ BlockIdType 'Repr 'Representation -> RuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
BlockIdType evalCtx ctx -> RuleScope' evalCtx ctx
BlockId PublicKey
BlockIdType 'Repr 'Representation
pk
BlockId (PkSlice Text
n) -> Validation (NonEmpty Text) RuleScope
-> (PublicKey -> Validation (NonEmpty Text) RuleScope)
-> Maybe PublicKey
-> Validation (NonEmpty Text) RuleScope
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Validation (NonEmpty Text) RuleScope
forall e a. e -> Validation (NonEmpty e) a
failure Text
n) (RuleScope -> Validation (NonEmpty Text) RuleScope
forall a. a -> Validation (NonEmpty Text) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RuleScope -> Validation (NonEmpty Text) RuleScope)
-> (PublicKey -> RuleScope)
-> PublicKey
-> Validation (NonEmpty Text) RuleScope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> RuleScope
BlockIdType 'Repr 'Representation -> RuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
BlockIdType evalCtx ctx -> RuleScope' evalCtx ctx
BlockId) (Maybe PublicKey -> Validation (NonEmpty Text) RuleScope)
-> Maybe PublicKey -> Validation (NonEmpty Text) RuleScope
forall a b. (a -> b) -> a -> b
$ Map Text PublicKey
keyMapping Map Text PublicKey -> Text -> Maybe PublicKey
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? Text
n