{-# 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)
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)

-- | 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{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
  -- 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
  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 =
        -- 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 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"

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