diff --git a/concordium-base.cabal b/concordium-base.cabal index 1e6fed687..9c3ac3dc1 100644 --- a/concordium-base.cabal +++ b/concordium-base.cabal @@ -87,6 +87,7 @@ library Concordium.Types.ProtocolVersion Concordium.Types.ProtocolVersion.TH Concordium.Types.Queries + Concordium.Types.Queries.KonsensusV1 Concordium.Types.SeedState Concordium.Types.SmartContracts Concordium.Types.Transactions diff --git a/concordium-grpc-api b/concordium-grpc-api index bc0b3fcb1..342f5d0bf 160000 --- a/concordium-grpc-api +++ b/concordium-grpc-api @@ -1 +1 @@ -Subproject commit bc0b3fcb12cbfb6336051a0bf40ae36474587790 +Subproject commit 342f5d0bf5580abd23a8f87ebdeba7923cba3d69 diff --git a/haskell-src/Concordium/GRPC2.hs b/haskell-src/Concordium/GRPC2.hs index 377bf6aaa..8b4697dae 100644 --- a/haskell-src/Concordium/GRPC2.hs +++ b/haskell-src/Concordium/GRPC2.hs @@ -55,6 +55,7 @@ import Concordium.Types.Block (AbsoluteBlockHeight (..)) import Concordium.Types.Execution import qualified Concordium.Types.InvokeContract as InvokeContract import qualified Concordium.Types.Parameters as Parameters +import qualified Concordium.Types.Queries.KonsensusV1 as KonsensusV1 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{..} = diff --git a/haskell-src/Concordium/Types/Queries/KonsensusV1.hs b/haskell-src/Concordium/Types/Queries/KonsensusV1.hs new file mode 100644 index 000000000..f1b55d39c --- /dev/null +++ b/haskell-src/Concordium/Types/Queries/KonsensusV1.hs @@ -0,0 +1,135 @@ +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE OverloadedStrings #-} + +-- |Types that are relevant only for endpoints exposed in consensus version 1. +module Concordium.Types.Queries.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 + ] + +-- |An aggregate signature created by members of the finalization committee on a 'TimeoutCertificate'. +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 consensus version 1. +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 + ]