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

module Auth.Biscuit.Proto
  ( Biscuit (..)
  , SignedBlock (..)
  , PublicKey (..)
  , Algorithm (..)
  , ExternalSig (..)
  , Proof (..)
  , Block (..)
  , Scope (..)
  , ScopeType (..)
  , FactV2 (..)
  , RuleV2 (..)
  , CheckKind (..)
  , CheckV2 (..)
  , PredicateV2 (..)
  , TermV2 (..)
  , ExpressionV2 (..)
  , TermSet (..)
  , Op (..)
  , OpUnary (..)
  , UnaryKind (..)
  , OpBinary (..)
  , BinaryKind (..)
  , OpTernary (..)
  , TernaryKind (..)
  , ThirdPartyBlockContents (..)
  , ThirdPartyBlockRequest (..)
  , getField
  , putField
  , decodeBlockList
  , decodeBlock
  , encodeBlockList
  , encodeBlock
  , decodeThirdPartyBlockRequest
  , decodeThirdPartyBlockContents
  , encodeThirdPartyBlockRequest
  , encodeThirdPartyBlockContents
  ) where

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

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

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

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

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

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

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

data Block = Block {
    Block -> Repeated 1 (Value Text)
symbols   :: Repeated 1 (Value Text)
  , Block -> Optional 2 (Value Text)
context   :: Optional 2 (Value Text)
  , Block -> Optional 3 (Value Int32)
version   :: Optional 3 (Value Int32)
  , Block -> Repeated 4 (Message FactV2)
facts_v2  :: Repeated 4 (Message FactV2)
  , Block -> Repeated 5 (Message RuleV2)
rules_v2  :: Repeated 5 (Message RuleV2)
  , Block -> Repeated 6 (Message CheckV2)
checks_v2 :: Repeated 6 (Message CheckV2)
  , Block -> Repeated 7 (Message Scope)
scope     :: Repeated 7 (Message Scope)
  , Block -> Repeated 8 (Message PublicKey)
pksTable  :: Repeated 8 (Message PublicKey)
  } deriving stock (forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Block x -> Block
$cfrom :: forall x. Block -> Rep Block x
Generic, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get Block
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get Block
$cdecode :: HashMap Tag [WireField] -> Get Block
Decode, Block -> Put
forall a. (a -> Put) -> Encode a
encode :: Block -> Put
$cencode :: Block -> Put
Encode)

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

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

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

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

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

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

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

data TermV2 =
    TermVariable (Required 1 (Value Int64))
  | TermInteger  (Required 2 (Value Int64))
  | TermString   (Required 3 (Value Int64))
  | TermDate     (Required 4 (Value Int64))
  | TermBytes    (Required 5 (Value ByteString))
  | TermBool     (Required 6 (Value Bool))
  | TermTermSet  (Required 7 (Message TermSet))
    deriving stock (forall x. Rep TermV2 x -> TermV2
forall x. TermV2 -> Rep TermV2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TermV2 x -> TermV2
$cfrom :: forall x. TermV2 -> Rep TermV2 x
Generic, Int -> TermV2 -> ShowS
[TermV2] -> ShowS
TermV2 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TermV2] -> ShowS
$cshowList :: [TermV2] -> ShowS
show :: TermV2 -> String
$cshow :: TermV2 -> String
showsPrec :: Int -> TermV2 -> ShowS
$cshowsPrec :: Int -> TermV2 -> ShowS
Show)
    deriving anyclass (HashMap Tag [WireField] -> Get TermV2
forall a. (HashMap Tag [WireField] -> Get a) -> Decode a
decode :: HashMap Tag [WireField] -> Get TermV2
$cdecode :: HashMap Tag [WireField] -> Get TermV2
Decode, TermV2 -> Put
forall a. (a -> Put) -> Encode a
encode :: TermV2 -> Put
$cencode :: TermV2 -> Put
Encode)


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

decodeThirdPartyBlockRequest :: ByteString -> Either String ThirdPartyBlockRequest
decodeThirdPartyBlockRequest :: ByteString -> Either String ThirdPartyBlockRequest
decodeThirdPartyBlockRequest = forall a. Get a -> ByteString -> Either String a
runGet forall a. Decode a => Get a
decodeMessage

decodeThirdPartyBlockContents :: ByteString -> Either String ThirdPartyBlockContents
decodeThirdPartyBlockContents :: ByteString -> Either String ThirdPartyBlockContents
decodeThirdPartyBlockContents = forall a. Get a -> ByteString -> Either String a
runGet forall a. Decode a => Get a
decodeMessage

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

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