{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-|
  Module      : Auth.Biscuit.Proto
  Copyright   : © Clément Delafargue, 2021
  License     : MIT
  Maintainer  : clement@delafargue.name
  Haskell data structures mapping the biscuit protobuf definitions
-}

module Auth.Biscuit.Proto
  ( Biscuit (..)
  , Signature (..)
  , Block (..)
  , FactV1 (..)
  , RuleV1 (..)
  , CheckV1 (..)
  , PredicateV1 (..)
  , IDV1 (..)
  , ExpressionV1 (..)
  , IDSet (..)
  , Op (..)
  , OpUnary (..)
  , UnaryKind (..)
  , OpBinary (..)
  , BinaryKind (..)
  , getField
  , putField
  , decodeBlockList
  , decodeBlock
  , encodeBlockList
  , encodeBlock
  ) where

import           Data.ByteString      (ByteString)
import           Data.Int
import           Data.ProtocolBuffers
import           Data.Serialize
import           Data.Text
import           GHC.Generics         (Generic)

data Biscuit = Biscuit
  { Biscuit -> Required 1 (Value ByteString)
authority :: Required 1 (Value ByteString)
  , Biscuit -> Repeated 2 (Value ByteString)
blocks    :: Repeated 2 (Value ByteString)
  , Biscuit -> Repeated 3 (Value ByteString)
keys      :: Repeated 3 (Value ByteString)
  , Biscuit -> Required 4 (Message Signature)
signature :: Required 4 (Message Signature)
  } deriving ((forall x. Biscuit -> Rep Biscuit x)
-> (forall x. Rep Biscuit x -> Biscuit) -> Generic Biscuit
forall x. Rep Biscuit x -> Biscuit
forall x. Biscuit -> Rep Biscuit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Biscuit x -> Biscuit
$cfrom :: forall x. Biscuit -> Rep Biscuit x
Generic, Int -> Biscuit -> ShowS
[Biscuit] -> ShowS
Biscuit -> String
(Int -> Biscuit -> ShowS)
-> (Biscuit -> String) -> ([Biscuit] -> ShowS) -> Show Biscuit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Biscuit] -> ShowS
$cshowList :: [Biscuit] -> ShowS
show :: Biscuit -> String
$cshow :: Biscuit -> String
showsPrec :: Int -> Biscuit -> ShowS
$cshowsPrec :: Int -> Biscuit -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get Biscuit
(HashMap Tag [WireField] -> Get Biscuit) -> Decode Biscuit
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get Biscuit
$cdecode :: HashMap Tag [WireField] -> Get Biscuit
Decode, Biscuit -> Put
(Biscuit -> Put) -> Encode Biscuit
forall a. (a -> Put) -> Encode a
encode :: Biscuit -> Put
$cencode :: Biscuit -> Put
Encode)

data CBiscuit = CBiscuit
  { CBiscuit -> Required 1 (Message Block)
cAuthority :: Required 1 (Message Block)
  , CBiscuit -> Repeated 2 (Message Block)
cBlocks    :: Repeated 2 (Message Block)
  , CBiscuit -> Repeated 3 (Value ByteString)
cKeys      :: Repeated 3 (Value ByteString)
  , CBiscuit -> Required 4 (Message Signature)
cSignature :: Required 4 (Message Signature)
  } deriving ((forall x. CBiscuit -> Rep CBiscuit x)
-> (forall x. Rep CBiscuit x -> CBiscuit) -> Generic CBiscuit
forall x. Rep CBiscuit x -> CBiscuit
forall x. CBiscuit -> Rep CBiscuit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CBiscuit x -> CBiscuit
$cfrom :: forall x. CBiscuit -> Rep CBiscuit x
Generic, Int -> CBiscuit -> ShowS
[CBiscuit] -> ShowS
CBiscuit -> String
(Int -> CBiscuit -> ShowS)
-> (CBiscuit -> String) -> ([CBiscuit] -> ShowS) -> Show CBiscuit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CBiscuit] -> ShowS
$cshowList :: [CBiscuit] -> ShowS
show :: CBiscuit -> String
$cshow :: CBiscuit -> String
showsPrec :: Int -> CBiscuit -> ShowS
$cshowsPrec :: Int -> CBiscuit -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get CBiscuit
(HashMap Tag [WireField] -> Get CBiscuit) -> Decode CBiscuit
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get CBiscuit
$cdecode :: HashMap Tag [WireField] -> Get CBiscuit
Decode, CBiscuit -> Put
(CBiscuit -> Put) -> Encode CBiscuit
forall a. (a -> Put) -> Encode a
encode :: CBiscuit -> Put
$cencode :: CBiscuit -> Put
Encode)

data SealedBiscuit = SealedBiscuit
  { SealedBiscuit -> Required 1 (Value ByteString)
sAuthority :: Required 1 (Value ByteString)
  , SealedBiscuit -> Repeated 2 (Value ByteString)
sBlocks    :: Repeated 2 (Value ByteString)
  , SealedBiscuit -> Required 3 (Value ByteString)
sSignature :: Required 3 (Value ByteString)
  } deriving ((forall x. SealedBiscuit -> Rep SealedBiscuit x)
-> (forall x. Rep SealedBiscuit x -> SealedBiscuit)
-> Generic SealedBiscuit
forall x. Rep SealedBiscuit x -> SealedBiscuit
forall x. SealedBiscuit -> Rep SealedBiscuit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SealedBiscuit x -> SealedBiscuit
$cfrom :: forall x. SealedBiscuit -> Rep SealedBiscuit x
Generic, Int -> SealedBiscuit -> ShowS
[SealedBiscuit] -> ShowS
SealedBiscuit -> String
(Int -> SealedBiscuit -> ShowS)
-> (SealedBiscuit -> String)
-> ([SealedBiscuit] -> ShowS)
-> Show SealedBiscuit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SealedBiscuit] -> ShowS
$cshowList :: [SealedBiscuit] -> ShowS
show :: SealedBiscuit -> String
$cshow :: SealedBiscuit -> String
showsPrec :: Int -> SealedBiscuit -> ShowS
$cshowsPrec :: Int -> SealedBiscuit -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get SealedBiscuit
(HashMap Tag [WireField] -> Get SealedBiscuit)
-> Decode SealedBiscuit
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get SealedBiscuit
$cdecode :: HashMap Tag [WireField] -> Get SealedBiscuit
Decode, SealedBiscuit -> Put
(SealedBiscuit -> Put) -> Encode SealedBiscuit
forall a. (a -> Put) -> Encode a
encode :: SealedBiscuit -> Put
$cencode :: SealedBiscuit -> Put
Encode)

data Signature = Signature
  { Signature -> Repeated 1 (Value ByteString)
parameters :: Repeated 1 (Value ByteString)
  , Signature -> Required 2 (Value ByteString)
z          :: Required 2 (Value ByteString)
  } deriving ((forall x. Signature -> Rep Signature x)
-> (forall x. Rep Signature x -> Signature) -> Generic Signature
forall x. Rep Signature x -> Signature
forall x. Signature -> Rep Signature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Signature x -> Signature
$cfrom :: forall x. Signature -> Rep Signature x
Generic, Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signature] -> ShowS
$cshowList :: [Signature] -> ShowS
show :: Signature -> String
$cshow :: Signature -> String
showsPrec :: Int -> Signature -> ShowS
$cshowsPrec :: Int -> Signature -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get Signature
(HashMap Tag [WireField] -> Get Signature) -> Decode Signature
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get Signature
$cdecode :: HashMap Tag [WireField] -> Get Signature
Decode, Signature -> Put
(Signature -> Put) -> Encode Signature
forall a. (a -> Put) -> Encode a
encode :: Signature -> Put
$cencode :: Signature -> Put
Encode)

data Block = Block {
    Block -> Required 1 (Value Int32)
index     :: Required 1 (Value Int32)
  , Block -> Repeated 2 (Value Text)
symbols   :: Repeated 2 (Value Text)
  -- , facts_v0   :: Repeated 3 (Message FactV0)
  -- , rules_v0   :: Repeated 4 (Message RuleV0)
  -- , caveats_v0 :: Repeated 5 (Message CaveatV0)
  , Block -> Optional 6 (Value Text)
context   :: Optional 6 (Value Text)
  , Block -> Optional 7 (Value Int32)
version   :: Optional 7 (Value Int32)
  , Block -> Repeated 8 (Message FactV1)
facts_v1  :: Repeated 8 (Message FactV1)
  , Block -> Repeated 9 (Message RuleV1)
rules_v1  :: Repeated 9 (Message RuleV1)
  , Block -> Repeated 10 (Message CheckV1)
checks_v1 :: Repeated 10 (Message CheckV1)
  } deriving ((forall x. Block -> Rep Block x)
-> (forall x. Rep Block x -> Block) -> Generic Block
forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Block x -> Block
$cfrom :: forall x. Block -> Rep Block x
Generic, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get Block
(HashMap Tag [WireField] -> Get Block) -> Decode Block
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get Block
$cdecode :: HashMap Tag [WireField] -> Get Block
Decode, Block -> Put
(Block -> Put) -> Encode Block
forall a. (a -> Put) -> Encode a
encode :: Block -> Put
$cencode :: Block -> Put
Encode)

newtype FactV1 = FactV1
  { FactV1 -> Required 1 (Message PredicateV1)
predicate :: Required 1 (Message PredicateV1)
  } deriving stock ((forall x. FactV1 -> Rep FactV1 x)
-> (forall x. Rep FactV1 x -> FactV1) -> Generic FactV1
forall x. Rep FactV1 x -> FactV1
forall x. FactV1 -> Rep FactV1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FactV1 x -> FactV1
$cfrom :: forall x. FactV1 -> Rep FactV1 x
Generic, Int -> FactV1 -> ShowS
[FactV1] -> ShowS
FactV1 -> String
(Int -> FactV1 -> ShowS)
-> (FactV1 -> String) -> ([FactV1] -> ShowS) -> Show FactV1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FactV1] -> ShowS
$cshowList :: [FactV1] -> ShowS
show :: FactV1 -> String
$cshow :: FactV1 -> String
showsPrec :: Int -> FactV1 -> ShowS
$cshowsPrec :: Int -> FactV1 -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get FactV1
(HashMap Tag [WireField] -> Get FactV1) -> Decode FactV1
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get FactV1
$cdecode :: HashMap Tag [WireField] -> Get FactV1
Decode, FactV1 -> Put
(FactV1 -> Put) -> Encode FactV1
forall a. (a -> Put) -> Encode a
encode :: FactV1 -> Put
$cencode :: FactV1 -> Put
Encode)

data RuleV1 = RuleV1
  { RuleV1 -> Required 1 (Message PredicateV1)
head        :: Required 1 (Message PredicateV1)
  , RuleV1 -> Repeated 2 (Message PredicateV1)
body        :: Repeated 2 (Message PredicateV1)
  , RuleV1 -> Repeated 3 (Message ExpressionV1)
expressions :: Repeated 3 (Message ExpressionV1)
  } deriving stock ((forall x. RuleV1 -> Rep RuleV1 x)
-> (forall x. Rep RuleV1 x -> RuleV1) -> Generic RuleV1
forall x. Rep RuleV1 x -> RuleV1
forall x. RuleV1 -> Rep RuleV1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RuleV1 x -> RuleV1
$cfrom :: forall x. RuleV1 -> Rep RuleV1 x
Generic, Int -> RuleV1 -> ShowS
[RuleV1] -> ShowS
RuleV1 -> String
(Int -> RuleV1 -> ShowS)
-> (RuleV1 -> String) -> ([RuleV1] -> ShowS) -> Show RuleV1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuleV1] -> ShowS
$cshowList :: [RuleV1] -> ShowS
show :: RuleV1 -> String
$cshow :: RuleV1 -> String
showsPrec :: Int -> RuleV1 -> ShowS
$cshowsPrec :: Int -> RuleV1 -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get RuleV1
(HashMap Tag [WireField] -> Get RuleV1) -> Decode RuleV1
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get RuleV1
$cdecode :: HashMap Tag [WireField] -> Get RuleV1
Decode, RuleV1 -> Put
(RuleV1 -> Put) -> Encode RuleV1
forall a. (a -> Put) -> Encode a
encode :: RuleV1 -> Put
$cencode :: RuleV1 -> Put
Encode)

newtype CheckV1 = CheckV1
  { CheckV1 -> Repeated 1 (Message RuleV1)
queries :: Repeated 1 (Message RuleV1)
  } deriving stock ((forall x. CheckV1 -> Rep CheckV1 x)
-> (forall x. Rep CheckV1 x -> CheckV1) -> Generic CheckV1
forall x. Rep CheckV1 x -> CheckV1
forall x. CheckV1 -> Rep CheckV1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CheckV1 x -> CheckV1
$cfrom :: forall x. CheckV1 -> Rep CheckV1 x
Generic, Int -> CheckV1 -> ShowS
[CheckV1] -> ShowS
CheckV1 -> String
(Int -> CheckV1 -> ShowS)
-> (CheckV1 -> String) -> ([CheckV1] -> ShowS) -> Show CheckV1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckV1] -> ShowS
$cshowList :: [CheckV1] -> ShowS
show :: CheckV1 -> String
$cshow :: CheckV1 -> String
showsPrec :: Int -> CheckV1 -> ShowS
$cshowsPrec :: Int -> CheckV1 -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get CheckV1
(HashMap Tag [WireField] -> Get CheckV1) -> Decode CheckV1
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get CheckV1
$cdecode :: HashMap Tag [WireField] -> Get CheckV1
Decode, CheckV1 -> Put
(CheckV1 -> Put) -> Encode CheckV1
forall a. (a -> Put) -> Encode a
encode :: CheckV1 -> Put
$cencode :: CheckV1 -> Put
Encode)

data PredicateV1 = PredicateV1
  { PredicateV1 -> Required 1 (Value Int64)
name :: Required 1 (Value Int64)
  , PredicateV1 -> Repeated 2 (Message IDV1)
ids  :: Repeated 2 (Message IDV1)
  } deriving stock ((forall x. PredicateV1 -> Rep PredicateV1 x)
-> (forall x. Rep PredicateV1 x -> PredicateV1)
-> Generic PredicateV1
forall x. Rep PredicateV1 x -> PredicateV1
forall x. PredicateV1 -> Rep PredicateV1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PredicateV1 x -> PredicateV1
$cfrom :: forall x. PredicateV1 -> Rep PredicateV1 x
Generic, Int -> PredicateV1 -> ShowS
[PredicateV1] -> ShowS
PredicateV1 -> String
(Int -> PredicateV1 -> ShowS)
-> (PredicateV1 -> String)
-> ([PredicateV1] -> ShowS)
-> Show PredicateV1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PredicateV1] -> ShowS
$cshowList :: [PredicateV1] -> ShowS
show :: PredicateV1 -> String
$cshow :: PredicateV1 -> String
showsPrec :: Int -> PredicateV1 -> ShowS
$cshowsPrec :: Int -> PredicateV1 -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get PredicateV1
(HashMap Tag [WireField] -> Get PredicateV1) -> Decode PredicateV1
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get PredicateV1
$cdecode :: HashMap Tag [WireField] -> Get PredicateV1
Decode, PredicateV1 -> Put
(PredicateV1 -> Put) -> Encode PredicateV1
forall a. (a -> Put) -> Encode a
encode :: PredicateV1 -> Put
$cencode :: PredicateV1 -> Put
Encode)

data IDV1 =
    IDSymbol (Required 1 (Value Int64))
  | IDVariable (Required 2 (Value Int32))
  | IDInteger (Required 3 (Value Int64))
  | IDString (Required 4 (Value Text))
  | IDDate (Required 5 (Value Int64))
  | IDBytes (Required 6 (Value ByteString))
  | IDBool (Required 7 (Value Bool))
  | IDIDSet (Required 8 (Message IDSet))
    deriving stock ((forall x. IDV1 -> Rep IDV1 x)
-> (forall x. Rep IDV1 x -> IDV1) -> Generic IDV1
forall x. Rep IDV1 x -> IDV1
forall x. IDV1 -> Rep IDV1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IDV1 x -> IDV1
$cfrom :: forall x. IDV1 -> Rep IDV1 x
Generic, Int -> IDV1 -> ShowS
[IDV1] -> ShowS
IDV1 -> String
(Int -> IDV1 -> ShowS)
-> (IDV1 -> String) -> ([IDV1] -> ShowS) -> Show IDV1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IDV1] -> ShowS
$cshowList :: [IDV1] -> ShowS
show :: IDV1 -> String
$cshow :: IDV1 -> String
showsPrec :: Int -> IDV1 -> ShowS
$cshowsPrec :: Int -> IDV1 -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get IDV1
(HashMap Tag [WireField] -> Get IDV1) -> Decode IDV1
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get IDV1
$cdecode :: HashMap Tag [WireField] -> Get IDV1
Decode, IDV1 -> Put
(IDV1 -> Put) -> Encode IDV1
forall a. (a -> Put) -> Encode a
encode :: IDV1 -> Put
$cencode :: IDV1 -> Put
Encode)


newtype IDSet = IDSet
  { IDSet -> Repeated 1 (Message IDV1)
set :: Repeated 1 (Message IDV1)
  } deriving stock ((forall x. IDSet -> Rep IDSet x)
-> (forall x. Rep IDSet x -> IDSet) -> Generic IDSet
forall x. Rep IDSet x -> IDSet
forall x. IDSet -> Rep IDSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IDSet x -> IDSet
$cfrom :: forall x. IDSet -> Rep IDSet x
Generic, Int -> IDSet -> ShowS
[IDSet] -> ShowS
IDSet -> String
(Int -> IDSet -> ShowS)
-> (IDSet -> String) -> ([IDSet] -> ShowS) -> Show IDSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IDSet] -> ShowS
$cshowList :: [IDSet] -> ShowS
show :: IDSet -> String
$cshow :: IDSet -> String
showsPrec :: Int -> IDSet -> ShowS
$cshowsPrec :: Int -> IDSet -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get IDSet
(HashMap Tag [WireField] -> Get IDSet) -> Decode IDSet
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get IDSet
$cdecode :: HashMap Tag [WireField] -> Get IDSet
Decode, IDSet -> Put
(IDSet -> Put) -> Encode IDSet
forall a. (a -> Put) -> Encode a
encode :: IDSet -> Put
$cencode :: IDSet -> Put
Encode)

type CV1Id = Required 1 (Value Int32)
data ConstraintV1 =
    CV1Int    CV1Id (Required 2 (Message IntConstraintV1))
  | CV1String CV1Id (Required 3 (Message StringConstraintV1))
  | CV1Date   CV1Id (Required 4 (Message DateConstraintV1))
  | CV1Symbol CV1Id (Required 5 (Message SymbolConstraintV1))
  | CV1Bytes  CV1Id (Required 6 (Message BytesConstraintV1))
    deriving stock ((forall x. ConstraintV1 -> Rep ConstraintV1 x)
-> (forall x. Rep ConstraintV1 x -> ConstraintV1)
-> Generic ConstraintV1
forall x. Rep ConstraintV1 x -> ConstraintV1
forall x. ConstraintV1 -> Rep ConstraintV1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConstraintV1 x -> ConstraintV1
$cfrom :: forall x. ConstraintV1 -> Rep ConstraintV1 x
Generic, Int -> ConstraintV1 -> ShowS
[ConstraintV1] -> ShowS
ConstraintV1 -> String
(Int -> ConstraintV1 -> ShowS)
-> (ConstraintV1 -> String)
-> ([ConstraintV1] -> ShowS)
-> Show ConstraintV1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstraintV1] -> ShowS
$cshowList :: [ConstraintV1] -> ShowS
show :: ConstraintV1 -> String
$cshow :: ConstraintV1 -> String
showsPrec :: Int -> ConstraintV1 -> ShowS
$cshowsPrec :: Int -> ConstraintV1 -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get ConstraintV1
(HashMap Tag [WireField] -> Get ConstraintV1)
-> Decode ConstraintV1
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get ConstraintV1
$cdecode :: HashMap Tag [WireField] -> Get ConstraintV1
Decode, ConstraintV1 -> Put
(ConstraintV1 -> Put) -> Encode ConstraintV1
forall a. (a -> Put) -> Encode a
encode :: ConstraintV1 -> Put
$cencode :: ConstraintV1 -> Put
Encode)

data IntConstraintV1 =
    ICV1LessThan       (Required 1 (Value Int64))
  | ICV1GreaterThan    (Required 2 (Value Int64))
  | ICV1LessOrEqual    (Required 3 (Value Int64))
  | ICV1GreaterOrEqual (Required 4 (Value Int64))
  | ICV1Equal          (Required 5 (Value Int64))
  | ICV1InSet          (Required 6 (Message IntSet))
  | ICV1NotInSet       (Required 7 (Message IntSet))
    deriving stock ((forall x. IntConstraintV1 -> Rep IntConstraintV1 x)
-> (forall x. Rep IntConstraintV1 x -> IntConstraintV1)
-> Generic IntConstraintV1
forall x. Rep IntConstraintV1 x -> IntConstraintV1
forall x. IntConstraintV1 -> Rep IntConstraintV1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IntConstraintV1 x -> IntConstraintV1
$cfrom :: forall x. IntConstraintV1 -> Rep IntConstraintV1 x
Generic, Int -> IntConstraintV1 -> ShowS
[IntConstraintV1] -> ShowS
IntConstraintV1 -> String
(Int -> IntConstraintV1 -> ShowS)
-> (IntConstraintV1 -> String)
-> ([IntConstraintV1] -> ShowS)
-> Show IntConstraintV1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntConstraintV1] -> ShowS
$cshowList :: [IntConstraintV1] -> ShowS
show :: IntConstraintV1 -> String
$cshow :: IntConstraintV1 -> String
showsPrec :: Int -> IntConstraintV1 -> ShowS
$cshowsPrec :: Int -> IntConstraintV1 -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get IntConstraintV1
(HashMap Tag [WireField] -> Get IntConstraintV1)
-> Decode IntConstraintV1
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get IntConstraintV1
$cdecode :: HashMap Tag [WireField] -> Get IntConstraintV1
Decode, IntConstraintV1 -> Put
(IntConstraintV1 -> Put) -> Encode IntConstraintV1
forall a. (a -> Put) -> Encode a
encode :: IntConstraintV1 -> Put
$cencode :: IntConstraintV1 -> Put
Encode)

newtype IntSet = IntSet
  { IntSet -> Packed 7 (Value Int64)
set :: Packed 7 (Value Int64)
  } deriving stock ((forall x. IntSet -> Rep IntSet x)
-> (forall x. Rep IntSet x -> IntSet) -> Generic IntSet
forall x. Rep IntSet x -> IntSet
forall x. IntSet -> Rep IntSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IntSet x -> IntSet
$cfrom :: forall x. IntSet -> Rep IntSet x
Generic, Int -> IntSet -> ShowS
[IntSet] -> ShowS
IntSet -> String
(Int -> IntSet -> ShowS)
-> (IntSet -> String) -> ([IntSet] -> ShowS) -> Show IntSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntSet] -> ShowS
$cshowList :: [IntSet] -> ShowS
show :: IntSet -> String
$cshow :: IntSet -> String
showsPrec :: Int -> IntSet -> ShowS
$cshowsPrec :: Int -> IntSet -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get IntSet
(HashMap Tag [WireField] -> Get IntSet) -> Decode IntSet
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get IntSet
$cdecode :: HashMap Tag [WireField] -> Get IntSet
Decode, IntSet -> Put
(IntSet -> Put) -> Encode IntSet
forall a. (a -> Put) -> Encode a
encode :: IntSet -> Put
$cencode :: IntSet -> Put
Encode)

data StringConstraintV1 =
    SCV1Prefix   (Required 1 (Value Text))
  | SCV1Suffix   (Required 2 (Value Text))
  | SCV1Equal    (Required 3 (Value Text))
  | SCV1InSet    (Required 4 (Message StringSet))
  | SCV1NotInSet (Required 5 (Message StringSet))
  | SCV1Regex    (Required 6 (Value Text))
    deriving stock ((forall x. StringConstraintV1 -> Rep StringConstraintV1 x)
-> (forall x. Rep StringConstraintV1 x -> StringConstraintV1)
-> Generic StringConstraintV1
forall x. Rep StringConstraintV1 x -> StringConstraintV1
forall x. StringConstraintV1 -> Rep StringConstraintV1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StringConstraintV1 x -> StringConstraintV1
$cfrom :: forall x. StringConstraintV1 -> Rep StringConstraintV1 x
Generic, Int -> StringConstraintV1 -> ShowS
[StringConstraintV1] -> ShowS
StringConstraintV1 -> String
(Int -> StringConstraintV1 -> ShowS)
-> (StringConstraintV1 -> String)
-> ([StringConstraintV1] -> ShowS)
-> Show StringConstraintV1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringConstraintV1] -> ShowS
$cshowList :: [StringConstraintV1] -> ShowS
show :: StringConstraintV1 -> String
$cshow :: StringConstraintV1 -> String
showsPrec :: Int -> StringConstraintV1 -> ShowS
$cshowsPrec :: Int -> StringConstraintV1 -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get StringConstraintV1
(HashMap Tag [WireField] -> Get StringConstraintV1)
-> Decode StringConstraintV1
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get StringConstraintV1
$cdecode :: HashMap Tag [WireField] -> Get StringConstraintV1
Decode, StringConstraintV1 -> Put
(StringConstraintV1 -> Put) -> Encode StringConstraintV1
forall a. (a -> Put) -> Encode a
encode :: StringConstraintV1 -> Put
$cencode :: StringConstraintV1 -> Put
Encode)

newtype StringSet = StringSet
  { StringSet -> Repeated 1 (Value Text)
set :: Repeated 1 (Value Text)
  } deriving stock ((forall x. StringSet -> Rep StringSet x)
-> (forall x. Rep StringSet x -> StringSet) -> Generic StringSet
forall x. Rep StringSet x -> StringSet
forall x. StringSet -> Rep StringSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StringSet x -> StringSet
$cfrom :: forall x. StringSet -> Rep StringSet x
Generic, Int -> StringSet -> ShowS
[StringSet] -> ShowS
StringSet -> String
(Int -> StringSet -> ShowS)
-> (StringSet -> String)
-> ([StringSet] -> ShowS)
-> Show StringSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringSet] -> ShowS
$cshowList :: [StringSet] -> ShowS
show :: StringSet -> String
$cshow :: StringSet -> String
showsPrec :: Int -> StringSet -> ShowS
$cshowsPrec :: Int -> StringSet -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get StringSet
(HashMap Tag [WireField] -> Get StringSet) -> Decode StringSet
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get StringSet
$cdecode :: HashMap Tag [WireField] -> Get StringSet
Decode, StringSet -> Put
(StringSet -> Put) -> Encode StringSet
forall a. (a -> Put) -> Encode a
encode :: StringSet -> Put
$cencode :: StringSet -> Put
Encode)

data DateConstraintV1 =
    DCV1Before (Required 1 (Value Int64))
  | DCV1After  (Required 2 (Value Int64))
    deriving stock ((forall x. DateConstraintV1 -> Rep DateConstraintV1 x)
-> (forall x. Rep DateConstraintV1 x -> DateConstraintV1)
-> Generic DateConstraintV1
forall x. Rep DateConstraintV1 x -> DateConstraintV1
forall x. DateConstraintV1 -> Rep DateConstraintV1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DateConstraintV1 x -> DateConstraintV1
$cfrom :: forall x. DateConstraintV1 -> Rep DateConstraintV1 x
Generic, Int -> DateConstraintV1 -> ShowS
[DateConstraintV1] -> ShowS
DateConstraintV1 -> String
(Int -> DateConstraintV1 -> ShowS)
-> (DateConstraintV1 -> String)
-> ([DateConstraintV1] -> ShowS)
-> Show DateConstraintV1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DateConstraintV1] -> ShowS
$cshowList :: [DateConstraintV1] -> ShowS
show :: DateConstraintV1 -> String
$cshow :: DateConstraintV1 -> String
showsPrec :: Int -> DateConstraintV1 -> ShowS
$cshowsPrec :: Int -> DateConstraintV1 -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get DateConstraintV1
(HashMap Tag [WireField] -> Get DateConstraintV1)
-> Decode DateConstraintV1
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get DateConstraintV1
$cdecode :: HashMap Tag [WireField] -> Get DateConstraintV1
Decode, DateConstraintV1 -> Put
(DateConstraintV1 -> Put) -> Encode DateConstraintV1
forall a. (a -> Put) -> Encode a
encode :: DateConstraintV1 -> Put
$cencode :: DateConstraintV1 -> Put
Encode)

data SymbolConstraintV1 =
    SyCV1InSet    (Required 1 (Message SymbolSet))
  | SyCV1NotInSet (Required 2 (Message SymbolSet))
    deriving stock ((forall x. SymbolConstraintV1 -> Rep SymbolConstraintV1 x)
-> (forall x. Rep SymbolConstraintV1 x -> SymbolConstraintV1)
-> Generic SymbolConstraintV1
forall x. Rep SymbolConstraintV1 x -> SymbolConstraintV1
forall x. SymbolConstraintV1 -> Rep SymbolConstraintV1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SymbolConstraintV1 x -> SymbolConstraintV1
$cfrom :: forall x. SymbolConstraintV1 -> Rep SymbolConstraintV1 x
Generic, Int -> SymbolConstraintV1 -> ShowS
[SymbolConstraintV1] -> ShowS
SymbolConstraintV1 -> String
(Int -> SymbolConstraintV1 -> ShowS)
-> (SymbolConstraintV1 -> String)
-> ([SymbolConstraintV1] -> ShowS)
-> Show SymbolConstraintV1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SymbolConstraintV1] -> ShowS
$cshowList :: [SymbolConstraintV1] -> ShowS
show :: SymbolConstraintV1 -> String
$cshow :: SymbolConstraintV1 -> String
showsPrec :: Int -> SymbolConstraintV1 -> ShowS
$cshowsPrec :: Int -> SymbolConstraintV1 -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get SymbolConstraintV1
(HashMap Tag [WireField] -> Get SymbolConstraintV1)
-> Decode SymbolConstraintV1
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get SymbolConstraintV1
$cdecode :: HashMap Tag [WireField] -> Get SymbolConstraintV1
Decode, SymbolConstraintV1 -> Put
(SymbolConstraintV1 -> Put) -> Encode SymbolConstraintV1
forall a. (a -> Put) -> Encode a
encode :: SymbolConstraintV1 -> Put
$cencode :: SymbolConstraintV1 -> Put
Encode)

newtype SymbolSet = SymbolSet
  { SymbolSet -> Packed 1 (Value Int64)
set :: Packed 1 (Value Int64)
  } deriving stock ((forall x. SymbolSet -> Rep SymbolSet x)
-> (forall x. Rep SymbolSet x -> SymbolSet) -> Generic SymbolSet
forall x. Rep SymbolSet x -> SymbolSet
forall x. SymbolSet -> Rep SymbolSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SymbolSet x -> SymbolSet
$cfrom :: forall x. SymbolSet -> Rep SymbolSet x
Generic, Int -> SymbolSet -> ShowS
[SymbolSet] -> ShowS
SymbolSet -> String
(Int -> SymbolSet -> ShowS)
-> (SymbolSet -> String)
-> ([SymbolSet] -> ShowS)
-> Show SymbolSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SymbolSet] -> ShowS
$cshowList :: [SymbolSet] -> ShowS
show :: SymbolSet -> String
$cshow :: SymbolSet -> String
showsPrec :: Int -> SymbolSet -> ShowS
$cshowsPrec :: Int -> SymbolSet -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get SymbolSet
(HashMap Tag [WireField] -> Get SymbolSet) -> Decode SymbolSet
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get SymbolSet
$cdecode :: HashMap Tag [WireField] -> Get SymbolSet
Decode, SymbolSet -> Put
(SymbolSet -> Put) -> Encode SymbolSet
forall a. (a -> Put) -> Encode a
encode :: SymbolSet -> Put
$cencode :: SymbolSet -> Put
Encode)


data BytesConstraintV1 =
    BCV1Equal    (Required 1 (Value ByteString))
  | BCV1InSet    (Required 2 (Message BytesSet))
  | BCV1NotInSet (Required 3 (Message BytesSet))
    deriving stock ((forall x. BytesConstraintV1 -> Rep BytesConstraintV1 x)
-> (forall x. Rep BytesConstraintV1 x -> BytesConstraintV1)
-> Generic BytesConstraintV1
forall x. Rep BytesConstraintV1 x -> BytesConstraintV1
forall x. BytesConstraintV1 -> Rep BytesConstraintV1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BytesConstraintV1 x -> BytesConstraintV1
$cfrom :: forall x. BytesConstraintV1 -> Rep BytesConstraintV1 x
Generic, Int -> BytesConstraintV1 -> ShowS
[BytesConstraintV1] -> ShowS
BytesConstraintV1 -> String
(Int -> BytesConstraintV1 -> ShowS)
-> (BytesConstraintV1 -> String)
-> ([BytesConstraintV1] -> ShowS)
-> Show BytesConstraintV1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BytesConstraintV1] -> ShowS
$cshowList :: [BytesConstraintV1] -> ShowS
show :: BytesConstraintV1 -> String
$cshow :: BytesConstraintV1 -> String
showsPrec :: Int -> BytesConstraintV1 -> ShowS
$cshowsPrec :: Int -> BytesConstraintV1 -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get BytesConstraintV1
(HashMap Tag [WireField] -> Get BytesConstraintV1)
-> Decode BytesConstraintV1
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get BytesConstraintV1
$cdecode :: HashMap Tag [WireField] -> Get BytesConstraintV1
Decode, BytesConstraintV1 -> Put
(BytesConstraintV1 -> Put) -> Encode BytesConstraintV1
forall a. (a -> Put) -> Encode a
encode :: BytesConstraintV1 -> Put
$cencode :: BytesConstraintV1 -> Put
Encode)

newtype BytesSet = BytesSet
  { BytesSet -> Repeated 1 (Value ByteString)
set :: Repeated 1 (Value ByteString)
  } deriving stock ((forall x. BytesSet -> Rep BytesSet x)
-> (forall x. Rep BytesSet x -> BytesSet) -> Generic BytesSet
forall x. Rep BytesSet x -> BytesSet
forall x. BytesSet -> Rep BytesSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BytesSet x -> BytesSet
$cfrom :: forall x. BytesSet -> Rep BytesSet x
Generic, Int -> BytesSet -> ShowS
[BytesSet] -> ShowS
BytesSet -> String
(Int -> BytesSet -> ShowS)
-> (BytesSet -> String) -> ([BytesSet] -> ShowS) -> Show BytesSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BytesSet] -> ShowS
$cshowList :: [BytesSet] -> ShowS
show :: BytesSet -> String
$cshow :: BytesSet -> String
showsPrec :: Int -> BytesSet -> ShowS
$cshowsPrec :: Int -> BytesSet -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get BytesSet
(HashMap Tag [WireField] -> Get BytesSet) -> Decode BytesSet
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get BytesSet
$cdecode :: HashMap Tag [WireField] -> Get BytesSet
Decode, BytesSet -> Put
(BytesSet -> Put) -> Encode BytesSet
forall a. (a -> Put) -> Encode a
encode :: BytesSet -> Put
$cencode :: BytesSet -> Put
Encode)

newtype ExpressionV1 = ExpressionV1
  { ExpressionV1 -> Repeated 1 (Message Op)
ops :: Repeated 1 (Message Op)
  } deriving stock ((forall x. ExpressionV1 -> Rep ExpressionV1 x)
-> (forall x. Rep ExpressionV1 x -> ExpressionV1)
-> Generic ExpressionV1
forall x. Rep ExpressionV1 x -> ExpressionV1
forall x. ExpressionV1 -> Rep ExpressionV1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExpressionV1 x -> ExpressionV1
$cfrom :: forall x. ExpressionV1 -> Rep ExpressionV1 x
Generic, Int -> ExpressionV1 -> ShowS
[ExpressionV1] -> ShowS
ExpressionV1 -> String
(Int -> ExpressionV1 -> ShowS)
-> (ExpressionV1 -> String)
-> ([ExpressionV1] -> ShowS)
-> Show ExpressionV1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpressionV1] -> ShowS
$cshowList :: [ExpressionV1] -> ShowS
show :: ExpressionV1 -> String
$cshow :: ExpressionV1 -> String
showsPrec :: Int -> ExpressionV1 -> ShowS
$cshowsPrec :: Int -> ExpressionV1 -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get ExpressionV1
(HashMap Tag [WireField] -> Get ExpressionV1)
-> Decode ExpressionV1
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get ExpressionV1
$cdecode :: HashMap Tag [WireField] -> Get ExpressionV1
Decode, ExpressionV1 -> Put
(ExpressionV1 -> Put) -> Encode ExpressionV1
forall a. (a -> Put) -> Encode a
encode :: ExpressionV1 -> Put
$cencode :: ExpressionV1 -> Put
Encode)

data Op =
    OpVValue  (Required 1 (Message IDV1))
  | OpVUnary  (Required 2 (Message OpUnary))
  | OpVBinary (Required 3 (Message OpBinary))
    deriving stock ((forall x. Op -> Rep Op x)
-> (forall x. Rep Op x -> Op) -> Generic Op
forall x. Rep Op x -> Op
forall x. Op -> Rep Op x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Op x -> Op
$cfrom :: forall x. Op -> Rep Op x
Generic, Int -> Op -> ShowS
[Op] -> ShowS
Op -> String
(Int -> Op -> ShowS)
-> (Op -> String) -> ([Op] -> ShowS) -> Show Op
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Op] -> ShowS
$cshowList :: [Op] -> ShowS
show :: Op -> String
$cshow :: Op -> String
showsPrec :: Int -> Op -> ShowS
$cshowsPrec :: Int -> Op -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get Op
(HashMap Tag [WireField] -> Get Op) -> Decode Op
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get Op
$cdecode :: HashMap Tag [WireField] -> Get Op
Decode, Op -> Put
(Op -> Put) -> Encode Op
forall a. (a -> Put) -> Encode a
encode :: Op -> Put
$cencode :: Op -> Put
Encode)

data UnaryKind = Negate | Parens | Length
  deriving stock (Int -> UnaryKind -> ShowS
[UnaryKind] -> ShowS
UnaryKind -> String
(Int -> UnaryKind -> ShowS)
-> (UnaryKind -> String)
-> ([UnaryKind] -> ShowS)
-> Show UnaryKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnaryKind] -> ShowS
$cshowList :: [UnaryKind] -> ShowS
show :: UnaryKind -> String
$cshow :: UnaryKind -> String
showsPrec :: Int -> UnaryKind -> ShowS
$cshowsPrec :: Int -> UnaryKind -> ShowS
Show, Int -> UnaryKind
UnaryKind -> Int
UnaryKind -> [UnaryKind]
UnaryKind -> UnaryKind
UnaryKind -> UnaryKind -> [UnaryKind]
UnaryKind -> UnaryKind -> UnaryKind -> [UnaryKind]
(UnaryKind -> UnaryKind)
-> (UnaryKind -> UnaryKind)
-> (Int -> UnaryKind)
-> (UnaryKind -> Int)
-> (UnaryKind -> [UnaryKind])
-> (UnaryKind -> UnaryKind -> [UnaryKind])
-> (UnaryKind -> UnaryKind -> [UnaryKind])
-> (UnaryKind -> UnaryKind -> UnaryKind -> [UnaryKind])
-> Enum UnaryKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UnaryKind -> UnaryKind -> UnaryKind -> [UnaryKind]
$cenumFromThenTo :: UnaryKind -> UnaryKind -> UnaryKind -> [UnaryKind]
enumFromTo :: UnaryKind -> UnaryKind -> [UnaryKind]
$cenumFromTo :: UnaryKind -> UnaryKind -> [UnaryKind]
enumFromThen :: UnaryKind -> UnaryKind -> [UnaryKind]
$cenumFromThen :: UnaryKind -> UnaryKind -> [UnaryKind]
enumFrom :: UnaryKind -> [UnaryKind]
$cenumFrom :: UnaryKind -> [UnaryKind]
fromEnum :: UnaryKind -> Int
$cfromEnum :: UnaryKind -> Int
toEnum :: Int -> UnaryKind
$ctoEnum :: Int -> UnaryKind
pred :: UnaryKind -> UnaryKind
$cpred :: UnaryKind -> UnaryKind
succ :: UnaryKind -> UnaryKind
$csucc :: UnaryKind -> UnaryKind
Enum, UnaryKind
UnaryKind -> UnaryKind -> Bounded UnaryKind
forall a. a -> a -> Bounded a
maxBound :: UnaryKind
$cmaxBound :: UnaryKind
minBound :: UnaryKind
$cminBound :: UnaryKind
Bounded)

newtype OpUnary = OpUnary
  { OpUnary -> Required 1 (Enumeration UnaryKind)
kind :: Required 1 (Enumeration UnaryKind)
  } deriving stock ((forall x. OpUnary -> Rep OpUnary x)
-> (forall x. Rep OpUnary x -> OpUnary) -> Generic OpUnary
forall x. Rep OpUnary x -> OpUnary
forall x. OpUnary -> Rep OpUnary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OpUnary x -> OpUnary
$cfrom :: forall x. OpUnary -> Rep OpUnary x
Generic, Int -> OpUnary -> ShowS
[OpUnary] -> ShowS
OpUnary -> String
(Int -> OpUnary -> ShowS)
-> (OpUnary -> String) -> ([OpUnary] -> ShowS) -> Show OpUnary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpUnary] -> ShowS
$cshowList :: [OpUnary] -> ShowS
show :: OpUnary -> String
$cshow :: OpUnary -> String
showsPrec :: Int -> OpUnary -> ShowS
$cshowsPrec :: Int -> OpUnary -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get OpUnary
(HashMap Tag [WireField] -> Get OpUnary) -> Decode OpUnary
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get OpUnary
$cdecode :: HashMap Tag [WireField] -> Get OpUnary
Decode, OpUnary -> Put
(OpUnary -> Put) -> Encode OpUnary
forall a. (a -> Put) -> Encode a
encode :: OpUnary -> Put
$cencode :: OpUnary -> Put
Encode)

data BinaryKind =
    LessThan
  | GreaterThan
  | LessOrEqual
  | GreaterOrEqual
  | Equal
  | Contains
  | Prefix
  | Suffix
  | Regex
  | Add
  | Sub
  | Mul
  | Div
  | And
  | Or
  | Intersection
  | Union
  deriving stock (Int -> BinaryKind -> ShowS
[BinaryKind] -> ShowS
BinaryKind -> String
(Int -> BinaryKind -> ShowS)
-> (BinaryKind -> String)
-> ([BinaryKind] -> ShowS)
-> Show BinaryKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinaryKind] -> ShowS
$cshowList :: [BinaryKind] -> ShowS
show :: BinaryKind -> String
$cshow :: BinaryKind -> String
showsPrec :: Int -> BinaryKind -> ShowS
$cshowsPrec :: Int -> BinaryKind -> ShowS
Show, Int -> BinaryKind
BinaryKind -> Int
BinaryKind -> [BinaryKind]
BinaryKind -> BinaryKind
BinaryKind -> BinaryKind -> [BinaryKind]
BinaryKind -> BinaryKind -> BinaryKind -> [BinaryKind]
(BinaryKind -> BinaryKind)
-> (BinaryKind -> BinaryKind)
-> (Int -> BinaryKind)
-> (BinaryKind -> Int)
-> (BinaryKind -> [BinaryKind])
-> (BinaryKind -> BinaryKind -> [BinaryKind])
-> (BinaryKind -> BinaryKind -> [BinaryKind])
-> (BinaryKind -> BinaryKind -> BinaryKind -> [BinaryKind])
-> Enum BinaryKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BinaryKind -> BinaryKind -> BinaryKind -> [BinaryKind]
$cenumFromThenTo :: BinaryKind -> BinaryKind -> BinaryKind -> [BinaryKind]
enumFromTo :: BinaryKind -> BinaryKind -> [BinaryKind]
$cenumFromTo :: BinaryKind -> BinaryKind -> [BinaryKind]
enumFromThen :: BinaryKind -> BinaryKind -> [BinaryKind]
$cenumFromThen :: BinaryKind -> BinaryKind -> [BinaryKind]
enumFrom :: BinaryKind -> [BinaryKind]
$cenumFrom :: BinaryKind -> [BinaryKind]
fromEnum :: BinaryKind -> Int
$cfromEnum :: BinaryKind -> Int
toEnum :: Int -> BinaryKind
$ctoEnum :: Int -> BinaryKind
pred :: BinaryKind -> BinaryKind
$cpred :: BinaryKind -> BinaryKind
succ :: BinaryKind -> BinaryKind
$csucc :: BinaryKind -> BinaryKind
Enum, BinaryKind
BinaryKind -> BinaryKind -> Bounded BinaryKind
forall a. a -> a -> Bounded a
maxBound :: BinaryKind
$cmaxBound :: BinaryKind
minBound :: BinaryKind
$cminBound :: BinaryKind
Bounded)

newtype OpBinary = OpBinary
  { OpBinary -> Required 1 (Enumeration BinaryKind)
kind :: Required 1 (Enumeration BinaryKind)
  } deriving stock ((forall x. OpBinary -> Rep OpBinary x)
-> (forall x. Rep OpBinary x -> OpBinary) -> Generic OpBinary
forall x. Rep OpBinary x -> OpBinary
forall x. OpBinary -> Rep OpBinary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OpBinary x -> OpBinary
$cfrom :: forall x. OpBinary -> Rep OpBinary x
Generic, Int -> OpBinary -> ShowS
[OpBinary] -> ShowS
OpBinary -> String
(Int -> OpBinary -> ShowS)
-> (OpBinary -> String) -> ([OpBinary] -> ShowS) -> Show OpBinary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpBinary] -> ShowS
$cshowList :: [OpBinary] -> ShowS
show :: OpBinary -> String
$cshow :: OpBinary -> String
showsPrec :: Int -> OpBinary -> ShowS
$cshowsPrec :: Int -> OpBinary -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get OpBinary
(HashMap Tag [WireField] -> Get OpBinary) -> Decode OpBinary
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get OpBinary
$cdecode :: HashMap Tag [WireField] -> Get OpBinary
Decode, OpBinary -> Put
(OpBinary -> Put) -> Encode OpBinary
forall a. (a -> Put) -> Encode a
encode :: OpBinary -> Put
$cencode :: OpBinary -> Put
Encode)

data PolicyKind = Allow | Deny
  deriving stock (Int -> PolicyKind -> ShowS
[PolicyKind] -> ShowS
PolicyKind -> String
(Int -> PolicyKind -> ShowS)
-> (PolicyKind -> String)
-> ([PolicyKind] -> ShowS)
-> Show PolicyKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PolicyKind] -> ShowS
$cshowList :: [PolicyKind] -> ShowS
show :: PolicyKind -> String
$cshow :: PolicyKind -> String
showsPrec :: Int -> PolicyKind -> ShowS
$cshowsPrec :: Int -> PolicyKind -> ShowS
Show, Int -> PolicyKind
PolicyKind -> Int
PolicyKind -> [PolicyKind]
PolicyKind -> PolicyKind
PolicyKind -> PolicyKind -> [PolicyKind]
PolicyKind -> PolicyKind -> PolicyKind -> [PolicyKind]
(PolicyKind -> PolicyKind)
-> (PolicyKind -> PolicyKind)
-> (Int -> PolicyKind)
-> (PolicyKind -> Int)
-> (PolicyKind -> [PolicyKind])
-> (PolicyKind -> PolicyKind -> [PolicyKind])
-> (PolicyKind -> PolicyKind -> [PolicyKind])
-> (PolicyKind -> PolicyKind -> PolicyKind -> [PolicyKind])
-> Enum PolicyKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PolicyKind -> PolicyKind -> PolicyKind -> [PolicyKind]
$cenumFromThenTo :: PolicyKind -> PolicyKind -> PolicyKind -> [PolicyKind]
enumFromTo :: PolicyKind -> PolicyKind -> [PolicyKind]
$cenumFromTo :: PolicyKind -> PolicyKind -> [PolicyKind]
enumFromThen :: PolicyKind -> PolicyKind -> [PolicyKind]
$cenumFromThen :: PolicyKind -> PolicyKind -> [PolicyKind]
enumFrom :: PolicyKind -> [PolicyKind]
$cenumFrom :: PolicyKind -> [PolicyKind]
fromEnum :: PolicyKind -> Int
$cfromEnum :: PolicyKind -> Int
toEnum :: Int -> PolicyKind
$ctoEnum :: Int -> PolicyKind
pred :: PolicyKind -> PolicyKind
$cpred :: PolicyKind -> PolicyKind
succ :: PolicyKind -> PolicyKind
$csucc :: PolicyKind -> PolicyKind
Enum, PolicyKind
PolicyKind -> PolicyKind -> Bounded PolicyKind
forall a. a -> a -> Bounded a
maxBound :: PolicyKind
$cmaxBound :: PolicyKind
minBound :: PolicyKind
$cminBound :: PolicyKind
Bounded)

data Policy = Policy
  { Policy -> Repeated 1 (Message RuleV1)
queries :: Repeated 1 (Message RuleV1)
  , Policy -> Required 2 (Enumeration PolicyKind)
kind    :: Required 2 (Enumeration PolicyKind)
  } deriving stock ((forall x. Policy -> Rep Policy x)
-> (forall x. Rep Policy x -> Policy) -> Generic Policy
forall x. Rep Policy x -> Policy
forall x. Policy -> Rep Policy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Policy x -> Policy
$cfrom :: forall x. Policy -> Rep Policy x
Generic, Int -> Policy -> ShowS
[Policy] -> ShowS
Policy -> String
(Int -> Policy -> ShowS)
-> (Policy -> String) -> ([Policy] -> ShowS) -> Show Policy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Policy] -> ShowS
$cshowList :: [Policy] -> ShowS
show :: Policy -> String
$cshow :: Policy -> String
showsPrec :: Int -> Policy -> ShowS
$cshowsPrec :: Int -> Policy -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get Policy
(HashMap Tag [WireField] -> Get Policy) -> Decode Policy
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get Policy
$cdecode :: HashMap Tag [WireField] -> Get Policy
Decode, Policy -> Put
(Policy -> Put) -> Encode Policy
forall a. (a -> Put) -> Encode a
encode :: Policy -> Put
$cencode :: Policy -> Put
Encode)

data VerifierPolicies = VerifierPolicies
  { VerifierPolicies -> Repeated 1 (Value Text)
symbols  :: Repeated 1 (Value Text)
  , VerifierPolicies -> Optional 2 (Value Int32)
version  :: Optional 2 (Value Int32)
  , VerifierPolicies -> Repeated 3 (Message FactV1)
facts    :: Repeated 3 (Message FactV1)
  , VerifierPolicies -> Repeated 4 (Message RuleV1)
rules    :: Repeated 4 (Message RuleV1)
  , VerifierPolicies -> Repeated 5 (Message CheckV1)
checks   :: Repeated 5 (Message CheckV1)
  , VerifierPolicies -> Repeated 6 (Message Policy)
policies :: Repeated 6 (Message Policy)
  } deriving stock ((forall x. VerifierPolicies -> Rep VerifierPolicies x)
-> (forall x. Rep VerifierPolicies x -> VerifierPolicies)
-> Generic VerifierPolicies
forall x. Rep VerifierPolicies x -> VerifierPolicies
forall x. VerifierPolicies -> Rep VerifierPolicies x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VerifierPolicies x -> VerifierPolicies
$cfrom :: forall x. VerifierPolicies -> Rep VerifierPolicies x
Generic, Int -> VerifierPolicies -> ShowS
[VerifierPolicies] -> ShowS
VerifierPolicies -> String
(Int -> VerifierPolicies -> ShowS)
-> (VerifierPolicies -> String)
-> ([VerifierPolicies] -> ShowS)
-> Show VerifierPolicies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerifierPolicies] -> ShowS
$cshowList :: [VerifierPolicies] -> ShowS
show :: VerifierPolicies -> String
$cshow :: VerifierPolicies -> String
showsPrec :: Int -> VerifierPolicies -> ShowS
$cshowsPrec :: Int -> VerifierPolicies -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get VerifierPolicies
(HashMap Tag [WireField] -> Get VerifierPolicies)
-> Decode VerifierPolicies
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get VerifierPolicies
$cdecode :: HashMap Tag [WireField] -> Get VerifierPolicies
Decode, VerifierPolicies -> Put
(VerifierPolicies -> Put) -> Encode VerifierPolicies
forall a. (a -> Put) -> Encode a
encode :: VerifierPolicies -> Put
$cencode :: VerifierPolicies -> Put
Encode)

decodeBlockList :: ByteString
                -> Either String Biscuit
decodeBlockList :: ByteString -> Either String Biscuit
decodeBlockList = Get Biscuit -> ByteString -> Either String Biscuit
forall a. Get a -> ByteString -> Either String a
runGet Get Biscuit
forall a. Decode a => Get a
decodeMessage

decodeBlock :: ByteString
            -> Either String Block
decodeBlock :: ByteString -> Either String Block
decodeBlock = Get Block -> ByteString -> Either String Block
forall a. Get a -> ByteString -> Either String a
runGet Get Block
forall a. Decode a => Get a
decodeMessage

encodeBlockList :: Biscuit -> ByteString
encodeBlockList :: Biscuit -> ByteString
encodeBlockList = Put -> ByteString
runPut (Put -> ByteString) -> (Biscuit -> Put) -> Biscuit -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Biscuit -> Put
forall a. Encode a => a -> Put
encodeMessage

encodeBlock :: Block -> ByteString
encodeBlock :: Block -> ByteString
encodeBlock = Put -> ByteString
runPut (Put -> ByteString) -> (Block -> Put) -> Block -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Put
forall a. Encode a => a -> Put
encodeMessage