Skip to content

Commit

Permalink
support for chain parameters v3
Browse files Browse the repository at this point in the history
  • Loading branch information
drsk committed Dec 16, 2024
1 parent 6e8d913 commit d85f19e
Show file tree
Hide file tree
Showing 2 changed files with 78 additions and 4 deletions.
65 changes: 65 additions & 0 deletions src/Concordium/Client/GRPC2.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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': "
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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{..}

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
17 changes: 13 additions & 4 deletions src/Concordium/Client/Output.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -1237,6 +1237,7 @@ printChainParametersV3 ChainParameters{..} = do
printRewardAndTimeParameters _cpRewardParameters _cpTimeParameters
printConsensusParametersV1 _cpConsensusParameters
mapM_ printFinalizationCommitteeParameters _cpFinalizationCommitteeParameters
mapM_ printValidatorScoreParameters _cpValidatorScoreParameters
tell
[ "",
[i|\# Other parameters: |],
Expand Down Expand Up @@ -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 ++ "]"
Expand Down

0 comments on commit d85f19e

Please sign in to comment.