Source file receipt_repr.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
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
type balance =
| Contract of Contract_repr.t
| Block_fees
| Deposits of Signature.Public_key_hash.t
| Nonce_revelation_rewards
| Double_signing_evidence_rewards
| Endorsing_rewards
| Baking_rewards
| Baking_bonuses
| Storage_fees
| Double_signing_punishments
| Lost_endorsing_rewards of Signature.Public_key_hash.t * bool * bool
| Liquidity_baking_subsidies
| Burned
| Commitments of Blinded_public_key_hash.t
| Bootstrap
| Invoice
| Initial_commitments
| Minted
| Frozen_bonds of Contract_repr.t * Bond_id_repr.t
| Tx_rollup_rejection_punishments
| Tx_rollup_rejection_rewards
| Sc_rollup_refutation_punishments
| Sc_rollup_refutation_rewards
let balance_encoding =
let open Data_encoding in
def "operation_metadata.alpha.balance"
@@ union
[
case
(Tag 0)
~title:"Contract"
(obj2
(req "kind" (constant "contract"))
(req "contract" Contract_repr.encoding))
(function Contract c -> Some ((), c) | _ -> None)
(fun ((), c) -> Contract c);
case
(Tag 2)
~title:"Block_fees"
(obj2
(req "kind" (constant "accumulator"))
(req "category" (constant "block fees")))
(function Block_fees -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Block_fees);
case
(Tag 4)
~title:"Deposits"
(obj3
(req "kind" (constant "freezer"))
(req "category" (constant "deposits"))
(req "delegate" Signature.Public_key_hash.encoding))
(function Deposits d -> Some ((), (), d) | _ -> None)
(fun ((), (), d) -> Deposits d);
case
(Tag 5)
~title:"Nonce_revelation_rewards"
(obj2
(req "kind" (constant "minted"))
(req "category" (constant "nonce revelation rewards")))
(function Nonce_revelation_rewards -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Nonce_revelation_rewards);
case
(Tag 6)
~title:"Double_signing_evidence_rewards"
(obj2
(req "kind" (constant "minted"))
(req "category" (constant "double signing evidence rewards")))
(function
| Double_signing_evidence_rewards -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Double_signing_evidence_rewards);
case
(Tag 7)
~title:"Endorsing_rewards"
(obj2
(req "kind" (constant "minted"))
(req "category" (constant "endorsing rewards")))
(function Endorsing_rewards -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Endorsing_rewards);
case
(Tag 8)
~title:"Baking_rewards"
(obj2
(req "kind" (constant "minted"))
(req "category" (constant "baking rewards")))
(function Baking_rewards -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Baking_rewards);
case
(Tag 9)
~title:"Baking_bonuses"
(obj2
(req "kind" (constant "minted"))
(req "category" (constant "baking bonuses")))
(function Baking_bonuses -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Baking_bonuses);
case
(Tag 11)
~title:"Storage_fees"
(obj2
(req "kind" (constant "burned"))
(req "category" (constant "storage fees")))
(function Storage_fees -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Storage_fees);
case
(Tag 12)
~title:"Double_signing_punishments"
(obj2
(req "kind" (constant "burned"))
(req "category" (constant "punishments")))
(function Double_signing_punishments -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Double_signing_punishments);
case
(Tag 13)
~title:"Lost_endorsing_rewards"
(obj5
(req "kind" (constant "burned"))
(req "category" (constant "lost endorsing rewards"))
(req "delegate" Signature.Public_key_hash.encoding)
(req "participation" Data_encoding.bool)
(req "revelation" Data_encoding.bool))
(function
| Lost_endorsing_rewards (d, p, r) -> Some ((), (), d, p, r)
| _ -> None)
(fun ((), (), d, p, r) -> Lost_endorsing_rewards (d, p, r));
case
(Tag 14)
~title:"Liquidity_baking_subsidies"
(obj2
(req "kind" (constant "minted"))
(req "category" (constant "subsidy")))
(function Liquidity_baking_subsidies -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Liquidity_baking_subsidies);
case
(Tag 15)
~title:"Burned"
(obj2
(req "kind" (constant "burned"))
(req "category" (constant "burned")))
(function Burned -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Burned);
case
(Tag 16)
~title:"Commitments"
(obj3
(req "kind" (constant "commitment"))
(req "category" (constant "commitment"))
(req "committer" Blinded_public_key_hash.encoding))
(function Commitments bpkh -> Some ((), (), bpkh) | _ -> None)
(fun ((), (), bpkh) -> Commitments bpkh);
case
(Tag 17)
~title:"Bootstrap"
(obj2
(req "kind" (constant "minted"))
(req "category" (constant "bootstrap")))
(function Bootstrap -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Bootstrap);
case
(Tag 18)
~title:"Invoice"
(obj2
(req "kind" (constant "minted"))
(req "category" (constant "invoice")))
(function Invoice -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Invoice);
case
(Tag 19)
~title:"Initial_commitments"
(obj2
(req "kind" (constant "minted"))
(req "category" (constant "commitment")))
(function Initial_commitments -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Initial_commitments);
case
(Tag 20)
~title:"Minted"
(obj2
(req "kind" (constant "minted"))
(req "category" (constant "minted")))
(function Minted -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Minted);
case
(Tag 21)
~title:"Frozen_bonds"
(obj4
(req "kind" (constant "freezer"))
(req "category" (constant "bonds"))
(req "contract" Contract_repr.encoding)
(req "bond_id" Bond_id_repr.encoding))
(function Frozen_bonds (c, r) -> Some ((), (), c, r) | _ -> None)
(fun ((), (), c, r) -> Frozen_bonds (c, r));
case
(Tag 22)
~title:"Tx_rollup_rejection_rewards"
(obj2
(req "kind" (constant "minted"))
(req "category" (constant "tx_rollup_rejection_rewards")))
(function Tx_rollup_rejection_rewards -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Tx_rollup_rejection_rewards);
case
(Tag 23)
~title:"Tx_rollup_rejection_punishments"
(obj2
(req "kind" (constant "burned"))
(req "category" (constant "tx_rollup_rejection_punishments")))
(function
| Tx_rollup_rejection_punishments -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Tx_rollup_rejection_punishments);
case
(Tag 24)
~title:"Sc_rollup_refutation_punishments"
(obj2
(req "kind" (constant "burned"))
(req "category" (constant "sc_rollup_refutation_punishments")))
(function
| Sc_rollup_refutation_punishments -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Sc_rollup_refutation_punishments);
case
(Tag 25)
~title:"Sc_rollup_refutation_rewards"
(obj2
(req "kind" (constant "minted"))
(req "category" (constant "sc_rollup_refutation_rewards")))
(function
| Sc_rollup_refutation_rewards -> Some ((), ()) | _ -> None)
(fun ((), ()) -> Sc_rollup_refutation_rewards);
]
let is_not_zero c = not (Compare.Int.equal c 0)
let compare_balance ba bb =
match (ba, bb) with
| Contract ca, Contract cb -> Contract_repr.compare ca cb
| Deposits pkha, Deposits pkhb -> Signature.Public_key_hash.compare pkha pkhb
| Lost_endorsing_rewards (pkha, pa, ra), Lost_endorsing_rewards (pkhb, pb, rb)
->
let c = Signature.Public_key_hash.compare pkha pkhb in
if is_not_zero c then c
else
let c = Compare.Bool.compare pa pb in
if is_not_zero c then c else Compare.Bool.compare ra rb
| Commitments bpkha, Commitments bpkhb ->
Blinded_public_key_hash.compare bpkha bpkhb
| Frozen_bonds (ca, ra), Frozen_bonds (cb, rb) ->
let c = Contract_repr.compare ca cb in
if is_not_zero c then c else Bond_id_repr.compare ra rb
| _, _ ->
let index b =
match b with
| Contract _ -> 0
| Block_fees -> 1
| Deposits _ -> 2
| Nonce_revelation_rewards -> 3
| Double_signing_evidence_rewards -> 4
| Endorsing_rewards -> 5
| Baking_rewards -> 6
| Baking_bonuses -> 7
| Storage_fees -> 8
| Double_signing_punishments -> 9
| Lost_endorsing_rewards _ -> 10
| Liquidity_baking_subsidies -> 11
| Burned -> 12
| Commitments _ -> 13
| Bootstrap -> 14
| Invoice -> 15
| Initial_commitments -> 16
| Minted -> 17
| Frozen_bonds _ -> 18
| Tx_rollup_rejection_punishments -> 19
| Tx_rollup_rejection_rewards -> 20
| Sc_rollup_refutation_punishments -> 21
| Sc_rollup_refutation_rewards -> 22
in
Compare.Int.compare (index ba) (index bb)
type balance_update = Debited of Tez_repr.t | Credited of Tez_repr.t
let is_zero_update = function Debited t | Credited t -> Tez_repr.(t = zero)
let balance_update_encoding =
let open Data_encoding in
def "operation_metadata.alpha.balance_update"
@@ obj1
(req
"change"
(conv
(function
| Credited v -> Tez_repr.to_mutez v
| Debited v -> Int64.neg (Tez_repr.to_mutez v))
( Json.wrap_error @@ fun v ->
if Compare.Int64.(v < 0L) then
match Tez_repr.of_mutez (Int64.neg v) with
| Some v -> Debited v
| None -> assert false
else
match Tez_repr.of_mutez v with
| Some v -> Credited v
| None -> assert false )
int64))
type update_origin =
| Block_application
| Protocol_migration
| Subsidy
| Simulation
let compare_update_origin oa ob =
let index o =
match o with
| Block_application -> 0
| Protocol_migration -> 1
| Subsidy -> 2
| Simulation -> 3
in
Compare.Int.compare (index oa) (index ob)
let update_origin_encoding =
let open Data_encoding in
def "operation_metadata.alpha.update_origin"
@@ obj1 @@ req "origin"
@@ union
[
case
(Tag 0)
~title:"Block_application"
(constant "block")
(function Block_application -> Some () | _ -> None)
(fun () -> Block_application);
case
(Tag 1)
~title:"Protocol_migration"
(constant "migration")
(function Protocol_migration -> Some () | _ -> None)
(fun () -> Protocol_migration);
case
(Tag 2)
~title:"Subsidy"
(constant "subsidy")
(function Subsidy -> Some () | _ -> None)
(fun () -> Subsidy);
case
(Tag 3)
~title:"Simulation"
(constant "simulation")
(function Simulation -> Some () | _ -> None)
(fun () -> Simulation);
]
type balance_updates = (balance * balance_update * update_origin) list
let balance_updates_encoding =
let open Data_encoding in
def "operation_metadata.alpha.balance_updates"
@@ list
(conv
(function
| balance, balance_update, update_origin ->
((balance, balance_update), update_origin))
(fun ((balance, balance_update), update_origin) ->
(balance, balance_update, update_origin))
(merge_objs
(merge_objs balance_encoding balance_update_encoding)
update_origin_encoding))
module BalanceMap = struct
include Map.Make (struct
type t = balance * update_origin
let compare (ba, ua) (bb, ub) =
let c = compare_balance ba bb in
if is_not_zero c then c else compare_update_origin ua ub
end)
let update_r key (f : 'a option -> 'b option tzresult) map =
f (find key map) >>? function
| Some v -> ok (add key v map)
| None -> ok (remove key map)
end
let group_balance_updates balance_updates =
List.fold_left_e
(fun acc (b, update, o) ->
if is_zero_update update then ok acc
else
BalanceMap.update_r
(b, o)
(function
| None -> ok (Some update)
| Some balance -> (
match (balance, update) with
| Credited a, Debited b | Debited b, Credited a ->
if Tez_repr.(a = b) then ok None
else if Tez_repr.(a > b) then
Tez_repr.(a -? b) >>? fun update ->
ok (Some (Credited update))
else
Tez_repr.(b -? a) >>? fun update ->
ok (Some (Debited update))
| Credited a, Credited b ->
Tez_repr.(a +? b) >>? fun update ->
ok (Some (Credited update))
| Debited a, Debited b ->
Tez_repr.(a +? b) >>? fun update ->
ok (Some (Debited update))))
acc)
BalanceMap.empty
balance_updates
>>? fun map ->
ok (BalanceMap.fold (fun (b, o) u acc -> (b, u, o) :: acc) map [])