biscuit-haskell-0.1.1.0: Library support for the Biscuit security token
Copyright© Clément Delafargue 2021
LicenseMIT
Maintainerclement@delafargue.name
Safe HaskellNone
LanguageHaskell2010

Auth.Biscuit.Datalog.AST

Description

The Datalog elements

Synopsis

Documentation

data Binary Source #

Instances

Instances details
Eq Binary Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

(==) :: Binary -> Binary -> Bool #

(/=) :: Binary -> Binary -> Bool #

Ord Binary Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Show Binary Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Lift Binary Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

lift :: Binary -> Q Exp #

liftTyped :: Binary -> Q (TExp Binary) #

type Block = Block' 'RegularString Source #

A biscuit block, containing facts, rules and checks.

Block has a Monoid instance, this is the expected way to build composite blocks (eg if you need to generate a list of facts):

-- build a block containing a list of facts `value("a"); value("b"); value("c");`.
foldMap (\v -> [block| value(${v}) |]) ["a", "b", "c"]

data Block' (ctx :: ParsedAs) Source #

A biscuit block, that may or may not contain slices referencing haskell variables

Constructors

Block 

Fields

Instances

Instances details
Show Block Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

showsPrec :: Int -> Block -> ShowS #

show :: Block -> String #

showList :: [Block] -> ShowS #

(Lift (Predicate' 'InFact ctx), Lift (Rule' ctx), Lift (QueryItem' ctx)) => Lift (Block' ctx :: Type) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

lift :: Block' ctx -> Q Exp #

liftTyped :: Block' ctx -> Q (TExp (Block' ctx)) #

(Eq (Predicate' 'InFact ctx), Eq (Rule' ctx), Eq (QueryItem' ctx)) => Eq (Block' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

(==) :: Block' ctx -> Block' ctx -> Bool #

(/=) :: Block' ctx -> Block' ctx -> Bool #

Semigroup (Block' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

(<>) :: Block' ctx -> Block' ctx -> Block' ctx #

sconcat :: NonEmpty (Block' ctx) -> Block' ctx #

stimes :: Integral b => b -> Block' ctx -> Block' ctx #

Monoid (Block' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

mempty :: Block' ctx #

mappend :: Block' ctx -> Block' ctx -> Block' ctx #

mconcat :: [Block' ctx] -> Block' ctx #

data BlockElement' ctx Source #

Instances

Instances details
(Show (Predicate' 'InFact ctx), Show (Rule' ctx), Show (QueryItem' ctx)) => Show (BlockElement' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

type Check' ctx = Query' ctx Source #

data Expression' (ctx :: ParsedAs) Source #

Instances

Instances details
Lift (ID' 'NotWithinSet 'InPredicate ctx) => Lift (Expression' ctx :: Type) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

lift :: Expression' ctx -> Q Exp #

liftTyped :: Expression' ctx -> Q (TExp (Expression' ctx)) #

Eq (ID' 'NotWithinSet 'InPredicate ctx) => Eq (Expression' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

(==) :: Expression' ctx -> Expression' ctx -> Bool #

(/=) :: Expression' ctx -> Expression' ctx -> Bool #

Ord (ID' 'NotWithinSet 'InPredicate ctx) => Ord (Expression' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

compare :: Expression' ctx -> Expression' ctx -> Ordering #

(<) :: Expression' ctx -> Expression' ctx -> Bool #

(<=) :: Expression' ctx -> Expression' ctx -> Bool #

(>) :: Expression' ctx -> Expression' ctx -> Bool #

(>=) :: Expression' ctx -> Expression' ctx -> Bool #

max :: Expression' ctx -> Expression' ctx -> Expression' ctx #

min :: Expression' ctx -> Expression' ctx -> Expression' ctx #

Show (ID' 'NotWithinSet 'InPredicate ctx) => Show (Expression' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

showsPrec :: Int -> Expression' ctx -> ShowS #

show :: Expression' ctx -> String #

showList :: [Expression' ctx] -> ShowS #

type ID = ID' 'NotWithinSet 'InPredicate 'RegularString Source #

In a regular AST, slices have already been eliminated

data ID' (inSet :: IsWithinSet) (pof :: PredicateOrFact) (ctx :: ParsedAs) Source #

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

Constructors

Symbol Text

A symbol (eg. #authority)

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

Instances

Instances details
(Lift (VariableType inSet pof), Lift (SetType inSet ctx), Lift (SliceType ctx)) => Lift (ID' inSet pof ctx :: Type) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

lift :: ID' inSet pof ctx -> Q Exp #

liftTyped :: ID' inSet pof ctx -> Q (TExp (ID' inSet pof ctx)) #

(Eq (VariableType inSet pof), Eq (SliceType ctx), Eq (SetType inSet ctx)) => Eq (ID' inSet pof ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

(==) :: ID' inSet pof ctx -> ID' inSet pof ctx -> Bool #

(/=) :: ID' inSet pof ctx -> ID' inSet pof ctx -> Bool #

(Ord (VariableType inSet pof), Ord (SliceType ctx), Ord (SetType inSet ctx)) => Ord (ID' inSet pof ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

compare :: ID' inSet pof ctx -> ID' inSet pof ctx -> Ordering #

(<) :: ID' inSet pof ctx -> ID' inSet pof ctx -> Bool #

(<=) :: ID' inSet pof ctx -> ID' inSet pof ctx -> Bool #

(>) :: ID' inSet pof ctx -> ID' inSet pof ctx -> Bool #

(>=) :: ID' inSet pof ctx -> ID' inSet pof ctx -> Bool #

max :: ID' inSet pof ctx -> ID' inSet pof ctx -> ID' inSet pof ctx #

min :: ID' inSet pof ctx -> ID' inSet pof ctx -> ID' inSet pof ctx #

(Show (VariableType inSet pof), Show (SliceType ctx), Show (SetType inSet ctx)) => Show (ID' inSet pof ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

showsPrec :: Int -> ID' inSet pof ctx -> ShowS #

show :: ID' inSet pof ctx -> String #

showList :: [ID' inSet pof ctx] -> ShowS #

data Op Source #

Constructors

VOp ID 
UOp Unary 
BOp Binary 

type Policy' ctx = (PolicyType, Query' ctx) Source #

data Predicate' (pof :: PredicateOrFact) (ctx :: ParsedAs) Source #

Constructors

Predicate 

Fields

Instances

Instances details
Lift (ID' 'NotWithinSet pof ctx) => Lift (Predicate' pof ctx :: Type) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

lift :: Predicate' pof ctx -> Q Exp #

liftTyped :: Predicate' pof ctx -> Q (TExp (Predicate' pof ctx)) #

Eq (ID' 'NotWithinSet pof ctx) => Eq (Predicate' pof ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

(==) :: Predicate' pof ctx -> Predicate' pof ctx -> Bool #

(/=) :: Predicate' pof ctx -> Predicate' pof ctx -> Bool #

Ord (ID' 'NotWithinSet pof ctx) => Ord (Predicate' pof ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

compare :: Predicate' pof ctx -> Predicate' pof ctx -> Ordering #

(<) :: Predicate' pof ctx -> Predicate' pof ctx -> Bool #

(<=) :: Predicate' pof ctx -> Predicate' pof ctx -> Bool #

(>) :: Predicate' pof ctx -> Predicate' pof ctx -> Bool #

(>=) :: Predicate' pof ctx -> Predicate' pof ctx -> Bool #

max :: Predicate' pof ctx -> Predicate' pof ctx -> Predicate' pof ctx #

min :: Predicate' pof ctx -> Predicate' pof ctx -> Predicate' pof ctx #

Show (ID' 'NotWithinSet pof ctx) => Show (Predicate' pof ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

showsPrec :: Int -> Predicate' pof ctx -> ShowS #

show :: Predicate' pof ctx -> String #

showList :: [Predicate' pof ctx] -> ShowS #

type QQID = ID' 'NotWithinSet 'InPredicate 'QuasiQuote Source #

In an AST parsed from a QuasiQuoter, there might be references to haskell variables

type Query' ctx = [QueryItem' ctx] Source #

data QueryItem' ctx Source #

Constructors

QueryItem 

Instances

Instances details
(Lift (Predicate' 'InPredicate ctx), Lift (Expression' ctx)) => Lift (QueryItem' ctx :: Type) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

lift :: QueryItem' ctx -> Q Exp #

liftTyped :: QueryItem' ctx -> Q (TExp (QueryItem' ctx)) #

(Eq (Predicate' 'InPredicate ctx), Eq (Expression' ctx)) => Eq (QueryItem' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

(==) :: QueryItem' ctx -> QueryItem' ctx -> Bool #

(/=) :: QueryItem' ctx -> QueryItem' ctx -> Bool #

(Ord (Predicate' 'InPredicate ctx), Ord (Expression' ctx)) => Ord (QueryItem' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

compare :: QueryItem' ctx -> QueryItem' ctx -> Ordering #

(<) :: QueryItem' ctx -> QueryItem' ctx -> Bool #

(<=) :: QueryItem' ctx -> QueryItem' ctx -> Bool #

(>) :: QueryItem' ctx -> QueryItem' ctx -> Bool #

(>=) :: QueryItem' ctx -> QueryItem' ctx -> Bool #

max :: QueryItem' ctx -> QueryItem' ctx -> QueryItem' ctx #

min :: QueryItem' ctx -> QueryItem' ctx -> QueryItem' ctx #

(Show (Predicate' 'InPredicate ctx), Show (Expression' ctx)) => Show (QueryItem' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

showsPrec :: Int -> QueryItem' ctx -> ShowS #

show :: QueryItem' ctx -> String #

showList :: [QueryItem' ctx] -> ShowS #

data Rule' ctx Source #

Constructors

Rule 

Instances

Instances details
(Lift (Predicate' 'InPredicate ctx), Lift (Expression' ctx)) => Lift (Rule' ctx :: Type) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

lift :: Rule' ctx -> Q Exp #

liftTyped :: Rule' ctx -> Q (TExp (Rule' ctx)) #

(Eq (Predicate' 'InPredicate ctx), Eq (Expression' ctx)) => Eq (Rule' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

(==) :: Rule' ctx -> Rule' ctx -> Bool #

(/=) :: Rule' ctx -> Rule' ctx -> Bool #

(Ord (Predicate' 'InPredicate ctx), Ord (Expression' ctx)) => Ord (Rule' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

compare :: Rule' ctx -> Rule' ctx -> Ordering #

(<) :: Rule' ctx -> Rule' ctx -> Bool #

(<=) :: Rule' ctx -> Rule' ctx -> Bool #

(>) :: Rule' ctx -> Rule' ctx -> Bool #

(>=) :: Rule' ctx -> Rule' ctx -> Bool #

max :: Rule' ctx -> Rule' ctx -> Rule' ctx #

min :: Rule' ctx -> Rule' ctx -> Rule' ctx #

(Show (Predicate' 'InPredicate ctx), Show (Expression' ctx)) => Show (Rule' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

showsPrec :: Int -> Rule' ctx -> ShowS #

show :: Rule' ctx -> String #

showList :: [Rule' ctx] -> ShowS #

type family SetType (inSet :: IsWithinSet) (ctx :: ParsedAs) where ... Source #

Equations

SetType 'NotWithinSet ctx = Set (ID' 'WithinSet 'InFact ctx) 
SetType 'WithinSet ctx = Void 

newtype Slice Source #

Constructors

Slice String 

Instances

Instances details
Eq Slice Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

(==) :: Slice -> Slice -> Bool #

(/=) :: Slice -> Slice -> Bool #

Ord Slice Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

compare :: Slice -> Slice -> Ordering #

(<) :: Slice -> Slice -> Bool #

(<=) :: Slice -> Slice -> Bool #

(>) :: Slice -> Slice -> Bool #

(>=) :: Slice -> Slice -> Bool #

max :: Slice -> Slice -> Slice #

min :: Slice -> Slice -> Slice #

Show Slice Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

showsPrec :: Int -> Slice -> ShowS #

show :: Slice -> String #

showList :: [Slice] -> ShowS #

IsString Slice Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

fromString :: String -> Slice #

Lift Slice Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

lift :: Slice -> Q Exp #

liftTyped :: Slice -> Q (TExp Slice) #

type family SliceType (ctx :: ParsedAs) where ... Source #

data Unary Source #

Constructors

Negate 
Parens 
Length 

Instances

Instances details
Eq Unary Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

(==) :: Unary -> Unary -> Bool #

(/=) :: Unary -> Unary -> Bool #

Ord Unary Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

compare :: Unary -> Unary -> Ordering #

(<) :: Unary -> Unary -> Bool #

(<=) :: Unary -> Unary -> Bool #

(>) :: Unary -> Unary -> Bool #

(>=) :: Unary -> Unary -> Bool #

max :: Unary -> Unary -> Unary #

min :: Unary -> Unary -> Unary #

Show Unary Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

showsPrec :: Int -> Unary -> ShowS #

show :: Unary -> String #

showList :: [Unary] -> ShowS #

Lift Unary Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

lift :: Unary -> Q Exp #

liftTyped :: Unary -> Q (TExp Unary) #

type Value = ID' 'NotWithinSet 'InFact 'RegularString Source #

A term that is not a variable

type family VariableType (inSet :: IsWithinSet) (pof :: PredicateOrFact) where ... Source #

type Verifier = Verifier' 'RegularString Source #

A biscuit verifier, containing, facts, rules, checks and policies

data Verifier' (ctx :: ParsedAs) Source #

The context in which a biscuit policies and checks are verified. A verifier may add policies (`deny if` / `allow if` conditions), as well as rules, facts, and checks. A verifier may or may not contain slices referencing haskell variables.

Constructors

Verifier 

Fields

Instances

Instances details
(Lift (Block' ctx), Lift (QueryItem' ctx)) => Lift (Verifier' ctx :: Type) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

lift :: Verifier' ctx -> Q Exp #

liftTyped :: Verifier' ctx -> Q (TExp (Verifier' ctx)) #

(Eq (Block' ctx), Eq (QueryItem' ctx)) => Eq (Verifier' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

(==) :: Verifier' ctx -> Verifier' ctx -> Bool #

(/=) :: Verifier' ctx -> Verifier' ctx -> Bool #

(Show (Block' ctx), Show (QueryItem' ctx)) => Show (Verifier' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

showsPrec :: Int -> Verifier' ctx -> ShowS #

show :: Verifier' ctx -> String #

showList :: [Verifier' ctx] -> ShowS #

Semigroup (Verifier' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

(<>) :: Verifier' ctx -> Verifier' ctx -> Verifier' ctx #

sconcat :: NonEmpty (Verifier' ctx) -> Verifier' ctx #

stimes :: Integral b => b -> Verifier' ctx -> Verifier' ctx #

Monoid (Verifier' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST

Methods

mempty :: Verifier' ctx #

mappend :: Verifier' ctx -> Verifier' ctx -> Verifier' ctx #

mconcat :: [Verifier' ctx] -> Verifier' ctx #

data VerifierElement' ctx Source #

Instances

Instances details
(Show (Predicate' 'InFact ctx), Show (Rule' ctx), Show (QueryItem' ctx)) => Show (VerifierElement' ctx) Source # 
Instance details

Defined in Auth.Biscuit.Datalog.AST