{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TypeApplications  #-}
{-|
  Module      : Auth.Biscuit.Utils
  Copyright   : © Clément Delafargue, 2021
  License     : MIT
  Maintainer  : clement@delafargue.name
  Conversion functions between biscuit components and protobuf-encoded components
-}
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)
$sel:key:PublicKey :: PublicKey -> Required 2 (Value ByteString)
$sel:algorithm:PublicKey :: PublicKey -> Required 1 (Enumeration Algorithm)
key :: Required 2 (Value ByteString)
algorithm :: Required 1 (Enumeration Algorithm)
..} =
  let keyBytes :: FieldType (Field 2 (RequiredField (Always (Value ByteString))))
keyBytes = forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Value ByteString)
key
      parseKey :: ByteString -> Maybe PublicKey
parseKey = ByteString -> Maybe PublicKey
Crypto.readEd25519PublicKey
   in case forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Enumeration Algorithm)
algorithm of
        FieldType
  (Field 1 (RequiredField (Always (Enumeration Algorithm))))
Algorithm
PB.Ed25519 -> forall b a. b -> Maybe a -> Either b a
maybeToRight String
"Invalid ed25519 public key" 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)
$sel:publicKey:ExternalSig :: ExternalSig -> Required 2 (Message PublicKey)
$sel:signature:ExternalSig :: ExternalSig -> Required 1 (Value ByteString)
publicKey :: Required 2 (Message PublicKey)
signature :: Required 1 (Value ByteString)
..} = do
  let sig :: Signature
sig = ByteString -> Signature
Crypto.signature forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Value ByteString)
signature
  PublicKey
pk  <- PublicKey -> Either String PublicKey
pbToPublicKey forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Message PublicKey)
publicKey
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signature
sig, PublicKey
pk)

-- | Parse a protobuf signed block into a signed biscuit block
pbToSignedBlock :: PB.SignedBlock -> Either String Crypto.SignedBlock
pbToSignedBlock :: SignedBlock -> Either String SignedBlock
pbToSignedBlock PB.SignedBlock{Optional 4 (Message ExternalSig)
Required 1 (Value ByteString)
Required 2 (Message PublicKey)
Required 3 (Value ByteString)
$sel:externalSig:SignedBlock :: SignedBlock -> Optional 4 (Message ExternalSig)
$sel:signature:SignedBlock :: SignedBlock -> Required 3 (Value ByteString)
$sel:nextKey:SignedBlock :: SignedBlock -> Required 2 (Message PublicKey)
$sel:block:SignedBlock :: SignedBlock -> Required 1 (Value ByteString)
externalSig :: Optional 4 (Message ExternalSig)
signature :: Required 3 (Value ByteString)
nextKey :: Required 2 (Message PublicKey)
block :: Required 1 (Value ByteString)
..} = do
  let sig :: Signature
sig = ByteString -> Signature
Crypto.signature forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 3 (Value ByteString)
signature
  Maybe (Signature, PublicKey)
mSig <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ExternalSig -> Either String (Signature, PublicKey)
pbToOptionalSignature forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Optional 4 (Message ExternalSig)
externalSig
  PublicKey
pk  <- PublicKey -> Either String PublicKey
pbToPublicKey forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Message PublicKey)
nextKey
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ( forall a. HasField a => a -> FieldType a
PB.getField Required 1 (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 = forall a. HasField a => FieldType a -> a
PB.putField Algorithm
PB.Ed25519
  , $sel:key:PublicKey :: Required 2 (Value ByteString)
key = forall a. HasField a => FieldType a -> a
PB.putField 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 = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ Signature -> ByteString
Crypto.sigBytes Signature
sig
  , $sel:publicKey:ExternalSig :: Required 2 (Message PublicKey)
publicKey = forall a. HasField a => FieldType a -> a
PB.putField 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 = forall a. HasField a => FieldType a -> a
PB.putField ByteString
block
  , $sel:signature:SignedBlock :: Required 3 (Value ByteString)
signature = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ Signature -> ByteString
Crypto.sigBytes Signature
sig
  , $sel:nextKey:SignedBlock :: Required 2 (Message PublicKey)
nextKey = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey
publicKeyToPb PublicKey
pk
  , $sel:externalSig:SignedBlock :: Optional 4 (Message ExternalSig)
externalSig = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ (Signature, PublicKey) -> ExternalSig
externalSigToPb 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) = forall a b. a -> Either a b
Left  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. b -> Either a b
Right (ByteString -> Signature
Crypto.signature forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Value ByteString)
rawSig)
pbToProof (PB.ProofSecret    Required 1 (Value ByteString)
rawPk)  = forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> Maybe a -> Either b a
maybeToRight String
"Invalid public key proof" (ByteString -> Maybe SecretKey
Crypto.readEd25519SecretKey forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 1 (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{Repeated 1 (Value Text)
Repeated 4 (Message FactV2)
Repeated 5 (Message RuleV2)
Repeated 6 (Message CheckV2)
Repeated 7 (Message Scope)
Repeated 8 (Message PublicKey)
Optional 2 (Value Text)
Optional 3 (Value Int32)
$sel:pksTable:Block :: Block -> Repeated 8 (Message PublicKey)
$sel:scope:Block :: Block -> Repeated 7 (Message Scope)
$sel:checks_v2:Block :: Block -> Repeated 6 (Message CheckV2)
$sel:rules_v2:Block :: Block -> Repeated 5 (Message RuleV2)
$sel:facts_v2:Block :: Block -> Repeated 4 (Message FactV2)
$sel:version:Block :: Block -> Optional 3 (Value Int32)
$sel:context:Block :: Block -> Optional 2 (Value Text)
$sel:symbols:Block :: Block -> Repeated 1 (Value Text)
pksTable :: Repeated 8 (Message PublicKey)
scope :: Repeated 7 (Message Scope)
checks_v2 :: Repeated 6 (Message CheckV2)
rules_v2 :: Repeated 5 (Message RuleV2)
facts_v2 :: Repeated 4 (Message FactV2)
version :: Optional 3 (Value Int32)
context :: Optional 2 (Value Text)
symbols :: Repeated 1 (Value Text)
..} = do
  [PublicKey]
blockPks <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse PublicKey -> Either String PublicKey
pbToPublicKey forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Repeated 8 (Message PublicKey)
pksTable
  let blockSymbols :: FieldType (Repeated 1 (Value Text))
blockSymbols = forall a. HasField a => a -> FieldType a
PB.getField Repeated 1 (Value Text)
symbols
  -- third party blocks use an isolated symbol table,
  -- but use the global public keys table:
  --   symbols defined in 3rd party blocks are not visible
  --   to following blocks, but public keys are
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe PublicKey
ePk) forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([Text] -> Symbols -> Symbols
registerNewSymbols [Text]
blockSymbols)
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([PublicKey] -> Symbols -> Symbols
registerNewPublicKeys forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PublicKey
ePk forall a. Semigroup a => a -> a -> a
<> [PublicKey]
blockPks)
  Symbols
currentSymbols <- forall s (m :: * -> *). MonadState s m => m s
get

  let symbolsForCurrentBlock :: Symbols
symbolsForCurrentBlock =
        -- third party blocks use an isolated symbol table,
        -- but use the global public keys table.
        --   3rd party blocks don't see previously defined
        --   symbols, but see previously defined public keys
        if forall a. Maybe a -> Bool
isNothing Maybe PublicKey
ePk then Symbols
currentSymbols
                         else [Text] -> Symbols -> Symbols
registerNewSymbols [Text]
blockSymbols forall a b. (a -> b) -> a -> b
$ Symbols -> Symbols
forgetSymbols Symbols
currentSymbols
  let bContext :: FieldType (Field 2 (OptionalField (Last (Value Text))))
bContext = forall a. HasField a => a -> FieldType a
PB.getField Optional 2 (Value Text)
context
      bVersion :: FieldType (Field 3 (OptionalField (Last (Value Int32))))
bVersion = forall a. HasField a => a -> FieldType a
PB.getField Optional 3 (Value Int32)
version
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ do
    let s :: Symbols
s = Symbols
symbolsForCurrentBlock
    [Fact]
bFacts <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> FactV2 -> Either String Fact
pbToFact Symbols
s) forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Repeated 4 (Message FactV2)
facts_v2
    [Rule]
bRules <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> RuleV2 -> Either String Rule
pbToRule Symbols
s) forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Repeated 5 (Message RuleV2)
rules_v2
    [Check]
bChecks <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> CheckV2 -> Either String Check
pbToCheck Symbols
s) forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Repeated 6 (Message CheckV2)
checks_v2
    Set RuleScope
bScope <- forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> Scope -> Either String RuleScope
pbToScope Symbols
s) (forall a. HasField a => a -> FieldType a
PB.getField Repeated 7 (Message Scope)
scope)
    let isV3 :: Bool
isV3 = forall a. Maybe a -> Bool
isNothing Maybe PublicKey
ePk
            Bool -> Bool -> Bool
&& forall a. Set a -> Bool
Set.null Set RuleScope
bScope
            Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Rule -> Bool
ruleHasNoScope [Rule]
bRules
            Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Query -> Bool
queryHasNoScope (forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cQueries forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Check]
bChecks)
            Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Bool
isCheckOne [Check]
bChecks
            Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Rule -> Bool
ruleHasNoV4Operators [Rule]
bRules
            Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Query -> Bool
queryHasNoV4Operators (forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cQueries 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
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Block {[Rule]
[Check]
[Fact]
Maybe Text
Set RuleScope
bScope :: Set RuleScope
bContext :: Maybe Text
bChecks :: [Check]
bFacts :: [Fact]
bRules :: [Rule]
bScope :: Set RuleScope
bChecks :: [Check]
bRules :: [Rule]
bFacts :: [Fact]
bContext :: Maybe Text
..}
      (Just Int32
3, Bool
True) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Block {[Rule]
[Check]
[Fact]
Maybe Text
Set RuleScope
bScope :: Set RuleScope
bContext :: Maybe Text
bChecks :: [Check]
bFacts :: [Fact]
bRules :: [Rule]
bScope :: Set RuleScope
bChecks :: [Check]
bRules :: [Rule]
bFacts :: [Fact]
bContext :: Maybe Text
..}
      (Just Int32
3, Bool
False) ->
        forall a b. a -> Either a b
Left String
"Biscuit v4 fields are present, but the block version is 3."
      (Maybe Int32, Bool)
_ ->
        forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unsupported biscuit version: " forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"0" forall a. Show a => a -> String
show Maybe Int32
bVersion forall a. Semigroup a => a -> a -> a
<> String
". Only versions 3 and 4 are supported"

-- | Turn a biscuit block into a protobuf block, for serialization,
-- along with the newly defined symbols
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
bScope :: Set RuleScope
bContext :: Maybe Text
bChecks :: [Check]
bFacts :: [Fact]
bRules :: [Rule]
bScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
bContext :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> Maybe Text
bChecks :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Check' evalCtx ctx]
bFacts :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Predicate' 'InFact ctx]
bRules :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Block' evalCtx ctx -> [Rule' evalCtx ctx]
..} =
  let isV3 :: Bool
isV3 = Bool -> Bool
not Bool
hasExternalPk
            Bool -> Bool -> Bool
&& forall a. Set a -> Bool
Set.null Set RuleScope
bScope
            Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Rule -> Bool
ruleHasNoScope [Rule]
bRules
            Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Query -> Bool
queryHasNoScope (forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cQueries forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Check]
bChecks)
            Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Bool
isCheckOne [Check]
bChecks
            Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Rule -> Bool
ruleHasNoV4Operators [Rule]
bRules
            Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Query -> Bool
queryHasNoV4Operators (forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
cQueries 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 forall a b. (a -> b) -> a -> b
$ Symbols -> BlockSymbols -> Symbols
addFromBlock Symbols
existingSymbols BlockSymbols
bSymbols
      symbols :: Repeated 1 (Value Text)
symbols   = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ BlockSymbols -> [Text]
getSymbolList BlockSymbols
bSymbols
      context :: Field 2 (OptionalField (Last (Value Text)))
context   = forall a. HasField a => FieldType a -> a
PB.putField Maybe Text
bContext
      facts_v2 :: Repeated 4 (Message FactV2)
facts_v2  = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Fact -> FactV2
factToPb ReverseSymbols
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Fact]
bFacts
      rules_v2 :: Repeated 5 (Message RuleV2)
rules_v2  = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Rule -> RuleV2
ruleToPb ReverseSymbols
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rule]
bRules
      checks_v2 :: Repeated 6 (Message CheckV2)
checks_v2 = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Check -> CheckV2
checkToPb ReverseSymbols
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Check]
bChecks
      scope :: Repeated 7 (Message Scope)
scope     = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> RuleScope -> Scope
scopeToPb ReverseSymbols
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
Set.toList Set RuleScope
bScope
      pksTable :: Repeated 8 (Message PublicKey)
pksTable   = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey
publicKeyToPb 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   = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ if Bool
isV3 then forall a. a -> Maybe a
Just Int32
3
                                        else forall a. a -> Maybe a
Just Int32
4
   in (BlockSymbols
bSymbols, PB.Block {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)
version :: Field 3 (OptionalField (Last (Value Int32)))
pksTable :: Repeated 8 (Message PublicKey)
scope :: Repeated 7 (Message Scope)
checks_v2 :: Repeated 6 (Message CheckV2)
rules_v2 :: Repeated 5 (Message RuleV2)
facts_v2 :: Repeated 4 (Message FactV2)
context :: Field 2 (OptionalField (Last (Value Text)))
symbols :: Repeated 1 (Value Text)
$sel:pksTable:Block :: Repeated 8 (Message PublicKey)
$sel:scope:Block :: Repeated 7 (Message Scope)
$sel:checks_v2:Block :: Repeated 6 (Message CheckV2)
$sel:rules_v2:Block :: Repeated 5 (Message RuleV2)
$sel:facts_v2:Block :: Repeated 4 (Message FactV2)
$sel:version:Block :: Optional 3 (Value Int32)
$sel:context:Block :: Optional 2 (Value Text)
$sel:symbols:Block :: Repeated 1 (Value Text)
..})

pbToFact :: Symbols -> PB.FactV2 -> Either String Fact
pbToFact :: Symbols -> FactV2 -> Either String Fact
pbToFact Symbols
s PB.FactV2{Required 1 (Message PredicateV2)
$sel:predicate:FactV2 :: FactV2 -> Required 1 (Message PredicateV2)
predicate :: Required 1 (Message PredicateV2)
predicate} = do
  let pbName :: FieldType (Field 1 (RequiredField (Always (Value Int64))))
pbName  = forall a. HasField a => a -> FieldType a
PB.getField forall a b. (a -> b) -> a -> b
$ PredicateV2 -> Required 1 (Value Int64)
PB.name  forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Message PredicateV2)
predicate
      pbTerms :: FieldType (Repeated 2 (Message TermV2))
pbTerms = forall a. HasField a => a -> FieldType a
PB.getField forall a b. (a -> b) -> a -> b
$ PredicateV2 -> Repeated 2 (Message TermV2)
PB.terms forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Message PredicateV2)
predicate
  Text
name <- Symbols -> SymbolRef -> Either String Text
getSymbol Symbols
s forall a b. (a -> b) -> a -> b
$ Int64 -> SymbolRef
SymbolRef Int64
pbName
  [Value]
terms <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> TermV2 -> Either String Value
pbToValue Symbols
s) [TermV2]
pbTerms
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Predicate{[Value]
Text
terms :: [Value]
name :: Text
terms :: [Value]
name :: Text
..}

factToPb :: ReverseSymbols -> Fact -> PB.FactV2
factToPb :: ReverseSymbols -> Fact -> FactV2
factToPb ReverseSymbols
s Predicate{[Value]
Text
terms :: [Value]
name :: Text
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
..} =
  let
      predicate :: PredicateV2
predicate = PB.PredicateV2
        { $sel:name:PredicateV2 :: Required 1 (Value Int64)
name  = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ SymbolRef -> Int64
getSymbolRef forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Text -> SymbolRef
getSymbolCode ReverseSymbols
s Text
name
        , $sel:terms:PredicateV2 :: Repeated 2 (Message TermV2)
terms = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Value -> TermV2
valueToPb ReverseSymbols
s 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 = forall a. HasField a => FieldType a -> a
PB.putField 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 = forall a. HasField a => a -> FieldType a
PB.getField forall a b. (a -> b) -> a -> b
$ RuleV2 -> Required 1 (Message PredicateV2)
PB.head RuleV2
pbRule
      pbBody :: FieldType (Repeated 2 (Message PredicateV2))
pbBody = forall a. HasField a => a -> FieldType a
PB.getField forall a b. (a -> b) -> a -> b
$ RuleV2 -> Repeated 2 (Message PredicateV2)
PB.body RuleV2
pbRule
      pbExpressions :: FieldType (Repeated 3 (Message ExpressionV2))
pbExpressions = forall a. HasField a => a -> FieldType a
PB.getField forall a b. (a -> b) -> a -> b
$ RuleV2 -> Repeated 3 (Message ExpressionV2)
PB.expressions RuleV2
pbRule
      pbScope :: FieldType (Repeated 4 (Message Scope))
pbScope = forall a. HasField a => a -> FieldType a
PB.getField forall a b. (a -> b) -> a -> b
$ forall {k} (x :: k) 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        <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols
-> PredicateV2
-> Either String (Predicate' 'InPredicate 'Representation)
pbToPredicate Symbols
s) [PredicateV2]
pbBody
  [Expression]
expressions <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> ExpressionV2 -> Either String Expression
pbToExpression Symbols
s) [ExpressionV2]
pbExpressions
  Set RuleScope
scope       <- forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> Scope -> Either String RuleScope
pbToScope Symbols
s) [Scope]
pbScope
  case 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 -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unbound variables in rule: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Text -> [Text] -> Text
T.intercalate Text
", " forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty Text
vs)
    Success Rule
r  -> 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
scope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
expressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Expression' ctx]
body :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Predicate' 'InPredicate ctx]
rhead :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> Predicate' 'InPredicate ctx
scope :: Set RuleScope
expressions :: [Expression]
body :: [Predicate' 'InPredicate 'Representation]
rhead :: Predicate' 'InPredicate 'Representation
..} =
  PB.RuleV2
    { $sel:head:RuleV2 :: Required 1 (Message PredicateV2)
head = forall a. HasField a => FieldType a -> a
PB.putField 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 = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ ReverseSymbols
-> Predicate' 'InPredicate 'Representation -> PredicateV2
predicateToPb ReverseSymbols
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Predicate' 'InPredicate 'Representation]
body
    , $sel:expressions:RuleV2 :: Repeated 3 (Message ExpressionV2)
expressions = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Expression -> ExpressionV2
expressionToPb ReverseSymbols
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expression]
expressions
    , $sel:scope:RuleV2 :: Repeated 4 (Message Scope)
scope = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> RuleScope -> Scope
scopeToPb ReverseSymbols
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
$sel:queries:CheckV2 :: CheckV2 -> Repeated 1 (Message RuleV2)
queries :: Repeated 1 (Message RuleV2)
queries,Optional 2 (Enumeration CheckKind)
$sel:kind:CheckV2 :: CheckV2 -> Optional 2 (Enumeration CheckKind)
kind :: Optional 2 (Enumeration CheckKind)
kind} = do
  let toCheck :: Rule' evalCtx ctx -> QueryItem' evalCtx ctx
toCheck Rule{[Predicate' 'InPredicate ctx]
body :: [Predicate' 'InPredicate ctx]
body :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Predicate' 'InPredicate ctx]
body,[Expression' ctx]
expressions :: [Expression' ctx]
expressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> [Expression' ctx]
expressions,Set (RuleScope' evalCtx ctx)
scope :: Set (RuleScope' evalCtx ctx)
scope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> 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 <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> RuleV2 -> Either String Rule
pbToRule Symbols
s) forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Repeated 1 (Message RuleV2)
queries
  let cQueries :: Query
cQueries = forall {evalCtx :: EvaluationContext} {ctx :: DatalogContext}.
Rule' evalCtx ctx -> QueryItem' evalCtx ctx
toCheck forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rule]
rules
  let cKind :: CheckKind
cKind = case forall a. HasField a => a -> FieldType a
PB.getField Optional 2 (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
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Check{Query
CheckKind
cKind :: CheckKind
cKind :: CheckKind
cQueries :: Query
cQueries :: Query
..}

checkToPb :: ReverseSymbols -> Check -> PB.CheckV2
checkToPb :: ReverseSymbols -> Check -> CheckV2
checkToPb ReverseSymbols
s Check{Query
CheckKind
cKind :: CheckKind
cQueries :: Query
cKind :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> CheckKind
cQueries :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> Query' evalCtx ctx
..} =
  let dummyHead :: Predicate' pof ctx
dummyHead = 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
qScope :: Set RuleScope
qExpressions :: [Expression]
qBody :: [Predicate' 'InPredicate 'Representation]
qScope :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> Set (RuleScope' evalCtx ctx)
qExpressions :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Expression' ctx]
qBody :: forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
QueryItem' evalCtx ctx -> [Predicate' 'InPredicate ctx]
..} =
        ReverseSymbols -> Rule -> RuleV2
ruleToPb ReverseSymbols
s forall a b. (a -> b) -> a -> b
$ Rule { rhead :: Predicate' 'InPredicate 'Representation
rhead = 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 -> forall a. Maybe a
Nothing
        CheckKind
All -> forall a. a -> Maybe a
Just CheckKind
PB.All
   in PB.CheckV2 { $sel:queries:CheckV2 :: Repeated 1 (Message RuleV2)
queries = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ QueryItem' 'Repr 'Representation -> RuleV2
toQuery forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query
cQueries
                 , $sel:kind:CheckV2 :: Optional 2 (Enumeration CheckKind)
kind = forall a. HasField a => FieldType a -> a
PB.putField Maybe 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 forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Enumeration ScopeType)
e of
    FieldType
  (Field 1 (RequiredField (Always (Enumeration ScopeType))))
ScopeType
PB.ScopeAuthority -> forall a b. b -> Either a b
Right forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
OnlyAuthority
    FieldType
  (Field 1 (RequiredField (Always (Enumeration ScopeType))))
ScopeType
PB.ScopePrevious  -> forall a b. b -> Either a b
Right forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
Previous
  PB.ScBlock Required 2 (Value Int64)
pkRef ->
    forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
BlockIdType evalCtx ctx -> RuleScope' evalCtx ctx
BlockId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> PublicKeyRef -> Either String PublicKey
getPublicKey' Symbols
s (Int64 -> PublicKeyRef
PublicKeyRef forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 2 (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 forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField ScopeType
PB.ScopeAuthority
  RuleScope
Previous      -> Required 1 (Enumeration ScopeType) -> Scope
PB.ScType forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField ScopeType
PB.ScopePrevious
  BlockId BlockIdType 'Repr 'Representation
pk    -> Required 2 (Value Int64) -> Scope
PB.ScBlock forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> PublicKey -> Int64
getPublicKeyCode ReverseSymbols
s 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  = forall a. HasField a => a -> FieldType a
PB.getField forall a b. (a -> b) -> a -> b
$ PredicateV2 -> Required 1 (Value Int64)
PB.name  PredicateV2
pbPredicate
      pbTerms :: FieldType (Repeated 2 (Message TermV2))
pbTerms = forall a. HasField a => a -> FieldType a
PB.getField 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 forall a b. (a -> b) -> a -> b
$ Int64 -> SymbolRef
SymbolRef Int64
pbName
  [Term]
terms <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> TermV2 -> Either String Term
pbToTerm Symbols
s) [TermV2]
pbTerms
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Predicate{[Term]
Text
terms :: [Term]
name :: Text
terms :: [Term]
name :: Text
..}

predicateToPb :: ReverseSymbols -> Predicate -> PB.PredicateV2
predicateToPb :: ReverseSymbols
-> Predicate' 'InPredicate 'Representation -> PredicateV2
predicateToPb ReverseSymbols
s Predicate{[Term]
Text
terms :: [Term]
name :: Text
terms :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
name :: forall (pof :: PredicateOrFact) (ctx :: DatalogContext).
Predicate' pof ctx -> Text
..} =
  PB.PredicateV2
    { $sel:name:PredicateV2 :: Required 1 (Value Int64)
name  = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ SymbolRef -> Int64
getSymbolRef forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Text -> SymbolRef
getSymbolCode ReverseSymbols
s Text
name
    , $sel:terms:PredicateV2 :: Repeated 2 (Message TermV2)
terms = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Term -> TermV2
termToPb ReverseSymbols
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Term]
terms
    }

pbTimeToUtcTime :: Int64 -> UTCTime
pbTimeToUtcTime :: Int64 -> UTCTime
pbTimeToUtcTime = POSIXTime -> UTCTime
posixSecondsToUTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Int -> Term' inSet pof ctx
LInteger forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Value Int64)
f
  PB.TermString   Required 3 (Value Int64)
f ->        forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> SymbolRef -> Either String Text
getSymbol Symbols
s (Int64 -> SymbolRef
SymbolRef forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 3 (Value Int64)
f)
  PB.TermDate     Required 4 (Value Int64)
f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate    forall a b. (a -> b) -> a -> b
$ Int64 -> UTCTime
pbTimeToUtcTime forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 4 (Value Int64)
f
  PB.TermBytes    Required 5 (Value ByteString)
f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes   forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 5 (Value ByteString)
f
  PB.TermBool     Required 6 (Value Bool)
f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool    forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 6 (Value Bool)
f
  PB.TermVariable Required 1 (Value Int64)
f -> forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
VariableType inSet pof -> Term' inSet pof ctx
Variable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> SymbolRef -> Either String Text
getSymbol Symbols
s (Int64 -> SymbolRef
SymbolRef forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Value Int64)
f)
  PB.TermTermSet  Required 7 (Message TermSet)
f -> forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
SetType inSet ctx -> Term' inSet pof ctx
TermSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols
-> TermV2
-> Either String (Term' 'WithinSet 'InFact 'Representation)
pbToSetValue Symbols
s) (forall a. HasField a => a -> FieldType a
PB.getField forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermSet -> Repeated 1 (Message TermV2)
PB.set forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 7 (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 forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ SymbolRef -> Int64
getSymbolRef forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Text -> SymbolRef
getSymbolCode ReverseSymbols
s VariableType 'NotWithinSet 'InPredicate
n
  LInteger Int
v -> Required 2 (Value Int64) -> TermV2
PB.TermInteger  forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
  LString  Text
v -> Required 3 (Value Int64) -> TermV2
PB.TermString   forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ SymbolRef -> Int64
getSymbolRef 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     forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
v
  LBytes   ByteString
v -> Required 5 (Value ByteString) -> TermV2
PB.TermBytes    forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField ByteString
v
  LBool    Bool
v -> Required 6 (Value Bool) -> TermV2
PB.TermBool     forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField Bool
v
  TermSet SetType 'NotWithinSet 'Representation
vs -> Required 7 (Message TermSet) -> TermV2
PB.TermTermSet  forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ Repeated 1 (Message TermV2) -> TermSet
PB.TermSet forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ ReverseSymbols
-> Term' 'WithinSet 'InFact 'Representation -> TermV2
setValueToPb ReverseSymbols
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
Set.toList SetType 'NotWithinSet 'Representation
vs

  Antiquote SliceType 'Representation
v -> forall a. Void -> a
absurd 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Int -> Term' inSet pof ctx
LInteger forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Value Int64)
f
  PB.TermString   Required 3 (Value Int64)
f ->        forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> SymbolRef -> Either String Text
getSymbol Symbols
s (Int64 -> SymbolRef
SymbolRef forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 3 (Value Int64)
f)
  PB.TermDate     Required 4 (Value Int64)
f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate    forall a b. (a -> b) -> a -> b
$ Int64 -> UTCTime
pbTimeToUtcTime forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 4 (Value Int64)
f
  PB.TermBytes    Required 5 (Value ByteString)
f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes   forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 5 (Value ByteString)
f
  PB.TermBool     Required 6 (Value Bool)
f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool    forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 6 (Value Bool)
f
  PB.TermVariable Required 1 (Value Int64)
_ -> forall a b. a -> Either a b
Left String
"Variables can't appear in facts"
  PB.TermTermSet  Required 7 (Message TermSet)
f -> forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
SetType inSet ctx -> Term' inSet pof ctx
TermSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols
-> TermV2
-> Either String (Term' 'WithinSet 'InFact 'Representation)
pbToSetValue Symbols
s) (forall a. HasField a => a -> FieldType a
PB.getField forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermSet -> Repeated 1 (Message TermV2)
PB.set forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 7 (Message TermSet)
f)

valueToPb :: ReverseSymbols -> Value -> PB.TermV2
valueToPb :: ReverseSymbols -> Value -> TermV2
valueToPb ReverseSymbols
s = \case
  LInteger Int
v -> Required 2 (Value Int64) -> TermV2
PB.TermInteger forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
  LString  Text
v -> Required 3 (Value Int64) -> TermV2
PB.TermString  forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ SymbolRef -> Int64
getSymbolRef 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    forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
v
  LBytes   ByteString
v -> Required 5 (Value ByteString) -> TermV2
PB.TermBytes   forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField ByteString
v
  LBool    Bool
v -> Required 6 (Value Bool) -> TermV2
PB.TermBool    forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField Bool
v
  TermSet SetType 'NotWithinSet 'Representation
vs -> Required 7 (Message TermSet) -> TermV2
PB.TermTermSet forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ Repeated 1 (Message TermV2) -> TermSet
PB.TermSet forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ ReverseSymbols
-> Term' 'WithinSet 'InFact 'Representation -> TermV2
setValueToPb ReverseSymbols
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
Set.toList SetType 'NotWithinSet 'Representation
vs

  Variable VariableType 'NotWithinSet 'InFact
v  -> forall a. Void -> a
absurd VariableType 'NotWithinSet 'InFact
v
  Antiquote SliceType 'Representation
v -> forall a. Void -> a
absurd SliceType 'Representation
v

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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Int -> Term' inSet pof ctx
LInteger forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Value Int64)
f
  PB.TermString   Required 3 (Value Int64)
f ->        forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> SymbolRef -> Either String Text
getSymbol Symbols
s (Int64 -> SymbolRef
SymbolRef forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 3 (Value Int64)
f)
  PB.TermDate     Required 4 (Value Int64)
f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate    forall a b. (a -> b) -> a -> b
$ Int64 -> UTCTime
pbTimeToUtcTime forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 4 (Value Int64)
f
  PB.TermBytes    Required 5 (Value ByteString)
f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes   forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 5 (Value ByteString)
f
  PB.TermBool     Required 6 (Value Bool)
f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool    forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 6 (Value Bool)
f
  PB.TermVariable Required 1 (Value Int64)
_ -> forall a b. a -> Either a b
Left String
"Variables can't appear in facts or sets"
  PB.TermTermSet  Required 7 (Message TermSet)
_ -> 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 Int
v  -> Required 2 (Value Int64) -> TermV2
PB.TermInteger forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
  LString  Text
v  -> Required 3 (Value Int64) -> TermV2
PB.TermString  forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ SymbolRef -> Int64
getSymbolRef 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    forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
v
  LBytes   ByteString
v  -> Required 5 (Value ByteString) -> TermV2
PB.TermBytes   forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField ByteString
v
  LBool    Bool
v  -> Required 6 (Value Bool) -> TermV2
PB.TermBool    forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField Bool
v

  TermSet   SetType 'WithinSet 'Representation
v -> forall a. Void -> a
absurd SetType 'WithinSet 'Representation
v
  Variable  VariableType 'WithinSet 'InFact
v -> forall a. Void -> a
absurd VariableType 'WithinSet 'InFact
v
  Antiquote SliceType 'Representation
v -> forall a. Void -> a
absurd SliceType 'Representation
v

pbToExpression :: Symbols -> PB.ExpressionV2 -> Either String Expression
pbToExpression :: Symbols -> ExpressionV2 -> Either String Expression
pbToExpression Symbols
s PB.ExpressionV2{Repeated 1 (Message Op)
$sel:ops:ExpressionV2 :: ExpressionV2 -> Repeated 1 (Message Op)
ops :: Repeated 1 (Message Op)
ops} = do
  [Op]
parsedOps <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> Op -> Either String Op
pbToOp Symbols
s) forall a b. (a -> b) -> a -> b
$ 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 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 = forall a. HasField a => FieldType a -> a
PB.putField [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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> TermV2 -> Either String Term
pbToTerm Symbols
s (forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Message TermV2)
v)
  PB.OpVUnary Required 2 (Message OpUnary)
v  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unary -> Op
UOp forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpUnary -> Unary
pbToUnary forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Message OpUnary)
v
  PB.OpVBinary Required 3 (Message OpBinary)
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binary -> Op
BOp forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpBinary -> Binary
pbToBinary forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 3 (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  forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField 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  forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ Unary -> OpUnary
unaryToPb Unary
o
  BOp Binary
o -> Required 3 (Message OpBinary) -> Op
PB.OpVBinary forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField 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)
$sel:kind:OpUnary :: OpUnary -> Required 1 (Enumeration UnaryKind)
kind :: Required 1 (Enumeration UnaryKind)
kind} = case forall a. HasField a => a -> FieldType a
PB.getField Required 1 (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
PB.OpUnary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasField a => FieldType a -> a
PB.putField 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)
$sel:kind:OpBinary :: OpBinary -> Required 1 (Enumeration BinaryKind)
kind :: Required 1 (Enumeration BinaryKind)
kind} = case forall a. HasField a => a -> FieldType a
PB.getField Required 1 (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

binaryToPb :: Binary -> PB.OpBinary
binaryToPb :: Binary -> OpBinary
binaryToPb = Required 1 (Enumeration BinaryKind) -> OpBinary
PB.OpBinary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasField a => FieldType a -> a
PB.putField 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


pbToThirdPartyBlockRequest :: PB.ThirdPartyBlockRequest -> Either String (Crypto.PublicKey, [Crypto.PublicKey])
pbToThirdPartyBlockRequest :: ThirdPartyBlockRequest -> Either String (PublicKey, [PublicKey])
pbToThirdPartyBlockRequest PB.ThirdPartyBlockRequest{Required 1 (Message PublicKey)
$sel:previousPk:ThirdPartyBlockRequest :: ThirdPartyBlockRequest -> Required 1 (Message PublicKey)
previousPk :: Required 1 (Message PublicKey)
previousPk, Repeated 2 (Message PublicKey)
$sel:pkTable:ThirdPartyBlockRequest :: ThirdPartyBlockRequest -> Repeated 2 (Message PublicKey)
pkTable :: Repeated 2 (Message PublicKey)
pkTable} = do
  forall (t :: * -> * -> *) (f :: * -> *) a b.
(Bitraversable t, Applicative f) =>
t (f a) (f b) -> f (t a b)
bisequence
    ( PublicKey -> Either String PublicKey
pbToPublicKey forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 1 (Message PublicKey)
previousPk
    , forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse PublicKey -> Either String PublicKey
pbToPublicKey forall a b. (a -> b) -> a -> b
$ 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 = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey
publicKeyToPb PublicKey
previousPk
  , $sel:pkTable:ThirdPartyBlockRequest :: Repeated 2 (Message PublicKey)
pkTable = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey
publicKeyToPb 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)
$sel:payload:ThirdPartyBlockContents :: ThirdPartyBlockContents -> Required 1 (Value ByteString)
payload :: Required 1 (Value ByteString)
payload,Required 2 (Message ExternalSig)
$sel:externalSig:ThirdPartyBlockContents :: ThirdPartyBlockContents -> Required 2 (Message ExternalSig)
externalSig :: Required 2 (Message ExternalSig)
externalSig} = do
  (Signature
sig, PublicKey
pk) <- ExternalSig -> Either String (Signature, PublicKey)
pbToOptionalSignature forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField Required 2 (Message ExternalSig)
externalSig
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ( forall a. HasField a => a -> FieldType a
PB.getField Required 1 (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 = forall a. HasField a => FieldType a -> a
PB.putField ByteString
payload
  , $sel:externalSig:ThirdPartyBlockContents :: Required 2 (Message ExternalSig)
PB.externalSig = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ (Signature, PublicKey) -> ExternalSig
externalSigToPb (Signature
sig, PublicKey
pk)
  }