package tezos-protocol-020-PsParisC

You can search for identifiers within the package.
in-package search v0.2.0
tezos-protocol-020-PsParisC
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file `delegate_consensus_key.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
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error +=
  | Invalid_consensus_key_update_noop of Cycle_repr.t
  | Invalid_consensus_key_update_active
  | Invalid_consensus_key_update_tz4 of Bls.Public_key.t

let () =
  register_error_kind
    `Permanent
    ~id:"delegate.consensus_key.invalid_noop"
    ~title:"Invalid key for consensus key update"
    ~description:"Tried to update the consensus key with the active key"
    ~pp:(fun ppf cycle ->
      Format.fprintf
        ppf
        "Invalid key while updating a consensus key (already active since %a)."
        Cycle_repr.pp
        cycle)
    Data_encoding.(obj1 (req "cycle" Cycle_repr.encoding))
    (function Invalid_consensus_key_update_noop c -> Some c | _ -> None)
    (fun c -> Invalid_consensus_key_update_noop c) ;
  register_error_kind
    `Permanent
    ~id:"delegate.consensus_key.active"
    ~title:"Active consensus key"
    ~description:
      "The delegate consensus key is already used by another delegate"
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "The delegate consensus key is already used by another delegate")
    Data_encoding.empty
    (function Invalid_consensus_key_update_active -> Some () | _ -> None)
    (fun () -> Invalid_consensus_key_update_active) ;
  register_error_kind
    `Permanent
    ~id:"delegate.consensus_key.tz4"
    ~title:"Consensus key cannot be a tz4"
    ~description:"Consensus key cannot be a tz4 (BLS public key)."
    ~pp:(fun ppf pk ->
      Format.fprintf
        ppf
        "The consensus key %a is forbidden as it is a BLS public key."
        Bls.Public_key_hash.pp
        (Bls.Public_key.hash pk))
    Data_encoding.(obj1 (req "delegate_pk" Bls.Public_key.encoding))
    (function Invalid_consensus_key_update_tz4 pk -> Some pk | _ -> None)
    (fun pk -> Invalid_consensus_key_update_tz4 pk)

type pk = Raw_context.consensus_pk = {
  delegate : Signature.Public_key_hash.t;
  consensus_pk : Signature.Public_key.t;
  consensus_pkh : Signature.Public_key_hash.t;
}

type t = {
  delegate : Signature.Public_key_hash.t;
  consensus_pkh : Signature.Public_key_hash.t;
}

let pkh {delegate; consensus_pkh; consensus_pk = _} = {delegate; consensus_pkh}

let zero =
  {
    consensus_pkh = Signature.Public_key_hash.zero;
    delegate = Signature.Public_key_hash.zero;
  }

let pp ppf {delegate; consensus_pkh} =
  Format.fprintf ppf "@[<v 2>%a" Signature.Public_key_hash.pp delegate ;
  if not (Signature.Public_key_hash.equal delegate consensus_pkh) then
    Format.fprintf
      ppf
      "@,Active key: %a"
      Signature.Public_key_hash.pp
      consensus_pkh ;
  Format.fprintf ppf "@]"

(* Invariant:
      No two delegates use the same active consensus key at a given time.

   To ensure that, {!Storage.Consensus_keys} contains keys that will be active
   at cycle `current + consensus_rights_delay + 1`.
*)

let check_unused ctxt pkh =
  let open Lwt_result_syntax in
  let*! is_active = Storage.Consensus_keys.mem ctxt pkh in
  fail_when is_active Invalid_consensus_key_update_active

let check_not_tz4 : Signature.Public_key.t -> unit tzresult =
  let open Result_syntax in
  function
  | Bls pk -> tzfail (Invalid_consensus_key_update_tz4 pk)
  | Ed25519 _ | Secp256k1 _ | P256 _ -> return_unit

let set_unused = Storage.Consensus_keys.remove

let set_used = Storage.Consensus_keys.add

let init ctxt delegate pk =
  let open Lwt_result_syntax in
  let*? () = check_not_tz4 pk in
  let pkh = Signature.Public_key.hash pk in
  let* () = check_unused ctxt pkh in
  let*! ctxt = set_used ctxt pkh in
  Storage.Contract.Consensus_key.init ctxt (Contract_repr.Implicit delegate) pk

let active_pubkey ctxt delegate =
  let open Lwt_result_syntax in
  let* pk =
    Storage.Contract.Consensus_key.get ctxt (Contract_repr.Implicit delegate)
  in
  let pkh = Signature.Public_key.hash pk in
  return {consensus_pk = pk; consensus_pkh = pkh; delegate}

let active_key ctxt delegate =
  let open Lwt_result_syntax in
  let* pk = active_pubkey ctxt delegate in
  return (pkh pk)

let raw_pending_updates ctxt ?up_to_cycle delegate =
  let open Lwt_result_syntax in
  let relevant_cycles =
    let level = Raw_context.current_level ctxt in
    let first_cycle = Cycle_repr.succ level.cycle in
    let last_cycle =
      match up_to_cycle with
      | None ->
          let cycles_delay =
            Constants_storage.consensus_key_activation_delay ctxt
          in
          Cycle_repr.add first_cycle cycles_delay
      | Some cycle -> cycle
    in
    Cycle_repr.(first_cycle ---> last_cycle)
  in
  let delegate = Contract_repr.Implicit delegate in
  List.filter_map_es
    (fun cycle ->
      let* pending_for_cycle =
        Storage.Pending_consensus_keys.find (ctxt, cycle) delegate
      in
      pending_for_cycle |> Option.map (fun pk -> (cycle, pk)) |> return)
    relevant_cycles

let pending_updates ctxt delegate =
  let open Lwt_result_syntax in
  let* updates = raw_pending_updates ctxt delegate in
  return
    (List.map (fun (c, pk) -> (c, Signature.Public_key.hash pk, pk)) updates)

let raw_active_pubkey_for_cycle ctxt delegate cycle =
  let open Lwt_result_syntax in
  let* pendings = raw_pending_updates ctxt ~up_to_cycle:cycle delegate in
  let* active = active_pubkey ctxt delegate in
  let current_cycle = (Raw_context.current_level ctxt).cycle in
  match List.hd (List.rev pendings) with
  | None -> return (current_cycle, active.consensus_pk)
  | Some (cycle, pk) -> return (cycle, pk)

let active_pubkey_for_cycle ctxt delegate cycle =
  let open Lwt_result_syntax in
  let+ _, consensus_pk = raw_active_pubkey_for_cycle ctxt delegate cycle in
  {
    consensus_pk;
    consensus_pkh = Signature.Public_key.hash consensus_pk;
    delegate;
  }

let register_update ctxt delegate pk =
  let open Lwt_result_syntax in
  let update_cycle =
    let current_level = Raw_context.current_level ctxt in
    let cycles_delay = Constants_storage.consensus_key_activation_delay ctxt in
    Cycle_repr.add current_level.cycle (cycles_delay + 1)
  in
  let* () =
    let* first_active_cycle, active_pubkey =
      raw_active_pubkey_for_cycle ctxt delegate update_cycle
    in
    fail_when
      Signature.Public_key.(pk = active_pubkey)
      (Invalid_consensus_key_update_noop first_active_cycle)
  in
  let*? () = check_not_tz4 pk in
  let pkh = Signature.Public_key.hash pk in
  let* () = check_unused ctxt pkh in
  let*! ctxt = set_used ctxt pkh in
  let* {consensus_pkh = old_pkh; _} =
    active_pubkey_for_cycle ctxt delegate update_cycle
  in
  let*! ctxt = set_unused ctxt old_pkh in
  let*! ctxt =
    Storage.Pending_consensus_keys.add
      (ctxt, update_cycle)
      (Contract_repr.Implicit delegate)
      pk
  in
  return ctxt

let activate ctxt ~new_cycle =
  let open Lwt_syntax in
  let* ctxt =
    Storage.Pending_consensus_keys.fold
      (ctxt, new_cycle)
      ~order:`Undefined
      ~init:ctxt
      ~f:(fun delegate pk ctxt ->
        Storage.Contract.Consensus_key.add ctxt delegate pk)
  in
  Storage.Pending_consensus_keys.clear (ctxt, new_cycle)
package tezos-protocol-020-PsParisC

Source file delegate_consensus_key.ml

Source file `delegate_consensus_key.ml`
