diff --git a/src/Concordium/Client/GRPC2.hs b/src/Concordium/Client/GRPC2.hs index c5ebbafa..74ffc5b6 100644 --- a/src/Concordium/Client/GRPC2.hs +++ b/src/Concordium/Client/GRPC2.hs @@ -1374,6 +1374,7 @@ instance FromProto Proto.NextUpdateSequenceNumbers where _nusnMinBlockTime <- fromProto $ nums ^. ProtoFields.minBlockTime _nusnBlockEnergyLimit <- fromProto $ nums ^. ProtoFields.blockEnergyLimit _nusnFinalizationCommitteeParameters <- fromProto $ nums ^. ProtoFields.finalizationCommitteeParameters + _nusnValidatorScoreParameters <- fromProto $ nums ^. ProtoFields.validatorScoreParameters return NextUpdateSequenceNumbers{..} instance FromProto Proto.IpAddress where @@ -1468,6 +1469,7 @@ instance FromProto Proto.UpdateType where fromProto ProtoFields.UPDATE_MIN_BLOCK_TIME = return Updates.UpdateMinBlockTime fromProto ProtoFields.UPDATE_BLOCK_ENERGY_LIMIT = return Updates.UpdateBlockEnergyLimit fromProto ProtoFields.UPDATE_FINALIZATION_COMMITTEE_PARAMETERS = return Updates.UpdateFinalizationCommitteeParameters + fromProto ProtoFields.UPDATE_VALIDATOR_SCORE_PARAMETERS = return Updates.UpdateValidatorScoreParameters fromProto (Proto.UpdateType'Unrecognized variant) = fromProtoFail $ "Unable to convert 'InvokeInstanceResponse': " @@ -1978,6 +1980,9 @@ instance FromProto Proto.UpdatePayload where ProtoFields.UpdatePayload'FinalizationCommitteeParametersUpdate fcpUpdate -> do fcp <- fromProto fcpUpdate return $ Updates.FinalizationCommitteeParametersUpdatePayload fcp + ProtoFields.UpdatePayload'ValidatorScoreParametersUpdate vspUpdate -> do + vsp <- fromProto vspUpdate + return $ Updates.ValidatorScoreParametersUpdatePayload vsp instance FromProto Proto.BlockItemSummary where type Output Proto.BlockItemSummary = SupplementedTransactionSummary @@ -2275,8 +2280,10 @@ instance FromProto (Proto.AccountAddress, Proto.BakerEvent) where return DelegationRemoved{..} ProtoFields.BakerEvent'BakerSuspended' bkrSuspended -> do ebsBakerId <- fromProto $ bkrSuspended ^. ProtoFields.bakerId + let ebsAccount = sender return BakerSuspended{..} ProtoFields.BakerEvent'BakerResumed' bkrResumed -> do + let ebrAccount = sender ebrBakerId <- fromProto $ bkrResumed ^. ProtoFields.bakerId return BakerResumed{..} @@ -2471,6 +2478,13 @@ instance FromProto Proto.FinalizationCommitteeParameters where _fcpFinalizerRelativeStakeThreshold <- fmap coerce $ fromProto $ fcParams ^. ProtoFields.finalizerRelativeStakeThreshold return Parameters.FinalizationCommitteeParameters{..} +instance FromProto Proto.ValidatorScoreParameters where + type Output Proto.ValidatorScoreParameters = Parameters.ValidatorScoreParameters + + fromProto vsParams = do + let _vspMaxMissedRounds = vsParams ^. ProtoFields.maximumMissedRounds + return Parameters.ValidatorScoreParameters{..} + instance FromProto Proto.ChainParametersV0 where -- \|The internal Haskell type for representing chain parameters expects -- an account _index_, while the protocol buffer representation uses an @@ -2506,6 +2520,7 @@ instance FromProto Proto.ChainParametersV0 where thresh <- fromProto $ cParams ^. ProtoFields.minimumThresholdForBaking return $ Parameters.PoolParametersV0 thresh let _cpFinalizationCommitteeParameters = Parameters.NoParam + let _cpValidatorScoreParameters = Parameters.NoParam let ecpParams = Parameters.ChainParameters{..} rootKeys <- fmap snd . fromProto $ cParams ^. ProtoFields.rootKeys level1Keys <- fmap fst . fromProto $ cParams ^. ProtoFields.level1Keys @@ -2553,6 +2568,7 @@ instance FromProto Proto.ChainParametersV1 where let _cpFoundationAccount = faIndex _cpPoolParameters <- fromProto $ cParams ^. ProtoFields.poolParameters let _cpFinalizationCommitteeParameters = Parameters.NoParam + let _cpValidatorScoreParameters = Parameters.NoParam let ecpParams = Parameters.ChainParameters{..} rootKeys <- fmap snd . fromProto $ cParams ^. ProtoFields.rootKeys level1Keys <- fmap fst . fromProto $ cParams ^. ProtoFields.level1Keys @@ -2589,6 +2605,44 @@ instance FromProto Proto.ChainParametersV2 where let _cpFoundationAccount = faIndex _cpPoolParameters <- fromProto $ cParams ^. ProtoFields.poolParameters _cpFinalizationCommitteeParameters <- fmap Parameters.SomeParam $ fromProto $ cParams ^. ProtoFields.finalizationCommitteeParameters + let _cpValidatorScoreParameters = Parameters.NoParam + let ecpParams = Parameters.ChainParameters{..} + rootKeys <- fmap snd . fromProto $ cParams ^. ProtoFields.rootKeys + level1Keys <- fmap fst . fromProto $ cParams ^. ProtoFields.level1Keys + level2Keys <- fromProto $ cParams ^. ProtoFields.level2Keys + let ecpKeys = Updates.UpdateKeysCollection{..} + return $ EChainParametersAndKeys ecpParams ecpKeys + +instance FromProto Proto.ChainParametersV3 where + -- \|The internal Haskell type for representing chain parameters expects + -- an account _index_, while the protocol buffer representation uses an + -- account _address_ for the foundation account. The workaround here is to + -- return the address and a closure. The address can then be converted + -- to its corresponding index and fed to the closure to get the desired + -- @EChainParametersAndKeys@ instance. + type Output Proto.ChainParametersV3 = (AccountAddress, AccountIndex -> FromProtoResult EChainParametersAndKeys) + fromProto cParams = do + faAddress <- fromProto $ cParams ^. ProtoFields.foundationAccount + return (faAddress, faIdxToOutput) + where + faIdxToOutput faIndex = do + _cpConsensusParameters <- fromProto $ cParams ^. ProtoFields.consensusParameters + _cpExchangeRates <- do + euroPerEnergy <- fromProto $ cParams ^. ProtoFields.euroPerEnergy + microCcdPerEuro <- fromProto $ cParams ^. ProtoFields.microCcdPerEuro + return $ Parameters.makeExchangeRates euroPerEnergy microCcdPerEuro + _cpCooldownParameters <- fromProto $ cParams ^. ProtoFields.cooldownParameters + _cpTimeParameters <- fmap Parameters.SomeParam $ fromProto $ cParams ^. ProtoFields.timeParameters + _cpAccountCreationLimit <- fromProto $ cParams ^. ProtoFields.accountCreationLimit + _cpRewardParameters <- do + _rpMintDistribution <- fromProto $ cParams ^. ProtoFields.mintDistribution + _rpTransactionFeeDistribution <- fromProto $ cParams ^. ProtoFields.transactionFeeDistribution + _rpGASRewards <- fromProto $ cParams ^. ProtoFields.gasRewards + return (Parameters.RewardParameters{..} :: Parameters.RewardParameters 'ChainParametersV3) + let _cpFoundationAccount = faIndex + _cpPoolParameters <- fromProto $ cParams ^. ProtoFields.poolParameters + _cpFinalizationCommitteeParameters <- fmap Parameters.SomeParam $ fromProto $ cParams ^. ProtoFields.finalizationCommitteeParameters + _cpValidatorScoreParameters <- fmap Parameters.SomeParam $ fromProto $ cParams ^. ProtoFields.validatorScoreParameters let ecpParams = Parameters.ChainParameters{..} rootKeys <- fmap snd . fromProto $ cParams ^. ProtoFields.rootKeys level1Keys <- fmap fst . fromProto $ cParams ^. ProtoFields.level1Keys @@ -2621,6 +2675,7 @@ instance FromProto Proto.ChainParameters where Proto.ChainParameters'V0 v0 -> fromProto v0 Proto.ChainParameters'V1 v1 -> fromProto v1 Proto.ChainParameters'V2 v2 -> fromProto v2 + Proto.ChainParameters'V3 v3 -> fromProto v3 instance FromProto Proto.CryptographicParameters where type Output Proto.CryptographicParameters = Parameters.CryptographicParameters @@ -2815,6 +2870,14 @@ instance FromProto Proto.BlockSpecialEvent where stoBakerReward <- fromProto $ ppReward ^. ProtoFields.bakerReward stoFinalizationReward <- fromProto $ ppReward ^. ProtoFields.finalizationReward return Transactions.PaydayPoolReward{..} + ProtoFields.BlockSpecialEvent'ValidatorSuspended' vSuspended -> do + vsBakerId <- fromProto $ vSuspended ^. ProtoFields.bakerId + vsAccount <- fromProto $ vSuspended ^. ProtoFields.account + return Transactions.ValidatorSuspended{..} + ProtoFields.BlockSpecialEvent'ValidatorPrimedForSuspension' vpfSuspension -> do + vpfsBakerId <- fromProto $ vpfSuspension ^. ProtoFields.bakerId + vpfsAccount <- fromProto $ vpfSuspension ^. ProtoFields.account + return Transactions.ValidatorPrimedForSuspension{..} instance FromProto Proto.PendingUpdate where type Output Proto.PendingUpdate = PendingUpdate @@ -2875,6 +2938,8 @@ instance FromProto Proto.PendingUpdate where PUEBlockEnergyLimit <$> fromProto beLimit ProtoFields.PendingUpdate'FinalizationCommitteeParameters fcParams -> do PUEFinalizationCommitteeParameters <$> fromProto fcParams + ProtoFields.PendingUpdate'ValidatorScoreParameters vsParams -> do + PUEValidatorScoreParameters <$> fromProto vsParams return PendingUpdate{..} instance FromProto Proto.WinningBaker where diff --git a/src/Concordium/Client/Output.hs b/src/Concordium/Client/Output.hs index 144c0624..b098b930 100644 --- a/src/Concordium/Client/Output.hs +++ b/src/Concordium/Client/Output.hs @@ -883,10 +883,10 @@ showEvent verbose ciM = \case Types.Resumed cAddr invokeSucceeded -> let invokeMsg :: Text = if invokeSucceeded then "succeeded" else "failed" in verboseOrNothing [i|resumed '#{cAddr}' after an interruption that #{invokeMsg}.|] - Types.BakerSuspended bID -> - verboseOrNothing $ printf "baker %s suspended" (show bID) - Types.BakerResumed bID -> - verboseOrNothing $ printf "baker %s resumed" (show bID) + Types.BakerSuspended bID acc -> + verboseOrNothing $ printf "baker %s with account %s suspended" (show bID) (show acc) + Types.BakerResumed bID acc -> + verboseOrNothing $ printf "baker %s with account %s resumed" (show bID) (show acc) where verboseOrNothing :: String -> Maybe String verboseOrNothing msg = if verbose then Just msg else Nothing @@ -1237,6 +1237,7 @@ printChainParametersV3 ChainParameters{..} = do printRewardAndTimeParameters _cpRewardParameters _cpTimeParameters printConsensusParametersV1 _cpConsensusParameters mapM_ printFinalizationCommitteeParameters _cpFinalizationCommitteeParameters + mapM_ printValidatorScoreParameters _cpValidatorScoreParameters tell [ "", [i|\# Other parameters: |], @@ -1339,6 +1340,14 @@ printFinalizationCommitteeParameters fcp = [i| + finalizer relative stake threshold: #{show (fcp ^. fcpFinalizerRelativeStakeThreshold)}|] ] +printValidatorScoreParameters :: ValidatorScoreParameters -> Printer +printValidatorScoreParameters vsp = + tell + [ "", + [i|\# Validator score parameters:|], + [i| + maximum missed rounds: #{show (vsp ^. vspMaxMissedRounds)}|] + ] + -- | Returns a string representation of the given 'InclusiveRange'. showInclusiveRange :: (a -> String) -> InclusiveRange a -> String showInclusiveRange toStr InclusiveRange{..} = "[" ++ toStr irMin ++ ", " ++ toStr irMax ++ "]"