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 5f8605d61e5219f5db27108e18ca1abe108e42b5..6b38c0f94a26653f9156d4b4ce30402e7a0cb960 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 @@ -1734,7 +1734,7 @@ let commands_rw () = match r with | 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 @@ -1935,7 +1935,7 @@ let commands_rw () = match r with | 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_delegate/test/tenderbrute/lib/tenderbrute.ml b/src/proto_alpha/lib_delegate/test/tenderbrute/lib/tenderbrute.ml index a27b9381426c08b3f8d273bb3db89bef462f9f16..fa99d708a0a1bd7ed9ffc107f7efbcf63c12d552 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 1d09ad48c453f6e9f94e4192e364207815d51e3b..1d5c3f61c63db0c84b806714d6c6f4780f265ad4 100644 --- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL @@ -134,6 +134,10 @@ "Contract_storage", "Token", "Delegate_storage", + "Delegate_sampler", + "Delegate_missed_endorsements_storage", + "Delegate_slashed_deposits_storage", + "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 51df1bab87ced7e5af0a73f8e9d6d95b67a5b073..0d730ba4372a6bd28cc61772258090c027aa20f3 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -466,6 +466,9 @@ module Receipt = Receipt_repr module Delegate = struct include Delegate_storage + include Delegate_missed_endorsements_storage + include Delegate_slashed_deposits_storage + include Delegate_cycles type deposits = Storage.deposits = { initial_amount : Tez.t; @@ -487,15 +490,11 @@ 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 delegate_pubkey = Delegate.pubkey - - let get_staking_balance = Delegate.staking_balance + let slot_owner = Delegate_sampler.slot_owner 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 88985286259cbd086b1ab0d2ed13e81d12b6cb52..c430caa37d61aa669002a98a54b8272ebbac8019 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -2514,7 +2514,9 @@ module Receipt : sig val group_balance_updates : balance_updates -> balance_updates tzresult end -(** This module re-exports definitions from {!Delegate_storage}. *) +(** This module re-exports definitions from {!Delegate_storage}, + {!Delegate_missed_endorsements_storage}, + {!Delegate_slashed_deposits_storage}, {!Delegate_cycles}. *) module Delegate : sig val init : context -> @@ -2543,8 +2545,6 @@ module Delegate : sig val list : context -> public_key_hash list Lwt.t - val check_delegate : context -> public_key_hash -> unit tzresult Lwt.t - type participation_info = { expected_cycle_activity : int; minimal_cycle_activity : int; @@ -2554,7 +2554,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 : @@ -4510,13 +4510,6 @@ module Stake_distribution : sig Level.t -> 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 -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t end (** This module re-exports definitions from {!Commitment_repr} and, diff --git a/src/proto_alpha/lib_protocol/contract_delegate_storage.mli b/src/proto_alpha/lib_protocol/contract_delegate_storage.mli index 45a05ca408ca08e7fde512f1895c367a6a308929..ac62d6ecd423259ca153c08f7596a7c9f697c14f 100644 --- a/src/proto_alpha/lib_protocol/contract_delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/contract_delegate_storage.mli @@ -23,6 +23,10 @@ (* *) (*****************************************************************************) +(** This module deals with the delegates of a contract. It is + responsible for maintaining the tables {!Storage.Contract.Delegate} + and {!Storage.Contract.Delegated}. *) + (** [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 9f5f0e47969a3771355a3675b1462c3581fad6ba..911bf6c30b08035023d5ee78d24d7de876b0939d 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_cycles.ml b/src/proto_alpha/lib_protocol/delegate_cycles.ml new file mode 100644 index 0000000000000000000000000000000000000000..0a2dac5e6c7823e0cda08a4dac964bd385fcd2f0 --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_cycles.ml @@ -0,0 +1,280 @@ +(*****************************************************************************) +(* *) +(* 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_minimal_stake + 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 -> + (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 -> + Delegate_storage.spendable_balance ctxt delegate >>=? 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 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 + .check_and_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 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 -> + 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 ~origin = + 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) + >>=? 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 new file mode 100644 index 0000000000000000000000000000000000000000..7fb56220567c59efae60e2592c7368f4687808d5 --- /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. *) +(* *) +(*****************************************************************************) + +(** Per-cycle management of delegates. *) + +(** 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 ~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 -> + origin:Receipt_repr.update_origin -> + (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 0000000000000000000000000000000000000000..2d1ef3030d6bb43880a7a7a89ad25644ac687bcd --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.ml @@ -0,0 +1,214 @@ +(*****************************************************************************) +(* *) +(* 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 + 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 -> + 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 + 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) + +let check_and_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 -> + Storage.Contract.Missed_endorsements.remove ctxt contract >>= fun ctxt -> + return (ctxt, Compare.Int.(missed_endorsements.remaining_slots >= 0)) + +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 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 -> + 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 + 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; + } 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 0000000000000000000000000000000000000000..e3950661ddc18a3cd0d74dfe5a27a2e84b3fac8c --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli @@ -0,0 +1,99 @@ +(*****************************************************************************) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +(** 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.t -> + active_stake:Tez_repr.t -> + int + +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 + +(** Check that a delegate participated enough in the last cycle + (returns [true] if it did), and then reset the participation for + preparing the next cycle. *) +val check_and_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 *) +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 participation_info : + Raw_context.t -> + Signature.Public_key_hash.t -> + participation_info 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 0000000000000000000000000000000000000000..104bdd6312d1d49d8af0235a9e4fc05c464a71b2 --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_sampler.ml @@ -0,0 +1,240 @@ +(*****************************************************************************) +(* *) +(* 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.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 + +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 = + Seed_storage.for_cycle 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 = + Seed_storage.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 -> + 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 + >>=? 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 -> 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 new file mode 100644 index 0000000000000000000000000000000000000000..b011b056c2b64aa5b71b05251b7e16b3e975cdf6 --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_sampler.mli @@ -0,0 +1,75 @@ +(*****************************************************************************) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +(** 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 table + {!Storage.Delegate_sampler_state}. *) + +(** 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_services.ml b/src/proto_alpha/lib_protocol/delegate_services.ml index ea9b8f633256a6959f997133e946fabc895e135c..e8426d3dd35b8cab5563732f32e2b693ed5934d8 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_delegate 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,43 +417,43 @@ 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) (check_delegate_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 () -> + 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_delegate 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_delegate 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_delegate 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_delegate 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_delegate ctxt pkh >>=? fun () -> + check_delegate_registered ctxt pkh >>=? fun () -> Delegate.delegated_balance ctxt pkh) ; register1 ~chunked:false S.deactivated (fun ctxt pkh () () -> - Delegate.check_delegate ctxt pkh >>=? fun () -> + check_delegate_registered ctxt pkh >>=? fun () -> Delegate.deactivated ctxt pkh) ; register1 ~chunked:false S.grace_period (fun ctxt pkh () () -> - Delegate.check_delegate 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_delegate 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_delegate 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_delegate ctxt pkh >>=? fun () -> - Delegate.delegate_participation_info ctxt pkh) + check_delegate_registered ctxt pkh >>=? fun () -> + Delegate.participation_info ctxt pkh) let list ctxt block ?(active = true) ?(inactive = false) ?(with_minimal_stake = true) ?(without_minimal_stake = false) () = diff --git a/src/proto_alpha/lib_protocol/delegate_services.mli b/src/proto_alpha/lib_protocol/delegate_services.mli index 8092f2c368cd0652ae1c5bbb7076c0ba60b163e6..a5eda671e57decec2ab53a7638f5acbf1439dacc 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_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml new file mode 100644 index 0000000000000000000000000000000000000000..5215aed04e7a350f7a561d9e8a3e8a7bd0ececca --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml @@ -0,0 +1,123 @@ +(*****************************************************************************) +(* *) +(* 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 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 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 -> {Storage.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 + let delegate_contract = Contract_repr.Implicit delegate in + 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 + 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 + 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 (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 -> {Storage.for_double_baking = true; for_double_endorsing = false} + | Some slashed -> + assert (Compare.Bool.(slashed.for_double_baking = false)) ; + {slashed with for_double_baking = true} + in + let delegate_contract = Contract_repr.Implicit delegate in + 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 + 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 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) 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 0000000000000000000000000000000000000000..9dfb7c314b9282a4dca1bb6df9dcf083a0a2900d --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli @@ -0,0 +1,77 @@ +(*****************************************************************************) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +(** 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. *) + +(** 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 and + record in the context that the given delegate has now been slashed + for double endorsing for the given level. + + Returns the burned amount. + + 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 * 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 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 * 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 diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml index ade867a88a3f5bb29d8ab94e56430cd8972f4d8d..3399246a130c97d92ee1f087b9469cd42d3fb269 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"),*) @@ -30,13 +31,6 @@ type error += | (* `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 let () = register_error_kind @@ -105,70 +99,7 @@ let () = 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" - ~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) + (fun k -> Unregistered_delegate k) let set_inactive ctxt delegate = Delegate_activation_storage.set_inactive ctxt delegate >>= fun ctxt -> @@ -180,16 +111,7 @@ let set_active ctxt delegate = if not inactive then return ctxt else Stake_storage.activate_only_call_from_delegate_storage ctxt delegate -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 deactivated = Delegate_activation_storage.is_inactive let init ctxt contract delegate = Contract_manager_storage.is_manager_key_revealed ctxt delegate @@ -254,7 +176,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) @@ -270,6 +192,10 @@ let set c contract delegate = Storage.Delegates.add c delegate >>= fun c -> set_active c delegate else return c +let fold = Storage.Delegates.fold + +let list = Storage.Delegates.elements + let frozen_deposits_limit ctxt delegate = Storage.Contract.Frozen_deposits_limit.find ctxt @@ -281,413 +207,17 @@ let set_frozen_deposits_limit ctxt delegate limit = (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_minimal_stake - 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 = - Seed_storage.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 -> - 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 frozen_deposits ctxt delegate = + Frozen_deposits_storage.get ctxt (Contract_repr.Implicit delegate) -let balance ctxt delegate = +let spendable_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 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 full_balance ctxt delegate = frozen_deposits ctxt delegate >>=? fun frozen_deposits -> @@ -697,354 +227,13 @@ let full_balance ctxt delegate = 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 -> full_balance ctxt delegate >>=? 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 = - Seed_storage.for_cycle 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) +let pubkey ctxt delegate = + Contract_manager_storage.get_manager_key ctxt - Misc.(0 --> preserved) + delegate + ~error:(Unregistered_delegate delegate) diff --git a/src/proto_alpha/lib_protocol/delegate_storage.mli b/src/proto_alpha/lib_protocol/delegate_storage.mli index cba3a98d9746d652c2f235d4fcc5af48f36bf48d..78eadc0204a93579e178d132c306a57b86c65c64 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,40 +25,14 @@ (* *) (*****************************************************************************) -(** 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 +(** This module groups everything related to delegate registration. -val frozen_deposits_limit : - Raw_context.t -> - Signature.Public_key_hash.t -> - Tez_repr.t option tzresult Lwt.t + It also groups "trivial" getters/setters related to delegates. -val set_frozen_deposits_limit : - Raw_context.t -> - Signature.Public_key_hash.t -> - Tez_repr.t option -> - Raw_context.t Lwt.t + It is responsible for maintaining the following tables: + - {!Storage.Contract.Frozen_deposits_limit} + - {!Storage.Delegates} +*) type error += | (* `Permanent *) No_deletion of Signature.Public_key_hash.t @@ -65,50 +40,29 @@ type error += | (* `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 -(** Check that a given implicit account is a registered delegate. *) -val check_delegate : - Raw_context.t -> Signature.Public_key_hash.t -> unit tzresult Lwt.t +val set_active : + Raw_context.t -> Signature.Public_key_hash.t -> 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) *) -} +val set_inactive : + Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t -(** Only use this function for RPC: this is expensive. +val deactivated : + Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t - [delegate_participation_info] and [!val:check_delegate] forms the - implementation of RPC call "/context/delegates//participation". - *) -val delegate_participation_info : +(** Allow to register a delegate when creating an account. *) +val init : Raw_context.t -> + Contract_repr.t -> Signature.Public_key_hash.t -> - participation_info tzresult Lwt.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 (** Iterate on all registered delegates. *) val fold : @@ -121,85 +75,34 @@ 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 spendable_balance : + Raw_context.t -> Signature.public_key_hash -> Tez_repr.tez tzresult Lwt.t + +val staking_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 +114,13 @@ 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 : - Raw_context.t -> - Level_repr.t -> - Slot_repr.t -> - (Raw_context.t * (Signature.Public_key.t * Signature.Public_key_hash.t)) - 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 - -val freeze_deposits_do_not_call_except_for_migration : +(** 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 -> - new_cycle:Cycle_repr.t -> - balance_updates:Receipt_repr.balance_updates -> - (Raw_context.t * Receipt_repr.balance_updates) 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 - -(** [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 + Signature.Public_key_hash.t -> + Signature.Public_key.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/dune b/src/proto_alpha/lib_protocol/dune index 86b02d98edc415f06ddf247a655e57461a183ca1..b7bcc6fd8e912c6b5d6eb48f8137a5234da2f4ac 100644 --- a/src/proto_alpha/lib_protocol/dune +++ b/src/proto_alpha/lib_protocol/dune @@ -155,6 +155,10 @@ Contract_storage Token Delegate_storage + Delegate_sampler + Delegate_missed_endorsements_storage + Delegate_slashed_deposits_storage + Delegate_cycles Bootstrap_storage Vote_storage Fees_storage @@ -409,6 +413,11 @@ contract_storage.ml contract_storage.mli token.ml token.mli delegate_storage.ml delegate_storage.mli + delegate_sampler.ml delegate_sampler.mli + delegate_missed_endorsements_storage.ml + delegate_missed_endorsements_storage.mli + delegate_slashed_deposits_storage.ml delegate_slashed_deposits_storage.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 @@ -643,6 +652,11 @@ contract_storage.ml contract_storage.mli token.ml token.mli delegate_storage.ml delegate_storage.mli + delegate_sampler.ml delegate_sampler.mli + delegate_missed_endorsements_storage.ml + delegate_missed_endorsements_storage.mli + delegate_slashed_deposits_storage.ml delegate_slashed_deposits_storage.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 @@ -882,6 +896,11 @@ contract_storage.ml contract_storage.mli token.ml token.mli delegate_storage.ml delegate_storage.mli + delegate_sampler.ml delegate_sampler.mli + delegate_missed_endorsements_storage.ml + delegate_missed_endorsements_storage.mli + delegate_slashed_deposits_storage.ml delegate_slashed_deposits_storage.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/frozen_deposits_storage.mli b/src/proto_alpha/lib_protocol/frozen_deposits_storage.mli index f61954b9c2a5ffac6c0a0d63f069362e71a6c669..d59f705a3dedcb7c2183498d3442ddb1b5403d85 100644 --- a/src/proto_alpha/lib_protocol/frozen_deposits_storage.mli +++ b/src/proto_alpha/lib_protocol/frozen_deposits_storage.mli @@ -23,7 +23,10 @@ (* *) (*****************************************************************************) -(** Simple abstraction from low-level storage to handle frozen deposits *) +(** Simple abstraction from low-level storage to handle frozen deposits. + + This module is responsible for maintaining the + {!Storage.Contract.Frozen_deposits} table. *) (** [init ctxt delegate] returns a new context from [ctxt] where the frozen deposits of the implicit contract represented by [delegate] have been initialized to diff --git a/src/proto_alpha/lib_protocol/init_storage.ml b/src/proto_alpha/lib_protocol/init_storage.ml index 8dd1785dae194fcd3ba21dd0cf934deed220c353..39e62b88310bda134abee7529793746a9092449d 100644 --- a/src/proto_alpha/lib_protocol/init_storage.ml +++ b/src/proto_alpha/lib_protocol/init_storage.ml @@ -141,12 +141,7 @@ 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 -> - let cycle = (Raw_context.current_level ctxt).cycle in - Delegate_storage.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 diff --git a/src/proto_alpha/lib_protocol/seed_storage.ml b/src/proto_alpha/lib_protocol/seed_storage.ml index b3c28135fb3e9c5c99af046e2dba9f704c3e072c..90021630c11387b104de6ab5639f2675df4ce363 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 @@ -213,6 +212,8 @@ let update_seed ctxt vdf_solution = let new_seed = Seed_repr.vdf_to_seed seed_challenge vdf_solution 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 max_slashing_period = Constants_storage.max_slashing_period ctxt in @@ -254,3 +255,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 d9488ed981b98e46c67549cbb54c5bc224e70284..93c8520aee949b53d5ef5551478286e47b79682f 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 : @@ -64,6 +68,13 @@ val check_vdf : Raw_context.t -> Seed_repr.vdf_solution -> unit tzresult Lwt.t val 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) *) @@ -82,3 +93,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 diff --git a/src/proto_alpha/lib_protocol/stake_storage.ml b/src/proto_alpha/lib_protocol/stake_storage.ml index 97bc11cec0ebefa9942a996d1c3bf6c626a4b1f5..76e3f1bf6ec8ba567143e2290f19bc750e368fa1 100644 --- a/src/proto_alpha/lib_protocol/stake_storage.ml +++ b/src/proto_alpha/lib_protocol/stake_storage.ml @@ -129,14 +129,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_delegates_with_minimal_stake.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 = @@ -193,7 +193,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 61269ae311b147c2157e5fbd4c2a461d590e5a16..84e7e67ab64ae08bb6f74dc06e66a0d3ff73d02b 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.Stake.Total_active_stake} +*) val remove_stake : Raw_context.t -> diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml index cdd6ee9b6fd760575b57e2effc669b94e4b3a354..486b9561a512a0e6297df40d3746d5a37f1fc030 100644 --- a/src/proto_alpha/lib_protocol/storage.ml +++ b/src/proto_alpha/lib_protocol/storage.ml @@ -1065,6 +1065,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 @@ -1092,7 +1093,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 ebbf7d61d134eabf6479ec4f35cdbd9a7803007a..8f3757547638fdc644710c80eb497aad9cf3689b 100644 --- a/src/proto_alpha/lib_protocol/storage.mli +++ b/src/proto_alpha/lib_protocol/storage.mli @@ -384,15 +384,15 @@ 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 - {!Constants_parametric_repr.minimal_stake} *) -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 + {!Constants_parametric_repr.minimal_stake} *) + 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]. *) diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_baking.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_baking.ml index f30d9e652065ddb8bfca0ad97b36d6c918b87d49..c6b4f7efcf1d9eb7536355b595e2e26b446377e3 100644 --- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_baking.ml +++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_baking.ml @@ -309,7 +309,7 @@ let test_enough_active_stake_to_bake ~has_active_stake () = (* N.B. setting the balance has an impact on the active stake; without delegation, the full balance is the same as the staking balance and the active balance is less or equal the staking balance (see - [Delegate_storage.select_distribution_for_cycle]). *) + [Delegate_sampler.select_distribution_for_cycle]). *) let initial_bal1 = if has_active_stake then tpr else Int64.sub tpr 1L in Context.init2 ~initial_balances:[initial_bal1; tpr] ~consensus_threshold:0 () >>=? fun (b0, (account1, _account2)) -> diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_frozen_deposits.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_frozen_deposits.ml index 6b942ff2265c36e0f79d3cab2f7fb33e3c2dba2f..89da110389275c5c2951ab5d09c27e82eef30534 100644 --- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_frozen_deposits.ml +++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_frozen_deposits.ml @@ -56,7 +56,7 @@ let get_first_2_accounts_contracts (a1, a2) = - active stake = the amount of tez with which a delegate participates in consensus; it must be greater than [minimal_stake] and less or equal the staking - balance; it is computed in [Delegate_storage.select_distribution_for_cycle] + balance; it is computed in [Delegate_sampler.select_distribution_for_cycle] - frozen deposits = represents frozen_deposits_percentage of the maximum stake during preserved_cycles + max_slashing_period cycles; obtained with @@ -534,7 +534,7 @@ let test_frozen_deposits_with_overdelegation () = Context.Delegate.full_balance (B b) account1 >>=? fun expected_new_frozen_deposits -> (* the equality follows from the definition of active stake in - [Delegate.select_distribution_for_cycle]. *) + [Delegate_sampler.select_distribution_for_cycle]. *) assert (initial_frozen_deposits = expected_new_frozen_deposits) ; Context.Delegate.current_frozen_deposits (B b) account1 >>=? fun new_frozen_deposits ->