Get block certificates

concordium-base.cabal

@@ -82,6 +82,7 @@ library
       Concordium.Types.HashableTo
       Concordium.Types.IdentityProviders
       Concordium.Types.InvokeContract
+      Concordium.Types.KonsensusV1
       Concordium.Types.Migration
       Concordium.Types.Parameters
       Concordium.Types.ProtocolVersion

haskell-src/Concordium/GRPC2.hs

@@ -54,6 +54,7 @@ import Concordium.Types.Accounts.Releases
 import Concordium.Types.Block (AbsoluteBlockHeight (..))
 import Concordium.Types.Execution
 import qualified Concordium.Types.InvokeContract as InvokeContract
+import qualified Concordium.Types.KonsensusV1 as KonsensusV1
 import qualified Concordium.Types.Parameters as Parameters
 import qualified Concordium.Types.Updates as Updates
 import qualified Concordium.Wasm as Wasm
@@ -2154,6 +2155,61 @@ instance ToProto IpPort where
     type Output IpPort = Proto.Port
     toProto ip = Proto.make $ ProtoFields.value .= fromIntegral (ipPort ip)
 
+instance ToProto KonsensusV1.QuorumCertificateSignature where
+    type Output KonsensusV1.QuorumCertificateSignature = Proto.QuorumSignature
+    toProto (KonsensusV1.QuorumCertificateSignature sig) = mkSerialize sig
+
+instance ToProto KonsensusV1.QuorumCertificate where
+    type Output KonsensusV1.QuorumCertificate = Proto.QuorumCertificate
+    toProto KonsensusV1.QuorumCertificate{..} =
+        Proto.make $ do
+            ProtoFields.blockHash .= toProto qcBlock
+            ProtoFields.round .= toProto qcRound
+            ProtoFields.epoch .= toProto qcEpoch
+            ProtoFields.aggregateSignature .= toProto qcAggregateSignature
+            ProtoFields.signatories .= (toProto <$> qcSignatories)
+
+instance ToProto KonsensusV1.FinalizerRound where
+    type Output KonsensusV1.FinalizerRound = Proto.FinalizerRound
+    toProto KonsensusV1.FinalizerRound{..} =
+        Proto.make $ do
+            ProtoFields.round .= toProto frRound
+            ProtoFields.finalizers .= (toProto <$> frFinalizers)
+
+instance ToProto KonsensusV1.TimeoutCertificateSignature where
+    type Output KonsensusV1.TimeoutCertificateSignature = Proto.TimeoutSignature
+    toProto (KonsensusV1.TimeoutCertificateSignature sig) = mkSerialize sig
+
+instance ToProto KonsensusV1.TimeoutCertificate where
+    type Output KonsensusV1.TimeoutCertificate = Proto.TimeoutCertificate
+    toProto KonsensusV1.TimeoutCertificate{..} =
+        Proto.make $ do
+            ProtoFields.round .= toProto tcRound
+            ProtoFields.minEpoch .= toProto tcMinEpoch
+            ProtoFields.qcRoundsFirstEpoch .= (toProto <$> tcFinalizerQCRoundsFirstEpoch)
+            ProtoFields.qcRoundsSecondEpoch .= (toProto <$> tcFinalizerQCRoundsSecondEpoch)
+            ProtoFields.aggregateSignature .= toProto tcAggregateSignature
+
+instance ToProto KonsensusV1.SuccessorProof where
+    type Output KonsensusV1.SuccessorProof = Proto.SuccessorProof
+    toProto (KonsensusV1.SuccessorProof proof) = mkSerialize proof
+
+instance ToProto KonsensusV1.EpochFinalizationEntry where
+    type Output KonsensusV1.EpochFinalizationEntry = Proto.EpochFinalizationEntry
+    toProto KonsensusV1.EpochFinalizationEntry{..} =
+        Proto.make $ do
+            ProtoFields.finalizedQc .= toProto efeFinalizedQC
+            ProtoFields.successorQc .= toProto efeSuccessorQC
+            ProtoFields.successorProof .= toProto efeSuccessorProof
+
+instance ToProto KonsensusV1.BlockCertificates where
+    type Output KonsensusV1.BlockCertificates = Proto.BlockCertificates
+    toProto KonsensusV1.BlockCertificates{..} =
+        Proto.make $ do
+            ProtoFields.maybe'quorumCertificate .= fmap toProto bcQuorumCertificate
+            ProtoFields.maybe'timeoutCertificate .= fmap toProto bcTimeoutCertificate
+            ProtoFields.maybe'epochFinalizationEntry .= fmap toProto bcEpochFinalizationEntry
+
 instance ToProto BakerRewardPeriodInfo where
     type Output BakerRewardPeriodInfo = Proto.BakerRewardPeriodInfo
     toProto BakerRewardPeriodInfo{..} =

haskell-src/Concordium/Types/KonsensusV1.hs

@@ -0,0 +1,134 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |Types that are relevant only for endpoints exposed in 'ConsensusV1'.
+module Concordium.Types.KonsensusV1 where
+
+import Data.Aeson
+import Data.Serialize
+
+import qualified Concordium.Crypto.BlsSignature as Bls
+import qualified Concordium.Crypto.SHA256 as Hash
+import Concordium.Types
+
+-- |An aggregate signature on a 'QuorumCertificate'.
+newtype QuorumCertificateSignature = QuorumCertificateSignature Bls.Signature
+    deriving (Eq, Show, ToJSON, FromJSON, Serialize) via Bls.Signature
+
+-- | A quorum certificate, to be formed when enough finalizers have signed the same 'QuorumSignatureMessage'.
+data QuorumCertificate = QuorumCertificate
+    { -- |Hash of the block this certificate refers to.
+      qcBlock :: !BlockHash,
+      -- |Round of the block this certificate refers to.
+      qcRound :: !Round,
+      -- |Epoch of the block this certificate refers to.
+      qcEpoch :: !Epoch,
+      -- |Aggregate signature on the 'QuorumSignatureMessage' with the block hash 'qcBlock'.
+      qcAggregateSignature :: !QuorumCertificateSignature,
+      -- |The set of finalizers whose signature is in 'qcAggregateSignature'.
+      qcSignatories :: ![BakerId]
+    }
+    deriving (Eq, Show)
+
+instance ToJSON QuorumCertificate where
+    toJSON QuorumCertificate{..} =
+        object
+            [ "block" .= qcBlock,
+              "round" .= qcRound,
+              "epoch" .= qcEpoch,
+              "aggregateSignature" .= qcAggregateSignature,
+              "signatories" .= qcSignatories
+            ]
+
+-- |The finalizers (identified by their 'BakerId's)
+-- that signed off for in the @frRound@.
+data FinalizerRound = FinalizerRound
+    { -- |The round.
+      frRound :: !Round,
+      -- |The finalizers who signed off in the round.
+      frFinalizers :: ![BakerId]
+    }
+    deriving (Eq, Show)
+
+instance ToJSON FinalizerRound where
+    toJSON FinalizerRound{..} =
+        object
+            [ "round" .= frRound,
+              "finalizers" .= frFinalizers
+            ]
+
+newtype TimeoutCertificateSignature = TimeoutCertificateSignature Bls.Signature
+    deriving (Eq, Show, ToJSON, FromJSON, Serialize) via Bls.Signature
+
+data TimeoutCertificate = TimeoutCertificate
+    { -- |The round that has timed-out.
+      tcRound :: !Round,
+      -- |The minimum epoch for which we include signatures.
+      tcMinEpoch :: !Epoch,
+      -- |The rounds for which finalizers have their best QCs in the epoch 'tcMinEpoch'.
+      tcFinalizerQCRoundsFirstEpoch :: ![FinalizerRound],
+      -- |The rounds for which finalizers have their best QCs in the epoch @tcMinEpoch + 1@.
+      tcFinalizerQCRoundsSecondEpoch :: ![FinalizerRound],
+      -- |Aggregate of the finalizers' 'TimeoutSignature's on the round and QC round.
+      tcAggregateSignature :: !TimeoutCertificateSignature
+    }
+    deriving (Eq, Show)
+
+instance ToJSON TimeoutCertificate where
+    toJSON TimeoutCertificate{..} =
+        object
+            [ "round" .= tcRound,
+              "minEpoch" .= tcMinEpoch,
+              "finalizerQCRoundsFirstEpoch" .= tcFinalizerQCRoundsFirstEpoch,
+              "finalizerQCRoundsSecondEpoch" .= tcFinalizerQCRoundsSecondEpoch,
+              "aggregateSignature" .= tcAggregateSignature
+            ]
+
+newtype SuccessorProof = SuccessorProof Hash.Hash
+    deriving (Eq, Show, ToJSON, FromJSON, Serialize) via Hash.Hash
+
+-- |The epoch finalization entry is the proof required in order to
+-- advance to a new epoch.
+data EpochFinalizationEntry = EpochFinalizationEntry
+    { -- |The qc that is finalized by the successor qc.
+      efeFinalizedQC :: !QuorumCertificate,
+      -- |The qc that finalizes @efeFinalizedQC@.
+      efeSuccessorQC :: !QuorumCertificate,
+      -- |A proof that the successor qc points to a block
+      -- which is an immediate successor of the block that
+      -- @efeFinalizedQC@ points to.
+      efeSuccessorProof :: !SuccessorProof
+    }
+    deriving (Eq, Show)
+
+instance ToJSON EpochFinalizationEntry where
+    toJSON EpochFinalizationEntry{..} =
+        object
+            [ "finalizedQC" .= efeFinalizedQC,
+              "successorQC" .= efeSuccessorQC,
+              "successorProof" .= efeSuccessorProof
+            ]
+
+-- |Block certificates for a block in 'ConsensusV1'.
+data BlockCertificates = BlockCertificates
+    { -- |Quorum certificate for the block.
+      -- This is only present if and only if the block is not a genesis block.
+      bcQuorumCertificate :: !(Maybe QuorumCertificate),
+      -- |Timeout certificate for the block.
+      -- Present if the round prior to the round of the block
+      -- timed out.
+      bcTimeoutCertificate :: !(Maybe TimeoutCertificate),
+      -- |Epoch finalization entry for the block.
+      -- Present if the block is the first block in an epoch,
+      -- hence concludes the prior epoch.
+      bcEpochFinalizationEntry :: !(Maybe EpochFinalizationEntry)
+    }
+    deriving (Eq, Show)
+
+instance ToJSON BlockCertificates where
+    toJSON BlockCertificates{..} =
+        object
+            [ "quorumCertificate" .= bcQuorumCertificate,
+              "timeoutCertificate" .= bcTimeoutCertificate,
+              "epochFinalizationEntry" .= bcEpochFinalizationEntry
+            ]