package tezos-protocol-015-PtLimaPt

You can search for identifiers within the package.
in-package search v0.2.0
tezos-protocol-015-PtLimaPt
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
(*****************************************************************************)
(*                                                                           *)
(* 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) (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 =
    Ticket_token_map.find ctxt token map >|=? fun (amnt_opt, ctxt) ->
    (Option.value ~default:Z.zero amnt_opt, ctxt)

  let merge_overlap ctxt b1 b2 =
    Gas.consume ctxt (Ticket_costs.add_z_cost b1 b2) >|? fun ctxt ->
    (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 =
    map
      ctxt
      (fun ctxt _ amount ->
        Gas.consume ctxt (Ticket_costs.negate_cost amount) >|? fun ctxt ->
        (Z.neg amount, ctxt))
      m2
    >>? fun (m2, ctxt) -> add ctxt m1 m2
end

let ticket_balances_of_value ctxt ~include_lazy ty value =
  Ticket_scanner.tickets_of_value ~include_lazy ctxt ty value
  >>=? fun (tickets, ctxt) ->
  List.fold_left_e
    (fun (acc, ctxt) ticket ->
      let token, amount = Ticket_token.token_and_amount_of_ex_ticket ticket in
      Gas.consume ctxt Ticket_costs.Constants.cost_collect_tickets_step
      >|? fun ctxt ->
      ( (token, Script_int.to_zint (amount :> Script_int.n Script_int.num))
        :: acc,
        ctxt ))
    ([], ctxt)
    tickets
  >>?= fun (list, ctxt) -> Ticket_token_map.of_list ctxt list

let update_ticket_balances ctxt ~total_storage_diff token destinations =
  List.fold_left_es
    (fun (tot_storage_diff, ctxt) (owner, delta) ->
      Ticket_balance_key.of_ex_token ctxt ~owner token
      >>=? fun (key_hash, ctxt) ->
      Ticket_balance.adjust_balance ctxt key_hash ~delta
      >>=? fun (storage_diff, ctxt) ->
      Gas.consume ctxt (Ticket_costs.add_z_cost total_storage_diff storage_diff)
      >>?= fun ctxt -> 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 =
  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
      error_unless
        is_valid_balance_update
        (invalid_ticket_transfer_error ~ticket_token ~amount)
      >>?= fun () ->
      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 =
  (* Only scan lazy-diffs for tickets in case the storage contains tickets. *)
  if Ticket_scanner.has_tickets storage_type_has_tickets then
    Ticket_lazy_storage_diff.ticket_diffs_of_lazy_storage_diff
      ctxt
      lazy_storage_diff
    >>=? fun (diffs, ctxt) -> 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
    =
  (* Collect ticket-token balances of the incoming parameters. *)
  ticket_balances_of_value ctxt ~include_lazy:true arg_type_has_tickets arg
  >>=? fun (arg_tickets, ctxt) ->
  ticket_diffs_of_lazy_storage_diff
    ctxt
    ~storage_type_has_tickets
    lazy_storage_diff
  >>=? fun (lazy_storage_diff, ctxt) ->
  ticket_balances_of_value
    ctxt
    ~include_lazy:false
    storage_type_has_tickets
    old_storage
  >>=? fun (old_storage_strict, ctxt) ->
  ticket_balances_of_value
    ctxt
    ~include_lazy:false
    storage_type_has_tickets
    new_storage
  >>=? fun (new_storage_strict, ctxt) ->
  Ticket_token_map.add ctxt new_storage_strict lazy_storage_diff
  >>?= fun (additions, ctxt) ->
  Ticket_token_map.sub ctxt additions old_storage_strict
  >>?= fun (total_storage_diff, ctxt) ->
  Ticket_token_map.sub ctxt total_storage_diff arg_tickets
  >>?= fun (diff, ctxt) ->
  Ticket_token_map.to_ticket_receipt
    ctxt
    ~owner:Destination.(Contract self_contract)
    total_storage_diff
  >>=? fun (ticket_receipt, ctxt) -> return (diff, ticket_receipt, ctxt)

let update_ticket_balances ctxt ~self_contract ~ticket_diffs operations =
  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
      Ticket_token_map.balance_diff ctxt ticket_token ticket_diffs
      >|=? fun (balance_diff, ctxt) ->
      (* 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 *)
  Ticket_operations_diff.ticket_diffs_of_operations ctxt operations
  >>=? fun (ticket_op_diffs, ctxt) ->
  (* Update balances for self-contract. *)
  Ticket_token_map.to_list ctxt ticket_diffs >>?= fun (ticket_diffs, ctxt) ->
  update_ticket_balances_for_self_contract ctxt ~self_contract ticket_diffs
  >>=? fun (total_storage_diff, ctxt) ->
  (* 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. *)
      validate_spending_budget ctxt ticket_token total_amount
      >>=? fun (is_valid_balance_update, ctxt) ->
      error_unless
        is_valid_balance_update
        (invalid_ticket_transfer_error
           ~ticket_token
           ~amount:(Script_int.to_zint total_amount))
      >>?= fun () ->
      List.fold_left_e
        (fun (acc, ctxt) (token, (amount : Script_typed_ir.ticket_amount)) ->
          (* Consume some gas for for traversing the list. *)
          Gas.consume ctxt Ticket_costs.Constants.cost_collect_tickets_step
          >|? fun ctxt ->
          ((token, Script_int.(to_zint (amount :> n num))) :: acc, ctxt))
        ([], ctxt)
        destinations
      >>?= fun (destinations, ctxt) ->
      update_ticket_balances ctxt ~total_storage_diff ticket_token destinations)
    (total_storage_diff, ctxt)
    ticket_op_diffs
package tezos-protocol-015-PtLimaPt

Source file ticket_accounting.ml

Source file `ticket_accounting.ml`
