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 `ticket_accounting.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
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2022 Trili Tech, <contact@trili.tech>                       *)
(*                                                                           *)
(* 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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

type error += Invalid_ticket_transfer of {ticketer : string; amount : Z.t}

let () =
  let open Data_encoding in
  register_error_kind
    `Permanent
    ~id:"invalid_ticket_transfer"
    ~title:"Invalid ticket transfer"
    ~description:"Invalid ticket transfer detected in ticket balance update."
    ~pp:(fun ppf (ticketer, amount) ->
      Format.fprintf
        ppf
        "Attempted to send %a unit(s) of a ticket created by %s."
        Z.pp_print
        amount
        ticketer)
    (obj2 (req "ticketer" (string Plain)) (req "amount" z))
    (function
      | Invalid_ticket_transfer {ticketer; amount} -> Some (ticketer, amount)
      | _ -> None)
    (fun (ticketer, amount) -> Invalid_ticket_transfer {ticketer; amount})

module Ticket_token_map = struct
  include Ticket_token_map

  let balance_diff ctxt token map =
    let open Lwt_result_syntax in
    let+ amnt_opt, ctxt = Ticket_token_map.find ctxt token map in
    (Option.value ~default:Z.zero amnt_opt, ctxt)

  let merge_overlap ctxt b1 b2 =
    let open Result_syntax in
    let+ ctxt = Gas.consume ctxt (Ticket_costs.add_z_cost b1 b2) in
    (Z.add b1 b2, ctxt)

  let of_list ctxt token_amounts =
    Ticket_token_map.of_list ctxt ~merge_overlap token_amounts

  let add ctxt = Ticket_token_map.merge ctxt ~merge_overlap

  let sub ctxt m1 m2 =
    let open Result_syntax in
    let* m2, ctxt =
      map_e
        ctxt
        (fun ctxt _ex_token amount ->
          let+ ctxt = Gas.consume ctxt (Ticket_costs.negate_cost amount) in
          (Z.neg amount, ctxt))
        m2
    in
    add ctxt m1 m2
end

let ticket_balances_of_value ctxt ~include_lazy ty value =
  let open Lwt_result_syntax in
  let* tickets, ctxt =
    Ticket_scanner.tickets_of_value ~include_lazy ctxt ty value
  in
  let accum_ticket_balances (acc, ctxt) ticket =
    let open Result_syntax in
    let token, amount =
      Ticket_scanner.ex_token_and_amount_of_ex_ticket ticket
    in
    let+ ctxt =
      Gas.consume ctxt Ticket_costs.Constants.cost_collect_tickets_step
    in
    ( (token, Script_int.to_zint (amount :> Script_int.n Script_int.num)) :: acc,
      ctxt )
  in
  let*? token_amounts, ctxt =
    List.fold_left_e accum_ticket_balances ([], ctxt) tickets
  in
  Ticket_token_map.of_list ctxt token_amounts

let update_ticket_balances ctxt ~total_storage_diff token destinations =
  let open Lwt_result_syntax in
  List.fold_left_es
    (fun (tot_storage_diff, ctxt) (owner, delta) ->
      let* key_hash, ctxt = Ticket_balance_key.of_ex_token ctxt ~owner token in
      let* storage_diff, ctxt =
        Ticket_balance.adjust_balance ctxt key_hash ~delta
      in
      let*? ctxt =
        Gas.consume
          ctxt
          (Ticket_costs.add_z_cost total_storage_diff storage_diff)
      in
      return (Z.add tot_storage_diff storage_diff, ctxt))
    (total_storage_diff, ctxt)
    destinations

let invalid_ticket_transfer_error
    ~ticket_token:
      (Ticket_token.Ex_token {ticketer; contents_type = _; contents = _})
    ~amount =
  Invalid_ticket_transfer {ticketer = Contract.to_b58check ticketer; amount}

let update_ticket_balances_for_self_contract ctxt ~self_contract ticket_diffs =
  let open Lwt_result_syntax in
  List.fold_left_es
    (fun (total_storage_diff, ctxt) (ticket_token, amount) ->
      (* Diff is valid iff either:
         - the balance has decreased (delta <= 0), or
         - the ticket-token was created by the [self] contract. *)
      let is_valid_balance_update =
        let (Ticket_token.Ex_token {ticketer; _}) = ticket_token in
        Compare.Z.(amount <= Z.zero) || Contract.equal ticketer self_contract
      in
      let*? () =
        error_unless
          is_valid_balance_update
          (invalid_ticket_transfer_error ~ticket_token ~amount)
      in
      update_ticket_balances
        ctxt
        ~total_storage_diff
        ticket_token
        [(Destination.Contract self_contract, amount)])
    (Z.zero, ctxt)
    ticket_diffs

let ticket_diffs_of_lazy_storage_diff ctxt ~storage_type_has_tickets
    lazy_storage_diff =
  let open Lwt_result_syntax in
  (* Only scan lazy-diffs for tickets in case the storage contains tickets. *)
  if Ticket_scanner.has_tickets storage_type_has_tickets then
    let* diffs, ctxt =
      Ticket_lazy_storage_diff.ticket_diffs_of_lazy_storage_diff
        ctxt
        lazy_storage_diff
    in
    Ticket_token_map.of_list ctxt diffs
  else return (Ticket_token_map.empty, ctxt)

(* TODO #2465
   Move the docs from HackMd to [docs/alpha] folder.
   The documentation referenced here should be moved to a permanent place and
   the comment below should be updated.
*)

(** Description here:
    https://hackmd.io/lutm_5JNRVW-nNFSFkCXLQ?view#Implementation

   - [old_storage_strict] the amount S_1^{strict} of ticket-tokens in the strict part of
     the old storage.

   - [new_storage_strict] the amount S_2^{strict} of ticket-tokens in the strict part of the
      new storage.

   - [lazy_storage_diff] the amount S_{\delta}^{lazy} of ticket-tokens added to the lazy part of
      the storage.

   - [arg_tickets] the amount I of ticket-tokens contained in the incoming
     arguments.

    We calculate the ticket diff as the following:
    [new_storage_strict] + [lazy_storage_diff] - ([old_storage_strict] + [arg_tickets])

    Additionally, we calculate the ticket receipt as below.
    We do not subtract the [arg_tickets] since we only want to display the tickets updated in storage for the receipt.
    [new_storage_strict] + [lazy_storage_diff] - [storage_strict]
 *)
let ticket_diffs ctxt ~self_contract ~arg_type_has_tickets
    ~storage_type_has_tickets ~arg ~old_storage ~new_storage ~lazy_storage_diff
    =
  let open Lwt_result_syntax in
  (* Collect ticket-token balances of the incoming parameters. *)
  let* arg_tickets, ctxt =
    ticket_balances_of_value ctxt ~include_lazy:true arg_type_has_tickets arg
  in
  let* lazy_storage_diff, ctxt =
    ticket_diffs_of_lazy_storage_diff
      ctxt
      ~storage_type_has_tickets
      lazy_storage_diff
  in
  let* old_storage_strict, ctxt =
    ticket_balances_of_value
      ctxt
      ~include_lazy:false
      storage_type_has_tickets
      old_storage
  in
  let* new_storage_strict, ctxt =
    ticket_balances_of_value
      ctxt
      ~include_lazy:false
      storage_type_has_tickets
      new_storage
  in
  let*? additions, ctxt =
    Ticket_token_map.add ctxt new_storage_strict lazy_storage_diff
  in
  let*? total_storage_diff, ctxt =
    Ticket_token_map.sub ctxt additions old_storage_strict
  in
  let*? diff, ctxt = Ticket_token_map.sub ctxt total_storage_diff arg_tickets in
  let* ticket_receipt, ctxt =
    Ticket_token_map.to_ticket_receipt
      ctxt
      ~owner:Destination.(Contract self_contract)
      total_storage_diff
  in
  return (diff, ticket_receipt, ctxt)

let update_ticket_balances ctxt ~self_contract ~ticket_diffs operations =
  let open Lwt_result_syntax in
  let validate_spending_budget ctxt
      (Ticket_token.Ex_token {ticketer; _} as ticket_token) amount =
    if Contract.equal ticketer self_contract then
      (* It's okay to send any amount of ticket-tokens minted by the current
         contract (self). Hence tickets stored by their ticketer are not
         stored in the ticket table and don't need to be updated here. *)
      return (true, ctxt)
    else
      let+ balance_diff, ctxt =
        Ticket_token_map.balance_diff ctxt ticket_token ticket_diffs
      in
      (* The balance-diff represents the number of units of a ticket-token,
         that is changed for the [self] contract. A negative diff means that
         an amount of ticket-tokens were not saved in the storage and are
         eligible for transfer to another contract.

         For example, if 5 units of a ticket-token "Alice Red" were pulled from
         the storage, the corresponding diff is -5. That means at most 5 units
         of "Alice Red" can be transferred. Any amount exceeding that would
         result in a validation error.
      *)
      (Compare.Z.(Script_int.to_zint amount <= Z.neg balance_diff), ctxt)
  in
  (* Collect diffs from operations *)
  let* ticket_op_diffs, ctxt =
    Ticket_operations_diff.ticket_diffs_of_operations ctxt operations
  in
  (* Update balances for self-contract. *)
  let*? ticket_diffs, ctxt = Ticket_token_map.to_list ctxt ticket_diffs in
  let* total_storage_diff, ctxt =
    update_ticket_balances_for_self_contract ctxt ~self_contract ticket_diffs
  in
  (* Update balances for operations. *)
  List.fold_left_es
    (fun (total_storage_diff, ctxt)
         {Ticket_operations_diff.ticket_token; total_amount; destinations} ->
      (* Verify that we are able to spend the given amount of ticket-tokens. *)
      let* is_valid_balance_update, ctxt =
        validate_spending_budget ctxt ticket_token total_amount
      in
      let*? () =
        error_unless
          is_valid_balance_update
          (invalid_ticket_transfer_error
             ~ticket_token
             ~amount:(Script_int.to_zint total_amount))
      in
      let*? destinations, ctxt =
        List.fold_left_e
          (fun (acc, ctxt) (token, (amount : Script_typed_ir.ticket_amount)) ->
            (* Consume some gas for traversing the list. *)
            let open Result_syntax in
            let+ ctxt =
              Gas.consume ctxt Ticket_costs.Constants.cost_collect_tickets_step
            in
            ((token, Script_int.(to_zint (amount :> n num))) :: acc, ctxt))
          ([], ctxt)
          destinations
      in
      update_ticket_balances ctxt ~total_storage_diff ticket_token destinations)
    (total_storage_diff, ctxt)
    ticket_op_diffs
package tezos-protocol-alpha

Source file ticket_accounting.ml

Source file `ticket_accounting.ml`
