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 06cf66a0930ca1dd2138fa3a6975b9dd2fd359a1..96c98d8b2ed6b2f48db88b03ad6806451870f126 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml @@ -1422,7 +1422,11 @@ let commands_rw () = src_pk >>= function | Ok _ -> return_unit - | Error [Environment.Ecoproto_error Delegate_storage.Active_delegate] -> + | Error + [ + Environment.Ecoproto_error + Delegate_storage.Contract.Active_delegate; + ] -> cctxt#message "Delegate already activated." >>= fun () -> return_unit | Error el -> Lwt.return_error el); @@ -1528,7 +1532,8 @@ let commands_rw () = >>= function | Ok voting_power -> return (voting_power <> 0L) | Error - (Environment.Ecoproto_error (Delegate_storage.Not_registered _) + (Environment.Ecoproto_error + (Delegate_services.Not_registered _) :: _) -> return false | Error _ as err -> Lwt.return err) @@ -1721,7 +1726,8 @@ let commands_rw () = >>= function | Ok voting_power -> return (voting_power <> 0L) | Error - (Environment.Ecoproto_error (Delegate_storage.Not_registered _) + (Environment.Ecoproto_error + (Delegate_services.Not_registered _) :: _) -> return false | Error _ as err -> Lwt.return err) diff --git a/src/proto_alpha/lib_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 fe26d8b662419b38c292a7a815745e1618427804..7931362c67bb006cabeb72360f74b666cf751197 100644 --- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL @@ -126,6 +126,10 @@ "Contract_storage", "Token", "Delegate_storage", + "Delegate_missed_endorsements_storage", + "Delegate_slashed_deposits_storage", + "Delegate_sampler", + "Delegate_cycles", "Bootstrap_storage", "Vote_storage", diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index 7be3af7d02c0105a52cdc03ab247208ed3ae2398..2c1661afa1aba5cf88e97ee6fbf2f2561ab4a4cf 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -294,6 +294,12 @@ module Contract = struct let get_manager_key = Contract_manager_storage.get_manager_key + module Delegate = struct + let find = Contract_delegate_storage.find + + include Delegate_storage.Contract + end + module Internal_for_tests = struct include Contract_repr include Contract_storage @@ -454,6 +460,11 @@ module Receipt = Receipt_repr module Delegate = struct include Delegate_storage + include Delegate_missed_endorsements_storage + include Delegate_slashed_deposits_storage + include Delegate_cycles + + let deactivated = Delegate_activation_storage.is_inactive type deposits = Storage.deposits = { initial_amount : Tez.t; @@ -465,25 +476,19 @@ module Delegate = struct let prepare_stake_distribution = Stake_storage.prepare_stake_distribution - let registered = Contract_delegate_storage.registered - - let find = Contract_delegate_storage.find - let delegated_contracts = Contract_delegate_storage.delegated_contracts end module Stake_distribution = struct let snapshot = Stake_storage.snapshot - let compute_snapshot_index = Delegate_storage.compute_snapshot_index - - let baking_rights_owner = Delegate.baking_rights_owner + let compute_snapshot_index = Delegate_sampler.compute_snapshot_index - let slot_owner = Delegate.slot_owner + let baking_rights_owner = Delegate_sampler.baking_rights_owner - let delegate_pubkey = Delegate.pubkey + let slot_owner = Delegate_sampler.slot_owner - let get_staking_balance = Delegate.staking_balance + let get_staking_balance = Delegate_storage.staking_balance end module Nonce = Nonce_storage diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index fa193e68509c1164a4b166cd8ea17bb8aba29967..5b128e448c0f460d4619ee388338692ad12057aa 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -1320,9 +1320,6 @@ module Seed : sig val compute_randao : context -> context tzresult Lwt.t - val cycle_end : - context -> Cycle.t -> (context * Nonce.unrevealed list) tzresult Lwt.t - (* RPC *) type seed_computation_status = | Nonce_revelation_stage @@ -1622,9 +1619,7 @@ end (** This module re-exports definitions from {!Contract_repr} and {!Contract_storage}. *) module Contract : sig - type t = - | Implicit of Signature.Public_key_hash.t - | Originated of Contract_hash.t + type t = Implicit of public_key_hash | Originated of Contract_hash.t type error += Non_existing_contract of t @@ -1749,6 +1744,18 @@ module Contract : sig script:Script.t * Lazy_storage.diffs option -> context tzresult Lwt.t + (** Functions for handling the delegate of a contract.*) + module Delegate : sig + (** See {!Contract_delegate_storage.find}. *) + val init : context -> t -> public_key_hash -> context tzresult Lwt.t + + (** see {!Delegate_table_storage.set}. *) + val set : context -> t -> public_key_hash option -> context tzresult Lwt.t + + (** see {!Delegate_table_storage.find}. *) + val find : context -> t -> public_key_hash option tzresult Lwt.t + end + (** This module discloses definitions that are only useful for tests and must not be used otherwise. *) module Internal_for_tests : sig @@ -1814,7 +1821,7 @@ end (** This module re-exports definitions from {!Tx_rollup_withdraw_repr}. *) module Tx_rollup_withdraw : sig type order = { - claimer : Signature.Public_key_hash.t; + claimer : public_key_hash; ticket_hash : Ticket_hash.t; amount : Tx_rollup_l2_qty.t; } @@ -1948,7 +1955,7 @@ module Tx_rollup_reveal : sig ty : Script.lazy_expr; ticketer : Contract.t; amount : Tx_rollup_l2_qty.t; - claimer : Signature.Public_key_hash.t; + claimer : public_key_hash; } val encoding : t Data_encoding.t @@ -2103,7 +2110,7 @@ module Tx_rollup_commitment : sig type nonrec t = { commitment : Compact.t; commitment_hash : Tx_rollup_commitment_hash.t; - committer : Signature.Public_key_hash.t; + committer : public_key_hash; submitted_at : Raw_level.t; finalized_at : Raw_level.t option; } @@ -2134,10 +2141,9 @@ module Tx_rollup_commitment : sig context -> Tx_rollup.t -> Tx_rollup_state.t -> - Signature.public_key_hash -> + public_key_hash -> Full.t -> - (context * Tx_rollup_state.t * Signature.public_key_hash option) tzresult - Lwt.t + (context * Tx_rollup_state.t * public_key_hash option) tzresult Lwt.t val find : context -> @@ -2173,16 +2179,10 @@ module Tx_rollup_commitment : sig (context * Submitted_commitment.t) tzresult Lwt.t val pending_bonded_commitments : - context -> - Tx_rollup.t -> - Signature.public_key_hash -> - (context * int) tzresult Lwt.t + context -> Tx_rollup.t -> public_key_hash -> (context * int) tzresult Lwt.t val has_bond : - context -> - Tx_rollup.t -> - Signature.public_key_hash -> - (context * bool) tzresult Lwt.t + context -> Tx_rollup.t -> public_key_hash -> (context * bool) tzresult Lwt.t val finalize_commitment : context -> @@ -2197,16 +2197,10 @@ module Tx_rollup_commitment : sig (context * Tx_rollup_state.t * Tx_rollup_level.t) tzresult Lwt.t val remove_bond : - context -> - Tx_rollup.t -> - Signature.public_key_hash -> - context tzresult Lwt.t + context -> Tx_rollup.t -> public_key_hash -> context tzresult Lwt.t val slash_bond : - context -> - Tx_rollup.t -> - Signature.public_key_hash -> - (context * bool) tzresult Lwt.t + context -> Tx_rollup.t -> public_key_hash -> (context * bool) tzresult Lwt.t val reject_commitment : context -> @@ -2254,8 +2248,8 @@ module Tx_rollup_errors : sig } | Level_already_has_commitment of Tx_rollup_level.t | Wrong_inbox_hash - | Bond_does_not_exist of Signature.public_key_hash - | Bond_in_use of Signature.public_key_hash + | Bond_does_not_exist of public_key_hash + | Bond_in_use of public_key_hash | No_uncommitted_inbox | No_commitment_to_finalize | No_commitment_to_remove @@ -2368,7 +2362,7 @@ module Receipt : sig | Baking_bonuses | Storage_fees | Double_signing_punishments - | Lost_endorsing_rewards of Signature.Public_key_hash.t * bool * bool + | Lost_endorsing_rewards of public_key_hash * bool * bool | Liquidity_baking_subsidies | Burned | Commitments of Blinded_public_key_hash.t @@ -2402,23 +2396,11 @@ end (** This module re-exports definitions from {!Delegate_storage}. *) module Delegate : sig - val init : - context -> - Contract.t -> - Signature.Public_key_hash.t -> - context tzresult Lwt.t - - (** See {!Contract_delegate_storage.find}. *) - val find : context -> Contract.t -> public_key_hash option tzresult Lwt.t - - val set : - context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t - val frozen_deposits_limit : - context -> Signature.Public_key_hash.t -> Tez.t option tzresult Lwt.t + context -> public_key_hash -> Tez.t option tzresult Lwt.t val set_frozen_deposits_limit : - context -> Signature.Public_key_hash.t -> Tez.t option -> context Lwt.t + context -> public_key_hash -> Tez.t option -> context Lwt.t val fold : context -> @@ -2429,8 +2411,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; @@ -2440,22 +2420,13 @@ 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 : context -> Cycle.t -> - Nonce.unrevealed list -> - (context * Receipt.balance_updates * Signature.Public_key_hash.t list) - tzresult - Lwt.t - - val already_slashed_for_double_endorsing : - context -> public_key_hash -> Level.t -> bool tzresult Lwt.t - - val already_slashed_for_double_baking : - context -> public_key_hash -> Level.t -> bool tzresult Lwt.t + (context * Receipt.balance_updates * public_key_hash list) tzresult Lwt.t val punish_double_endorsing : context -> @@ -2475,15 +2446,15 @@ module Delegate : sig val record_baking_activity_and_pay_rewards_and_fees : context -> - payload_producer:Signature.Public_key_hash.t -> - block_producer:Signature.Public_key_hash.t -> + payload_producer:public_key_hash -> + block_producer:public_key_hash -> baking_reward:Tez.t -> reward_bonus:Tez.t option -> (context * Receipt.balance_updates) tzresult Lwt.t val record_endorsing_participation : context -> - delegate:Signature.Public_key_hash.t -> + delegate:public_key_hash -> participation:level_participation -> endorsing_power:int -> context tzresult Lwt.t @@ -2492,25 +2463,21 @@ module Delegate : sig val frozen_deposits : context -> public_key_hash -> deposits tzresult Lwt.t - val staking_balance : - context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t + val staking_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t (** See {!Contract_delegate_storage.delegated_contracts}. *) - val delegated_contracts : - context -> Signature.Public_key_hash.t -> Contract.t list Lwt.t + val delegated_contracts : context -> public_key_hash -> Contract.t list Lwt.t - val delegated_balance : - context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t + val delegated_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t (** See {!Contract_delegate_storage.registered}. *) - val registered : context -> Signature.Public_key_hash.t -> bool tzresult Lwt.t + val registered : context -> public_key_hash -> bool Lwt.t - val deactivated : - context -> Signature.Public_key_hash.t -> bool tzresult Lwt.t + val deactivated : context -> public_key_hash -> bool tzresult Lwt.t (** See {!Delegate_activation_storage.last_cycle_before_deactivation}. *) val last_cycle_before_deactivation : - context -> Signature.Public_key_hash.t -> Cycle.t tzresult Lwt.t + context -> public_key_hash -> Cycle.t tzresult Lwt.t val pubkey : context -> public_key_hash -> public_key tzresult Lwt.t @@ -2582,8 +2549,7 @@ module Vote : sig val recorded_proposal_count_for_delegate : context -> public_key_hash -> int tzresult Lwt.t - val listings_encoding : - (Signature.Public_key_hash.t * int64) list Data_encoding.t + val listings_encoding : (public_key_hash * int64) list Data_encoding.t val update_listings : context -> context tzresult Lwt.t @@ -2607,13 +2573,12 @@ module Vote : sig val delegate_info_encoding : delegate_info Data_encoding.t val get_delegate_info : - context -> Signature.Public_key_hash.t -> delegate_info tzresult Lwt.t + context -> public_key_hash -> delegate_info tzresult Lwt.t - val get_voting_power_free : - context -> Signature.Public_key_hash.t -> int64 tzresult Lwt.t + val get_voting_power_free : context -> public_key_hash -> int64 tzresult Lwt.t val get_voting_power : - context -> Signature.Public_key_hash.t -> (context * int64) tzresult Lwt.t + context -> public_key_hash -> (context * int64) tzresult Lwt.t val get_total_voting_power_free : context -> int64 tzresult Lwt.t @@ -2677,7 +2642,7 @@ module Dal : sig val expected_size_in_bits : max_index:Slot_index.t -> int - val shards : context -> endorser:Signature.Public_key_hash.t -> int list + val shards : context -> endorser:public_key_hash -> int list val record_available_shards : context -> t -> int list -> context end @@ -2759,8 +2724,7 @@ module Sc_rollup : sig type rollup := t - module Staker : - S.SIGNATURE_PUBLIC_KEY_HASH with type t = Signature.Public_key_hash.t + module Staker : S.SIGNATURE_PUBLIC_KEY_HASH with type t = public_key_hash module State_hash : S.HASH @@ -2772,7 +2736,7 @@ module Sc_rollup : sig type internal_inbox_message = { payload : Script.expr; sender : Contract_hash.t; - source : Signature.public_key_hash; + source : public_key_hash; } type t = Internal of internal_inbox_message | External of string @@ -2880,7 +2844,7 @@ module Sc_rollup : sig rollup -> payload:Script.expr -> sender:Contract_hash.t -> - source:Signature.public_key_hash -> + source:public_key_hash -> (t * Z.t * context) tzresult Lwt.t val inbox : context -> rollup -> (t * context) tzresult Lwt.t @@ -3374,7 +3338,7 @@ module Block_header : sig Liquidity_baking_repr.liquidity_baking_toggle_vote; } - type protocol_data = {contents : contents; signature : Signature.t} + type protocol_data = {contents : contents; signature : signature} type t = {shell : Block_header.shell_header; protocol_data : protocol_data} @@ -3431,8 +3395,7 @@ module Block_header : sig predecessor_round:Round.t -> unit tzresult - val check_signature : - t -> Chain_id.t -> Signature.Public_key.t -> unit tzresult + val check_signature : t -> Chain_id.t -> public_key -> unit tzresult val begin_validate_block_header : block_header:t -> @@ -3441,7 +3404,7 @@ module Block_header : sig predecessor_round:Round.t -> fitness:Fitness.t -> timestamp:Time.t -> - delegate_pk:Signature.public_key -> + delegate_pk:public_key -> round_durations:Round.round_durations -> proof_of_work_threshold:int64 -> expected_commitment:bool -> @@ -3619,7 +3582,7 @@ type 'kind operation = { and 'kind protocol_data = { contents : 'kind contents_list; - signature : Signature.t option; + signature : signature option; } and _ contents_list = @@ -3632,7 +3595,7 @@ and _ contents = | Preendorsement : consensus_content -> Kind.preendorsement contents | Endorsement : consensus_content -> Kind.endorsement contents | Dal_slot_availability : - Signature.Public_key_hash.t * Dal.Endorsement.t + public_key_hash * Dal.Endorsement.t -> Kind.dal_slot_availability contents | Seed_nonce_revelation : { level : Raw_level.t; @@ -3664,13 +3627,13 @@ and _ contents = } -> Kind.activate_account contents | Proposals : { - source : Signature.Public_key_hash.t; + source : public_key_hash; period : int32; proposals : Protocol_hash.t list; } -> Kind.proposals contents | Ballot : { - source : Signature.Public_key_hash.t; + source : public_key_hash; period : int32; proposal : Protocol_hash.t; ballot : Vote.ballot; @@ -3678,7 +3641,7 @@ and _ contents = -> Kind.ballot contents | Failing_noop : string -> Kind.failing_noop contents | Manager_operation : { - source : Signature.Public_key_hash.t; + source : public_key_hash; fee : Tez.tez; counter : counter; operation : 'kind manager_operation; @@ -3688,7 +3651,7 @@ and _ contents = -> 'kind Kind.manager contents and _ manager_operation = - | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation + | Reveal : public_key -> Kind.reveal manager_operation | Transaction : { amount : Tez.tez; parameters : Script.lazy_expr; @@ -3697,14 +3660,12 @@ and _ manager_operation = } -> Kind.transaction manager_operation | Origination : { - delegate : Signature.Public_key_hash.t option; + delegate : public_key_hash option; script : Script.t; credit : Tez.tez; } -> Kind.origination manager_operation - | Delegation : - Signature.Public_key_hash.t option - -> Kind.delegation manager_operation + | Delegation : public_key_hash option -> Kind.delegation manager_operation | Register_global_constant : { value : Script.lazy_expr; } @@ -4095,12 +4056,8 @@ module Stake_distribution : sig Slot.t -> (context * (public_key * public_key_hash)) tzresult Lwt.t - (** See {!Delegate.pubkey}. *) - val delegate_pubkey : context -> public_key_hash -> public_key tzresult Lwt.t - (** See {!Delegate.staking_balance}. *) - val get_staking_balance : - context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t + val get_staking_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t end (** This module re-exports definitions from {!Commitment_repr} and, @@ -4285,8 +4242,8 @@ module Token : sig type container = [ `Contract of Contract.t | `Collected_commitments of Blinded_public_key_hash.t - | `Delegate_balance of Signature.Public_key_hash.t - | `Frozen_deposits of Signature.Public_key_hash.t + | `Delegate_balance of public_key_hash + | `Frozen_deposits of public_key_hash | `Block_fees | `Frozen_bonds of Contract.t * Bond_id.t ] @@ -4307,7 +4264,7 @@ module Token : sig type sink = [ `Storage_fees | `Double_signing_punishments - | `Lost_endorsing_rewards of Signature.Public_key_hash.t * bool * bool + | `Lost_endorsing_rewards of public_key_hash * bool * bool | `Burned | `Tx_rollup_rejection_punishments | `Sc_rollup_refutation_punishments diff --git a/src/proto_alpha/lib_protocol/amendment.mli b/src/proto_alpha/lib_protocol/amendment.mli index 999de49ac79c313bc1374d7ea43cd9e02d9a8631..a52ad9a6b927cde458986b9184fc885e93f9ca7e 100644 --- a/src/proto_alpha/lib_protocol/amendment.mli +++ b/src/proto_alpha/lib_protocol/amendment.mli @@ -103,3 +103,10 @@ val record_ballot : Protocol_hash.t -> Vote.ballot -> context tzresult Lwt.t + +(** On testnets whose [chain_id] is not the one of Mainnet, this + function checks whether the provided [pkh] is the one of the + registered governance dictator, if any. + + On mainnet, it always returns false. *) +val is_governance_dictator : context -> Chain_id.t -> public_key_hash -> bool diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 5f4a7d5531d1f7d10f4642b4e898c73686b1b41b..debf18d19c2bdbd3e0b15c1ad45efb28eb528744 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -95,6 +95,8 @@ type error += | Set_deposits_limit_on_unregistered_delegate of Signature.Public_key_hash.t | Set_deposits_limit_too_high of {limit : Tez.t; max_limit : Tez.t} | Error_while_taking_fees + | Ballot_on_unregistered_delegate of Signature.Public_key_hash.t + | Proposals_on_unregistered_delegate of Signature.Public_key_hash.t | Empty_transaction of Contract.t | Tx_rollup_feature_disabled | Tx_rollup_invalid_transaction_ticket_amount @@ -108,7 +110,6 @@ type error += delegate1 : Signature.Public_key_hash.t; delegate2 : Signature.Public_key_hash.t; } - | Unrequired_denunciation | Too_early_denunciation of { kind : denunciation_kind; level : Raw_level.t; @@ -447,6 +448,35 @@ let () = (function | Set_deposits_limit_on_unregistered_delegate c -> Some c | _ -> None) (fun c -> Set_deposits_limit_on_unregistered_delegate c) ; + register_error_kind + `Permanent + ~id:"operation.ballot_on_unregistered_delegate" + ~title:"Ballot with an unregistered delegate" + ~description:"Cannot cast a ballot with an unregistered delegate." + ~pp:(fun ppf c -> + Format.fprintf + ppf + "Cannot cast a ballot for public key hash %a (unregistered delegate)." + Signature.Public_key_hash.pp + c) + Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) + (function Ballot_on_unregistered_delegate c -> Some c | _ -> None) + (fun c -> Ballot_on_unregistered_delegate c) ; + register_error_kind + `Permanent + ~id:"operation.proposals_on_unregistered_delegate" + ~title:"Proposals with an unregistered delegate" + ~description:"Cannot submit proposals with an unregistered delegate." + ~pp:(fun ppf c -> + Format.fprintf + ppf + "Cannot submit proposals for public key hash %a (unregistered \ + delegate)." + Signature.Public_key_hash.pp + c) + Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) + (function Proposals_on_unregistered_delegate c -> Some c | _ -> None) + (fun c -> Proposals_on_unregistered_delegate c) ; register_error_kind `Permanent ~id:"operation.set_deposits_limit_too_high" @@ -616,19 +646,6 @@ let () = | _ -> None) (fun (kind, delegate1, delegate2) -> Inconsistent_denunciation {kind; delegate1; delegate2}) ; - register_error_kind - `Branch - ~id:"block.unrequired_denunciation" - ~title:"Unrequired denunciation" - ~description:"A denunciation is unrequired" - ~pp:(fun ppf _ -> - Format.fprintf - ppf - "A valid denunciation cannot be applied: the associated delegate has \ - already been denounced for this level.") - Data_encoding.unit - (function Unrequired_denunciation -> Some () | _ -> None) - (fun () -> Unrequired_denunciation) ; register_error_kind `Temporary ~id:"block.too_early_denunciation" @@ -777,7 +794,7 @@ let update_script_storage_and_ticket_balances ctxt ~self storage Ticket_accounting.update_ticket_balances ctxt ~self ~ticket_diffs operations let apply_delegation ~ctxt ~source ~delegate ~before_operation = - Delegate.set ctxt source delegate >|=? fun ctxt -> + Contract.Delegate.set ctxt source delegate >|=? fun ctxt -> (ctxt, Gas.consumed ~since:before_operation ~until:ctxt, []) type execution_arg = @@ -1046,7 +1063,7 @@ let apply_origination ~ctxt ~storage_type ~storage ~unparsed_code let contract = Contract.Originated contract_hash in (match delegate with | None -> return ctxt - | Some delegate -> Delegate.init ctxt contract delegate) + | Some delegate -> Contract.Delegate.init ctxt contract delegate) >>=? fun ctxt -> Token.transfer ctxt (`Contract source) (`Contract contract) credit >>=? fun (ctxt, balance_updates) -> @@ -1542,7 +1559,7 @@ let apply_external_manager_operation_content : Tez.(limit > max_limit) (Set_deposits_limit_too_high {limit; max_limit})) >>?= fun () -> - Delegate.registered ctxt source >>=? fun is_registered -> + Delegate.registered ctxt source >>= fun is_registered -> error_unless is_registered (Set_deposits_limit_on_unregistered_delegate source) @@ -2698,17 +2715,11 @@ let check_denunciation_age ctxt kind given_level = {kind; level = given_level; last_cycle = last_slashable_cycle}) let punish_delegate ctxt delegate level mistake mk_result ~payload_producer = - let already_slashed, punish = + let punish = match mistake with - | `Double_baking -> - ( Delegate.already_slashed_for_double_baking, - Delegate.punish_double_baking ) - | `Double_endorsing -> - ( Delegate.already_slashed_for_double_endorsing, - Delegate.punish_double_endorsing ) + | `Double_baking -> Delegate.punish_double_baking + | `Double_endorsing -> Delegate.punish_double_endorsing in - already_slashed ctxt delegate level >>=? fun slashed -> - fail_when slashed Unrequired_denunciation >>=? fun () -> punish ctxt delegate level >>=? fun (ctxt, burned, punish_balance_updates) -> (match Tez.(burned /? 2L) with | Ok reward -> @@ -2986,6 +2997,14 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) mode >>=? fun (ctxt, bupds) -> return (ctxt, Single_result (Activate_account_result bupds)) | Single (Proposals {source; period; proposals}) -> + Delegate.registered ctxt source >>= fun is_registered -> + let is_governance_dictator = + Amendment.is_governance_dictator ctxt chain_id source + in + error_unless + (is_registered || is_governance_dictator) + (Proposals_on_unregistered_delegate source) + >>?= fun () -> Delegate.pubkey ctxt source >>=? fun delegate -> Operation.check_signature delegate chain_id operation >>?= fun () -> Voting_period.get_current ctxt >>=? fun {index = current_period; _} -> @@ -2996,6 +3015,9 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) mode Amendment.record_proposals ctxt chain_id source proposals >|=? fun ctxt -> (ctxt, Single_result Proposals_result) | Single (Ballot {source; period; proposal; ballot}) -> + Delegate.registered ctxt source >>= fun is_registered -> + error_unless is_registered (Ballot_on_unregistered_delegate source) + >>?= fun () -> Delegate.pubkey ctxt source >>=? fun delegate -> Operation.check_signature delegate chain_id operation >>?= fun () -> Voting_period.get_current ctxt >>=? fun {index = current_period; _} -> @@ -3049,8 +3071,7 @@ let may_start_new_cycle ctxt = match Level.dawn_of_a_new_cycle ctxt with | None -> return (ctxt, [], []) | Some last_cycle -> - Seed.cycle_end ctxt last_cycle >>=? fun (ctxt, unrevealed) -> - Delegate.cycle_end ctxt last_cycle unrevealed + Delegate.cycle_end ctxt last_cycle >>=? fun (ctxt, balance_updates, deactivated) -> Bootstrap.cycle_end ctxt last_cycle >|=? fun ctxt -> (ctxt, balance_updates, deactivated) diff --git a/src/proto_alpha/lib_protocol/bootstrap_storage.ml b/src/proto_alpha/lib_protocol/bootstrap_storage.ml index b9abaec549892bbc65886880f281d64cd5368800..592bdebbec46a3168cd6f2d1e6bf2f66c0ca07e7 100644 --- a/src/proto_alpha/lib_protocol/bootstrap_storage.ml +++ b/src/proto_alpha/lib_protocol/bootstrap_storage.ml @@ -59,7 +59,7 @@ let init_account (ctxt, balance_updates) public_key_hash public_key >>=? fun ctxt -> - Delegate_storage.set + Delegate_storage.Contract.set ctxt contract (Some (Option.value ~default:public_key_hash delegate_to)) @@ -84,7 +84,7 @@ let init_contract ~typecheck (ctxt, balance_updates) let contract = Contract_repr.Originated contract_hash in (match delegate with | None -> return ctxt - | Some delegate -> Delegate_storage.init ctxt contract delegate) + | Some delegate -> Delegate_storage.Contract.init ctxt contract delegate) >>=? fun ctxt -> let origin = Receipt_repr.Protocol_migration in Token.transfer ~origin ctxt `Bootstrap (`Contract contract) amount diff --git a/src/proto_alpha/lib_protocol/contract_delegate_storage.ml b/src/proto_alpha/lib_protocol/contract_delegate_storage.ml index 8dbb1063250d137bb618ecbbea219224ce703804..75efd48243daa84662d3c0079af54998d5758763 100644 --- a/src/proto_alpha/lib_protocol/contract_delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/contract_delegate_storage.ml @@ -25,14 +25,6 @@ let find = Storage.Contract.Delegate.find -(* A delegate is registered if its "implicit account" delegates to itself. *) -let registered c delegate = - Storage.Contract.Delegate.find c (Contract_repr.Implicit delegate) - >|=? function - | Some current_delegate -> - Signature.Public_key_hash.equal delegate current_delegate - | None -> false - let init ctxt contract delegate = Storage.Contract.Delegate.init ctxt contract delegate >>=? fun ctxt -> let delegate_contract = Contract_repr.Implicit delegate in diff --git a/src/proto_alpha/lib_protocol/contract_delegate_storage.mli b/src/proto_alpha/lib_protocol/contract_delegate_storage.mli index 45a05ca408ca08e7fde512f1895c367a6a308929..a0c97c1c53490aaefad85baf82cde4d1fe14c2de 100644 --- a/src/proto_alpha/lib_protocol/contract_delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/contract_delegate_storage.mli @@ -23,6 +23,9 @@ (* *) (*****************************************************************************) +(** This module deals with the delegates of a contract. It is responsible for + maintaining the table {!Storage.Contract.Delegate}. *) + (** [find ctxt contract] returns the delegate associated to [contract], or [None] if [contract] has no delegate. *) val find : @@ -30,15 +33,9 @@ val find : Contract_repr.t -> Signature.Public_key_hash.t option tzresult Lwt.t -(** [registered ctxt delegate] returns true iff delegate is an implicit contract - that delegates to itself. *) -val registered : - Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t - (** [init ctxt contract delegate] sets the [delegate] associated to [contract]. - This function is undefined if [contract] is not allocated, or if [contract] - has already a delegate. *) + This function returns an error if [contract] has already a delegate. *) val init : Raw_context.t -> Contract_repr.t -> @@ -60,10 +57,7 @@ val unlink : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t This function is undefined if [contract] is not allocated. *) val delete : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t -(** [set ctxt contract delegate] updates the [delegate] associated to [contract]. - - This function is undefined if [contract] is not allocated, or if [contract] - does not have a delegate. *) +(** [set ctxt contract delegate] updates the [delegate] associated to [contract]. *) val set : Raw_context.t -> Contract_repr.t -> diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml index 1d18c7117acf7f67d9e50a1486d620f6adda6818..d95dd6b5d6eb9312dffb0f181dadb4547b9e4744 100644 --- a/src/proto_alpha/lib_protocol/contract_services.ml +++ b/src/proto_alpha/lib_protocol/contract_services.ml @@ -398,7 +398,7 @@ let[@coq_axiom_with_reason "gadt"] register () = | false -> return_some None | true -> Contract.get_manager_key ctxt mgr >|=? fun key -> Some (Some key))) ; - register_opt_field ~chunked:false S.delegate Delegate.find ; + register_opt_field ~chunked:false S.delegate Contract.Delegate.find ; opt_register1 ~chunked:false S.counter (fun ctxt contract () () -> match contract with | Originated _ -> return_none @@ -544,7 +544,7 @@ let[@coq_axiom_with_reason "gadt"] register () = S.info (fun ctxt contract {normalize_types} -> Contract.get_balance ctxt contract >>=? fun balance -> - Delegate.find ctxt contract >>=? fun delegate -> + Contract.Delegate.find ctxt contract >>=? fun delegate -> match contract with | Implicit manager -> Contract.get_counter ctxt manager >|=? fun counter -> diff --git a/src/proto_alpha/lib_protocol/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..53a0c38c2146e6364e1acdb9a2281110205a8241 --- /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_rolls + ctxt + ~order:`Sorted + ~init:(Ok (ctxt, [])) + ~f:(fun delegate () acc -> + acc >>?= fun (ctxt, deactivated) -> + Delegate_activation_storage.last_cycle_before_deactivation + ctxt + delegate + >>=? fun cycle -> + if Cycle_repr.(cycle <= last_cycle) then + Stake_storage.set_inactive ctxt delegate >>= fun ctxt -> + return (ctxt, delegate :: deactivated) + else return (ctxt, deactivated)) + >|=? fun (ctxt, deactivated) -> (ctxt, deactivated) + +(* Return a map from delegates (with active stake at some cycle + in the cycle window [from_cycle, to_cycle]) to the maximum + of the stake to be deposited for each such cycle (which is just the + [frozen_deposits_percentage] of the active stake at that cycle). Also + return the delegates that have fallen out of the sliding window. *) +let max_frozen_deposits_and_delegates_to_remove ctxt ~from_cycle ~to_cycle = + let frozen_deposits_percentage = + Constants_storage.frozen_deposits_percentage ctxt + in + let cycles = Cycle_repr.(from_cycle ---> to_cycle) in + (match Cycle_repr.pred from_cycle with + | None -> return Signature.Public_key_hash.Set.empty + | Some cleared_cycle -> ( + Stake_storage.find_selected_distribution ctxt cleared_cycle + >|=? fun cleared_cycle_delegates -> + match cleared_cycle_delegates with + | None -> Signature.Public_key_hash.Set.empty + | Some delegates -> + List.fold_left + (fun set (d, _) -> Signature.Public_key_hash.Set.add d set) + Signature.Public_key_hash.Set.empty + delegates)) + >>=? fun cleared_cycle_delegates -> + List.fold_left_es + (fun (maxima, delegates_to_remove) (cycle : Cycle_repr.t) -> + Stake_storage.get_selected_distribution ctxt cycle + >|=? fun active_stakes -> + List.fold_left + (fun (maxima, delegates_to_remove) (delegate, stake) -> + let stake_to_be_deposited = + Tez_repr.(div_exn (mul_exn stake frozen_deposits_percentage) 100) + in + let maxima = + Signature.Public_key_hash.Map.update + delegate + (function + | None -> Some stake_to_be_deposited + | Some maximum -> + Some (Tez_repr.max maximum stake_to_be_deposited)) + maxima + in + let delegates_to_remove = + Signature.Public_key_hash.Set.remove delegate delegates_to_remove + in + (maxima, delegates_to_remove)) + (maxima, delegates_to_remove) + active_stakes) + (Signature.Public_key_hash.Map.empty, cleared_cycle_delegates) + cycles + +let freeze_deposits ?(origin = Receipt_repr.Block_application) ctxt ~new_cycle + ~balance_updates = + let max_slashable_period = Constants_storage.max_slashing_period ctxt in + (* We want to be able to slash for at most [max_slashable_period] *) + (match Cycle_repr.(sub new_cycle (max_slashable_period - 1)) with + | None -> + Storage.Tenderbake.First_level_of_protocol.get ctxt + >>=? fun first_level_of_protocol -> + let cycle_eras = Raw_context.cycle_eras ctxt in + let level = + Level_repr.level_from_raw ~cycle_eras first_level_of_protocol + in + return level.cycle + | Some cycle -> return cycle) + >>=? fun from_cycle -> + let preserved_cycles = Constants_storage.preserved_cycles ctxt in + let to_cycle = Cycle_repr.(add new_cycle preserved_cycles) in + max_frozen_deposits_and_delegates_to_remove ctxt ~from_cycle ~to_cycle + >>=? fun (maxima, delegates_to_remove) -> + Signature.Public_key_hash.Map.fold_es + (fun delegate maximum_stake_to_be_deposited (ctxt, balance_updates) -> + (* Here we make sure to preserve the following invariant : + maximum_stake_to_be_deposited <= frozen_deposits + balance + See select_distribution_for_cycle *) + let delegate_contract = Contract_repr.Implicit delegate in + Frozen_deposits_storage.update_initial_amount + ctxt + delegate_contract + maximum_stake_to_be_deposited + >>=? fun ctxt -> + Frozen_deposits_storage.get ctxt delegate_contract >>=? fun deposits -> + let current_amount = deposits.current_amount in + if Tez_repr.(current_amount > maximum_stake_to_be_deposited) then + Tez_repr.(current_amount -? maximum_stake_to_be_deposited) + >>?= fun to_reimburse -> + Token.transfer + ~origin + ctxt + (`Frozen_deposits delegate) + (`Delegate_balance delegate) + to_reimburse + >|=? fun (ctxt, bupds) -> (ctxt, bupds @ balance_updates) + else if Tez_repr.(current_amount < maximum_stake_to_be_deposited) then + Tez_repr.(maximum_stake_to_be_deposited -? current_amount) + >>?= fun desired_to_freeze -> + Contract_storage.get_balance ctxt delegate_contract >>=? fun balance -> + (* In case the delegate hasn't been slashed in this cycle, + the following invariant holds: + maximum_stake_to_be_deposited <= frozen_deposits + balance + See select_distribution_for_cycle + + If the delegate has been slashed during the cycle, the invariant + above doesn't necessarily hold. In this case, we freeze the max + we can for the delegate. *) + let to_freeze = Tez_repr.(min balance desired_to_freeze) in + Token.transfer + ~origin + ctxt + (`Delegate_balance delegate) + (`Frozen_deposits delegate) + to_freeze + >|=? fun (ctxt, bupds) -> (ctxt, bupds @ balance_updates) + else return (ctxt, balance_updates)) + maxima + (ctxt, balance_updates) + >>=? fun (ctxt, balance_updates) -> + (* Unfreeze deposits (that is, set them to zero) for delegates that + were previously in the relevant window (and therefore had some + frozen deposits) but are not in the new window; because that means + that such a delegate had no active stake in the relevant cycles, + and therefore it should have no frozen deposits. *) + Signature.Public_key_hash.Set.fold_es + (fun delegate (ctxt, balance_updates) -> + let delegate_contract = Contract_repr.Implicit delegate in + Frozen_deposits_storage.update_initial_amount + ctxt + delegate_contract + Tez_repr.zero + >>=? fun ctxt -> + Frozen_deposits_storage.get ctxt delegate_contract + >>=? fun frozen_deposits -> + if Tez_repr.(frozen_deposits.current_amount > zero) then + Token.transfer + ~origin + ctxt + (`Frozen_deposits delegate) + (`Delegate_balance delegate) + frozen_deposits.current_amount + >|=? fun (ctxt, bupds) -> (ctxt, bupds @ balance_updates) + else return (ctxt, balance_updates)) + delegates_to_remove + (ctxt, balance_updates) + +let delegate_has_revealed_nonces delegate unrevelead_nonces_set = + not (Signature.Public_key_hash.Set.mem delegate unrevelead_nonces_set) + +let distribute_endorsing_rewards ctxt last_cycle unrevealed_nonces = + let endorsing_reward_per_slot = + Constants_storage.endorsing_reward_per_slot ctxt + in + let unrevealed_nonces_set = + List.fold_left + (fun set {Storage.Seed.nonce_hash = _; delegate} -> + Signature.Public_key_hash.Set.add delegate set) + Signature.Public_key_hash.Set.empty + unrevealed_nonces + in + Stake_storage.get_total_active_stake ctxt last_cycle + >>=? fun total_active_stake -> + Stake_storage.get_selected_distribution ctxt last_cycle >>=? fun delegates -> + List.fold_left_es + (fun (ctxt, balance_updates) (delegate, active_stake) -> + let delegate_contract = Contract_repr.Implicit delegate in + Delegate_missed_endorsements_storage.reset_delegate_participation + ctxt + delegate + >>=? fun (ctxt, sufficient_participation) -> + let has_revealed_nonces = + delegate_has_revealed_nonces delegate unrevealed_nonces_set + in + let expected_slots = + Delegate_missed_endorsements_storage + .expected_slots_for_given_active_stake + ctxt + ~total_active_stake + ~active_stake + in + let rewards = Tez_repr.mul_exn endorsing_reward_per_slot expected_slots in + if sufficient_participation && has_revealed_nonces then + (* Sufficient participation: we pay the rewards *) + Token.transfer + ctxt + `Endorsing_rewards + (`Contract delegate_contract) + rewards + >|=? fun (ctxt, payed_rewards_receipts) -> + (ctxt, payed_rewards_receipts @ balance_updates) + else + (* Insufficient participation or unrevealed nonce: no rewards *) + Token.transfer + ctxt + `Endorsing_rewards + (`Lost_endorsing_rewards + (delegate, not sufficient_participation, not has_revealed_nonces)) + rewards + >|=? fun (ctxt, payed_rewards_receipts) -> + (ctxt, payed_rewards_receipts @ balance_updates)) + (ctxt, []) + delegates + +let cycle_end ctxt last_cycle = + Seed_storage.cycle_end ctxt last_cycle >>=? fun (ctxt, unrevealed_nonces) -> + let new_cycle = Cycle_repr.add last_cycle 1 in + 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..ebcecb05d925a881d7ca62b110be0aa8445137ad --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_cycles.mli @@ -0,0 +1,49 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2022 G.B. Fefe, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Trigger the context maintenance at the end of cycle 'n', i.e.: + unfreeze the endorsing rewards, potentially deactivate delegates. + Return the corresponding balances updates and the list of + deactivated delegates. *) +val cycle_end : + Raw_context.t -> + Cycle_repr.t -> + (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..96d22c2888cdd5fd8c2b3379ae8fb6e168e416ef --- /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 -> Stake_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 = + Stake_storage.set_active ctxt payload_producer >>=? fun ctxt -> + (if not (Signature.Public_key_hash.equal payload_producer block_producer) then + Stake_storage.set_active ctxt block_producer + else return ctxt) + >>=? fun ctxt -> + let pay_payload_producer ctxt delegate = + let contract = Contract_repr.Implicit delegate in + Token.balance ctxt `Block_fees >>=? fun (ctxt, block_fees) -> + Token.transfer_n + ctxt + [(`Block_fees, block_fees); (`Baking_rewards, baking_reward)] + (`Contract contract) + in + let pay_block_producer ctxt delegate bonus = + let contract = Contract_repr.Implicit delegate in + Token.transfer ctxt `Baking_bonuses (`Contract contract) bonus + in + pay_payload_producer ctxt payload_producer + >>=? fun (ctxt, balance_updates_payload_producer) -> + (match reward_bonus with + | Some bonus -> pay_block_producer ctxt block_producer bonus + | None -> return (ctxt, [])) + >>=? fun (ctxt, balance_updates_block_producer) -> + return + (ctxt, balance_updates_payload_producer @ balance_updates_block_producer) + +type participation_info = { + expected_cycle_activity : int; + minimal_cycle_activity : int; + missed_slots : int; + missed_levels : int; + remaining_allowed_missed_slots : int; + expected_endorsing_rewards : Tez_repr.t; +} + +(* Inefficient, only for RPC *) +let 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; + } + +let reset_delegate_participation ctxt delegate = + let contract = Contract_repr.Implicit delegate in + Storage.Contract.Missed_endorsements.find ctxt contract >>=? fun missed -> + match missed with + | None -> return (ctxt, true) + | Some missed_endorsements -> + Storage.Contract.Missed_endorsements.remove ctxt contract >>= fun ctxt -> + return (ctxt, Compare.Int.(missed_endorsements.remaining_slots >= 0)) diff --git a/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli new file mode 100644 index 0000000000000000000000000000000000000000..03ce915c9fd7188ef998ed42341223789d3ef98d --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_missed_endorsements_storage.mli @@ -0,0 +1,98 @@ +(*****************************************************************************) +(* *) +(* 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.tez -> + active_stake:Tez_repr.tez -> + 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 + +(** Check that a delegate participated enough in the last cycle, + and then reset the participation for preparing the next cycle. *) +val reset_delegate_participation : + Raw_context.t -> + Signature.Public_key_hash.t -> + (Raw_context.t * bool) tzresult Lwt.t + +(** Participation information. We denote by: + - "static" information that does not change during the cycle + - "dynamic" information that may change during the cycle *) +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 + +(** 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 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..a6c07992cef7c1fc14040cd49b03f4a3a92870c1 --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_sampler.ml @@ -0,0 +1,241 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2022 G.B. Fefe, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Delegate_sampler_state = struct + module Cache_client = struct + type cached_value = + (Signature.public_key * Signature.public_key_hash) Sampler.t + + let namespace = Cache_repr.create_namespace "sampler_state" + + let cache_index = 2 + + let value_of_identifier ctxt identifier = + let cycle = Cycle_repr.of_string_exn identifier in + Storage.Delegate_sampler_state.get ctxt cycle + end + + module Cache = (val Cache_repr.register_exn (module Cache_client)) + + let identifier_of_cycle cycle = Format.asprintf "%a" Cycle_repr.pp cycle + + let init ctxt cycle sampler_state = + let id = identifier_of_cycle cycle in + Storage.Delegate_sampler_state.init ctxt cycle sampler_state + >>=? fun ctxt -> + let size = 1 (* that's symbolic: 1 cycle = 1 entry *) in + Cache.update ctxt id (Some (sampler_state, size)) >>?= fun ctxt -> + return ctxt + + let get ctxt cycle = + let id = identifier_of_cycle cycle in + Cache.find ctxt id >>=? function + | None -> Storage.Delegate_sampler_state.get ctxt cycle + | Some v -> return v + + let remove_existing ctxt cycle = + let id = identifier_of_cycle cycle in + Cache.update ctxt id None >>?= fun ctxt -> + Storage.Delegate_sampler_state.remove_existing ctxt cycle +end + +module Random = struct + (* [init_random_state] initialize a random sequence drawing state + that's unique for a given (seed, level, index) triple. Elements + from this sequence are drawn using [take_int64], updating the + state for the next draw. The initial state is the Blake2b hash of + the three randomness sources, and an offset set to zero + (indicating that zero bits of randomness have been + consumed). When drawing random elements, bits are extracted from + the state until exhaustion (256 bits), at which point the state + is rehashed and the offset reset to 0. *) + + let init_random_state seed level index = + ( Raw_hashes.blake2b + (Data_encoding.Binary.to_bytes_exn + Data_encoding.(tup3 Seed_repr.seed_encoding int32 int32) + (seed, level.Level_repr.cycle_position, Int32.of_int index)), + 0 ) + + let take_int64 bound state = + let drop_if_over = + (* This function draws random values in [0-(bound-1)] by drawing + in [0-(2^63-1)] (64-bit) and computing the value modulo + [bound]. For the application of [mod bound] to preserve + uniformity, the input space must be of the form + [0-(n*bound-1)]. We enforce this by rejecting 64-bit samples + above this limit (in which case, we draw a new 64-sample from + the sequence and try again). *) + Int64.sub Int64.max_int (Int64.rem Int64.max_int bound) + in + let rec loop (bytes, n) = + let consumed_bytes = 8 in + let state_size = Bytes.length bytes in + if Compare.Int.(n > state_size - consumed_bytes) then + loop (Raw_hashes.blake2b bytes, 0) + else + let r = TzEndian.get_int64 bytes n in + (* The absolute value of min_int is min_int. Also, every + positive integer is represented twice (positive and negative), + but zero is only represented once. We fix both problems at + once. *) + let r = if Compare.Int64.(r = Int64.min_int) then 0L else Int64.abs r in + if Compare.Int64.(r >= drop_if_over) then + loop (bytes, n + consumed_bytes) + else + let v = Int64.rem r bound in + (v, (bytes, n + consumed_bytes)) + in + loop state + + (** [sampler_for_cycle ctxt cycle] reads the sampler for [cycle] from + [ctxt] if it has been previously inited. Otherwise it initializes + the sampler and caches it in [ctxt] with + [Raw_context.set_sampler_for_cycle]. *) + let sampler_for_cycle ctxt cycle = + let read ctxt = + Seed_storage.raw_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.raw_for_cycle ctxt cycle >>=? fun seed -> + compute_snapshot_index_for_seed ~max_snapshot_index seed + +let select_distribution_for_cycle ctxt cycle = + Stake_storage.max_snapshot_index ctxt >>=? fun max_snapshot_index -> + 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 6a07486f0c1ade58ac04baeffe062e7ce4535f15..306c912164449218cda66c538e6aa852de82202d 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..3601db429048330c350e7e707e1a3b9fcc12a760 --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml @@ -0,0 +1,132 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2022 G.B. Fefe, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type error += Unrequired_denunciation + +let () = + register_error_kind + `Branch + ~id:"block.unrequired_denunciation" + ~title:"Unrequired denunciation" + ~description:"A denunciation is unrequired" + ~pp:(fun ppf _ -> + Format.fprintf + ppf + "A valid denunciation cannot be applied: the associated delegate has \ + already been denounced for this level.") + Data_encoding.unit + (function Unrequired_denunciation -> Some () | _ -> None) + (fun () -> Unrequired_denunciation) + +let clear_outdated_slashed_deposits ctxt ~new_cycle = + let max_slashable_period = Constants_storage.max_slashing_period ctxt in + match Cycle_repr.(sub new_cycle max_slashable_period) with + | None -> Lwt.return ctxt + | Some outdated_cycle -> Storage.Slashed_deposits.clear (ctxt, outdated_cycle) + +let punish_double_endorsing ctxt delegate (level : Level_repr.t) = + let open Lwt_tzresult_syntax in + let* slashed = + Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate) + in + let* updated_slashed = + match slashed with + | None -> + return {Storage.for_double_endorsing = true; for_double_baking = false} + | Some slashed -> + let* () = + fail_when slashed.for_double_endorsing Unrequired_denunciation + in + return {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 -> + return {Storage.for_double_baking = true; for_double_endorsing = false} + | Some slashed -> + let* () = fail_when slashed.for_double_baking Unrequired_denunciation in + return {slashed with for_double_baking = true} + in + let delegate_contract = Contract_repr.Implicit delegate in + 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) 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..236be3438db2cc07fa3672d8bd0a10ce1fb20af3 --- /dev/null +++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli @@ -0,0 +1,63 @@ +(*****************************************************************************) +(* *) +(* 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. *) + +type error += Unrequired_denunciation + +(** 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 d2f0fa7c765693732737e996abd195f996c6f61c..6d38d93501196c5c042b02e97535ab18dd0091aa 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"),*) @@ -24,251 +25,11 @@ (* *) (*****************************************************************************) -type error += - | (* `Permanent *) No_deletion of Signature.Public_key_hash.t - | (* `Temporary *) Active_delegate - | (* `Temporary *) Current_delegate - | (* `Permanent *) Empty_delegate_account of Signature.Public_key_hash.t - | (* `Permanent *) Unregistered_delegate of Signature.Public_key_hash.t - | (* `Permanent *) Unassigned_validation_slot_for_level of Level_repr.t * int - | (* `Permanent *) - Cannot_find_active_stake of { - cycle : Cycle_repr.t; - delegate : Signature.Public_key_hash.t; - } - | (* `Temporary *) Not_registered of Signature.Public_key_hash.t +let registered = Storage.Delegates.mem -let () = - register_error_kind - `Permanent - ~id:"delegate.no_deletion" - ~title:"Forbidden delegate deletion" - ~description:"Tried to unregister a delegate" - ~pp:(fun ppf delegate -> - Format.fprintf - ppf - "Delegate deletion is forbidden (%a)" - Signature.Public_key_hash.pp - delegate) - Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) - (function No_deletion c -> Some c | _ -> None) - (fun c -> No_deletion c) ; - register_error_kind - `Temporary - ~id:"delegate.already_active" - ~title:"Delegate already active" - ~description:"Useless delegate reactivation" - ~pp:(fun ppf () -> - Format.fprintf ppf "The delegate is still active, no need to refresh it") - Data_encoding.empty - (function Active_delegate -> Some () | _ -> None) - (fun () -> Active_delegate) ; - register_error_kind - `Temporary - ~id:"delegate.unchanged" - ~title:"Unchanged delegated" - ~description:"Contract already delegated to the given delegate" - ~pp:(fun ppf () -> - Format.fprintf - ppf - "The contract is already delegated to the same delegate") - Data_encoding.empty - (function Current_delegate -> Some () | _ -> None) - (fun () -> Current_delegate) ; - register_error_kind - `Permanent - ~id:"delegate.empty_delegate_account" - ~title:"Empty delegate account" - ~description:"Cannot register a delegate when its implicit account is empty" - ~pp:(fun ppf delegate -> - Format.fprintf - ppf - "Delegate registration is forbidden when the delegate\n\ - \ implicit account is empty (%a)" - Signature.Public_key_hash.pp - delegate) - Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) - (function Empty_delegate_account c -> Some c | _ -> None) - (fun c -> Empty_delegate_account c) ; - (* Unregistered delegate *) - register_error_kind - `Permanent - ~id:"contract.manager.unregistered_delegate" - ~title:"Unregistered delegate" - ~description:"A contract cannot be delegated to an unregistered delegate" - ~pp:(fun ppf k -> - Format.fprintf - ppf - "The provided public key (with hash %a) is not registered as valid \ - delegate key." - Signature.Public_key_hash.pp - k) - Data_encoding.(obj1 (req "hash" Signature.Public_key_hash.encoding)) - (function Unregistered_delegate k -> Some k | _ -> None) - (fun k -> Unregistered_delegate k) ; - (* Unassigned_validation_slot_for_level *) - register_error_kind - `Permanent - ~id:"delegate.unassigned_validation_slot_for_level" - ~title:"Unassigned validation slot for level" - ~description: - "The validation slot for the given level is not assigned. Nobody payed \ - for that slot, or the level is either in the past or too far in the \ - future (further than the validatiors_selection_offset constant)" - ~pp:(fun ppf (l, slot) -> - Format.fprintf - ppf - "The validation slot %i for the level %a is not assigned. Nobody payed \ - for that slot, or the level is either in the past or too far in the \ - future (further than the validatiors_selection_offset constant)" - slot - Level_repr.pp - l) - Data_encoding.(obj2 (req "level" Level_repr.encoding) (req "slot" int31)) - (function - | Unassigned_validation_slot_for_level (l, s) -> Some (l, s) | _ -> None) - (fun (l, s) -> Unassigned_validation_slot_for_level (l, s)) ; - register_error_kind - `Permanent - ~id:"delegate.cannot_find_active_stake" - ~title:"Cannot find active stake" - ~description: - "The active stake of a delegate cannot be found for the given cycle." - ~pp:(fun ppf (cycle, delegate) -> - Format.fprintf - ppf - "The active stake of the delegate %a cannot be found for the cycle %a." - Cycle_repr.pp - cycle - Signature.Public_key_hash.pp - delegate) - Data_encoding.( - obj2 - (req "cycle" Cycle_repr.encoding) - (req "delegate" Signature.Public_key_hash.encoding)) - (function - | Cannot_find_active_stake {cycle; delegate} -> Some (cycle, delegate) - | _ -> None) - (fun (cycle, delegate) -> Cannot_find_active_stake {cycle; delegate}) ; - register_error_kind - `Temporary - ~id:"delegate.not_registered" - ~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 set_inactive ctxt delegate = - Delegate_activation_storage.set_inactive ctxt delegate >>= fun ctxt -> - Stake_storage.deactivate_only_call_from_delegate_storage ctxt delegate >|= ok - -let set_active ctxt delegate = - Delegate_activation_storage.set_active ctxt delegate - >>=? fun (ctxt, inactive) -> - if not inactive then return ctxt - else Stake_storage.activate_only_call_from_delegate_storage ctxt delegate - -let 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 init ctxt contract delegate = - Contract_manager_storage.is_manager_key_revealed ctxt delegate - >>=? fun known_delegate -> - error_unless known_delegate (Unregistered_delegate delegate) >>?= fun () -> - Contract_delegate_storage.registered ctxt delegate >>=? fun is_registered -> - error_unless is_registered (Unregistered_delegate delegate) >>?= fun () -> - Contract_delegate_storage.init ctxt contract delegate >>=? fun ctxt -> - Contract_storage.get_balance_and_frozen_bonds ctxt contract - >>=? fun balance_and_frozen_bonds -> - Stake_storage.add_stake ctxt delegate balance_and_frozen_bonds +let fold = Storage.Delegates.fold -let set c contract delegate = - match delegate with - | None -> ( - (* check if contract is a registered delegate *) - (match contract with - | Contract_repr.Implicit pkh -> - Contract_delegate_storage.registered c pkh >>=? fun is_registered -> - fail_when is_registered (No_deletion pkh) - | Originated _ -> return_unit) - >>=? fun () -> - Contract_delegate_storage.find c contract >>=? function - | None -> return c - | Some delegate -> - (* Removes the balance of the contract from the delegate *) - Contract_storage.get_balance_and_frozen_bonds c contract - >>=? fun balance_and_frozen_bonds -> - Stake_storage.remove_stake c delegate balance_and_frozen_bonds - >>=? fun c -> Contract_delegate_storage.delete c contract) - | Some delegate -> - Contract_manager_storage.is_manager_key_revealed c delegate - >>=? fun known_delegate -> - Contract_delegate_storage.registered c delegate - >>=? fun registered_delegate -> - let self_delegation = - match contract with - | Implicit pkh -> Signature.Public_key_hash.equal pkh delegate - | Originated _ -> false - in - if (not known_delegate) || not (registered_delegate || self_delegation) - then fail (Unregistered_delegate delegate) - else - Contract_delegate_storage.find c contract >>=? fun current_delegate -> - (match current_delegate with - | Some current_delegate - when Signature.Public_key_hash.equal delegate current_delegate -> - if self_delegation then - Delegate_activation_storage.is_inactive c delegate >>=? function - | true -> return_unit - | false -> fail Active_delegate - else fail Current_delegate - | None | Some _ -> return_unit) - >>=? fun () -> - (* check if contract is a registered delegate *) - (match contract with - | Contract_repr.Implicit pkh -> - Contract_delegate_storage.registered c pkh >>=? fun is_registered -> - (* allow self-delegation to re-activate *) - if (not self_delegation) && is_registered then - fail (No_deletion pkh) - else return_unit - | Originated _ -> return_unit) - >>=? fun () -> - Storage.Contract.Spendable_balance.mem c contract >>= fun exists -> - error_when - (self_delegation && not exists) - (Empty_delegate_account delegate) - >>?= fun () -> - Contract_storage.get_balance_and_frozen_bonds c contract - >>=? fun balance_and_frozen_bonds -> - Stake_storage.remove_contract_stake c contract balance_and_frozen_bonds - >>=? fun c -> - Contract_delegate_storage.set c contract delegate >>=? fun c -> - Stake_storage.add_stake c delegate balance_and_frozen_bonds - >>=? fun c -> - if self_delegation then - Storage.Delegates.add c delegate >>= fun c -> set_active c delegate - else return c +let list = Storage.Delegates.elements let frozen_deposits_limit ctxt delegate = Storage.Contract.Frozen_deposits_limit.find @@ -281,423 +42,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_rolls - ctxt - ~order:`Sorted - ~init:(Ok (ctxt, [])) - ~f:(fun delegate () acc -> - acc >>?= fun (ctxt, deactivated) -> - Delegate_activation_storage.last_cycle_before_deactivation - ctxt - delegate - >>=? fun cycle -> - if Cycle_repr.(cycle <= last_cycle) then - set_inactive ctxt delegate >|=? fun ctxt -> - (ctxt, delegate :: deactivated) - else return (ctxt, deactivated)) - >|=? fun (ctxt, deactivated) -> (ctxt, deactivated) - -let expected_slots_for_given_active_stake ctxt ~total_active_stake ~active_stake - = - let blocks_per_cycle = - Int32.to_int (Constants_storage.blocks_per_cycle ctxt) - in - let consensus_committee_size = - Constants_storage.consensus_committee_size ctxt - in - let number_of_endorsements_per_cycle = - blocks_per_cycle * consensus_committee_size - in - Result.return - (Z.to_int - (Z.div - (Z.mul - (Z.of_int64 (Tez_repr.to_mutez active_stake)) - (Z.of_int number_of_endorsements_per_cycle)) - (Z.of_int64 (Tez_repr.to_mutez total_active_stake)))) - -let delegate_participated_enough ctxt delegate = - Storage.Contract.Missed_endorsements.find ctxt delegate >>=? function - | None -> return_true - | Some missed_endorsements -> - return Compare.Int.(missed_endorsements.remaining_slots >= 0) - -let delegate_has_revealed_nonces delegate unrevelead_nonces_set = - not (Signature.Public_key_hash.Set.mem delegate unrevelead_nonces_set) - -let distribute_endorsing_rewards ctxt last_cycle unrevealed_nonces = - let endorsing_reward_per_slot = - Constants_storage.endorsing_reward_per_slot ctxt - in - let unrevealed_nonces_set = - List.fold_left - (fun set {Storage.Seed.nonce_hash = _; delegate} -> - Signature.Public_key_hash.Set.add delegate set) - Signature.Public_key_hash.Set.empty - unrevealed_nonces - in - Stake_storage.get_total_active_stake ctxt last_cycle - >>=? fun total_active_stake -> - Stake_storage.get_selected_distribution ctxt last_cycle >>=? fun delegates -> - List.fold_left_es - (fun (ctxt, balance_updates) (delegate, active_stake) -> - let delegate_contract = Contract_repr.Implicit delegate in - delegate_participated_enough ctxt delegate_contract - >>=? fun sufficient_participation -> - let has_revealed_nonces = - delegate_has_revealed_nonces delegate unrevealed_nonces_set - in - expected_slots_for_given_active_stake - ctxt - ~total_active_stake - ~active_stake - >>?= fun expected_slots -> - let rewards = Tez_repr.mul_exn endorsing_reward_per_slot expected_slots in - (if sufficient_participation && has_revealed_nonces then - (* Sufficient participation: we pay the rewards *) - Token.transfer - ctxt - `Endorsing_rewards - (`Contract delegate_contract) - rewards - >|=? fun (ctxt, payed_rewards_receipts) -> - (ctxt, payed_rewards_receipts @ balance_updates) - else - (* Insufficient participation or unrevealed nonce: no rewards *) - Token.transfer - ctxt - `Endorsing_rewards - (`Lost_endorsing_rewards - (delegate, not sufficient_participation, not has_revealed_nonces)) - rewards - >|=? fun (ctxt, payed_rewards_receipts) -> - (ctxt, payed_rewards_receipts @ balance_updates)) - >>=? fun (ctxt, balance_updates) -> - Storage.Contract.Missed_endorsements.remove ctxt delegate_contract - >>= fun ctxt -> return (ctxt, balance_updates)) - (ctxt, []) - delegates - -let clear_outdated_slashed_deposits ctxt ~new_cycle = - let max_slashable_period = Constants_storage.max_slashing_period ctxt in - match Cycle_repr.(sub new_cycle max_slashable_period) with - | None -> Lwt.return ctxt - | Some outdated_cycle -> Storage.Slashed_deposits.clear (ctxt, outdated_cycle) - -(* Return a map from delegates (with active stake at some cycle - in the cycle window [from_cycle, to_cycle]) to the maximum - of the stake to be deposited for each such cycle (which is just the - [frozen_deposits_percentage] of the active stake at that cycle). Also - return the delegates that have fallen out of the sliding window. *) -let max_frozen_deposits_and_delegates_to_remove ctxt ~from_cycle ~to_cycle = - let frozen_deposits_percentage = - Constants_storage.frozen_deposits_percentage ctxt - in - let cycles = Cycle_repr.(from_cycle ---> to_cycle) in - (match Cycle_repr.pred from_cycle with - | None -> return Signature.Public_key_hash.Set.empty - | Some cleared_cycle -> ( - Stake_storage.find_selected_distribution ctxt cleared_cycle - >|=? fun cleared_cycle_delegates -> - match cleared_cycle_delegates with - | None -> Signature.Public_key_hash.Set.empty - | Some delegates -> - List.fold_left - (fun set (d, _) -> Signature.Public_key_hash.Set.add d set) - Signature.Public_key_hash.Set.empty - delegates)) - >>=? fun cleared_cycle_delegates -> - List.fold_left_es - (fun (maxima, delegates_to_remove) (cycle : Cycle_repr.t) -> - Stake_storage.get_selected_distribution ctxt cycle - >|=? fun active_stakes -> - List.fold_left - (fun (maxima, delegates_to_remove) (delegate, stake) -> - let stake_to_be_deposited = - Tez_repr.(div_exn (mul_exn stake frozen_deposits_percentage) 100) - in - let maxima = - Signature.Public_key_hash.Map.update - delegate - (function - | None -> Some stake_to_be_deposited - | Some maximum -> - Some (Tez_repr.max maximum stake_to_be_deposited)) - maxima - in - let delegates_to_remove = - Signature.Public_key_hash.Set.remove delegate delegates_to_remove - in - (maxima, delegates_to_remove)) - (maxima, delegates_to_remove) - active_stakes) - (Signature.Public_key_hash.Map.empty, cleared_cycle_delegates) - cycles - -let freeze_deposits ?(origin = Receipt_repr.Block_application) ctxt ~new_cycle - ~balance_updates = - let max_slashable_period = Constants_storage.max_slashing_period ctxt in - (* We want to be able to slash for at most [max_slashable_period] *) - (match Cycle_repr.(sub new_cycle (max_slashable_period - 1)) with - | None -> - Storage.Tenderbake.First_level_of_protocol.get ctxt - >>=? fun first_level_of_protocol -> - let cycle_eras = Raw_context.cycle_eras ctxt in - let level = - Level_repr.level_from_raw ~cycle_eras first_level_of_protocol - in - return level.cycle - | Some cycle -> return cycle) - >>=? fun from_cycle -> - let preserved_cycles = Constants_storage.preserved_cycles ctxt in - let to_cycle = Cycle_repr.(add new_cycle preserved_cycles) in - max_frozen_deposits_and_delegates_to_remove ctxt ~from_cycle ~to_cycle - >>=? fun (maxima, delegates_to_remove) -> - Signature.Public_key_hash.Map.fold_es - (fun delegate maximum_stake_to_be_deposited (ctxt, balance_updates) -> - (* Here we make sure to preserve the following invariant : - maximum_stake_to_be_deposited <= frozen_deposits + balance - See select_distribution_for_cycle *) - let delegate_contract = Contract_repr.Implicit delegate in - Frozen_deposits_storage.update_initial_amount - ctxt - delegate_contract - maximum_stake_to_be_deposited - >>=? fun ctxt -> - Frozen_deposits_storage.get ctxt delegate_contract >>=? fun deposits -> - let current_amount = deposits.current_amount in - if Tez_repr.(current_amount > maximum_stake_to_be_deposited) then - Tez_repr.(current_amount -? maximum_stake_to_be_deposited) - >>?= fun to_reimburse -> - Token.transfer - ~origin - ctxt - (`Frozen_deposits delegate) - (`Delegate_balance delegate) - to_reimburse - >|=? fun (ctxt, bupds) -> (ctxt, bupds @ balance_updates) - else if Tez_repr.(current_amount < maximum_stake_to_be_deposited) then - Tez_repr.(maximum_stake_to_be_deposited -? current_amount) - >>?= fun desired_to_freeze -> - Storage.Contract.Spendable_balance.get ctxt delegate_contract - >>=? fun balance -> - (* In case the delegate hasn't been slashed in this cycle, - the following invariant holds: - maximum_stake_to_be_deposited <= frozen_deposits + balance - See select_distribution_for_cycle - - If the delegate has been slashed during the cycle, the invariant - above doesn't necessarily hold. In this case, we freeze the max - we can for the delegate. *) - let to_freeze = Tez_repr.(min balance desired_to_freeze) in - Token.transfer - ~origin - ctxt - (`Delegate_balance delegate) - (`Frozen_deposits delegate) - to_freeze - >|=? fun (ctxt, bupds) -> (ctxt, bupds @ balance_updates) - else return (ctxt, balance_updates)) - maxima - (ctxt, balance_updates) - >>=? fun (ctxt, balance_updates) -> - (* Unfreeze deposits (that is, set them to zero) for delegates that - were previously in the relevant window (and therefore had some - frozen deposits) but are not in the new window; because that means - that such a delegate had no active stake in the relevant cycles, - and therefore it should have no frozen deposits. *) - Signature.Public_key_hash.Set.fold_es - (fun delegate (ctxt, balance_updates) -> - let delegate_contract = Contract_repr.Implicit delegate in - Frozen_deposits_storage.update_initial_amount - ctxt - delegate_contract - Tez_repr.zero - >>=? fun ctxt -> - Frozen_deposits_storage.get ctxt delegate_contract - >>=? fun frozen_deposits -> - if Tez_repr.(frozen_deposits.current_amount > zero) then - Token.transfer - ~origin - ctxt - (`Frozen_deposits delegate) - (`Delegate_balance delegate) - frozen_deposits.current_amount - >|=? fun (ctxt, bupds) -> (ctxt, bupds @ balance_updates) - else return (ctxt, balance_updates)) - delegates_to_remove - (ctxt, balance_updates) - -let freeze_deposits_do_not_call_except_for_migration = - freeze_deposits ~origin:Protocol_migration - -module Delegate_sampler_state = struct - module Cache_client = struct - type cached_value = - (Signature.Public_key.t * Signature.Public_key_hash.t) Sampler.t - - let namespace = Cache_repr.create_namespace "sampler_state" - - let cache_index = 2 - - let value_of_identifier ctxt identifier = - let cycle = Cycle_repr.of_string_exn identifier in - Storage.Delegate_sampler_state.get ctxt cycle - end - - module Cache = (val Cache_repr.register_exn (module Cache_client)) - - let identifier_of_cycle cycle = Format.asprintf "%a" Cycle_repr.pp cycle - - let init ctxt cycle sampler_state = - let id = identifier_of_cycle cycle in - Storage.Delegate_sampler_state.init ctxt cycle sampler_state - >>=? fun ctxt -> - let size = 1 (* that's symbolic: 1 cycle = 1 entry *) in - Cache.update ctxt id (Some (sampler_state, size)) >>?= fun ctxt -> - return ctxt - - let get ctxt cycle = - let id = identifier_of_cycle cycle in - Cache.find ctxt id >>=? function - | None -> Storage.Delegate_sampler_state.get ctxt cycle - | Some v -> return v - - let remove_existing ctxt cycle = - let id = identifier_of_cycle cycle in - Cache.update ctxt id None >>?= fun ctxt -> - Storage.Delegate_sampler_state.remove_existing ctxt cycle -end - -let get_stakes_for_selected_index ctxt index = - Stake_storage.fold_snapshot - ctxt - ~index - ~f:(fun (delegate, staking_balance) (acc, total_stake) -> - let delegate_contract = Contract_repr.Implicit delegate in - let open Tez_repr in - let open Lwt_result_syntax in - let* frozen_deposits_limit = - Storage.Contract.Frozen_deposits_limit.find ctxt delegate_contract - in - - let* balance_and_frozen_bonds = - Contract_storage.get_balance_and_frozen_bonds ctxt delegate_contract - in - let* frozen_deposits = - Frozen_deposits_storage.get ctxt delegate_contract - in - let*? total_balance = - balance_and_frozen_bonds +? frozen_deposits.current_amount - in - let* stake_for_cycle = - let frozen_deposits_percentage = - Int64.of_int @@ Constants_storage.frozen_deposits_percentage ctxt - in - let max_mutez = of_mutez_exn Int64.max_int in - let frozen_deposits_limit = - match frozen_deposits_limit with Some fdp -> fdp | None -> max_mutez - in - let aux = min total_balance frozen_deposits_limit in - let*? overflow_bound = max_mutez /? 100L in - if aux <= overflow_bound then - let*? aux = aux *? 100L in - let*? v = aux /? frozen_deposits_percentage in - return (min v staking_balance) - else - let*? sbal = staking_balance /? 100L in - let*? a = aux /? frozen_deposits_percentage in - if sbal <= a then return staking_balance - else - let*? r = max_mutez /? frozen_deposits_percentage in - return r - in - let*? total_stake = Tez_repr.(total_stake +? stake_for_cycle) in - return ((delegate, stake_for_cycle) :: acc, total_stake)) - ~init:([], Tez_repr.zero) - -let compute_snapshot_index_for_seed ~max_snapshot_index seed = - let rd = Seed_repr.initialize_new seed [Bytes.of_string "stake_snapshot"] in - let seq = Seed_repr.sequence rd 0l in - Seed_repr.take_int32 seq (Int32.of_int max_snapshot_index) - |> fst |> Int32.to_int |> return - -let compute_snapshot_index ctxt cycle ~max_snapshot_index = - Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed -> - compute_snapshot_index_for_seed ~max_snapshot_index seed - -let select_distribution_for_cycle ctxt cycle = - Stake_storage.max_snapshot_index ctxt >>=? fun max_snapshot_index -> - Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed -> - compute_snapshot_index_for_seed ~max_snapshot_index seed - >>=? fun selected_index -> - get_stakes_for_selected_index ctxt selected_index - >>=? fun (stakes, total_stake) -> - Stake_storage.set_selected_distribution_for_cycle - ctxt - cycle - stakes - total_stake - >>=? fun ctxt -> - List.fold_left_es - (fun acc (pkh, stake) -> - pubkey ctxt pkh >|=? fun pk -> ((pk, pkh), Tez_repr.to_mutez stake) :: acc) - [] - stakes - >>=? fun stakes_pk -> - let state = Sampler.create stakes_pk in - Delegate_sampler_state.init ctxt cycle state >>=? fun ctxt -> - (* pre-allocate the sampler *) - Lwt.return (Raw_context.init_sampler_for_cycle ctxt cycle seed state) - -let select_new_distribution_at_cycle_end ctxt ~new_cycle = - let preserved = Constants_storage.preserved_cycles ctxt in - let for_cycle = Cycle_repr.add new_cycle preserved in - select_distribution_for_cycle ctxt for_cycle - -let clear_outdated_sampling_data ctxt ~new_cycle = - let max_slashing_period = Constants_storage.max_slashing_period ctxt in - match Cycle_repr.sub new_cycle max_slashing_period with - | None -> return ctxt - | Some outdated_cycle -> - Delegate_sampler_state.remove_existing ctxt outdated_cycle - >>=? fun ctxt -> - Storage.Seed.For_cycle.remove_existing ctxt outdated_cycle - -let cycle_end ctxt last_cycle unrevealed_nonces = - let new_cycle = Cycle_repr.add last_cycle 1 in - select_new_distribution_at_cycle_end ctxt ~new_cycle >>=? fun ctxt -> - clear_outdated_slashed_deposits ctxt ~new_cycle >>= fun ctxt -> - distribute_endorsing_rewards ctxt last_cycle unrevealed_nonces - >>=? fun (ctxt, balance_updates) -> - freeze_deposits ctxt ~new_cycle ~balance_updates - >>=? fun (ctxt, balance_updates) -> - Stake_storage.clear_at_cycle_end ctxt ~new_cycle >>=? fun ctxt -> - clear_outdated_sampling_data ctxt ~new_cycle >>=? fun ctxt -> - update_activity ctxt last_cycle >>=? fun (ctxt, deactivated_delagates) -> - return (ctxt, balance_updates, deactivated_delagates) +let frozen_deposits ctxt delegate = + Frozen_deposits_storage.get ctxt (Contract_repr.Implicit delegate) let balance ctxt delegate = let contract = Contract_repr.Implicit delegate in Storage.Contract.Spendable_balance.get ctxt contract -let frozen_deposits ctxt delegate = - Frozen_deposits_storage.get ctxt (Contract_repr.Implicit delegate) - -let full_balance ctxt delegate = - frozen_deposits ctxt delegate >>=? fun frozen_deposits -> - let delegate_contract = Contract_repr.Implicit delegate in - Contract_storage.get_balance_and_frozen_bonds ctxt delegate_contract - >>=? fun balance_and_frozen_bonds -> - Lwt.return - Tez_repr.(frozen_deposits.current_amount +? balance_and_frozen_bonds) - -let deactivated = Delegate_activation_storage.is_inactive +let staking_balance ctxt delegate = + registered ctxt delegate >>= fun is_registered -> + if is_registered then Stake_storage.get_staking_balance ctxt delegate + else return Tez_repr.zero let delegated_balance ctxt delegate = staking_balance ctxt delegate >>=? fun staking_balance -> @@ -707,347 +62,196 @@ let delegated_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 = - Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed -> - Delegate_sampler_state.get ctxt cycle >>=? fun state -> - return (seed, state) - in - Raw_context.sampler_for_cycle ~read ctxt cycle - - let owner c (level : Level_repr.t) offset = - let cycle = level.Level_repr.cycle in - sampler_for_cycle c cycle >>=? fun (c, seed, state) -> - let sample ~int_bound ~mass_bound = - let state = init_random_state seed level offset in - let i, state = take_int64 (Int64.of_int int_bound) state in - let elt, _ = take_int64 mass_bound state in - (Int64.to_int i, elt) - in - let pk, pkh = Sampler.sample state sample in - return (c, (pk, pkh)) -end - -let slot_owner c level slot = Random.owner c level (Slot_repr.to_int slot) - -let baking_rights_owner c (level : Level_repr.t) ~round = - Round_repr.to_int round >>?= fun round -> - let consensus_committee_size = Constants_storage.consensus_committee_size c in - Slot_repr.of_int (round mod consensus_committee_size) >>?= fun slot -> - slot_owner c level slot >>=? fun (ctxt, pk) -> return (ctxt, slot, pk) - -let already_slashed_for_double_endorsing ctxt delegate (level : Level_repr.t) = - Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate) - >>=? function - | None -> return_false - | Some slashed -> return slashed.for_double_endorsing - -let already_slashed_for_double_baking ctxt delegate (level : Level_repr.t) = - Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate) - >>=? function - | None -> return_false - | Some slashed -> return slashed.for_double_baking - -let punish_double_endorsing ctxt delegate (level : Level_repr.t) = - let delegate_contract = Contract_repr.Implicit delegate in - Frozen_deposits_storage.get ctxt delegate_contract >>=? fun frozen_deposits -> - let slashing_ratio : Ratio_repr.t = - Constants_storage.ratio_of_frozen_deposits_slashed_per_double_endorsement - ctxt - in - let punish_value = - Tez_repr.( - div_exn - (mul_exn frozen_deposits.initial_amount slashing_ratio.numerator) - slashing_ratio.denominator) - in - let amount_to_burn = - Tez_repr.(min frozen_deposits.current_amount punish_value) - in - Token.transfer - ctxt - (`Frozen_deposits delegate) - `Double_signing_punishments - amount_to_burn - >>=? fun (ctxt, balance_updates) -> - Stake_storage.remove_stake ctxt delegate amount_to_burn >>=? fun ctxt -> - Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate) - >>=? fun slashed -> - let slashed : Storage.slashed_level = - match slashed with - | None -> {for_double_endorsing = true; for_double_baking = false} - | Some slashed -> - assert (Compare.Bool.(slashed.for_double_endorsing = false)) ; - {slashed with for_double_endorsing = true} - in - Storage.Slashed_deposits.add - (ctxt, level.cycle) - (level.level, delegate) - slashed - >>= fun ctxt -> return (ctxt, amount_to_burn, balance_updates) - -let punish_double_baking ctxt delegate (level : Level_repr.t) = +let full_balance ctxt delegate = + frozen_deposits ctxt delegate >>=? fun frozen_deposits -> 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; -} + Contract_storage.get_balance_and_frozen_bonds ctxt delegate_contract + >>=? fun balance_and_frozen_bonds -> + Lwt.return + Tez_repr.(frozen_deposits.current_amount +? balance_and_frozen_bonds) -(* 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 +module Contract = struct + type error += + | (* `Permanent *) Unregistered_delegate of Signature.Public_key_hash.t + + let () = + (* Unregistered delegate *) + register_error_kind + `Permanent + ~id:"contract.manager.unregistered_delegate" + ~title:"Unregistered delegate" + ~description:"A contract cannot be delegated to an unregistered delegate" + ~pp:(fun ppf k -> + Format.fprintf + ppf + "The provided public key (with hash %a) is not registered as valid \ + delegate key." + Signature.Public_key_hash.pp + k) + Data_encoding.(obj1 (req "hash" Signature.Public_key_hash.encoding)) + (function Unregistered_delegate k -> Some k | _ -> None) + (fun k -> Unregistered_delegate k) + + let init ctxt contract delegate = + Contract_manager_storage.is_manager_key_revealed ctxt delegate + >>=? fun known_delegate -> + error_unless known_delegate (Unregistered_delegate delegate) >>?= fun () -> + registered ctxt delegate >>= fun is_registered -> + error_unless is_registered (Unregistered_delegate delegate) >>?= fun () -> + Contract_delegate_storage.init ctxt contract delegate >>=? fun ctxt -> + Contract_storage.get_balance_and_frozen_bonds ctxt contract + >>=? fun balance_and_frozen_bonds -> + Stake_storage.add_stake ctxt delegate balance_and_frozen_bonds + + type error += + | (* `Temporary *) Active_delegate + | (* `Permanent *) Empty_delegate_account of Signature.Public_key_hash.t + + let () = + register_error_kind + `Temporary + ~id:"delegate.already_active" + ~title:"Delegate already active" + ~description:"Useless delegate reactivation" + ~pp:(fun ppf () -> + Format.fprintf ppf "The delegate is still active, no need to refresh it") + Data_encoding.empty + (function Active_delegate -> Some () | _ -> None) + (fun () -> Active_delegate) ; + register_error_kind + `Permanent + ~id:"delegate.empty_delegate_account" + ~title:"Empty delegate account" + ~description: + "Cannot register a delegate when its implicit account is empty" + ~pp:(fun ppf delegate -> + Format.fprintf + ppf + "Delegate registration is forbidden when the delegate\n\ + \ implicit account is empty (%a)" + Signature.Public_key_hash.pp + delegate) + Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) + (function Empty_delegate_account c -> Some c | _ -> None) + (fun c -> Empty_delegate_account c) + + let set_self_delegate c delegate = + let open Lwt_tzresult_syntax in + let*! is_registered = registered c delegate in + if is_registered then + let* () = + let* is_inactive = Delegate_activation_storage.is_inactive c delegate in + fail_unless is_inactive Active_delegate in - let minimal_cycle_activity = - expected_cycle_activity * numerator / denominator - in - let maximal_cycle_inactivity = - expected_cycle_activity - minimal_cycle_activity + Stake_storage.set_active c delegate + else + let contract = Contract_repr.Implicit delegate in + let* () = + let* is_pk_revealed = + Contract_manager_storage.is_manager_key_revealed c delegate + in + fail_unless is_pk_revealed (Unregistered_delegate delegate) in - let expected_endorsing_rewards = - Tez_repr.mul_exn endorsing_reward_per_slot expected_cycle_activity + let* () = + let*! is_allocated = Contract_storage.allocated c contract in + fail_unless is_allocated (Empty_delegate_account delegate) 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 ) + let* balance_and_frozen_bonds = + Contract_storage.get_balance_and_frozen_bonds c contract in - let expected_endorsing_rewards = - match missed_endorsements with - | Some r when Compare.Int.(r.remaining_slots < 0) -> Tez_repr.zero - | _ -> expected_endorsing_rewards + let* c = + Stake_storage.remove_contract_stake c contract balance_and_frozen_bonds in - return - { - expected_cycle_activity; - minimal_cycle_activity; - missed_slots; - missed_levels; - remaining_allowed_missed_slots; - expected_endorsing_rewards; - } + let* c = Contract_delegate_storage.set c contract delegate in + let* c = Stake_storage.add_stake c delegate balance_and_frozen_bonds in + let*! c = Storage.Delegates.add c delegate in + let* c = Stake_storage.set_active c delegate in + return c + + type error += + | (* `Permanent *) No_deletion of Signature.Public_key_hash.t + | (* `Temporary *) Current_delegate + + let () = + register_error_kind + `Permanent + ~id:"delegate.no_deletion" + ~title:"Forbidden delegate deletion" + ~description:"Tried to unregister a delegate" + ~pp:(fun ppf delegate -> + Format.fprintf + ppf + "Delegate deletion is forbidden (%a)" + Signature.Public_key_hash.pp + delegate) + Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding)) + (function No_deletion c -> Some c | _ -> None) + (fun c -> No_deletion c) ; + register_error_kind + `Temporary + ~id:"delegate.unchanged" + ~title:"Unchanged delegated" + ~description:"Contract already delegated to the given delegate" + ~pp:(fun ppf () -> + Format.fprintf + ppf + "The contract is already delegated to the same delegate") + Data_encoding.empty + (function Current_delegate -> Some () | _ -> None) + (fun () -> Current_delegate) + + let set_delegate c contract delegate = + let open Lwt_tzresult_syntax in + let* () = + match contract with + | Contract_repr.Originated _ -> return_unit + | Implicit pkh -> + let*! is_registered = registered c pkh in + fail_when is_registered (No_deletion pkh) + in + let* () = + let* current_delegate = Contract_delegate_storage.find c contract in + match (delegate, current_delegate) with + | None, None -> + (* we don't fail in this case in order not to risk breaking + existing smart contracts. *) + return_unit + | Some delegate, Some current_delegate + when Signature.Public_key_hash.equal delegate current_delegate -> + fail Current_delegate + | _ -> return_unit + in + let* balance_and_frozen_bonds = + Contract_storage.get_balance_and_frozen_bonds c contract + in + let* c = + Stake_storage.remove_contract_stake c contract balance_and_frozen_bonds + in + match delegate with + | None -> + let* c = Contract_delegate_storage.delete c contract in + return c + | Some delegate -> + let* () = + let*! is_delegate_registered = registered c delegate in + fail_when + (not is_delegate_registered) + (Unregistered_delegate delegate) + in + let* c = Contract_delegate_storage.set c contract delegate in + let* c = Stake_storage.add_stake c delegate balance_and_frozen_bonds in + return c + + let set c contract delegate = + match (delegate, contract) with + | Some delegate, Contract_repr.Implicit source + when Signature.Public_key_hash.equal source delegate -> + set_self_delegate c delegate + | _ -> set_delegate c contract delegate +end -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 pkh = + Contract_manager_storage.get_manager_key + ~error:(Contract.Unregistered_delegate pkh) ctxt - Misc.(0 --> preserved) + pkh diff --git a/src/proto_alpha/lib_protocol/delegate_storage.mli b/src/proto_alpha/lib_protocol/delegate_storage.mli index cba3a98d9746d652c2f235d4fcc5af48f36bf48d..262a49ce3f528b7d543ffed4d5672687cb6177f9 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,91 +25,18 @@ (* *) (*****************************************************************************) -(** Allow to register a delegate when creating an account. *) -val init : - Raw_context.t -> - Contract_repr.t -> - Signature.Public_key_hash.t -> - Raw_context.t tzresult Lwt.t - -val pubkey : - Raw_context.t -> - Signature.Public_key_hash.t -> - Signature.Public_key.t tzresult Lwt.t - -(** Updating the delegate of a contract. - - When calling this function on an "implicit contract" and setting - the delegate to the contract manager registers it as a delegate. One - cannot unregister a delegate for now. The associate contract is now - 'undeletable'. *) -val set : - Raw_context.t -> - Contract_repr.t -> - Signature.Public_key_hash.t option -> - Raw_context.t tzresult Lwt.t - -val frozen_deposits_limit : - Raw_context.t -> - Signature.Public_key_hash.t -> - Tez_repr.t option tzresult Lwt.t - -val set_frozen_deposits_limit : - Raw_context.t -> - Signature.Public_key_hash.t -> - Tez_repr.t option -> - Raw_context.t Lwt.t - -type error += - | (* `Permanent *) No_deletion of Signature.Public_key_hash.t - | (* `Temporary *) Active_delegate - | (* `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 +(** This module groups everything related to delegate registration. + For the invariants maintained, see the submodule {!Contract}. -(** 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 + It also groups "trivial" getters/setters related to delegates. -(** 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) *) -} + It is responsible for maintaining the following tables: + - {!Storage.Contract.Frozen_deposits_limit} + - {!Storage.Delegates} +*) -(** Only use this function for RPC: this is expensive. - - [delegate_participation_info] and [!val:check_delegate] forms the - implementation of RPC call "/context/delegates//participation". - *) -val delegate_participation_info : - Raw_context.t -> - Signature.Public_key_hash.t -> - participation_info tzresult Lwt.t +(** Has a delegate been registered in the delegate table? *) +val registered : Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t (** Iterate on all registered delegates. *) val fold : @@ -121,85 +49,35 @@ val fold : (** List all registered delegates. *) val list : Raw_context.t -> Signature.Public_key_hash.t list Lwt.t -val balance : - Raw_context.t -> Signature.public_key_hash -> Tez_repr.tez tzresult Lwt.t - -type level_participation = Participated | Didn't_participate - -(** Record the participation of a delegate as a validator. *) -val record_endorsing_participation : - Raw_context.t -> - delegate:Signature.Public_key_hash.t -> - participation:level_participation -> - endorsing_power:int -> - Raw_context.t tzresult Lwt.t - -(** Sets the payload and block producer as active. Pays the baking - reward and the fees to the payload producer and the reward bonus to - the payload producer (if the reward_bonus is not None).*) -val record_baking_activity_and_pay_rewards_and_fees : - Raw_context.t -> - payload_producer:Signature.Public_key_hash.t -> - block_producer:Signature.Public_key_hash.t -> - baking_reward:Tez_repr.t -> - reward_bonus:Tez_repr.t option -> - (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t - -(** Trigger the context maintenance at the end of cycle 'n', i.e.: - unfreeze the endorsing rewards, potentially deactivate delegates. - Return the corresponding balances updates and the list of - deactivated delegates. *) -val cycle_end : - Raw_context.t -> - Cycle_repr.t -> - Storage.Seed.unrevealed_nonce list -> - (Raw_context.t - * Receipt_repr.balance_updates - * Signature.Public_key_hash.t list) - tzresult - Lwt.t - -(** Returns true if the given delegate has already been slashed - for double baking for the given level. *) -val already_slashed_for_double_baking : - Raw_context.t -> - Signature.Public_key_hash.t -> - Level_repr.t -> - bool tzresult Lwt.t - -(** Returns true if the given delegate has already been slashed - for double preendorsing or double endorsing for the given level. *) -val already_slashed_for_double_endorsing : - Raw_context.t -> - Signature.Public_key_hash.t -> - Level_repr.t -> - bool tzresult Lwt.t - -(** Burn some frozen deposit for a delegate at a given level. Returns - the burned amount. *) -val punish_double_endorsing : +val frozen_deposits_limit : Raw_context.t -> Signature.Public_key_hash.t -> - Level_repr.t -> - (Raw_context.t * Tez_repr.t * Receipt_repr.balance_updates) tzresult Lwt.t + Tez_repr.t option tzresult Lwt.t -val punish_double_baking : +val set_frozen_deposits_limit : Raw_context.t -> Signature.Public_key_hash.t -> - Level_repr.t -> - (Raw_context.t * Tez_repr.t * Receipt_repr.balance_updates) tzresult Lwt.t + Tez_repr.t option -> + Raw_context.t Lwt.t (** Returns a delegate's frozen deposits, both the current amount and the initial freezed amount. A delegate's frozen balance is only composed of frozen deposits; - rewards and fees are not frozen, but simply credited at the right - moment. *) + rewards and fees are not frozen, but simply credited at the right + moment. *) val frozen_deposits : Raw_context.t -> Signature.Public_key_hash.t -> Storage.deposits tzresult Lwt.t +val staking_balance : + Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t + +(** Only use this function for RPCs: this is expensive. *) +val delegated_balance : + Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t + (** Returns the full 'balance' of the implicit contract associated to a given key, i.e. the sum of the spendable balance (given by [balance] or [Contract_storage.get_balance]) and of the frozen balance. The frozen @@ -211,55 +89,54 @@ 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 : +(** This module ensures the following invariants: + - registered delegates (i.e. those that appear in {!Storage.Delegates}) are + self-delegated (i.e. {!Contract_delegate_storage.find} [delegate] returns [delegate]), + - registered delegates have their public keys revealed, + - registered delegates cannot change their delegation, + - stake is properly moved when changing delegation. +*) +module Contract : sig + type error += + | (* `Permanent *) Unregistered_delegate of Signature.Public_key_hash.t + | (* `Temporary *) Active_delegate + | (* `Permanent *) Empty_delegate_account of Signature.Public_key_hash.t + | (* `Permanent *) No_deletion of Signature.Public_key_hash.t + | (* `Temporary *) Current_delegate + + (** [init ctxt contract delegate] registers a delegate when + creating a contract. + + This functions assumes that [contract] is allocated. + This function returns an error if [contract] already has a delegate or + if [delegate] is not a registered delegate. *) + val init : + Raw_context.t -> + Contract_repr.t -> + Signature.Public_key_hash.t -> + Raw_context.t tzresult Lwt.t + + (** [set ctxt contract delegate_opt] allows to set the + delegate of a contract to [delegate] when [delegate_opt = Some delegate] + or to unset the delegate when [delegate_opt = None]. + When [delegate_opt = Some contract] (aka self-delegation), + the function also registers the contract as a delegate and + sets the delegate as {{!module:Delegate_activation_storage}active}. + + It returns an error when trying to set the delegate to an unregistered delegate. + It returns an error when trying to unset or change the delegate of a registered delegate. + It returns an error when self-delegating and the delegate is not {{!Contract_storage.allocated}allocated}. + It returns an error when self-delegating and the delegate is already active. *) + val set : + Raw_context.t -> + Contract_repr.t -> + Signature.Public_key_hash.t option -> + Raw_context.t tzresult Lwt.t +end + +(** Returns the public key of a registered delegate. Returns the error + {!Contract.Unregistered_delegate} if the delegate is not registered. *) +val pubkey : Raw_context.t -> - 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 a14172d55b10fa99320b5eb609d5856faadc1de8..5af750185614754449de28ff353938125aa7518d 100644 --- a/src/proto_alpha/lib_protocol/dune +++ b/src/proto_alpha/lib_protocol/dune @@ -149,6 +149,10 @@ Contract_storage Token Delegate_storage + Delegate_missed_endorsements_storage + Delegate_slashed_deposits_storage + Delegate_sampler + Delegate_cycles Bootstrap_storage Vote_storage Fees_storage @@ -385,6 +389,11 @@ contract_storage.ml contract_storage.mli token.ml token.mli delegate_storage.ml delegate_storage.mli + delegate_missed_endorsements_storage.ml + delegate_missed_endorsements_storage.mli + delegate_slashed_deposits_storage.ml delegate_slashed_deposits_storage.mli + delegate_sampler.ml delegate_sampler.mli + delegate_cycles.ml delegate_cycles.mli bootstrap_storage.ml bootstrap_storage.mli vote_storage.ml vote_storage.mli fees_storage.ml fees_storage.mli @@ -609,6 +618,11 @@ contract_storage.ml contract_storage.mli token.ml token.mli delegate_storage.ml delegate_storage.mli + delegate_missed_endorsements_storage.ml + delegate_missed_endorsements_storage.mli + delegate_slashed_deposits_storage.ml delegate_slashed_deposits_storage.mli + delegate_sampler.ml delegate_sampler.mli + delegate_cycles.ml delegate_cycles.mli bootstrap_storage.ml bootstrap_storage.mli vote_storage.ml vote_storage.mli fees_storage.ml fees_storage.mli @@ -837,6 +851,11 @@ contract_storage.ml contract_storage.mli token.ml token.mli delegate_storage.ml delegate_storage.mli + delegate_missed_endorsements_storage.ml + delegate_missed_endorsements_storage.mli + delegate_slashed_deposits_storage.ml delegate_slashed_deposits_storage.mli + delegate_sampler.ml delegate_sampler.mli + delegate_cycles.ml delegate_cycles.mli bootstrap_storage.ml bootstrap_storage.mli vote_storage.ml vote_storage.mli fees_storage.ml fees_storage.mli diff --git a/src/proto_alpha/lib_protocol/init_storage.ml b/src/proto_alpha/lib_protocol/init_storage.ml index 258702c6e1f02a990bd7d7de728d54bae8edf4d5..e5195fe38233d6c325ea7cfe73377b10f2489f75 100644 --- a/src/proto_alpha/lib_protocol/init_storage.ml +++ b/src/proto_alpha/lib_protocol/init_storage.ml @@ -97,12 +97,7 @@ let prepare_first_block _chain_id ctxt ~typecheck ~level ~timestamp = param.bootstrap_accounts param.bootstrap_contracts >>=? fun (ctxt, bootstrap_balance_updates) -> - Delegate_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 99d6396575a7075b4822d22dadaa6b5ebb2fbe88..79b64c6261a704307810b4fe3cb1769f6656c5a7 100644 --- a/src/proto_alpha/lib_protocol/seed_storage.ml +++ b/src/proto_alpha/lib_protocol/seed_storage.ml @@ -34,7 +34,8 @@ type seed_computation_status = | Computation_finished type error += - | Unknown of { + | (* `Permanent *) + Unknown of { oldest : Cycle_repr.t; cycle : Cycle_repr.t; latest : Cycle_repr.t; @@ -43,8 +44,6 @@ type error += | Unverified_vdf | Too_early_revelation -(* `Permanent *) - let () = register_error_kind `Permanent @@ -208,6 +207,8 @@ let check_vdf_and_update_seed ctxt vdf_solution = let cycle_computed = Cycle_repr.add current_cycle (preserved + 1) in Storage.Seed.For_cycle.update ctxt cycle_computed new_seed Seed_repr.VDF_seed +let raw_for_cycle = Storage.Seed.For_cycle.get + let for_cycle ctxt cycle = let preserved = Constants_storage.preserved_cycles ctxt in let current_cycle = (Level_storage.current ctxt).cycle in @@ -248,3 +249,5 @@ let cycle_end ctxt last_cycle = | Some previous_cycle -> (* cycle with revelations *) purge_nonces_and_get_unrevealed ctxt ~cycle:previous_cycle + +let remove_for_cycle = Storage.Seed.For_cycle.remove_existing diff --git a/src/proto_alpha/lib_protocol/seed_storage.mli b/src/proto_alpha/lib_protocol/seed_storage.mli index 8942a010c9fc3db7e60a34276fbd23c2ec355c36..75e050c302a37fefd9fd7f24122312687c9f6983 100644 --- a/src/proto_alpha/lib_protocol/seed_storage.mli +++ b/src/proto_alpha/lib_protocol/seed_storage.mli @@ -23,6 +23,11 @@ (* *) (*****************************************************************************) +(** This modules handles the storage of random nonce seeds. + + This module is responsible for maintaining the table + {!Storage.Seed.For_cycle}. *) + type seed_computation_status = | Nonce_revelation_stage | Vdf_revelation_stage of { @@ -32,7 +37,8 @@ type seed_computation_status = | Computation_finished type error += - | Unknown of { + | (* `Permanent *) + Unknown of { oldest : Cycle_repr.t; cycle : Cycle_repr.t; latest : Cycle_repr.t; @@ -41,8 +47,6 @@ type error += | Unverified_vdf | Too_early_revelation -(* `Permanent *) - (** Generates the first [preserved_cycles+2] seeds for which there are no nonces. *) val init : @@ -53,6 +57,13 @@ val init : val check_vdf_and_update_seed : Raw_context.t -> Seed_repr.vdf_solution -> Raw_context.t tzresult Lwt.t +(** Returns the seed associated with the given cycle. Returns a generic storage + error when the seed is not available. *) +val raw_for_cycle : + Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t + +(** Returns the seed associated with the given cycle. Returns the {!Unknown} + error when the seed is not available. *) val for_cycle : Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t (** Computes RANDAO output for cycle #(current_cycle + preserved + 1) *) @@ -71,3 +82,8 @@ val cycle_end : finished for the current cycle. *) val get_seed_computation_status : Raw_context.t -> seed_computation_status tzresult Lwt.t + +(** Removes the seed associated with the given cycle from the storage. It + assumes the seed exists. If it does not it returns a generic storage error. *) +val remove_for_cycle : + Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/stake_storage.ml b/src/proto_alpha/lib_protocol/stake_storage.ml index 9c34808d628ec435f0c40ad8eaf8bb75c06c449f..ec4442592ac51b2eae320721ff3c040d85561d31 100644 --- a/src/proto_alpha/lib_protocol/stake_storage.ml +++ b/src/proto_alpha/lib_protocol/stake_storage.ml @@ -107,16 +107,21 @@ let add_stake ctxt delegate amount = roll now). *) return ctxt -let deactivate_only_call_from_delegate_storage ctxt delegate = +let set_inactive ctxt delegate = + Delegate_activation_storage.set_inactive ctxt delegate >>= fun ctxt -> Storage.Stake.Active_delegate_with_one_roll.remove ctxt delegate -let activate_only_call_from_delegate_storage ctxt delegate = - get_initialized_stake ctxt delegate >>=? fun (staking_balance, ctxt) -> - let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in - if Tez_repr.(staking_balance >= tokens_per_roll) then - Storage.Stake.Active_delegate_with_one_roll.add ctxt delegate () - >>= fun ctxt -> return ctxt - else return ctxt +let set_active ctxt delegate = + Delegate_activation_storage.set_active ctxt delegate + >>=? fun (ctxt, inactive) -> + if not inactive then return ctxt + else + get_initialized_stake ctxt delegate >>=? fun (staking_balance, ctxt) -> + let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in + if Tez_repr.(staking_balance >= tokens_per_roll) then + Storage.Stake.Active_delegate_with_one_roll.add ctxt delegate () + >>= fun ctxt -> return ctxt + else return ctxt let snapshot ctxt = Storage.Stake.Last_snapshot.get ctxt >>=? fun index -> @@ -129,14 +134,14 @@ let max_snapshot_index = Storage.Stake.Last_snapshot.get let set_selected_distribution_for_cycle ctxt cycle stakes total_stake = let stakes = List.sort (fun (_, x) (_, y) -> Tez_repr.compare y x) stakes in Selected_distribution_for_cycle.init ctxt cycle stakes >>=? fun ctxt -> - Storage.Total_active_stake.add ctxt cycle total_stake >>= fun ctxt -> + Storage.Stake.Total_active_stake.add ctxt cycle total_stake >>= fun ctxt -> (* cleanup snapshots *) Storage.Stake.Staking_balance.Snapshot.clear ctxt >>= fun ctxt -> Storage.Stake.Active_delegate_with_one_roll.Snapshot.clear ctxt >>= fun ctxt -> Storage.Stake.Last_snapshot.update ctxt 0 let clear_cycle ctxt cycle = - Storage.Total_active_stake.remove_existing ctxt cycle >>=? fun ctxt -> + Storage.Stake.Total_active_stake.remove_existing ctxt cycle >>=? fun ctxt -> Selected_distribution_for_cycle.remove_existing ctxt cycle let fold ctxt ~f ~order init = @@ -192,7 +197,7 @@ let prepare_stake_distribution ctxt = ctxt stake_distribution) -let get_total_active_stake = Storage.Total_active_stake.get +let get_total_active_stake = Storage.Stake.Total_active_stake.get let remove_contract_stake ctxt contract amount = Contract_delegate_storage.find ctxt contract >>=? function diff --git a/src/proto_alpha/lib_protocol/stake_storage.mli b/src/proto_alpha/lib_protocol/stake_storage.mli index 894f683cd5798953fad5533810ac5bd07be79677..aad1f9dfdc2995edcc1fab0c2b95e1c76803d2f3 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 -> @@ -38,10 +46,10 @@ val add_stake : Tez_repr.t -> Raw_context.t tzresult Lwt.t -val deactivate_only_call_from_delegate_storage : +val set_inactive : Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t Lwt.t -val activate_only_call_from_delegate_storage : +val set_active : Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t val get_staking_balance : diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml index 064797d6476b54eef8a9ed4bc23fa07ebecd4482..bf5fa2e5f3eece53321ec45e40ad7732e178f888 100644 --- a/src/proto_alpha/lib_protocol/storage.ml +++ b/src/proto_alpha/lib_protocol/storage.ml @@ -1063,6 +1063,7 @@ module Stake = struct end) module Selected_distribution_for_cycle = Cycle.Selected_stake_distribution + module Total_active_stake = Cycle.Total_active_stake (* This is an index that is set to 0 by calls to {!val:Stake_storage.selected_new_distribution_at_cycle_end} and incremented @@ -1088,7 +1089,6 @@ module Stake = struct (Encoding.UInt16) end -module Total_active_stake = Cycle.Total_active_stake module Delegate_sampler_state = Cycle.Delegate_sampler_state (** Votes *) diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli index 9fd408a5e7bbb28b26fd81c0a85e2243c9be5653..675c2f585730bfc3f6dae62b1d07a6a970f44608 100644 --- a/src/proto_alpha/lib_protocol/storage.mli +++ b/src/proto_alpha/lib_protocol/storage.mli @@ -383,14 +383,14 @@ module Stake : sig with type key = Cycle_repr.t and type value = (Signature.Public_key_hash.t * Tez_repr.t) list and type t := Raw_context.t -end -(** Sum of the active stakes of all the delegates with rolls *) -module Total_active_stake : - Indexed_data_storage - with type key = Cycle_repr.t - and type value = Tez_repr.t - and type t := Raw_context.t + (** Sum of the active stakes of all the delegates with rolls *) + module Total_active_stake : + Indexed_data_storage + with type key = Cycle_repr.t + and type value = Tez_repr.t + and type t := Raw_context.t +end (** State of the sampler used to select delegates. Managed synchronously with [Stake.Selected_distribution_for_cycle]. *) diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_delegation.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_delegation.ml index 880961fcc6cdfc4ec1a5ab890de1895a855c8428..4863aac4086d9223c67e1e6e5d38595a27dec527 100644 --- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_delegation.ml +++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_delegation.ml @@ -56,7 +56,7 @@ let expect_error err = function let expect_alpha_error err = expect_error (Environment.Ecoproto_error err) let expect_no_change_registered_delegate_pkh pkh = function - | Environment.Ecoproto_error (Delegate_storage.No_deletion pkh0) :: _ + | Environment.Ecoproto_error (Delegate_storage.Contract.No_deletion pkh0) :: _ when pkh0 = pkh -> return_unit | _ -> failwith "Delegate can not be deleted and operation should fail." @@ -221,7 +221,8 @@ let bootstrap_manager_already_registered_delegate ~fee () = else Incremental.add_operation ~expect_apply_failure:(function - | Environment.Ecoproto_error Delegate_storage.Active_delegate :: _ -> + | Environment.Ecoproto_error Delegate_storage.Contract.Active_delegate + :: _ -> return_unit | _ -> failwith "Delegate is already active and operation should fail.") i @@ -458,7 +459,8 @@ let tests_bootstrap_contracts = two possibilities of 1a for non-credited contracts. *) let expect_unregistered_key pkh = function - | Environment.Ecoproto_error (Delegate_storage.Unregistered_delegate pkh0) + | Environment.Ecoproto_error + (Delegate_storage.Contract.Unregistered_delegate pkh0) :: _ when pkh = pkh0 -> return_unit diff --git a/src/proto_alpha/lib_protocol/test/integration/test_frozen_bonds.ml b/src/proto_alpha/lib_protocol/test/integration/test_frozen_bonds.ml index 27f5394c700a2b0276a33e8f3782f8558e6e49d8..2237adcb14077206814e36a551f37e927b07d586 100644 --- a/src/proto_alpha/lib_protocol/test/integration/test_frozen_bonds.ml +++ b/src/proto_alpha/lib_protocol/test/integration/test_frozen_bonds.ml @@ -93,7 +93,7 @@ let init_test ~user_is_delegate = (* Configure delegate, as a delegate by self-delegation, for which revealing its manager key is a prerequisite. *) Contract.reveal_manager_key ctxt delegate delegate_pk >>>=? fun ctxt -> - Delegate.set ctxt delegate_contract (Some delegate) >>>=? fun ctxt -> + Contract.Delegate.set ctxt delegate_contract (Some delegate) >>>=? fun ctxt -> return (ctxt, user_contract, user_account, delegate) (** Tested scenario : @@ -111,7 +111,7 @@ let test_delegate_then_freeze_deposit () = (* Fetch user's initial balance before freeze. *) Token.balance ctxt user_account >>>=? fun (ctxt, user_balance) -> (* Let user delegate to "delegate". *) - Delegate.set ctxt user_contract (Some delegate) >>>=? fun ctxt -> + Contract.Delegate.set ctxt user_contract (Some delegate) >>>=? fun ctxt -> (* Fetch staking balance after delegation and before freeze. *) Delegate.staking_balance ctxt delegate >>>=? fun staking_balance -> (* Freeze a tx-rollup deposit. *) @@ -126,7 +126,7 @@ let test_delegate_then_freeze_deposit () = (* Ensure staking balance did not change. *) Assert.equal_tez ~loc:__LOC__ staking_balance' staking_balance >>=? fun () -> (* Remove delegation. *) - Delegate.set ctxt user_contract None >>>=? fun ctxt -> + Contract.Delegate.set ctxt user_contract None >>>=? fun ctxt -> (* Fetch staking balance after delegation removal. *) Delegate.staking_balance ctxt delegate >>>=? fun staking_balance'' -> (* Ensure staking balance decreased by user's initial balance. *) @@ -173,7 +173,7 @@ let test_freeze_deposit_then_delegate () = Now, fetch staking balance before delegation and after freeze. *) Delegate.staking_balance ctxt delegate >>>=? fun staking_balance -> (* Let user delegate to "delegate". *) - Delegate.set ctxt user_contract (Some delegate) >>>=? fun ctxt -> + Contract.Delegate.set ctxt user_contract (Some delegate) >>>=? fun ctxt -> (* Fetch staking balance after delegation. *) Delegate.staking_balance ctxt delegate >>>=? fun staking_balance' -> (* ensure staking balance increased by the user's balance. *) @@ -191,7 +191,7 @@ let test_freeze_deposit_then_delegate () = Assert.equal_tez ~loc:__LOC__ staking_balance'' staking_balance' >>=? fun () -> (* Remove delegation. *) - Delegate.set ctxt user_contract None >>>=? fun ctxt -> + Contract.Delegate.set ctxt user_contract None >>>=? fun ctxt -> (* Fetch staking balance. *) Delegate.staking_balance ctxt delegate >>>=? fun staking_balance''' -> (* Check that staking balance has decreased by the user's initial balance. *) @@ -329,7 +329,8 @@ let test_scenario scenario = (* Configure delegate, as a delegate by self-delegation, for which revealing its manager key is a prerequisite. *) Contract.reveal_manager_key ctxt delegate2 delegate_pk2 >>>=? fun ctxt -> - Delegate.set ctxt delegate_contract2 (Some delegate2) >>>=? fun ctxt -> + Contract.Delegate.set ctxt delegate_contract2 (Some delegate2) + >>>=? fun ctxt -> let tx_rollup1, nonce = mk_tx_rollup () in let tx_rollup2, _ = mk_tx_rollup ~nonce () in let bond_id1 = Bond_id.Tx_rollup_bond_id tx_rollup1 in @@ -344,7 +345,7 @@ let test_scenario scenario = Contract.get_balance_and_frozen_bonds ctxt user_contract >>>=? fun user_balance -> (* Let user delegate to "delegate". *) - Delegate.set ctxt user_contract (Some delegate) >>>=? fun ctxt -> + Contract.Delegate.set ctxt user_contract (Some delegate) >>>=? fun ctxt -> (* Fetch staking balance after delegation *) Delegate.staking_balance ctxt delegate >>>=? fun staking_balance' -> Assert.equal_tez @@ -418,7 +419,7 @@ let test_scenario scenario = (* Fetch user's initial balance before undelegate. *) Token.balance ctxt user_account >>>=? fun (_, user_balance) -> (* Remove delegation. *) - Delegate.set ctxt user_contract None >>>=? fun ctxt -> + Contract.Delegate.set ctxt user_contract None >>>=? fun ctxt -> (* Fetch staking balance after delegation removal. *) Delegate.staking_balance ctxt delegate >>>=? fun staking_balance' -> (* Ensure staking balance decreased by delegation amount *) diff --git a/src/proto_alpha/lib_protocol/test/integration/test_token.ml b/src/proto_alpha/lib_protocol/test/integration/test_token.ml index 4a05fb1a885e7d9e132c526f87c3b45bc7ec7193..1d3edd5f6c2f7db8e5f0bdc89c0ed23e73c6913a 100644 --- a/src/proto_alpha/lib_protocol/test/integration/test_token.ml +++ b/src/proto_alpha/lib_protocol/test/integration/test_token.ml @@ -516,13 +516,13 @@ let build_test_cases () = (* Configure baker1, and baker2 as delegates by self-delegation, for which revealing their manager key is a prerequisite. *) wrap (Contract.reveal_manager_key ctxt baker1 baker1_pk) >>=? fun ctxt -> - wrap (Delegate.set ctxt (Contract.Implicit baker1) (Some baker1)) + wrap (Contract.Delegate.set ctxt (Contract.Implicit baker1) (Some baker1)) >>=? fun ctxt -> wrap (Contract.reveal_manager_key ctxt baker2 baker2_pk) >>=? fun ctxt -> - wrap (Delegate.set ctxt (Contract.Implicit baker2) (Some baker2)) + wrap (Contract.Delegate.set ctxt (Contract.Implicit baker2) (Some baker2)) (* Let user1 delegate to baker2. *) >>=? fun ctxt -> - wrap (Delegate.set ctxt (Contract.Implicit user1) (Some baker2)) + wrap (Contract.Delegate.set ctxt (Contract.Implicit user1) (Some baker2)) >>=? fun ctxt -> let tx_rollup1 = mk_rollup () in let bond_id1 = Bond_id.Tx_rollup_bond_id tx_rollup1 in