{-# 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.ByteString.Base16     as Hex
import           Data.Foldable              (fold, toList)
import           Data.Function              (on)
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)

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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Slice -> Slice -> Bool
$c/= :: Slice -> Slice -> Bool
== :: Slice -> Slice -> Bool
$c== :: Slice -> Slice -> Bool
Eq, Int -> Slice -> ShowS
[Slice] -> ShowS
Slice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Slice] -> ShowS
$cshowList :: [Slice] -> ShowS
show :: Slice -> String
$cshow :: Slice -> String
showsPrec :: Int -> Slice -> ShowS
$cshowsPrec :: Int -> Slice -> ShowS
Show, Eq 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
min :: Slice -> Slice -> Slice
$cmin :: Slice -> Slice -> Slice
max :: Slice -> Slice -> Slice
$cmax :: Slice -> Slice -> Slice
>= :: Slice -> Slice -> Bool
$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
compare :: Slice -> Slice -> Ordering
$ccompare :: Slice -> Slice -> Ordering
Ord, String -> Slice
forall a. (String -> a) -> IsString a
fromString :: String -> Slice
$cfromString :: String -> Slice
IsString)

instance Lift Slice where
  lift :: forall (m :: * -> *). Quote m => Slice -> m Exp
lift (Slice Text
name) = [| toTerm $(varE $ mkName $ unpack name) |]
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped :: forall (m :: * -> *). Quote m => Slice -> Code m Slice
liftTyped = forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkOrSlice -> PkOrSlice -> Bool
$c/= :: PkOrSlice -> PkOrSlice -> Bool
== :: PkOrSlice -> PkOrSlice -> Bool
$c== :: PkOrSlice -> PkOrSlice -> Bool
Eq, Int -> PkOrSlice -> ShowS
[PkOrSlice] -> ShowS
PkOrSlice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PkOrSlice] -> ShowS
$cshowList :: [PkOrSlice] -> ShowS
show :: PkOrSlice -> String
$cshow :: PkOrSlice -> String
showsPrec :: Int -> PkOrSlice -> ShowS
$cshowsPrec :: Int -> PkOrSlice -> ShowS
Show, Eq 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
min :: PkOrSlice -> PkOrSlice -> PkOrSlice
$cmin :: PkOrSlice -> PkOrSlice -> PkOrSlice
max :: PkOrSlice -> PkOrSlice -> PkOrSlice
$cmax :: PkOrSlice -> PkOrSlice -> PkOrSlice
>= :: PkOrSlice -> PkOrSlice -> Bool
$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
compare :: PkOrSlice -> PkOrSlice -> Ordering
$ccompare :: PkOrSlice -> PkOrSlice -> Ordering
Ord)

instance Lift PkOrSlice where
  lift :: forall (m :: * -> *). Quote m => PkOrSlice -> m Exp
lift (PkSlice Text
name) = [| $(varE $ mkName $ unpack name) |]
  lift (Pk PublicKey
pk)        = [| pk |]
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped :: forall (m :: * -> *). Quote m => PkOrSlice -> Code m PkOrSlice
liftTyped = forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> 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 Int
  -- ^ 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 Int
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 $(lift $ show 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 = forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> 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 = forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Int -> Term' inSet pof ctx
LInteger

instance FromValue Int where
  fromValue :: Value -> Maybe Int
fromValue (LInteger Int
v) = forall a. a -> Maybe a
Just Int
v
  fromValue Value
_            = forall a. Maybe a
Nothing

instance ToTerm Integer inSet pof where
  toTerm :: Integer -> Term' inSet pof 'Representation
toTerm = forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Int -> Term' inSet pof ctx
LInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance FromValue Integer where
  fromValue :: Value -> Maybe Integer
fromValue (LInteger Int
v) = forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v)
  fromValue Value
_            = forall a. Maybe a
Nothing

instance ToTerm Text inSet pof where
  toTerm :: Text -> Term' inSet pof 'Representation
toTerm = 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) = forall a. a -> Maybe a
Just Text
t
  fromValue Value
_           = forall a. Maybe a
Nothing

instance ToTerm Bool inSet pof where
  toTerm :: Bool -> Term' inSet pof 'Representation
toTerm = 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) = forall a. a -> Maybe a
Just Bool
b
  fromValue Value
_         = forall a. Maybe a
Nothing

instance ToTerm ByteString inSet pof where
  toTerm :: ByteString -> Term' inSet pof 'Representation
toTerm = 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) = forall a. a -> Maybe a
Just ByteString
bs
  fromValue Value
_           = forall a. Maybe a
Nothing

instance ToTerm UTCTime inSet pof where
  toTerm :: UTCTime -> Term' inSet pof 'Representation
toTerm = 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) = forall a. a -> Maybe a
Just UTCTime
t
  fromValue Value
_         = 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 = forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
SetType inSet ctx -> Term' inSet pof ctx
TermSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall t (inSet :: IsWithinSet) (pof :: PredicateOrFact).
ToTerm t inSet pof =>
t -> Term' inSet pof 'Representation
toTerm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
vs

instance FromValue Value where
  fromValue :: Value -> Maybe Value
fromValue = forall a. a -> Maybe a
Just

valueToSetTerm :: Value
               -> Maybe (Term' 'WithinSet 'InFact 'Representation)
valueToSetTerm :: Value -> Maybe (Term' 'WithinSet 'InFact 'Representation)
valueToSetTerm = \case
  LInteger Int
i  -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Int -> Term' inSet pof ctx
LInteger Int
i
  LString Text
i   -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString Text
i
  LDate UTCTime
i     -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate UTCTime
i
  LBytes ByteString
i    -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes ByteString
i
  LBool Bool
i     -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool Bool
i
  TermSet SetType 'NotWithinSet 'Representation
_   -> forall a. Maybe a
Nothing
  Variable VariableType 'NotWithinSet 'InFact
v  -> forall a. Void -> a
absurd VariableType 'NotWithinSet 'InFact
v
  Antiquote SliceType 'Representation
v -> forall a. Void -> a
absurd SliceType 'Representation
v

valueToTerm :: Value -> Term
valueToTerm :: Value -> Term
valueToTerm = \case
  LInteger Int
i  -> forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Int -> Term' inSet pof ctx
LInteger Int
i
  LString Text
i   -> forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString Text
i
  LDate UTCTime
i     -> forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate UTCTime
i
  LBytes ByteString
i    -> forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes ByteString
i
  LBool Bool
i     -> forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool Bool
i
  TermSet SetType 'NotWithinSet 'Representation
i   -> forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
SetType inSet ctx -> Term' inSet pof ctx
TermSet SetType 'NotWithinSet 'Representation
i
  Variable VariableType 'NotWithinSet 'InFact
v  -> forall a. Void -> a
absurd VariableType 'NotWithinSet 'InFact
v
  Antiquote SliceType 'Representation
v -> forall a. Void -> a
absurd 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 Int
int  -> String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
int
  LString Text
str   -> String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Text
str
  LDate UTCTime
time    -> String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%FT%T%Q%Ez" UTCTime
time
  LBytes ByteString
bs     -> Text
"hex:" forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
Hex.encodeBase16 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
"[" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate 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' forall a. Void -> a
absurd forall a. Void -> a
absurd SliceType ctx -> Text
slice forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
Set.toList Set (Term' 'WithinSet 'InFact ctx)
terms) forall a. Semigroup a => a -> a -> a
<> Text
"]"

renderId :: Term -> Text
renderId :: Term -> 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' (Text
"$" forall a. Semigroup a => a -> a -> a
<>) (forall (ctx :: DatalogContext).
(SliceType ctx -> Text)
-> Set (Term' 'WithinSet 'InFact ctx) -> Text
renderSet forall a. Void -> a
absurd) forall a. Void -> a
absurd

renderFactId :: Term' 'NotWithinSet 'InFact 'Representation -> Text
renderFactId :: Value -> Text
renderFactId = forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
(VariableType inSet pof -> Text)
-> (SetType inSet ctx -> Text)
-> (SliceType ctx -> Text)
-> Term' inSet pof ctx
-> Text
renderId' forall a. Void -> a
absurd (forall (ctx :: DatalogContext).
(SliceType ctx -> Text)
-> Set (Term' 'WithinSet 'InFact ctx) -> Text
renderSet forall a. Void -> a
absurd) forall a. Void -> a
absurd

listSymbolsInTerm :: Term -> Set.Set Text
listSymbolsInTerm :: Term -> Set Text
listSymbolsInTerm = \case
  LString  Text
v    -> forall a. a -> Set a
Set.singleton Text
v
  Variable VariableType 'NotWithinSet 'InPredicate
name -> forall a. a -> Set a
Set.singleton VariableType 'NotWithinSet 'InPredicate
name
  TermSet SetType 'NotWithinSet 'Representation
terms -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' 'WithinSet 'InFact 'Representation -> Set Text
listSymbolsInSetValue SetType 'NotWithinSet 'Representation
terms
  Antiquote SliceType 'Representation
v   -> forall a. Void -> a
absurd SliceType 'Representation
v
  Term
_             -> forall a. Monoid a => a
mempty

listSymbolsInValue :: Value -> Set.Set Text
listSymbolsInValue :: Value -> Set Text
listSymbolsInValue = \case
  LString  Text
v    -> forall a. a -> Set a
Set.singleton Text
v
  TermSet SetType 'NotWithinSet 'Representation
terms -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' 'WithinSet 'InFact 'Representation -> Set Text
listSymbolsInSetValue SetType 'NotWithinSet 'Representation
terms
  Variable  VariableType 'NotWithinSet 'InFact
v   -> forall a. Void -> a
absurd VariableType 'NotWithinSet 'InFact
v
  Antiquote SliceType 'Representation
v   -> forall a. Void -> a
absurd SliceType 'Representation
v
  Value
_             -> forall a. Monoid a => a
mempty

listSymbolsInSetValue :: SetValue -> Set.Set Text
listSymbolsInSetValue :: Term' 'WithinSet 'InFact 'Representation -> Set Text
listSymbolsInSetValue = \case
  LString  Text
v  -> forall a. a -> Set a
Set.singleton Text
v
  TermSet   SetType 'WithinSet 'Representation
v -> forall a. Void -> a
absurd SetType 'WithinSet 'Representation
v
  Variable  VariableType 'WithinSet 'InFact
v -> forall a. Void -> a
absurd VariableType 'WithinSet 'InFact
v
  Antiquote SliceType 'Representation
v -> forall a. Void -> a
absurd SliceType 'Representation
v
  Term' 'WithinSet 'InFact 'Representation
_           -> 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 :: Text
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
name,[Term]
terms :: [Term]
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
terms} =
  Text
name forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term -> Text
renderId [Term]
terms) forall a. Semigroup a => a -> a -> a
<> Text
")"

renderFact :: Fact -> Text
renderFact :: Fact -> Text
renderFact Predicate{Text
name :: Text
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
name,[Value]
terms :: [Value]
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
terms} =
  Text
name forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Text
renderFactId [Value]
terms) forall a. Semigroup a => a -> a -> a
<> Text
")"

listSymbolsInFact :: Fact -> Set.Set Text
listSymbolsInFact :: Fact -> Set Text
listSymbolsInFact Predicate{[Value]
Text
terms :: [Value]
name :: Text
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
..} =
     forall a. a -> Set a
Set.singleton Text
name
  forall a. Semigroup a => a -> a -> a
<> 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
terms :: [Term]
name :: Text
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
..} =
     forall a. a -> Set a
Set.singleton Text
name
  forall a. Semigroup a => a -> a -> a
<> 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Set a -> Bool
Set.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
qScope)

queryHasNoV4Operators :: Query -> Bool
queryHasNoV4Operators :: Query -> Bool
queryHasNoV4Operators =
  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Expression -> Bool
expressionHasNoV4Operators forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (ctx :: DatalogContext).
[Predicate' 'InPredicate ctx] -> Set Text
extractVariables [Predicate' 'InPredicate ctx]
qBody
      exprVariables :: Set Text
exprVariables = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall (ctx :: DatalogContext). Expression' ctx -> Set Text
extractExprVariables [Expression' ctx]
qExpressions
      unboundVariables :: Set Text
unboundVariables = Set Text
exprVariables forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Text
boundVariables
   in case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (forall a. Set a -> [a]
Set.toList Set Text
unboundVariables) of
        Maybe (NonEmpty Text)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryItem{[Expression' ctx]
[Predicate' 'InPredicate ctx]
Set (RuleScope' 'Repr ctx)
qScope :: Set (RuleScope' 'Repr ctx)
qExpressions :: [Expression' ctx]
qBody :: [Predicate' 'InPredicate ctx]
qScope :: Set (RuleScope' 'Repr ctx)
qExpressions :: [Expression' ctx]
qBody :: [Predicate' 'InPredicate ctx]
..}
        Just NonEmpty Text
vs -> forall e a. e -> Validation e a
Failure NonEmpty Text
vs


data CheckKind = One | All
  deriving (CheckKind -> CheckKind -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckKind -> CheckKind -> Bool
$c/= :: CheckKind -> CheckKind -> Bool
== :: CheckKind -> CheckKind -> Bool
$c== :: CheckKind -> CheckKind -> Bool
Eq, Int -> CheckKind -> ShowS
[CheckKind] -> ShowS
CheckKind -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckKind] -> ShowS
$cshowList :: [CheckKind] -> ShowS
show :: CheckKind -> String
$cshow :: CheckKind -> String
showsPrec :: Int -> CheckKind -> ShowS
$cshowsPrec :: Int -> CheckKind -> ShowS
Show, Eq 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
min :: CheckKind -> CheckKind -> CheckKind
$cmin :: CheckKind -> CheckKind -> CheckKind
max :: CheckKind -> CheckKind -> CheckKind
$cmax :: CheckKind -> CheckKind -> CheckKind
>= :: CheckKind -> CheckKind -> Bool
$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
compare :: CheckKind -> CheckKind -> Ordering
$ccompare :: CheckKind -> CheckKind -> Ordering
Ord, 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
liftTyped :: forall (m :: * -> *). Quote m => CheckKind -> Code m CheckKind
$cliftTyped :: forall (m :: * -> *). Quote m => CheckKind -> Code m CheckKind
lift :: forall (m :: * -> *). Quote m => CheckKind -> m Exp
$clift :: forall (m :: * -> *). Quote m => CheckKind -> m Exp
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 :: CheckKind
cKind :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> CheckKind
cKind} = CheckKind
cKind forall a. Eq a => a -> a -> Bool
== CheckKind
One

data PolicyType = Allow | Deny
  deriving (PolicyType -> PolicyType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolicyType -> PolicyType -> Bool
$c/= :: PolicyType -> PolicyType -> Bool
== :: PolicyType -> PolicyType -> Bool
$c== :: PolicyType -> PolicyType -> Bool
Eq, Int -> PolicyType -> ShowS
[PolicyType] -> ShowS
PolicyType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PolicyType] -> ShowS
$cshowList :: [PolicyType] -> ShowS
show :: PolicyType -> String
$cshow :: PolicyType -> String
showsPrec :: Int -> PolicyType -> ShowS
$cshowsPrec :: Int -> PolicyType -> ShowS
Show, Eq 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
min :: PolicyType -> PolicyType -> PolicyType
$cmin :: PolicyType -> PolicyType -> PolicyType
max :: PolicyType -> PolicyType -> PolicyType
$cmax :: PolicyType -> PolicyType -> PolicyType
>= :: PolicyType -> PolicyType -> Bool
$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
compare :: PolicyType -> PolicyType -> Ordering
$ccompare :: PolicyType -> PolicyType -> Ordering
Ord, 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
liftTyped :: forall (m :: * -> *). Quote m => PolicyType -> Code m PolicyType
$cliftTyped :: forall (m :: * -> *). Quote m => PolicyType -> Code m PolicyType
lift :: forall (m :: * -> *). Quote m => PolicyType -> m Exp
$clift :: forall (m :: * -> *). Quote m => PolicyType -> m Exp
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 forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
" or \n" (QueryItem' 'Repr 'Representation -> Text
renderQueryItem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query
query) forall a. Semigroup a => a -> a -> a
<> Text
";"

renderQueryItem :: QueryItem' 'Repr 'Representation -> Text
renderQueryItem :: QueryItem' 'Repr 'Representation -> Text
renderQueryItem QueryItem{[Expression]
[Predicate]
Set RuleScope
qScope :: Set RuleScope
qExpressions :: [Expression]
qBody :: [Predicate]
qScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
qExpressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Expression' ctx]
qBody :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Predicate' 'InPredicate ctx]
..} =
  Text -> [Text] -> Text
intercalate Text
",\n" (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ Predicate -> Text
renderPredicate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Predicate]
qBody
    , Expression -> Text
renderExpression forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expression]
qExpressions
    ])
  forall a. Semigroup a => a -> a -> a
<> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set RuleScope
qScope then Text
""
                   else Text
" trusting " forall a. Semigroup a => a -> a -> a
<> Set RuleScope -> Text
renderRuleScope Set RuleScope
qScope

renderCheck :: Check -> Text
renderCheck :: Check -> Text
renderCheck Check{Query
CheckKind
cKind :: CheckKind
cQueries :: Query
cKind :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> CheckKind
cQueries :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
..} =
  let kindToken :: Text
kindToken = case CheckKind
cKind of
        CheckKind
One -> Text
"if"
        CheckKind
All -> Text
"all"
   in Text
"check " forall a. Semigroup a => a -> a -> a
<> Text
kindToken forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<>
      Text -> [Text] -> Text
intercalate Text
"\n or " (QueryItem' 'Repr 'Representation -> Text
renderQueryItem 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)
qScope :: Set (RuleScope' evalCtx 'Representation)
qExpressions :: [Expression]
qBody :: [Predicate]
qScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
qExpressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Expression' ctx]
qBody :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Predicate' 'InPredicate ctx]
..} =
     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.
  forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Predicate -> Set Text
listSymbolsInPredicate [Predicate]
qBody
  forall a. Semigroup a => a -> a -> a
<> 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 =
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall (evalCtx :: EvaluationContext).
QueryItem' evalCtx 'Representation -> Set Text
listSymbolsInQueryItem forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: Set RuleScope
qScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
qScope} =
  Set RuleScope -> Set PublicKey
listPublicKeysInScope Set RuleScope
qScope

listPublicKeysInCheck :: Check -> Set.Set PublicKey
listPublicKeysInCheck :: Check -> Set PublicKey
listPublicKeysInCheck = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap QueryItem' 'Repr 'Representation -> Set PublicKey
listPublicKeysInQueryItem forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a b. (a -> b) -> a -> b
$
  \case BlockId BlockIdType 'Repr 'Representation
pk -> forall a. a -> Set a
Set.singleton BlockIdType 'Repr 'Representation
pk
        RuleScope
_          -> 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 :: Set RuleScope
scope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
scope} = 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
_ 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 :: [Expression]
expressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Expression' ctx]
expressions} =
  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 :: Predicate
rhead :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Predicate' 'InPredicate ctx
rhead,[Predicate]
body :: [Predicate]
body :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Predicate' 'InPredicate ctx]
body,[Expression]
expressions :: [Expression]
expressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Expression' ctx]
expressions,Set RuleScope
scope :: Set RuleScope
scope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
scope} =
     Predicate -> Text
renderPredicate Predicate
rhead forall a. Semigroup a => a -> a -> a
<> Text
" <- "
  forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Predicate -> Text
renderPredicate [Predicate]
body forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expression -> Text
renderExpression [Expression]
expressions)
  forall a. Semigroup a => a -> a -> a
<> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set RuleScope
scope then Text
""
                   else Text
" trusting " 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
scope :: Set RuleScope
expressions :: [Expression]
body :: [Predicate]
rhead :: Predicate
scope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
expressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Expression' ctx]
body :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Predicate' 'InPredicate ctx]
rhead :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Predicate' 'InPredicate ctx
..} =
     Predicate -> Set Text
listSymbolsInPredicate Predicate
rhead
  forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Predicate -> Set Text
listSymbolsInPredicate [Predicate]
body
  forall a. Semigroup a => a -> a -> a
<> 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 :: Set RuleScope
scope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
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 -> forall a. a -> Maybe a
Just VariableType inSet pof
name
        Term' inSet pof ctx
_             -> forall a. Maybe a
Nothing
      extractVariables' :: Predicate' pof ctx -> [VariableType 'NotWithinSet pof]
extractVariables' Predicate{[Term' 'NotWithinSet pof ctx]
terms :: [Term' 'NotWithinSet pof ctx]
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
terms} = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {inSet :: IsWithinSet} {pof :: PredicateOrFact}
       {ctx :: DatalogContext}.
Term' inSet pof ctx -> Maybe (VariableType inSet pof)
keepVariable [Term' 'NotWithinSet pof ctx]
terms
   in forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall {pof :: PredicateOrFact} {ctx :: DatalogContext}.
Predicate' pof ctx -> [VariableType 'NotWithinSet pof]
extractVariables' 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 -> forall a. a -> Set a
Set.singleton VariableType inSet pof
name
        Term' inSet pof ctx
_             -> forall a. Set a
Set.empty
   in \case
        EValue Term' 'NotWithinSet 'InPredicate ctx
t       -> 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     -> forall (ctx :: DatalogContext). Expression' ctx -> Set Text
extractExprVariables Expression' ctx
e
        EBinary Binary
_ Expression' ctx
e Expression' ctx
e' -> (forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` 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 = forall (ctx :: DatalogContext).
[Predicate' 'InPredicate ctx] -> Set Text
extractVariables [Predicate' 'InPredicate ctx]
body
      exprVariables :: Set Text
exprVariables = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall (ctx :: DatalogContext). Expression' ctx -> Set Text
extractExprVariables [Expression' ctx]
expressions
      headVariables :: Set Text
headVariables = forall (ctx :: DatalogContext).
[Predicate' 'InPredicate ctx] -> Set Text
extractVariables [Predicate' 'InPredicate ctx
rhead]
      unboundVariables :: Set Text
unboundVariables = (Set Text
headVariables forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Text
exprVariables) forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Text
boundVariables
   in case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (forall a. Set a -> [a]
Set.toList Set Text
unboundVariables) of
        Maybe (NonEmpty Text)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Rule{[Expression' ctx]
[Predicate' 'InPredicate ctx]
Set (RuleScope' 'Repr ctx)
Predicate' 'InPredicate ctx
scope :: Set (RuleScope' 'Repr ctx)
expressions :: [Expression' ctx]
body :: [Predicate' 'InPredicate ctx]
rhead :: Predicate' 'InPredicate ctx
scope :: Set (RuleScope' 'Repr ctx)
expressions :: [Expression' ctx]
body :: [Predicate' 'InPredicate ctx]
rhead :: Predicate' 'InPredicate ctx
..}
        Just NonEmpty Text
vs -> forall e a. e -> Validation e a
Failure NonEmpty Text
vs

data Unary =
    Negate
  | Parens
  | Length
  deriving (Unary -> Unary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unary -> Unary -> Bool
$c/= :: Unary -> Unary -> Bool
== :: Unary -> Unary -> Bool
$c== :: Unary -> Unary -> Bool
Eq, Eq 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
min :: Unary -> Unary -> Unary
$cmin :: Unary -> Unary -> Unary
max :: Unary -> Unary -> Unary
$cmax :: Unary -> Unary -> Unary
>= :: Unary -> Unary -> Bool
$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
compare :: Unary -> Unary -> Ordering
$ccompare :: Unary -> Unary -> Ordering
Ord, Int -> Unary -> ShowS
[Unary] -> ShowS
Unary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unary] -> ShowS
$cshowList :: [Unary] -> ShowS
show :: Unary -> String
$cshow :: Unary -> String
showsPrec :: Int -> Unary -> ShowS
$cshowsPrec :: Int -> Unary -> ShowS
Show, 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
liftTyped :: forall (m :: * -> *). Quote m => Unary -> Code m Unary
$cliftTyped :: forall (m :: * -> *). Quote m => Unary -> Code m Unary
lift :: forall (m :: * -> *). Quote m => Unary -> m Exp
$clift :: forall (m :: * -> *). Quote m => Unary -> m Exp
Lift)

data Binary =
    LessThan
  | GreaterThan
  | LessOrEqual
  | GreaterOrEqual
  | Equal
  | Contains
  | Prefix
  | Suffix
  | Regex
  | Add
  | Sub
  | Mul
  | Div
  | And
  | Or
  | Intersection
  | Union
  | BitwiseAnd
  | BitwiseOr
  | BitwiseXor
  deriving (Binary -> Binary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Binary -> Binary -> Bool
$c/= :: Binary -> Binary -> Bool
== :: Binary -> Binary -> Bool
$c== :: Binary -> Binary -> Bool
Eq, Eq 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
min :: Binary -> Binary -> Binary
$cmin :: Binary -> Binary -> Binary
max :: Binary -> Binary -> Binary
$cmax :: Binary -> Binary -> Binary
>= :: Binary -> Binary -> Bool
$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
compare :: Binary -> Binary -> Ordering
$ccompare :: Binary -> Binary -> Ordering
Ord, Int -> Binary -> ShowS
[Binary] -> ShowS
Binary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Binary] -> ShowS
$cshowList :: [Binary] -> ShowS
show :: Binary -> String
$cshow :: Binary -> String
showsPrec :: Int -> Binary -> ShowS
$cshowsPrec :: Int -> Binary -> ShowS
Show, 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
liftTyped :: forall (m :: * -> *). Quote m => Binary -> Code m Binary
$cliftTyped :: forall (m :: * -> *). Quote m => Binary -> Code m Binary
lift :: forall (m :: * -> *). Quote m => Binary -> m Exp
$clift :: forall (m :: * -> *). Quote m => Binary -> m Exp
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' -> 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 []                    = forall a b. b -> Either a b
Right [Expression]
stack
      go [Expression]
stack        (VOp Term
t : [Op]
rest) = [Expression] -> [Op] -> Either a [Expression]
go (forall (ctx :: DatalogContext).
Term' 'NotWithinSet 'InPredicate ctx -> Expression' ctx
EValue Term
t 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 (forall (ctx :: DatalogContext).
Unary -> Expression' ctx -> Expression' ctx
EUnary Unary
o Expression
e forall a. a -> [a] -> [a]
: [Expression]
stack) [Op]
rest
      go []           (UOp Unary
_ : [Op]
_)    = 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 (forall (ctx :: DatalogContext).
Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
EBinary Binary
o Expression
e' Expression
e forall a. a -> [a] -> [a]
: [Expression]
stack) [Op]
rest
      go [Expression
_]          (BOp Binary
_ : [Op]
_)    = forall a b. a -> Either a b
Left a
"Unary stack on binary op"
      go []           (BOp Binary
_ : [Op]
_)    = forall a b. a -> Either a b
Left a
"Empty stack on binary op"
      final :: [b] -> Either a b
final []  = forall a b. a -> Either a b
Left a
"Empty stack"
      final [b
x] = forall a b. b -> Either a b
Right b
x
      final [b]
_   = forall a b. a -> Either a b
Left a
"Stack containing more than one element"
   in forall {a} {b}. IsString a => [b] -> Either a b
final forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< 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 forall a. a -> [a] -> [a]
: [Op]
s
        EUnary Unary
o Expression
i    -> Expression -> [Op] -> [Op]
go Expression
i forall a b. (a -> b) -> a -> b
$ Unary -> Op
UOp Unary
o forall a. a -> [a] -> [a]
: [Op]
s
        EBinary Binary
o Expression
l Expression
r -> Expression -> [Op] -> [Op]
go Expression
l forall a b. (a -> b) -> a -> b
$ Expression -> [Op] -> [Op]
go Expression
r forall a b. (a -> b) -> a -> b
$ Binary -> Op
BOp Binary
o 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
                forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> 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
               forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
m forall a. Semigroup a => a -> a -> a
<> Text
"("
               forall a. Semigroup a => a -> a -> a
<> Expression -> Text
renderExpression Expression
e'
               forall a. Semigroup a => a -> a -> a
<> Text
")"
   in \case
        EValue Term
t                    -> Term -> Text
renderId Term
t
        EUnary Unary
Negate Expression
e             -> Text
"!" forall a. Semigroup a => a -> a -> a
<> Expression -> Text
renderExpression Expression
e
        EUnary Unary
Parens Expression
e             -> Text
"(" forall a. Semigroup a => a -> a -> a
<> Expression -> Text
renderExpression Expression
e forall a. Semigroup a => a -> a -> a
<> Text
")"
        EUnary Unary
Length Expression
e             -> Expression -> Text
renderExpression Expression
e 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'

-- | 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 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 = forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
bRules Block' evalCtx ctx
b1 forall a. Semigroup a => a -> a -> a
<> forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
bRules Block' evalCtx ctx
b2
                   , bFacts :: [Predicate' 'InFact ctx]
bFacts = forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Predicate' 'InFact ctx]
bFacts Block' evalCtx ctx
b1 forall a. Semigroup a => a -> a -> a
<> forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Predicate' 'InFact ctx]
bFacts Block' evalCtx ctx
b2
                   , bChecks :: [Check' evalCtx ctx]
bChecks = forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bChecks Block' evalCtx ctx
b1 forall a. Semigroup a => a -> a -> a
<> forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bChecks Block' evalCtx ctx
b2
                   , bContext :: Maybe Text
bContext = forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Maybe Text
bContext Block' evalCtx ctx
b2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bScope Block' evalCtx ctx
b1)
                              then forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bScope Block' evalCtx ctx
b2
                              else 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 = forall a. Maybe a
Nothing
                 , bScope :: Set (RuleScope' evalCtx ctx)
bScope = 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/" forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
Hex.encodeBase16 (PublicKey -> ByteString
pkBytes BlockIdType 'Repr 'Representation
bs)
   in Text -> [Text] -> Text
intercalate Text
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
bScope :: Set RuleScope
bContext :: Maybe Text
bChecks :: [Check]
bFacts :: [Fact]
bRules :: [Rule]
bScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bContext :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Maybe Text
bChecks :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bFacts :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Predicate' 'InFact ctx]
bRules :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
..} =
  let renderScopeLine :: Set RuleScope -> Text
renderScopeLine = (Text
"trusting " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set RuleScope -> Text
renderRuleScope
   in forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. Semigroup a => a -> a -> a
<> Text
";\n") forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
         [ [Set RuleScope -> Text
renderScopeLine Set RuleScope
bScope | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set RuleScope
bScope)]
         , Rule -> Text
renderRule forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rule]
bRules
         , Fact -> Text
renderFact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Fact]
bFacts
         , Check -> Text
renderCheck 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
bScope :: Set RuleScope
bContext :: Maybe Text
bChecks :: [Check]
bFacts :: [Fact]
bRules :: [Rule]
bScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bContext :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Maybe Text
bChecks :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bFacts :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Predicate' 'InFact ctx]
bRules :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
..} = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
  [ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Rule -> Set Text
listSymbolsInRule [Rule]
bRules
  , forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Fact -> Set Text
listSymbolsInFact [Fact]
bFacts
  , 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
bScope :: Set RuleScope
bContext :: Maybe Text
bChecks :: [Check]
bFacts :: [Fact]
bRules :: [Rule]
bScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bContext :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Maybe Text
bChecks :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bFacts :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Predicate' 'InFact ctx]
bRules :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
..} = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
  [ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Rule -> Set PublicKey
listPublicKeysInRule [Rule]
bRules
  , 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 = forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> [Policy' evalCtx ctx]
vPolicies Authorizer' evalCtx ctx
v1 forall a. Semigroup a => a -> a -> a
<> forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> [Policy' evalCtx ctx]
vPolicies Authorizer' evalCtx ctx
v2
                      , vBlock :: Block' evalCtx ctx
vBlock = forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> Block' evalCtx ctx
vBlock Authorizer' evalCtx ctx
v1 forall a. Semigroup a => a -> a -> a
<> 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 = 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
vBlock :: Block
vPolicies :: [Policy]
vBlock :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> Block' evalCtx ctx
vPolicies :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> [Policy' evalCtx ctx]
..} =
  Block -> Text
renderBlock Block
vBlock forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<>
  Text -> [Text] -> Text
intercalate Text
"\n" (Policy -> Text
renderPolicy 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  -> 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] [] [] forall a. Maybe a
Nothing forall a. Set a
Set.empty
   BlockFact Predicate' 'InFact ctx
f  -> 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] [] forall a. Maybe a
Nothing forall a. Set a
Set.empty
   BlockCheck Check' evalCtx ctx
c -> 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] forall a. Maybe a
Nothing forall a. Set a
Set.empty
   BlockElement' evalCtx ctx
BlockComment -> 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 -> forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
[Policy' evalCtx ctx]
-> Block' evalCtx ctx -> Authorizer' evalCtx ctx
Authorizer [Policy' evalCtx ctx
p] forall a. Monoid a => a
mempty
  BlockElement BlockElement' evalCtx ctx
be    -> forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
[Policy' evalCtx ctx]
-> Block' evalCtx ctx -> Authorizer' evalCtx ctx
Authorizer [] (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, forall a. a -> Set a
Set.singleton a
bId)]
            makeEntry (Maybe a, a)
_               = []
         in forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {a} {a}. (Maybe a, a) -> [(a, Set a)]
makeEntry forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe PublicKey]
ePks [Natural
0..]
      translateElem :: RuleScope -> EvalRuleScope
translateElem = \case
        RuleScope
Previous      -> forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
Previous
        RuleScope
OnlyAuthority -> forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
OnlyAuthority
        BlockId BlockIdType 'Repr 'Representation
bPk   -> forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
BlockIdType evalCtx ctx -> RuleScope' evalCtx ctx
BlockId (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup BlockIdType 'Repr 'Representation
bPk Map PublicKey (Set Natural)
indexedPks, BlockIdType 'Repr 'Representation
bPk)
   in 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         -> forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
Previous
        EvalRuleScope
OnlyAuthority    -> forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
OnlyAuthority
        BlockId (Set Natural
_, BlockIdType 'Repr 'Representation
ePk) -> forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
BlockIdType evalCtx ctx -> RuleScope' evalCtx ctx
BlockId BlockIdType 'Repr 'Representation
ePk
   in 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
[Maybe PublicKey]
-> elem 'Repr 'Representation -> elem 'Eval 'Representation
toEvaluation [Maybe PublicKey]
ePks) (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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
elem 'Eval 'Representation -> elem 'Repr 'Representation
toRepresentation (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 forall a b. (a -> b) -> a -> b
$ forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bScope Block
b
    , bRules :: [Rule' 'Eval 'Representation]
bRules = forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
[Maybe PublicKey]
-> elem 'Repr 'Representation -> elem 'Eval 'Representation
toEvaluation [Maybe PublicKey]
ePks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a b. (a -> b) -> a -> b
$ forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bScope Block' 'Eval 'Representation
b
    , bRules :: [Rule]
bRules = forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
elem 'Eval 'Representation -> elem 'Repr 'Representation
toRepresentation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
bRules Block' 'Eval 'Representation
b
    , bChecks :: [Check]
bChecks = forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
elem 'Eval 'Representation -> elem 'Repr 'Representation
toRepresentation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
[Maybe PublicKey]
-> elem 'Repr 'Representation -> elem 'Eval 'Representation
toEvaluation [Maybe PublicKey]
ePks (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
elem 'Eval 'Representation -> elem 'Repr 'Representation
toRepresentation (forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> Block' evalCtx ctx
vBlock Authorizer' 'Eval 'Representation
a)
    , vPolicies :: [Policy]
vPolicies = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
elem 'Eval 'Representation -> elem 'Repr 'Representation
toRepresentation) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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
vBlock :: Block' 'Repr 'WithSlices
vPolicies :: [Policy' 'Repr 'WithSlices]
vBlock :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> Block' evalCtx ctx
vPolicies :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> [Policy' evalCtx ctx]
..} = do
  [Policy]
newPolicies <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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)
bScope :: Set (RuleScope' 'Repr 'WithSlices)
bContext :: Maybe Text
bChecks :: [Check' 'Repr 'WithSlices]
bFacts :: [Predicate' 'InFact 'WithSlices]
bRules :: [Rule' 'Repr 'WithSlices]
bScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bContext :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Maybe Text
bChecks :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bFacts :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Predicate' 'InFact ctx]
bRules :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
..} = do
  [Rule]
newRules <-  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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 <-  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Map Text Value
-> Predicate' 'InFact 'WithSlices
-> Validation (NonEmpty Text) Fact
substituteFact Map Text Value
termMapping) [Predicate' 'InFact 'WithSlices]
bFacts
  [Check]
newChecks <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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 <- forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Map Text PublicKey
-> RuleScope' 'Repr 'WithSlices
-> Validation (NonEmpty Text) RuleScope
substituteScope Map Text PublicKey
keyMapping) (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
scope :: Set (RuleScope' 'Repr 'WithSlices)
expressions :: [Expression' 'WithSlices]
body :: [Predicate' 'InPredicate 'WithSlices]
rhead :: Predicate' 'InPredicate 'WithSlices
scope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
expressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Expression' ctx]
body :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Predicate' 'InPredicate ctx]
rhead :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Predicate' 'InPredicate ctx
..} = do
  Predicate
newHead <- Map Text Value
-> Predicate' 'InPredicate 'WithSlices
-> Validation (NonEmpty Text) Predicate
substitutePredicate Map Text Value
termMapping Predicate' 'InPredicate 'WithSlices
rhead
  [Predicate]
newBody <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Map Text Value
-> Predicate' 'InPredicate 'WithSlices
-> Validation (NonEmpty Text) Predicate
substitutePredicate Map Text Value
termMapping) [Predicate' 'InPredicate 'WithSlices]
body
  [Expression]
newExpressions <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Map Text Value
-> Expression' 'WithSlices -> Validation (NonEmpty Text) Expression
substituteExpression Map Text Value
termMapping) [Expression' 'WithSlices]
expressions
  Set RuleScope
newScope <- forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Map Text PublicKey
-> RuleScope' 'Repr 'WithSlices
-> Validation (NonEmpty Text) RuleScope
substituteScope Map Text PublicKey
keyMapping) (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
cKind :: CheckKind
cQueries :: Query' 'Repr 'WithSlices
cKind :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> CheckKind
cQueries :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
..} = do
  Query
newQueries <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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 =
  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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)
qScope :: Set (RuleScope' 'Repr 'WithSlices)
qExpressions :: [Expression' 'WithSlices]
qBody :: [Predicate' 'InPredicate 'WithSlices]
qScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
qExpressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Expression' ctx]
qBody :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Predicate' 'InPredicate ctx]
..} = do
  [Predicate]
newBody <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Map Text Value
-> Predicate' 'InPredicate 'WithSlices
-> Validation (NonEmpty Text) Predicate
substitutePredicate Map Text Value
termMapping) [Predicate' 'InPredicate 'WithSlices]
qBody
  [Expression]
newExpressions <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Map Text Value
-> Expression' 'WithSlices -> Validation (NonEmpty Text) Expression
substituteExpression Map Text Value
termMapping) [Expression' 'WithSlices]
qExpressions
  Set RuleScope
newScope <- forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Map Text PublicKey
-> RuleScope' 'Repr 'WithSlices
-> Validation (NonEmpty Text) RuleScope
substituteScope Map Text PublicKey
keyMapping) (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
terms :: [Term' 'NotWithinSet 'InPredicate 'WithSlices]
name :: Text
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
..} = do
  [Term]
newTerms <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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
terms :: [Term' 'NotWithinSet 'InFact 'WithSlices]
name :: Text
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
..} = do
  [Value]
newTerms <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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 Int
i  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Int -> Term' inSet pof ctx
LInteger Int
i
  LString Text
i   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString Text
i
  LDate UTCTime
i     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate UTCTime
i
  LBytes ByteString
i    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes ByteString
i
  LBool Bool
i     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool Bool
i
  TermSet SetType 'NotWithinSet 'WithSlices
i   ->
    forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
SetType inSet ctx -> Term' inSet pof ctx
TermSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Map Text Value
-> Term' 'WithinSet 'InFact 'WithSlices
-> Validation
     (NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
substituteSetTerm Map Text Value
termMapping) (forall a. Set a -> [a]
Set.toList SetType 'NotWithinSet 'WithSlices
i)
  Variable VariableType 'NotWithinSet 'InPredicate
i  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
VariableType inSet pof -> Term' inSet pof ctx
Variable VariableType 'NotWithinSet 'InPredicate
i
  Antiquote (Slice Text
v) -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. e -> Validation (NonEmpty e) a
failure Text
v) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Term
valueToTerm) forall a b. (a -> b) -> a -> b
$ Map Text Value
termMapping 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 Int
i  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Int -> Term' inSet pof ctx
LInteger Int
i
  LString Text
i   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString Text
i
  LDate UTCTime
i     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate UTCTime
i
  LBytes ByteString
i    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes ByteString
i
  LBool Bool
i     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool Bool
i
  TermSet SetType 'NotWithinSet 'WithSlices
i   ->
    forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
SetType inSet ctx -> Term' inSet pof ctx
TermSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Map Text Value
-> Term' 'WithinSet 'InFact 'WithSlices
-> Validation
     (NonEmpty Text) (Term' 'WithinSet 'InFact 'Representation)
substituteSetTerm Map Text Value
termMapping) (forall a. Set a -> [a]
Set.toList SetType 'NotWithinSet 'WithSlices
i)
  Variable VariableType 'NotWithinSet 'InFact
v  -> forall a. Void -> a
absurd VariableType 'NotWithinSet 'InFact
v
  Antiquote (Slice Text
v) -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. e -> Validation (NonEmpty e) a
failure Text
v) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Map Text Value
termMapping 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 Int
i  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Int -> Term' inSet pof ctx
LInteger Int
i
  LString Text
i   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString Text
i
  LDate UTCTime
i     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate UTCTime
i
  LBytes ByteString
i    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes ByteString
i
  LBool Bool
i     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool Bool
i
  TermSet SetType 'WithinSet 'WithSlices
v   -> forall a. Void -> a
absurd SetType 'WithinSet 'WithSlices
v
  Variable VariableType 'WithinSet 'InFact
v  -> forall a. Void -> a
absurd VariableType 'WithinSet 'InFact
v
  Antiquote (Slice Text
v) ->
    let setTerm :: Maybe (Term' 'WithinSet 'InFact 'Representation)
setTerm = Value -> Maybe (Term' 'WithinSet 'InFact 'Representation)
valueToSetTerm forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Map Text Value
termMapping forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? Text
v
     in forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. e -> Validation (NonEmpty e) a
failure Text
v) 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 -> forall (ctx :: DatalogContext).
Term' 'NotWithinSet 'InPredicate ctx -> Expression' ctx
EValue 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 -> forall (ctx :: DatalogContext).
Unary -> Expression' ctx -> Expression' ctx
EUnary Unary
op 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' -> forall (ctx :: DatalogContext).
Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
EBinary Binary
op 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
                                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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
OnlyAuthority
    RuleScope' 'Repr 'WithSlices
Previous      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
Previous
    BlockId (Pk PublicKey
pk) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
BlockIdType evalCtx ctx -> RuleScope' evalCtx ctx
BlockId PublicKey
pk
    BlockId (PkSlice Text
n) -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. e -> Validation (NonEmpty e) a
failure Text
n) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
BlockIdType evalCtx ctx -> RuleScope' evalCtx ctx
BlockId) forall a b. (a -> b) -> a -> b
$ Map Text PublicKey
keyMapping forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? Text
n