From 9895ee90ec1d54fe576e0ed57cce789d34249ce4 Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Thu, 14 Apr 2022 23:37:43 +0200 Subject: [PATCH 01/23] Proto: split `Delegate_storage` in multiple files --- .../test/tenderbrute/lib/tenderbrute.ml | 2 +- src/proto_alpha/lib_protocol/TEZOS_PROTOCOL | 4 + src/proto_alpha/lib_protocol/alpha_context.ml | 15 +- .../lib_protocol/alpha_context.mli | 10 +- src/proto_alpha/lib_protocol/apply.ml | 11 +- .../lib_protocol/delegate_cycles.ml | 225 +++++ .../lib_protocol/delegate_cycles.mli | 52 ++ .../delegate_missed_endorsements_storage.ml | 266 ++++++ .../delegate_missed_endorsements_storage.mli | 86 ++ .../lib_protocol/delegate_sampler.ml | 242 +++++ .../lib_protocol/delegate_sampler.mli | 65 ++ .../delegate_slashed_deposits_storage.ml | 118 +++ .../delegate_slashed_deposits_storage.mli | 61 ++ .../lib_protocol/delegate_storage.ml | 840 ++---------------- .../lib_protocol/delegate_storage.mli | 209 +---- src/proto_alpha/lib_protocol/dune | 19 + src/proto_alpha/lib_protocol/init_storage.ml | 4 +- 17 files changed, 1245 insertions(+), 984 deletions(-) create mode 100644 src/proto_alpha/lib_protocol/delegate_cycles.ml create mode 100644 src/proto_alpha/lib_protocol/delegate_cycles.mli create mode 100644 src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml create mode 100644 src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli create mode 100644 src/proto_alpha/lib_protocol/delegate_sampler.ml create mode 100644 src/proto_alpha/lib_protocol/delegate_sampler.mli create mode 100644 src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml create mode 100644 src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli diff --git a/src/proto_alpha/lib_delegate/test/tenderbrute/lib/tenderbrute.ml b/src/proto_alpha/lib_delegate/test/tenderbrute/lib/tenderbrute.ml index a27b9381426c..fa99d708a0a1 100644 --- a/src/proto_alpha/lib_delegate/test/tenderbrute/lib/tenderbrute.ml +++ b/src/proto_alpha/lib_delegate/test/tenderbrute/lib/tenderbrute.ml @@ -100,7 +100,7 @@ let check ctxt ~selection = (fun () -> LevelRoundMap.fold_es (fun (level, round) delegate ctxt -> - Delegate_storage.baking_rights_owner ctxt level ~round + Delegate_sampler.baking_rights_owner ctxt level ~round >|= Environment.wrap_tzresult >>=? fun (ctxt, _, (_, pkh)) -> if not (Signature.Public_key_hash.equal delegate pkh) then raise Exit diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL index fe26d8b66241..7931362c67bb 100644 --- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL @@ -126,6 +126,10 @@ "Contract_storage", "Token", "Delegate_storage", + "Delegate_missed_endorsements_storage", + "Delegate_slashed_deposits_storage", + "Delegate_sampler", + "Delegate_cycles", "Bootstrap_storage", "Vote_storage", diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index 7be3af7d02c0..7153b6d0d5e4 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -454,6 +454,11 @@ module Receipt = Receipt_repr module Delegate = struct include Delegate_storage + include Delegate_missed_endorsements_storage + include Delegate_slashed_deposits_storage + include Delegate_cycles + + let deactivated = Delegate_activation_storage.is_inactive type deposits = Storage.deposits = { initial_amount : Tez.t; @@ -475,15 +480,15 @@ end module Stake_distribution = struct let snapshot = Stake_storage.snapshot - let compute_snapshot_index = Delegate_storage.compute_snapshot_index + let compute_snapshot_index = Delegate_sampler.compute_snapshot_index - let baking_rights_owner = Delegate.baking_rights_owner + let baking_rights_owner = Delegate_sampler.baking_rights_owner - let slot_owner = Delegate.slot_owner + let slot_owner = Delegate_sampler.slot_owner - let delegate_pubkey = Delegate.pubkey + let delegate_pubkey = Delegate_storage.pubkey - let get_staking_balance = Delegate.staking_balance + let get_staking_balance = Delegate_storage.staking_balance end module Nonce = Nonce_storage diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index fa193e68509c..2a28fc573eef 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -2451,22 +2451,20 @@ module Delegate : sig tzresult Lwt.t - val already_slashed_for_double_endorsing : - context -> public_key_hash -> Level.t -> bool tzresult Lwt.t + val check_and_record_already_slashed_for_double_endorsing : + context -> public_key_hash -> Level.t -> (context * bool) tzresult Lwt.t - val already_slashed_for_double_baking : - context -> public_key_hash -> Level.t -> bool tzresult Lwt.t + val check_and_record_already_slashed_for_double_baking : + context -> public_key_hash -> Level.t -> (context * bool) tzresult Lwt.t val punish_double_endorsing : context -> public_key_hash -> - Level.t -> (context * Tez.t * Receipt.balance_updates) tzresult Lwt.t val punish_double_baking : context -> public_key_hash -> - Level.t -> (context * Tez.t * Receipt.balance_updates) tzresult Lwt.t val full_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 5f4a7d5531d1..79861cba813f 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -2698,18 +2698,19 @@ let check_denunciation_age ctxt kind given_level = {kind; level = given_level; last_cycle = last_slashable_cycle}) let punish_delegate ctxt delegate level mistake mk_result ~payload_producer = - let already_slashed, punish = + let check_and_record_already_slashed, punish = match mistake with | `Double_baking -> - ( Delegate.already_slashed_for_double_baking, + ( Delegate.check_and_record_already_slashed_for_double_baking, Delegate.punish_double_baking ) | `Double_endorsing -> - ( Delegate.already_slashed_for_double_endorsing, + ( Delegate.check_and_record_already_slashed_for_double_endorsing, Delegate.punish_double_endorsing ) in - already_slashed ctxt delegate level >>=? fun slashed -> + check_and_record_already_slashed ctxt delegate level + >>=? fun (ctxt, slashed) -> fail_when slashed Unrequired_denunciation >>=? fun () -> - punish ctxt delegate level >>=? fun (ctxt, burned, punish_balance_updates) -> + punish ctxt delegate >>=? fun (ctxt, burned, punish_balance_updates) -> (match Tez.(burned /? 2L) with | Ok reward -> Token.transfer diff --git a/src/proto_alpha/lib_protocol/delegate_cycles.ml b/src/proto_alpha/lib_protocol/delegate_cycles.ml new file mode 100644 index 000000000000..a866f2727f6d --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_cycles.ml @@ -0,0 +1,225 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2022 G.B. Fefe, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let update_activity ctxt last_cycle = + let preserved = Constants_storage.preserved_cycles ctxt in + match Cycle_repr.sub last_cycle preserved with + | None -> return (ctxt, []) + | Some _unfrozen_cycle -> + Stake_storage.fold_on_active_delegates_with_rolls + ctxt + ~order:`Sorted + ~init:(Ok (ctxt, [])) + ~f:(fun delegate () acc -> + acc >>?= fun (ctxt, deactivated) -> + Delegate_activation_storage.last_cycle_before_deactivation + ctxt + delegate + >>=? fun cycle -> + if Cycle_repr.(cycle <= last_cycle) then + Delegate_storage.set_inactive ctxt delegate >>=? fun ctxt -> + return (ctxt, delegate :: deactivated) + else return (ctxt, deactivated)) + >|=? fun (ctxt, deactivated) -> (ctxt, deactivated) + +(* Return a map from delegates (with active stake at some cycle + in the cycle window [from_cycle, to_cycle]) to the maximum + of the stake to be deposited for each such cycle (which is just the + [frozen_deposits_percentage] of the active stake at that cycle). Also + return the delegates that have fallen out of the sliding window. *) +let max_frozen_deposits_and_delegates_to_remove ctxt ~from_cycle ~to_cycle = + let frozen_deposits_percentage = + Constants_storage.frozen_deposits_percentage ctxt + in + let cycles = Cycle_repr.(from_cycle ---> to_cycle) in + (match Cycle_repr.pred from_cycle with + | None -> return Signature.Public_key_hash.Set.empty + | Some cleared_cycle -> ( + Stake_storage.find_selected_distribution ctxt cleared_cycle + >|=? fun cleared_cycle_delegates -> + match cleared_cycle_delegates with + | None -> Signature.Public_key_hash.Set.empty + | Some delegates -> + List.fold_left + (fun set (d, _) -> Signature.Public_key_hash.Set.add d set) + Signature.Public_key_hash.Set.empty + delegates)) + >>=? fun cleared_cycle_delegates -> + List.fold_left_es + (fun (maxima, delegates_to_remove) (cycle : Cycle_repr.t) -> + Stake_storage.get_selected_distribution ctxt cycle + >|=? fun active_stakes -> + List.fold_left + (fun (maxima, delegates_to_remove) (delegate, stake) -> + let stake_to_be_deposited = + Tez_repr.(div_exn (mul_exn stake frozen_deposits_percentage) 100) + in + let maxima = + Signature.Public_key_hash.Map.update + delegate + (function + | None -> Some stake_to_be_deposited + | Some maximum -> + Some (Tez_repr.max maximum stake_to_be_deposited)) + maxima + in + let delegates_to_remove = + Signature.Public_key_hash.Set.remove delegate delegates_to_remove + in + (maxima, delegates_to_remove)) + (maxima, delegates_to_remove) + active_stakes) + (Signature.Public_key_hash.Map.empty, cleared_cycle_delegates) + cycles + +let freeze_deposits ?(origin = Receipt_repr.Block_application) ctxt ~new_cycle + ~balance_updates = + let max_slashable_period = Constants_storage.max_slashing_period ctxt in + (* We want to be able to slash for at most [max_slashable_period] *) + (match Cycle_repr.(sub new_cycle (max_slashable_period - 1)) with + | None -> + Storage.Tenderbake.First_level_of_protocol.get ctxt + >>=? fun first_level_of_protocol -> + let cycle_eras = Raw_context.cycle_eras ctxt in + let level = + Level_repr.level_from_raw ~cycle_eras first_level_of_protocol + in + return level.cycle + | Some cycle -> return cycle) + >>=? fun from_cycle -> + let preserved_cycles = Constants_storage.preserved_cycles ctxt in + let to_cycle = Cycle_repr.(add new_cycle preserved_cycles) in + max_frozen_deposits_and_delegates_to_remove ctxt ~from_cycle ~to_cycle + >>=? fun (maxima, delegates_to_remove) -> + Signature.Public_key_hash.Map.fold_es + (fun delegate maximum_stake_to_be_deposited (ctxt, balance_updates) -> + (* Here we make sure to preserve the following invariant : + maximum_stake_to_be_deposited <= frozen_deposits + balance + See select_distribution_for_cycle *) + let delegate_contract = Contract_repr.Implicit delegate in + Frozen_deposits_storage.update_initial_amount + ctxt + delegate_contract + maximum_stake_to_be_deposited + >>=? fun ctxt -> + Frozen_deposits_storage.get ctxt delegate_contract >>=? fun deposits -> + let current_amount = deposits.current_amount in + if Tez_repr.(current_amount > maximum_stake_to_be_deposited) then + Tez_repr.(current_amount -? maximum_stake_to_be_deposited) + >>?= fun to_reimburse -> + Token.transfer + ~origin + ctxt + (`Frozen_deposits delegate) + (`Delegate_balance delegate) + to_reimburse + >|=? fun (ctxt, bupds) -> (ctxt, bupds @ balance_updates) + else if Tez_repr.(current_amount < maximum_stake_to_be_deposited) then + Tez_repr.(maximum_stake_to_be_deposited -? current_amount) + >>?= fun desired_to_freeze -> + Contract_storage.get_balance ctxt delegate_contract >>=? fun balance -> + (* In case the delegate hasn't been slashed in this cycle, + the following invariant holds: + maximum_stake_to_be_deposited <= frozen_deposits + balance + See select_distribution_for_cycle + + If the delegate has been slashed during the cycle, the invariant + above doesn't necessarily hold. In this case, we freeze the max + we can for the delegate. *) + let to_freeze = Tez_repr.(min balance desired_to_freeze) in + Token.transfer + ~origin + ctxt + (`Delegate_balance delegate) + (`Frozen_deposits delegate) + to_freeze + >|=? fun (ctxt, bupds) -> (ctxt, bupds @ balance_updates) + else return (ctxt, balance_updates)) + maxima + (ctxt, balance_updates) + >>=? fun (ctxt, balance_updates) -> + (* Unfreeze deposits (that is, set them to zero) for delegates that + were previously in the relevant window (and therefore had some + frozen deposits) but are not in the new window; because that means + that such a delegate had no active stake in the relevant cycles, + and therefore it should have no frozen deposits. *) + Signature.Public_key_hash.Set.fold_es + (fun delegate (ctxt, balance_updates) -> + let delegate_contract = Contract_repr.Implicit delegate in + Frozen_deposits_storage.update_initial_amount + ctxt + delegate_contract + Tez_repr.zero + >>=? fun ctxt -> + Frozen_deposits_storage.get ctxt delegate_contract + >>=? fun frozen_deposits -> + if Tez_repr.(frozen_deposits.current_amount > zero) then + Token.transfer + ~origin + ctxt + (`Frozen_deposits delegate) + (`Delegate_balance delegate) + frozen_deposits.current_amount + >|=? fun (ctxt, bupds) -> (ctxt, bupds @ balance_updates) + else return (ctxt, balance_updates)) + delegates_to_remove + (ctxt, balance_updates) + +let freeze_deposits_do_not_call_except_for_migration = + freeze_deposits ~origin:Protocol_migration + +let cycle_end ctxt last_cycle unrevealed_nonces = + let new_cycle = Cycle_repr.add last_cycle 1 in + Delegate_sampler.select_new_distribution_at_cycle_end ctxt ~new_cycle + >>=? fun ctxt -> + Delegate_slashed_deposits_storage.clear_outdated_slashed_deposits + ctxt + ~new_cycle + >>= fun ctxt -> + Delegate_missed_endorsements_storage.distribute_endorsing_rewards + ctxt + last_cycle + unrevealed_nonces + >>=? fun (ctxt, balance_updates) -> + freeze_deposits ctxt ~new_cycle ~balance_updates + >>=? fun (ctxt, balance_updates) -> + Stake_storage.clear_at_cycle_end ctxt ~new_cycle >>=? fun ctxt -> + Delegate_sampler.clear_outdated_sampling_data ctxt ~new_cycle >>=? fun ctxt -> + update_activity ctxt last_cycle >>=? fun (ctxt, deactivated_delagates) -> + return (ctxt, balance_updates, deactivated_delagates) + +let init_first_cycles ctxt = + let preserved = Constants_storage.preserved_cycles ctxt in + List.fold_left_es + (fun ctxt c -> + let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in + Stake_storage.snapshot ctxt >>=? fun ctxt -> + (* NB: we need to take several snapshots because + select_distribution_for_cycle deletes the snapshots *) + Delegate_sampler.select_distribution_for_cycle ctxt cycle) + ctxt + Misc.(0 --> preserved) diff --git a/src/proto_alpha/lib_protocol/delegate_cycles.mli b/src/proto_alpha/lib_protocol/delegate_cycles.mli new file mode 100644 index 000000000000..f45fd05bed59 --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_cycles.mli @@ -0,0 +1,52 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2022 G.B. Fefe, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Trigger the context maintenance at the end of cycle 'n', i.e.: + unfreeze the endorsing rewards, potentially deactivate delegates. + Return the corresponding balances updates and the list of + deactivated delegates. *) +val cycle_end : + Raw_context.t -> + Cycle_repr.t -> + Storage.Seed.unrevealed_nonce list -> + (Raw_context.t + * Receipt_repr.balance_updates + * Signature.Public_key_hash.t list) + tzresult + Lwt.t + +(** [init_first_cycles ctxt] computes and records the distribution of the total + active stake among active delegates. This concerns the total active stake + involved in the calculation of baking rights for all cycles in the range + [0, preserved_cycles]. *) +val init_first_cycles : Raw_context.t -> Raw_context.t tzresult Lwt.t + +val freeze_deposits_do_not_call_except_for_migration : + Raw_context.t -> + new_cycle:Cycle_repr.t -> + balance_updates:Receipt_repr.balance_updates -> + (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml new file mode 100644 index 000000000000..b776c0eb8171 --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml @@ -0,0 +1,266 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2022 G.B. Fefe, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let expected_slots_for_given_active_stake ctxt ~total_active_stake ~active_stake + = + let blocks_per_cycle = + Int32.to_int (Constants_storage.blocks_per_cycle ctxt) + in + let consensus_committee_size = + Constants_storage.consensus_committee_size ctxt + in + let number_of_endorsements_per_cycle = + blocks_per_cycle * consensus_committee_size + in + Result.return + (Z.to_int + (Z.div + (Z.mul + (Z.of_int64 (Tez_repr.to_mutez active_stake)) + (Z.of_int number_of_endorsements_per_cycle)) + (Z.of_int64 (Tez_repr.to_mutez total_active_stake)))) + +type level_participation = Participated | Didn't_participate + +(* Note that the participation for the last block of a cycle is + recorded in the next cycle. *) +let record_endorsing_participation ctxt ~delegate ~participation + ~endorsing_power = + match participation with + | Participated -> Delegate_storage.set_active ctxt delegate + | Didn't_participate -> ( + let contract = Contract_repr.Implicit delegate in + Storage.Contract.Missed_endorsements.find ctxt contract >>=? function + | Some {remaining_slots; missed_levels} -> + let remaining_slots = remaining_slots - endorsing_power in + Storage.Contract.Missed_endorsements.update + ctxt + contract + {remaining_slots; missed_levels = missed_levels + 1} + | None -> ( + let level = Level_storage.current ctxt in + Raw_context.stake_distribution_for_current_cycle ctxt + >>?= fun stake_distribution -> + match + Signature.Public_key_hash.Map.find delegate stake_distribution + with + | None -> + (* This happens when the block is the first one in a + cycle, and therefore the endorsements are for the last + block of the previous cycle, and when the delegate does + not have an active stake at the current cycle; in this + case its participation is simply ignored. *) + assert (Compare.Int32.(level.cycle_position = 0l)) ; + return ctxt + | Some active_stake -> + Stake_storage.get_total_active_stake ctxt level.cycle + >>=? fun total_active_stake -> + expected_slots_for_given_active_stake + ctxt + ~total_active_stake + ~active_stake + >>?= fun expected_slots -> + let Ratio_repr.{numerator; denominator} = + Constants_storage.minimal_participation_ratio ctxt + in + let minimal_activity = expected_slots * numerator / denominator in + let maximal_inactivity = expected_slots - minimal_activity in + let remaining_slots = maximal_inactivity - endorsing_power in + Storage.Contract.Missed_endorsements.init + ctxt + contract + {remaining_slots; missed_levels = 1})) + +let record_baking_activity_and_pay_rewards_and_fees ctxt ~payload_producer + ~block_producer ~baking_reward ~reward_bonus = + Delegate_storage.set_active ctxt payload_producer >>=? fun ctxt -> + (if not (Signature.Public_key_hash.equal payload_producer block_producer) then + Delegate_storage.set_active ctxt block_producer + else return ctxt) + >>=? fun ctxt -> + let pay_payload_producer ctxt delegate = + let contract = Contract_repr.Implicit delegate in + Token.balance ctxt `Block_fees >>=? fun (ctxt, block_fees) -> + Token.transfer_n + ctxt + [(`Block_fees, block_fees); (`Baking_rewards, baking_reward)] + (`Contract contract) + in + let pay_block_producer ctxt delegate bonus = + let contract = Contract_repr.Implicit delegate in + Token.transfer ctxt `Baking_bonuses (`Contract contract) bonus + in + pay_payload_producer ctxt payload_producer + >>=? fun (ctxt, balance_updates_payload_producer) -> + (match reward_bonus with + | Some bonus -> pay_block_producer ctxt block_producer bonus + | None -> return (ctxt, [])) + >>=? fun (ctxt, balance_updates_block_producer) -> + return + (ctxt, balance_updates_payload_producer @ balance_updates_block_producer) + +type participation_info = { + expected_cycle_activity : int; + minimal_cycle_activity : int; + missed_slots : int; + missed_levels : int; + remaining_allowed_missed_slots : int; + expected_endorsing_rewards : Tez_repr.t; +} + +(* Inefficient, only for RPC *) +let delegate_participation_info ctxt delegate = + let level = Level_storage.current ctxt in + Stake_storage.get_selected_distribution ctxt level.cycle + >>=? fun stake_distribution -> + match + List.assoc_opt + ~equal:Signature.Public_key_hash.equal + delegate + stake_distribution + with + | None -> + (* delegate does not have an active stake at the current cycle *) + return + { + expected_cycle_activity = 0; + minimal_cycle_activity = 0; + missed_slots = 0; + missed_levels = 0; + remaining_allowed_missed_slots = 0; + expected_endorsing_rewards = Tez_repr.zero; + } + | Some active_stake -> + Stake_storage.get_total_active_stake ctxt level.cycle + >>=? fun total_active_stake -> + expected_slots_for_given_active_stake + ctxt + ~total_active_stake + ~active_stake + >>?= fun expected_cycle_activity -> + let Ratio_repr.{numerator; denominator} = + Constants_storage.minimal_participation_ratio ctxt + in + let endorsing_reward_per_slot = + Constants_storage.endorsing_reward_per_slot ctxt + in + let minimal_cycle_activity = + expected_cycle_activity * numerator / denominator + in + let maximal_cycle_inactivity = + expected_cycle_activity - minimal_cycle_activity + in + let expected_endorsing_rewards = + Tez_repr.mul_exn endorsing_reward_per_slot expected_cycle_activity + in + let contract = Contract_repr.Implicit delegate in + Storage.Contract.Missed_endorsements.find ctxt contract + >>=? fun missed_endorsements -> + let missed_slots, missed_levels, remaining_allowed_missed_slots = + match missed_endorsements with + | None -> (0, 0, maximal_cycle_inactivity) + | Some {remaining_slots; missed_levels} -> + ( maximal_cycle_inactivity - remaining_slots, + missed_levels, + Compare.Int.max 0 remaining_slots ) + in + let expected_endorsing_rewards = + match missed_endorsements with + | Some r when Compare.Int.(r.remaining_slots < 0) -> Tez_repr.zero + | _ -> expected_endorsing_rewards + in + return + { + expected_cycle_activity; + minimal_cycle_activity; + missed_slots; + missed_levels; + remaining_allowed_missed_slots; + expected_endorsing_rewards; + } + +let delegate_participated_enough ctxt delegate = + Storage.Contract.Missed_endorsements.find ctxt delegate >>=? function + | None -> return_true + | Some missed_endorsements -> + return Compare.Int.(missed_endorsements.remaining_slots >= 0) + +let delegate_has_revealed_nonces delegate unrevelead_nonces_set = + not (Signature.Public_key_hash.Set.mem delegate unrevelead_nonces_set) + +let distribute_endorsing_rewards ctxt last_cycle unrevealed_nonces = + let endorsing_reward_per_slot = + Constants_storage.endorsing_reward_per_slot ctxt + in + let unrevealed_nonces_set = + List.fold_left + (fun set {Storage.Seed.nonce_hash = _; delegate} -> + Signature.Public_key_hash.Set.add delegate set) + Signature.Public_key_hash.Set.empty + unrevealed_nonces + in + Stake_storage.get_total_active_stake ctxt last_cycle + >>=? fun total_active_stake -> + Stake_storage.get_selected_distribution ctxt last_cycle >>=? fun delegates -> + List.fold_left_es + (fun (ctxt, balance_updates) (delegate, active_stake) -> + let delegate_contract = Contract_repr.Implicit delegate in + delegate_participated_enough ctxt delegate_contract + >>=? fun sufficient_participation -> + let has_revealed_nonces = + delegate_has_revealed_nonces delegate unrevealed_nonces_set + in + expected_slots_for_given_active_stake + ctxt + ~total_active_stake + ~active_stake + >>?= fun expected_slots -> + let rewards = Tez_repr.mul_exn endorsing_reward_per_slot expected_slots in + (if sufficient_participation && has_revealed_nonces then + (* Sufficient participation: we pay the rewards *) + Token.transfer + ctxt + `Endorsing_rewards + (`Contract delegate_contract) + rewards + >|=? fun (ctxt, payed_rewards_receipts) -> + (ctxt, payed_rewards_receipts @ balance_updates) + else + (* Insufficient participation or unrevealed nonce: no rewards *) + Token.transfer + ctxt + `Endorsing_rewards + (`Lost_endorsing_rewards + (delegate, not sufficient_participation, not has_revealed_nonces)) + rewards + >|=? fun (ctxt, payed_rewards_receipts) -> + (ctxt, payed_rewards_receipts @ balance_updates)) + >>=? fun (ctxt, balance_updates) -> + Storage.Contract.Missed_endorsements.remove ctxt delegate_contract + >>= fun ctxt -> return (ctxt, balance_updates)) + (ctxt, []) + delegates diff --git a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli new file mode 100644 index 000000000000..3ac64a03ae96 --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli @@ -0,0 +1,86 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2022 G.B. Fefe, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type level_participation = Participated | Didn't_participate + +(** Record the participation of a delegate as a validator. *) +val record_endorsing_participation : + Raw_context.t -> + delegate:Signature.Public_key_hash.t -> + participation:level_participation -> + endorsing_power:int -> + Raw_context.t tzresult Lwt.t + +(** Participation information. We denote by: + - "static" information that does not change during the cycle + - "dynamic" information that may change during the cycle *) +type participation_info = { + expected_cycle_activity : int; + (** The total expected slots to be endorsed in the cycle. (static) *) + minimal_cycle_activity : int; + (** The minimal endorsing slots in the cycle to get endorsing + rewards. (static) *) + missed_slots : int; + (** The number of missed endorsing slots in the cycle. (dynamic) *) + missed_levels : int; + (** The number of missed endorsing levels in the cycle. (dynamic) *) + remaining_allowed_missed_slots : int; + (** Remaining amount of endorsing slots that can be missed in the + cycle before forfeiting the rewards. (dynamic) *) + expected_endorsing_rewards : Tez_repr.t; + (** Endorsing rewards that will be distributed at the end of the + cycle if activity at that point will be greater than the minimal + required. If the activity is already known to be below the + required minimum, then the rewards are zero. (dynamic) *) +} + +(** Only use this function for RPC: this is expensive. + + [delegate_participation_info] and [!val:check_delegate] forms the + implementation of RPC call "/context/delegates//participation". + *) +val delegate_participation_info : + Raw_context.t -> + Signature.Public_key_hash.t -> + participation_info tzresult Lwt.t + +(** Sets the payload and block producer as active. Pays the baking + reward and the fees to the payload producer and the reward bonus to + the payload producer (if the reward_bonus is not None).*) +val record_baking_activity_and_pay_rewards_and_fees : + Raw_context.t -> + payload_producer:Signature.Public_key_hash.t -> + block_producer:Signature.Public_key_hash.t -> + baking_reward:Tez_repr.t -> + reward_bonus:Tez_repr.t option -> + (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t + +val distribute_endorsing_rewards : + Raw_context.t -> + Cycle_repr.t -> + Storage.Seed.unrevealed_nonce list -> + (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/delegate_sampler.ml b/src/proto_alpha/lib_protocol/delegate_sampler.ml new file mode 100644 index 000000000000..71b837b7ef60 --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_sampler.ml @@ -0,0 +1,242 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2022 G.B. Fefe, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Delegate_sampler_state = struct + module Cache_client = struct + type cached_value = + (Signature.public_key * Signature.public_key_hash) Sampler.t + + let namespace = Cache_repr.create_namespace "sampler_state" + + let cache_index = 2 + + let value_of_identifier ctxt identifier = + let cycle = Cycle_repr.of_string_exn identifier in + Storage.Delegate_sampler_state.get ctxt cycle + end + + module Cache = (val Cache_repr.register_exn (module Cache_client)) + + let identifier_of_cycle cycle = Format.asprintf "%a" Cycle_repr.pp cycle + + let init ctxt cycle sampler_state = + let id = identifier_of_cycle cycle in + Storage.Delegate_sampler_state.init ctxt cycle sampler_state + >>=? fun ctxt -> + let size = 1 (* that's symbolic: 1 cycle = 1 entry *) in + Cache.update ctxt id (Some (sampler_state, size)) >>?= fun ctxt -> + return ctxt + + let get ctxt cycle = + let id = identifier_of_cycle cycle in + Cache.find ctxt id >>=? function + | None -> Storage.Delegate_sampler_state.get ctxt cycle + | Some v -> return v + + let remove_existing ctxt cycle = + let id = identifier_of_cycle cycle in + Cache.update ctxt id None >>?= fun ctxt -> + Storage.Delegate_sampler_state.remove_existing ctxt cycle +end + +module Random = struct + (* [init_random_state] initialize a random sequence drawing state + that's unique for a given (seed, level, index) triple. Elements + from this sequence are drawn using [take_int64], updating the + state for the next draw. The initial state is the Blake2b hash of + the three randomness sources, and an offset set to zero + (indicating that zero bits of randomness have been + consumed). When drawing random elements, bits are extracted from + the state until exhaustion (256 bits), at which point the state + is rehashed and the offset reset to 0. *) + + let init_random_state seed level index = + ( Raw_hashes.blake2b + (Data_encoding.Binary.to_bytes_exn + Data_encoding.(tup3 Seed_repr.seed_encoding int32 int32) + (seed, level.Level_repr.cycle_position, Int32.of_int index)), + 0 ) + + let take_int64 bound state = + let drop_if_over = + (* This function draws random values in [0-(bound-1)] by drawing + in [0-(2^63-1)] (64-bit) and computing the value modulo + [bound]. For the application of [mod bound] to preserve + uniformity, the input space must be of the form + [0-(n*bound-1)]. We enforce this by rejecting 64-bit samples + above this limit (in which case, we draw a new 64-sample from + the sequence and try again). *) + Int64.sub Int64.max_int (Int64.rem Int64.max_int bound) + in + let rec loop (bytes, n) = + let consumed_bytes = 8 in + let state_size = Bytes.length bytes in + if Compare.Int.(n > state_size - consumed_bytes) then + loop (Raw_hashes.blake2b bytes, 0) + else + let r = TzEndian.get_int64 bytes n in + (* The absolute value of min_int is min_int. Also, every + positive integer is represented twice (positive and negative), + but zero is only represented once. We fix both problems at + once. *) + let r = if Compare.Int64.(r = Int64.min_int) then 0L else Int64.abs r in + if Compare.Int64.(r >= drop_if_over) then + loop (bytes, n + consumed_bytes) + else + let v = Int64.rem r bound in + (v, (bytes, n + consumed_bytes)) + in + loop state + + (** [sampler_for_cycle ctxt cycle] reads the sampler for [cycle] from + [ctxt] if it has been previously inited. Otherwise it initializes + the sampler and caches it in [ctxt] with + [Raw_context.set_sampler_for_cycle]. *) + let sampler_for_cycle ctxt cycle = + let read ctxt = + Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed -> + Delegate_sampler_state.get ctxt cycle >>=? fun state -> + return (seed, state) + in + Raw_context.sampler_for_cycle ~read ctxt cycle + + let owner c (level : Level_repr.t) offset = + let cycle = level.Level_repr.cycle in + sampler_for_cycle c cycle >>=? fun (c, seed, state) -> + let sample ~int_bound ~mass_bound = + let state = init_random_state seed level offset in + let i, state = take_int64 (Int64.of_int int_bound) state in + let elt, _ = take_int64 mass_bound state in + (Int64.to_int i, elt) + in + let pk, pkh = Sampler.sample state sample in + return (c, (pk, pkh)) +end + +let slot_owner c level slot = Random.owner c level (Slot_repr.to_int slot) + +let baking_rights_owner c (level : Level_repr.t) ~round = + Round_repr.to_int round >>?= fun round -> + let consensus_committee_size = Constants_storage.consensus_committee_size c in + Slot_repr.of_int (round mod consensus_committee_size) >>?= fun slot -> + slot_owner c level slot >>=? fun (ctxt, pk) -> return (ctxt, slot, pk) + +let get_stakes_for_selected_index ctxt index = + Stake_storage.fold_snapshot + ctxt + ~index + ~f:(fun (delegate, staking_balance) (acc, total_stake) -> + let delegate_contract = Contract_repr.Implicit delegate in + let open Tez_repr in + let open Lwt_result_syntax in + let* frozen_deposits_limit = + Delegate_storage.frozen_deposits_limit ctxt delegate + in + + let* balance_and_frozen_bonds = + Contract_storage.get_balance_and_frozen_bonds ctxt delegate_contract + in + let* frozen_deposits = + Frozen_deposits_storage.get ctxt delegate_contract + in + let*? total_balance = + balance_and_frozen_bonds +? frozen_deposits.current_amount + in + let* stake_for_cycle = + let frozen_deposits_percentage = + Int64.of_int @@ Constants_storage.frozen_deposits_percentage ctxt + in + let max_mutez = of_mutez_exn Int64.max_int in + let frozen_deposits_limit = + match frozen_deposits_limit with Some fdp -> fdp | None -> max_mutez + in + let aux = min total_balance frozen_deposits_limit in + let*? overflow_bound = max_mutez /? 100L in + if aux <= overflow_bound then + let*? aux = aux *? 100L in + let*? v = aux /? frozen_deposits_percentage in + return (min v staking_balance) + else + let*? sbal = staking_balance /? 100L in + let*? a = aux /? frozen_deposits_percentage in + if sbal <= a then return staking_balance + else + let*? r = max_mutez /? frozen_deposits_percentage in + return r + in + let*? total_stake = Tez_repr.(total_stake +? stake_for_cycle) in + return ((delegate, stake_for_cycle) :: acc, total_stake)) + ~init:([], Tez_repr.zero) + +let compute_snapshot_index_for_seed ~max_snapshot_index seed = + let rd = Seed_repr.initialize_new seed [Bytes.of_string "stake_snapshot"] in + let seq = Seed_repr.sequence rd 0l in + Seed_repr.take_int32 seq (Int32.of_int max_snapshot_index) + |> fst |> Int32.to_int |> return + +let compute_snapshot_index ctxt cycle ~max_snapshot_index = + Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed -> + compute_snapshot_index_for_seed ~max_snapshot_index seed + +let select_distribution_for_cycle ctxt cycle = + Stake_storage.max_snapshot_index ctxt >>=? fun max_snapshot_index -> + Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed -> + compute_snapshot_index_for_seed ~max_snapshot_index seed + >>=? fun selected_index -> + get_stakes_for_selected_index ctxt selected_index + >>=? fun (stakes, total_stake) -> + Stake_storage.set_selected_distribution_for_cycle + ctxt + cycle + stakes + total_stake + >>=? fun ctxt -> + List.fold_left_es + (fun acc (pkh, stake) -> + Delegate_storage.pubkey ctxt pkh >|=? fun pk -> + ((pk, pkh), Tez_repr.to_mutez stake) :: acc) + [] + stakes + >>=? fun stakes_pk -> + let state = Sampler.create stakes_pk in + Delegate_sampler_state.init ctxt cycle state >>=? fun ctxt -> + (* pre-allocate the sampler *) + Lwt.return (Raw_context.init_sampler_for_cycle ctxt cycle seed state) + +let select_new_distribution_at_cycle_end ctxt ~new_cycle = + let preserved = Constants_storage.preserved_cycles ctxt in + let for_cycle = Cycle_repr.add new_cycle preserved in + select_distribution_for_cycle ctxt for_cycle + +let clear_outdated_sampling_data ctxt ~new_cycle = + let max_slashing_period = Constants_storage.max_slashing_period ctxt in + match Cycle_repr.sub new_cycle max_slashing_period with + | None -> return ctxt + | Some outdated_cycle -> + Delegate_sampler_state.remove_existing ctxt outdated_cycle + >>=? fun ctxt -> + Storage.Seed.For_cycle.remove_existing ctxt outdated_cycle diff --git a/src/proto_alpha/lib_protocol/delegate_sampler.mli b/src/proto_alpha/lib_protocol/delegate_sampler.mli new file mode 100644 index 000000000000..194c5a50468b --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_sampler.mli @@ -0,0 +1,65 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2022 G.B. Fefe, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Participation slots potentially associated to accounts. The + accounts that didn't place a deposit will be excluded from this + list. This function should only be used to compute the deposits to + freeze or initialize the protocol while stitching. RPCs can use this + function to predict an approximation of long term future slot + allocations. It shouldn't be used in the baker. *) +val slot_owner : + Raw_context.t -> + Level_repr.t -> + Slot_repr.t -> + (Raw_context.t * (Signature.public_key * Signature.public_key_hash)) tzresult + Lwt.t + +val baking_rights_owner : + Raw_context.t -> + Level_repr.t -> + round:Round_repr.round -> + (Raw_context.t + * Slot_repr.t + * (Signature.public_key * Signature.public_key_hash)) + tzresult + Lwt.t + +(** [compute_snapshot_index ctxt cycle max_snapshot_index] Returns the index of + the selected snapshot for the [cycle] passed as argument, and for the max + index of snapshots taken so far, [max_snapshot_index] (see + [Stake_storage.max_snapshot_index]. *) +val compute_snapshot_index : + Raw_context.t -> Cycle_repr.t -> max_snapshot_index:int -> int tzresult Lwt.t + +val select_new_distribution_at_cycle_end : + Raw_context.t -> new_cycle:Cycle_repr.t -> Raw_context.t tzresult Lwt.t + +val clear_outdated_sampling_data : + Raw_context.t -> new_cycle:Cycle_repr.t -> Raw_context.t tzresult Lwt.t + +val select_distribution_for_cycle : + Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml new file mode 100644 index 000000000000..043f8c117346 --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml @@ -0,0 +1,118 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2022 G.B. Fefe, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let check_and_record_already_slashed_for_double_baking ctxt delegate + (level : Level_repr.t) = + let open Lwt_tzresult_syntax in + let* slashed = + Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate) + in + let already_slashed, updated_slashed = + match slashed with + | None -> + (false, {Storage.for_double_baking = true; for_double_endorsing = false}) + | Some slashed -> + (slashed.for_double_baking, {slashed with for_double_baking = true}) + in + let*! ctxt = + Storage.Slashed_deposits.add + (ctxt, level.cycle) + (level.level, delegate) + updated_slashed + in + return (ctxt, already_slashed) + +let check_and_record_already_slashed_for_double_endorsing ctxt delegate + (level : Level_repr.t) = + let open Lwt_tzresult_syntax in + let* slashed = + Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate) + in + let already_slashed, updated_slashed = + match slashed with + | None -> + (false, {Storage.for_double_endorsing = true; for_double_baking = false}) + | Some slashed -> + ( slashed.for_double_endorsing, + {slashed with for_double_endorsing = true} ) + in + let*! ctxt = + Storage.Slashed_deposits.add + (ctxt, level.cycle) + (level.level, delegate) + updated_slashed + in + return (ctxt, already_slashed) + +let clear_outdated_slashed_deposits ctxt ~new_cycle = + let max_slashable_period = Constants_storage.max_slashing_period ctxt in + match Cycle_repr.(sub new_cycle max_slashable_period) with + | None -> Lwt.return ctxt + | Some outdated_cycle -> Storage.Slashed_deposits.clear (ctxt, outdated_cycle) + +let punish_double_endorsing ctxt delegate = + let delegate_contract = Contract_repr.Implicit delegate in + Frozen_deposits_storage.get ctxt delegate_contract >>=? fun frozen_deposits -> + let slashing_ratio : Ratio_repr.t = + Constants_storage.ratio_of_frozen_deposits_slashed_per_double_endorsement + ctxt + in + let punish_value = + Tez_repr.( + div_exn + (mul_exn frozen_deposits.initial_amount slashing_ratio.numerator) + slashing_ratio.denominator) + in + let amount_to_burn = + Tez_repr.(min frozen_deposits.current_amount punish_value) + in + Token.transfer + ctxt + (`Frozen_deposits delegate) + `Double_signing_punishments + amount_to_burn + >>=? fun (ctxt, balance_updates) -> + Stake_storage.remove_stake ctxt delegate amount_to_burn >>=? fun ctxt -> + return (ctxt, amount_to_burn, balance_updates) + +let punish_double_baking ctxt delegate = + let delegate_contract = Contract_repr.Implicit delegate in + Frozen_deposits_storage.get ctxt delegate_contract >>=? fun frozen_deposits -> + let slashing_for_one_block = + Constants_storage.double_baking_punishment ctxt + in + let amount_to_burn = + Tez_repr.(min frozen_deposits.current_amount slashing_for_one_block) + in + Token.transfer + ctxt + (`Frozen_deposits delegate) + `Double_signing_punishments + amount_to_burn + >>=? fun (ctxt, balance_updates) -> + Stake_storage.remove_stake ctxt delegate amount_to_burn >>=? fun ctxt -> + return (ctxt, amount_to_burn, balance_updates) diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli new file mode 100644 index 000000000000..474456f6c49d --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli @@ -0,0 +1,61 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2022 G.B. Fefe, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Burn some frozen deposit for a delegate at a given level. Returns + the burned amount. *) +val punish_double_endorsing : + Raw_context.t -> + Signature.Public_key_hash.t -> + (Raw_context.t * Tez_repr.t * Receipt_repr.balance_updates) tzresult Lwt.t + +val punish_double_baking : + Raw_context.t -> + Signature.Public_key_hash.t -> + (Raw_context.t * Tez_repr.t * Receipt_repr.balance_updates) tzresult Lwt.t + +(** Returns true if the given delegate has already been slashed + for double baking for the given level, and record in the context + that the given delegate has now been slashed for double baking + for the given level. *) +val check_and_record_already_slashed_for_double_baking : + Raw_context.t -> + Signature.Public_key_hash.t -> + Level_repr.t -> + (Raw_context.t * bool) tzresult Lwt.t + +(** Returns true if the given delegate has already been slashed for + double preendorsing or double endorsing for the given level, and + record in the context that the given delegate has now been slashed + for double preendorsing or double endorsing for the given level. *) +val check_and_record_already_slashed_for_double_endorsing : + Raw_context.t -> + Signature.Public_key_hash.t -> + Level_repr.t -> + (Raw_context.t * bool) tzresult Lwt.t + +val clear_outdated_slashed_deposits : + Raw_context.t -> new_cycle:Cycle_repr.t -> Raw_context.t Lwt.t diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml index d2f0fa7c7656..8d10d9fad5c4 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_storage.ml @@ -3,6 +3,7 @@ (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) (* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2022 G.B. Fefe, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -170,6 +171,37 @@ let () = (function Not_registered pkh -> Some pkh | _ -> None) (fun pkh -> Not_registered pkh) +(* The fact that this succeeds iff [registered ctxt pkh] returns true is an + invariant of the [set] function. *) +let check_delegate ctxt pkh = + Storage.Delegates.mem ctxt pkh >>= function + | true -> return_unit + | false -> fail (Not_registered pkh) + +let fold = Storage.Delegates.fold + +let list = Storage.Delegates.elements + +let pubkey ctxt pkh = + Contract_manager_storage.get_manager_key + ctxt + pkh + ~error:(Unregistered_delegate pkh) + +let frozen_deposits_limit ctxt delegate = + Storage.Contract.Frozen_deposits_limit.find + ctxt + (Contract_repr.Implicit delegate) + +let set_frozen_deposits_limit ctxt delegate limit = + Storage.Contract.Frozen_deposits_limit.add_or_remove + ctxt + (Contract_repr.Implicit delegate) + limit + +let frozen_deposits ctxt delegate = + Frozen_deposits_storage.get ctxt (Contract_repr.Implicit delegate) + let set_inactive ctxt delegate = Delegate_activation_storage.set_inactive ctxt delegate >>= fun ctxt -> Stake_storage.deactivate_only_call_from_delegate_storage ctxt delegate >|= ok @@ -180,16 +212,30 @@ let set_active ctxt delegate = if not inactive then return ctxt else Stake_storage.activate_only_call_from_delegate_storage ctxt delegate +let balance ctxt delegate = + let contract = Contract_repr.Implicit delegate in + Storage.Contract.Spendable_balance.get ctxt contract + let staking_balance ctxt delegate = Contract_delegate_storage.registered ctxt delegate >>=? fun is_registered -> if is_registered then Stake_storage.get_staking_balance ctxt delegate else return Tez_repr.zero -let pubkey ctxt delegate = - Contract_manager_storage.get_manager_key - ctxt - delegate - ~error:(Unregistered_delegate delegate) +let delegated_balance ctxt delegate = + staking_balance ctxt delegate >>=? fun staking_balance -> + balance ctxt delegate >>=? fun balance -> + frozen_deposits ctxt delegate >>=? fun frozen_deposits -> + Tez_repr.(balance +? frozen_deposits.current_amount) + >>?= fun self_staking_balance -> + Lwt.return Tez_repr.(staking_balance -? self_staking_balance) + +let full_balance ctxt delegate = + frozen_deposits ctxt delegate >>=? fun frozen_deposits -> + let delegate_contract = Contract_repr.Implicit delegate in + Contract_storage.get_balance_and_frozen_bonds ctxt delegate_contract + >>=? fun balance_and_frozen_bonds -> + Lwt.return + Tez_repr.(frozen_deposits.current_amount +? balance_and_frozen_bonds) let init ctxt contract delegate = Contract_manager_storage.is_manager_key_revealed ctxt delegate @@ -254,7 +300,7 @@ let set c contract delegate = else return_unit | Originated _ -> return_unit) >>=? fun () -> - Storage.Contract.Spendable_balance.mem c contract >>= fun exists -> + Contract_storage.allocated c contract >>= fun exists -> error_when (self_delegation && not exists) (Empty_delegate_account delegate) @@ -269,785 +315,3 @@ let set c contract delegate = if self_delegation then Storage.Delegates.add c delegate >>= fun c -> set_active c delegate else return c - -let frozen_deposits_limit ctxt delegate = - Storage.Contract.Frozen_deposits_limit.find - ctxt - (Contract_repr.Implicit delegate) - -let set_frozen_deposits_limit ctxt delegate limit = - Storage.Contract.Frozen_deposits_limit.add_or_remove - ctxt - (Contract_repr.Implicit delegate) - limit - -let update_activity ctxt last_cycle = - let preserved = Constants_storage.preserved_cycles ctxt in - match Cycle_repr.sub last_cycle preserved with - | None -> return (ctxt, []) - | Some _unfrozen_cycle -> - Stake_storage.fold_on_active_delegates_with_rolls - ctxt - ~order:`Sorted - ~init:(Ok (ctxt, [])) - ~f:(fun delegate () acc -> - acc >>?= fun (ctxt, deactivated) -> - Delegate_activation_storage.last_cycle_before_deactivation - ctxt - delegate - >>=? fun cycle -> - if Cycle_repr.(cycle <= last_cycle) then - set_inactive ctxt delegate >|=? fun ctxt -> - (ctxt, delegate :: deactivated) - else return (ctxt, deactivated)) - >|=? fun (ctxt, deactivated) -> (ctxt, deactivated) - -let expected_slots_for_given_active_stake ctxt ~total_active_stake ~active_stake - = - let blocks_per_cycle = - Int32.to_int (Constants_storage.blocks_per_cycle ctxt) - in - let consensus_committee_size = - Constants_storage.consensus_committee_size ctxt - in - let number_of_endorsements_per_cycle = - blocks_per_cycle * consensus_committee_size - in - Result.return - (Z.to_int - (Z.div - (Z.mul - (Z.of_int64 (Tez_repr.to_mutez active_stake)) - (Z.of_int number_of_endorsements_per_cycle)) - (Z.of_int64 (Tez_repr.to_mutez total_active_stake)))) - -let delegate_participated_enough ctxt delegate = - Storage.Contract.Missed_endorsements.find ctxt delegate >>=? function - | None -> return_true - | Some missed_endorsements -> - return Compare.Int.(missed_endorsements.remaining_slots >= 0) - -let delegate_has_revealed_nonces delegate unrevelead_nonces_set = - not (Signature.Public_key_hash.Set.mem delegate unrevelead_nonces_set) - -let distribute_endorsing_rewards ctxt last_cycle unrevealed_nonces = - let endorsing_reward_per_slot = - Constants_storage.endorsing_reward_per_slot ctxt - in - let unrevealed_nonces_set = - List.fold_left - (fun set {Storage.Seed.nonce_hash = _; delegate} -> - Signature.Public_key_hash.Set.add delegate set) - Signature.Public_key_hash.Set.empty - unrevealed_nonces - in - Stake_storage.get_total_active_stake ctxt last_cycle - >>=? fun total_active_stake -> - Stake_storage.get_selected_distribution ctxt last_cycle >>=? fun delegates -> - List.fold_left_es - (fun (ctxt, balance_updates) (delegate, active_stake) -> - let delegate_contract = Contract_repr.Implicit delegate in - delegate_participated_enough ctxt delegate_contract - >>=? fun sufficient_participation -> - let has_revealed_nonces = - delegate_has_revealed_nonces delegate unrevealed_nonces_set - in - expected_slots_for_given_active_stake - ctxt - ~total_active_stake - ~active_stake - >>?= fun expected_slots -> - let rewards = Tez_repr.mul_exn endorsing_reward_per_slot expected_slots in - (if sufficient_participation && has_revealed_nonces then - (* Sufficient participation: we pay the rewards *) - Token.transfer - ctxt - `Endorsing_rewards - (`Contract delegate_contract) - rewards - >|=? fun (ctxt, payed_rewards_receipts) -> - (ctxt, payed_rewards_receipts @ balance_updates) - else - (* Insufficient participation or unrevealed nonce: no rewards *) - Token.transfer - ctxt - `Endorsing_rewards - (`Lost_endorsing_rewards - (delegate, not sufficient_participation, not has_revealed_nonces)) - rewards - >|=? fun (ctxt, payed_rewards_receipts) -> - (ctxt, payed_rewards_receipts @ balance_updates)) - >>=? fun (ctxt, balance_updates) -> - Storage.Contract.Missed_endorsements.remove ctxt delegate_contract - >>= fun ctxt -> return (ctxt, balance_updates)) - (ctxt, []) - delegates - -let clear_outdated_slashed_deposits ctxt ~new_cycle = - let max_slashable_period = Constants_storage.max_slashing_period ctxt in - match Cycle_repr.(sub new_cycle max_slashable_period) with - | None -> Lwt.return ctxt - | Some outdated_cycle -> Storage.Slashed_deposits.clear (ctxt, outdated_cycle) - -(* Return a map from delegates (with active stake at some cycle - in the cycle window [from_cycle, to_cycle]) to the maximum - of the stake to be deposited for each such cycle (which is just the - [frozen_deposits_percentage] of the active stake at that cycle). Also - return the delegates that have fallen out of the sliding window. *) -let max_frozen_deposits_and_delegates_to_remove ctxt ~from_cycle ~to_cycle = - let frozen_deposits_percentage = - Constants_storage.frozen_deposits_percentage ctxt - in - let cycles = Cycle_repr.(from_cycle ---> to_cycle) in - (match Cycle_repr.pred from_cycle with - | None -> return Signature.Public_key_hash.Set.empty - | Some cleared_cycle -> ( - Stake_storage.find_selected_distribution ctxt cleared_cycle - >|=? fun cleared_cycle_delegates -> - match cleared_cycle_delegates with - | None -> Signature.Public_key_hash.Set.empty - | Some delegates -> - List.fold_left - (fun set (d, _) -> Signature.Public_key_hash.Set.add d set) - Signature.Public_key_hash.Set.empty - delegates)) - >>=? fun cleared_cycle_delegates -> - List.fold_left_es - (fun (maxima, delegates_to_remove) (cycle : Cycle_repr.t) -> - Stake_storage.get_selected_distribution ctxt cycle - >|=? fun active_stakes -> - List.fold_left - (fun (maxima, delegates_to_remove) (delegate, stake) -> - let stake_to_be_deposited = - Tez_repr.(div_exn (mul_exn stake frozen_deposits_percentage) 100) - in - let maxima = - Signature.Public_key_hash.Map.update - delegate - (function - | None -> Some stake_to_be_deposited - | Some maximum -> - Some (Tez_repr.max maximum stake_to_be_deposited)) - maxima - in - let delegates_to_remove = - Signature.Public_key_hash.Set.remove delegate delegates_to_remove - in - (maxima, delegates_to_remove)) - (maxima, delegates_to_remove) - active_stakes) - (Signature.Public_key_hash.Map.empty, cleared_cycle_delegates) - cycles - -let freeze_deposits ?(origin = Receipt_repr.Block_application) ctxt ~new_cycle - ~balance_updates = - let max_slashable_period = Constants_storage.max_slashing_period ctxt in - (* We want to be able to slash for at most [max_slashable_period] *) - (match Cycle_repr.(sub new_cycle (max_slashable_period - 1)) with - | None -> - Storage.Tenderbake.First_level_of_protocol.get ctxt - >>=? fun first_level_of_protocol -> - let cycle_eras = Raw_context.cycle_eras ctxt in - let level = - Level_repr.level_from_raw ~cycle_eras first_level_of_protocol - in - return level.cycle - | Some cycle -> return cycle) - >>=? fun from_cycle -> - let preserved_cycles = Constants_storage.preserved_cycles ctxt in - let to_cycle = Cycle_repr.(add new_cycle preserved_cycles) in - max_frozen_deposits_and_delegates_to_remove ctxt ~from_cycle ~to_cycle - >>=? fun (maxima, delegates_to_remove) -> - Signature.Public_key_hash.Map.fold_es - (fun delegate maximum_stake_to_be_deposited (ctxt, balance_updates) -> - (* Here we make sure to preserve the following invariant : - maximum_stake_to_be_deposited <= frozen_deposits + balance - See select_distribution_for_cycle *) - let delegate_contract = Contract_repr.Implicit delegate in - Frozen_deposits_storage.update_initial_amount - ctxt - delegate_contract - maximum_stake_to_be_deposited - >>=? fun ctxt -> - Frozen_deposits_storage.get ctxt delegate_contract >>=? fun deposits -> - let current_amount = deposits.current_amount in - if Tez_repr.(current_amount > maximum_stake_to_be_deposited) then - Tez_repr.(current_amount -? maximum_stake_to_be_deposited) - >>?= fun to_reimburse -> - Token.transfer - ~origin - ctxt - (`Frozen_deposits delegate) - (`Delegate_balance delegate) - to_reimburse - >|=? fun (ctxt, bupds) -> (ctxt, bupds @ balance_updates) - else if Tez_repr.(current_amount < maximum_stake_to_be_deposited) then - Tez_repr.(maximum_stake_to_be_deposited -? current_amount) - >>?= fun desired_to_freeze -> - Storage.Contract.Spendable_balance.get ctxt delegate_contract - >>=? fun balance -> - (* In case the delegate hasn't been slashed in this cycle, - the following invariant holds: - maximum_stake_to_be_deposited <= frozen_deposits + balance - See select_distribution_for_cycle - - If the delegate has been slashed during the cycle, the invariant - above doesn't necessarily hold. In this case, we freeze the max - we can for the delegate. *) - let to_freeze = Tez_repr.(min balance desired_to_freeze) in - Token.transfer - ~origin - ctxt - (`Delegate_balance delegate) - (`Frozen_deposits delegate) - to_freeze - >|=? fun (ctxt, bupds) -> (ctxt, bupds @ balance_updates) - else return (ctxt, balance_updates)) - maxima - (ctxt, balance_updates) - >>=? fun (ctxt, balance_updates) -> - (* Unfreeze deposits (that is, set them to zero) for delegates that - were previously in the relevant window (and therefore had some - frozen deposits) but are not in the new window; because that means - that such a delegate had no active stake in the relevant cycles, - and therefore it should have no frozen deposits. *) - Signature.Public_key_hash.Set.fold_es - (fun delegate (ctxt, balance_updates) -> - let delegate_contract = Contract_repr.Implicit delegate in - Frozen_deposits_storage.update_initial_amount - ctxt - delegate_contract - Tez_repr.zero - >>=? fun ctxt -> - Frozen_deposits_storage.get ctxt delegate_contract - >>=? fun frozen_deposits -> - if Tez_repr.(frozen_deposits.current_amount > zero) then - Token.transfer - ~origin - ctxt - (`Frozen_deposits delegate) - (`Delegate_balance delegate) - frozen_deposits.current_amount - >|=? fun (ctxt, bupds) -> (ctxt, bupds @ balance_updates) - else return (ctxt, balance_updates)) - delegates_to_remove - (ctxt, balance_updates) - -let freeze_deposits_do_not_call_except_for_migration = - freeze_deposits ~origin:Protocol_migration - -module Delegate_sampler_state = struct - module Cache_client = struct - type cached_value = - (Signature.Public_key.t * Signature.Public_key_hash.t) Sampler.t - - let namespace = Cache_repr.create_namespace "sampler_state" - - let cache_index = 2 - - let value_of_identifier ctxt identifier = - let cycle = Cycle_repr.of_string_exn identifier in - Storage.Delegate_sampler_state.get ctxt cycle - end - - module Cache = (val Cache_repr.register_exn (module Cache_client)) - - let identifier_of_cycle cycle = Format.asprintf "%a" Cycle_repr.pp cycle - - let init ctxt cycle sampler_state = - let id = identifier_of_cycle cycle in - Storage.Delegate_sampler_state.init ctxt cycle sampler_state - >>=? fun ctxt -> - let size = 1 (* that's symbolic: 1 cycle = 1 entry *) in - Cache.update ctxt id (Some (sampler_state, size)) >>?= fun ctxt -> - return ctxt - - let get ctxt cycle = - let id = identifier_of_cycle cycle in - Cache.find ctxt id >>=? function - | None -> Storage.Delegate_sampler_state.get ctxt cycle - | Some v -> return v - - let remove_existing ctxt cycle = - let id = identifier_of_cycle cycle in - Cache.update ctxt id None >>?= fun ctxt -> - Storage.Delegate_sampler_state.remove_existing ctxt cycle -end - -let get_stakes_for_selected_index ctxt index = - Stake_storage.fold_snapshot - ctxt - ~index - ~f:(fun (delegate, staking_balance) (acc, total_stake) -> - let delegate_contract = Contract_repr.Implicit delegate in - let open Tez_repr in - let open Lwt_result_syntax in - let* frozen_deposits_limit = - Storage.Contract.Frozen_deposits_limit.find ctxt delegate_contract - in - - let* balance_and_frozen_bonds = - Contract_storage.get_balance_and_frozen_bonds ctxt delegate_contract - in - let* frozen_deposits = - Frozen_deposits_storage.get ctxt delegate_contract - in - let*? total_balance = - balance_and_frozen_bonds +? frozen_deposits.current_amount - in - let* stake_for_cycle = - let frozen_deposits_percentage = - Int64.of_int @@ Constants_storage.frozen_deposits_percentage ctxt - in - let max_mutez = of_mutez_exn Int64.max_int in - let frozen_deposits_limit = - match frozen_deposits_limit with Some fdp -> fdp | None -> max_mutez - in - let aux = min total_balance frozen_deposits_limit in - let*? overflow_bound = max_mutez /? 100L in - if aux <= overflow_bound then - let*? aux = aux *? 100L in - let*? v = aux /? frozen_deposits_percentage in - return (min v staking_balance) - else - let*? sbal = staking_balance /? 100L in - let*? a = aux /? frozen_deposits_percentage in - if sbal <= a then return staking_balance - else - let*? r = max_mutez /? frozen_deposits_percentage in - return r - in - let*? total_stake = Tez_repr.(total_stake +? stake_for_cycle) in - return ((delegate, stake_for_cycle) :: acc, total_stake)) - ~init:([], Tez_repr.zero) - -let compute_snapshot_index_for_seed ~max_snapshot_index seed = - let rd = Seed_repr.initialize_new seed [Bytes.of_string "stake_snapshot"] in - let seq = Seed_repr.sequence rd 0l in - Seed_repr.take_int32 seq (Int32.of_int max_snapshot_index) - |> fst |> Int32.to_int |> return - -let compute_snapshot_index ctxt cycle ~max_snapshot_index = - Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed -> - compute_snapshot_index_for_seed ~max_snapshot_index seed - -let select_distribution_for_cycle ctxt cycle = - Stake_storage.max_snapshot_index ctxt >>=? fun max_snapshot_index -> - Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed -> - compute_snapshot_index_for_seed ~max_snapshot_index seed - >>=? fun selected_index -> - get_stakes_for_selected_index ctxt selected_index - >>=? fun (stakes, total_stake) -> - Stake_storage.set_selected_distribution_for_cycle - ctxt - cycle - stakes - total_stake - >>=? fun ctxt -> - List.fold_left_es - (fun acc (pkh, stake) -> - pubkey ctxt pkh >|=? fun pk -> ((pk, pkh), Tez_repr.to_mutez stake) :: acc) - [] - stakes - >>=? fun stakes_pk -> - let state = Sampler.create stakes_pk in - Delegate_sampler_state.init ctxt cycle state >>=? fun ctxt -> - (* pre-allocate the sampler *) - Lwt.return (Raw_context.init_sampler_for_cycle ctxt cycle seed state) - -let select_new_distribution_at_cycle_end ctxt ~new_cycle = - let preserved = Constants_storage.preserved_cycles ctxt in - let for_cycle = Cycle_repr.add new_cycle preserved in - select_distribution_for_cycle ctxt for_cycle - -let clear_outdated_sampling_data ctxt ~new_cycle = - let max_slashing_period = Constants_storage.max_slashing_period ctxt in - match Cycle_repr.sub new_cycle max_slashing_period with - | None -> return ctxt - | Some outdated_cycle -> - Delegate_sampler_state.remove_existing ctxt outdated_cycle - >>=? fun ctxt -> - Storage.Seed.For_cycle.remove_existing ctxt outdated_cycle - -let cycle_end ctxt last_cycle unrevealed_nonces = - let new_cycle = Cycle_repr.add last_cycle 1 in - select_new_distribution_at_cycle_end ctxt ~new_cycle >>=? fun ctxt -> - clear_outdated_slashed_deposits ctxt ~new_cycle >>= fun ctxt -> - distribute_endorsing_rewards ctxt last_cycle unrevealed_nonces - >>=? fun (ctxt, balance_updates) -> - freeze_deposits ctxt ~new_cycle ~balance_updates - >>=? fun (ctxt, balance_updates) -> - Stake_storage.clear_at_cycle_end ctxt ~new_cycle >>=? fun ctxt -> - clear_outdated_sampling_data ctxt ~new_cycle >>=? fun ctxt -> - update_activity ctxt last_cycle >>=? fun (ctxt, deactivated_delagates) -> - return (ctxt, balance_updates, deactivated_delagates) - -let balance ctxt delegate = - let contract = Contract_repr.Implicit delegate in - Storage.Contract.Spendable_balance.get ctxt contract - -let frozen_deposits ctxt delegate = - Frozen_deposits_storage.get ctxt (Contract_repr.Implicit delegate) - -let full_balance ctxt delegate = - frozen_deposits ctxt delegate >>=? fun frozen_deposits -> - let delegate_contract = Contract_repr.Implicit delegate in - Contract_storage.get_balance_and_frozen_bonds ctxt delegate_contract - >>=? fun balance_and_frozen_bonds -> - Lwt.return - Tez_repr.(frozen_deposits.current_amount +? balance_and_frozen_bonds) - -let deactivated = Delegate_activation_storage.is_inactive - -let delegated_balance ctxt delegate = - staking_balance ctxt delegate >>=? fun staking_balance -> - balance ctxt delegate >>=? fun balance -> - frozen_deposits ctxt delegate >>=? fun frozen_deposits -> - Tez_repr.(balance +? frozen_deposits.current_amount) - >>?= fun self_staking_balance -> - Lwt.return Tez_repr.(staking_balance -? self_staking_balance) - -let fold = Storage.Delegates.fold - -let list = Storage.Delegates.elements - -(* The fact that this succeeds iff [registered ctxt pkh] returns true is an - invariant of the [set] function. *) -let check_delegate ctxt pkh = - Storage.Delegates.mem ctxt pkh >>= function - | true -> return_unit - | false -> fail (Not_registered pkh) - -module Random = struct - (* [init_random_state] initialize a random sequence drawing state - that's unique for a given (seed, level, index) triple. Elements - from this sequence are drawn using [take_int64], updating the - state for the next draw. The initial state is the Blake2b hash of - the three randomness sources, and an offset set to zero - (indicating that zero bits of randomness have been - consumed). When drawing random elements, bits are extracted from - the state until exhaustion (256 bits), at which point the state - is rehashed and the offset reset to 0. *) - - let init_random_state seed level index = - ( Raw_hashes.blake2b - (Data_encoding.Binary.to_bytes_exn - Data_encoding.(tup3 Seed_repr.seed_encoding int32 int32) - (seed, level.Level_repr.cycle_position, Int32.of_int index)), - 0 ) - - let take_int64 bound state = - let drop_if_over = - (* This function draws random values in [0-(bound-1)] by drawing - in [0-(2^63-1)] (64-bit) and computing the value modulo - [bound]. For the application of [mod bound] to preserve - uniformity, the input space must be of the form - [0-(n*bound-1)]. We enforce this by rejecting 64-bit samples - above this limit (in which case, we draw a new 64-sample from - the sequence and try again). *) - Int64.sub Int64.max_int (Int64.rem Int64.max_int bound) - in - let rec loop (bytes, n) = - let consumed_bytes = 8 in - let state_size = Bytes.length bytes in - if Compare.Int.(n > state_size - consumed_bytes) then - loop (Raw_hashes.blake2b bytes, 0) - else - let r = TzEndian.get_int64 bytes n in - (* The absolute value of min_int is min_int. Also, every - positive integer is represented twice (positive and negative), - but zero is only represented once. We fix both problems at - once. *) - let r = if Compare.Int64.(r = Int64.min_int) then 0L else Int64.abs r in - if Compare.Int64.(r >= drop_if_over) then - loop (bytes, n + consumed_bytes) - else - let v = Int64.rem r bound in - (v, (bytes, n + consumed_bytes)) - in - loop state - - (** [sampler_for_cycle ctxt cycle] reads the sampler for [cycle] from - [ctxt] if it has been previously inited. Otherwise it initializes - the sampler and caches it in [ctxt] with - [Raw_context.set_sampler_for_cycle]. *) - let sampler_for_cycle ctxt cycle = - let read ctxt = - Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed -> - Delegate_sampler_state.get ctxt cycle >>=? fun state -> - return (seed, state) - in - Raw_context.sampler_for_cycle ~read ctxt cycle - - let owner c (level : Level_repr.t) offset = - let cycle = level.Level_repr.cycle in - sampler_for_cycle c cycle >>=? fun (c, seed, state) -> - let sample ~int_bound ~mass_bound = - let state = init_random_state seed level offset in - let i, state = take_int64 (Int64.of_int int_bound) state in - let elt, _ = take_int64 mass_bound state in - (Int64.to_int i, elt) - in - let pk, pkh = Sampler.sample state sample in - return (c, (pk, pkh)) -end - -let slot_owner c level slot = Random.owner c level (Slot_repr.to_int slot) - -let baking_rights_owner c (level : Level_repr.t) ~round = - Round_repr.to_int round >>?= fun round -> - let consensus_committee_size = Constants_storage.consensus_committee_size c in - Slot_repr.of_int (round mod consensus_committee_size) >>?= fun slot -> - slot_owner c level slot >>=? fun (ctxt, pk) -> return (ctxt, slot, pk) - -let already_slashed_for_double_endorsing ctxt delegate (level : Level_repr.t) = - Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate) - >>=? function - | None -> return_false - | Some slashed -> return slashed.for_double_endorsing - -let already_slashed_for_double_baking ctxt delegate (level : Level_repr.t) = - Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate) - >>=? function - | None -> return_false - | Some slashed -> return slashed.for_double_baking - -let punish_double_endorsing ctxt delegate (level : Level_repr.t) = - let delegate_contract = Contract_repr.Implicit delegate in - Frozen_deposits_storage.get ctxt delegate_contract >>=? fun frozen_deposits -> - let slashing_ratio : Ratio_repr.t = - Constants_storage.ratio_of_frozen_deposits_slashed_per_double_endorsement - ctxt - in - let punish_value = - Tez_repr.( - div_exn - (mul_exn frozen_deposits.initial_amount slashing_ratio.numerator) - slashing_ratio.denominator) - in - let amount_to_burn = - Tez_repr.(min frozen_deposits.current_amount punish_value) - in - Token.transfer - ctxt - (`Frozen_deposits delegate) - `Double_signing_punishments - amount_to_burn - >>=? fun (ctxt, balance_updates) -> - Stake_storage.remove_stake ctxt delegate amount_to_burn >>=? fun ctxt -> - Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate) - >>=? fun slashed -> - let slashed : Storage.slashed_level = - match slashed with - | None -> {for_double_endorsing = true; for_double_baking = false} - | Some slashed -> - assert (Compare.Bool.(slashed.for_double_endorsing = false)) ; - {slashed with for_double_endorsing = true} - in - Storage.Slashed_deposits.add - (ctxt, level.cycle) - (level.level, delegate) - slashed - >>= fun ctxt -> return (ctxt, amount_to_burn, balance_updates) - -let punish_double_baking ctxt delegate (level : Level_repr.t) = - let delegate_contract = Contract_repr.Implicit delegate in - Frozen_deposits_storage.get ctxt delegate_contract >>=? fun frozen_deposits -> - let slashing_for_one_block = - Constants_storage.double_baking_punishment ctxt - in - let amount_to_burn = - Tez_repr.(min frozen_deposits.current_amount slashing_for_one_block) - in - Token.transfer - ctxt - (`Frozen_deposits delegate) - `Double_signing_punishments - amount_to_burn - >>=? fun (ctxt, balance_updates) -> - Stake_storage.remove_stake ctxt delegate amount_to_burn >>=? fun ctxt -> - Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate) - >>=? fun slashed -> - let slashed : Storage.slashed_level = - match slashed with - | None -> {for_double_endorsing = false; for_double_baking = true} - | Some slashed -> - assert (Compare.Bool.(slashed.for_double_baking = false)) ; - {slashed with for_double_baking = true} - in - Storage.Slashed_deposits.add - (ctxt, level.cycle) - (level.level, delegate) - slashed - >>= fun ctxt -> return (ctxt, amount_to_burn, balance_updates) - -type level_participation = Participated | Didn't_participate - -(* Note that the participation for the last block of a cycle is - recorded in the next cycle. *) -let record_endorsing_participation ctxt ~delegate ~participation - ~endorsing_power = - match participation with - | Participated -> set_active ctxt delegate - | Didn't_participate -> ( - let contract = Contract_repr.Implicit delegate in - Storage.Contract.Missed_endorsements.find ctxt contract >>=? function - | Some {remaining_slots; missed_levels} -> - let remaining_slots = remaining_slots - endorsing_power in - Storage.Contract.Missed_endorsements.update - ctxt - contract - {remaining_slots; missed_levels = missed_levels + 1} - | None -> ( - let level = Level_storage.current ctxt in - Raw_context.stake_distribution_for_current_cycle ctxt - >>?= fun stake_distribution -> - match - Signature.Public_key_hash.Map.find delegate stake_distribution - with - | None -> - (* This happens when the block is the first one in a - cycle, and therefore the endorsements are for the last - block of the previous cycle, and when the delegate does - not have an active stake at the current cycle; in this - case its participation is simply ignored. *) - assert (Compare.Int32.(level.cycle_position = 0l)) ; - return ctxt - | Some active_stake -> - Stake_storage.get_total_active_stake ctxt level.cycle - >>=? fun total_active_stake -> - expected_slots_for_given_active_stake - ctxt - ~total_active_stake - ~active_stake - >>?= fun expected_slots -> - let Ratio_repr.{numerator; denominator} = - Constants_storage.minimal_participation_ratio ctxt - in - let minimal_activity = expected_slots * numerator / denominator in - let maximal_inactivity = expected_slots - minimal_activity in - let remaining_slots = maximal_inactivity - endorsing_power in - Storage.Contract.Missed_endorsements.init - ctxt - contract - {remaining_slots; missed_levels = 1})) - -let record_baking_activity_and_pay_rewards_and_fees ctxt ~payload_producer - ~block_producer ~baking_reward ~reward_bonus = - set_active ctxt payload_producer >>=? fun ctxt -> - (if not (Signature.Public_key_hash.equal payload_producer block_producer) then - set_active ctxt block_producer - else return ctxt) - >>=? fun ctxt -> - let pay_payload_producer ctxt delegate = - let contract = Contract_repr.Implicit delegate in - Token.balance ctxt `Block_fees >>=? fun (ctxt, block_fees) -> - Token.transfer_n - ctxt - [(`Block_fees, block_fees); (`Baking_rewards, baking_reward)] - (`Contract contract) - in - let pay_block_producer ctxt delegate bonus = - let contract = Contract_repr.Implicit delegate in - Token.transfer ctxt `Baking_bonuses (`Contract contract) bonus - in - pay_payload_producer ctxt payload_producer - >>=? fun (ctxt, balance_updates_payload_producer) -> - (match reward_bonus with - | Some bonus -> pay_block_producer ctxt block_producer bonus - | None -> return (ctxt, [])) - >>=? fun (ctxt, balance_updates_block_producer) -> - return - (ctxt, balance_updates_payload_producer @ balance_updates_block_producer) - -type participation_info = { - expected_cycle_activity : int; - minimal_cycle_activity : int; - missed_slots : int; - missed_levels : int; - remaining_allowed_missed_slots : int; - expected_endorsing_rewards : Tez_repr.t; -} - -(* Inefficient, only for RPC *) -let delegate_participation_info ctxt delegate = - let level = Level_storage.current ctxt in - Stake_storage.get_selected_distribution ctxt level.cycle - >>=? fun stake_distribution -> - match - List.assoc_opt - ~equal:Signature.Public_key_hash.equal - delegate - stake_distribution - with - | None -> - (* delegate does not have an active stake at the current cycle *) - return - { - expected_cycle_activity = 0; - minimal_cycle_activity = 0; - missed_slots = 0; - missed_levels = 0; - remaining_allowed_missed_slots = 0; - expected_endorsing_rewards = Tez_repr.zero; - } - | Some active_stake -> - Stake_storage.get_total_active_stake ctxt level.cycle - >>=? fun total_active_stake -> - expected_slots_for_given_active_stake - ctxt - ~total_active_stake - ~active_stake - >>?= fun expected_cycle_activity -> - let Ratio_repr.{numerator; denominator} = - Constants_storage.minimal_participation_ratio ctxt - in - let endorsing_reward_per_slot = - Constants_storage.endorsing_reward_per_slot ctxt - in - let minimal_cycle_activity = - expected_cycle_activity * numerator / denominator - in - let maximal_cycle_inactivity = - expected_cycle_activity - minimal_cycle_activity - in - let expected_endorsing_rewards = - Tez_repr.mul_exn endorsing_reward_per_slot expected_cycle_activity - in - let contract = Contract_repr.Implicit delegate in - Storage.Contract.Missed_endorsements.find ctxt contract - >>=? fun missed_endorsements -> - let missed_slots, missed_levels, remaining_allowed_missed_slots = - match missed_endorsements with - | None -> (0, 0, maximal_cycle_inactivity) - | Some {remaining_slots; missed_levels} -> - ( maximal_cycle_inactivity - remaining_slots, - missed_levels, - Compare.Int.max 0 remaining_slots ) - in - let expected_endorsing_rewards = - match missed_endorsements with - | Some r when Compare.Int.(r.remaining_slots < 0) -> Tez_repr.zero - | _ -> expected_endorsing_rewards - in - return - { - expected_cycle_activity; - minimal_cycle_activity; - missed_slots; - missed_levels; - remaining_allowed_missed_slots; - expected_endorsing_rewards; - } - -let init_first_cycles ctxt = - let preserved = Constants_storage.preserved_cycles ctxt in - List.fold_left_es - (fun ctxt c -> - let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in - Stake_storage.snapshot ctxt >>=? fun ctxt -> - (* NB: we need to take several snapshots because - select_distribution_for_cycle deletes the snapshots *) - select_distribution_for_cycle ctxt cycle) - ctxt - Misc.(0 --> preserved) diff --git a/src/proto_alpha/lib_protocol/delegate_storage.mli b/src/proto_alpha/lib_protocol/delegate_storage.mli index cba3a98d9746..ce6f830baf59 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/delegate_storage.mli @@ -3,6 +3,7 @@ (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) (* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2022 G.B. Fefe, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -24,41 +25,6 @@ (* *) (*****************************************************************************) -(** Allow to register a delegate when creating an account. *) -val init : - Raw_context.t -> - Contract_repr.t -> - Signature.Public_key_hash.t -> - Raw_context.t tzresult Lwt.t - -val pubkey : - Raw_context.t -> - Signature.Public_key_hash.t -> - Signature.Public_key.t tzresult Lwt.t - -(** Updating the delegate of a contract. - - When calling this function on an "implicit contract" and setting - the delegate to the contract manager registers it as a delegate. One - cannot unregister a delegate for now. The associate contract is now - 'undeletable'. *) -val set : - Raw_context.t -> - Contract_repr.t -> - Signature.Public_key_hash.t option -> - Raw_context.t tzresult Lwt.t - -val frozen_deposits_limit : - Raw_context.t -> - Signature.Public_key_hash.t -> - Tez_repr.t option tzresult Lwt.t - -val set_frozen_deposits_limit : - Raw_context.t -> - Signature.Public_key_hash.t -> - Tez_repr.t option -> - Raw_context.t Lwt.t - type error += | (* `Permanent *) No_deletion of Signature.Public_key_hash.t | (* `Temporary *) Active_delegate @@ -77,39 +43,6 @@ type error += val check_delegate : Raw_context.t -> Signature.Public_key_hash.t -> unit tzresult Lwt.t -(** Participation information. We denote by: - - "static" information that does not change during the cycle - - "dynamic" information that may change during the cycle *) -type participation_info = { - expected_cycle_activity : int; - (** The total expected slots to be endorsed in the cycle. (static) *) - minimal_cycle_activity : int; - (** The minimal endorsing slots in the cycle to get endorsing - rewards. (static) *) - missed_slots : int; - (** The number of missed endorsing slots in the cycle. (dynamic) *) - missed_levels : int; - (** The number of missed endorsing levels in the cycle. (dynamic) *) - remaining_allowed_missed_slots : int; - (** Remaining amount of endorsing slots that can be missed in the - cycle before forfeiting the rewards. (dynamic) *) - expected_endorsing_rewards : Tez_repr.t; - (** Endorsing rewards that will be distributed at the end of the - cycle if activity at that point will be greater than the minimal - required. If the activity is already known to be below the - required minimum, then the rewards are zero. (dynamic) *) -} - -(** Only use this function for RPC: this is expensive. - - [delegate_participation_info] and [!val:check_delegate] forms the - implementation of RPC call "/context/delegates//participation". - *) -val delegate_participation_info : - Raw_context.t -> - Signature.Public_key_hash.t -> - participation_info tzresult Lwt.t - (** Iterate on all registered delegates. *) val fold : Raw_context.t -> @@ -121,85 +54,35 @@ val fold : (** List all registered delegates. *) val list : Raw_context.t -> Signature.Public_key_hash.t list Lwt.t -val balance : - Raw_context.t -> Signature.public_key_hash -> Tez_repr.tez tzresult Lwt.t - -type level_participation = Participated | Didn't_participate - -(** Record the participation of a delegate as a validator. *) -val record_endorsing_participation : - Raw_context.t -> - delegate:Signature.Public_key_hash.t -> - participation:level_participation -> - endorsing_power:int -> - Raw_context.t tzresult Lwt.t - -(** Sets the payload and block producer as active. Pays the baking - reward and the fees to the payload producer and the reward bonus to - the payload producer (if the reward_bonus is not None).*) -val record_baking_activity_and_pay_rewards_and_fees : - Raw_context.t -> - payload_producer:Signature.Public_key_hash.t -> - block_producer:Signature.Public_key_hash.t -> - baking_reward:Tez_repr.t -> - reward_bonus:Tez_repr.t option -> - (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t - -(** Trigger the context maintenance at the end of cycle 'n', i.e.: - unfreeze the endorsing rewards, potentially deactivate delegates. - Return the corresponding balances updates and the list of - deactivated delegates. *) -val cycle_end : - Raw_context.t -> - Cycle_repr.t -> - Storage.Seed.unrevealed_nonce list -> - (Raw_context.t - * Receipt_repr.balance_updates - * Signature.Public_key_hash.t list) - tzresult - Lwt.t - -(** Returns true if the given delegate has already been slashed - for double baking for the given level. *) -val already_slashed_for_double_baking : - Raw_context.t -> - Signature.Public_key_hash.t -> - Level_repr.t -> - bool tzresult Lwt.t - -(** Returns true if the given delegate has already been slashed - for double preendorsing or double endorsing for the given level. *) -val already_slashed_for_double_endorsing : - Raw_context.t -> - Signature.Public_key_hash.t -> - Level_repr.t -> - bool tzresult Lwt.t - -(** Burn some frozen deposit for a delegate at a given level. Returns - the burned amount. *) -val punish_double_endorsing : +val frozen_deposits_limit : Raw_context.t -> Signature.Public_key_hash.t -> - Level_repr.t -> - (Raw_context.t * Tez_repr.t * Receipt_repr.balance_updates) tzresult Lwt.t + Tez_repr.t option tzresult Lwt.t -val punish_double_baking : +val set_frozen_deposits_limit : Raw_context.t -> Signature.Public_key_hash.t -> - Level_repr.t -> - (Raw_context.t * Tez_repr.t * Receipt_repr.balance_updates) tzresult Lwt.t + Tez_repr.t option -> + Raw_context.t Lwt.t (** Returns a delegate's frozen deposits, both the current amount and the initial freezed amount. A delegate's frozen balance is only composed of frozen deposits; - rewards and fees are not frozen, but simply credited at the right - moment. *) + rewards and fees are not frozen, but simply credited at the right + moment. *) val frozen_deposits : Raw_context.t -> Signature.Public_key_hash.t -> Storage.deposits tzresult Lwt.t +val staking_balance : + Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t + +(** Only use this function for RPCs: this is expensive. *) +val delegated_balance : + Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t + (** Returns the full 'balance' of the implicit contract associated to a given key, i.e. the sum of the spendable balance (given by [balance] or [Contract_storage.get_balance]) and of the frozen balance. The frozen @@ -211,55 +94,27 @@ val frozen_deposits : val full_balance : Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t -val staking_balance : - Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t - -(** Only use this function for RPCs: this is expensive. *) -val delegated_balance : - Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t - -val deactivated : - Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t - -(** Participation slots potentially associated to accounts. The - accounts that didn't place a deposit will be excluded from this - list. This function should only be used to compute the deposits to - freeze or initialize the protocol while stitching. RPCs can use this - function to predict an approximation of long term future slot - allocations. It shouldn't be used in the baker. *) -val slot_owner : +(** Allow to register a delegate when creating an account. *) +val init : Raw_context.t -> - Level_repr.t -> - Slot_repr.t -> - (Raw_context.t * (Signature.Public_key.t * Signature.Public_key_hash.t)) - tzresult - Lwt.t + Contract_repr.t -> + Signature.Public_key_hash.t -> + Raw_context.t tzresult Lwt.t -val baking_rights_owner : +(** Allow to set the delegate of an account. *) +val set : Raw_context.t -> - Level_repr.t -> - round:Round_repr.round -> - (Raw_context.t - * Slot_repr.t - * (Signature.public_key * Signature.public_key_hash)) - tzresult - Lwt.t + Contract_repr.t -> + Signature.Public_key_hash.t option -> + Raw_context.t tzresult Lwt.t -val freeze_deposits_do_not_call_except_for_migration : +val pubkey : Raw_context.t -> - new_cycle:Cycle_repr.t -> - balance_updates:Receipt_repr.balance_updates -> - (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t + Signature.Public_key_hash.t -> + Signature.Public_key.t tzresult Lwt.t -(** [init_first_cycles ctxt] computes and records the distribution of the total - active stake among active delegates. This concerns the total active stake - involved in the calculation of baking rights for all cycles in the range - [0, preserved_cycles]. *) -val init_first_cycles : Raw_context.t -> Raw_context.t tzresult Lwt.t +val set_active : + Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t -(** [compute_snapshot_index ctxt cycle max_snapshot_index] Returns the index of - the selected snapshot for the [cycle] passed as argument, and for the max - index of snapshots taken so far, [max_snapshot_index] (see - [Stake_storage.max_snapshot_index]. *) -val compute_snapshot_index : - Raw_context.t -> Cycle_repr.t -> max_snapshot_index:int -> int tzresult Lwt.t +val set_inactive : + Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/dune b/src/proto_alpha/lib_protocol/dune index a14172d55b10..5af750185614 100644 --- a/src/proto_alpha/lib_protocol/dune +++ b/src/proto_alpha/lib_protocol/dune @@ -149,6 +149,10 @@ Contract_storage Token Delegate_storage + Delegate_missed_endorsements_storage + Delegate_slashed_deposits_storage + Delegate_sampler + Delegate_cycles Bootstrap_storage Vote_storage Fees_storage @@ -385,6 +389,11 @@ contract_storage.ml contract_storage.mli token.ml token.mli delegate_storage.ml delegate_storage.mli + delegate_missed_endorsements_storage.ml + delegate_missed_endorsements_storage.mli + delegate_slashed_deposits_storage.ml delegate_slashed_deposits_storage.mli + delegate_sampler.ml delegate_sampler.mli + delegate_cycles.ml delegate_cycles.mli bootstrap_storage.ml bootstrap_storage.mli vote_storage.ml vote_storage.mli fees_storage.ml fees_storage.mli @@ -609,6 +618,11 @@ contract_storage.ml contract_storage.mli token.ml token.mli delegate_storage.ml delegate_storage.mli + delegate_missed_endorsements_storage.ml + delegate_missed_endorsements_storage.mli + delegate_slashed_deposits_storage.ml delegate_slashed_deposits_storage.mli + delegate_sampler.ml delegate_sampler.mli + delegate_cycles.ml delegate_cycles.mli bootstrap_storage.ml bootstrap_storage.mli vote_storage.ml vote_storage.mli fees_storage.ml fees_storage.mli @@ -837,6 +851,11 @@ contract_storage.ml contract_storage.mli token.ml token.mli delegate_storage.ml delegate_storage.mli + delegate_missed_endorsements_storage.ml + delegate_missed_endorsements_storage.mli + delegate_slashed_deposits_storage.ml delegate_slashed_deposits_storage.mli + delegate_sampler.ml delegate_sampler.mli + delegate_cycles.ml delegate_cycles.mli bootstrap_storage.ml bootstrap_storage.mli vote_storage.ml vote_storage.mli fees_storage.ml fees_storage.mli diff --git a/src/proto_alpha/lib_protocol/init_storage.ml b/src/proto_alpha/lib_protocol/init_storage.ml index 258702c6e1f0..d5b1b058a73f 100644 --- a/src/proto_alpha/lib_protocol/init_storage.ml +++ b/src/proto_alpha/lib_protocol/init_storage.ml @@ -97,9 +97,9 @@ let prepare_first_block _chain_id ctxt ~typecheck ~level ~timestamp = param.bootstrap_accounts param.bootstrap_contracts >>=? fun (ctxt, bootstrap_balance_updates) -> - Delegate_storage.init_first_cycles ctxt >>=? fun ctxt -> + Delegate_cycles.init_first_cycles ctxt >>=? fun ctxt -> let cycle = (Raw_context.current_level ctxt).cycle in - Delegate_storage.freeze_deposits_do_not_call_except_for_migration + Delegate_cycles.freeze_deposits_do_not_call_except_for_migration ~new_cycle:cycle ~balance_updates:[] ctxt -- GitLab From 5264d81fb9aec05540b4072022f4fd55ac62ad68 Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Thu, 21 Apr 2022 10:38:31 +0200 Subject: [PATCH 02/23] Proto: move `set_active` into `Stake_storage` --- .../lib_protocol/delegate_cycles.ml | 2 +- .../delegate_missed_endorsements_storage.ml | 6 +++--- .../lib_protocol/delegate_storage.ml | 13 ++---------- .../lib_protocol/delegate_storage.mli | 6 ------ src/proto_alpha/lib_protocol/stake_storage.ml | 21 ++++++++++++------- .../lib_protocol/stake_storage.mli | 4 ++-- 6 files changed, 21 insertions(+), 31 deletions(-) diff --git a/src/proto_alpha/lib_protocol/delegate_cycles.ml b/src/proto_alpha/lib_protocol/delegate_cycles.ml index a866f2727f6d..7d5d6b0b11d3 100644 --- a/src/proto_alpha/lib_protocol/delegate_cycles.ml +++ b/src/proto_alpha/lib_protocol/delegate_cycles.ml @@ -41,7 +41,7 @@ let update_activity ctxt last_cycle = delegate >>=? fun cycle -> if Cycle_repr.(cycle <= last_cycle) then - Delegate_storage.set_inactive ctxt delegate >>=? fun ctxt -> + Stake_storage.set_inactive ctxt delegate >>= fun ctxt -> return (ctxt, delegate :: deactivated) else return (ctxt, deactivated)) >|=? fun (ctxt, deactivated) -> (ctxt, deactivated) diff --git a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml index b776c0eb8171..508d2852e8a3 100644 --- a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml @@ -51,7 +51,7 @@ type level_participation = Participated | Didn't_participate let record_endorsing_participation ctxt ~delegate ~participation ~endorsing_power = match participation with - | Participated -> Delegate_storage.set_active ctxt delegate + | Participated -> Stake_storage.set_active ctxt delegate | Didn't_participate -> ( let contract = Contract_repr.Implicit delegate in Storage.Contract.Missed_endorsements.find ctxt contract >>=? function @@ -97,9 +97,9 @@ let record_endorsing_participation ctxt ~delegate ~participation let record_baking_activity_and_pay_rewards_and_fees ctxt ~payload_producer ~block_producer ~baking_reward ~reward_bonus = - Delegate_storage.set_active ctxt payload_producer >>=? fun ctxt -> + Stake_storage.set_active ctxt payload_producer >>=? fun ctxt -> (if not (Signature.Public_key_hash.equal payload_producer block_producer) then - Delegate_storage.set_active ctxt block_producer + Stake_storage.set_active ctxt block_producer else return ctxt) >>=? fun ctxt -> let pay_payload_producer ctxt delegate = diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml index 8d10d9fad5c4..8935aed71ec7 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_storage.ml @@ -202,16 +202,6 @@ let set_frozen_deposits_limit ctxt delegate limit = let frozen_deposits ctxt delegate = Frozen_deposits_storage.get ctxt (Contract_repr.Implicit delegate) -let set_inactive ctxt delegate = - Delegate_activation_storage.set_inactive ctxt delegate >>= fun ctxt -> - Stake_storage.deactivate_only_call_from_delegate_storage ctxt delegate >|= ok - -let set_active ctxt delegate = - Delegate_activation_storage.set_active ctxt delegate - >>=? fun (ctxt, inactive) -> - if not inactive then return ctxt - else Stake_storage.activate_only_call_from_delegate_storage ctxt delegate - let balance ctxt delegate = let contract = Contract_repr.Implicit delegate in Storage.Contract.Spendable_balance.get ctxt contract @@ -313,5 +303,6 @@ let set c contract delegate = Stake_storage.add_stake c delegate balance_and_frozen_bonds >>=? fun c -> if self_delegation then - Storage.Delegates.add c delegate >>= fun c -> set_active c delegate + Storage.Delegates.add c delegate >>= fun c -> + Stake_storage.set_active c delegate else return c diff --git a/src/proto_alpha/lib_protocol/delegate_storage.mli b/src/proto_alpha/lib_protocol/delegate_storage.mli index ce6f830baf59..089cb829199d 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/delegate_storage.mli @@ -112,9 +112,3 @@ val pubkey : Raw_context.t -> Signature.Public_key_hash.t -> Signature.Public_key.t tzresult Lwt.t - -val set_active : - Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t - -val set_inactive : - Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/stake_storage.ml b/src/proto_alpha/lib_protocol/stake_storage.ml index 9c34808d628e..c668430b87bd 100644 --- a/src/proto_alpha/lib_protocol/stake_storage.ml +++ b/src/proto_alpha/lib_protocol/stake_storage.ml @@ -107,16 +107,21 @@ let add_stake ctxt delegate amount = roll now). *) return ctxt -let deactivate_only_call_from_delegate_storage ctxt delegate = +let set_inactive ctxt delegate = + Delegate_activation_storage.set_inactive ctxt delegate >>= fun ctxt -> Storage.Stake.Active_delegate_with_one_roll.remove ctxt delegate -let activate_only_call_from_delegate_storage ctxt delegate = - get_initialized_stake ctxt delegate >>=? fun (staking_balance, ctxt) -> - let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in - if Tez_repr.(staking_balance >= tokens_per_roll) then - Storage.Stake.Active_delegate_with_one_roll.add ctxt delegate () - >>= fun ctxt -> return ctxt - else return ctxt +let set_active ctxt delegate = + Delegate_activation_storage.set_active ctxt delegate + >>=? fun (ctxt, inactive) -> + if not inactive then return ctxt + else + get_initialized_stake ctxt delegate >>=? fun (staking_balance, ctxt) -> + let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in + if Tez_repr.(staking_balance >= tokens_per_roll) then + Storage.Stake.Active_delegate_with_one_roll.add ctxt delegate () + >>= fun ctxt -> return ctxt + else return ctxt let snapshot ctxt = Storage.Stake.Last_snapshot.get ctxt >>=? fun index -> diff --git a/src/proto_alpha/lib_protocol/stake_storage.mli b/src/proto_alpha/lib_protocol/stake_storage.mli index 894f683cd579..e41693973461 100644 --- a/src/proto_alpha/lib_protocol/stake_storage.mli +++ b/src/proto_alpha/lib_protocol/stake_storage.mli @@ -38,10 +38,10 @@ val add_stake : Tez_repr.t -> Raw_context.t tzresult Lwt.t -val deactivate_only_call_from_delegate_storage : +val set_inactive : Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t Lwt.t -val activate_only_call_from_delegate_storage : +val set_active : Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t val get_staking_balance : -- GitLab From c6e335be5d334143b7636820310cd01d489345d0 Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Thu, 21 Apr 2022 11:55:00 +0200 Subject: [PATCH 03/23] Proto: Rename `Delegate.check_delegate` into `Delegate.check` --- .../lib_protocol/alpha_context.mli | 2 +- .../lib_protocol/delegate_services.ml | 26 +++++++++---------- .../lib_protocol/delegate_storage.ml | 2 +- .../lib_protocol/delegate_storage.mli | 2 +- 4 files changed, 16 insertions(+), 16 deletions(-) diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 2a28fc573eef..96f446b2b968 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -2429,7 +2429,7 @@ module Delegate : sig val list : context -> public_key_hash list Lwt.t - val check_delegate : context -> public_key_hash -> unit tzresult Lwt.t + val check_registered : context -> public_key_hash -> unit tzresult Lwt.t type participation_info = { expected_cycle_activity : int; diff --git a/src/proto_alpha/lib_protocol/delegate_services.ml b/src/proto_alpha/lib_protocol/delegate_services.ml index 6a07486f0c1a..b0c8da4709a4 100644 --- a/src/proto_alpha/lib_protocol/delegate_services.ml +++ b/src/proto_alpha/lib_protocol/delegate_services.ml @@ -366,7 +366,7 @@ let register () = | {with_minimal_stake = false; without_minimal_stake = false; _} -> return delegates) ; register1 ~chunked:false S.info (fun ctxt pkh () () -> - Delegate.check_delegate ctxt pkh >>=? fun () -> + Delegate.check_registered ctxt pkh >>=? fun () -> Delegate.full_balance ctxt pkh >>=? fun full_balance -> Delegate.frozen_deposits ctxt pkh >>=? fun frozen_deposits -> Delegate.staking_balance ctxt pkh >>=? fun staking_balance -> @@ -389,42 +389,42 @@ let register () = voting_info; }) ; register1 ~chunked:false S.full_balance (fun ctxt pkh () () -> - trace (Balance_rpc_non_delegate pkh) (Delegate.check_delegate ctxt pkh) + trace (Balance_rpc_non_delegate pkh) (Delegate.check_registered ctxt pkh) >>=? fun () -> Delegate.full_balance ctxt pkh) ; register1 ~chunked:false S.current_frozen_deposits (fun ctxt pkh () () -> - Delegate.check_delegate ctxt pkh >>=? fun () -> + Delegate.check_registered ctxt pkh >>=? fun () -> Delegate.frozen_deposits ctxt pkh >>=? fun deposits -> return deposits.current_amount) ; register1 ~chunked:false S.frozen_deposits (fun ctxt pkh () () -> - Delegate.check_delegate ctxt pkh >>=? fun () -> + Delegate.check_registered ctxt pkh >>=? fun () -> Delegate.frozen_deposits ctxt pkh >>=? fun deposits -> return deposits.initial_amount) ; register1 ~chunked:false S.staking_balance (fun ctxt pkh () () -> - Delegate.check_delegate ctxt pkh >>=? fun () -> + Delegate.check_registered ctxt pkh >>=? fun () -> Delegate.staking_balance ctxt pkh) ; register1 ~chunked:false S.frozen_deposits_limit (fun ctxt pkh () () -> - Delegate.check_delegate ctxt pkh >>=? fun () -> + Delegate.check_registered ctxt pkh >>=? fun () -> Delegate.frozen_deposits_limit ctxt pkh) ; register1 ~chunked:true S.delegated_contracts (fun ctxt pkh () () -> - Delegate.check_delegate ctxt pkh >>=? fun () -> + Delegate.check_registered ctxt pkh >>=? fun () -> Delegate.delegated_contracts ctxt pkh >|= ok) ; register1 ~chunked:false S.delegated_balance (fun ctxt pkh () () -> - Delegate.check_delegate ctxt pkh >>=? fun () -> + Delegate.check_registered ctxt pkh >>=? fun () -> Delegate.delegated_balance ctxt pkh) ; register1 ~chunked:false S.deactivated (fun ctxt pkh () () -> - Delegate.check_delegate ctxt pkh >>=? fun () -> + Delegate.check_registered ctxt pkh >>=? fun () -> Delegate.deactivated ctxt pkh) ; register1 ~chunked:false S.grace_period (fun ctxt pkh () () -> - Delegate.check_delegate ctxt pkh >>=? fun () -> + Delegate.check_registered ctxt pkh >>=? fun () -> Delegate.last_cycle_before_deactivation ctxt pkh) ; register1 ~chunked:false S.voting_power (fun ctxt pkh () () -> - Delegate.check_delegate ctxt pkh >>=? fun () -> + Delegate.check_registered ctxt pkh >>=? fun () -> Vote.get_voting_power_free ctxt pkh) ; register1 ~chunked:false S.voting_info (fun ctxt pkh () () -> - Delegate.check_delegate ctxt pkh >>=? fun () -> + Delegate.check_registered ctxt pkh >>=? fun () -> Vote.get_delegate_info ctxt pkh) ; register1 ~chunked:false S.participation (fun ctxt pkh () () -> - Delegate.check_delegate ctxt pkh >>=? fun () -> + Delegate.check_registered ctxt pkh >>=? fun () -> Delegate.delegate_participation_info ctxt pkh) let list ctxt block ?(active = true) ?(inactive = false) diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml index 8935aed71ec7..39b2a8050110 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_storage.ml @@ -173,7 +173,7 @@ let () = (* The fact that this succeeds iff [registered ctxt pkh] returns true is an invariant of the [set] function. *) -let check_delegate ctxt pkh = +let check_registered ctxt pkh = Storage.Delegates.mem ctxt pkh >>= function | true -> return_unit | false -> fail (Not_registered pkh) diff --git a/src/proto_alpha/lib_protocol/delegate_storage.mli b/src/proto_alpha/lib_protocol/delegate_storage.mli index 089cb829199d..05cda508fdfd 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/delegate_storage.mli @@ -40,7 +40,7 @@ type error += | (* `Temporary *) Not_registered of Signature.Public_key_hash.t (** Check that a given implicit account is a registered delegate. *) -val check_delegate : +val check_registered : Raw_context.t -> Signature.Public_key_hash.t -> unit tzresult Lwt.t (** Iterate on all registered delegates. *) -- GitLab From 57f59fd449ab230a05b6f9f11def35e31aae7c20 Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Mon, 25 Apr 2022 16:32:16 +0200 Subject: [PATCH 04/23] Proto: simplify `Delegate.registered` --- src/proto_alpha/lib_protocol/alpha_context.ml | 2 -- src/proto_alpha/lib_protocol/alpha_context.mli | 2 +- src/proto_alpha/lib_protocol/apply.ml | 2 +- .../lib_protocol/contract_delegate_storage.ml | 8 -------- .../lib_protocol/contract_delegate_storage.mli | 5 ----- .../lib_protocol/delegate_storage.ml | 17 ++++++++--------- .../lib_protocol/delegate_storage.mli | 3 +++ 7 files changed, 13 insertions(+), 26 deletions(-) diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index 7153b6d0d5e4..64e67ad921d6 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -470,8 +470,6 @@ module Delegate = struct let prepare_stake_distribution = Stake_storage.prepare_stake_distribution - let registered = Contract_delegate_storage.registered - let find = Contract_delegate_storage.find let delegated_contracts = Contract_delegate_storage.delegated_contracts diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 96f446b2b968..a824a187763f 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -2501,7 +2501,7 @@ module Delegate : sig context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t (** See {!Contract_delegate_storage.registered}. *) - val registered : context -> Signature.Public_key_hash.t -> bool tzresult Lwt.t + val registered : context -> Signature.Public_key_hash.t -> bool Lwt.t val deactivated : context -> Signature.Public_key_hash.t -> bool tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 79861cba813f..54fc0f7401d7 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1542,7 +1542,7 @@ let apply_external_manager_operation_content : Tez.(limit > max_limit) (Set_deposits_limit_too_high {limit; max_limit})) >>?= fun () -> - Delegate.registered ctxt source >>=? fun is_registered -> + Delegate.registered ctxt source >>= fun is_registered -> error_unless is_registered (Set_deposits_limit_on_unregistered_delegate source) diff --git a/src/proto_alpha/lib_protocol/contract_delegate_storage.ml b/src/proto_alpha/lib_protocol/contract_delegate_storage.ml index 8dbb1063250d..75efd48243da 100644 --- a/src/proto_alpha/lib_protocol/contract_delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/contract_delegate_storage.ml @@ -25,14 +25,6 @@ let find = Storage.Contract.Delegate.find -(* A delegate is registered if its "implicit account" delegates to itself. *) -let registered c delegate = - Storage.Contract.Delegate.find c (Contract_repr.Implicit delegate) - >|=? function - | Some current_delegate -> - Signature.Public_key_hash.equal delegate current_delegate - | None -> false - let init ctxt contract delegate = Storage.Contract.Delegate.init ctxt contract delegate >>=? fun ctxt -> let delegate_contract = Contract_repr.Implicit delegate in diff --git a/src/proto_alpha/lib_protocol/contract_delegate_storage.mli b/src/proto_alpha/lib_protocol/contract_delegate_storage.mli index 45a05ca408ca..2f9b8e201c4f 100644 --- a/src/proto_alpha/lib_protocol/contract_delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/contract_delegate_storage.mli @@ -30,11 +30,6 @@ val find : Contract_repr.t -> Signature.Public_key_hash.t option tzresult Lwt.t -(** [registered ctxt delegate] returns true iff delegate is an implicit contract - that delegates to itself. *) -val registered : - Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t - (** [init ctxt contract delegate] sets the [delegate] associated to [contract]. This function is undefined if [contract] is not allocated, or if [contract] diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml index 39b2a8050110..7d5719d1415d 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_storage.ml @@ -171,10 +171,10 @@ let () = (function Not_registered pkh -> Some pkh | _ -> None) (fun pkh -> Not_registered pkh) -(* The fact that this succeeds iff [registered ctxt pkh] returns true is an - invariant of the [set] function. *) +let registered = Storage.Delegates.mem + let check_registered ctxt pkh = - Storage.Delegates.mem ctxt pkh >>= function + registered ctxt pkh >>= function | true -> return_unit | false -> fail (Not_registered pkh) @@ -207,7 +207,7 @@ let balance ctxt delegate = Storage.Contract.Spendable_balance.get ctxt contract let staking_balance ctxt delegate = - Contract_delegate_storage.registered ctxt delegate >>=? fun is_registered -> + registered ctxt delegate >>= fun is_registered -> if is_registered then Stake_storage.get_staking_balance ctxt delegate else return Tez_repr.zero @@ -231,7 +231,7 @@ let init ctxt contract delegate = Contract_manager_storage.is_manager_key_revealed ctxt delegate >>=? fun known_delegate -> error_unless known_delegate (Unregistered_delegate delegate) >>?= fun () -> - Contract_delegate_storage.registered ctxt delegate >>=? fun is_registered -> + registered ctxt delegate >>= fun is_registered -> error_unless is_registered (Unregistered_delegate delegate) >>?= fun () -> Contract_delegate_storage.init ctxt contract delegate >>=? fun ctxt -> Contract_storage.get_balance_and_frozen_bonds ctxt contract @@ -244,7 +244,7 @@ let set c contract delegate = (* check if contract is a registered delegate *) (match contract with | Contract_repr.Implicit pkh -> - Contract_delegate_storage.registered c pkh >>=? fun is_registered -> + registered c pkh >>= fun is_registered -> fail_when is_registered (No_deletion pkh) | Originated _ -> return_unit) >>=? fun () -> @@ -259,8 +259,7 @@ let set c contract delegate = | Some delegate -> Contract_manager_storage.is_manager_key_revealed c delegate >>=? fun known_delegate -> - Contract_delegate_storage.registered c delegate - >>=? fun registered_delegate -> + registered c delegate >>= fun registered_delegate -> let self_delegation = match contract with | Implicit pkh -> Signature.Public_key_hash.equal pkh delegate @@ -283,7 +282,7 @@ let set c contract delegate = (* check if contract is a registered delegate *) (match contract with | Contract_repr.Implicit pkh -> - Contract_delegate_storage.registered c pkh >>=? fun is_registered -> + registered c pkh >>= fun is_registered -> (* allow self-delegation to re-activate *) if (not self_delegation) && is_registered then fail (No_deletion pkh) diff --git a/src/proto_alpha/lib_protocol/delegate_storage.mli b/src/proto_alpha/lib_protocol/delegate_storage.mli index 05cda508fdfd..afa43e5df789 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/delegate_storage.mli @@ -39,6 +39,9 @@ type error += } | (* `Temporary *) Not_registered of Signature.Public_key_hash.t +(** Has a delegate been registered in the delegate table? *) +val registered : Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t + (** Check that a given implicit account is a registered delegate. *) val check_registered : Raw_context.t -> Signature.Public_key_hash.t -> unit tzresult Lwt.t -- GitLab From ee405120353bb6db68e3dd7a8f48de1ac94111e6 Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Thu, 14 Apr 2022 23:37:43 +0200 Subject: [PATCH 05/23] Proto: remove `freeze_deposits_do_not_call_except_for_migration` --- src/proto_alpha/lib_protocol/delegate_cycles.ml | 8 ++++---- src/proto_alpha/lib_protocol/delegate_cycles.mli | 16 +++++++--------- src/proto_alpha/lib_protocol/init_storage.ml | 7 +------ 3 files changed, 12 insertions(+), 19 deletions(-) diff --git a/src/proto_alpha/lib_protocol/delegate_cycles.ml b/src/proto_alpha/lib_protocol/delegate_cycles.ml index 7d5d6b0b11d3..57cf944e033a 100644 --- a/src/proto_alpha/lib_protocol/delegate_cycles.ml +++ b/src/proto_alpha/lib_protocol/delegate_cycles.ml @@ -189,9 +189,6 @@ let freeze_deposits ?(origin = Receipt_repr.Block_application) ctxt ~new_cycle delegates_to_remove (ctxt, balance_updates) -let freeze_deposits_do_not_call_except_for_migration = - freeze_deposits ~origin:Protocol_migration - let cycle_end ctxt last_cycle unrevealed_nonces = let new_cycle = Cycle_repr.add last_cycle 1 in Delegate_sampler.select_new_distribution_at_cycle_end ctxt ~new_cycle @@ -212,7 +209,7 @@ let cycle_end ctxt last_cycle unrevealed_nonces = update_activity ctxt last_cycle >>=? fun (ctxt, deactivated_delagates) -> return (ctxt, balance_updates, deactivated_delagates) -let init_first_cycles ctxt = +let init_first_cycles ctxt ~origin = let preserved = Constants_storage.preserved_cycles ctxt in List.fold_left_es (fun ctxt c -> @@ -223,3 +220,6 @@ let init_first_cycles ctxt = Delegate_sampler.select_distribution_for_cycle ctxt cycle) ctxt Misc.(0 --> preserved) + >>=? fun ctxt -> + let cycle = (Raw_context.current_level ctxt).cycle in + freeze_deposits ~origin ~new_cycle:cycle ~balance_updates:[] ctxt diff --git a/src/proto_alpha/lib_protocol/delegate_cycles.mli b/src/proto_alpha/lib_protocol/delegate_cycles.mli index f45fd05bed59..0814d32d45b8 100644 --- a/src/proto_alpha/lib_protocol/delegate_cycles.mli +++ b/src/proto_alpha/lib_protocol/delegate_cycles.mli @@ -39,14 +39,12 @@ val cycle_end : tzresult Lwt.t -(** [init_first_cycles ctxt] computes and records the distribution of the total - active stake among active delegates. This concerns the total active stake - involved in the calculation of baking rights for all cycles in the range - [0, preserved_cycles]. *) -val init_first_cycles : Raw_context.t -> Raw_context.t tzresult Lwt.t - -val freeze_deposits_do_not_call_except_for_migration : +(** [init_first_cycles ctxt ~origin] computes and records the distribution of + the total active stake among active delegates. This concerns the total + active stake involved in the calculation of baking rights for all cycles + in the range [0, preserved_cycles]. It also freezes the deposits for all + the active delegates. *) +val init_first_cycles : Raw_context.t -> - new_cycle:Cycle_repr.t -> - balance_updates:Receipt_repr.balance_updates -> + origin:Receipt_repr.update_origin -> (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/init_storage.ml b/src/proto_alpha/lib_protocol/init_storage.ml index d5b1b058a73f..e5195fe38233 100644 --- a/src/proto_alpha/lib_protocol/init_storage.ml +++ b/src/proto_alpha/lib_protocol/init_storage.ml @@ -97,12 +97,7 @@ let prepare_first_block _chain_id ctxt ~typecheck ~level ~timestamp = param.bootstrap_accounts param.bootstrap_contracts >>=? fun (ctxt, bootstrap_balance_updates) -> - Delegate_cycles.init_first_cycles ctxt >>=? fun ctxt -> - let cycle = (Raw_context.current_level ctxt).cycle in - Delegate_cycles.freeze_deposits_do_not_call_except_for_migration - ~new_cycle:cycle - ~balance_updates:[] - ctxt + Delegate_cycles.init_first_cycles ctxt ~origin:Protocol_migration >>=? fun (ctxt, deposits_balance_updates) -> Vote_storage.init ctxt -- GitLab From 4b182f91e0b27b72eccaf638e632269198ee1af8 Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Sat, 7 May 2022 13:41:44 +0200 Subject: [PATCH 06/23] Proto: introduce `Alpha_context.Contract.Delegate` --- src/proto_alpha/lib_protocol/alpha_context.ml | 10 +++++-- .../lib_protocol/alpha_context.mli | 26 ++++++++++--------- src/proto_alpha/lib_protocol/apply.ml | 4 +-- .../lib_protocol/contract_services.ml | 4 +-- .../test/integration/test_frozen_bonds.ml | 17 ++++++------ .../test/integration/test_token.ml | 6 ++--- 6 files changed, 38 insertions(+), 29 deletions(-) diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index 64e67ad921d6..a3d88427151a 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -294,6 +294,14 @@ module Contract = struct let get_manager_key = Contract_manager_storage.get_manager_key + module Delegate = struct + let find = Contract_delegate_storage.find + + let init = Delegate_storage.init + + let set = Delegate_storage.set + end + module Internal_for_tests = struct include Contract_repr include Contract_storage @@ -470,8 +478,6 @@ module Delegate = struct let prepare_stake_distribution = Stake_storage.prepare_stake_distribution - let find = Contract_delegate_storage.find - let delegated_contracts = Contract_delegate_storage.delegated_contracts end diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index a824a187763f..2e9baae921eb 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -1749,6 +1749,20 @@ module Contract : sig script:Script.t * Lazy_storage.diffs option -> context tzresult Lwt.t + module Delegate : sig + (** See {!Contract_delegate_storage.find}. *) + val find : context -> t -> Signature.Public_key_hash.t option tzresult Lwt.t + + val init : + context -> t -> Signature.Public_key_hash.t -> context tzresult Lwt.t + + val set : + context -> + t -> + Signature.Public_key_hash.t option -> + context tzresult Lwt.t + end + (** This module discloses definitions that are only useful for tests and must not be used otherwise. *) module Internal_for_tests : sig @@ -2402,18 +2416,6 @@ end (** This module re-exports definitions from {!Delegate_storage}. *) module Delegate : sig - val init : - context -> - Contract.t -> - Signature.Public_key_hash.t -> - context tzresult Lwt.t - - (** See {!Contract_delegate_storage.find}. *) - val find : context -> Contract.t -> public_key_hash option tzresult Lwt.t - - val set : - context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t - val frozen_deposits_limit : context -> Signature.Public_key_hash.t -> Tez.t option tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 54fc0f7401d7..6addb5c0d7f1 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -777,7 +777,7 @@ let update_script_storage_and_ticket_balances ctxt ~self storage Ticket_accounting.update_ticket_balances ctxt ~self ~ticket_diffs operations let apply_delegation ~ctxt ~source ~delegate ~before_operation = - Delegate.set ctxt source delegate >|=? fun ctxt -> + Contract.Delegate.set ctxt source delegate >|=? fun ctxt -> (ctxt, Gas.consumed ~since:before_operation ~until:ctxt, []) type execution_arg = @@ -1046,7 +1046,7 @@ let apply_origination ~ctxt ~storage_type ~storage ~unparsed_code let contract = Contract.Originated contract_hash in (match delegate with | None -> return ctxt - | Some delegate -> Delegate.init ctxt contract delegate) + | Some delegate -> Contract.Delegate.init ctxt contract delegate) >>=? fun ctxt -> Token.transfer ctxt (`Contract source) (`Contract contract) credit >>=? fun (ctxt, balance_updates) -> diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml index 1d18c7117acf..d95dd6b5d6eb 100644 --- a/src/proto_alpha/lib_protocol/contract_services.ml +++ b/src/proto_alpha/lib_protocol/contract_services.ml @@ -398,7 +398,7 @@ let[@coq_axiom_with_reason "gadt"] register () = | false -> return_some None | true -> Contract.get_manager_key ctxt mgr >|=? fun key -> Some (Some key))) ; - register_opt_field ~chunked:false S.delegate Delegate.find ; + register_opt_field ~chunked:false S.delegate Contract.Delegate.find ; opt_register1 ~chunked:false S.counter (fun ctxt contract () () -> match contract with | Originated _ -> return_none @@ -544,7 +544,7 @@ let[@coq_axiom_with_reason "gadt"] register () = S.info (fun ctxt contract {normalize_types} -> Contract.get_balance ctxt contract >>=? fun balance -> - Delegate.find ctxt contract >>=? fun delegate -> + Contract.Delegate.find ctxt contract >>=? fun delegate -> match contract with | Implicit manager -> Contract.get_counter ctxt manager >|=? fun counter -> diff --git a/src/proto_alpha/lib_protocol/test/integration/test_frozen_bonds.ml b/src/proto_alpha/lib_protocol/test/integration/test_frozen_bonds.ml index 27f5394c700a..2237adcb1407 100644 --- a/src/proto_alpha/lib_protocol/test/integration/test_frozen_bonds.ml +++ b/src/proto_alpha/lib_protocol/test/integration/test_frozen_bonds.ml @@ -93,7 +93,7 @@ let init_test ~user_is_delegate = (* Configure delegate, as a delegate by self-delegation, for which revealing its manager key is a prerequisite. *) Contract.reveal_manager_key ctxt delegate delegate_pk >>>=? fun ctxt -> - Delegate.set ctxt delegate_contract (Some delegate) >>>=? fun ctxt -> + Contract.Delegate.set ctxt delegate_contract (Some delegate) >>>=? fun ctxt -> return (ctxt, user_contract, user_account, delegate) (** Tested scenario : @@ -111,7 +111,7 @@ let test_delegate_then_freeze_deposit () = (* Fetch user's initial balance before freeze. *) Token.balance ctxt user_account >>>=? fun (ctxt, user_balance) -> (* Let user delegate to "delegate". *) - Delegate.set ctxt user_contract (Some delegate) >>>=? fun ctxt -> + Contract.Delegate.set ctxt user_contract (Some delegate) >>>=? fun ctxt -> (* Fetch staking balance after delegation and before freeze. *) Delegate.staking_balance ctxt delegate >>>=? fun staking_balance -> (* Freeze a tx-rollup deposit. *) @@ -126,7 +126,7 @@ let test_delegate_then_freeze_deposit () = (* Ensure staking balance did not change. *) Assert.equal_tez ~loc:__LOC__ staking_balance' staking_balance >>=? fun () -> (* Remove delegation. *) - Delegate.set ctxt user_contract None >>>=? fun ctxt -> + Contract.Delegate.set ctxt user_contract None >>>=? fun ctxt -> (* Fetch staking balance after delegation removal. *) Delegate.staking_balance ctxt delegate >>>=? fun staking_balance'' -> (* Ensure staking balance decreased by user's initial balance. *) @@ -173,7 +173,7 @@ let test_freeze_deposit_then_delegate () = Now, fetch staking balance before delegation and after freeze. *) Delegate.staking_balance ctxt delegate >>>=? fun staking_balance -> (* Let user delegate to "delegate". *) - Delegate.set ctxt user_contract (Some delegate) >>>=? fun ctxt -> + Contract.Delegate.set ctxt user_contract (Some delegate) >>>=? fun ctxt -> (* Fetch staking balance after delegation. *) Delegate.staking_balance ctxt delegate >>>=? fun staking_balance' -> (* ensure staking balance increased by the user's balance. *) @@ -191,7 +191,7 @@ let test_freeze_deposit_then_delegate () = Assert.equal_tez ~loc:__LOC__ staking_balance'' staking_balance' >>=? fun () -> (* Remove delegation. *) - Delegate.set ctxt user_contract None >>>=? fun ctxt -> + Contract.Delegate.set ctxt user_contract None >>>=? fun ctxt -> (* Fetch staking balance. *) Delegate.staking_balance ctxt delegate >>>=? fun staking_balance''' -> (* Check that staking balance has decreased by the user's initial balance. *) @@ -329,7 +329,8 @@ let test_scenario scenario = (* Configure delegate, as a delegate by self-delegation, for which revealing its manager key is a prerequisite. *) Contract.reveal_manager_key ctxt delegate2 delegate_pk2 >>>=? fun ctxt -> - Delegate.set ctxt delegate_contract2 (Some delegate2) >>>=? fun ctxt -> + Contract.Delegate.set ctxt delegate_contract2 (Some delegate2) + >>>=? fun ctxt -> let tx_rollup1, nonce = mk_tx_rollup () in let tx_rollup2, _ = mk_tx_rollup ~nonce () in let bond_id1 = Bond_id.Tx_rollup_bond_id tx_rollup1 in @@ -344,7 +345,7 @@ let test_scenario scenario = Contract.get_balance_and_frozen_bonds ctxt user_contract >>>=? fun user_balance -> (* Let user delegate to "delegate". *) - Delegate.set ctxt user_contract (Some delegate) >>>=? fun ctxt -> + Contract.Delegate.set ctxt user_contract (Some delegate) >>>=? fun ctxt -> (* Fetch staking balance after delegation *) Delegate.staking_balance ctxt delegate >>>=? fun staking_balance' -> Assert.equal_tez @@ -418,7 +419,7 @@ let test_scenario scenario = (* Fetch user's initial balance before undelegate. *) Token.balance ctxt user_account >>>=? fun (_, user_balance) -> (* Remove delegation. *) - Delegate.set ctxt user_contract None >>>=? fun ctxt -> + Contract.Delegate.set ctxt user_contract None >>>=? fun ctxt -> (* Fetch staking balance after delegation removal. *) Delegate.staking_balance ctxt delegate >>>=? fun staking_balance' -> (* Ensure staking balance decreased by delegation amount *) diff --git a/src/proto_alpha/lib_protocol/test/integration/test_token.ml b/src/proto_alpha/lib_protocol/test/integration/test_token.ml index 4a05fb1a885e..1d3edd5f6c2f 100644 --- a/src/proto_alpha/lib_protocol/test/integration/test_token.ml +++ b/src/proto_alpha/lib_protocol/test/integration/test_token.ml @@ -516,13 +516,13 @@ let build_test_cases () = (* Configure baker1, and baker2 as delegates by self-delegation, for which revealing their manager key is a prerequisite. *) wrap (Contract.reveal_manager_key ctxt baker1 baker1_pk) >>=? fun ctxt -> - wrap (Delegate.set ctxt (Contract.Implicit baker1) (Some baker1)) + wrap (Contract.Delegate.set ctxt (Contract.Implicit baker1) (Some baker1)) >>=? fun ctxt -> wrap (Contract.reveal_manager_key ctxt baker2 baker2_pk) >>=? fun ctxt -> - wrap (Delegate.set ctxt (Contract.Implicit baker2) (Some baker2)) + wrap (Contract.Delegate.set ctxt (Contract.Implicit baker2) (Some baker2)) (* Let user1 delegate to baker2. *) >>=? fun ctxt -> - wrap (Delegate.set ctxt (Contract.Implicit user1) (Some baker2)) + wrap (Contract.Delegate.set ctxt (Contract.Implicit user1) (Some baker2)) >>=? fun ctxt -> let tx_rollup1 = mk_rollup () in let bond_id1 = Bond_id.Tx_rollup_bond_id tx_rollup1 in -- GitLab From 28d9b1e17cdaeb1b6ba997e5c48758e62985671b Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Mon, 25 Apr 2022 16:39:20 +0200 Subject: [PATCH 07/23] Proto: introduce `Delegate_table_storage.Contract` --- src/proto_alpha/lib_protocol/alpha_context.ml | 4 +- .../lib_protocol/alpha_context.mli | 14 +- .../lib_protocol/bootstrap_storage.ml | 4 +- .../contract_delegate_storage.mli | 8 +- .../lib_protocol/delegate_storage.ml | 147 +++++++++--------- .../lib_protocol/delegate_storage.mli | 39 +++-- 6 files changed, 113 insertions(+), 103 deletions(-) diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index a3d88427151a..76be0e03ee50 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -297,9 +297,7 @@ module Contract = struct module Delegate = struct let find = Contract_delegate_storage.find - let init = Delegate_storage.init - - let set = Delegate_storage.set + include Delegate_storage.Contract end module Internal_for_tests = struct diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 2e9baae921eb..9a0415f86411 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -1749,18 +1749,16 @@ module Contract : sig script:Script.t * Lazy_storage.diffs option -> context tzresult Lwt.t + (** Functions for handling the delegate of a contract.*) module Delegate : sig (** See {!Contract_delegate_storage.find}. *) - val find : context -> t -> Signature.Public_key_hash.t option tzresult Lwt.t + val init : context -> t -> public_key_hash -> context tzresult Lwt.t - val init : - context -> t -> Signature.Public_key_hash.t -> context tzresult Lwt.t + (** see {!Delegate_table_storage.set}. *) + val set : context -> t -> public_key_hash option -> context tzresult Lwt.t - val set : - context -> - t -> - Signature.Public_key_hash.t option -> - context tzresult Lwt.t + (** see {!Delegate_table_storage.find}. *) + val find : context -> t -> public_key_hash option tzresult Lwt.t end (** This module discloses definitions that are only useful for tests and must diff --git a/src/proto_alpha/lib_protocol/bootstrap_storage.ml b/src/proto_alpha/lib_protocol/bootstrap_storage.ml index b9abaec54989..592bdebbec46 100644 --- a/src/proto_alpha/lib_protocol/bootstrap_storage.ml +++ b/src/proto_alpha/lib_protocol/bootstrap_storage.ml @@ -59,7 +59,7 @@ let init_account (ctxt, balance_updates) public_key_hash public_key >>=? fun ctxt -> - Delegate_storage.set + Delegate_storage.Contract.set ctxt contract (Some (Option.value ~default:public_key_hash delegate_to)) @@ -84,7 +84,7 @@ let init_contract ~typecheck (ctxt, balance_updates) let contract = Contract_repr.Originated contract_hash in (match delegate with | None -> return ctxt - | Some delegate -> Delegate_storage.init ctxt contract delegate) + | Some delegate -> Delegate_storage.Contract.init ctxt contract delegate) >>=? fun ctxt -> let origin = Receipt_repr.Protocol_migration in Token.transfer ~origin ctxt `Bootstrap (`Contract contract) amount diff --git a/src/proto_alpha/lib_protocol/contract_delegate_storage.mli b/src/proto_alpha/lib_protocol/contract_delegate_storage.mli index 2f9b8e201c4f..1bdd5d5d1895 100644 --- a/src/proto_alpha/lib_protocol/contract_delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/contract_delegate_storage.mli @@ -32,8 +32,7 @@ val find : (** [init ctxt contract delegate] sets the [delegate] associated to [contract]. - This function is undefined if [contract] is not allocated, or if [contract] - has already a delegate. *) + This function is undefined if [contract] has already a delegate. *) val init : Raw_context.t -> Contract_repr.t -> @@ -55,10 +54,7 @@ val unlink : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t This function is undefined if [contract] is not allocated. *) val delete : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t -(** [set ctxt contract delegate] updates the [delegate] associated to [contract]. - - This function is undefined if [contract] is not allocated, or if [contract] - does not have a delegate. *) +(** [set ctxt contract delegate] updates the [delegate] associated to [contract]. *) val set : Raw_context.t -> Contract_repr.t -> diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml index 7d5719d1415d..4f9fda6a3b3b 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_storage.ml @@ -227,81 +227,86 @@ let full_balance ctxt delegate = Lwt.return Tez_repr.(frozen_deposits.current_amount +? balance_and_frozen_bonds) -let init ctxt contract delegate = - Contract_manager_storage.is_manager_key_revealed ctxt delegate - >>=? fun known_delegate -> - error_unless known_delegate (Unregistered_delegate delegate) >>?= fun () -> - registered ctxt delegate >>= fun is_registered -> - error_unless is_registered (Unregistered_delegate delegate) >>?= fun () -> - Contract_delegate_storage.init ctxt contract delegate >>=? fun ctxt -> - Contract_storage.get_balance_and_frozen_bonds ctxt contract - >>=? fun balance_and_frozen_bonds -> - Stake_storage.add_stake ctxt delegate balance_and_frozen_bonds +module Contract = struct + let init ctxt contract delegate = + Contract_manager_storage.is_manager_key_revealed ctxt delegate + >>=? fun known_delegate -> + error_unless known_delegate (Unregistered_delegate delegate) >>?= fun () -> + registered ctxt delegate >>= fun is_registered -> + error_unless is_registered (Unregistered_delegate delegate) >>?= fun () -> + Contract_delegate_storage.init ctxt contract delegate >>=? fun ctxt -> + Contract_storage.get_balance_and_frozen_bonds ctxt contract + >>=? fun balance_and_frozen_bonds -> + Stake_storage.add_stake ctxt delegate balance_and_frozen_bonds -let set c contract delegate = - match delegate with - | None -> ( - (* check if contract is a registered delegate *) - (match contract with - | Contract_repr.Implicit pkh -> - registered c pkh >>= fun is_registered -> - fail_when is_registered (No_deletion pkh) - | Originated _ -> return_unit) - >>=? fun () -> - Contract_delegate_storage.find c contract >>=? function - | None -> return c - | Some delegate -> - (* Removes the balance of the contract from the delegate *) - Contract_storage.get_balance_and_frozen_bonds c contract - >>=? fun balance_and_frozen_bonds -> - Stake_storage.remove_stake c delegate balance_and_frozen_bonds - >>=? fun c -> Contract_delegate_storage.delete c contract) - | Some delegate -> - Contract_manager_storage.is_manager_key_revealed c delegate - >>=? fun known_delegate -> - registered c delegate >>= fun registered_delegate -> - let self_delegation = - match contract with - | Implicit pkh -> Signature.Public_key_hash.equal pkh delegate - | Originated _ -> false - in - if (not known_delegate) || not (registered_delegate || self_delegation) - then fail (Unregistered_delegate delegate) - else - Contract_delegate_storage.find c contract >>=? fun current_delegate -> - (match current_delegate with - | Some current_delegate - when Signature.Public_key_hash.equal delegate current_delegate -> - if self_delegation then - Delegate_activation_storage.is_inactive c delegate >>=? function - | true -> return_unit - | false -> fail Active_delegate - else fail Current_delegate - | None | Some _ -> return_unit) - >>=? fun () -> + let set c contract delegate = + match delegate with + | None -> ( (* check if contract is a registered delegate *) (match contract with | Contract_repr.Implicit pkh -> registered c pkh >>= fun is_registered -> - (* allow self-delegation to re-activate *) - if (not self_delegation) && is_registered then - fail (No_deletion pkh) - else return_unit + fail_when is_registered (No_deletion pkh) | Originated _ -> return_unit) >>=? fun () -> - Contract_storage.allocated c contract >>= fun exists -> - error_when - (self_delegation && not exists) - (Empty_delegate_account delegate) - >>?= fun () -> - Contract_storage.get_balance_and_frozen_bonds c contract - >>=? fun balance_and_frozen_bonds -> - Stake_storage.remove_contract_stake c contract balance_and_frozen_bonds - >>=? fun c -> - Contract_delegate_storage.set c contract delegate >>=? fun c -> - Stake_storage.add_stake c delegate balance_and_frozen_bonds - >>=? fun c -> - if self_delegation then - Storage.Delegates.add c delegate >>= fun c -> - Stake_storage.set_active c delegate - else return c + Contract_delegate_storage.find c contract >>=? function + | None -> return c + | Some delegate -> + (* Removes the balance of the contract from the delegate *) + Contract_storage.get_balance_and_frozen_bonds c contract + >>=? fun balance_and_frozen_bonds -> + Stake_storage.remove_stake c delegate balance_and_frozen_bonds + >>=? fun c -> Contract_delegate_storage.delete c contract) + | Some delegate -> + Contract_manager_storage.is_manager_key_revealed c delegate + >>=? fun known_delegate -> + registered c delegate >>= fun registered_delegate -> + let self_delegation = + match contract with + | Implicit pkh -> Signature.Public_key_hash.equal pkh delegate + | Originated _ -> false + in + if (not known_delegate) || not (registered_delegate || self_delegation) + then fail (Unregistered_delegate delegate) + else + Contract_delegate_storage.find c contract >>=? fun current_delegate -> + (match current_delegate with + | Some current_delegate + when Signature.Public_key_hash.equal delegate current_delegate -> + if self_delegation then + Delegate_activation_storage.is_inactive c delegate >>=? function + | true -> return_unit + | false -> fail Active_delegate + else fail Current_delegate + | None | Some _ -> return_unit) + >>=? fun () -> + (* check if contract is a registered delegate *) + (match contract with + | Implicit pkh -> + registered c pkh >>= fun is_registered -> + (* allow self-delegation to re-activate *) + if (not self_delegation) && is_registered then + fail (No_deletion pkh) + else return_unit + | Originated _ -> return_unit) + >>=? fun () -> + Contract_storage.allocated c contract >>= fun exists -> + error_when + (self_delegation && not exists) + (Empty_delegate_account delegate) + >>?= fun () -> + Contract_storage.get_balance_and_frozen_bonds c contract + >>=? fun balance_and_frozen_bonds -> + Stake_storage.remove_contract_stake + c + contract + balance_and_frozen_bonds + >>=? fun c -> + Contract_delegate_storage.set c contract delegate >>=? fun c -> + Stake_storage.add_stake c delegate balance_and_frozen_bonds + >>=? fun c -> + if self_delegation then + Storage.Delegates.add c delegate >>= fun c -> + Stake_storage.set_active c delegate + else return c +end diff --git a/src/proto_alpha/lib_protocol/delegate_storage.mli b/src/proto_alpha/lib_protocol/delegate_storage.mli index afa43e5df789..3c747f8d89c5 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/delegate_storage.mli @@ -97,19 +97,32 @@ val delegated_balance : val full_balance : Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t -(** Allow to register a delegate when creating an account. *) -val init : - Raw_context.t -> - Contract_repr.t -> - Signature.Public_key_hash.t -> - Raw_context.t tzresult Lwt.t - -(** Allow to set the delegate of an account. *) -val set : - Raw_context.t -> - Contract_repr.t -> - Signature.Public_key_hash.t option -> - Raw_context.t tzresult Lwt.t +module Contract : sig + (** [init ctxt contract delegate] allows to register a delegate when + creating a contract. + + This function is undefined if [contract] is not allocated, or if + [contract] has already a delegate, or if [delegate] is not a registered + delegate. *) + val init : + Raw_context.t -> + Contract_repr.t -> + Signature.Public_key_hash.t -> + Raw_context.t tzresult Lwt.t + + (** [set ctxt contract delegate_opt] allows to set or unsetthe + delegate of a contract. + + This function is undefined if [contract] is not allocated. When + [delegate = contract], the function also register the contract + as a delegate. Otherwide, the function is undefined if + [delegate] is not a registered delegate *) + val set : + Raw_context.t -> + Contract_repr.t -> + Signature.Public_key_hash.t option -> + Raw_context.t tzresult Lwt.t +end val pubkey : Raw_context.t -> -- GitLab From 6585326095cb3ff05495a14d9de5a3775c439010 Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Thu, 14 Apr 2022 23:37:43 +0200 Subject: [PATCH 08/23] Proto: merge `Seed.cycle_end` into `Delegate.cycle_end` --- src/proto_alpha/lib_protocol/alpha_context.mli | 4 ---- src/proto_alpha/lib_protocol/apply.ml | 3 +-- src/proto_alpha/lib_protocol/delegate_cycles.ml | 3 ++- src/proto_alpha/lib_protocol/delegate_cycles.mli | 1 - 4 files changed, 3 insertions(+), 8 deletions(-) diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 9a0415f86411..c9c9a739dbcb 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -1320,9 +1320,6 @@ module Seed : sig val compute_randao : context -> context tzresult Lwt.t - val cycle_end : - context -> Cycle.t -> (context * Nonce.unrevealed list) tzresult Lwt.t - (* RPC *) type seed_computation_status = | Nonce_revelation_stage @@ -2446,7 +2443,6 @@ module Delegate : sig val cycle_end : context -> Cycle.t -> - Nonce.unrevealed list -> (context * Receipt.balance_updates * Signature.Public_key_hash.t list) tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 6addb5c0d7f1..b2d6e8e3648c 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -3050,8 +3050,7 @@ let may_start_new_cycle ctxt = match Level.dawn_of_a_new_cycle ctxt with | None -> return (ctxt, [], []) | Some last_cycle -> - Seed.cycle_end ctxt last_cycle >>=? fun (ctxt, unrevealed) -> - Delegate.cycle_end ctxt last_cycle unrevealed + Delegate.cycle_end ctxt last_cycle >>=? fun (ctxt, balance_updates, deactivated) -> Bootstrap.cycle_end ctxt last_cycle >|=? fun ctxt -> (ctxt, balance_updates, deactivated) diff --git a/src/proto_alpha/lib_protocol/delegate_cycles.ml b/src/proto_alpha/lib_protocol/delegate_cycles.ml index 57cf944e033a..1fec466d8e38 100644 --- a/src/proto_alpha/lib_protocol/delegate_cycles.ml +++ b/src/proto_alpha/lib_protocol/delegate_cycles.ml @@ -189,7 +189,8 @@ let freeze_deposits ?(origin = Receipt_repr.Block_application) ctxt ~new_cycle delegates_to_remove (ctxt, balance_updates) -let cycle_end ctxt last_cycle unrevealed_nonces = +let cycle_end ctxt last_cycle = + Seed_storage.cycle_end ctxt last_cycle >>=? fun (ctxt, unrevealed_nonces) -> let new_cycle = Cycle_repr.add last_cycle 1 in Delegate_sampler.select_new_distribution_at_cycle_end ctxt ~new_cycle >>=? fun ctxt -> diff --git a/src/proto_alpha/lib_protocol/delegate_cycles.mli b/src/proto_alpha/lib_protocol/delegate_cycles.mli index 0814d32d45b8..ebcecb05d925 100644 --- a/src/proto_alpha/lib_protocol/delegate_cycles.mli +++ b/src/proto_alpha/lib_protocol/delegate_cycles.mli @@ -32,7 +32,6 @@ val cycle_end : Raw_context.t -> Cycle_repr.t -> - Storage.Seed.unrevealed_nonce list -> (Raw_context.t * Receipt_repr.balance_updates * Signature.Public_key_hash.t list) -- GitLab From 67073749bca5016dae8f12479a75f1f49762172f Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Sat, 23 Apr 2022 13:14:16 +0200 Subject: [PATCH 09/23] Proto/Alpha_context: always use `public_key` and `public_key_hash` --- .../lib_protocol/alpha_context.mli | 124 +++++++----------- 1 file changed, 48 insertions(+), 76 deletions(-) diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index c9c9a739dbcb..381a949f2b07 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -1619,9 +1619,7 @@ end (** This module re-exports definitions from {!Contract_repr} and {!Contract_storage}. *) module Contract : sig - type t = - | Implicit of Signature.Public_key_hash.t - | Originated of Contract_hash.t + type t = Implicit of public_key_hash | Originated of Contract_hash.t type error += Non_existing_contract of t @@ -1823,7 +1821,7 @@ end (** This module re-exports definitions from {!Tx_rollup_withdraw_repr}. *) module Tx_rollup_withdraw : sig type order = { - claimer : Signature.Public_key_hash.t; + claimer : public_key_hash; ticket_hash : Ticket_hash.t; amount : Tx_rollup_l2_qty.t; } @@ -1957,7 +1955,7 @@ module Tx_rollup_reveal : sig ty : Script.lazy_expr; ticketer : Contract.t; amount : Tx_rollup_l2_qty.t; - claimer : Signature.Public_key_hash.t; + claimer : public_key_hash; } val encoding : t Data_encoding.t @@ -2112,7 +2110,7 @@ module Tx_rollup_commitment : sig type nonrec t = { commitment : Compact.t; commitment_hash : Tx_rollup_commitment_hash.t; - committer : Signature.Public_key_hash.t; + committer : public_key_hash; submitted_at : Raw_level.t; finalized_at : Raw_level.t option; } @@ -2143,10 +2141,9 @@ module Tx_rollup_commitment : sig context -> Tx_rollup.t -> Tx_rollup_state.t -> - Signature.public_key_hash -> + public_key_hash -> Full.t -> - (context * Tx_rollup_state.t * Signature.public_key_hash option) tzresult - Lwt.t + (context * Tx_rollup_state.t * public_key_hash option) tzresult Lwt.t val find : context -> @@ -2182,16 +2179,10 @@ module Tx_rollup_commitment : sig (context * Submitted_commitment.t) tzresult Lwt.t val pending_bonded_commitments : - context -> - Tx_rollup.t -> - Signature.public_key_hash -> - (context * int) tzresult Lwt.t + context -> Tx_rollup.t -> public_key_hash -> (context * int) tzresult Lwt.t val has_bond : - context -> - Tx_rollup.t -> - Signature.public_key_hash -> - (context * bool) tzresult Lwt.t + context -> Tx_rollup.t -> public_key_hash -> (context * bool) tzresult Lwt.t val finalize_commitment : context -> @@ -2206,16 +2197,10 @@ module Tx_rollup_commitment : sig (context * Tx_rollup_state.t * Tx_rollup_level.t) tzresult Lwt.t val remove_bond : - context -> - Tx_rollup.t -> - Signature.public_key_hash -> - context tzresult Lwt.t + context -> Tx_rollup.t -> public_key_hash -> context tzresult Lwt.t val slash_bond : - context -> - Tx_rollup.t -> - Signature.public_key_hash -> - (context * bool) tzresult Lwt.t + context -> Tx_rollup.t -> public_key_hash -> (context * bool) tzresult Lwt.t val reject_commitment : context -> @@ -2263,8 +2248,8 @@ module Tx_rollup_errors : sig } | Level_already_has_commitment of Tx_rollup_level.t | Wrong_inbox_hash - | Bond_does_not_exist of Signature.public_key_hash - | Bond_in_use of Signature.public_key_hash + | Bond_does_not_exist of public_key_hash + | Bond_in_use of public_key_hash | No_uncommitted_inbox | No_commitment_to_finalize | No_commitment_to_remove @@ -2377,7 +2362,7 @@ module Receipt : sig | Baking_bonuses | Storage_fees | Double_signing_punishments - | Lost_endorsing_rewards of Signature.Public_key_hash.t * bool * bool + | Lost_endorsing_rewards of public_key_hash * bool * bool | Liquidity_baking_subsidies | Burned | Commitments of Blinded_public_key_hash.t @@ -2412,10 +2397,10 @@ end (** This module re-exports definitions from {!Delegate_storage}. *) module Delegate : sig val frozen_deposits_limit : - context -> Signature.Public_key_hash.t -> Tez.t option tzresult Lwt.t + context -> public_key_hash -> Tez.t option tzresult Lwt.t val set_frozen_deposits_limit : - context -> Signature.Public_key_hash.t -> Tez.t option -> context Lwt.t + context -> public_key_hash -> Tez.t option -> context Lwt.t val fold : context -> @@ -2443,9 +2428,7 @@ module Delegate : sig val cycle_end : context -> Cycle.t -> - (context * Receipt.balance_updates * Signature.Public_key_hash.t list) - tzresult - Lwt.t + (context * Receipt.balance_updates * public_key_hash list) tzresult Lwt.t val check_and_record_already_slashed_for_double_endorsing : context -> public_key_hash -> Level.t -> (context * bool) tzresult Lwt.t @@ -2469,15 +2452,15 @@ module Delegate : sig val record_baking_activity_and_pay_rewards_and_fees : context -> - payload_producer:Signature.Public_key_hash.t -> - block_producer:Signature.Public_key_hash.t -> + payload_producer:public_key_hash -> + block_producer:public_key_hash -> baking_reward:Tez.t -> reward_bonus:Tez.t option -> (context * Receipt.balance_updates) tzresult Lwt.t val record_endorsing_participation : context -> - delegate:Signature.Public_key_hash.t -> + delegate:public_key_hash -> participation:level_participation -> endorsing_power:int -> context tzresult Lwt.t @@ -2486,25 +2469,21 @@ module Delegate : sig val frozen_deposits : context -> public_key_hash -> deposits tzresult Lwt.t - val staking_balance : - context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t + val staking_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t (** See {!Contract_delegate_storage.delegated_contracts}. *) - val delegated_contracts : - context -> Signature.Public_key_hash.t -> Contract.t list Lwt.t + val delegated_contracts : context -> public_key_hash -> Contract.t list Lwt.t - val delegated_balance : - context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t + val delegated_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t (** See {!Contract_delegate_storage.registered}. *) - val registered : context -> Signature.Public_key_hash.t -> bool Lwt.t + val registered : context -> public_key_hash -> bool Lwt.t - val deactivated : - context -> Signature.Public_key_hash.t -> bool tzresult Lwt.t + val deactivated : context -> public_key_hash -> bool tzresult Lwt.t (** See {!Delegate_activation_storage.last_cycle_before_deactivation}. *) val last_cycle_before_deactivation : - context -> Signature.Public_key_hash.t -> Cycle.t tzresult Lwt.t + context -> public_key_hash -> Cycle.t tzresult Lwt.t val pubkey : context -> public_key_hash -> public_key tzresult Lwt.t @@ -2576,8 +2555,7 @@ module Vote : sig val recorded_proposal_count_for_delegate : context -> public_key_hash -> int tzresult Lwt.t - val listings_encoding : - (Signature.Public_key_hash.t * int64) list Data_encoding.t + val listings_encoding : (public_key_hash * int64) list Data_encoding.t val update_listings : context -> context tzresult Lwt.t @@ -2601,13 +2579,12 @@ module Vote : sig val delegate_info_encoding : delegate_info Data_encoding.t val get_delegate_info : - context -> Signature.Public_key_hash.t -> delegate_info tzresult Lwt.t + context -> public_key_hash -> delegate_info tzresult Lwt.t - val get_voting_power_free : - context -> Signature.Public_key_hash.t -> int64 tzresult Lwt.t + val get_voting_power_free : context -> public_key_hash -> int64 tzresult Lwt.t val get_voting_power : - context -> Signature.Public_key_hash.t -> (context * int64) tzresult Lwt.t + context -> public_key_hash -> (context * int64) tzresult Lwt.t val get_total_voting_power_free : context -> int64 tzresult Lwt.t @@ -2671,7 +2648,7 @@ module Dal : sig val expected_size_in_bits : max_index:Slot_index.t -> int - val shards : context -> endorser:Signature.Public_key_hash.t -> int list + val shards : context -> endorser:public_key_hash -> int list val record_available_shards : context -> t -> int list -> context end @@ -2753,8 +2730,7 @@ module Sc_rollup : sig type rollup := t - module Staker : - S.SIGNATURE_PUBLIC_KEY_HASH with type t = Signature.Public_key_hash.t + module Staker : S.SIGNATURE_PUBLIC_KEY_HASH with type t = public_key_hash module State_hash : S.HASH @@ -2766,7 +2742,7 @@ module Sc_rollup : sig type internal_inbox_message = { payload : Script.expr; sender : Contract_hash.t; - source : Signature.public_key_hash; + source : public_key_hash; } type t = Internal of internal_inbox_message | External of string @@ -2874,7 +2850,7 @@ module Sc_rollup : sig rollup -> payload:Script.expr -> sender:Contract_hash.t -> - source:Signature.public_key_hash -> + source:public_key_hash -> (t * Z.t * context) tzresult Lwt.t val inbox : context -> rollup -> (t * context) tzresult Lwt.t @@ -3368,7 +3344,7 @@ module Block_header : sig Liquidity_baking_repr.liquidity_baking_toggle_vote; } - type protocol_data = {contents : contents; signature : Signature.t} + type protocol_data = {contents : contents; signature : signature} type t = {shell : Block_header.shell_header; protocol_data : protocol_data} @@ -3425,8 +3401,7 @@ module Block_header : sig predecessor_round:Round.t -> unit tzresult - val check_signature : - t -> Chain_id.t -> Signature.Public_key.t -> unit tzresult + val check_signature : t -> Chain_id.t -> public_key -> unit tzresult val begin_validate_block_header : block_header:t -> @@ -3435,7 +3410,7 @@ module Block_header : sig predecessor_round:Round.t -> fitness:Fitness.t -> timestamp:Time.t -> - delegate_pk:Signature.public_key -> + delegate_pk:public_key -> round_durations:Round.round_durations -> proof_of_work_threshold:int64 -> expected_commitment:bool -> @@ -3613,7 +3588,7 @@ type 'kind operation = { and 'kind protocol_data = { contents : 'kind contents_list; - signature : Signature.t option; + signature : signature option; } and _ contents_list = @@ -3626,7 +3601,7 @@ and _ contents = | Preendorsement : consensus_content -> Kind.preendorsement contents | Endorsement : consensus_content -> Kind.endorsement contents | Dal_slot_availability : - Signature.Public_key_hash.t * Dal.Endorsement.t + public_key_hash * Dal.Endorsement.t -> Kind.dal_slot_availability contents | Seed_nonce_revelation : { level : Raw_level.t; @@ -3658,13 +3633,13 @@ and _ contents = } -> Kind.activate_account contents | Proposals : { - source : Signature.Public_key_hash.t; + source : public_key_hash; period : int32; proposals : Protocol_hash.t list; } -> Kind.proposals contents | Ballot : { - source : Signature.Public_key_hash.t; + source : public_key_hash; period : int32; proposal : Protocol_hash.t; ballot : Vote.ballot; @@ -3672,7 +3647,7 @@ and _ contents = -> Kind.ballot contents | Failing_noop : string -> Kind.failing_noop contents | Manager_operation : { - source : Signature.Public_key_hash.t; + source : public_key_hash; fee : Tez.tez; counter : counter; operation : 'kind manager_operation; @@ -3682,7 +3657,7 @@ and _ contents = -> 'kind Kind.manager contents and _ manager_operation = - | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation + | Reveal : public_key -> Kind.reveal manager_operation | Transaction : { amount : Tez.tez; parameters : Script.lazy_expr; @@ -3691,14 +3666,12 @@ and _ manager_operation = } -> Kind.transaction manager_operation | Origination : { - delegate : Signature.Public_key_hash.t option; + delegate : public_key_hash option; script : Script.t; credit : Tez.tez; } -> Kind.origination manager_operation - | Delegation : - Signature.Public_key_hash.t option - -> Kind.delegation manager_operation + | Delegation : public_key_hash option -> Kind.delegation manager_operation | Register_global_constant : { value : Script.lazy_expr; } @@ -4093,8 +4066,7 @@ module Stake_distribution : sig val delegate_pubkey : context -> public_key_hash -> public_key tzresult Lwt.t (** See {!Delegate.staking_balance}. *) - val get_staking_balance : - context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t + val get_staking_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t end (** This module re-exports definitions from {!Commitment_repr} and, @@ -4279,8 +4251,8 @@ module Token : sig type container = [ `Contract of Contract.t | `Collected_commitments of Blinded_public_key_hash.t - | `Delegate_balance of Signature.Public_key_hash.t - | `Frozen_deposits of Signature.Public_key_hash.t + | `Delegate_balance of public_key_hash + | `Frozen_deposits of public_key_hash | `Block_fees | `Frozen_bonds of Contract.t * Bond_id.t ] @@ -4301,7 +4273,7 @@ module Token : sig type sink = [ `Storage_fees | `Double_signing_punishments - | `Lost_endorsing_rewards of Signature.Public_key_hash.t * bool * bool + | `Lost_endorsing_rewards of public_key_hash * bool * bool | `Burned | `Tx_rollup_rejection_punishments | `Sc_rollup_refutation_punishments -- GitLab From 3b37920c843acf319d5bc97a0670ba8d2626bbf4 Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Mon, 25 Apr 2022 09:26:31 +0200 Subject: [PATCH 10/23] Proto/Delegate: remove dead code --- src/proto_alpha/lib_protocol/alpha_context.ml | 2 -- src/proto_alpha/lib_protocol/alpha_context.mli | 3 --- 2 files changed, 5 deletions(-) diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index 76be0e03ee50..2c1661afa1ab 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -488,8 +488,6 @@ module Stake_distribution = struct let slot_owner = Delegate_sampler.slot_owner - let delegate_pubkey = Delegate_storage.pubkey - let get_staking_balance = Delegate_storage.staking_balance end diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 381a949f2b07..5d54a52edac7 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -4062,9 +4062,6 @@ module Stake_distribution : sig Slot.t -> (context * (public_key * public_key_hash)) tzresult Lwt.t - (** See {!Delegate.pubkey}. *) - val delegate_pubkey : context -> public_key_hash -> public_key tzresult Lwt.t - (** See {!Delegate.staking_balance}. *) val get_staking_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t end -- GitLab From 16201e6b636af414a08ccc135ef0004f0dee3ac7 Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Mon, 25 Apr 2022 09:43:07 +0200 Subject: [PATCH 11/23] Proto: rename `Delegate.delegate_participation_info` --- src/proto_alpha/lib_protocol/alpha_context.mli | 2 +- .../lib_protocol/delegate_missed_endorsements_storage.ml | 2 +- .../lib_protocol/delegate_missed_endorsements_storage.mli | 2 +- src/proto_alpha/lib_protocol/delegate_services.ml | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 5d54a52edac7..d1326c07bec5 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -2422,7 +2422,7 @@ module Delegate : sig expected_endorsing_rewards : Tez.t; } - val delegate_participation_info : + val participation_info : context -> public_key_hash -> participation_info tzresult Lwt.t val cycle_end : diff --git a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml index 508d2852e8a3..6d28a0beacfa 100644 --- a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml @@ -133,7 +133,7 @@ type participation_info = { } (* Inefficient, only for RPC *) -let delegate_participation_info ctxt delegate = +let participation_info ctxt delegate = let level = Level_storage.current ctxt in Stake_storage.get_selected_distribution ctxt level.cycle >>=? fun stake_distribution -> diff --git a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli index 3ac64a03ae96..7f8f7b1a4df7 100644 --- a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli +++ b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli @@ -63,7 +63,7 @@ type participation_info = { [delegate_participation_info] and [!val:check_delegate] forms the implementation of RPC call "/context/delegates//participation". *) -val delegate_participation_info : +val participation_info : Raw_context.t -> Signature.Public_key_hash.t -> participation_info tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/delegate_services.ml b/src/proto_alpha/lib_protocol/delegate_services.ml index b0c8da4709a4..f05ee611020b 100644 --- a/src/proto_alpha/lib_protocol/delegate_services.ml +++ b/src/proto_alpha/lib_protocol/delegate_services.ml @@ -425,7 +425,7 @@ let register () = Vote.get_delegate_info ctxt pkh) ; register1 ~chunked:false S.participation (fun ctxt pkh () () -> Delegate.check_registered ctxt pkh >>=? fun () -> - Delegate.delegate_participation_info ctxt pkh) + Delegate.participation_info ctxt pkh) let list ctxt block ?(active = true) ?(inactive = false) ?(with_minimal_stake = true) ?(without_minimal_stake = false) () = -- GitLab From ff652cc5a8c8383368aea409b51076081a085f56 Mon Sep 17 00:00:00 2001 From: Eugen Zalinescu Date: Tue, 26 Apr 2022 10:29:20 +0000 Subject: [PATCH 12/23] Proto: improve doc in `Delegate_table_storage`. --- .../contract_delegate_storage.mli | 2 +- .../lib_protocol/delegate_storage.mli | 26 +++++++++++-------- 2 files changed, 16 insertions(+), 12 deletions(-) diff --git a/src/proto_alpha/lib_protocol/contract_delegate_storage.mli b/src/proto_alpha/lib_protocol/contract_delegate_storage.mli index 1bdd5d5d1895..7fe992903bc0 100644 --- a/src/proto_alpha/lib_protocol/contract_delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/contract_delegate_storage.mli @@ -32,7 +32,7 @@ val find : (** [init ctxt contract delegate] sets the [delegate] associated to [contract]. - This function is undefined if [contract] has already a delegate. *) + This function returns an error if [contract] has already a delegate. *) val init : Raw_context.t -> Contract_repr.t -> diff --git a/src/proto_alpha/lib_protocol/delegate_storage.mli b/src/proto_alpha/lib_protocol/delegate_storage.mli index 3c747f8d89c5..885f3e097ea8 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/delegate_storage.mli @@ -98,25 +98,29 @@ val full_balance : Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t module Contract : sig - (** [init ctxt contract delegate] allows to register a delegate when + (** [init ctxt contract delegate] registers a delegate when creating a contract. - This function is undefined if [contract] is not allocated, or if - [contract] has already a delegate, or if [delegate] is not a registered - delegate. *) + This functions assumes that [contract] is allocated. + This function returns an error if [contract] already has a delegate or + if [delegate] is not a registered delegate. *) val init : Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t - (** [set ctxt contract delegate_opt] allows to set or unsetthe - delegate of a contract. - - This function is undefined if [contract] is not allocated. When - [delegate = contract], the function also register the contract - as a delegate. Otherwide, the function is undefined if - [delegate] is not a registered delegate *) + (** [set ctxt contract delegate_opt] allows to set the + delegate of a contract to [delegate] when [delegate_opt = Some delegate] + or to unset the delegate when [delegate_opt = None]. + When [delegate_opt = Some contract] (aka self-delegation), + the function also registers the contract as a delegate and + sets the delegate as {{!module:Delegate_activation_storage}active}. + + It returns an error when trying to set the delegate to an unregistered delegate. + It returns an error when trying to unset or change the delegate of a registered delegate. + It returns an error when self-delegating and the delegate is not {{!Contract_storage.allocated}allocated}. + It returns an error when self-delegating and the delegate is already active. *) val set : Raw_context.t -> Contract_repr.t -> -- GitLab From 51485236183fc3da6c517b2d9065ea2f98f3c421 Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Wed, 27 Apr 2022 11:08:02 +0200 Subject: [PATCH 13/23] Proto: refactor `Delegate_table_storage.Contract.set` --- .../lib_protocol/delegate_storage.ml | 150 ++++++++++-------- 1 file changed, 83 insertions(+), 67 deletions(-) diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml index 4f9fda6a3b3b..454f849ea20a 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_storage.ml @@ -227,6 +227,11 @@ let full_balance ctxt delegate = Lwt.return Tez_repr.(frozen_deposits.current_amount +? balance_and_frozen_bonds) +(** This module ensures the following invariants: + - registered delegates are self-delegated and appears in `Storage.Delegate`, + i.e. registered delegate cannot change their delegation + - stake is properly moved when changing delegation. +*) module Contract = struct let init ctxt contract delegate = Contract_manager_storage.is_manager_key_revealed ctxt delegate @@ -239,74 +244,85 @@ module Contract = struct >>=? fun balance_and_frozen_bonds -> Stake_storage.add_stake ctxt delegate balance_and_frozen_bonds - let set c contract delegate = + let set_self_delegate c delegate = + let open Lwt_tzresult_syntax in + let*! is_registered = registered c delegate in + if is_registered then + let* () = + let* is_inactive = Delegate_activation_storage.is_inactive c delegate in + fail_unless is_inactive Active_delegate + in + Stake_storage.set_active c delegate + else + let contract = Contract_repr.Implicit delegate in + let* () = + let* is_pk_revealed = + Contract_manager_storage.is_manager_key_revealed c delegate + in + fail_unless is_pk_revealed (Unregistered_delegate delegate) + in + let* () = + let*! is_allocated = Contract_storage.allocated c contract in + fail_unless is_allocated (Empty_delegate_account delegate) + in + let* balance_and_frozen_bonds = + Contract_storage.get_balance_and_frozen_bonds c contract + in + let* c = + Stake_storage.remove_contract_stake c contract balance_and_frozen_bonds + in + let* c = Contract_delegate_storage.set c contract delegate in + let* c = Stake_storage.add_stake c delegate balance_and_frozen_bonds in + let*! c = Storage.Delegates.add c delegate in + let* c = Stake_storage.set_active c delegate in + return c + + let set_delegate c contract delegate = + let open Lwt_tzresult_syntax in + let* () = + match contract with + | Contract_repr.Originated _ -> return_unit + | Implicit pkh -> + let*! is_registered = registered c pkh in + fail_when is_registered (No_deletion pkh) + in + let* () = + let* current_delegate = Contract_delegate_storage.find c contract in + match (delegate, current_delegate) with + | None, None -> + (* we don't fail in this case in order not to risk breaking + existing smart contracts. *) + return_unit + | Some delegate, Some current_delegate + when Signature.Public_key_hash.equal delegate current_delegate -> + fail Current_delegate + | _ -> return_unit + in + let* balance_and_frozen_bonds = + Contract_storage.get_balance_and_frozen_bonds c contract + in + let* c = + Stake_storage.remove_contract_stake c contract balance_and_frozen_bonds + in match delegate with - | None -> ( - (* check if contract is a registered delegate *) - (match contract with - | Contract_repr.Implicit pkh -> - registered c pkh >>= fun is_registered -> - fail_when is_registered (No_deletion pkh) - | Originated _ -> return_unit) - >>=? fun () -> - Contract_delegate_storage.find c contract >>=? function - | None -> return c - | Some delegate -> - (* Removes the balance of the contract from the delegate *) - Contract_storage.get_balance_and_frozen_bonds c contract - >>=? fun balance_and_frozen_bonds -> - Stake_storage.remove_stake c delegate balance_and_frozen_bonds - >>=? fun c -> Contract_delegate_storage.delete c contract) + | None -> + let* c = Contract_delegate_storage.delete c contract in + return c | Some delegate -> - Contract_manager_storage.is_manager_key_revealed c delegate - >>=? fun known_delegate -> - registered c delegate >>= fun registered_delegate -> - let self_delegation = - match contract with - | Implicit pkh -> Signature.Public_key_hash.equal pkh delegate - | Originated _ -> false + let* () = + let*! is_delegate_registered = registered c delegate in + fail_when + (not is_delegate_registered) + (Unregistered_delegate delegate) in - if (not known_delegate) || not (registered_delegate || self_delegation) - then fail (Unregistered_delegate delegate) - else - Contract_delegate_storage.find c contract >>=? fun current_delegate -> - (match current_delegate with - | Some current_delegate - when Signature.Public_key_hash.equal delegate current_delegate -> - if self_delegation then - Delegate_activation_storage.is_inactive c delegate >>=? function - | true -> return_unit - | false -> fail Active_delegate - else fail Current_delegate - | None | Some _ -> return_unit) - >>=? fun () -> - (* check if contract is a registered delegate *) - (match contract with - | Implicit pkh -> - registered c pkh >>= fun is_registered -> - (* allow self-delegation to re-activate *) - if (not self_delegation) && is_registered then - fail (No_deletion pkh) - else return_unit - | Originated _ -> return_unit) - >>=? fun () -> - Contract_storage.allocated c contract >>= fun exists -> - error_when - (self_delegation && not exists) - (Empty_delegate_account delegate) - >>?= fun () -> - Contract_storage.get_balance_and_frozen_bonds c contract - >>=? fun balance_and_frozen_bonds -> - Stake_storage.remove_contract_stake - c - contract - balance_and_frozen_bonds - >>=? fun c -> - Contract_delegate_storage.set c contract delegate >>=? fun c -> - Stake_storage.add_stake c delegate balance_and_frozen_bonds - >>=? fun c -> - if self_delegation then - Storage.Delegates.add c delegate >>= fun c -> - Stake_storage.set_active c delegate - else return c + let* c = Contract_delegate_storage.set c contract delegate in + let* c = Stake_storage.add_stake c delegate balance_and_frozen_bonds in + return c + + let set c contract delegate = + match (delegate, contract) with + | Some delegate, Contract_repr.Implicit source + when Signature.Public_key_hash.equal source delegate -> + set_self_delegate c delegate + | _ -> set_delegate c contract delegate end -- GitLab From 2975db6355e14fb23af2591454128d38b97f267e Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Sat, 7 May 2022 13:08:21 +0200 Subject: [PATCH 14/23] Proto: no error for `expected_slots_for_given_active_stake` --- .../delegate_missed_endorsements_storage.ml | 46 ++++++++++--------- 1 file changed, 24 insertions(+), 22 deletions(-) diff --git a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml index 6d28a0beacfa..6517bf97ad9c 100644 --- a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml @@ -36,13 +36,12 @@ let expected_slots_for_given_active_stake ctxt ~total_active_stake ~active_stake let number_of_endorsements_per_cycle = blocks_per_cycle * consensus_committee_size in - Result.return - (Z.to_int - (Z.div - (Z.mul - (Z.of_int64 (Tez_repr.to_mutez active_stake)) - (Z.of_int number_of_endorsements_per_cycle)) - (Z.of_int64 (Tez_repr.to_mutez total_active_stake)))) + Z.to_int + (Z.div + (Z.mul + (Z.of_int64 (Tez_repr.to_mutez active_stake)) + (Z.of_int number_of_endorsements_per_cycle)) + (Z.of_int64 (Tez_repr.to_mutez total_active_stake))) type level_participation = Participated | Didn't_participate @@ -79,11 +78,12 @@ let record_endorsing_participation ctxt ~delegate ~participation | Some active_stake -> Stake_storage.get_total_active_stake ctxt level.cycle >>=? fun total_active_stake -> - expected_slots_for_given_active_stake - ctxt - ~total_active_stake - ~active_stake - >>?= fun expected_slots -> + let expected_slots = + expected_slots_for_given_active_stake + ctxt + ~total_active_stake + ~active_stake + in let Ratio_repr.{numerator; denominator} = Constants_storage.minimal_participation_ratio ctxt in @@ -157,11 +157,12 @@ let participation_info ctxt delegate = | Some active_stake -> Stake_storage.get_total_active_stake ctxt level.cycle >>=? fun total_active_stake -> - expected_slots_for_given_active_stake - ctxt - ~total_active_stake - ~active_stake - >>?= fun expected_cycle_activity -> + let expected_cycle_activity = + expected_slots_for_given_active_stake + ctxt + ~total_active_stake + ~active_stake + in let Ratio_repr.{numerator; denominator} = Constants_storage.minimal_participation_ratio ctxt in @@ -234,11 +235,12 @@ let distribute_endorsing_rewards ctxt last_cycle unrevealed_nonces = let has_revealed_nonces = delegate_has_revealed_nonces delegate unrevealed_nonces_set in - expected_slots_for_given_active_stake - ctxt - ~total_active_stake - ~active_stake - >>?= fun expected_slots -> + let expected_slots = + expected_slots_for_given_active_stake + ctxt + ~total_active_stake + ~active_stake + in let rewards = Tez_repr.mul_exn endorsing_reward_per_slot expected_slots in (if sufficient_participation && has_revealed_nonces then (* Sufficient participation: we pay the rewards *) -- GitLab From 65f50384fdffd176e8e98c68bae97cb31b2a891f Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Sat, 7 May 2022 13:08:38 +0200 Subject: [PATCH 15/23] Proto: move `distribute_endorsing_rewards` into `Delegate_cycles` --- .../lib_protocol/delegate_cycles.ml | 62 +++++++++++++++-- .../delegate_missed_endorsements_storage.ml | 68 ++----------------- .../delegate_missed_endorsements_storage.mli | 19 ++++-- 3 files changed, 78 insertions(+), 71 deletions(-) diff --git a/src/proto_alpha/lib_protocol/delegate_cycles.ml b/src/proto_alpha/lib_protocol/delegate_cycles.ml index 1fec466d8e38..53a0c38c2146 100644 --- a/src/proto_alpha/lib_protocol/delegate_cycles.ml +++ b/src/proto_alpha/lib_protocol/delegate_cycles.ml @@ -189,6 +189,63 @@ let freeze_deposits ?(origin = Receipt_repr.Block_application) ctxt ~new_cycle delegates_to_remove (ctxt, balance_updates) +let delegate_has_revealed_nonces delegate unrevelead_nonces_set = + not (Signature.Public_key_hash.Set.mem delegate unrevelead_nonces_set) + +let distribute_endorsing_rewards ctxt last_cycle unrevealed_nonces = + let endorsing_reward_per_slot = + Constants_storage.endorsing_reward_per_slot ctxt + in + let unrevealed_nonces_set = + List.fold_left + (fun set {Storage.Seed.nonce_hash = _; delegate} -> + Signature.Public_key_hash.Set.add delegate set) + Signature.Public_key_hash.Set.empty + unrevealed_nonces + in + Stake_storage.get_total_active_stake ctxt last_cycle + >>=? fun total_active_stake -> + Stake_storage.get_selected_distribution ctxt last_cycle >>=? fun delegates -> + List.fold_left_es + (fun (ctxt, balance_updates) (delegate, active_stake) -> + let delegate_contract = Contract_repr.Implicit delegate in + Delegate_missed_endorsements_storage.reset_delegate_participation + ctxt + delegate + >>=? fun (ctxt, sufficient_participation) -> + let has_revealed_nonces = + delegate_has_revealed_nonces delegate unrevealed_nonces_set + in + let expected_slots = + Delegate_missed_endorsements_storage + .expected_slots_for_given_active_stake + ctxt + ~total_active_stake + ~active_stake + in + let rewards = Tez_repr.mul_exn endorsing_reward_per_slot expected_slots in + if sufficient_participation && has_revealed_nonces then + (* Sufficient participation: we pay the rewards *) + Token.transfer + ctxt + `Endorsing_rewards + (`Contract delegate_contract) + rewards + >|=? fun (ctxt, payed_rewards_receipts) -> + (ctxt, payed_rewards_receipts @ balance_updates) + else + (* Insufficient participation or unrevealed nonce: no rewards *) + Token.transfer + ctxt + `Endorsing_rewards + (`Lost_endorsing_rewards + (delegate, not sufficient_participation, not has_revealed_nonces)) + rewards + >|=? fun (ctxt, payed_rewards_receipts) -> + (ctxt, payed_rewards_receipts @ balance_updates)) + (ctxt, []) + delegates + let cycle_end ctxt last_cycle = Seed_storage.cycle_end ctxt last_cycle >>=? fun (ctxt, unrevealed_nonces) -> let new_cycle = Cycle_repr.add last_cycle 1 in @@ -198,10 +255,7 @@ let cycle_end ctxt last_cycle = ctxt ~new_cycle >>= fun ctxt -> - Delegate_missed_endorsements_storage.distribute_endorsing_rewards - ctxt - last_cycle - unrevealed_nonces + distribute_endorsing_rewards ctxt last_cycle unrevealed_nonces >>=? fun (ctxt, balance_updates) -> freeze_deposits ctxt ~new_cycle ~balance_updates >>=? fun (ctxt, balance_updates) -> diff --git a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml index 6517bf97ad9c..96d22c2888cd 100644 --- a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml @@ -204,65 +204,11 @@ let participation_info ctxt delegate = expected_endorsing_rewards; } -let delegate_participated_enough ctxt delegate = - Storage.Contract.Missed_endorsements.find ctxt delegate >>=? function - | None -> return_true +let reset_delegate_participation ctxt delegate = + let contract = Contract_repr.Implicit delegate in + Storage.Contract.Missed_endorsements.find ctxt contract >>=? fun missed -> + match missed with + | None -> return (ctxt, true) | Some missed_endorsements -> - return Compare.Int.(missed_endorsements.remaining_slots >= 0) - -let delegate_has_revealed_nonces delegate unrevelead_nonces_set = - not (Signature.Public_key_hash.Set.mem delegate unrevelead_nonces_set) - -let distribute_endorsing_rewards ctxt last_cycle unrevealed_nonces = - let endorsing_reward_per_slot = - Constants_storage.endorsing_reward_per_slot ctxt - in - let unrevealed_nonces_set = - List.fold_left - (fun set {Storage.Seed.nonce_hash = _; delegate} -> - Signature.Public_key_hash.Set.add delegate set) - Signature.Public_key_hash.Set.empty - unrevealed_nonces - in - Stake_storage.get_total_active_stake ctxt last_cycle - >>=? fun total_active_stake -> - Stake_storage.get_selected_distribution ctxt last_cycle >>=? fun delegates -> - List.fold_left_es - (fun (ctxt, balance_updates) (delegate, active_stake) -> - let delegate_contract = Contract_repr.Implicit delegate in - delegate_participated_enough ctxt delegate_contract - >>=? fun sufficient_participation -> - let has_revealed_nonces = - delegate_has_revealed_nonces delegate unrevealed_nonces_set - in - let expected_slots = - expected_slots_for_given_active_stake - ctxt - ~total_active_stake - ~active_stake - in - let rewards = Tez_repr.mul_exn endorsing_reward_per_slot expected_slots in - (if sufficient_participation && has_revealed_nonces then - (* Sufficient participation: we pay the rewards *) - Token.transfer - ctxt - `Endorsing_rewards - (`Contract delegate_contract) - rewards - >|=? fun (ctxt, payed_rewards_receipts) -> - (ctxt, payed_rewards_receipts @ balance_updates) - else - (* Insufficient participation or unrevealed nonce: no rewards *) - Token.transfer - ctxt - `Endorsing_rewards - (`Lost_endorsing_rewards - (delegate, not sufficient_participation, not has_revealed_nonces)) - rewards - >|=? fun (ctxt, payed_rewards_receipts) -> - (ctxt, payed_rewards_receipts @ balance_updates)) - >>=? fun (ctxt, balance_updates) -> - Storage.Contract.Missed_endorsements.remove ctxt delegate_contract - >>= fun ctxt -> return (ctxt, balance_updates)) - (ctxt, []) - delegates + Storage.Contract.Missed_endorsements.remove ctxt contract >>= fun ctxt -> + return (ctxt, Compare.Int.(missed_endorsements.remaining_slots >= 0)) diff --git a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli index 7f8f7b1a4df7..d2267d33a6a3 100644 --- a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli +++ b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli @@ -25,6 +25,12 @@ (* *) (*****************************************************************************) +val expected_slots_for_given_active_stake : + Raw_context.t -> + total_active_stake:Tez_repr.tez -> + active_stake:Tez_repr.tez -> + int + type level_participation = Participated | Didn't_participate (** Record the participation of a delegate as a validator. *) @@ -35,6 +41,13 @@ val record_endorsing_participation : endorsing_power:int -> Raw_context.t tzresult Lwt.t +(** Check that a delegate participated enough in the last cycle, + and then reset the participation for preparing the next cycle. *) +val reset_delegate_participation : + Raw_context.t -> + Signature.Public_key_hash.t -> + (Raw_context.t * bool) tzresult Lwt.t + (** Participation information. We denote by: - "static" information that does not change during the cycle - "dynamic" information that may change during the cycle *) @@ -78,9 +91,3 @@ val record_baking_activity_and_pay_rewards_and_fees : baking_reward:Tez_repr.t -> reward_bonus:Tez_repr.t option -> (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t - -val distribute_endorsing_rewards : - Raw_context.t -> - Cycle_repr.t -> - Storage.Seed.unrevealed_nonce list -> - (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t -- GitLab From 4f7c26ce41a5e289a949306d8b34fb58e7556fd2 Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Sat, 7 May 2022 14:31:00 +0200 Subject: [PATCH 16/23] Proto: remove unused error in `Delegate_storage` --- .../client_proto_context_commands.ml | 6 +- .../lib_protocol/delegate_storage.ml | 222 ++++++++---------- .../lib_protocol/delegate_storage.mli | 21 +- .../integration/consensus/test_delegation.ml | 8 +- 4 files changed, 110 insertions(+), 147 deletions(-) diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml index 06cf66a0930c..e85d61855e29 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml @@ -1422,7 +1422,11 @@ let commands_rw () = src_pk >>= function | Ok _ -> return_unit - | Error [Environment.Ecoproto_error Delegate_storage.Active_delegate] -> + | Error + [ + Environment.Ecoproto_error + Delegate_storage.Contract.Active_delegate; + ] -> cctxt#message "Delegate already activated." >>= fun () -> return_unit | Error el -> Lwt.return_error el); diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml index 454f849ea20a..cc7509a47399 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_storage.ml @@ -25,132 +25,9 @@ (* *) (*****************************************************************************) -type error += - | (* `Permanent *) No_deletion of Signature.Public_key_hash.t - | (* `Temporary *) Active_delegate - | (* `Temporary *) Current_delegate - | (* `Permanent *) Empty_delegate_account of Signature.Public_key_hash.t - | (* `Permanent *) Unregistered_delegate of Signature.Public_key_hash.t - | (* `Permanent *) Unassigned_validation_slot_for_level of Level_repr.t * int - | (* `Permanent *) - Cannot_find_active_stake of { - cycle : Cycle_repr.t; - delegate : Signature.Public_key_hash.t; - } - | (* `Temporary *) Not_registered of Signature.Public_key_hash.t +type error += (* `Temporary *) Not_registered of Signature.Public_key_hash.t let () = - register_error_kind - `Permanent - ~id:"delegate.no_deletion" - ~title:"Forbidden delegate deletion" - ~description:"Tried to unregister a delegate" - ~pp:(fun ppf delegate -> - Format.fprintf - ppf - "Delegate deletion is forbidden (%a)" - Signature.Public_key_hash.pp - delegate) - Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) - (function No_deletion c -> Some c | _ -> None) - (fun c -> No_deletion c) ; - register_error_kind - `Temporary - ~id:"delegate.already_active" - ~title:"Delegate already active" - ~description:"Useless delegate reactivation" - ~pp:(fun ppf () -> - Format.fprintf ppf "The delegate is still active, no need to refresh it") - Data_encoding.empty - (function Active_delegate -> Some () | _ -> None) - (fun () -> Active_delegate) ; - register_error_kind - `Temporary - ~id:"delegate.unchanged" - ~title:"Unchanged delegated" - ~description:"Contract already delegated to the given delegate" - ~pp:(fun ppf () -> - Format.fprintf - ppf - "The contract is already delegated to the same delegate") - Data_encoding.empty - (function Current_delegate -> Some () | _ -> None) - (fun () -> Current_delegate) ; - register_error_kind - `Permanent - ~id:"delegate.empty_delegate_account" - ~title:"Empty delegate account" - ~description:"Cannot register a delegate when its implicit account is empty" - ~pp:(fun ppf delegate -> - Format.fprintf - ppf - "Delegate registration is forbidden when the delegate\n\ - \ implicit account is empty (%a)" - Signature.Public_key_hash.pp - delegate) - Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) - (function Empty_delegate_account c -> Some c | _ -> None) - (fun c -> Empty_delegate_account c) ; - (* Unregistered delegate *) - register_error_kind - `Permanent - ~id:"contract.manager.unregistered_delegate" - ~title:"Unregistered delegate" - ~description:"A contract cannot be delegated to an unregistered delegate" - ~pp:(fun ppf k -> - Format.fprintf - ppf - "The provided public key (with hash %a) is not registered as valid \ - delegate key." - Signature.Public_key_hash.pp - k) - Data_encoding.(obj1 (req "hash" Signature.Public_key_hash.encoding)) - (function Unregistered_delegate k -> Some k | _ -> None) - (fun k -> Unregistered_delegate k) ; - (* Unassigned_validation_slot_for_level *) - register_error_kind - `Permanent - ~id:"delegate.unassigned_validation_slot_for_level" - ~title:"Unassigned validation slot for level" - ~description: - "The validation slot for the given level is not assigned. Nobody payed \ - for that slot, or the level is either in the past or too far in the \ - future (further than the validatiors_selection_offset constant)" - ~pp:(fun ppf (l, slot) -> - Format.fprintf - ppf - "The validation slot %i for the level %a is not assigned. Nobody payed \ - for that slot, or the level is either in the past or too far in the \ - future (further than the validatiors_selection_offset constant)" - slot - Level_repr.pp - l) - Data_encoding.(obj2 (req "level" Level_repr.encoding) (req "slot" int31)) - (function - | Unassigned_validation_slot_for_level (l, s) -> Some (l, s) | _ -> None) - (fun (l, s) -> Unassigned_validation_slot_for_level (l, s)) ; - register_error_kind - `Permanent - ~id:"delegate.cannot_find_active_stake" - ~title:"Cannot find active stake" - ~description: - "The active stake of a delegate cannot be found for the given cycle." - ~pp:(fun ppf (cycle, delegate) -> - Format.fprintf - ppf - "The active stake of the delegate %a cannot be found for the cycle %a." - Cycle_repr.pp - cycle - Signature.Public_key_hash.pp - delegate) - Data_encoding.( - obj2 - (req "cycle" Cycle_repr.encoding) - (req "delegate" Signature.Public_key_hash.encoding)) - (function - | Cannot_find_active_stake {cycle; delegate} -> Some (cycle, delegate) - | _ -> None) - (fun (cycle, delegate) -> Cannot_find_active_stake {cycle; delegate}) ; register_error_kind `Temporary ~id:"delegate.not_registered" @@ -182,12 +59,6 @@ let fold = Storage.Delegates.fold let list = Storage.Delegates.elements -let pubkey ctxt pkh = - Contract_manager_storage.get_manager_key - ctxt - pkh - ~error:(Unregistered_delegate pkh) - let frozen_deposits_limit ctxt delegate = Storage.Contract.Frozen_deposits_limit.find ctxt @@ -233,6 +104,27 @@ let full_balance ctxt delegate = - stake is properly moved when changing delegation. *) module Contract = struct + type error += + | (* `Permanent *) Unregistered_delegate of Signature.Public_key_hash.t + + let () = + (* Unregistered delegate *) + register_error_kind + `Permanent + ~id:"contract.manager.unregistered_delegate" + ~title:"Unregistered delegate" + ~description:"A contract cannot be delegated to an unregistered delegate" + ~pp:(fun ppf k -> + Format.fprintf + ppf + "The provided public key (with hash %a) is not registered as valid \ + delegate key." + Signature.Public_key_hash.pp + k) + Data_encoding.(obj1 (req "hash" Signature.Public_key_hash.encoding)) + (function Unregistered_delegate k -> Some k | _ -> None) + (fun k -> Unregistered_delegate k) + let init ctxt contract delegate = Contract_manager_storage.is_manager_key_revealed ctxt delegate >>=? fun known_delegate -> @@ -244,6 +136,38 @@ module Contract = struct >>=? fun balance_and_frozen_bonds -> Stake_storage.add_stake ctxt delegate balance_and_frozen_bonds + type error += + | (* `Temporary *) Active_delegate + | (* `Permanent *) Empty_delegate_account of Signature.Public_key_hash.t + + let () = + register_error_kind + `Temporary + ~id:"delegate.already_active" + ~title:"Delegate already active" + ~description:"Useless delegate reactivation" + ~pp:(fun ppf () -> + Format.fprintf ppf "The delegate is still active, no need to refresh it") + Data_encoding.empty + (function Active_delegate -> Some () | _ -> None) + (fun () -> Active_delegate) ; + register_error_kind + `Permanent + ~id:"delegate.empty_delegate_account" + ~title:"Empty delegate account" + ~description: + "Cannot register a delegate when its implicit account is empty" + ~pp:(fun ppf delegate -> + Format.fprintf + ppf + "Delegate registration is forbidden when the delegate\n\ + \ implicit account is empty (%a)" + Signature.Public_key_hash.pp + delegate) + Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) + (function Empty_delegate_account c -> Some c | _ -> None) + (fun c -> Empty_delegate_account c) + let set_self_delegate c delegate = let open Lwt_tzresult_syntax in let*! is_registered = registered c delegate in @@ -277,6 +201,38 @@ module Contract = struct let* c = Stake_storage.set_active c delegate in return c + type error += + | (* `Permanent *) No_deletion of Signature.Public_key_hash.t + | (* `Temporary *) Current_delegate + + let () = + register_error_kind + `Permanent + ~id:"delegate.no_deletion" + ~title:"Forbidden delegate deletion" + ~description:"Tried to unregister a delegate" + ~pp:(fun ppf delegate -> + Format.fprintf + ppf + "Delegate deletion is forbidden (%a)" + Signature.Public_key_hash.pp + delegate) + Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) + (function No_deletion c -> Some c | _ -> None) + (fun c -> No_deletion c) ; + register_error_kind + `Temporary + ~id:"delegate.unchanged" + ~title:"Unchanged delegated" + ~description:"Contract already delegated to the given delegate" + ~pp:(fun ppf () -> + Format.fprintf + ppf + "The contract is already delegated to the same delegate") + Data_encoding.empty + (function Current_delegate -> Some () | _ -> None) + (fun () -> Current_delegate) + let set_delegate c contract delegate = let open Lwt_tzresult_syntax in let* () = @@ -326,3 +282,9 @@ module Contract = struct set_self_delegate c delegate | _ -> set_delegate c contract delegate end + +let pubkey ctxt pkh = + Contract_manager_storage.get_manager_key + ~error:(Contract.Unregistered_delegate pkh) + ctxt + pkh diff --git a/src/proto_alpha/lib_protocol/delegate_storage.mli b/src/proto_alpha/lib_protocol/delegate_storage.mli index 885f3e097ea8..8096594f8fab 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/delegate_storage.mli @@ -25,19 +25,7 @@ (* *) (*****************************************************************************) -type error += - | (* `Permanent *) No_deletion of Signature.Public_key_hash.t - | (* `Temporary *) Active_delegate - | (* `Temporary *) Current_delegate - | (* `Permanent *) Empty_delegate_account of Signature.Public_key_hash.t - | (* `Permanent *) Unregistered_delegate of Signature.Public_key_hash.t - | (* `Permanent *) Unassigned_validation_slot_for_level of Level_repr.t * int - | (* `Permanent *) - Cannot_find_active_stake of { - cycle : Cycle_repr.t; - delegate : Signature.Public_key_hash.t; - } - | (* `Temporary *) Not_registered of Signature.Public_key_hash.t +type error += (* `Temporary *) Not_registered of Signature.Public_key_hash.t (** Has a delegate been registered in the delegate table? *) val registered : Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t @@ -98,6 +86,13 @@ val full_balance : Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t module Contract : sig + type error += + | (* `Permanent *) Unregistered_delegate of Signature.Public_key_hash.t + | (* `Temporary *) Active_delegate + | (* `Permanent *) Empty_delegate_account of Signature.Public_key_hash.t + | (* `Permanent *) No_deletion of Signature.Public_key_hash.t + | (* `Temporary *) Current_delegate + (** [init ctxt contract delegate] registers a delegate when creating a contract. diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_delegation.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_delegation.ml index 880961fcc6cd..4863aac4086d 100644 --- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_delegation.ml +++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_delegation.ml @@ -56,7 +56,7 @@ let expect_error err = function let expect_alpha_error err = expect_error (Environment.Ecoproto_error err) let expect_no_change_registered_delegate_pkh pkh = function - | Environment.Ecoproto_error (Delegate_storage.No_deletion pkh0) :: _ + | Environment.Ecoproto_error (Delegate_storage.Contract.No_deletion pkh0) :: _ when pkh0 = pkh -> return_unit | _ -> failwith "Delegate can not be deleted and operation should fail." @@ -221,7 +221,8 @@ let bootstrap_manager_already_registered_delegate ~fee () = else Incremental.add_operation ~expect_apply_failure:(function - | Environment.Ecoproto_error Delegate_storage.Active_delegate :: _ -> + | Environment.Ecoproto_error Delegate_storage.Contract.Active_delegate + :: _ -> return_unit | _ -> failwith "Delegate is already active and operation should fail.") i @@ -458,7 +459,8 @@ let tests_bootstrap_contracts = two possibilities of 1a for non-credited contracts. *) let expect_unregistered_key pkh = function - | Environment.Ecoproto_error (Delegate_storage.Unregistered_delegate pkh0) + | Environment.Ecoproto_error + (Delegate_storage.Contract.Unregistered_delegate pkh0) :: _ when pkh = pkh0 -> return_unit -- GitLab From 67bbeb92d9db550fb4d0fbebe4d30a6c8fa054fd Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Tue, 10 May 2022 02:57:07 +0200 Subject: [PATCH 17/23] Proto: add some doc for `Delegate_storage` --- .../delegate_missed_endorsements_storage.ml | 4 ++++ src/proto_alpha/lib_protocol/delegate_sampler.ml | 7 +++++++ .../lib_protocol/delegate_slashed_deposits_storage.ml | 4 ++++ src/proto_alpha/lib_protocol/delegate_storage.ml | 11 +++++++++++ 4 files changed, 26 insertions(+) diff --git a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml index 96d22c2888cd..7869cfca16ec 100644 --- a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml @@ -25,6 +25,10 @@ (* *) (*****************************************************************************) +(** This module is responsible for: + - [Storage.Contract.Missed_endorsements] +*) + let expected_slots_for_given_active_stake ctxt ~total_active_stake ~active_stake = let blocks_per_cycle = diff --git a/src/proto_alpha/lib_protocol/delegate_sampler.ml b/src/proto_alpha/lib_protocol/delegate_sampler.ml index 71b837b7ef60..9d5af86363fd 100644 --- a/src/proto_alpha/lib_protocol/delegate_sampler.ml +++ b/src/proto_alpha/lib_protocol/delegate_sampler.ml @@ -25,6 +25,13 @@ (* *) (*****************************************************************************) +(** This module is responsible for: + - [Storage.Seed.For_cycle] + + And the submodule `Delegate_sampler_state` is responsible for: + - [Storage.Delegate_sampler_state] +*) + module Delegate_sampler_state = struct module Cache_client = struct type cached_value = diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml index 043f8c117346..c3975dc709c0 100644 --- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml @@ -25,6 +25,10 @@ (* *) (*****************************************************************************) +(** This module is responsible for: + - [Storage.Slashed_deposits] +*) + let check_and_record_already_slashed_for_double_baking ctxt delegate (level : Level_repr.t) = let open Lwt_tzresult_syntax in diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml index cc7509a47399..daa8c60c0a06 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_storage.ml @@ -25,6 +25,17 @@ (* *) (*****************************************************************************) +(** This is module regroups everything related to delegate registration + (see the invariant maintained by the submodule `Contract`. + + It also regroups "trivial" getter/setter related to delegates. + + It is responsible for: + - [Storage.Contract.Frozen_deposits_limit] + - [Storage.Delegates] + +*) + type error += (* `Temporary *) Not_registered of Signature.Public_key_hash.t let () = -- GitLab From a0bc9ce8f5b10849c1c6d25ba7b398776f69ef8b Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Mon, 16 May 2022 11:16:32 +0200 Subject: [PATCH 18/23] Proto: merge `Delegate.check_and_record_...` into `punish` --- .../lib_protocol/alpha_context.mli | 8 +- src/proto_alpha/lib_protocol/apply.ml | 29 +--- .../delegate_slashed_deposits_storage.ml | 130 ++++++++++-------- .../delegate_slashed_deposits_storage.mli | 40 +++--- 4 files changed, 97 insertions(+), 110 deletions(-) diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index d1326c07bec5..25575afeebeb 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -2430,20 +2430,16 @@ module Delegate : sig Cycle.t -> (context * Receipt.balance_updates * public_key_hash list) tzresult Lwt.t - val check_and_record_already_slashed_for_double_endorsing : - context -> public_key_hash -> Level.t -> (context * bool) tzresult Lwt.t - - val check_and_record_already_slashed_for_double_baking : - context -> public_key_hash -> Level.t -> (context * bool) tzresult Lwt.t - val punish_double_endorsing : context -> public_key_hash -> + Level.t -> (context * Tez.t * Receipt.balance_updates) tzresult Lwt.t val punish_double_baking : context -> public_key_hash -> + Level.t -> (context * Tez.t * Receipt.balance_updates) tzresult Lwt.t val full_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index b2d6e8e3648c..7ec2d4839e93 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -108,7 +108,6 @@ type error += delegate1 : Signature.Public_key_hash.t; delegate2 : Signature.Public_key_hash.t; } - | Unrequired_denunciation | Too_early_denunciation of { kind : denunciation_kind; level : Raw_level.t; @@ -616,19 +615,6 @@ let () = | _ -> None) (fun (kind, delegate1, delegate2) -> Inconsistent_denunciation {kind; delegate1; delegate2}) ; - register_error_kind - `Branch - ~id:"block.unrequired_denunciation" - ~title:"Unrequired denunciation" - ~description:"A denunciation is unrequired" - ~pp:(fun ppf _ -> - Format.fprintf - ppf - "A valid denunciation cannot be applied: the associated delegate has \ - already been denounced for this level.") - Data_encoding.unit - (function Unrequired_denunciation -> Some () | _ -> None) - (fun () -> Unrequired_denunciation) ; register_error_kind `Temporary ~id:"block.too_early_denunciation" @@ -2698,19 +2684,12 @@ let check_denunciation_age ctxt kind given_level = {kind; level = given_level; last_cycle = last_slashable_cycle}) let punish_delegate ctxt delegate level mistake mk_result ~payload_producer = - let check_and_record_already_slashed, punish = + let punish = match mistake with - | `Double_baking -> - ( Delegate.check_and_record_already_slashed_for_double_baking, - Delegate.punish_double_baking ) - | `Double_endorsing -> - ( Delegate.check_and_record_already_slashed_for_double_endorsing, - Delegate.punish_double_endorsing ) + | `Double_baking -> Delegate.punish_double_baking + | `Double_endorsing -> Delegate.punish_double_endorsing in - check_and_record_already_slashed ctxt delegate level - >>=? fun (ctxt, slashed) -> - fail_when slashed Unrequired_denunciation >>=? fun () -> - punish ctxt delegate >>=? fun (ctxt, burned, punish_balance_updates) -> + punish ctxt delegate level >>=? fun (ctxt, burned, punish_balance_updates) -> (match Tez.(burned /? 2L) with | Ok reward -> Token.transfer diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml index c3975dc709c0..a67b302e57ba 100644 --- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml @@ -29,58 +29,46 @@ - [Storage.Slashed_deposits] *) -let check_and_record_already_slashed_for_double_baking ctxt delegate - (level : Level_repr.t) = - let open Lwt_tzresult_syntax in - let* slashed = - Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate) - in - let already_slashed, updated_slashed = - match slashed with - | None -> - (false, {Storage.for_double_baking = true; for_double_endorsing = false}) - | Some slashed -> - (slashed.for_double_baking, {slashed with for_double_baking = true}) - in - let*! ctxt = - Storage.Slashed_deposits.add - (ctxt, level.cycle) - (level.level, delegate) - updated_slashed - in - return (ctxt, already_slashed) +type error += Unrequired_denunciation + +let () = + register_error_kind + `Branch + ~id:"block.unrequired_denunciation" + ~title:"Unrequired denunciation" + ~description:"A denunciation is unrequired" + ~pp:(fun ppf _ -> + Format.fprintf + ppf + "A valid denunciation cannot be applied: the associated delegate has \ + already been denounced for this level.") + Data_encoding.unit + (function Unrequired_denunciation -> Some () | _ -> None) + (fun () -> Unrequired_denunciation) -let check_and_record_already_slashed_for_double_endorsing ctxt delegate - (level : Level_repr.t) = +let clear_outdated_slashed_deposits ctxt ~new_cycle = + let max_slashable_period = Constants_storage.max_slashing_period ctxt in + match Cycle_repr.(sub new_cycle max_slashable_period) with + | None -> Lwt.return ctxt + | Some outdated_cycle -> Storage.Slashed_deposits.clear (ctxt, outdated_cycle) + +let punish_double_endorsing ctxt delegate (level : Level_repr.t) = let open Lwt_tzresult_syntax in let* slashed = Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate) in - let already_slashed, updated_slashed = + let* updated_slashed = match slashed with | None -> - (false, {Storage.for_double_endorsing = true; for_double_baking = false}) + return {Storage.for_double_endorsing = true; for_double_baking = false} | Some slashed -> - ( slashed.for_double_endorsing, - {slashed with for_double_endorsing = true} ) - in - let*! ctxt = - Storage.Slashed_deposits.add - (ctxt, level.cycle) - (level.level, delegate) - updated_slashed + let* () = + fail_when slashed.for_double_endorsing Unrequired_denunciation + in + return {slashed with for_double_endorsing = true} in - return (ctxt, already_slashed) - -let clear_outdated_slashed_deposits ctxt ~new_cycle = - let max_slashable_period = Constants_storage.max_slashing_period ctxt in - match Cycle_repr.(sub new_cycle max_slashable_period) with - | None -> Lwt.return ctxt - | Some outdated_cycle -> Storage.Slashed_deposits.clear (ctxt, outdated_cycle) - -let punish_double_endorsing ctxt delegate = let delegate_contract = Contract_repr.Implicit delegate in - Frozen_deposits_storage.get ctxt delegate_contract >>=? fun frozen_deposits -> + let* frozen_deposits = Frozen_deposits_storage.get ctxt delegate_contract in let slashing_ratio : Ratio_repr.t = Constants_storage.ratio_of_frozen_deposits_slashed_per_double_endorsement ctxt @@ -94,29 +82,55 @@ let punish_double_endorsing ctxt delegate = let amount_to_burn = Tez_repr.(min frozen_deposits.current_amount punish_value) in - Token.transfer - ctxt - (`Frozen_deposits delegate) - `Double_signing_punishments - amount_to_burn - >>=? fun (ctxt, balance_updates) -> - Stake_storage.remove_stake ctxt delegate amount_to_burn >>=? fun ctxt -> + let* ctxt, balance_updates = + Token.transfer + ctxt + (`Frozen_deposits delegate) + `Double_signing_punishments + amount_to_burn + in + let* ctxt = Stake_storage.remove_stake ctxt delegate amount_to_burn in + let*! ctxt = + Storage.Slashed_deposits.add + (ctxt, level.cycle) + (level.level, delegate) + updated_slashed + in return (ctxt, amount_to_burn, balance_updates) -let punish_double_baking ctxt delegate = +let punish_double_baking ctxt delegate (level : Level_repr.t) = + let open Lwt_tzresult_syntax in + let* slashed = + Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate) + in + let* updated_slashed = + match slashed with + | None -> + return {Storage.for_double_baking = true; for_double_endorsing = false} + | Some slashed -> + let* () = fail_when slashed.for_double_baking Unrequired_denunciation in + return {slashed with for_double_baking = true} + in let delegate_contract = Contract_repr.Implicit delegate in - Frozen_deposits_storage.get ctxt delegate_contract >>=? fun frozen_deposits -> + let* frozen_deposits = Frozen_deposits_storage.get ctxt delegate_contract in let slashing_for_one_block = Constants_storage.double_baking_punishment ctxt in let amount_to_burn = Tez_repr.(min frozen_deposits.current_amount slashing_for_one_block) in - Token.transfer - ctxt - (`Frozen_deposits delegate) - `Double_signing_punishments - amount_to_burn - >>=? fun (ctxt, balance_updates) -> - Stake_storage.remove_stake ctxt delegate amount_to_burn >>=? fun ctxt -> + let* ctxt, balance_updates = + Token.transfer + ctxt + (`Frozen_deposits delegate) + `Double_signing_punishments + amount_to_burn + in + let* ctxt = Stake_storage.remove_stake ctxt delegate amount_to_burn in + let*! ctxt = + Storage.Slashed_deposits.add + (ctxt, level.cycle) + (level.level, delegate) + updated_slashed + in return (ctxt, amount_to_burn, balance_updates) diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli index 474456f6c49d..189a37d29011 100644 --- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli +++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli @@ -25,37 +25,35 @@ (* *) (*****************************************************************************) -(** Burn some frozen deposit for a delegate at a given level. Returns - the burned amount. *) -val punish_double_endorsing : - Raw_context.t -> - Signature.Public_key_hash.t -> - (Raw_context.t * Tez_repr.t * Receipt_repr.balance_updates) tzresult Lwt.t +type error += Unrequired_denunciation -val punish_double_baking : - Raw_context.t -> - Signature.Public_key_hash.t -> - (Raw_context.t * Tez_repr.t * Receipt_repr.balance_updates) tzresult Lwt.t +(** Burn some frozen deposit for a delegate at a given level and + record in the context that the given delegate has now been slashed + for double endorsing for the given level. + + Returns the burned amount. -(** Returns true if the given delegate has already been slashed - for double baking for the given level, and record in the context - that the given delegate has now been slashed for double baking - for the given level. *) -val check_and_record_already_slashed_for_double_baking : + Fails with [Unrequired_denunciation] if the given delegate has + already been slashed for double endorsing for the given level. *) +val punish_double_endorsing : Raw_context.t -> Signature.Public_key_hash.t -> Level_repr.t -> - (Raw_context.t * bool) tzresult Lwt.t + (Raw_context.t * Tez_repr.t * Receipt_repr.balance_updates) tzresult Lwt.t -(** Returns true if the given delegate has already been slashed for - double preendorsing or double endorsing for the given level, and +(** Burn some frozen deposit for a delegate at a given level and record in the context that the given delegate has now been slashed - for double preendorsing or double endorsing for the given level. *) -val check_and_record_already_slashed_for_double_endorsing : + for double baking for the given level. + + Returns the burned amount. + + Fails with [Unrequired_denunciation] if the given delegate has + already been slashed for double baking for the given level. *) +val punish_double_baking : Raw_context.t -> Signature.Public_key_hash.t -> Level_repr.t -> - (Raw_context.t * bool) tzresult Lwt.t + (Raw_context.t * Tez_repr.t * Receipt_repr.balance_updates) tzresult Lwt.t val clear_outdated_slashed_deposits : Raw_context.t -> new_cycle:Cycle_repr.t -> Raw_context.t Lwt.t -- GitLab From ae17bf452374c6e6049215f810333956966fc014 Mon Sep 17 00:00:00 2001 From: Eugen Zalinescu Date: Thu, 2 Jun 2022 12:59:20 +0200 Subject: [PATCH 19/23] Proto: add doc strings to delegate-related modules --- .../contract_delegate_storage.mli | 3 +++ .../delegate_activation_storage.mli | 11 ++++++----- .../delegate_missed_endorsements_storage.ml | 4 ---- .../delegate_missed_endorsements_storage.mli | 5 +++++ .../lib_protocol/delegate_sampler.ml | 7 ------- .../lib_protocol/delegate_sampler.mli | 10 ++++++++++ .../delegate_slashed_deposits_storage.ml | 4 ---- .../delegate_slashed_deposits_storage.mli | 4 ++++ .../lib_protocol/delegate_storage.ml | 16 ---------------- .../lib_protocol/delegate_storage.mli | 19 +++++++++++++++++++ .../lib_protocol/stake_storage.mli | 12 ++++++++++-- 11 files changed, 57 insertions(+), 38 deletions(-) diff --git a/src/proto_alpha/lib_protocol/contract_delegate_storage.mli b/src/proto_alpha/lib_protocol/contract_delegate_storage.mli index 7fe992903bc0..a0c97c1c5349 100644 --- a/src/proto_alpha/lib_protocol/contract_delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/contract_delegate_storage.mli @@ -23,6 +23,9 @@ (* *) (*****************************************************************************) +(** This module deals with the delegates of a contract. It is responsible for + maintaining the table {!Storage.Contract.Delegate}. *) + (** [find ctxt contract] returns the delegate associated to [contract], or [None] if [contract] has no delegate. *) val find : diff --git a/src/proto_alpha/lib_protocol/delegate_activation_storage.mli b/src/proto_alpha/lib_protocol/delegate_activation_storage.mli index 9f5f0e47969a..911bf6c30b08 100644 --- a/src/proto_alpha/lib_protocol/delegate_activation_storage.mli +++ b/src/proto_alpha/lib_protocol/delegate_activation_storage.mli @@ -23,12 +23,13 @@ (* *) (*****************************************************************************) -(** This module provides functions related to delegates' activity. +(** This module deals with delegates' activity. Typically, the provided + functions can be used to deactivate a delegate that has not shown activity + for a certain number of cycles, and to reactivate it when appropriate. - Typically, they can be used to deactivate a delegate that has not shown - activity for a certain number of cycles, and to reactivate it when - appropriate. -*) + This module is responsible for maintaining the following tables: + - {!Storage.Contract.Inactive_delegate} + - {!Storage.Contract.Delegate_last_cycle_before_deactivation} *) val is_inactive : Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml index 7869cfca16ec..96d22c2888cd 100644 --- a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml @@ -25,10 +25,6 @@ (* *) (*****************************************************************************) -(** This module is responsible for: - - [Storage.Contract.Missed_endorsements] -*) - let expected_slots_for_given_active_stake ctxt ~total_active_stake ~active_stake = let blocks_per_cycle = diff --git a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli index d2267d33a6a3..03ce915c9fd7 100644 --- a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli +++ b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli @@ -25,6 +25,11 @@ (* *) (*****************************************************************************) +(** This modules deals with delegates' participation in consensus. + + This module is responsible for maintaining the + {!Storage.Contract.Missed_endorsements} table. *) + val expected_slots_for_given_active_stake : Raw_context.t -> total_active_stake:Tez_repr.tez -> diff --git a/src/proto_alpha/lib_protocol/delegate_sampler.ml b/src/proto_alpha/lib_protocol/delegate_sampler.ml index 9d5af86363fd..71b837b7ef60 100644 --- a/src/proto_alpha/lib_protocol/delegate_sampler.ml +++ b/src/proto_alpha/lib_protocol/delegate_sampler.ml @@ -25,13 +25,6 @@ (* *) (*****************************************************************************) -(** This module is responsible for: - - [Storage.Seed.For_cycle] - - And the submodule `Delegate_sampler_state` is responsible for: - - [Storage.Delegate_sampler_state] -*) - module Delegate_sampler_state = struct module Cache_client = struct type cached_value = diff --git a/src/proto_alpha/lib_protocol/delegate_sampler.mli b/src/proto_alpha/lib_protocol/delegate_sampler.mli index 194c5a50468b..cf4cf8dc6bd9 100644 --- a/src/proto_alpha/lib_protocol/delegate_sampler.mli +++ b/src/proto_alpha/lib_protocol/delegate_sampler.mli @@ -25,6 +25,16 @@ (* *) (*****************************************************************************) +(** This module draws random values for a cycle based on the {!Seed_repr.seed} + associated that cycle. These random values are: + - delegates associated with slots + - snapshot indexes. + The selection of delegates is done by {i sampling} from a particular + distribution of the stake among the active delegates. + + This module is responsible for maintaining the tables + {!Storage.Delegate_sampler_state} and {!Storage.Seed.For_cycle}. *) + (** Participation slots potentially associated to accounts. The accounts that didn't place a deposit will be excluded from this list. This function should only be used to compute the deposits to diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml index a67b302e57ba..3601db429048 100644 --- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml @@ -25,10 +25,6 @@ (* *) (*****************************************************************************) -(** This module is responsible for: - - [Storage.Slashed_deposits] -*) - type error += Unrequired_denunciation let () = diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli index 189a37d29011..236be3438db2 100644 --- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli +++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli @@ -25,6 +25,10 @@ (* *) (*****************************************************************************) +(** This module maintains the storage related to slashing of delegates for + double signing. In particular, it is responsible for maintaining the + {!Storage.Slashed_deposits} table. *) + type error += Unrequired_denunciation (** Burn some frozen deposit for a delegate at a given level and diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml index daa8c60c0a06..41a367cbbf5c 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_storage.ml @@ -25,17 +25,6 @@ (* *) (*****************************************************************************) -(** This is module regroups everything related to delegate registration - (see the invariant maintained by the submodule `Contract`. - - It also regroups "trivial" getter/setter related to delegates. - - It is responsible for: - - [Storage.Contract.Frozen_deposits_limit] - - [Storage.Delegates] - -*) - type error += (* `Temporary *) Not_registered of Signature.Public_key_hash.t let () = @@ -109,11 +98,6 @@ let full_balance ctxt delegate = Lwt.return Tez_repr.(frozen_deposits.current_amount +? balance_and_frozen_bonds) -(** This module ensures the following invariants: - - registered delegates are self-delegated and appears in `Storage.Delegate`, - i.e. registered delegate cannot change their delegation - - stake is properly moved when changing delegation. -*) module Contract = struct type error += | (* `Permanent *) Unregistered_delegate of Signature.Public_key_hash.t diff --git a/src/proto_alpha/lib_protocol/delegate_storage.mli b/src/proto_alpha/lib_protocol/delegate_storage.mli index 8096594f8fab..42db919d947e 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/delegate_storage.mli @@ -25,6 +25,16 @@ (* *) (*****************************************************************************) +(** This module groups everything related to delegate registration. + For the invariants maintained, see the submodule {!Contract}. + + It also groups "trivial" getters/setters related to delegates. + + It is responsible for maintaining the following tables: + - {!Storage.Contract.Frozen_deposits_limit} + - {!Storage.Delegates} +*) + type error += (* `Temporary *) Not_registered of Signature.Public_key_hash.t (** Has a delegate been registered in the delegate table? *) @@ -85,6 +95,13 @@ val delegated_balance : val full_balance : Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t +(** This module ensures the following invariants: + - registered delegates (i.e. those that appear in {!Storage.Delegates}) are + self-delegated (i.e. {!Contract_delegate_storage.find} [delegate] returns [delegate]), + - registered delegates have their public keys revealed, + - registered delegates cannot change their delegation, + - stake is properly moved when changing delegation. +*) module Contract : sig type error += | (* `Permanent *) Unregistered_delegate of Signature.Public_key_hash.t @@ -123,6 +140,8 @@ module Contract : sig Raw_context.t tzresult Lwt.t end +(** Returns the public key of a registered delegate. Returns the error + {!Contract.Unregistered_delegate} if the delegate is not registered. *) val pubkey : Raw_context.t -> Signature.Public_key_hash.t -> diff --git a/src/proto_alpha/lib_protocol/stake_storage.mli b/src/proto_alpha/lib_protocol/stake_storage.mli index e41693973461..49774f23d3aa 100644 --- a/src/proto_alpha/lib_protocol/stake_storage.mli +++ b/src/proto_alpha/lib_protocol/stake_storage.mli @@ -23,8 +23,16 @@ (* *) (*****************************************************************************) -(** This library provides basic operations (accessors and setters) on - staking tokens. *) +(** This module provides basic operations (accessors and setters) on + staking tokens. + + It is responsible for maintaining the following tables: + - {!Storage.Stake.Selected_distribution_for_cycle} + - {!Storage.Stake.Staking_balance} + - {!Storage.Stake.Active_delegate_with_one_roll} + - {!Storage.Stake.Last_snapshot} + - {!Storage.Total_active_stake} +*) val remove_stake : Raw_context.t -> -- GitLab From 72211aec5716eaf611eaca88f8790e26989ad706 Mon Sep 17 00:00:00 2001 From: Eugen Zalinescu Date: Thu, 2 Jun 2022 13:08:38 +0200 Subject: [PATCH 20/23] Proto: move Total_active_stake into Stake for consistency --- src/proto_alpha/lib_protocol/stake_storage.ml | 6 +++--- src/proto_alpha/lib_protocol/stake_storage.mli | 2 +- src/proto_alpha/lib_protocol/storage.ml | 2 +- src/proto_alpha/lib_protocol/storage.mli | 14 +++++++------- 4 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/proto_alpha/lib_protocol/stake_storage.ml b/src/proto_alpha/lib_protocol/stake_storage.ml index c668430b87bd..ec4442592ac5 100644 --- a/src/proto_alpha/lib_protocol/stake_storage.ml +++ b/src/proto_alpha/lib_protocol/stake_storage.ml @@ -134,14 +134,14 @@ let max_snapshot_index = Storage.Stake.Last_snapshot.get let set_selected_distribution_for_cycle ctxt cycle stakes total_stake = let stakes = List.sort (fun (_, x) (_, y) -> Tez_repr.compare y x) stakes in Selected_distribution_for_cycle.init ctxt cycle stakes >>=? fun ctxt -> - Storage.Total_active_stake.add ctxt cycle total_stake >>= fun ctxt -> + Storage.Stake.Total_active_stake.add ctxt cycle total_stake >>= fun ctxt -> (* cleanup snapshots *) Storage.Stake.Staking_balance.Snapshot.clear ctxt >>= fun ctxt -> Storage.Stake.Active_delegate_with_one_roll.Snapshot.clear ctxt >>= fun ctxt -> Storage.Stake.Last_snapshot.update ctxt 0 let clear_cycle ctxt cycle = - Storage.Total_active_stake.remove_existing ctxt cycle >>=? fun ctxt -> + Storage.Stake.Total_active_stake.remove_existing ctxt cycle >>=? fun ctxt -> Selected_distribution_for_cycle.remove_existing ctxt cycle let fold ctxt ~f ~order init = @@ -197,7 +197,7 @@ let prepare_stake_distribution ctxt = ctxt stake_distribution) -let get_total_active_stake = Storage.Total_active_stake.get +let get_total_active_stake = Storage.Stake.Total_active_stake.get let remove_contract_stake ctxt contract amount = Contract_delegate_storage.find ctxt contract >>=? function diff --git a/src/proto_alpha/lib_protocol/stake_storage.mli b/src/proto_alpha/lib_protocol/stake_storage.mli index 49774f23d3aa..aad1f9dfdc29 100644 --- a/src/proto_alpha/lib_protocol/stake_storage.mli +++ b/src/proto_alpha/lib_protocol/stake_storage.mli @@ -31,7 +31,7 @@ - {!Storage.Stake.Staking_balance} - {!Storage.Stake.Active_delegate_with_one_roll} - {!Storage.Stake.Last_snapshot} - - {!Storage.Total_active_stake} + - {!Storage.Stake.Total_active_stake} *) val remove_stake : diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml index 064797d6476b..bf5fa2e5f3ee 100644 --- a/src/proto_alpha/lib_protocol/storage.ml +++ b/src/proto_alpha/lib_protocol/storage.ml @@ -1063,6 +1063,7 @@ module Stake = struct end) module Selected_distribution_for_cycle = Cycle.Selected_stake_distribution + module Total_active_stake = Cycle.Total_active_stake (* This is an index that is set to 0 by calls to {!val:Stake_storage.selected_new_distribution_at_cycle_end} and incremented @@ -1088,7 +1089,6 @@ module Stake = struct (Encoding.UInt16) end -module Total_active_stake = Cycle.Total_active_stake module Delegate_sampler_state = Cycle.Delegate_sampler_state (** Votes *) diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli index 9fd408a5e7bb..675c2f585730 100644 --- a/src/proto_alpha/lib_protocol/storage.mli +++ b/src/proto_alpha/lib_protocol/storage.mli @@ -383,14 +383,14 @@ module Stake : sig with type key = Cycle_repr.t and type value = (Signature.Public_key_hash.t * Tez_repr.t) list and type t := Raw_context.t -end -(** Sum of the active stakes of all the delegates with rolls *) -module Total_active_stake : - Indexed_data_storage - with type key = Cycle_repr.t - and type value = Tez_repr.t - and type t := Raw_context.t + (** Sum of the active stakes of all the delegates with rolls *) + module Total_active_stake : + Indexed_data_storage + with type key = Cycle_repr.t + and type value = Tez_repr.t + and type t := Raw_context.t +end (** State of the sampler used to select delegates. Managed synchronously with [Stake.Selected_distribution_for_cycle]. *) -- GitLab From be52de4bf2c5109773e4a8dc458e09ad1dd8adbd Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Mon, 27 Jun 2022 14:56:59 +0200 Subject: [PATCH 21/23] Proto: access seeds only through Seed_storage --- .../lib_protocol/delegate_sampler.ml | 9 ++++---- .../lib_protocol/delegate_sampler.mli | 4 ++-- src/proto_alpha/lib_protocol/seed_storage.ml | 9 +++++--- src/proto_alpha/lib_protocol/seed_storage.mli | 22 ++++++++++++++++--- 4 files changed, 31 insertions(+), 13 deletions(-) diff --git a/src/proto_alpha/lib_protocol/delegate_sampler.ml b/src/proto_alpha/lib_protocol/delegate_sampler.ml index 71b837b7ef60..a6c07992cef7 100644 --- a/src/proto_alpha/lib_protocol/delegate_sampler.ml +++ b/src/proto_alpha/lib_protocol/delegate_sampler.ml @@ -118,7 +118,7 @@ module Random = struct [Raw_context.set_sampler_for_cycle]. *) let sampler_for_cycle ctxt cycle = let read ctxt = - Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed -> + Seed_storage.raw_for_cycle ctxt cycle >>=? fun seed -> Delegate_sampler_state.get ctxt cycle >>=? fun state -> return (seed, state) in @@ -199,12 +199,12 @@ let compute_snapshot_index_for_seed ~max_snapshot_index seed = |> fst |> Int32.to_int |> return let compute_snapshot_index ctxt cycle ~max_snapshot_index = - Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed -> + Seed_storage.raw_for_cycle ctxt cycle >>=? fun seed -> compute_snapshot_index_for_seed ~max_snapshot_index seed let select_distribution_for_cycle ctxt cycle = Stake_storage.max_snapshot_index ctxt >>=? fun max_snapshot_index -> - Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed -> + Seed_storage.raw_for_cycle ctxt cycle >>=? fun seed -> compute_snapshot_index_for_seed ~max_snapshot_index seed >>=? fun selected_index -> get_stakes_for_selected_index ctxt selected_index @@ -238,5 +238,4 @@ let clear_outdated_sampling_data ctxt ~new_cycle = | None -> return ctxt | Some outdated_cycle -> Delegate_sampler_state.remove_existing ctxt outdated_cycle - >>=? fun ctxt -> - Storage.Seed.For_cycle.remove_existing ctxt outdated_cycle + >>=? fun ctxt -> Seed_storage.remove_for_cycle ctxt outdated_cycle diff --git a/src/proto_alpha/lib_protocol/delegate_sampler.mli b/src/proto_alpha/lib_protocol/delegate_sampler.mli index cf4cf8dc6bd9..b011b056c2b6 100644 --- a/src/proto_alpha/lib_protocol/delegate_sampler.mli +++ b/src/proto_alpha/lib_protocol/delegate_sampler.mli @@ -32,8 +32,8 @@ The selection of delegates is done by {i sampling} from a particular distribution of the stake among the active delegates. - This module is responsible for maintaining the tables - {!Storage.Delegate_sampler_state} and {!Storage.Seed.For_cycle}. *) + This module is responsible for maintaining the table + {!Storage.Delegate_sampler_state}. *) (** Participation slots potentially associated to accounts. The accounts that didn't place a deposit will be excluded from this diff --git a/src/proto_alpha/lib_protocol/seed_storage.ml b/src/proto_alpha/lib_protocol/seed_storage.ml index 99d6396575a7..79b64c6261a7 100644 --- a/src/proto_alpha/lib_protocol/seed_storage.ml +++ b/src/proto_alpha/lib_protocol/seed_storage.ml @@ -34,7 +34,8 @@ type seed_computation_status = | Computation_finished type error += - | Unknown of { + | (* `Permanent *) + Unknown of { oldest : Cycle_repr.t; cycle : Cycle_repr.t; latest : Cycle_repr.t; @@ -43,8 +44,6 @@ type error += | Unverified_vdf | Too_early_revelation -(* `Permanent *) - let () = register_error_kind `Permanent @@ -208,6 +207,8 @@ let check_vdf_and_update_seed ctxt vdf_solution = let cycle_computed = Cycle_repr.add current_cycle (preserved + 1) in Storage.Seed.For_cycle.update ctxt cycle_computed new_seed Seed_repr.VDF_seed +let raw_for_cycle = Storage.Seed.For_cycle.get + let for_cycle ctxt cycle = let preserved = Constants_storage.preserved_cycles ctxt in let current_cycle = (Level_storage.current ctxt).cycle in @@ -248,3 +249,5 @@ let cycle_end ctxt last_cycle = | Some previous_cycle -> (* cycle with revelations *) purge_nonces_and_get_unrevealed ctxt ~cycle:previous_cycle + +let remove_for_cycle = Storage.Seed.For_cycle.remove_existing diff --git a/src/proto_alpha/lib_protocol/seed_storage.mli b/src/proto_alpha/lib_protocol/seed_storage.mli index 8942a010c9fc..75e050c302a3 100644 --- a/src/proto_alpha/lib_protocol/seed_storage.mli +++ b/src/proto_alpha/lib_protocol/seed_storage.mli @@ -23,6 +23,11 @@ (* *) (*****************************************************************************) +(** This modules handles the storage of random nonce seeds. + + This module is responsible for maintaining the table + {!Storage.Seed.For_cycle}. *) + type seed_computation_status = | Nonce_revelation_stage | Vdf_revelation_stage of { @@ -32,7 +37,8 @@ type seed_computation_status = | Computation_finished type error += - | Unknown of { + | (* `Permanent *) + Unknown of { oldest : Cycle_repr.t; cycle : Cycle_repr.t; latest : Cycle_repr.t; @@ -41,8 +47,6 @@ type error += | Unverified_vdf | Too_early_revelation -(* `Permanent *) - (** Generates the first [preserved_cycles+2] seeds for which there are no nonces. *) val init : @@ -53,6 +57,13 @@ val init : val check_vdf_and_update_seed : Raw_context.t -> Seed_repr.vdf_solution -> Raw_context.t tzresult Lwt.t +(** Returns the seed associated with the given cycle. Returns a generic storage + error when the seed is not available. *) +val raw_for_cycle : + Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t + +(** Returns the seed associated with the given cycle. Returns the {!Unknown} + error when the seed is not available. *) val for_cycle : Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t (** Computes RANDAO output for cycle #(current_cycle + preserved + 1) *) @@ -71,3 +82,8 @@ val cycle_end : finished for the current cycle. *) val get_seed_computation_status : Raw_context.t -> seed_computation_status tzresult Lwt.t + +(** Removes the seed associated with the given cycle from the storage. It + assumes the seed exists. If it does not it returns a generic storage error. *) +val remove_for_cycle : + Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t -- GitLab From f544650e909839bcebe3a6ff09d6ceb90e5026dd Mon Sep 17 00:00:00 2001 From: Eugen Zalinescu Date: Fri, 3 Jun 2022 14:59:27 +0200 Subject: [PATCH 22/23] Proto: move Not_registered error to Delegate_services --- .../client_proto_context_commands.ml | 6 ++- .../lib_protocol/alpha_context.mli | 2 - .../lib_protocol/delegate_services.ml | 54 ++++++++++++++----- .../lib_protocol/delegate_services.mli | 2 + .../lib_protocol/delegate_storage.ml | 28 ---------- .../lib_protocol/delegate_storage.mli | 6 --- 6 files changed, 47 insertions(+), 51 deletions(-) diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml index e85d61855e29..96c98d8b2ed6 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml @@ -1532,7 +1532,8 @@ let commands_rw () = >>= function | Ok voting_power -> return (voting_power <> 0L) | Error - (Environment.Ecoproto_error (Delegate_storage.Not_registered _) + (Environment.Ecoproto_error + (Delegate_services.Not_registered _) :: _) -> return false | Error _ as err -> Lwt.return err) @@ -1725,7 +1726,8 @@ let commands_rw () = >>= function | Ok voting_power -> return (voting_power <> 0L) | Error - (Environment.Ecoproto_error (Delegate_storage.Not_registered _) + (Environment.Ecoproto_error + (Delegate_services.Not_registered _) :: _) -> return false | Error _ as err -> Lwt.return err) diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 25575afeebeb..5b128e448c0f 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -2411,8 +2411,6 @@ module Delegate : sig val list : context -> public_key_hash list Lwt.t - val check_registered : context -> public_key_hash -> unit tzresult Lwt.t - type participation_info = { expected_cycle_activity : int; minimal_cycle_activity : int; diff --git a/src/proto_alpha/lib_protocol/delegate_services.ml b/src/proto_alpha/lib_protocol/delegate_services.ml index f05ee611020b..306c91216444 100644 --- a/src/proto_alpha/lib_protocol/delegate_services.ml +++ b/src/proto_alpha/lib_protocol/delegate_services.ml @@ -29,6 +29,29 @@ open Alpha_context type error += Balance_rpc_non_delegate of public_key_hash +type error += (* `Temporary *) Not_registered of Signature.Public_key_hash.t + +let () = + register_error_kind + `Temporary + ~id:"delegate.not_registered" + ~title:"Not a registered delegate" + ~description: + "The provided public key hash is not the address of a registered \ + delegate." + ~pp:(fun ppf pkh -> + Format.fprintf + ppf + "The provided public key hash (%a) is not the address of a registered \ + delegate. If you own this account and want to register it as a \ + delegate, use a delegation operation to delegate the account to \ + itself." + Signature.Public_key_hash.pp + pkh) + Data_encoding.(obj1 (req "pkh" Signature.Public_key_hash.encoding)) + (function Not_registered pkh -> Some pkh | _ -> None) + (fun pkh -> Not_registered pkh) + let () = register_error_kind `Temporary @@ -332,6 +355,11 @@ module S = struct RPC_path.(path / "participation") end +let check_delegate_registered ctxt pkh = + Delegate.registered ctxt pkh >>= function + | true -> return_unit + | false -> fail (Not_registered pkh) + let register () = let open Services_registration in register0 ~chunked:true S.list_delegate (fun ctxt q () -> @@ -366,7 +394,7 @@ let register () = | {with_minimal_stake = false; without_minimal_stake = false; _} -> return delegates) ; register1 ~chunked:false S.info (fun ctxt pkh () () -> - Delegate.check_registered ctxt pkh >>=? fun () -> + check_delegate_registered ctxt pkh >>=? fun () -> Delegate.full_balance ctxt pkh >>=? fun full_balance -> Delegate.frozen_deposits ctxt pkh >>=? fun frozen_deposits -> Delegate.staking_balance ctxt pkh >>=? fun staking_balance -> @@ -389,42 +417,42 @@ let register () = voting_info; }) ; register1 ~chunked:false S.full_balance (fun ctxt pkh () () -> - trace (Balance_rpc_non_delegate pkh) (Delegate.check_registered ctxt pkh) + trace (Balance_rpc_non_delegate pkh) (check_delegate_registered ctxt pkh) >>=? fun () -> Delegate.full_balance ctxt pkh) ; register1 ~chunked:false S.current_frozen_deposits (fun ctxt pkh () () -> - Delegate.check_registered ctxt pkh >>=? fun () -> + check_delegate_registered ctxt pkh >>=? fun () -> Delegate.frozen_deposits ctxt pkh >>=? fun deposits -> return deposits.current_amount) ; register1 ~chunked:false S.frozen_deposits (fun ctxt pkh () () -> - Delegate.check_registered ctxt pkh >>=? fun () -> + check_delegate_registered ctxt pkh >>=? fun () -> Delegate.frozen_deposits ctxt pkh >>=? fun deposits -> return deposits.initial_amount) ; register1 ~chunked:false S.staking_balance (fun ctxt pkh () () -> - Delegate.check_registered ctxt pkh >>=? fun () -> + check_delegate_registered ctxt pkh >>=? fun () -> Delegate.staking_balance ctxt pkh) ; register1 ~chunked:false S.frozen_deposits_limit (fun ctxt pkh () () -> - Delegate.check_registered ctxt pkh >>=? fun () -> + check_delegate_registered ctxt pkh >>=? fun () -> Delegate.frozen_deposits_limit ctxt pkh) ; register1 ~chunked:true S.delegated_contracts (fun ctxt pkh () () -> - Delegate.check_registered ctxt pkh >>=? fun () -> + check_delegate_registered ctxt pkh >>=? fun () -> Delegate.delegated_contracts ctxt pkh >|= ok) ; register1 ~chunked:false S.delegated_balance (fun ctxt pkh () () -> - Delegate.check_registered ctxt pkh >>=? fun () -> + check_delegate_registered ctxt pkh >>=? fun () -> Delegate.delegated_balance ctxt pkh) ; register1 ~chunked:false S.deactivated (fun ctxt pkh () () -> - Delegate.check_registered ctxt pkh >>=? fun () -> + check_delegate_registered ctxt pkh >>=? fun () -> Delegate.deactivated ctxt pkh) ; register1 ~chunked:false S.grace_period (fun ctxt pkh () () -> - Delegate.check_registered ctxt pkh >>=? fun () -> + check_delegate_registered ctxt pkh >>=? fun () -> Delegate.last_cycle_before_deactivation ctxt pkh) ; register1 ~chunked:false S.voting_power (fun ctxt pkh () () -> - Delegate.check_registered ctxt pkh >>=? fun () -> + check_delegate_registered ctxt pkh >>=? fun () -> Vote.get_voting_power_free ctxt pkh) ; register1 ~chunked:false S.voting_info (fun ctxt pkh () () -> - Delegate.check_registered ctxt pkh >>=? fun () -> + check_delegate_registered ctxt pkh >>=? fun () -> Vote.get_delegate_info ctxt pkh) ; register1 ~chunked:false S.participation (fun ctxt pkh () () -> - Delegate.check_registered ctxt pkh >>=? fun () -> + check_delegate_registered ctxt pkh >>=? fun () -> Delegate.participation_info ctxt pkh) let list ctxt block ?(active = true) ?(inactive = false) diff --git a/src/proto_alpha/lib_protocol/delegate_services.mli b/src/proto_alpha/lib_protocol/delegate_services.mli index 8092f2c368cd..a5eda671e57d 100644 --- a/src/proto_alpha/lib_protocol/delegate_services.mli +++ b/src/proto_alpha/lib_protocol/delegate_services.mli @@ -31,6 +31,8 @@ open Alpha_context +type error += (* `Temporary *) Not_registered of Signature.Public_key_hash.t + val list : 'a #RPC_context.simple -> 'a -> diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml index 41a367cbbf5c..6d38d9350119 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_storage.ml @@ -25,36 +25,8 @@ (* *) (*****************************************************************************) -type error += (* `Temporary *) Not_registered of Signature.Public_key_hash.t - -let () = - register_error_kind - `Temporary - ~id:"delegate.not_registered" - ~title:"Not a registered delegate" - ~description: - "The provided public key hash is not the address of a registered \ - delegate." - ~pp:(fun ppf pkh -> - Format.fprintf - ppf - "The provided public key hash (%a) is not the address of a registered \ - delegate. If you own this account and want to register it as a \ - delegate, use a delegation operation to delegate the account to \ - itself." - Signature.Public_key_hash.pp - pkh) - Data_encoding.(obj1 (req "pkh" Signature.Public_key_hash.encoding)) - (function Not_registered pkh -> Some pkh | _ -> None) - (fun pkh -> Not_registered pkh) - let registered = Storage.Delegates.mem -let check_registered ctxt pkh = - registered ctxt pkh >>= function - | true -> return_unit - | false -> fail (Not_registered pkh) - let fold = Storage.Delegates.fold let list = Storage.Delegates.elements diff --git a/src/proto_alpha/lib_protocol/delegate_storage.mli b/src/proto_alpha/lib_protocol/delegate_storage.mli index 42db919d947e..262a49ce3f52 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/delegate_storage.mli @@ -35,15 +35,9 @@ - {!Storage.Delegates} *) -type error += (* `Temporary *) Not_registered of Signature.Public_key_hash.t - (** Has a delegate been registered in the delegate table? *) val registered : Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t -(** Check that a given implicit account is a registered delegate. *) -val check_registered : - Raw_context.t -> Signature.Public_key_hash.t -> unit tzresult Lwt.t - (** Iterate on all registered delegates. *) val fold : Raw_context.t -> -- GitLab From 0b704a5ad322f6a40df6d76e8b9abe9586fa7b66 Mon Sep 17 00:00:00 2001 From: "G.B. Fefe" Date: Fri, 3 Jun 2022 16:06:25 +0200 Subject: [PATCH 23/23] Proto: use a proper Permanent error for invalid ballot and proposals --- src/proto_alpha/lib_protocol/amendment.mli | 7 ++++ src/proto_alpha/lib_protocol/apply.ml | 42 ++++++++++++++++++++++ 2 files changed, 49 insertions(+) diff --git a/src/proto_alpha/lib_protocol/amendment.mli b/src/proto_alpha/lib_protocol/amendment.mli index 999de49ac79c..a52ad9a6b927 100644 --- a/src/proto_alpha/lib_protocol/amendment.mli +++ b/src/proto_alpha/lib_protocol/amendment.mli @@ -103,3 +103,10 @@ val record_ballot : Protocol_hash.t -> Vote.ballot -> context tzresult Lwt.t + +(** On testnets whose [chain_id] is not the one of Mainnet, this + function checks whether the provided [pkh] is the one of the + registered governance dictator, if any. + + On mainnet, it always returns false. *) +val is_governance_dictator : context -> Chain_id.t -> public_key_hash -> bool diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 7ec2d4839e93..debf18d19c2b 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -95,6 +95,8 @@ type error += | Set_deposits_limit_on_unregistered_delegate of Signature.Public_key_hash.t | Set_deposits_limit_too_high of {limit : Tez.t; max_limit : Tez.t} | Error_while_taking_fees + | Ballot_on_unregistered_delegate of Signature.Public_key_hash.t + | Proposals_on_unregistered_delegate of Signature.Public_key_hash.t | Empty_transaction of Contract.t | Tx_rollup_feature_disabled | Tx_rollup_invalid_transaction_ticket_amount @@ -446,6 +448,35 @@ let () = (function | Set_deposits_limit_on_unregistered_delegate c -> Some c | _ -> None) (fun c -> Set_deposits_limit_on_unregistered_delegate c) ; + register_error_kind + `Permanent + ~id:"operation.ballot_on_unregistered_delegate" + ~title:"Ballot with an unregistered delegate" + ~description:"Cannot cast a ballot with an unregistered delegate." + ~pp:(fun ppf c -> + Format.fprintf + ppf + "Cannot cast a ballot for public key hash %a (unregistered delegate)." + Signature.Public_key_hash.pp + c) + Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) + (function Ballot_on_unregistered_delegate c -> Some c | _ -> None) + (fun c -> Ballot_on_unregistered_delegate c) ; + register_error_kind + `Permanent + ~id:"operation.proposals_on_unregistered_delegate" + ~title:"Proposals with an unregistered delegate" + ~description:"Cannot submit proposals with an unregistered delegate." + ~pp:(fun ppf c -> + Format.fprintf + ppf + "Cannot submit proposals for public key hash %a (unregistered \ + delegate)." + Signature.Public_key_hash.pp + c) + Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) + (function Proposals_on_unregistered_delegate c -> Some c | _ -> None) + (fun c -> Proposals_on_unregistered_delegate c) ; register_error_kind `Permanent ~id:"operation.set_deposits_limit_too_high" @@ -2966,6 +2997,14 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) mode >>=? fun (ctxt, bupds) -> return (ctxt, Single_result (Activate_account_result bupds)) | Single (Proposals {source; period; proposals}) -> + Delegate.registered ctxt source >>= fun is_registered -> + let is_governance_dictator = + Amendment.is_governance_dictator ctxt chain_id source + in + error_unless + (is_registered || is_governance_dictator) + (Proposals_on_unregistered_delegate source) + >>?= fun () -> Delegate.pubkey ctxt source >>=? fun delegate -> Operation.check_signature delegate chain_id operation >>?= fun () -> Voting_period.get_current ctxt >>=? fun {index = current_period; _} -> @@ -2976,6 +3015,9 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) mode Amendment.record_proposals ctxt chain_id source proposals >|=? fun ctxt -> (ctxt, Single_result Proposals_result) | Single (Ballot {source; period; proposal; ballot}) -> + Delegate.registered ctxt source >>= fun is_registered -> + error_unless is_registered (Ballot_on_unregistered_delegate source) + >>?= fun () -> Delegate.pubkey ctxt source >>=? fun delegate -> Operation.check_signature delegate chain_id operation >>?= fun () -> Voting_period.get_current ctxt >>=? fun {index = current_period; _} -> -- GitLab