{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
module Auth.Biscuit.ProtoBufAdapter
( Symbols
, buildSymbolTable
, pbToBlock
, blockToPb
, pbToSignedBlock
, signedBlockToPb
, pbToProof
, pbToThirdPartyBlockRequest
, thirdPartyBlockRequestToPb
, pbToThirdPartyBlockContents
, thirdPartyBlockContentsToPb
) where
import Control.Monad (when)
import Control.Monad.State (StateT, get, lift, modify)
import Data.Bitraversable (bisequence)
import Data.ByteString (ByteString)
import Data.Int (Int64)
import qualified Data.List.NonEmpty as NE
import Data.Maybe (isNothing)
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime,
utcTimeToPOSIXSeconds)
import Data.Void (absurd)
import GHC.Records (getField)
import Validation (Validation (..))
import qualified Auth.Biscuit.Crypto as Crypto
import Auth.Biscuit.Datalog.AST
import qualified Auth.Biscuit.Proto as PB
import Auth.Biscuit.Symbols
import Auth.Biscuit.Utils (maybeToRight)
buildSymbolTable :: Symbols -> Block -> BlockSymbols
buildSymbolTable :: Symbols -> Block -> BlockSymbols
buildSymbolTable Symbols
existingSymbols Block
block =
let allSymbols :: Set Text
allSymbols = Block -> Set Text
listSymbolsInBlock Block
block
allKeys :: Set PublicKey
allKeys = Block -> Set PublicKey
listPublicKeysInBlock Block
block
in Symbols -> Set Text -> Set PublicKey -> BlockSymbols
addSymbols Symbols
existingSymbols Set Text
allSymbols Set PublicKey
allKeys
pbToPublicKey :: PB.PublicKey -> Either String Crypto.PublicKey
pbToPublicKey :: PublicKey -> Either String PublicKey
pbToPublicKey PB.PublicKey{Required 1 (Enumeration Algorithm)
Required 2 (Value ByteString)
algorithm :: Required 1 (Enumeration Algorithm)
key :: Required 2 (Value ByteString)
$sel:algorithm:PublicKey :: PublicKey -> Required 1 (Enumeration Algorithm)
$sel:key:PublicKey :: PublicKey -> Required 2 (Value ByteString)
..} =
let keyBytes :: FieldType (Field 2 (RequiredField (Always (Value ByteString))))
keyBytes = Field 2 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 2 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Value ByteString)
Field 2 (RequiredField (Always (Value ByteString)))
key
parseKey :: ByteString -> Maybe PublicKey
parseKey = ByteString -> Maybe PublicKey
Crypto.readEd25519PublicKey
in case Field 1 (RequiredField (Always (Enumeration Algorithm)))
-> FieldType
(Field 1 (RequiredField (Always (Enumeration Algorithm))))
forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Enumeration Algorithm)
Field 1 (RequiredField (Always (Enumeration Algorithm)))
algorithm of
FieldType
(Field 1 (RequiredField (Always (Enumeration Algorithm))))
Algorithm
PB.Ed25519 -> String -> Maybe PublicKey -> Either String PublicKey
forall b a. b -> Maybe a -> Either b a
maybeToRight String
"Invalid ed25519 public key" (Maybe PublicKey -> Either String PublicKey)
-> Maybe PublicKey -> Either String PublicKey
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe PublicKey
parseKey ByteString
keyBytes
pbToOptionalSignature :: PB.ExternalSig -> Either String (Crypto.Signature, Crypto.PublicKey)
pbToOptionalSignature :: ExternalSig -> Either String (Signature, PublicKey)
pbToOptionalSignature PB.ExternalSig{Required 1 (Value ByteString)
Required 2 (Message PublicKey)
signature :: Required 1 (Value ByteString)
publicKey :: Required 2 (Message PublicKey)
$sel:signature:ExternalSig :: ExternalSig -> Required 1 (Value ByteString)
$sel:publicKey:ExternalSig :: ExternalSig -> Required 2 (Message PublicKey)
..} = do
let sig :: Signature
sig = ByteString -> Signature
Crypto.signature (ByteString -> Signature) -> ByteString -> Signature
forall a b. (a -> b) -> a -> b
$ Field 1 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 1 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Value ByteString)
Field 1 (RequiredField (Always (Value ByteString)))
signature
PublicKey
pk <- PublicKey -> Either String PublicKey
pbToPublicKey (PublicKey -> Either String PublicKey)
-> PublicKey -> Either String PublicKey
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Message PublicKey)))
-> FieldType (Field 2 (RequiredField (Always (Message PublicKey))))
forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Message PublicKey)
Field 2 (RequiredField (Always (Message PublicKey)))
publicKey
(Signature, PublicKey) -> Either String (Signature, PublicKey)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signature
sig, PublicKey
pk)
pbToSignedBlock :: PB.SignedBlock -> Either String Crypto.SignedBlock
pbToSignedBlock :: SignedBlock -> Either String SignedBlock
pbToSignedBlock PB.SignedBlock{Required 1 (Value ByteString)
Required 2 (Message PublicKey)
Required 3 (Value ByteString)
Optional 4 (Message ExternalSig)
block :: Required 1 (Value ByteString)
nextKey :: Required 2 (Message PublicKey)
signature :: Required 3 (Value ByteString)
externalSig :: Optional 4 (Message ExternalSig)
$sel:block:SignedBlock :: SignedBlock -> Required 1 (Value ByteString)
$sel:nextKey:SignedBlock :: SignedBlock -> Required 2 (Message PublicKey)
$sel:signature:SignedBlock :: SignedBlock -> Required 3 (Value ByteString)
$sel:externalSig:SignedBlock :: SignedBlock -> Optional 4 (Message ExternalSig)
..} = do
let sig :: Signature
sig = ByteString -> Signature
Crypto.signature (ByteString -> Signature) -> ByteString -> Signature
forall a b. (a -> b) -> a -> b
$ Field 3 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 3 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Required 3 (Value ByteString)
Field 3 (RequiredField (Always (Value ByteString)))
signature
Maybe (Signature, PublicKey)
mSig <- (ExternalSig -> Either String (Signature, PublicKey))
-> Maybe ExternalSig
-> Either String (Maybe (Signature, PublicKey))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ExternalSig -> Either String (Signature, PublicKey)
pbToOptionalSignature (Maybe ExternalSig -> Either String (Maybe (Signature, PublicKey)))
-> Maybe ExternalSig
-> Either String (Maybe (Signature, PublicKey))
forall a b. (a -> b) -> a -> b
$ Field 4 (OptionalField (Maybe (Message ExternalSig)))
-> FieldType
(Field 4 (OptionalField (Maybe (Message ExternalSig))))
forall a. HasField a => a -> FieldType a
PB.getField Optional 4 (Message ExternalSig)
Field 4 (OptionalField (Maybe (Message ExternalSig)))
externalSig
PublicKey
pk <- PublicKey -> Either String PublicKey
pbToPublicKey (PublicKey -> Either String PublicKey)
-> PublicKey -> Either String PublicKey
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Message PublicKey)))
-> FieldType (Field 2 (RequiredField (Always (Message PublicKey))))
forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Message PublicKey)
Field 2 (RequiredField (Always (Message PublicKey)))
nextKey
SignedBlock -> Either String SignedBlock
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( Field 1 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 1 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Value ByteString)
Field 1 (RequiredField (Always (Value ByteString)))
block
, Signature
sig
, PublicKey
pk
, Maybe (Signature, PublicKey)
mSig
)
publicKeyToPb :: Crypto.PublicKey -> PB.PublicKey
publicKeyToPb :: PublicKey -> PublicKey
publicKeyToPb PublicKey
pk = PB.PublicKey
{ $sel:algorithm:PublicKey :: Required 1 (Enumeration Algorithm)
algorithm = FieldType
(Field 1 (RequiredField (Always (Enumeration Algorithm))))
-> Field 1 (RequiredField (Always (Enumeration Algorithm)))
forall a. HasField a => FieldType a -> a
PB.putField FieldType
(Field 1 (RequiredField (Always (Enumeration Algorithm))))
Algorithm
PB.Ed25519
, $sel:key:PublicKey :: Required 2 (Value ByteString)
key = FieldType (Required 2 (Value ByteString))
-> Required 2 (Value ByteString)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 2 (Value ByteString))
-> Required 2 (Value ByteString))
-> FieldType (Required 2 (Value ByteString))
-> Required 2 (Value ByteString)
forall a b. (a -> b) -> a -> b
$ PublicKey -> ByteString
Crypto.pkBytes PublicKey
pk
}
externalSigToPb :: (Crypto.Signature, Crypto.PublicKey) -> PB.ExternalSig
externalSigToPb :: (Signature, PublicKey) -> ExternalSig
externalSigToPb (Signature
sig, PublicKey
pk) = PB.ExternalSig
{ $sel:signature:ExternalSig :: Required 1 (Value ByteString)
signature = FieldType (Required 1 (Value ByteString))
-> Required 1 (Value ByteString)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 1 (Value ByteString))
-> Required 1 (Value ByteString))
-> FieldType (Required 1 (Value ByteString))
-> Required 1 (Value ByteString)
forall a b. (a -> b) -> a -> b
$ Signature -> ByteString
Crypto.sigBytes Signature
sig
, $sel:publicKey:ExternalSig :: Required 2 (Message PublicKey)
publicKey = FieldType (Required 2 (Message PublicKey))
-> Required 2 (Message PublicKey)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 2 (Message PublicKey))
-> Required 2 (Message PublicKey))
-> FieldType (Required 2 (Message PublicKey))
-> Required 2 (Message PublicKey)
forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey
publicKeyToPb PublicKey
pk
}
signedBlockToPb :: Crypto.SignedBlock -> PB.SignedBlock
signedBlockToPb :: SignedBlock -> SignedBlock
signedBlockToPb (ByteString
block, Signature
sig, PublicKey
pk, Maybe (Signature, PublicKey)
eSig) = PB.SignedBlock
{ $sel:block:SignedBlock :: Required 1 (Value ByteString)
block = FieldType (Field 1 (RequiredField (Always (Value ByteString))))
-> Field 1 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
PB.putField ByteString
FieldType (Field 1 (RequiredField (Always (Value ByteString))))
block
, $sel:signature:SignedBlock :: Required 3 (Value ByteString)
signature = FieldType (Required 3 (Value ByteString))
-> Required 3 (Value ByteString)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 3 (Value ByteString))
-> Required 3 (Value ByteString))
-> FieldType (Required 3 (Value ByteString))
-> Required 3 (Value ByteString)
forall a b. (a -> b) -> a -> b
$ Signature -> ByteString
Crypto.sigBytes Signature
sig
, $sel:nextKey:SignedBlock :: Required 2 (Message PublicKey)
nextKey = FieldType (Required 2 (Message PublicKey))
-> Required 2 (Message PublicKey)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 2 (Message PublicKey))
-> Required 2 (Message PublicKey))
-> FieldType (Required 2 (Message PublicKey))
-> Required 2 (Message PublicKey)
forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey
publicKeyToPb PublicKey
pk
, $sel:externalSig:SignedBlock :: Optional 4 (Message ExternalSig)
externalSig = FieldType (Optional 4 (Message ExternalSig))
-> Optional 4 (Message ExternalSig)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Optional 4 (Message ExternalSig))
-> Optional 4 (Message ExternalSig))
-> FieldType (Optional 4 (Message ExternalSig))
-> Optional 4 (Message ExternalSig)
forall a b. (a -> b) -> a -> b
$ (Signature, PublicKey) -> ExternalSig
externalSigToPb ((Signature, PublicKey) -> ExternalSig)
-> Maybe (Signature, PublicKey) -> Maybe ExternalSig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Signature, PublicKey)
eSig
}
pbToProof :: PB.Proof -> Either String (Either Crypto.Signature Crypto.SecretKey)
pbToProof :: Proof -> Either String (Either Signature SecretKey)
pbToProof (PB.ProofSignature Required 2 (Value ByteString)
rawSig) = Signature -> Either Signature SecretKey
forall a b. a -> Either a b
Left (Signature -> Either Signature SecretKey)
-> Either String Signature
-> Either String (Either Signature SecretKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signature -> Either String Signature
forall a b. b -> Either a b
Right (ByteString -> Signature
Crypto.signature (ByteString -> Signature) -> ByteString -> Signature
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 2 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Value ByteString)
Field 2 (RequiredField (Always (Value ByteString)))
rawSig)
pbToProof (PB.ProofSecret Required 1 (Value ByteString)
rawPk) = SecretKey -> Either Signature SecretKey
forall a b. b -> Either a b
Right (SecretKey -> Either Signature SecretKey)
-> Either String SecretKey
-> Either String (Either Signature SecretKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe SecretKey -> Either String SecretKey
forall b a. b -> Maybe a -> Either b a
maybeToRight String
"Invalid public key proof" (ByteString -> Maybe SecretKey
Crypto.readEd25519SecretKey (ByteString -> Maybe SecretKey) -> ByteString -> Maybe SecretKey
forall a b. (a -> b) -> a -> b
$ Field 1 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 1 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Value ByteString)
Field 1 (RequiredField (Always (Value ByteString)))
rawPk)
pbToBlock :: Maybe Crypto.PublicKey -> PB.Block -> StateT Symbols (Either String) Block
pbToBlock :: Maybe PublicKey -> Block -> StateT Symbols (Either String) Block
pbToBlock Maybe PublicKey
ePk PB.Block{Optional 2 (Value Text)
Optional 3 (Value Int32)
Repeated 1 (Value Text)
Repeated 4 (Message FactV2)
Repeated 5 (Message RuleV2)
Repeated 6 (Message CheckV2)
Repeated 7 (Message Scope)
Repeated 8 (Message PublicKey)
symbols :: Repeated 1 (Value Text)
context :: Optional 2 (Value Text)
version :: Optional 3 (Value Int32)
facts_v2 :: Repeated 4 (Message FactV2)
rules_v2 :: Repeated 5 (Message RuleV2)
checks_v2 :: Repeated 6 (Message CheckV2)
scope :: Repeated 7 (Message Scope)
pksTable :: Repeated 8 (Message PublicKey)
$sel:symbols:Block :: Block -> Repeated 1 (Value Text)
$sel:context:Block :: Block -> Optional 2 (Value Text)
$sel:version:Block :: Block -> Optional 3 (Value Int32)
$sel:facts_v2:Block :: Block -> Repeated 4 (Message FactV2)
$sel:rules_v2:Block :: Block -> Repeated 5 (Message RuleV2)
$sel:checks_v2:Block :: Block -> Repeated 6 (Message CheckV2)
$sel:scope:Block :: Block -> Repeated 7 (Message Scope)
$sel:pksTable:Block :: Block -> Repeated 8 (Message PublicKey)
..} = do
[PublicKey]
blockPks <- Either String [PublicKey]
-> StateT Symbols (Either String) [PublicKey]
forall (m :: * -> *) a. Monad m => m a -> StateT Symbols m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String [PublicKey]
-> StateT Symbols (Either String) [PublicKey])
-> Either String [PublicKey]
-> StateT Symbols (Either String) [PublicKey]
forall a b. (a -> b) -> a -> b
$ (PublicKey -> Either String PublicKey)
-> [PublicKey] -> Either String [PublicKey]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse PublicKey -> Either String PublicKey
pbToPublicKey ([PublicKey] -> Either String [PublicKey])
-> [PublicKey] -> Either String [PublicKey]
forall a b. (a -> b) -> a -> b
$ Repeated 8 (Message PublicKey)
-> FieldType (Repeated 8 (Message PublicKey))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 8 (Message PublicKey)
pksTable
let blockSymbols :: FieldType (Repeated 1 (Value Text))
blockSymbols = Repeated 1 (Value Text) -> FieldType (Repeated 1 (Value Text))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 1 (Value Text)
symbols
Bool
-> StateT Symbols (Either String) ()
-> StateT Symbols (Either String) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe PublicKey -> Bool
forall a. Maybe a -> Bool
isNothing Maybe PublicKey
ePk) (StateT Symbols (Either String) ()
-> StateT Symbols (Either String) ())
-> StateT Symbols (Either String) ()
-> StateT Symbols (Either String) ()
forall a b. (a -> b) -> a -> b
$ (Symbols -> Symbols) -> StateT Symbols (Either String) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([Text] -> Symbols -> Symbols
registerNewSymbols [Text]
blockSymbols)
(Symbols -> Symbols) -> StateT Symbols (Either String) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([PublicKey] -> Symbols -> Symbols
registerNewPublicKeys ([PublicKey] -> Symbols -> Symbols)
-> [PublicKey] -> Symbols -> Symbols
forall a b. (a -> b) -> a -> b
$ (PublicKey -> [PublicKey]) -> Maybe PublicKey -> [PublicKey]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap PublicKey -> [PublicKey]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PublicKey
ePk [PublicKey] -> [PublicKey] -> [PublicKey]
forall a. Semigroup a => a -> a -> a
<> [PublicKey]
blockPks)
Symbols
currentSymbols <- StateT Symbols (Either String) Symbols
forall s (m :: * -> *). MonadState s m => m s
get
let symbolsForCurrentBlock :: Symbols
symbolsForCurrentBlock =
if Maybe PublicKey -> Bool
forall a. Maybe a -> Bool
isNothing Maybe PublicKey
ePk then Symbols
currentSymbols
else [Text] -> Symbols -> Symbols
registerNewSymbols [Text]
blockSymbols (Symbols -> Symbols) -> Symbols -> Symbols
forall a b. (a -> b) -> a -> b
$ Symbols -> Symbols
forgetSymbols Symbols
currentSymbols
let bContext :: FieldType (Field 2 (OptionalField (Last (Value Text))))
bContext = Field 2 (OptionalField (Last (Value Text)))
-> FieldType (Field 2 (OptionalField (Last (Value Text))))
forall a. HasField a => a -> FieldType a
PB.getField Optional 2 (Value Text)
Field 2 (OptionalField (Last (Value Text)))
context
bVersion :: FieldType (Field 3 (OptionalField (Last (Value Int32))))
bVersion = Field 3 (OptionalField (Last (Value Int32)))
-> FieldType (Field 3 (OptionalField (Last (Value Int32))))
forall a. HasField a => a -> FieldType a
PB.getField Optional 3 (Value Int32)
Field 3 (OptionalField (Last (Value Int32)))
version
Either String Block -> StateT Symbols (Either String) Block
forall (m :: * -> *) a. Monad m => m a -> StateT Symbols m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String Block -> StateT Symbols (Either String) Block)
-> Either String Block -> StateT Symbols (Either String) Block
forall a b. (a -> b) -> a -> b
$ do
let s :: Symbols
s = Symbols
symbolsForCurrentBlock
[Fact]
bFacts <- (FactV2 -> Either String Fact) -> [FactV2] -> Either String [Fact]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Symbols -> FactV2 -> Either String Fact
pbToFact Symbols
s) ([FactV2] -> Either String [Fact])
-> [FactV2] -> Either String [Fact]
forall a b. (a -> b) -> a -> b
$ Repeated 4 (Message FactV2)
-> FieldType (Repeated 4 (Message FactV2))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 4 (Message FactV2)
facts_v2
[Rule]
bRules <- (RuleV2 -> Either String Rule) -> [RuleV2] -> Either String [Rule]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Symbols -> RuleV2 -> Either String Rule
pbToRule Symbols
s) ([RuleV2] -> Either String [Rule])
-> [RuleV2] -> Either String [Rule]
forall a b. (a -> b) -> a -> b
$ Repeated 5 (Message RuleV2)
-> FieldType (Repeated 5 (Message RuleV2))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 5 (Message RuleV2)
rules_v2
[Check]
bChecks <- (CheckV2 -> Either String Check)
-> [CheckV2] -> Either String [Check]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Symbols -> CheckV2 -> Either String Check
pbToCheck Symbols
s) ([CheckV2] -> Either String [Check])
-> [CheckV2] -> Either String [Check]
forall a b. (a -> b) -> a -> b
$ Repeated 6 (Message CheckV2)
-> FieldType (Repeated 6 (Message CheckV2))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 6 (Message CheckV2)
checks_v2
Set RuleScope
bScope <- [RuleScope] -> Set RuleScope
forall a. Ord a => [a] -> Set a
Set.fromList ([RuleScope] -> Set RuleScope)
-> Either String [RuleScope] -> Either String (Set RuleScope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Scope -> Either String RuleScope)
-> [Scope] -> Either String [RuleScope]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Symbols -> Scope -> Either String RuleScope
pbToScope Symbols
s) (Repeated 7 (Message Scope)
-> FieldType (Repeated 7 (Message Scope))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 7 (Message Scope)
scope)
let isV3 :: Bool
isV3 = Maybe PublicKey -> Bool
forall a. Maybe a -> Bool
isNothing Maybe PublicKey
ePk
Bool -> Bool -> Bool
&& Set RuleScope -> Bool
forall a. Set a -> Bool
Set.null Set RuleScope
bScope
Bool -> Bool -> Bool
&& (Rule -> Bool) -> [Rule] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Rule -> Bool
ruleHasNoScope [Rule]
bRules
Bool -> Bool -> Bool
&& (Query -> Bool) -> [Query] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Query -> Bool
queryHasNoScope (Check -> Query
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cQueries (Check -> Query) -> [Check] -> [Query]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Check]
bChecks)
Bool -> Bool -> Bool
&& (Check -> Bool) -> [Check] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Check -> Bool
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Bool
isCheckOne [Check]
bChecks
Bool -> Bool -> Bool
&& (Rule -> Bool) -> [Rule] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Rule -> Bool
ruleHasNoV4Operators [Rule]
bRules
Bool -> Bool -> Bool
&& (Query -> Bool) -> [Query] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Query -> Bool
queryHasNoV4Operators (Check -> Query
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cQueries (Check -> Query) -> [Check] -> [Query]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Check]
bChecks)
case (Maybe Int32
bVersion, Bool
isV3) of
(Just Int32
4, Bool
_) -> Block -> Either String Block
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block {[Rule]
[Check]
[Fact]
Maybe Text
Set RuleScope
bContext :: Maybe Text
bFacts :: [Fact]
bRules :: [Rule]
bChecks :: [Check]
bScope :: Set RuleScope
bRules :: [Rule]
bFacts :: [Fact]
bChecks :: [Check]
bContext :: Maybe Text
bScope :: Set RuleScope
..}
(Just Int32
3, Bool
True) -> Block -> Either String Block
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block {[Rule]
[Check]
[Fact]
Maybe Text
Set RuleScope
bContext :: Maybe Text
bFacts :: [Fact]
bRules :: [Rule]
bChecks :: [Check]
bScope :: Set RuleScope
bRules :: [Rule]
bFacts :: [Fact]
bChecks :: [Check]
bContext :: Maybe Text
bScope :: Set RuleScope
..}
(Just Int32
3, Bool
False) ->
String -> Either String Block
forall a b. a -> Either a b
Left String
"Biscuit v4 fields are present, but the block version is 3."
(Maybe Int32, Bool)
_ ->
String -> Either String Block
forall a b. a -> Either a b
Left (String -> Either String Block) -> String -> Either String Block
forall a b. (a -> b) -> a -> b
$ String
"Unsupported biscuit version: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> (Int32 -> String) -> Maybe Int32 -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"0" Int32 -> String
forall a. Show a => a -> String
show Maybe Int32
bVersion String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". Only versions 3 and 4 are supported"
blockToPb :: Bool -> Symbols -> Block -> (BlockSymbols, PB.Block)
blockToPb :: Bool -> Symbols -> Block -> (BlockSymbols, Block)
blockToPb Bool
hasExternalPk Symbols
existingSymbols b :: Block
b@Block{[Rule]
[Check]
[Fact]
Maybe Text
Set RuleScope
bRules :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
bFacts :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Predicate' 'InFact ctx]
bChecks :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bContext :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Maybe Text
bScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bRules :: [Rule]
bFacts :: [Fact]
bChecks :: [Check]
bContext :: Maybe Text
bScope :: Set RuleScope
..} =
let isV3 :: Bool
isV3 = Bool -> Bool
not Bool
hasExternalPk
Bool -> Bool -> Bool
&& Set RuleScope -> Bool
forall a. Set a -> Bool
Set.null Set RuleScope
bScope
Bool -> Bool -> Bool
&& (Rule -> Bool) -> [Rule] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Rule -> Bool
ruleHasNoScope [Rule]
bRules
Bool -> Bool -> Bool
&& (Query -> Bool) -> [Query] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Query -> Bool
queryHasNoScope (Check -> Query
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cQueries (Check -> Query) -> [Check] -> [Query]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Check]
bChecks)
Bool -> Bool -> Bool
&& (Check -> Bool) -> [Check] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Check -> Bool
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Bool
isCheckOne [Check]
bChecks
Bool -> Bool -> Bool
&& (Rule -> Bool) -> [Rule] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Rule -> Bool
ruleHasNoV4Operators [Rule]
bRules
Bool -> Bool -> Bool
&& (Query -> Bool) -> [Query] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Query -> Bool
queryHasNoV4Operators (Check -> Query
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cQueries (Check -> Query) -> [Check] -> [Query]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Check]
bChecks)
bSymbols :: BlockSymbols
bSymbols = Symbols -> Block -> BlockSymbols
buildSymbolTable Symbols
existingSymbols Block
b
s :: ReverseSymbols
s = Symbols -> ReverseSymbols
reverseSymbols (Symbols -> ReverseSymbols) -> Symbols -> ReverseSymbols
forall a b. (a -> b) -> a -> b
$ Symbols -> BlockSymbols -> Symbols
addFromBlock Symbols
existingSymbols BlockSymbols
bSymbols
symbols :: Repeated 1 (Value Text)
symbols = FieldType (Repeated 1 (Value Text)) -> Repeated 1 (Value Text)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 1 (Value Text)) -> Repeated 1 (Value Text))
-> FieldType (Repeated 1 (Value Text)) -> Repeated 1 (Value Text)
forall a b. (a -> b) -> a -> b
$ BlockSymbols -> [Text]
getSymbolList BlockSymbols
bSymbols
context :: Field 2 (OptionalField (Last (Value Text)))
context = FieldType (Field 2 (OptionalField (Last (Value Text))))
-> Field 2 (OptionalField (Last (Value Text)))
forall a. HasField a => FieldType a -> a
PB.putField Maybe Text
FieldType (Field 2 (OptionalField (Last (Value Text))))
bContext
facts_v2 :: Repeated 4 (Message FactV2)
facts_v2 = FieldType (Repeated 4 (Message FactV2))
-> Repeated 4 (Message FactV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 4 (Message FactV2))
-> Repeated 4 (Message FactV2))
-> FieldType (Repeated 4 (Message FactV2))
-> Repeated 4 (Message FactV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Fact -> FactV2
factToPb ReverseSymbols
s (Fact -> FactV2) -> [Fact] -> [FactV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Fact]
bFacts
rules_v2 :: Repeated 5 (Message RuleV2)
rules_v2 = FieldType (Repeated 5 (Message RuleV2))
-> Repeated 5 (Message RuleV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 5 (Message RuleV2))
-> Repeated 5 (Message RuleV2))
-> FieldType (Repeated 5 (Message RuleV2))
-> Repeated 5 (Message RuleV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Rule -> RuleV2
ruleToPb ReverseSymbols
s (Rule -> RuleV2) -> [Rule] -> [RuleV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rule]
bRules
checks_v2 :: Repeated 6 (Message CheckV2)
checks_v2 = FieldType (Repeated 6 (Message CheckV2))
-> Repeated 6 (Message CheckV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 6 (Message CheckV2))
-> Repeated 6 (Message CheckV2))
-> FieldType (Repeated 6 (Message CheckV2))
-> Repeated 6 (Message CheckV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Check -> CheckV2
checkToPb ReverseSymbols
s (Check -> CheckV2) -> [Check] -> [CheckV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Check]
bChecks
scope :: Repeated 7 (Message Scope)
scope = FieldType (Repeated 7 (Message Scope))
-> Repeated 7 (Message Scope)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 7 (Message Scope))
-> Repeated 7 (Message Scope))
-> FieldType (Repeated 7 (Message Scope))
-> Repeated 7 (Message Scope)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> RuleScope -> Scope
scopeToPb ReverseSymbols
s (RuleScope -> Scope) -> [RuleScope] -> [Scope]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set RuleScope -> [RuleScope]
forall a. Set a -> [a]
Set.toList Set RuleScope
bScope
pksTable :: Repeated 8 (Message PublicKey)
pksTable = FieldType (Repeated 8 (Message PublicKey))
-> Repeated 8 (Message PublicKey)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 8 (Message PublicKey))
-> Repeated 8 (Message PublicKey))
-> FieldType (Repeated 8 (Message PublicKey))
-> Repeated 8 (Message PublicKey)
forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey
publicKeyToPb (PublicKey -> PublicKey) -> [PublicKey] -> [PublicKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockSymbols -> [PublicKey]
getPkList BlockSymbols
bSymbols
version :: Field 3 (OptionalField (Last (Value Int32)))
version = FieldType (Field 3 (OptionalField (Last (Value Int32))))
-> Field 3 (OptionalField (Last (Value Int32)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 3 (OptionalField (Last (Value Int32))))
-> Field 3 (OptionalField (Last (Value Int32))))
-> FieldType (Field 3 (OptionalField (Last (Value Int32))))
-> Field 3 (OptionalField (Last (Value Int32)))
forall a b. (a -> b) -> a -> b
$ if Bool
isV3 then Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
3
else Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
4
in (BlockSymbols
bSymbols, PB.Block {Optional 2 (Value Text)
Optional 3 (Value Int32)
Repeated 1 (Value Text)
Field 2 (OptionalField (Last (Value Text)))
Field 3 (OptionalField (Last (Value Int32)))
Repeated 4 (Message FactV2)
Repeated 5 (Message RuleV2)
Repeated 6 (Message CheckV2)
Repeated 7 (Message Scope)
Repeated 8 (Message PublicKey)
$sel:symbols:Block :: Repeated 1 (Value Text)
$sel:context:Block :: Optional 2 (Value Text)
$sel:version:Block :: Optional 3 (Value Int32)
$sel:facts_v2:Block :: Repeated 4 (Message FactV2)
$sel:rules_v2:Block :: Repeated 5 (Message RuleV2)
$sel:checks_v2:Block :: Repeated 6 (Message CheckV2)
$sel:scope:Block :: Repeated 7 (Message Scope)
$sel:pksTable:Block :: Repeated 8 (Message PublicKey)
symbols :: Repeated 1 (Value Text)
context :: Field 2 (OptionalField (Last (Value Text)))
facts_v2 :: Repeated 4 (Message FactV2)
rules_v2 :: Repeated 5 (Message RuleV2)
checks_v2 :: Repeated 6 (Message CheckV2)
scope :: Repeated 7 (Message Scope)
pksTable :: Repeated 8 (Message PublicKey)
version :: Field 3 (OptionalField (Last (Value Int32)))
..})
pbToFact :: Symbols -> PB.FactV2 -> Either String Fact
pbToFact :: Symbols -> FactV2 -> Either String Fact
pbToFact Symbols
s PB.FactV2{Required 1 (Message PredicateV2)
predicate :: Required 1 (Message PredicateV2)
$sel:predicate:FactV2 :: FactV2 -> Required 1 (Message PredicateV2)
predicate} = do
let pbName :: FieldType (Field 1 (RequiredField (Always (Value Int64))))
pbName = Field 1 (RequiredField (Always (Value Int64)))
-> FieldType (Field 1 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField (Field 1 (RequiredField (Always (Value Int64)))
-> FieldType (Field 1 (RequiredField (Always (Value Int64)))))
-> Field 1 (RequiredField (Always (Value Int64)))
-> FieldType (Field 1 (RequiredField (Always (Value Int64))))
forall a b. (a -> b) -> a -> b
$ PredicateV2 -> Required 1 (Value Int64)
PB.name (PredicateV2 -> Required 1 (Value Int64))
-> PredicateV2 -> Required 1 (Value Int64)
forall a b. (a -> b) -> a -> b
$ Field 1 (RequiredField (Always (Message PredicateV2)))
-> FieldType
(Field 1 (RequiredField (Always (Message PredicateV2))))
forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Message PredicateV2)
Field 1 (RequiredField (Always (Message PredicateV2)))
predicate
pbTerms :: FieldType (Repeated 2 (Message TermV2))
pbTerms = Repeated 2 (Message TermV2)
-> FieldType (Repeated 2 (Message TermV2))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 2 (Message TermV2)
-> FieldType (Repeated 2 (Message TermV2)))
-> Repeated 2 (Message TermV2)
-> FieldType (Repeated 2 (Message TermV2))
forall a b. (a -> b) -> a -> b
$ PredicateV2 -> Repeated 2 (Message TermV2)
PB.terms (PredicateV2 -> Repeated 2 (Message TermV2))
-> PredicateV2 -> Repeated 2 (Message TermV2)
forall a b. (a -> b) -> a -> b
$ Field 1 (RequiredField (Always (Message PredicateV2)))
-> FieldType
(Field 1 (RequiredField (Always (Message PredicateV2))))
forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Message PredicateV2)
Field 1 (RequiredField (Always (Message PredicateV2)))
predicate
Text
name <- Symbols -> SymbolRef -> Either String Text
getSymbol Symbols
s (SymbolRef -> Either String Text)
-> SymbolRef -> Either String Text
forall a b. (a -> b) -> a -> b
$ Int64 -> SymbolRef
SymbolRef Int64
pbName
[Value]
terms <- (TermV2 -> Either String Value)
-> [TermV2] -> Either String [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Symbols -> TermV2 -> Either String Value
pbToValue Symbols
s) [TermV2]
pbTerms
Fact -> Either String Fact
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Predicate{[Value]
Text
name :: Text
terms :: [Value]
name :: Text
terms :: [Value]
..}
factToPb :: ReverseSymbols -> Fact -> PB.FactV2
factToPb :: ReverseSymbols -> Fact -> FactV2
factToPb ReverseSymbols
s Predicate{[Value]
Text
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
name :: Text
terms :: [Value]
..} =
let
predicate :: PredicateV2
predicate = PB.PredicateV2
{ $sel:name:PredicateV2 :: Required 1 (Value Int64)
name = FieldType (Required 1 (Value Int64)) -> Required 1 (Value Int64)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 1 (Value Int64)) -> Required 1 (Value Int64))
-> FieldType (Required 1 (Value Int64)) -> Required 1 (Value Int64)
forall a b. (a -> b) -> a -> b
$ SymbolRef -> Int64
getSymbolRef (SymbolRef -> Int64) -> SymbolRef -> Int64
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Text -> SymbolRef
getSymbolCode ReverseSymbols
s Text
name
, $sel:terms:PredicateV2 :: Repeated 2 (Message TermV2)
terms = FieldType (Repeated 2 (Message TermV2))
-> Repeated 2 (Message TermV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 2 (Message TermV2))
-> Repeated 2 (Message TermV2))
-> FieldType (Repeated 2 (Message TermV2))
-> Repeated 2 (Message TermV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Value -> TermV2
valueToPb ReverseSymbols
s (Value -> TermV2) -> [Value] -> [TermV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
terms
}
in PB.FactV2{$sel:predicate:FactV2 :: Required 1 (Message PredicateV2)
predicate = FieldType (Field 1 (RequiredField (Always (Message PredicateV2))))
-> Field 1 (RequiredField (Always (Message PredicateV2)))
forall a. HasField a => FieldType a -> a
PB.putField FieldType (Field 1 (RequiredField (Always (Message PredicateV2))))
PredicateV2
predicate}
pbToRule :: Symbols -> PB.RuleV2 -> Either String Rule
pbToRule :: Symbols -> RuleV2 -> Either String Rule
pbToRule Symbols
s RuleV2
pbRule = do
let pbHead :: FieldType (Required 1 (Message PredicateV2))
pbHead = Required 1 (Message PredicateV2)
-> FieldType (Required 1 (Message PredicateV2))
forall a. HasField a => a -> FieldType a
PB.getField (Required 1 (Message PredicateV2)
-> FieldType (Required 1 (Message PredicateV2)))
-> Required 1 (Message PredicateV2)
-> FieldType (Required 1 (Message PredicateV2))
forall a b. (a -> b) -> a -> b
$ RuleV2 -> Required 1 (Message PredicateV2)
PB.head RuleV2
pbRule
pbBody :: FieldType (Repeated 2 (Message PredicateV2))
pbBody = Repeated 2 (Message PredicateV2)
-> FieldType (Repeated 2 (Message PredicateV2))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 2 (Message PredicateV2)
-> FieldType (Repeated 2 (Message PredicateV2)))
-> Repeated 2 (Message PredicateV2)
-> FieldType (Repeated 2 (Message PredicateV2))
forall a b. (a -> b) -> a -> b
$ RuleV2 -> Repeated 2 (Message PredicateV2)
PB.body RuleV2
pbRule
pbExpressions :: FieldType (Repeated 3 (Message ExpressionV2))
pbExpressions = Repeated 3 (Message ExpressionV2)
-> FieldType (Repeated 3 (Message ExpressionV2))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 3 (Message ExpressionV2)
-> FieldType (Repeated 3 (Message ExpressionV2)))
-> Repeated 3 (Message ExpressionV2)
-> FieldType (Repeated 3 (Message ExpressionV2))
forall a b. (a -> b) -> a -> b
$ RuleV2 -> Repeated 3 (Message ExpressionV2)
PB.expressions RuleV2
pbRule
pbScope :: FieldType (Repeated 4 (Message Scope))
pbScope = Repeated 4 (Message Scope)
-> FieldType (Repeated 4 (Message Scope))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 4 (Message Scope)
-> FieldType (Repeated 4 (Message Scope)))
-> Repeated 4 (Message Scope)
-> FieldType (Repeated 4 (Message Scope))
forall a b. (a -> b) -> a -> b
$ forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @"scope" RuleV2
pbRule
Predicate' 'InPredicate 'Representation
rhead <- Symbols
-> PredicateV2
-> Either String (Predicate' 'InPredicate 'Representation)
pbToPredicate Symbols
s PredicateV2
pbHead
[Predicate' 'InPredicate 'Representation]
body <- (PredicateV2
-> Either String (Predicate' 'InPredicate 'Representation))
-> [PredicateV2]
-> Either String [Predicate' 'InPredicate 'Representation]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Symbols
-> PredicateV2
-> Either String (Predicate' 'InPredicate 'Representation)
pbToPredicate Symbols
s) [PredicateV2]
pbBody
[Expression]
expressions <- (ExpressionV2 -> Either String Expression)
-> [ExpressionV2] -> Either String [Expression]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Symbols -> ExpressionV2 -> Either String Expression
pbToExpression Symbols
s) [ExpressionV2]
pbExpressions
Set RuleScope
scope <- [RuleScope] -> Set RuleScope
forall a. Ord a => [a] -> Set a
Set.fromList ([RuleScope] -> Set RuleScope)
-> Either String [RuleScope] -> Either String (Set RuleScope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Scope -> Either String RuleScope)
-> [Scope] -> Either String [RuleScope]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Symbols -> Scope -> Either String RuleScope
pbToScope Symbols
s) [Scope]
pbScope
case Predicate' 'InPredicate 'Representation
-> [Predicate' 'InPredicate 'Representation]
-> [Expression]
-> Set RuleScope
-> Validation (NonEmpty Text) Rule
forall (ctx :: DatalogContext).
Predicate' 'InPredicate ctx
-> [Predicate' 'InPredicate ctx]
-> [Expression' ctx]
-> Set (RuleScope' 'Repr ctx)
-> Validation (NonEmpty Text) (Rule' 'Repr ctx)
makeRule Predicate' 'InPredicate 'Representation
rhead [Predicate' 'InPredicate 'Representation]
body [Expression]
expressions Set RuleScope
scope of
Failure NonEmpty Text
vs -> String -> Either String Rule
forall a b. a -> Either a b
Left (String -> Either String Rule) -> String -> Either String Rule
forall a b. (a -> b) -> a -> b
$ String
"Unbound variables in rule: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Text
vs)
Success Rule
r -> Rule -> Either String Rule
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rule
r
ruleToPb :: ReverseSymbols -> Rule -> PB.RuleV2
ruleToPb :: ReverseSymbols -> Rule -> RuleV2
ruleToPb ReverseSymbols
s Rule{[Expression]
[Predicate' 'InPredicate 'Representation]
Set RuleScope
Predicate' 'InPredicate 'Representation
rhead :: Predicate' 'InPredicate 'Representation
body :: [Predicate' 'InPredicate 'Representation]
expressions :: [Expression]
scope :: Set RuleScope
rhead :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Predicate' 'InPredicate ctx
body :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Predicate' 'InPredicate ctx]
expressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Expression' ctx]
scope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
..} =
PB.RuleV2
{ $sel:head:RuleV2 :: Required 1 (Message PredicateV2)
head = FieldType (Required 1 (Message PredicateV2))
-> Required 1 (Message PredicateV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 1 (Message PredicateV2))
-> Required 1 (Message PredicateV2))
-> FieldType (Required 1 (Message PredicateV2))
-> Required 1 (Message PredicateV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols
-> Predicate' 'InPredicate 'Representation -> PredicateV2
predicateToPb ReverseSymbols
s Predicate' 'InPredicate 'Representation
rhead
, $sel:body:RuleV2 :: Repeated 2 (Message PredicateV2)
body = FieldType (Repeated 2 (Message PredicateV2))
-> Repeated 2 (Message PredicateV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 2 (Message PredicateV2))
-> Repeated 2 (Message PredicateV2))
-> FieldType (Repeated 2 (Message PredicateV2))
-> Repeated 2 (Message PredicateV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols
-> Predicate' 'InPredicate 'Representation -> PredicateV2
predicateToPb ReverseSymbols
s (Predicate' 'InPredicate 'Representation -> PredicateV2)
-> [Predicate' 'InPredicate 'Representation] -> [PredicateV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Predicate' 'InPredicate 'Representation]
body
, $sel:expressions:RuleV2 :: Repeated 3 (Message ExpressionV2)
expressions = FieldType (Repeated 3 (Message ExpressionV2))
-> Repeated 3 (Message ExpressionV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 3 (Message ExpressionV2))
-> Repeated 3 (Message ExpressionV2))
-> FieldType (Repeated 3 (Message ExpressionV2))
-> Repeated 3 (Message ExpressionV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Expression -> ExpressionV2
expressionToPb ReverseSymbols
s (Expression -> ExpressionV2) -> [Expression] -> [ExpressionV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expression]
expressions
, $sel:scope:RuleV2 :: Repeated 4 (Message Scope)
scope = FieldType (Repeated 4 (Message Scope))
-> Repeated 4 (Message Scope)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 4 (Message Scope))
-> Repeated 4 (Message Scope))
-> FieldType (Repeated 4 (Message Scope))
-> Repeated 4 (Message Scope)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> RuleScope -> Scope
scopeToPb ReverseSymbols
s (RuleScope -> Scope) -> [RuleScope] -> [Scope]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set RuleScope -> [RuleScope]
forall a. Set a -> [a]
Set.toList Set RuleScope
scope
}
pbToCheck :: Symbols -> PB.CheckV2 -> Either String Check
pbToCheck :: Symbols -> CheckV2 -> Either String Check
pbToCheck Symbols
s PB.CheckV2{Repeated 1 (Message RuleV2)
queries :: Repeated 1 (Message RuleV2)
$sel:queries:CheckV2 :: CheckV2 -> Repeated 1 (Message RuleV2)
queries,Optional 2 (Enumeration CheckKind)
kind :: Optional 2 (Enumeration CheckKind)
$sel:kind:CheckV2 :: CheckV2 -> Optional 2 (Enumeration CheckKind)
kind} = do
let toCheck :: Rule' evalCtx ctx -> QueryItem' evalCtx ctx
toCheck Rule{[Predicate' 'InPredicate ctx]
body :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Predicate' 'InPredicate ctx]
body :: [Predicate' 'InPredicate ctx]
body,[Expression' ctx]
expressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Expression' ctx]
expressions :: [Expression' ctx]
expressions,Set (RuleScope' evalCtx ctx)
scope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
scope :: Set (RuleScope' evalCtx ctx)
scope} = QueryItem{qBody :: [Predicate' 'InPredicate ctx]
qBody = [Predicate' 'InPredicate ctx]
body, qExpressions :: [Expression' ctx]
qExpressions = [Expression' ctx]
expressions, qScope :: Set (RuleScope' evalCtx ctx)
qScope = Set (RuleScope' evalCtx ctx)
scope}
[Rule]
rules <- (RuleV2 -> Either String Rule) -> [RuleV2] -> Either String [Rule]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Symbols -> RuleV2 -> Either String Rule
pbToRule Symbols
s) ([RuleV2] -> Either String [Rule])
-> [RuleV2] -> Either String [Rule]
forall a b. (a -> b) -> a -> b
$ Repeated 1 (Message RuleV2)
-> FieldType (Repeated 1 (Message RuleV2))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 1 (Message RuleV2)
queries
let cQueries :: Query
cQueries = Rule -> QueryItem' 'Repr 'Representation
forall {evalCtx :: EvaluationContext} {ctx :: DatalogContext}.
Rule' evalCtx ctx -> QueryItem' evalCtx ctx
toCheck (Rule -> QueryItem' 'Repr 'Representation) -> [Rule] -> Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rule]
rules
let cKind :: CheckKind
cKind = case Field 2 (OptionalField (Last (Enumeration CheckKind)))
-> FieldType
(Field 2 (OptionalField (Last (Enumeration CheckKind))))
forall a. HasField a => a -> FieldType a
PB.getField Optional 2 (Enumeration CheckKind)
Field 2 (OptionalField (Last (Enumeration CheckKind)))
kind of
Just CheckKind
PB.All -> CheckKind
All
Just CheckKind
PB.One -> CheckKind
One
Maybe CheckKind
FieldType (Field 2 (OptionalField (Last (Enumeration CheckKind))))
Nothing -> CheckKind
One
Check -> Either String Check
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Check{Query
CheckKind
cQueries :: Query
cQueries :: Query
cKind :: CheckKind
cKind :: CheckKind
..}
checkToPb :: ReverseSymbols -> Check -> PB.CheckV2
checkToPb :: ReverseSymbols -> Check -> CheckV2
checkToPb ReverseSymbols
s Check{Query
CheckKind
cQueries :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cKind :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> CheckKind
cQueries :: Query
cKind :: CheckKind
..} =
let dummyHead :: Predicate' pof ctx
dummyHead = Text -> [Term' 'NotWithinSet pof ctx] -> Predicate' pof ctx
forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Text -> [Term' 'NotWithinSet pof ctx] -> Predicate' pof ctx
Predicate Text
"query" []
toQuery :: QueryItem' 'Repr 'Representation -> RuleV2
toQuery QueryItem{[Expression]
[Predicate' 'InPredicate 'Representation]
Set RuleScope
qBody :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Predicate' 'InPredicate ctx]
qExpressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Expression' ctx]
qScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
qBody :: [Predicate' 'InPredicate 'Representation]
qExpressions :: [Expression]
qScope :: Set RuleScope
..} =
ReverseSymbols -> Rule -> RuleV2
ruleToPb ReverseSymbols
s (Rule -> RuleV2) -> Rule -> RuleV2
forall a b. (a -> b) -> a -> b
$ Rule { rhead :: Predicate' 'InPredicate 'Representation
rhead = Predicate' 'InPredicate 'Representation
forall {pof :: PredicateOrFact} {ctx :: DatalogContext}.
Predicate' pof ctx
dummyHead
, body :: [Predicate' 'InPredicate 'Representation]
body = [Predicate' 'InPredicate 'Representation]
qBody
, expressions :: [Expression]
expressions = [Expression]
qExpressions
, scope :: Set RuleScope
scope = Set RuleScope
qScope
}
pbKind :: Maybe CheckKind
pbKind = case CheckKind
cKind of
CheckKind
One -> Maybe CheckKind
forall a. Maybe a
Nothing
CheckKind
All -> CheckKind -> Maybe CheckKind
forall a. a -> Maybe a
Just CheckKind
PB.All
in PB.CheckV2 { $sel:queries:CheckV2 :: Repeated 1 (Message RuleV2)
queries = FieldType (Repeated 1 (Message RuleV2))
-> Repeated 1 (Message RuleV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 1 (Message RuleV2))
-> Repeated 1 (Message RuleV2))
-> FieldType (Repeated 1 (Message RuleV2))
-> Repeated 1 (Message RuleV2)
forall a b. (a -> b) -> a -> b
$ QueryItem' 'Repr 'Representation -> RuleV2
toQuery (QueryItem' 'Repr 'Representation -> RuleV2) -> Query -> [RuleV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query
cQueries
, $sel:kind:CheckV2 :: Optional 2 (Enumeration CheckKind)
kind = FieldType (Field 2 (OptionalField (Last (Enumeration CheckKind))))
-> Field 2 (OptionalField (Last (Enumeration CheckKind)))
forall a. HasField a => FieldType a -> a
PB.putField Maybe CheckKind
FieldType (Field 2 (OptionalField (Last (Enumeration CheckKind))))
pbKind
}
pbToScope :: Symbols -> PB.Scope -> Either String RuleScope
pbToScope :: Symbols -> Scope -> Either String RuleScope
pbToScope Symbols
s = \case
PB.ScType Required 1 (Enumeration ScopeType)
e -> case Field 1 (RequiredField (Always (Enumeration ScopeType)))
-> FieldType
(Field 1 (RequiredField (Always (Enumeration ScopeType))))
forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Enumeration ScopeType)
Field 1 (RequiredField (Always (Enumeration ScopeType)))
e of
FieldType
(Field 1 (RequiredField (Always (Enumeration ScopeType))))
ScopeType
PB.ScopeAuthority -> RuleScope -> Either String RuleScope
forall a b. b -> Either a b
Right RuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
OnlyAuthority
FieldType
(Field 1 (RequiredField (Always (Enumeration ScopeType))))
ScopeType
PB.ScopePrevious -> RuleScope -> Either String RuleScope
forall a b. b -> Either a b
Right RuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
Previous
PB.ScBlock Required 2 (Value Int64)
pkRef ->
PublicKey -> RuleScope
BlockIdType 'Repr 'Representation -> RuleScope
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
BlockIdType evalCtx ctx -> RuleScope' evalCtx ctx
BlockId (PublicKey -> RuleScope)
-> Either String PublicKey -> Either String RuleScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> PublicKeyRef -> Either String PublicKey
getPublicKey' Symbols
s (Int64 -> PublicKeyRef
PublicKeyRef (Int64 -> PublicKeyRef) -> Int64 -> PublicKeyRef
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Value Int64)))
-> FieldType (Field 2 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Value Int64)
Field 2 (RequiredField (Always (Value Int64)))
pkRef)
scopeToPb :: ReverseSymbols -> RuleScope -> PB.Scope
scopeToPb :: ReverseSymbols -> RuleScope -> Scope
scopeToPb ReverseSymbols
s = \case
RuleScope
OnlyAuthority -> Required 1 (Enumeration ScopeType) -> Scope
PB.ScType (Required 1 (Enumeration ScopeType) -> Scope)
-> Required 1 (Enumeration ScopeType) -> Scope
forall a b. (a -> b) -> a -> b
$ FieldType
(Field 1 (RequiredField (Always (Enumeration ScopeType))))
-> Field 1 (RequiredField (Always (Enumeration ScopeType)))
forall a. HasField a => FieldType a -> a
PB.putField FieldType
(Field 1 (RequiredField (Always (Enumeration ScopeType))))
ScopeType
PB.ScopeAuthority
RuleScope
Previous -> Required 1 (Enumeration ScopeType) -> Scope
PB.ScType (Required 1 (Enumeration ScopeType) -> Scope)
-> Required 1 (Enumeration ScopeType) -> Scope
forall a b. (a -> b) -> a -> b
$ FieldType
(Field 1 (RequiredField (Always (Enumeration ScopeType))))
-> Field 1 (RequiredField (Always (Enumeration ScopeType)))
forall a. HasField a => FieldType a -> a
PB.putField FieldType
(Field 1 (RequiredField (Always (Enumeration ScopeType))))
ScopeType
PB.ScopePrevious
BlockId BlockIdType 'Repr 'Representation
pk -> Required 2 (Value Int64) -> Scope
PB.ScBlock (Required 2 (Value Int64) -> Scope)
-> Required 2 (Value Int64) -> Scope
forall a b. (a -> b) -> a -> b
$ FieldType (Required 2 (Value Int64)) -> Required 2 (Value Int64)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 2 (Value Int64)) -> Required 2 (Value Int64))
-> FieldType (Required 2 (Value Int64)) -> Required 2 (Value Int64)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> PublicKey -> Int64
getPublicKeyCode ReverseSymbols
s PublicKey
BlockIdType 'Repr 'Representation
pk
pbToPredicate :: Symbols -> PB.PredicateV2 -> Either String (Predicate' 'InPredicate 'Representation)
pbToPredicate :: Symbols
-> PredicateV2
-> Either String (Predicate' 'InPredicate 'Representation)
pbToPredicate Symbols
s PredicateV2
pbPredicate = do
let pbName :: FieldType (Required 1 (Value Int64))
pbName = Required 1 (Value Int64) -> FieldType (Required 1 (Value Int64))
forall a. HasField a => a -> FieldType a
PB.getField (Required 1 (Value Int64) -> FieldType (Required 1 (Value Int64)))
-> Required 1 (Value Int64) -> FieldType (Required 1 (Value Int64))
forall a b. (a -> b) -> a -> b
$ PredicateV2 -> Required 1 (Value Int64)
PB.name PredicateV2
pbPredicate
pbTerms :: FieldType (Repeated 2 (Message TermV2))
pbTerms = Repeated 2 (Message TermV2)
-> FieldType (Repeated 2 (Message TermV2))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 2 (Message TermV2)
-> FieldType (Repeated 2 (Message TermV2)))
-> Repeated 2 (Message TermV2)
-> FieldType (Repeated 2 (Message TermV2))
forall a b. (a -> b) -> a -> b
$ PredicateV2 -> Repeated 2 (Message TermV2)
PB.terms PredicateV2
pbPredicate
Text
name <- Symbols -> SymbolRef -> Either String Text
getSymbol Symbols
s (SymbolRef -> Either String Text)
-> SymbolRef -> Either String Text
forall a b. (a -> b) -> a -> b
$ Int64 -> SymbolRef
SymbolRef Int64
pbName
[Term]
terms <- (TermV2 -> Either String Term) -> [TermV2] -> Either String [Term]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Symbols -> TermV2 -> Either String Term
pbToTerm Symbols
s) [TermV2]
pbTerms
Predicate' 'InPredicate 'Representation
-> Either String (Predicate' 'InPredicate 'Representation)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Predicate{[Term]
Text
name :: Text
terms :: [Term]
name :: Text
terms :: [Term]
..}
predicateToPb :: ReverseSymbols -> Predicate -> PB.PredicateV2
predicateToPb :: ReverseSymbols
-> Predicate' 'InPredicate 'Representation -> PredicateV2
predicateToPb ReverseSymbols
s Predicate{[Term]
Text
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
name :: Text
terms :: [Term]
..} =
PB.PredicateV2
{ $sel:name:PredicateV2 :: Required 1 (Value Int64)
name = FieldType (Required 1 (Value Int64)) -> Required 1 (Value Int64)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 1 (Value Int64)) -> Required 1 (Value Int64))
-> FieldType (Required 1 (Value Int64)) -> Required 1 (Value Int64)
forall a b. (a -> b) -> a -> b
$ SymbolRef -> Int64
getSymbolRef (SymbolRef -> Int64) -> SymbolRef -> Int64
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Text -> SymbolRef
getSymbolCode ReverseSymbols
s Text
name
, $sel:terms:PredicateV2 :: Repeated 2 (Message TermV2)
terms = FieldType (Repeated 2 (Message TermV2))
-> Repeated 2 (Message TermV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 2 (Message TermV2))
-> Repeated 2 (Message TermV2))
-> FieldType (Repeated 2 (Message TermV2))
-> Repeated 2 (Message TermV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Term -> TermV2
termToPb ReverseSymbols
s (Term -> TermV2) -> [Term] -> [TermV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Term]
terms
}
pbTimeToUtcTime :: Int64 -> UTCTime
pbTimeToUtcTime :: Int64 -> UTCTime
pbTimeToUtcTime = POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> (Int64 -> POSIXTime) -> Int64 -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral
pbToTerm :: Symbols -> PB.TermV2 -> Either String Term
pbToTerm :: Symbols -> TermV2 -> Either String Term
pbToTerm Symbols
s = \case
PB.TermInteger Required 2 (Value Int64)
f -> Term -> Either String Term
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Either String Term) -> Term -> Either String Term
forall a b. (a -> b) -> a -> b
$ Int64 -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Int64 -> Term' inSet pof ctx
LInteger (Int64 -> Term) -> Int64 -> Term
forall a b. (a -> b) -> a -> b
$ FieldType (Field 2 (RequiredField (Always (Value Int64)))) -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FieldType (Field 2 (RequiredField (Always (Value Int64))))
-> Int64)
-> FieldType (Field 2 (RequiredField (Always (Value Int64))))
-> Int64
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Value Int64)))
-> FieldType (Field 2 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Value Int64)
Field 2 (RequiredField (Always (Value Int64)))
f
PB.TermString Required 3 (Value Int64)
f -> Text -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString (Text -> Term) -> Either String Text -> Either String Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> SymbolRef -> Either String Text
getSymbol Symbols
s (Int64 -> SymbolRef
SymbolRef (Int64 -> SymbolRef) -> Int64 -> SymbolRef
forall a b. (a -> b) -> a -> b
$ Field 3 (RequiredField (Always (Value Int64)))
-> FieldType (Field 3 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Required 3 (Value Int64)
Field 3 (RequiredField (Always (Value Int64)))
f)
PB.TermDate Required 4 (Value Int64)
f -> Term -> Either String Term
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Either String Term) -> Term -> Either String Term
forall a b. (a -> b) -> a -> b
$ UTCTime -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate (UTCTime -> Term) -> UTCTime -> Term
forall a b. (a -> b) -> a -> b
$ Int64 -> UTCTime
pbTimeToUtcTime (Int64 -> UTCTime) -> Int64 -> UTCTime
forall a b. (a -> b) -> a -> b
$ Field 4 (RequiredField (Always (Value Int64)))
-> FieldType (Field 4 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Required 4 (Value Int64)
Field 4 (RequiredField (Always (Value Int64)))
f
PB.TermBytes Required 5 (Value ByteString)
f -> Term -> Either String Term
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Either String Term) -> Term -> Either String Term
forall a b. (a -> b) -> a -> b
$ ByteString -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes (ByteString -> Term) -> ByteString -> Term
forall a b. (a -> b) -> a -> b
$ Field 5 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 5 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Required 5 (Value ByteString)
Field 5 (RequiredField (Always (Value ByteString)))
f
PB.TermBool Required 6 (Value Bool)
f -> Term -> Either String Term
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Either String Term) -> Term -> Either String Term
forall a b. (a -> b) -> a -> b
$ Bool -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool (Bool -> Term) -> Bool -> Term
forall a b. (a -> b) -> a -> b
$ Field 6 (RequiredField (Always (Value Bool)))
-> FieldType (Field 6 (RequiredField (Always (Value Bool))))
forall a. HasField a => a -> FieldType a
PB.getField Required 6 (Value Bool)
Field 6 (RequiredField (Always (Value Bool)))
f
PB.TermVariable Required 1 (Value Int64)
f -> Text -> Term
VariableType 'NotWithinSet 'InPredicate -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
VariableType inSet pof -> Term' inSet pof ctx
Variable (Text -> Term) -> Either String Text -> Either String Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> SymbolRef -> Either String Text
getSymbol Symbols
s (Int64 -> SymbolRef
SymbolRef (Int64 -> SymbolRef) -> Int64 -> SymbolRef
forall a b. (a -> b) -> a -> b
$ Field 1 (RequiredField (Always (Value Int64)))
-> FieldType (Field 1 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Value Int64)
Field 1 (RequiredField (Always (Value Int64)))
f)
PB.TermTermSet Required 7 (Message TermSet)
f -> Set (Term' 'WithinSet 'InFact 'Representation) -> Term
SetType 'NotWithinSet 'Representation -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
SetType inSet ctx -> Term' inSet pof ctx
TermSet (Set (Term' 'WithinSet 'InFact 'Representation) -> Term)
-> ([Term' 'WithinSet 'InFact 'Representation]
-> Set (Term' 'WithinSet 'InFact 'Representation))
-> [Term' 'WithinSet 'InFact 'Representation]
-> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Term' 'WithinSet 'InFact 'Representation]
-> Set (Term' 'WithinSet 'InFact 'Representation)
forall a. Ord a => [a] -> Set a
Set.fromList ([Term' 'WithinSet 'InFact 'Representation] -> Term)
-> Either String [Term' 'WithinSet 'InFact 'Representation]
-> Either String Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TermV2
-> Either String (Term' 'WithinSet 'InFact 'Representation))
-> [TermV2]
-> Either String [Term' 'WithinSet 'InFact 'Representation]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Symbols
-> TermV2
-> Either String (Term' 'WithinSet 'InFact 'Representation)
pbToSetValue Symbols
s) (Repeated 1 (Message TermV2) -> [TermV2]
Repeated 1 (Message TermV2)
-> FieldType (Repeated 1 (Message TermV2))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 1 (Message TermV2) -> [TermV2])
-> (TermSet -> Repeated 1 (Message TermV2)) -> TermSet -> [TermV2]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermSet -> Repeated 1 (Message TermV2)
PB.set (TermSet -> [TermV2]) -> TermSet -> [TermV2]
forall a b. (a -> b) -> a -> b
$ Field 7 (RequiredField (Always (Message TermSet)))
-> FieldType (Field 7 (RequiredField (Always (Message TermSet))))
forall a. HasField a => a -> FieldType a
PB.getField Required 7 (Message TermSet)
Field 7 (RequiredField (Always (Message TermSet)))
f)
termToPb :: ReverseSymbols -> Term -> PB.TermV2
termToPb :: ReverseSymbols -> Term -> TermV2
termToPb ReverseSymbols
s = \case
Variable VariableType 'NotWithinSet 'InPredicate
n -> Required 1 (Value Int64) -> TermV2
PB.TermVariable (Required 1 (Value Int64) -> TermV2)
-> Required 1 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Required 1 (Value Int64)) -> Required 1 (Value Int64)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 1 (Value Int64)) -> Required 1 (Value Int64))
-> FieldType (Required 1 (Value Int64)) -> Required 1 (Value Int64)
forall a b. (a -> b) -> a -> b
$ SymbolRef -> Int64
getSymbolRef (SymbolRef -> Int64) -> SymbolRef -> Int64
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Text -> SymbolRef
getSymbolCode ReverseSymbols
s Text
VariableType 'NotWithinSet 'InPredicate
n
LInteger Int64
v -> Required 2 (Value Int64) -> TermV2
PB.TermInteger (Required 2 (Value Int64) -> TermV2)
-> Required 2 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Required 2 (Value Int64)) -> Required 2 (Value Int64)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 2 (Value Int64)) -> Required 2 (Value Int64))
-> FieldType (Required 2 (Value Int64)) -> Required 2 (Value Int64)
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v
LString Text
v -> Required 3 (Value Int64) -> TermV2
PB.TermString (Required 3 (Value Int64) -> TermV2)
-> Required 3 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Required 3 (Value Int64)) -> Required 3 (Value Int64)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 3 (Value Int64)) -> Required 3 (Value Int64))
-> FieldType (Required 3 (Value Int64)) -> Required 3 (Value Int64)
forall a b. (a -> b) -> a -> b
$ SymbolRef -> Int64
getSymbolRef (SymbolRef -> Int64) -> SymbolRef -> Int64
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Text -> SymbolRef
getSymbolCode ReverseSymbols
s Text
v
LDate UTCTime
v -> Required 4 (Value Int64) -> TermV2
PB.TermDate (Required 4 (Value Int64) -> TermV2)
-> Required 4 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Required 4 (Value Int64)) -> Required 4 (Value Int64)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 4 (Value Int64)) -> Required 4 (Value Int64))
-> FieldType (Required 4 (Value Int64)) -> Required 4 (Value Int64)
forall a b. (a -> b) -> a -> b
$ POSIXTime -> FieldType (Required 4 (Value Int64))
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> FieldType (Required 4 (Value Int64)))
-> POSIXTime -> FieldType (Required 4 (Value Int64))
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
v
LBytes ByteString
v -> Required 5 (Value ByteString) -> TermV2
PB.TermBytes (Required 5 (Value ByteString) -> TermV2)
-> Required 5 (Value ByteString) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 5 (RequiredField (Always (Value ByteString))))
-> Field 5 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
PB.putField ByteString
FieldType (Field 5 (RequiredField (Always (Value ByteString))))
v
LBool Bool
v -> Required 6 (Value Bool) -> TermV2
PB.TermBool (Required 6 (Value Bool) -> TermV2)
-> Required 6 (Value Bool) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 6 (RequiredField (Always (Value Bool))))
-> Field 6 (RequiredField (Always (Value Bool)))
forall a. HasField a => FieldType a -> a
PB.putField Bool
FieldType (Field 6 (RequiredField (Always (Value Bool))))
v
TermSet SetType 'NotWithinSet 'Representation
vs -> Required 7 (Message TermSet) -> TermV2
PB.TermTermSet (Required 7 (Message TermSet) -> TermV2)
-> Required 7 (Message TermSet) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Required 7 (Message TermSet))
-> Required 7 (Message TermSet)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 7 (Message TermSet))
-> Required 7 (Message TermSet))
-> FieldType (Required 7 (Message TermSet))
-> Required 7 (Message TermSet)
forall a b. (a -> b) -> a -> b
$ Repeated 1 (Message TermV2) -> TermSet
PB.TermSet (Repeated 1 (Message TermV2) -> TermSet)
-> Repeated 1 (Message TermV2) -> TermSet
forall a b. (a -> b) -> a -> b
$ FieldType (Repeated 1 (Message TermV2))
-> Repeated 1 (Message TermV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 1 (Message TermV2))
-> Repeated 1 (Message TermV2))
-> FieldType (Repeated 1 (Message TermV2))
-> Repeated 1 (Message TermV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols
-> Term' 'WithinSet 'InFact 'Representation -> TermV2
setValueToPb ReverseSymbols
s (Term' 'WithinSet 'InFact 'Representation -> TermV2)
-> [Term' 'WithinSet 'InFact 'Representation] -> [TermV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (Term' 'WithinSet 'InFact 'Representation)
-> [Term' 'WithinSet 'InFact 'Representation]
forall a. Set a -> [a]
Set.toList Set (Term' 'WithinSet 'InFact 'Representation)
SetType 'NotWithinSet 'Representation
vs
Antiquote SliceType 'Representation
v -> Void -> TermV2
forall a. Void -> a
absurd Void
SliceType 'Representation
v
pbToValue :: Symbols -> PB.TermV2 -> Either String Value
pbToValue :: Symbols -> TermV2 -> Either String Value
pbToValue Symbols
s = \case
PB.TermInteger Required 2 (Value Int64)
f -> Value -> Either String Value
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ Int64 -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Int64 -> Term' inSet pof ctx
LInteger (Int64 -> Value) -> Int64 -> Value
forall a b. (a -> b) -> a -> b
$ FieldType (Field 2 (RequiredField (Always (Value Int64)))) -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FieldType (Field 2 (RequiredField (Always (Value Int64))))
-> Int64)
-> FieldType (Field 2 (RequiredField (Always (Value Int64))))
-> Int64
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Value Int64)))
-> FieldType (Field 2 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Value Int64)
Field 2 (RequiredField (Always (Value Int64)))
f
PB.TermString Required 3 (Value Int64)
f -> Text -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString (Text -> Value) -> Either String Text -> Either String Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> SymbolRef -> Either String Text
getSymbol Symbols
s (Int64 -> SymbolRef
SymbolRef (Int64 -> SymbolRef) -> Int64 -> SymbolRef
forall a b. (a -> b) -> a -> b
$ Field 3 (RequiredField (Always (Value Int64)))
-> FieldType (Field 3 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Required 3 (Value Int64)
Field 3 (RequiredField (Always (Value Int64)))
f)
PB.TermDate Required 4 (Value Int64)
f -> Value -> Either String Value
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ UTCTime -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate (UTCTime -> Value) -> UTCTime -> Value
forall a b. (a -> b) -> a -> b
$ Int64 -> UTCTime
pbTimeToUtcTime (Int64 -> UTCTime) -> Int64 -> UTCTime
forall a b. (a -> b) -> a -> b
$ Field 4 (RequiredField (Always (Value Int64)))
-> FieldType (Field 4 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Required 4 (Value Int64)
Field 4 (RequiredField (Always (Value Int64)))
f
PB.TermBytes Required 5 (Value ByteString)
f -> Value -> Either String Value
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Field 5 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 5 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Required 5 (Value ByteString)
Field 5 (RequiredField (Always (Value ByteString)))
f
PB.TermBool Required 6 (Value Bool)
f -> Value -> Either String Value
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool (Bool -> Value) -> Bool -> Value
forall a b. (a -> b) -> a -> b
$ Field 6 (RequiredField (Always (Value Bool)))
-> FieldType (Field 6 (RequiredField (Always (Value Bool))))
forall a. HasField a => a -> FieldType a
PB.getField Required 6 (Value Bool)
Field 6 (RequiredField (Always (Value Bool)))
f
PB.TermVariable Required 1 (Value Int64)
_ -> String -> Either String Value
forall a b. a -> Either a b
Left String
"Variables can't appear in facts"
PB.TermTermSet Required 7 (Message TermSet)
f -> Set (Term' 'WithinSet 'InFact 'Representation) -> Value
SetType 'NotWithinSet 'Representation -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
SetType inSet ctx -> Term' inSet pof ctx
TermSet (Set (Term' 'WithinSet 'InFact 'Representation) -> Value)
-> ([Term' 'WithinSet 'InFact 'Representation]
-> Set (Term' 'WithinSet 'InFact 'Representation))
-> [Term' 'WithinSet 'InFact 'Representation]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Term' 'WithinSet 'InFact 'Representation]
-> Set (Term' 'WithinSet 'InFact 'Representation)
forall a. Ord a => [a] -> Set a
Set.fromList ([Term' 'WithinSet 'InFact 'Representation] -> Value)
-> Either String [Term' 'WithinSet 'InFact 'Representation]
-> Either String Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TermV2
-> Either String (Term' 'WithinSet 'InFact 'Representation))
-> [TermV2]
-> Either String [Term' 'WithinSet 'InFact 'Representation]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Symbols
-> TermV2
-> Either String (Term' 'WithinSet 'InFact 'Representation)
pbToSetValue Symbols
s) (Repeated 1 (Message TermV2) -> [TermV2]
Repeated 1 (Message TermV2)
-> FieldType (Repeated 1 (Message TermV2))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 1 (Message TermV2) -> [TermV2])
-> (TermSet -> Repeated 1 (Message TermV2)) -> TermSet -> [TermV2]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermSet -> Repeated 1 (Message TermV2)
PB.set (TermSet -> [TermV2]) -> TermSet -> [TermV2]
forall a b. (a -> b) -> a -> b
$ Field 7 (RequiredField (Always (Message TermSet)))
-> FieldType (Field 7 (RequiredField (Always (Message TermSet))))
forall a. HasField a => a -> FieldType a
PB.getField Required 7 (Message TermSet)
Field 7 (RequiredField (Always (Message TermSet)))
f)
valueToPb :: ReverseSymbols -> Value -> PB.TermV2
valueToPb :: ReverseSymbols -> Value -> TermV2
valueToPb ReverseSymbols
s = \case
LInteger Int64
v -> Required 2 (Value Int64) -> TermV2
PB.TermInteger (Required 2 (Value Int64) -> TermV2)
-> Required 2 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Required 2 (Value Int64)) -> Required 2 (Value Int64)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 2 (Value Int64)) -> Required 2 (Value Int64))
-> FieldType (Required 2 (Value Int64)) -> Required 2 (Value Int64)
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v
LString Text
v -> Required 3 (Value Int64) -> TermV2
PB.TermString (Required 3 (Value Int64) -> TermV2)
-> Required 3 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Required 3 (Value Int64)) -> Required 3 (Value Int64)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 3 (Value Int64)) -> Required 3 (Value Int64))
-> FieldType (Required 3 (Value Int64)) -> Required 3 (Value Int64)
forall a b. (a -> b) -> a -> b
$ SymbolRef -> Int64
getSymbolRef (SymbolRef -> Int64) -> SymbolRef -> Int64
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Text -> SymbolRef
getSymbolCode ReverseSymbols
s Text
v
LDate UTCTime
v -> Required 4 (Value Int64) -> TermV2
PB.TermDate (Required 4 (Value Int64) -> TermV2)
-> Required 4 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Required 4 (Value Int64)) -> Required 4 (Value Int64)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 4 (Value Int64)) -> Required 4 (Value Int64))
-> FieldType (Required 4 (Value Int64)) -> Required 4 (Value Int64)
forall a b. (a -> b) -> a -> b
$ POSIXTime -> FieldType (Required 4 (Value Int64))
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> FieldType (Required 4 (Value Int64)))
-> POSIXTime -> FieldType (Required 4 (Value Int64))
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
v
LBytes ByteString
v -> Required 5 (Value ByteString) -> TermV2
PB.TermBytes (Required 5 (Value ByteString) -> TermV2)
-> Required 5 (Value ByteString) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 5 (RequiredField (Always (Value ByteString))))
-> Field 5 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
PB.putField ByteString
FieldType (Field 5 (RequiredField (Always (Value ByteString))))
v
LBool Bool
v -> Required 6 (Value Bool) -> TermV2
PB.TermBool (Required 6 (Value Bool) -> TermV2)
-> Required 6 (Value Bool) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 6 (RequiredField (Always (Value Bool))))
-> Field 6 (RequiredField (Always (Value Bool)))
forall a. HasField a => FieldType a -> a
PB.putField Bool
FieldType (Field 6 (RequiredField (Always (Value Bool))))
v
TermSet SetType 'NotWithinSet 'Representation
vs -> Required 7 (Message TermSet) -> TermV2
PB.TermTermSet (Required 7 (Message TermSet) -> TermV2)
-> Required 7 (Message TermSet) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Required 7 (Message TermSet))
-> Required 7 (Message TermSet)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 7 (Message TermSet))
-> Required 7 (Message TermSet))
-> FieldType (Required 7 (Message TermSet))
-> Required 7 (Message TermSet)
forall a b. (a -> b) -> a -> b
$ Repeated 1 (Message TermV2) -> TermSet
PB.TermSet (Repeated 1 (Message TermV2) -> TermSet)
-> Repeated 1 (Message TermV2) -> TermSet
forall a b. (a -> b) -> a -> b
$ FieldType (Repeated 1 (Message TermV2))
-> Repeated 1 (Message TermV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 1 (Message TermV2))
-> Repeated 1 (Message TermV2))
-> FieldType (Repeated 1 (Message TermV2))
-> Repeated 1 (Message TermV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols
-> Term' 'WithinSet 'InFact 'Representation -> TermV2
setValueToPb ReverseSymbols
s (Term' 'WithinSet 'InFact 'Representation -> TermV2)
-> [Term' 'WithinSet 'InFact 'Representation] -> [TermV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (Term' 'WithinSet 'InFact 'Representation)
-> [Term' 'WithinSet 'InFact 'Representation]
forall a. Set a -> [a]
Set.toList Set (Term' 'WithinSet 'InFact 'Representation)
SetType 'NotWithinSet 'Representation
vs
Variable VariableType 'NotWithinSet 'InFact
v -> Void -> TermV2
forall a. Void -> a
absurd Void
VariableType 'NotWithinSet 'InFact
v
Antiquote SliceType 'Representation
v -> Void -> TermV2
forall a. Void -> a
absurd Void
SliceType 'Representation
v
pbToSetValue :: Symbols -> PB.TermV2 -> Either String (Term' 'WithinSet 'InFact 'Representation)
pbToSetValue :: Symbols
-> TermV2
-> Either String (Term' 'WithinSet 'InFact 'Representation)
pbToSetValue Symbols
s = \case
PB.TermInteger Required 2 (Value Int64)
f -> Term' 'WithinSet 'InFact 'Representation
-> Either String (Term' 'WithinSet 'InFact 'Representation)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term' 'WithinSet 'InFact 'Representation
-> Either String (Term' 'WithinSet 'InFact 'Representation))
-> Term' 'WithinSet 'InFact 'Representation
-> Either String (Term' 'WithinSet 'InFact 'Representation)
forall a b. (a -> b) -> a -> b
$ Int64 -> Term' 'WithinSet 'InFact 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Int64 -> Term' inSet pof ctx
LInteger (Int64 -> Term' 'WithinSet 'InFact 'Representation)
-> Int64 -> Term' 'WithinSet 'InFact 'Representation
forall a b. (a -> b) -> a -> b
$ FieldType (Field 2 (RequiredField (Always (Value Int64)))) -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FieldType (Field 2 (RequiredField (Always (Value Int64))))
-> Int64)
-> FieldType (Field 2 (RequiredField (Always (Value Int64))))
-> Int64
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Value Int64)))
-> FieldType (Field 2 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Value Int64)
Field 2 (RequiredField (Always (Value Int64)))
f
PB.TermString Required 3 (Value Int64)
f -> Text -> Term' 'WithinSet 'InFact 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString (Text -> Term' 'WithinSet 'InFact 'Representation)
-> Either String Text
-> Either String (Term' 'WithinSet 'InFact 'Representation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> SymbolRef -> Either String Text
getSymbol Symbols
s (Int64 -> SymbolRef
SymbolRef (Int64 -> SymbolRef) -> Int64 -> SymbolRef
forall a b. (a -> b) -> a -> b
$ Field 3 (RequiredField (Always (Value Int64)))
-> FieldType (Field 3 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Required 3 (Value Int64)
Field 3 (RequiredField (Always (Value Int64)))
f)
PB.TermDate Required 4 (Value Int64)
f -> Term' 'WithinSet 'InFact 'Representation
-> Either String (Term' 'WithinSet 'InFact 'Representation)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term' 'WithinSet 'InFact 'Representation
-> Either String (Term' 'WithinSet 'InFact 'Representation))
-> Term' 'WithinSet 'InFact 'Representation
-> Either String (Term' 'WithinSet 'InFact 'Representation)
forall a b. (a -> b) -> a -> b
$ UTCTime -> Term' 'WithinSet 'InFact 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate (UTCTime -> Term' 'WithinSet 'InFact 'Representation)
-> UTCTime -> Term' 'WithinSet 'InFact 'Representation
forall a b. (a -> b) -> a -> b
$ Int64 -> UTCTime
pbTimeToUtcTime (Int64 -> UTCTime) -> Int64 -> UTCTime
forall a b. (a -> b) -> a -> b
$ Field 4 (RequiredField (Always (Value Int64)))
-> FieldType (Field 4 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Required 4 (Value Int64)
Field 4 (RequiredField (Always (Value Int64)))
f
PB.TermBytes Required 5 (Value ByteString)
f -> Term' 'WithinSet 'InFact 'Representation
-> Either String (Term' 'WithinSet 'InFact 'Representation)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term' 'WithinSet 'InFact 'Representation
-> Either String (Term' 'WithinSet 'InFact 'Representation))
-> Term' 'WithinSet 'InFact 'Representation
-> Either String (Term' 'WithinSet 'InFact 'Representation)
forall a b. (a -> b) -> a -> b
$ ByteString -> Term' 'WithinSet 'InFact 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes (ByteString -> Term' 'WithinSet 'InFact 'Representation)
-> ByteString -> Term' 'WithinSet 'InFact 'Representation
forall a b. (a -> b) -> a -> b
$ Field 5 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 5 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Required 5 (Value ByteString)
Field 5 (RequiredField (Always (Value ByteString)))
f
PB.TermBool Required 6 (Value Bool)
f -> Term' 'WithinSet 'InFact 'Representation
-> Either String (Term' 'WithinSet 'InFact 'Representation)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term' 'WithinSet 'InFact 'Representation
-> Either String (Term' 'WithinSet 'InFact 'Representation))
-> Term' 'WithinSet 'InFact 'Representation
-> Either String (Term' 'WithinSet 'InFact 'Representation)
forall a b. (a -> b) -> a -> b
$ Bool -> Term' 'WithinSet 'InFact 'Representation
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
(ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool (Bool -> Term' 'WithinSet 'InFact 'Representation)
-> Bool -> Term' 'WithinSet 'InFact 'Representation
forall a b. (a -> b) -> a -> b
$ Field 6 (RequiredField (Always (Value Bool)))
-> FieldType (Field 6 (RequiredField (Always (Value Bool))))
forall a. HasField a => a -> FieldType a
PB.getField Required 6 (Value Bool)
Field 6 (RequiredField (Always (Value Bool)))
f
PB.TermVariable Required 1 (Value Int64)
_ -> String -> Either String (Term' 'WithinSet 'InFact 'Representation)
forall a b. a -> Either a b
Left String
"Variables can't appear in facts or sets"
PB.TermTermSet Required 7 (Message TermSet)
_ -> String -> Either String (Term' 'WithinSet 'InFact 'Representation)
forall a b. a -> Either a b
Left String
"Sets can't be nested"
setValueToPb :: ReverseSymbols -> Term' 'WithinSet 'InFact 'Representation -> PB.TermV2
setValueToPb :: ReverseSymbols
-> Term' 'WithinSet 'InFact 'Representation -> TermV2
setValueToPb ReverseSymbols
s = \case
LInteger Int64
v -> Required 2 (Value Int64) -> TermV2
PB.TermInteger (Required 2 (Value Int64) -> TermV2)
-> Required 2 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Required 2 (Value Int64)) -> Required 2 (Value Int64)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 2 (Value Int64)) -> Required 2 (Value Int64))
-> FieldType (Required 2 (Value Int64)) -> Required 2 (Value Int64)
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v
LString Text
v -> Required 3 (Value Int64) -> TermV2
PB.TermString (Required 3 (Value Int64) -> TermV2)
-> Required 3 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Required 3 (Value Int64)) -> Required 3 (Value Int64)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 3 (Value Int64)) -> Required 3 (Value Int64))
-> FieldType (Required 3 (Value Int64)) -> Required 3 (Value Int64)
forall a b. (a -> b) -> a -> b
$ SymbolRef -> Int64
getSymbolRef (SymbolRef -> Int64) -> SymbolRef -> Int64
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Text -> SymbolRef
getSymbolCode ReverseSymbols
s Text
v
LDate UTCTime
v -> Required 4 (Value Int64) -> TermV2
PB.TermDate (Required 4 (Value Int64) -> TermV2)
-> Required 4 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Required 4 (Value Int64)) -> Required 4 (Value Int64)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 4 (Value Int64)) -> Required 4 (Value Int64))
-> FieldType (Required 4 (Value Int64)) -> Required 4 (Value Int64)
forall a b. (a -> b) -> a -> b
$ POSIXTime -> FieldType (Required 4 (Value Int64))
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> FieldType (Required 4 (Value Int64)))
-> POSIXTime -> FieldType (Required 4 (Value Int64))
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
v
LBytes ByteString
v -> Required 5 (Value ByteString) -> TermV2
PB.TermBytes (Required 5 (Value ByteString) -> TermV2)
-> Required 5 (Value ByteString) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 5 (RequiredField (Always (Value ByteString))))
-> Field 5 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
PB.putField ByteString
FieldType (Field 5 (RequiredField (Always (Value ByteString))))
v
LBool Bool
v -> Required 6 (Value Bool) -> TermV2
PB.TermBool (Required 6 (Value Bool) -> TermV2)
-> Required 6 (Value Bool) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 6 (RequiredField (Always (Value Bool))))
-> Field 6 (RequiredField (Always (Value Bool)))
forall a. HasField a => FieldType a -> a
PB.putField Bool
FieldType (Field 6 (RequiredField (Always (Value Bool))))
v
TermSet SetType 'WithinSet 'Representation
v -> Void -> TermV2
forall a. Void -> a
absurd Void
SetType 'WithinSet 'Representation
v
Variable VariableType 'WithinSet 'InFact
v -> Void -> TermV2
forall a. Void -> a
absurd Void
VariableType 'WithinSet 'InFact
v
Antiquote SliceType 'Representation
v -> Void -> TermV2
forall a. Void -> a
absurd Void
SliceType 'Representation
v
pbToExpression :: Symbols -> PB.ExpressionV2 -> Either String Expression
pbToExpression :: Symbols -> ExpressionV2 -> Either String Expression
pbToExpression Symbols
s PB.ExpressionV2{Repeated 1 (Message Op)
ops :: Repeated 1 (Message Op)
$sel:ops:ExpressionV2 :: ExpressionV2 -> Repeated 1 (Message Op)
ops} = do
[Op]
parsedOps <- (Op -> Either String Op) -> [Op] -> Either String [Op]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Symbols -> Op -> Either String Op
pbToOp Symbols
s) ([Op] -> Either String [Op]) -> [Op] -> Either String [Op]
forall a b. (a -> b) -> a -> b
$ Repeated 1 (Message Op) -> FieldType (Repeated 1 (Message Op))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 1 (Message Op)
ops
[Op] -> Either String Expression
fromStack [Op]
parsedOps
expressionToPb :: ReverseSymbols -> Expression -> PB.ExpressionV2
expressionToPb :: ReverseSymbols -> Expression -> ExpressionV2
expressionToPb ReverseSymbols
s Expression
e =
let ops :: [Op]
ops = ReverseSymbols -> Op -> Op
opToPb ReverseSymbols
s (Op -> Op) -> [Op] -> [Op]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression -> [Op]
toStack Expression
e
in PB.ExpressionV2 { $sel:ops:ExpressionV2 :: Repeated 1 (Message Op)
ops = FieldType (Repeated 1 (Message Op)) -> Repeated 1 (Message Op)
forall a. HasField a => FieldType a -> a
PB.putField [Op]
FieldType (Repeated 1 (Message Op))
ops }
pbToOp :: Symbols -> PB.Op -> Either String Op
pbToOp :: Symbols -> Op -> Either String Op
pbToOp Symbols
s = \case
PB.OpVValue Required 1 (Message TermV2)
v -> Term -> Op
VOp (Term -> Op) -> Either String Term -> Either String Op
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> TermV2 -> Either String Term
pbToTerm Symbols
s (Field 1 (RequiredField (Always (Message TermV2)))
-> FieldType (Field 1 (RequiredField (Always (Message TermV2))))
forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Message TermV2)
Field 1 (RequiredField (Always (Message TermV2)))
v)
PB.OpVUnary Required 2 (Message OpUnary)
v -> Op -> Either String Op
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Op -> Either String Op)
-> (OpUnary -> Op) -> OpUnary -> Either String Op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unary -> Op
UOp (Unary -> Op) -> (OpUnary -> Unary) -> OpUnary -> Op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpUnary -> Unary
pbToUnary (OpUnary -> Either String Op) -> OpUnary -> Either String Op
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Message OpUnary)))
-> FieldType (Field 2 (RequiredField (Always (Message OpUnary))))
forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Message OpUnary)
Field 2 (RequiredField (Always (Message OpUnary)))
v
PB.OpVBinary Required 3 (Message OpBinary)
v -> Op -> Either String Op
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Op -> Either String Op)
-> (OpBinary -> Op) -> OpBinary -> Either String Op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binary -> Op
BOp (Binary -> Op) -> (OpBinary -> Binary) -> OpBinary -> Op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpBinary -> Binary
pbToBinary (OpBinary -> Either String Op) -> OpBinary -> Either String Op
forall a b. (a -> b) -> a -> b
$ Field 3 (RequiredField (Always (Message OpBinary)))
-> FieldType (Field 3 (RequiredField (Always (Message OpBinary))))
forall a. HasField a => a -> FieldType a
PB.getField Required 3 (Message OpBinary)
Field 3 (RequiredField (Always (Message OpBinary)))
v
opToPb :: ReverseSymbols -> Op -> PB.Op
opToPb :: ReverseSymbols -> Op -> Op
opToPb ReverseSymbols
s = \case
VOp Term
t -> Required 1 (Message TermV2) -> Op
PB.OpVValue (Required 1 (Message TermV2) -> Op)
-> Required 1 (Message TermV2) -> Op
forall a b. (a -> b) -> a -> b
$ FieldType (Required 1 (Message TermV2))
-> Required 1 (Message TermV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 1 (Message TermV2))
-> Required 1 (Message TermV2))
-> FieldType (Required 1 (Message TermV2))
-> Required 1 (Message TermV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Term -> TermV2
termToPb ReverseSymbols
s Term
t
UOp Unary
o -> Required 2 (Message OpUnary) -> Op
PB.OpVUnary (Required 2 (Message OpUnary) -> Op)
-> Required 2 (Message OpUnary) -> Op
forall a b. (a -> b) -> a -> b
$ FieldType (Required 2 (Message OpUnary))
-> Required 2 (Message OpUnary)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 2 (Message OpUnary))
-> Required 2 (Message OpUnary))
-> FieldType (Required 2 (Message OpUnary))
-> Required 2 (Message OpUnary)
forall a b. (a -> b) -> a -> b
$ Unary -> OpUnary
unaryToPb Unary
o
BOp Binary
o -> Required 3 (Message OpBinary) -> Op
PB.OpVBinary (Required 3 (Message OpBinary) -> Op)
-> Required 3 (Message OpBinary) -> Op
forall a b. (a -> b) -> a -> b
$ FieldType (Required 3 (Message OpBinary))
-> Required 3 (Message OpBinary)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 3 (Message OpBinary))
-> Required 3 (Message OpBinary))
-> FieldType (Required 3 (Message OpBinary))
-> Required 3 (Message OpBinary)
forall a b. (a -> b) -> a -> b
$ Binary -> OpBinary
binaryToPb Binary
o
pbToUnary :: PB.OpUnary -> Unary
pbToUnary :: OpUnary -> Unary
pbToUnary PB.OpUnary{Required 1 (Enumeration UnaryKind)
kind :: Required 1 (Enumeration UnaryKind)
$sel:kind:OpUnary :: OpUnary -> Required 1 (Enumeration UnaryKind)
kind} = case Field 1 (RequiredField (Always (Enumeration UnaryKind)))
-> FieldType
(Field 1 (RequiredField (Always (Enumeration UnaryKind))))
forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Enumeration UnaryKind)
Field 1 (RequiredField (Always (Enumeration UnaryKind)))
kind of
FieldType
(Field 1 (RequiredField (Always (Enumeration UnaryKind))))
UnaryKind
PB.Negate -> Unary
Negate
FieldType
(Field 1 (RequiredField (Always (Enumeration UnaryKind))))
UnaryKind
PB.Parens -> Unary
Parens
FieldType
(Field 1 (RequiredField (Always (Enumeration UnaryKind))))
UnaryKind
PB.Length -> Unary
Length
unaryToPb :: Unary -> PB.OpUnary
unaryToPb :: Unary -> OpUnary
unaryToPb = Required 1 (Enumeration UnaryKind) -> OpUnary
Field 1 (RequiredField (Always (Enumeration UnaryKind))) -> OpUnary
PB.OpUnary (Field 1 (RequiredField (Always (Enumeration UnaryKind)))
-> OpUnary)
-> (Unary
-> Field 1 (RequiredField (Always (Enumeration UnaryKind))))
-> Unary
-> OpUnary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldType
(Field 1 (RequiredField (Always (Enumeration UnaryKind))))
-> Field 1 (RequiredField (Always (Enumeration UnaryKind)))
UnaryKind
-> Field 1 (RequiredField (Always (Enumeration UnaryKind)))
forall a. HasField a => FieldType a -> a
PB.putField (UnaryKind
-> Field 1 (RequiredField (Always (Enumeration UnaryKind))))
-> (Unary -> UnaryKind)
-> Unary
-> Field 1 (RequiredField (Always (Enumeration UnaryKind)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Unary
Negate -> UnaryKind
PB.Negate
Unary
Parens -> UnaryKind
PB.Parens
Unary
Length -> UnaryKind
PB.Length
pbToBinary :: PB.OpBinary -> Binary
pbToBinary :: OpBinary -> Binary
pbToBinary PB.OpBinary{Required 1 (Enumeration BinaryKind)
kind :: Required 1 (Enumeration BinaryKind)
$sel:kind:OpBinary :: OpBinary -> Required 1 (Enumeration BinaryKind)
kind} = case Field 1 (RequiredField (Always (Enumeration BinaryKind)))
-> FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Enumeration BinaryKind)
Field 1 (RequiredField (Always (Enumeration BinaryKind)))
kind of
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.LessThan -> Binary
LessThan
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.GreaterThan -> Binary
GreaterThan
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.LessOrEqual -> Binary
LessOrEqual
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.GreaterOrEqual -> Binary
GreaterOrEqual
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.Equal -> Binary
Equal
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.Contains -> Binary
Contains
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.Prefix -> Binary
Prefix
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.Suffix -> Binary
Suffix
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.Regex -> Binary
Regex
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.Add -> Binary
Add
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.Sub -> Binary
Sub
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.Mul -> Binary
Mul
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.Div -> Binary
Div
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.And -> Binary
And
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.Or -> Binary
Or
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.Intersection -> Binary
Intersection
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.Union -> Binary
Union
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.BitwiseAnd -> Binary
BitwiseAnd
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.BitwiseOr -> Binary
BitwiseOr
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.BitwiseXor -> Binary
BitwiseXor
FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
BinaryKind
PB.NotEqual -> Binary
NotEqual
binaryToPb :: Binary -> PB.OpBinary
binaryToPb :: Binary -> OpBinary
binaryToPb = Required 1 (Enumeration BinaryKind) -> OpBinary
Field 1 (RequiredField (Always (Enumeration BinaryKind)))
-> OpBinary
PB.OpBinary (Field 1 (RequiredField (Always (Enumeration BinaryKind)))
-> OpBinary)
-> (Binary
-> Field 1 (RequiredField (Always (Enumeration BinaryKind))))
-> Binary
-> OpBinary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldType
(Field 1 (RequiredField (Always (Enumeration BinaryKind))))
-> Field 1 (RequiredField (Always (Enumeration BinaryKind)))
BinaryKind
-> Field 1 (RequiredField (Always (Enumeration BinaryKind)))
forall a. HasField a => FieldType a -> a
PB.putField (BinaryKind
-> Field 1 (RequiredField (Always (Enumeration BinaryKind))))
-> (Binary -> BinaryKind)
-> Binary
-> Field 1 (RequiredField (Always (Enumeration BinaryKind)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Binary
LessThan -> BinaryKind
PB.LessThan
Binary
GreaterThan -> BinaryKind
PB.GreaterThan
Binary
LessOrEqual -> BinaryKind
PB.LessOrEqual
Binary
GreaterOrEqual -> BinaryKind
PB.GreaterOrEqual
Binary
Equal -> BinaryKind
PB.Equal
Binary
Contains -> BinaryKind
PB.Contains
Binary
Prefix -> BinaryKind
PB.Prefix
Binary
Suffix -> BinaryKind
PB.Suffix
Binary
Regex -> BinaryKind
PB.Regex
Binary
Add -> BinaryKind
PB.Add
Binary
Sub -> BinaryKind
PB.Sub
Binary
Mul -> BinaryKind
PB.Mul
Binary
Div -> BinaryKind
PB.Div
Binary
And -> BinaryKind
PB.And
Binary
Or -> BinaryKind
PB.Or
Binary
Intersection -> BinaryKind
PB.Intersection
Binary
Union -> BinaryKind
PB.Union
Binary
BitwiseAnd -> BinaryKind
PB.BitwiseAnd
Binary
BitwiseOr -> BinaryKind
PB.BitwiseOr
Binary
BitwiseXor -> BinaryKind
PB.BitwiseXor
Binary
NotEqual -> BinaryKind
PB.NotEqual
pbToThirdPartyBlockRequest :: PB.ThirdPartyBlockRequest -> Either String (Crypto.PublicKey, [Crypto.PublicKey])
pbToThirdPartyBlockRequest :: ThirdPartyBlockRequest -> Either String (PublicKey, [PublicKey])
pbToThirdPartyBlockRequest PB.ThirdPartyBlockRequest{Required 1 (Message PublicKey)
previousPk :: Required 1 (Message PublicKey)
$sel:previousPk:ThirdPartyBlockRequest :: ThirdPartyBlockRequest -> Required 1 (Message PublicKey)
previousPk, Repeated 2 (Message PublicKey)
pkTable :: Repeated 2 (Message PublicKey)
$sel:pkTable:ThirdPartyBlockRequest :: ThirdPartyBlockRequest -> Repeated 2 (Message PublicKey)
pkTable} = do
(Either String PublicKey, Either String [PublicKey])
-> Either String (PublicKey, [PublicKey])
forall (t :: * -> * -> *) (f :: * -> *) a b.
(Bitraversable t, Applicative f) =>
t (f a) (f b) -> f (t a b)
bisequence
( PublicKey -> Either String PublicKey
pbToPublicKey (PublicKey -> Either String PublicKey)
-> PublicKey -> Either String PublicKey
forall a b. (a -> b) -> a -> b
$ Field 1 (RequiredField (Always (Message PublicKey)))
-> FieldType (Field 1 (RequiredField (Always (Message PublicKey))))
forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Message PublicKey)
Field 1 (RequiredField (Always (Message PublicKey)))
previousPk
, (PublicKey -> Either String PublicKey)
-> [PublicKey] -> Either String [PublicKey]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse PublicKey -> Either String PublicKey
pbToPublicKey ([PublicKey] -> Either String [PublicKey])
-> [PublicKey] -> Either String [PublicKey]
forall a b. (a -> b) -> a -> b
$ Repeated 2 (Message PublicKey)
-> FieldType (Repeated 2 (Message PublicKey))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 2 (Message PublicKey)
pkTable
)
thirdPartyBlockRequestToPb :: (Crypto.PublicKey, [Crypto.PublicKey]) -> PB.ThirdPartyBlockRequest
thirdPartyBlockRequestToPb :: (PublicKey, [PublicKey]) -> ThirdPartyBlockRequest
thirdPartyBlockRequestToPb (PublicKey
previousPk, [PublicKey]
pkTable) = PB.ThirdPartyBlockRequest
{ $sel:previousPk:ThirdPartyBlockRequest :: Required 1 (Message PublicKey)
previousPk = FieldType (Required 1 (Message PublicKey))
-> Required 1 (Message PublicKey)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 1 (Message PublicKey))
-> Required 1 (Message PublicKey))
-> FieldType (Required 1 (Message PublicKey))
-> Required 1 (Message PublicKey)
forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey
publicKeyToPb PublicKey
previousPk
, $sel:pkTable:ThirdPartyBlockRequest :: Repeated 2 (Message PublicKey)
pkTable = FieldType (Repeated 2 (Message PublicKey))
-> Repeated 2 (Message PublicKey)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 2 (Message PublicKey))
-> Repeated 2 (Message PublicKey))
-> FieldType (Repeated 2 (Message PublicKey))
-> Repeated 2 (Message PublicKey)
forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey
publicKeyToPb (PublicKey -> PublicKey) -> [PublicKey] -> [PublicKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PublicKey]
pkTable
}
pbToThirdPartyBlockContents :: PB.ThirdPartyBlockContents -> Either String (ByteString, Crypto.Signature, Crypto.PublicKey)
pbToThirdPartyBlockContents :: ThirdPartyBlockContents
-> Either String (ByteString, Signature, PublicKey)
pbToThirdPartyBlockContents PB.ThirdPartyBlockContents{Required 1 (Value ByteString)
payload :: Required 1 (Value ByteString)
$sel:payload:ThirdPartyBlockContents :: ThirdPartyBlockContents -> Required 1 (Value ByteString)
payload,Required 2 (Message ExternalSig)
externalSig :: Required 2 (Message ExternalSig)
$sel:externalSig:ThirdPartyBlockContents :: ThirdPartyBlockContents -> Required 2 (Message ExternalSig)
externalSig} = do
(Signature
sig, PublicKey
pk) <- ExternalSig -> Either String (Signature, PublicKey)
pbToOptionalSignature (ExternalSig -> Either String (Signature, PublicKey))
-> ExternalSig -> Either String (Signature, PublicKey)
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Message ExternalSig)))
-> FieldType
(Field 2 (RequiredField (Always (Message ExternalSig))))
forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Message ExternalSig)
Field 2 (RequiredField (Always (Message ExternalSig)))
externalSig
(ByteString, Signature, PublicKey)
-> Either String (ByteString, Signature, PublicKey)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( Field 1 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 1 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Value ByteString)
Field 1 (RequiredField (Always (Value ByteString)))
payload
, Signature
sig
, PublicKey
pk
)
thirdPartyBlockContentsToPb :: (ByteString, Crypto.Signature, Crypto.PublicKey) -> PB.ThirdPartyBlockContents
thirdPartyBlockContentsToPb :: (ByteString, Signature, PublicKey) -> ThirdPartyBlockContents
thirdPartyBlockContentsToPb (ByteString
payload, Signature
sig, PublicKey
pk) = PB.ThirdPartyBlockContents
{ $sel:payload:ThirdPartyBlockContents :: Required 1 (Value ByteString)
PB.payload = FieldType (Field 1 (RequiredField (Always (Value ByteString))))
-> Field 1 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
PB.putField ByteString
FieldType (Field 1 (RequiredField (Always (Value ByteString))))
payload
, $sel:externalSig:ThirdPartyBlockContents :: Required 2 (Message ExternalSig)
PB.externalSig = FieldType (Required 2 (Message ExternalSig))
-> Required 2 (Message ExternalSig)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 2 (Message ExternalSig))
-> Required 2 (Message ExternalSig))
-> FieldType (Required 2 (Message ExternalSig))
-> Required 2 (Message ExternalSig)
forall a b. (a -> b) -> a -> b
$ (Signature, PublicKey) -> ExternalSig
externalSigToPb (Signature
sig, PublicKey
pk)
}