package tezos-protocol-alpha

You can search for identifiers within the package.
in-package search v0.2.0
tezos-protocol-alpha
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file `delegate_cycles.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)
(* Copyright (c) 2022 G.B. Fefe, <gb.fefe@protonmail.com>                    *)
(*                                                                           *)
(* 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 open Lwt_result_syntax in
  let rights_delay = Constants_storage.consensus_rights_delay ctxt in
  match Cycle_repr.sub last_cycle rights_delay with
  | None ->
      (* do not update activity in the first cycles of a network.*)
      return (ctxt, [])
  | Some _unfrozen_cycle ->
      Stake_storage.fold_on_active_delegates_with_minimal_stake_s
        ctxt
        ~order:`Sorted
        ~init:(Ok (ctxt, []))
        ~f:(fun delegate acc ->
          let*? ctxt, deactivated = acc in
          let* cycle =
            Delegate_activation_storage.last_cycle_before_deactivation
              ctxt
              delegate
          in
          if Cycle_repr.(cycle <= last_cycle) then
            let*! ctxt = Stake_storage.set_inactive ctxt delegate in
            return (ctxt, delegate :: deactivated)
          else return (ctxt, deactivated))

let delegate_has_revealed_nonces delegate unrevelead_nonces_set =
  not (Signature.Public_key_hash.Set.mem delegate unrevelead_nonces_set)

let distribute_attesting_rewards ctxt last_cycle unrevealed_nonces =
  let open Lwt_result_syntax in
  let*? attesting_reward_per_slot =
    Delegate_rewards.attesting_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
  let* total_active_stake =
    Stake_storage.get_total_active_stake ctxt last_cycle
  in
  let total_active_stake_weight =
    Stake_repr.staking_weight total_active_stake
  in
  let* delegates = Stake_storage.get_selected_distribution ctxt last_cycle in
  List.fold_left_es
    (fun (ctxt, balance_updates) (delegate, active_stake) ->
      let* ctxt, sufficient_participation =
        Delegate_missed_attestations_storage
        .check_and_reset_delegate_participation
          ctxt
          delegate
      in
      let has_revealed_nonces =
        delegate_has_revealed_nonces delegate unrevealed_nonces_set
      in
      let active_stake_weight = Stake_repr.staking_weight active_stake in
      let expected_slots =
        Delegate_missed_attestations_storage
        .expected_slots_for_given_active_stake
          ctxt
          ~total_active_stake_weight
          ~active_stake_weight
      in
      let rewards = Tez_repr.mul_exn attesting_reward_per_slot expected_slots in
      if sufficient_participation && has_revealed_nonces then
        (* Sufficient participation: we pay the rewards *)
        let+ ctxt, payed_rewards_receipts =
          Shared_stake.pay_rewards
            ctxt
            ~active_stake
            ~source:`Attesting_rewards
            ~delegate
            rewards
        in
        (ctxt, payed_rewards_receipts @ balance_updates)
      else
        (* Insufficient participation or unrevealed nonce: no rewards *)
        let+ ctxt, payed_rewards_receipts =
          Token.transfer
            ctxt
            `Attesting_rewards
            (`Lost_attesting_rewards
              (delegate, not sufficient_participation, not has_revealed_nonces))
            rewards
        in
        (ctxt, payed_rewards_receipts @ balance_updates))
    (ctxt, [])
    delegates

let adjust_frozen_stakes ctxt ~deactivated_delegates :
    (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t =
  let open Lwt_result_syntax in
  (* Note: deactivated_delegates have just been removed from the set of
     active delegates with minimal stake by [update_activity] so the two
     following iterations are on disjoint sets of delegates. *)
  let* ctxt, balance_updates =
    Stake_storage.fold_on_active_delegates_with_minimal_stake_es
      ctxt
      ~order:`Undefined
      ~init:(ctxt, [])
      ~f:(fun delegate (ctxt, balance_updates) ->
        let*! has_been_denounced =
          Pending_denunciations_storage.has_pending_denunciations ctxt delegate
        in
        if has_been_denounced then return (ctxt, balance_updates)
          (* we don't autostake on behalf of delegates who will be slashed *)
        else
          let* full_staking_balance =
            Stake_storage.get_full_staking_balance ctxt delegate
          in
          let own_frozen =
            Full_staking_balance_repr.own_frozen full_staking_balance
          in
          let*? optimal_frozen =
            Stake_context.optimal_frozen_wrt_delegated_without_ai
              ctxt
              full_staking_balance
          in
          let* deposit_limit =
            Delegate_storage.frozen_deposits_limit ctxt delegate
          in
          let optimal_frozen =
            match deposit_limit with
            | None -> optimal_frozen
            | Some deposit_limit -> Tez_repr.min optimal_frozen deposit_limit
          in
          let* ctxt, new_balance_updates =
            if Tez_repr.(optimal_frozen > own_frozen) then
              let*? optimal_to_stake =
                Tez_repr.(optimal_frozen -? own_frozen)
              in
              Staking.stake
                ctxt
                ~for_next_cycle_use_only_after_slashing:true
                ~amount:(`At_most optimal_to_stake)
                ~sender:delegate
                ~delegate
            else if Tez_repr.(optimal_frozen < own_frozen) then
              let*? to_unstake = Tez_repr.(own_frozen -? optimal_frozen) in
              Staking.request_unstake
                ctxt
                ~for_next_cycle_use_only_after_slashing:true
                ~sender_contract:Contract_repr.(Implicit delegate)
                ~delegate
                to_unstake
            else
              Staking.finalize_unstake
                ctxt
                ~for_next_cycle_use_only_after_slashing:true
                Contract_repr.(Implicit delegate)
          in
          return (ctxt, new_balance_updates @ balance_updates))
  in
  List.fold_left_es
    (fun (ctxt, balance_updates) delegate ->
      let+ ctxt, new_balance_updates =
        Staking.request_unstake
          ctxt
          ~for_next_cycle_use_only_after_slashing:true
          ~sender_contract:(Implicit delegate)
          ~delegate
          Tez_repr.max_mutez
      in
      (ctxt, new_balance_updates @ balance_updates))
    (ctxt, balance_updates)
    deactivated_delegates

let cycle_end ctxt last_cycle =
  let open Lwt_result_syntax in
  (* attributing attesting rewards   *)
  let* ctxt, unrevealed_nonces = Seed_storage.cycle_end ctxt last_cycle in
  let* ctxt, attesting_balance_updates =
    distribute_attesting_rewards ctxt last_cycle unrevealed_nonces
  in
  (* Applying slashing related to expiring denunciations *)
  let* ctxt, slashing_balance_updates =
    Delegate_slashed_deposits_storage.apply_and_clear_denunciations ctxt
  in
  let new_cycle = Cycle_repr.add last_cycle 1 in
  let*! ctxt = Already_denounced_storage.clear_outdated_cycle ctxt ~new_cycle in
  (* Deactivating delegates which didn't participate to consensus for too long *)
  let* ctxt, deactivated_delegates = update_activity ctxt last_cycle in
  (* Applying autostaking. Do not move before slashing. Keep before rights
     computation for optimising rights*)
  let* ctxt, autostake_balance_updates =
    match Staking.staking_automation ctxt with
    | Manual_staking -> return (ctxt, [])
    | Auto_staking -> adjust_frozen_stakes ctxt ~deactivated_delegates
  in
  (* Computing future staking rights *)
  let* ctxt =
    Delegate_sampler.select_new_distribution_at_cycle_end ctxt ~new_cycle
  in
  (* Activating consensus key for the cycle to come *)
  let*! ctxt = Delegate_consensus_key.activate ctxt ~new_cycle in
  (* trying to unforbid delegates for the cycle to come.  *)
  let* ctxt =
    Forbidden_delegates_storage.update_at_cycle_end_after_slashing
      ctxt
      ~new_cycle
  in
  (* clear deprecated cycles data.  *)
  let* ctxt = Stake_storage.clear_at_cycle_end ctxt ~new_cycle in
  let* ctxt = Delegate_sampler.clear_outdated_sampling_data ctxt ~new_cycle in
  (* activate delegate parameters for the cycle to come.  *)
  let*! ctxt = Delegate_staking_parameters.activate ctxt ~new_cycle in
  (* updating AI coefficient. It should remain after all balance changes of the
     cycle-end operations *)
  let* ctxt =
    Adaptive_issuance_storage.update_stored_rewards_at_cycle_end ctxt ~new_cycle
  in
  let balance_updates =
    slashing_balance_updates @ attesting_balance_updates
    @ autostake_balance_updates
  in
  return (ctxt, balance_updates, deactivated_delegates)

let init_first_cycles ctxt =
  let consensus_rights_delay = Constants_storage.consensus_rights_delay ctxt in
  List.fold_left_es
    (fun ctxt c ->
      let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in
      Delegate_sampler.select_distribution_for_cycle ctxt cycle)
    ctxt
    Misc.(0 --> consensus_rights_delay)
package tezos-protocol-alpha

Source file delegate_cycles.ml

Source file `delegate_cycles.ml`
