{-# 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
  Copyright   : © Clément Delafargue, 2021
  License     : MIT
  Maintainer  : clement@delafargue.name
  The Datalog elements
-}
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
  -- ^ Intermediate Datalog representation, which may contain references
  -- to external variables (currently, only sliced in through TemplateHaskell,
  -- but it could also be done at runtime, a bit like parameter substitution in
  -- SQL queries)
  | Representation
  -- ^ A datalog representation faithful to its text display. There are no external
  -- variables, and the authorized blocks are identified through their public keys

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)

-- | A single datalog item.
-- | This can be a value, a set of items, or a slice (a value that will be injected later),
-- | depending on the context
data Term' (inSet :: IsWithinSet) (pof :: PredicateOrFact) (ctx :: DatalogContext) =
    Variable (VariableType inSet pof)
  -- ^ A variable (eg. @$0@)
  | LInteger Int64
  -- ^ An integer literal (eg. @42@)
  | LString Text
  -- ^ A string literal (eg. @"file1"@)
  | LDate UTCTime
  -- ^ A date literal (eg. @2021-05-26T18:00:00Z@)
  | LBytes ByteString
  -- ^ A hex literal (eg. @hex:ff9900@)
  | LBool Bool
  -- ^ A bool literal (eg. @true@)
  | Antiquote (SliceType ctx)
  -- ^ A slice (eg. @{name}@)
  | TermSet (SetType inSet ctx)
  -- ^ A set (eg. @[true, false]@)

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)

-- | In a regular AST, slices have already been eliminated
type Term = Term' 'NotWithinSet 'InPredicate 'Representation
-- | In an AST parsed from a WithSlicesr, there might be references to haskell variables
type QQTerm = Term' 'NotWithinSet 'InPredicate 'WithSlices
-- | A term that is not a variable
type Value = Term' 'NotWithinSet 'InFact 'Representation
-- | An element of a set
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

-- | This class describes how to turn a haskell value into a datalog value.
-- | This is used when slicing a haskell variable in a datalog expression
class ToTerm t inSet pof where
  -- | How to turn a value into a datalog item
  toTerm :: t -> Term' inSet pof 'Representation

-- | This class describes how to turn a datalog value into a regular haskell value.
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" -- query items are serialized as `Rule`s
                           -- so an empty rule head is added: `query()`
                           -- It means that query items implicitly depend on
                           -- the `query` symbol being defined.
  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
extractVariables :: forall (ctx :: DatalogContext).
[Predicate' 'InPredicate ctx] -> Set Text
extractVariables [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
extractExprVariables :: forall (ctx :: DatalogContext). Expression' ctx -> Set Text
extractExprVariables =
  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'

-- | A biscuit block, containing facts, rules and checks.
--
-- 'Block' has a 'Monoid' instance, which is the expected way
-- to build composite blocks (eg if you need to generate a list of facts):
--
-- > -- build a block from multiple variables v1, v2, v3
-- > [block| value({v1}); |] <>
-- > [block| value({v2}); |] <>
-- > [block| value({v3}); |]
type Block = Block' 'Repr 'Representation
type EvalBlock = Block' 'Eval 'Representation

-- | A biscuit block, that may or may not contain slices referencing
-- haskell variables
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
                   -- `trusting` declarations in blocks override
                   -- each other, they don't accumulate
                   , 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
  ]

-- | A biscuit authorizer, containing, facts, rules, checks and policies
type Authorizer = Authorizer' 'Repr 'Representation

-- | The context in which a biscuit policies and checks are verified.
-- A authorizer may add policies (`deny if` / `allow if` conditions), as well as rules, facts, and checks.
-- A authorizer may or may not contain slices referencing haskell variables.
data Authorizer' (evalCtx :: EvaluationContext) (ctx :: DatalogContext) = Authorizer
  { forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> [Policy' evalCtx ctx]
vPolicies :: [Policy' evalCtx ctx]
  -- ^ the allow / deny policies.
  , forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> Block' evalCtx ctx
vBlock    :: Block' evalCtx ctx
  -- ^ the facts, rules and checks
  }

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)
  | BlockComment

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