• Home
  • Features
  • Pricing
  • Docs
  • Announcements
  • Sign In

MinaProtocol / mina / 535

25 Aug 2025 05:35PM UTC coverage: 32.09% (-28.7%) from 60.772%
535

push

buildkite

web-flow
Merge pull request #17673 from MinaProtocol/amcie-merge-release320-to-master

amcie-merge-release320-to-master

1010 of 3745 new or added lines in 242 files covered. (26.97%)

17403 existing lines in 378 files now uncovered.

23062 of 71866 relevant lines covered (32.09%)

24742.7 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

43.38
/src/lib/staged_ledger_diff/diff.ml
1
open Core_kernel
78✔
2
open Mina_base
3

4
module At_most_two = struct
5
  [%%versioned
6
  module Stable = struct
7
    [@@@no_toplevel_latest_type]
8

9
    module V1 = struct
NEW
10
      type 'a t = Zero | One of 'a option | Two of ('a * 'a option) option
×
11
      [@@deriving equal, compare, sexp, yojson]
234✔
12
    end
13
  end]
14

15
  type 'a t = 'a Stable.Latest.t =
1,600✔
NEW
16
    | Zero
×
NEW
17
    | One of 'a option
×
NEW
18
    | Two of ('a * 'a option) option
×
NEW
19
  [@@deriving equal, compare, sexp, yojson]
×
20

21
  let increase t ws =
NEW
22
    match (t, ws) with
×
NEW
23
    | Zero, [] ->
×
24
        Ok (One None)
NEW
25
    | Zero, [ a ] ->
×
26
        Ok (One (Some a))
NEW
27
    | One _, [] ->
×
28
        Ok (Two None)
NEW
29
    | One _, [ a ] ->
×
30
        Ok (Two (Some (a, None)))
NEW
31
    | One _, [ a; a' ] ->
×
32
        Ok (Two (Some (a', Some a)))
NEW
33
    | _ ->
×
34
        Or_error.error_string "Error incrementing coinbase parts"
35
end
36

37
module At_most_one = struct
38
  [%%versioned
39
  module Stable = struct
40
    [@@@no_toplevel_latest_type]
41

42
    module V1 = struct
NEW
43
      type 'a t = Zero | One of 'a option
×
44
      [@@deriving equal, compare, sexp, yojson]
234✔
45
    end
46
  end]
47

NEW
48
  type 'a t = 'a Stable.Latest.t = Zero | One of 'a option
×
49
  [@@deriving equal, compare, sexp, yojson]
50

51
  let increase t ws =
NEW
52
    match (t, ws) with
×
NEW
53
    | Zero, [] ->
×
54
        Ok (One None)
NEW
55
    | Zero, [ a ] ->
×
56
        Ok (One (Some a))
NEW
57
    | _ ->
×
58
        Or_error.error_string "Error incrementing coinbase parts"
59
end
60

61
module Ft = struct
62
  [%%versioned
63
  module Stable = struct
64
    [@@@no_toplevel_latest_type]
65

66
    module V1 = struct
NEW
67
      type t = Coinbase.Fee_transfer.Stable.V1.t
×
68
      [@@deriving equal, compare, sexp, yojson]
390✔
69

70
      let to_latest = Fn.id
71
    end
72
  end]
73

NEW
74
  type t = Stable.Latest.t [@@deriving equal, compare, sexp, yojson]
×
75
end
76

77
module Pre_diff_two = struct
78
  [%%versioned
79
  module Stable = struct
80
    [@@@no_toplevel_latest_type]
81

82
    module V2 = struct
83
      type ('a, 'b) t =
390✔
NEW
84
        { completed_works : 'a list
×
NEW
85
        ; commands : 'b list
×
NEW
86
        ; coinbase : Ft.Stable.V1.t At_most_two.Stable.V1.t
×
NEW
87
        ; internal_command_statuses : Transaction_status.Stable.V2.t list
×
88
        }
89
      [@@deriving equal, compare, sexp, yojson]
558✔
90
    end
91
  end]
92

NEW
93
  type ('a, 'b) t = ('a, 'b) Stable.Latest.t =
×
NEW
94
    { completed_works : 'a list
×
NEW
95
    ; commands : 'b list
×
NEW
96
    ; coinbase : Ft.t At_most_two.t
×
NEW
97
    ; internal_command_statuses : Transaction_status.t list
×
98
    }
NEW
99
  [@@deriving equal, compare, sexp, yojson]
×
100

101
  let map t ~f1 ~f2 =
102
    { completed_works = List.map t.completed_works ~f:f1
800✔
103
    ; commands = List.map t.commands ~f:f2
800✔
104
    ; coinbase = t.coinbase
105
    ; internal_command_statuses = t.internal_command_statuses
106
    }
107
end
108

109
module Pre_diff_one = struct
110
  [%%versioned
111
  module Stable = struct
112
    [@@@no_toplevel_latest_type]
113

114
    module V2 = struct
115
      type ('a, 'b) t =
178✔
NEW
116
        { completed_works : 'a list
×
NEW
117
        ; commands : 'b list
×
NEW
118
        ; coinbase : Ft.Stable.V1.t At_most_one.Stable.V1.t
×
NEW
119
        ; internal_command_statuses : Transaction_status.Stable.V2.t list
×
120
        }
121
      [@@deriving equal, compare, sexp, yojson]
390✔
122
    end
123
  end]
124

NEW
125
  type ('a, 'b) t = ('a, 'b) Stable.Latest.t =
×
NEW
126
    { completed_works : 'a list
×
NEW
127
    ; commands : 'b list
×
NEW
128
    ; coinbase : Ft.t At_most_one.t
×
NEW
129
    ; internal_command_statuses : Transaction_status.t list
×
130
    }
NEW
131
  [@@deriving equal, compare, sexp, yojson]
×
132

133
  let map t ~f1 ~f2 =
NEW
134
    { completed_works = List.map t.completed_works ~f:f1
×
NEW
135
    ; commands = List.map t.commands ~f:f2
×
136
    ; coinbase = t.coinbase
137
    ; internal_command_statuses = t.internal_command_statuses
138
    }
139
end
140

141
module Pre_diff_with_at_most_two_coinbase = struct
142
  [%%versioned
143
  module Stable = struct
144
    [@@@no_toplevel_latest_type]
145

146
    module V2 = struct
147
      type t =
78✔
NEW
148
        ( Transaction_snark_work.Stable.V2.t
×
NEW
149
        , User_command.Stable.V2.t With_status.Stable.V2.t )
×
NEW
150
        Pre_diff_two.Stable.V2.t
×
151
      [@@deriving equal, sexp, yojson]
390✔
152

153
      let to_latest = Fn.id
154
    end
155
  end]
156

157
  type t =
158
    (Transaction_snark_work.t, User_command.t With_status.t) Pre_diff_two.t
159

160
  let write_all_proofs_to_disk ~proof_cache_db : Stable.Latest.t -> t =
161
    let signature_kind = Mina_signature_kind.t_DEPRECATED in
200✔
162
    Pre_diff_two.map
163
      ~f1:(Transaction_snark_work.write_all_proofs_to_disk ~proof_cache_db)
164
      ~f2:
165
        (With_status.map
166
           ~f:
167
             (User_command.write_all_proofs_to_disk ~signature_kind
168
                ~proof_cache_db ) )
169

170
  let read_all_proofs_from_disk : t -> Stable.Latest.t =
171
    Pre_diff_two.map ~f1:Transaction_snark_work.read_all_proofs_from_disk
172
      ~f2:(With_status.map ~f:User_command.read_all_proofs_from_disk)
173
end
174

175
module Pre_diff_with_at_most_one_coinbase = struct
176
  [%%versioned
177
  module Stable = struct
178
    [@@@no_toplevel_latest_type]
179

180
    module V2 = struct
181
      type t =
78✔
NEW
182
        ( Transaction_snark_work.Stable.V2.t
×
NEW
183
        , User_command.Stable.V2.t With_status.Stable.V2.t )
×
NEW
184
        Pre_diff_one.Stable.V2.t
×
185
      [@@deriving equal, sexp, yojson]
390✔
186

187
      let to_latest = Fn.id
188
    end
189
  end]
190

191
  type t =
192
    (Transaction_snark_work.t, User_command.t With_status.t) Pre_diff_one.t
193

194
  let write_all_proofs_to_disk ~proof_cache_db : Stable.Latest.t -> t =
195
    let signature_kind = Mina_signature_kind.t_DEPRECATED in
200✔
196
    Pre_diff_one.map
197
      ~f1:(Transaction_snark_work.write_all_proofs_to_disk ~proof_cache_db)
198
      ~f2:
199
        (With_status.map
200
           ~f:
201
             (User_command.write_all_proofs_to_disk ~signature_kind
202
                ~proof_cache_db ) )
203

204
  let read_all_proofs_from_disk : t -> Stable.Latest.t =
205
    Pre_diff_one.map ~f1:Transaction_snark_work.read_all_proofs_from_disk
206
      ~f2:(With_status.map ~f:User_command.read_all_proofs_from_disk)
207
end
208

209
module Diff = struct
210
  let coinbase_amount
211
      ~(constraint_constants : Genesis_constants.Constraint_constants.t)
212
      ~supercharge_coinbase =
213
    if supercharge_coinbase then
781✔
214
      Currency.Amount.scale constraint_constants.coinbase_amount
393✔
215
        constraint_constants.supercharged_coinbase_factor
216
    else Some constraint_constants.coinbase_amount
388✔
217

218
  let coinbase
219
      ~(constraint_constants : Genesis_constants.Constraint_constants.t)
220
      ~supercharge_coinbase (first_pre_diff, second_pre_diff_opt) =
221
    let coinbase_amount =
381✔
222
      coinbase_amount ~constraint_constants ~supercharge_coinbase
223
    in
224
    match
225
      ( first_pre_diff.Pre_diff_two.coinbase
226
      , Option.value_map second_pre_diff_opt ~default:At_most_one.Zero
381✔
NEW
227
          ~f:(fun d -> d.Pre_diff_one.coinbase) )
×
228
    with
229
    | At_most_two.Zero, At_most_one.Zero ->
221✔
230
        Some Currency.Amount.zero
231
    | _ ->
160✔
232
        coinbase_amount
233

234
  [%%versioned
235
  module Stable = struct
236
    [@@@no_toplevel_latest_type]
237

238
    module V2 = struct
239
      type t =
78✔
NEW
240
        Pre_diff_with_at_most_two_coinbase.Stable.V2.t
×
NEW
241
        * Pre_diff_with_at_most_one_coinbase.Stable.V2.t option
×
242
      [@@deriving equal, sexp, yojson]
390✔
243

244
      let to_latest = Fn.id
245

246
      let coinbase = coinbase
247
    end
248
  end]
249

250
  type t =
251
    Pre_diff_with_at_most_two_coinbase.t
252
    * Pre_diff_with_at_most_one_coinbase.t option
253

254
  let write_all_proofs_to_disk ~proof_cache_db
255
      (( pre_diff_with_at_most_two_coinbase
256
       , pre_diff_with_at_most_one_coinbase_opt ) :
257
        Stable.Latest.t ) : t =
258
    ( Pre_diff_with_at_most_two_coinbase.write_all_proofs_to_disk
200✔
259
        ~proof_cache_db pre_diff_with_at_most_two_coinbase
260
    , Option.map pre_diff_with_at_most_one_coinbase_opt
200✔
261
        ~f:
262
          (Pre_diff_with_at_most_one_coinbase.write_all_proofs_to_disk
263
             ~proof_cache_db ) )
264

265
  let read_all_proofs_from_disk
266
      (( pre_diff_with_at_most_two_coinbase
267
       , pre_diff_with_at_most_one_coinbase_opt ) :
268
        t ) : Stable.Latest.t =
269
    ( Pre_diff_with_at_most_two_coinbase.read_all_proofs_from_disk
600✔
270
        pre_diff_with_at_most_two_coinbase
271
    , Option.map pre_diff_with_at_most_one_coinbase_opt
600✔
272
        ~f:Pre_diff_with_at_most_one_coinbase.read_all_proofs_from_disk )
273
end
274

275
[%%versioned
276
module Stable = struct
277
  [@@@no_toplevel_latest_type]
278

279
  module V2 = struct
NEW
280
    type t = { diff : Diff.Stable.V2.t } [@@deriving equal, sexp, yojson]
×
281

282
    let to_latest = Fn.id
283

284
    let empty_diff : t =
285
      { diff =
286
          ( { completed_works = []
287
            ; commands = []
288
            ; coinbase = At_most_two.Zero
289
            ; internal_command_statuses = []
290
            }
291
          , None )
292
      }
293

294
    let completed_works (t : t) =
NEW
295
      (fst t.diff).completed_works
×
NEW
296
      @ Option.value_map (snd t.diff) ~default:[] ~f:(fun d ->
×
NEW
297
            d.completed_works )
×
298
  end
299
end]
300

NEW
301
type t = { diff : Diff.t } [@@deriving fields]
×
302

303
let write_all_proofs_to_disk ~proof_cache_db t =
304
  { diff = Diff.write_all_proofs_to_disk ~proof_cache_db t.Stable.Latest.diff }
200✔
305

306
let read_all_proofs_from_disk t =
307
  { Stable.Latest.diff = Diff.read_all_proofs_from_disk t.diff }
600✔
308

309
module With_valid_signatures_and_proofs = struct
310
  type pre_diff_with_at_most_two_coinbase =
311
    ( Transaction_snark_work.Checked.t
312
    , User_command.Valid.t With_status.t )
313
    Pre_diff_two.t
314

315
  type pre_diff_with_at_most_one_coinbase =
316
    ( Transaction_snark_work.Checked.t
317
    , User_command.Valid.t With_status.t )
318
    Pre_diff_one.t
319

320
  type diff =
321
    pre_diff_with_at_most_two_coinbase
322
    * pre_diff_with_at_most_one_coinbase option
323

324
  type t = { diff : diff }
325

326
  let empty_diff : t =
327
    { diff =
328
        ( { completed_works = []
329
          ; commands = []
330
          ; coinbase = At_most_two.Zero
331
          ; internal_command_statuses = []
332
          }
333
        , None )
334
    }
335

336
  let commands t =
NEW
337
    (fst t.diff).commands
×
NEW
338
    @ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.commands)
×
339
end
340

341
let forget_cw cw_list = List.map ~f:Transaction_snark_work.forget cw_list
400✔
342

343
module With_valid_signatures = struct
344
  type pre_diff_with_at_most_two_coinbase =
345
    ( Transaction_snark_work.t
346
    , User_command.Valid.t With_status.t )
347
    Pre_diff_two.t
348

349
  type pre_diff_with_at_most_one_coinbase =
350
    ( Transaction_snark_work.t
351
    , User_command.Valid.t With_status.t )
352
    Pre_diff_one.t
353

354
  type diff =
355
    pre_diff_with_at_most_two_coinbase
356
    * pre_diff_with_at_most_one_coinbase option
357

358
  type t = { diff : diff }
359

360
  let coinbase
361
      ~(constraint_constants : Genesis_constants.Constraint_constants.t)
362
      ~supercharge_coinbase (t : t) =
363
    let first_pre_diff, second_pre_diff_opt = t.diff in
400✔
364
    let coinbase_amount =
365
      Diff.coinbase_amount ~constraint_constants ~supercharge_coinbase
366
    in
367
    match
368
      ( first_pre_diff.coinbase
369
      , Option.value_map second_pre_diff_opt ~default:At_most_one.Zero
400✔
NEW
370
          ~f:(fun d -> d.coinbase) )
×
371
    with
372
    | At_most_two.Zero, At_most_one.Zero ->
240✔
373
        Some Currency.Amount.zero
374
    | _ ->
160✔
375
        coinbase_amount
376
end
377

378
let validate_commands (t : t)
379
    ~(check :
380
          User_command.t With_status.t list
381
       -> (User_command.Valid.t list, 'e) Result.t Async.Deferred.Or_error.t ) :
382
    (With_valid_signatures.t, 'e) Result.t Async.Deferred.Or_error.t =
383
  let map t ~f = Async.Deferred.Or_error.map t ~f:(Result.map ~f) in
200✔
384
  let validate cs =
385
    map (check cs)
200✔
386
      ~f:
387
        (List.map2_exn cs ~f:(fun c data ->
200✔
388
             { With_status.data; status = c.status } ) )
480✔
389
  in
390
  let d1, d2 = t.diff in
391
  map
392
    (validate
200✔
NEW
393
       (d1.commands @ Option.value_map d2 ~default:[] ~f:(fun d2 -> d2.commands)) )
×
394
    ~f:(fun commands_all ->
395
      let commands1, commands2 =
200✔
396
        List.split_n commands_all (List.length d1.commands)
200✔
397
      in
398
      let p1 : With_valid_signatures.pre_diff_with_at_most_two_coinbase =
200✔
399
        { completed_works = d1.completed_works
400
        ; commands = commands1
401
        ; coinbase = d1.coinbase
402
        ; internal_command_statuses = d1.internal_command_statuses
403
        }
404
      in
405
      let p2 =
406
        Option.value_map ~default:None d2 ~f:(fun d2 ->
NEW
407
            Some
×
408
              { Pre_diff_one.completed_works = d2.completed_works
409
              ; commands = commands2
410
              ; coinbase = d2.coinbase
411
              ; internal_command_statuses = d2.internal_command_statuses
412
              } )
413
      in
414
      ({ diff = (p1, p2) } : With_valid_signatures.t) )
200✔
415

416
let forget_proof_checks (d : With_valid_signatures_and_proofs.t) :
417
    With_valid_signatures.t =
418
  let d1 = fst d.diff in
200✔
419
  let p1 : With_valid_signatures.pre_diff_with_at_most_two_coinbase =
200✔
420
    { completed_works = forget_cw d1.completed_works
200✔
421
    ; commands = d1.commands
422
    ; coinbase = d1.coinbase
423
    ; internal_command_statuses = d1.internal_command_statuses
424
    }
425
  in
426
  let p2 =
427
    Option.map (snd d.diff)
200✔
428
      ~f:(fun d2 : With_valid_signatures.pre_diff_with_at_most_one_coinbase ->
NEW
429
        { completed_works = forget_cw d2.completed_works
×
430
        ; commands = d2.commands
431
        ; coinbase = d2.coinbase
432
        ; internal_command_statuses = d2.internal_command_statuses
433
        } )
434
  in
435
  { diff = (p1, p2) }
200✔
436

437
let forget_pre_diff_with_at_most_two
438
    (pre_diff :
439
      With_valid_signatures_and_proofs.pre_diff_with_at_most_two_coinbase ) :
440
    Pre_diff_with_at_most_two_coinbase.t =
441
  { completed_works = forget_cw pre_diff.completed_works
200✔
442
  ; commands =
443
      List.map
200✔
444
        ~f:(With_status.map ~f:User_command.forget_check)
445
        pre_diff.commands
446
  ; coinbase = pre_diff.coinbase
447
  ; internal_command_statuses = pre_diff.internal_command_statuses
448
  }
449

450
let forget_pre_diff_with_at_most_one
451
    (pre_diff :
452
      With_valid_signatures_and_proofs.pre_diff_with_at_most_one_coinbase ) =
NEW
453
  { Pre_diff_one.completed_works = forget_cw pre_diff.completed_works
×
454
  ; commands =
NEW
455
      List.map
×
456
        ~f:(With_status.map ~f:User_command.forget_check)
457
        pre_diff.commands
458
  ; coinbase = pre_diff.coinbase
459
  ; internal_command_statuses = pre_diff.internal_command_statuses
460
  }
461

462
let forget (t : With_valid_signatures_and_proofs.t) =
463
  { diff =
200✔
464
      ( forget_pre_diff_with_at_most_two (fst t.diff)
200✔
465
      , Option.map (snd t.diff) ~f:forget_pre_diff_with_at_most_one )
200✔
466
  }
467

468
let commands (t : t) =
469
  (fst t.diff).commands
400✔
NEW
470
  @ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.commands)
×
471

472
let completed_works (t : t) =
473
  (fst t.diff).completed_works
400✔
NEW
474
  @ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.completed_works)
×
475

476
let net_return
477
    ~(constraint_constants : Genesis_constants.Constraint_constants.t)
478
    ~supercharge_coinbase (t : t) =
NEW
479
  let open Currency in
×
480
  let open Option.Let_syntax in
481
  let%bind coinbase =
NEW
482
    Diff.coinbase ~constraint_constants ~supercharge_coinbase t.diff
×
483
  in
484
  let%bind total_reward =
NEW
485
    List.fold
×
NEW
486
      ~init:(Some (Amount.to_fee coinbase))
×
NEW
487
      (commands t)
×
488
      ~f:(fun sum cmd ->
489
        let%bind sum = sum in
NEW
490
        Fee.( + ) sum (User_command.fee (With_status.data cmd)) )
×
491
  in
492
  let%bind completed_works_fees =
NEW
493
    List.fold ~init:(Some Fee.zero) (completed_works t) ~f:(fun sum work ->
×
494
        let%bind sum = sum in
NEW
495
        Fee.(sum + Transaction_snark_work.fee work) )
×
496
  in
NEW
497
  Amount.(of_fee total_reward - of_fee completed_works_fees)
×
498

499
let empty_diff : t =
500
  { diff =
501
      ( { completed_works = []
502
        ; commands = []
503
        ; coinbase = At_most_two.Zero
504
        ; internal_command_statuses = []
505
        }
506
      , None )
507
  }
508

509
let is_empty = function
NEW
510
  | { diff =
×
511
        ( { completed_works = []
512
          ; commands = []
513
          ; coinbase = At_most_two.Zero
514
          ; internal_command_statuses = []
515
          }
516
        , None )
517
    } ->
518
      true
NEW
519
  | _ ->
×
520
      false
156✔
STATUS · Troubleshooting · Open an Issue · Sales · Support · CAREERS · ENTERPRISE · START FREE · SCHEDULE DEMO
ANNOUNCEMENTS · TWITTER · TOS & SLA · Supported CI Services · What's a CI service? · Automated Testing

© 2026 Coveralls, Inc