3424

Committed 27 Feb 2025 08:50PM UTC coverage: 32.457% (-28.3%) from 60.796%

Build # 3424

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #16392 from MinaProtocol/dkijania/do_not_publish_dockers_on_pr

Skip publishing dockers on PR

Run Details

23218 of 71534 relevant lines covered (32.46%)

16977.68 hits per line

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

40.31

/src/lib/staged_ledger_diff/diff.ml

open Core_kernel
open Mina_base
module Wire_types = Mina_wire_types.Staged_ledger_diff

module Make_sig (A : Wire_types.Types.S) = struct
  module type S =
    Diff_intf.Full
      with type 'a At_most_two.t = 'a A.At_most_two.V1.t
       and type 'a At_most_two.Stable.V1.t = 'a A.At_most_two.V1.t
       and type ('a, 'b) Pre_diff_two.Stable.V2.t = ('a, 'b) A.Pre_diff_two.V2.t
       and type Pre_diff_with_at_most_two_coinbase.Stable.V2.t =
        A.Pre_diff_with_at_most_two_coinbase.V2.t
       and type 'a At_most_one.t = 'a A.At_most_one.V1.t
       and type ('a, 'b) Pre_diff_one.Stable.V2.t = ('a, 'b) A.Pre_diff_one.V2.t
       and type Pre_diff_with_at_most_one_coinbase.Stable.V2.t =
        A.Pre_diff_with_at_most_one_coinbase.V2.t
       and type t = A.V2.t
       and type Stable.V2.t = A.V2.t
end

module Make_str (A : Wire_types.Concrete) = struct
  module At_most_two = struct
    [%%versioned
    module Stable = struct
      [@@@no_toplevel_latest_type]

      module V1 = struct
        type 'a t = 'a A.At_most_two.V1.t =
          | Zero
          | One of 'a option
          | Two of ('a * 'a option) option
        [@@deriving equal, compare, sexp, yojson]
      end
    end]

    type 'a t = 'a Stable.Latest.t =
      | Zero
      | One of 'a option
      | Two of ('a * 'a option) option
    [@@deriving equal, compare, sexp, yojson]

    let increase t ws =
      match (t, ws) with
      | Zero, [] ->
          Ok (One None)
      | Zero, [ a ] ->
          Ok (One (Some a))
      | One _, [] ->
          Ok (Two None)
      | One _, [ a ] ->
          Ok (Two (Some (a, None)))
      | One _, [ a; a' ] ->
          Ok (Two (Some (a', Some a)))
      | _ ->
          Or_error.error_string "Error incrementing coinbase parts"
  end

  module At_most_one = struct
    [%%versioned
    module Stable = struct
      [@@@no_toplevel_latest_type]

      module V1 = struct
        type 'a t = 'a A.At_most_one.V1.t = Zero | One of 'a option
        [@@deriving equal, compare, sexp, yojson]
      end
    end]

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

    let increase t ws =
      match (t, ws) with
      | Zero, [] ->
          Ok (One None)
      | Zero, [ a ] ->
          Ok (One (Some a))
      | _ ->
          Or_error.error_string "Error incrementing coinbase parts"
  end

  module Ft = struct
    [%%versioned
    module Stable = struct
      [@@@no_toplevel_latest_type]

      module V1 = struct
        type t = Coinbase.Fee_transfer.Stable.V1.t
        [@@deriving equal, compare, sexp, yojson]

        let to_latest = Fn.id
      end
    end]

    type t = Stable.Latest.t [@@deriving equal, compare, sexp, yojson]
  end

  module Pre_diff_two = struct
    [%%versioned
    module Stable = struct
      [@@@no_toplevel_latest_type]

      module V2 = struct
        type ('a, 'b) t = ('a, 'b) A.Pre_diff_two.V2.t =
          { completed_works : 'a list
          ; commands : 'b list
          ; coinbase : Ft.Stable.V1.t At_most_two.Stable.V1.t
          ; internal_command_statuses : Transaction_status.Stable.V2.t list
          }
        [@@deriving equal, compare, sexp, yojson]
      end
    end]

    type ('a, 'b) t = ('a, 'b) Stable.Latest.t =
      { completed_works : 'a list
      ; commands : 'b list
      ; coinbase : Ft.t At_most_two.t
      ; internal_command_statuses : Transaction_status.t list
      }
    [@@deriving equal, compare, sexp, yojson]

    let map t ~f1 ~f2 =
      { completed_works = List.map t.completed_works ~f:f1
      ; commands = List.map t.commands ~f:f2
      ; coinbase = t.coinbase
      ; internal_command_statuses = t.internal_command_statuses
      }
  end

  module Pre_diff_one = struct
    [%%versioned
    module Stable = struct
      [@@@no_toplevel_latest_type]

      module V2 = struct
        type ('a, 'b) t = ('a, 'b) A.Pre_diff_one.V2.t =
          { completed_works : 'a list
          ; commands : 'b list
          ; coinbase : Ft.Stable.V1.t At_most_one.Stable.V1.t
          ; internal_command_statuses : Transaction_status.Stable.V2.t list
          }
        [@@deriving equal, compare, sexp, yojson]
      end
    end]

    type ('a, 'b) t = ('a, 'b) Stable.Latest.t =
      { completed_works : 'a list
      ; commands : 'b list
      ; coinbase : Ft.t At_most_one.t
      ; internal_command_statuses : Transaction_status.t list
      }
    [@@deriving equal, compare, sexp, yojson]

    let map t ~f1 ~f2 =
      { completed_works = List.map t.completed_works ~f:f1
      ; commands = List.map t.commands ~f:f2
      ; coinbase = t.coinbase
      ; internal_command_statuses = t.internal_command_statuses
      }
  end

  module Pre_diff_with_at_most_two_coinbase = struct
    [%%versioned
    module Stable = struct
      [@@@no_toplevel_latest_type]

      module V2 = struct
        type t =
          ( Transaction_snark_work.Stable.V2.t
          , User_command.Stable.V2.t With_status.Stable.V2.t )
          Pre_diff_two.Stable.V2.t
        [@@deriving equal, sexp, yojson]

        let to_latest = Fn.id
      end
    end]

    type t = Stable.Latest.t
  end

  module Pre_diff_with_at_most_one_coinbase = struct
    [%%versioned
    module Stable = struct
      [@@@no_toplevel_latest_type]

      module V2 = struct
        type t =
          ( Transaction_snark_work.Stable.V2.t
          , User_command.Stable.V2.t With_status.Stable.V2.t )
          Pre_diff_one.Stable.V2.t
        [@@deriving equal, sexp, yojson]

        let to_latest = Fn.id
      end
    end]

    type t = Stable.Latest.t
  end

  module Diff = struct
    [%%versioned
    module Stable = struct
      [@@@no_toplevel_latest_type]

      module V2 = struct
        type t =
          Pre_diff_with_at_most_two_coinbase.Stable.V2.t
          * Pre_diff_with_at_most_one_coinbase.Stable.V2.t option
        [@@deriving equal, sexp, yojson]

        let to_latest = Fn.id
      end
    end]

    type t = Stable.Latest.t
  end

  [%%versioned
  module Stable = struct
    [@@@no_toplevel_latest_type]

    module V2 = struct
      type t = A.V2.t = { diff : Diff.Stable.V2.t }
      [@@deriving equal, sexp, yojson]

      let to_latest = Fn.id
    end
  end]

  type t = Stable.Latest.t = { diff : Diff.t } [@@deriving fields]

  module With_valid_signatures_and_proofs = struct
    type pre_diff_with_at_most_two_coinbase =
      ( Transaction_snark_work.Checked.t
      , User_command.Valid.t With_status.t )
      Pre_diff_two.t

    type pre_diff_with_at_most_one_coinbase =
      ( Transaction_snark_work.Checked.t
      , User_command.Valid.t With_status.t )
      Pre_diff_one.t

    type diff =
      pre_diff_with_at_most_two_coinbase
      * pre_diff_with_at_most_one_coinbase option

    type t = { diff : diff }

    let empty_diff : t =
      { diff =
          ( { completed_works = []
            ; commands = []
            ; coinbase = At_most_two.Zero
            ; internal_command_statuses = []
            }
          , None )
      }

    let commands t =
      (fst t.diff).commands
      @ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.commands)
  end

  let forget_cw cw_list = List.map ~f:Transaction_snark_work.forget cw_list

  let coinbase_amount
      ~(constraint_constants : Genesis_constants.Constraint_constants.t)
      ~supercharge_coinbase =
    if supercharge_coinbase then
      Currency.Amount.scale constraint_constants.coinbase_amount
        constraint_constants.supercharged_coinbase_factor
    else Some constraint_constants.coinbase_amount

  let coinbase
      ~(constraint_constants : Genesis_constants.Constraint_constants.t)
      ~supercharge_coinbase t =
    let first_pre_diff, second_pre_diff_opt = t.diff in
    let coinbase_amount =
      coinbase_amount ~constraint_constants ~supercharge_coinbase
    in
    match
      ( first_pre_diff.coinbase
      , Option.value_map second_pre_diff_opt ~default:At_most_one.Zero
          ~f:(fun d -> d.coinbase) )
    with
    | At_most_two.Zero, At_most_one.Zero ->
        Some Currency.Amount.zero
    | _ ->
        coinbase_amount

  module With_valid_signatures = struct
    type pre_diff_with_at_most_two_coinbase =
      ( Transaction_snark_work.t
      , User_command.Valid.t With_status.t )
      Pre_diff_two.t

    type pre_diff_with_at_most_one_coinbase =
      ( Transaction_snark_work.t
      , User_command.Valid.t With_status.t )
      Pre_diff_one.t

    type diff =
      pre_diff_with_at_most_two_coinbase
      * pre_diff_with_at_most_one_coinbase option

    type t = { diff : diff }

    let coinbase
        ~(constraint_constants : Genesis_constants.Constraint_constants.t)
        ~supercharge_coinbase (t : t) =
      let first_pre_diff, second_pre_diff_opt = t.diff in
      let coinbase_amount =
        coinbase_amount ~constraint_constants ~supercharge_coinbase
      in
      match
        ( first_pre_diff.coinbase
        , Option.value_map second_pre_diff_opt ~default:At_most_one.Zero
            ~f:(fun d -> d.coinbase) )
      with
      | At_most_two.Zero, At_most_one.Zero ->
          Some Currency.Amount.zero
      | _ ->
          coinbase_amount
  end

  let validate_commands (t : t)
      ~(check :
            User_command.t With_status.t list
         -> (User_command.Valid.t list, 'e) Result.t Async.Deferred.Or_error.t
         ) : (With_valid_signatures.t, 'e) Result.t Async.Deferred.Or_error.t =
    let map t ~f = Async.Deferred.Or_error.map t ~f:(Result.map ~f) in
    let validate cs =
      map (check cs)
        ~f:
          (List.map2_exn cs ~f:(fun c data ->
               { With_status.data; status = c.status } ) )
    in
    let d1, d2 = t.diff in
    map
      (validate
         ( d1.commands
         @ Option.value_map d2 ~default:[] ~f:(fun d2 -> d2.commands) ) )
      ~f:(fun commands_all ->
        let commands1, commands2 =
          List.split_n commands_all (List.length d1.commands)
        in
        let p1 : With_valid_signatures.pre_diff_with_at_most_two_coinbase =
          { completed_works = d1.completed_works
          ; commands = commands1
          ; coinbase = d1.coinbase
          ; internal_command_statuses = d1.internal_command_statuses
          }
        in
        let p2 =
          Option.value_map ~default:None d2 ~f:(fun d2 ->
              Some
                { Pre_diff_one.completed_works = d2.completed_works
                ; commands = commands2
                ; coinbase = d2.coinbase
                ; internal_command_statuses = d2.internal_command_statuses
                } )
        in
        ({ diff = (p1, p2) } : With_valid_signatures.t) )

  let forget_proof_checks (d : With_valid_signatures_and_proofs.t) :
      With_valid_signatures.t =
    let d1 = fst d.diff in
    let p1 : With_valid_signatures.pre_diff_with_at_most_two_coinbase =
      { completed_works = forget_cw d1.completed_works
      ; commands = d1.commands
      ; coinbase = d1.coinbase
      ; internal_command_statuses = d1.internal_command_statuses
      }
    in
    let p2 =
      Option.map (snd d.diff)
        ~f:(fun d2 : With_valid_signatures.pre_diff_with_at_most_one_coinbase ->
          { completed_works = forget_cw d2.completed_works
          ; commands = d2.commands
          ; coinbase = d2.coinbase
          ; internal_command_statuses = d2.internal_command_statuses
          } )
    in
    { diff = (p1, p2) }

  let forget_pre_diff_with_at_most_two
      (pre_diff :
        With_valid_signatures_and_proofs.pre_diff_with_at_most_two_coinbase ) :
      Pre_diff_with_at_most_two_coinbase.t =
    { completed_works = forget_cw pre_diff.completed_works
    ; commands =
        List.map
          ~f:(With_status.map ~f:User_command.forget_check)
          pre_diff.commands
    ; coinbase = pre_diff.coinbase
    ; internal_command_statuses = pre_diff.internal_command_statuses
    }

  let forget_pre_diff_with_at_most_one
      (pre_diff :
        With_valid_signatures_and_proofs.pre_diff_with_at_most_one_coinbase ) =
    { Pre_diff_one.completed_works = forget_cw pre_diff.completed_works
    ; commands =
        List.map
          ~f:(With_status.map ~f:User_command.forget_check)
          pre_diff.commands
    ; coinbase = pre_diff.coinbase
    ; internal_command_statuses = pre_diff.internal_command_statuses
    }

  let forget (t : With_valid_signatures_and_proofs.t) =
    { diff =
        ( forget_pre_diff_with_at_most_two (fst t.diff)
        , Option.map (snd t.diff) ~f:forget_pre_diff_with_at_most_one )
    }

  let commands (t : t) =
    (fst t.diff).commands
    @ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.commands)

  let completed_works (t : t) =
    (fst t.diff).completed_works
    @ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.completed_works)

  let net_return
      ~(constraint_constants : Genesis_constants.Constraint_constants.t)
      ~supercharge_coinbase (t : t) =
    let open Currency in
    let open Option.Let_syntax in
    let%bind coinbase =
      coinbase ~constraint_constants ~supercharge_coinbase t
    in
    let%bind total_reward =
      List.fold
        ~init:(Some (Amount.to_fee coinbase))
        (commands t)
        ~f:(fun sum cmd ->
          let%bind sum = sum in
          Fee.( + ) sum (User_command.fee (With_status.data cmd)) )
    in
    let%bind completed_works_fees =
      List.fold ~init:(Some Fee.zero) (completed_works t) ~f:(fun sum work ->
          let%bind sum = sum in
          Fee.(sum + Transaction_snark_work.fee work) )
    in
    Amount.(of_fee total_reward - of_fee completed_works_fees)

  let empty_diff : t =
    { diff =
        ( { completed_works = []
          ; commands = []
          ; coinbase = At_most_two.Zero
          ; internal_command_statuses = []
          }
        , None )
    }

  let is_empty = function
    | { diff =
          ( { completed_works = []
            ; commands = []
            ; coinbase = At_most_two.Zero
            ; internal_command_statuses = []
            }
          , None )
      } ->
        true
    | _ ->
        false
end

include Wire_types.Make (Make_sig) (Make_str)

1	open Core_kernel	20✔
2	open Mina_base
3	module Wire_types = Mina_wire_types.Staged_ledger_diff
4
5	module Make_sig (A : Wire_types.Types.S) = struct
6	module type S =
7	Diff_intf.Full
8	with type 'a At_most_two.t = 'a A.At_most_two.V1.t
9	and type 'a At_most_two.Stable.V1.t = 'a A.At_most_two.V1.t
10	and type ('a, 'b) Pre_diff_two.Stable.V2.t = ('a, 'b) A.Pre_diff_two.V2.t
11	and type Pre_diff_with_at_most_two_coinbase.Stable.V2.t =
12	A.Pre_diff_with_at_most_two_coinbase.V2.t
13	and type 'a At_most_one.t = 'a A.At_most_one.V1.t
14	and type ('a, 'b) Pre_diff_one.Stable.V2.t = ('a, 'b) A.Pre_diff_one.V2.t
15	and type Pre_diff_with_at_most_one_coinbase.Stable.V2.t =
16	A.Pre_diff_with_at_most_one_coinbase.V2.t
17	and type t = A.V2.t
18	and type Stable.V2.t = A.V2.t
19	end
20
21	module Make_str (A : Wire_types.Concrete) = struct
22	module At_most_two = struct
23	[%%versioned
24	module Stable = struct
25	[@@@no_toplevel_latest_type]
26
27	module V1 = struct
28	type 'a t = 'a A.At_most_two.V1.t =	23✔
29	\| Zero	520✔
30	\| One of 'a option	×
31	\| Two of ('a * 'a option) option	×
32	[@@deriving equal, compare, sexp, yojson]	60✔
33	end
34	end]
35
36	type 'a t = 'a Stable.Latest.t =	1,600✔
37	\| Zero	×
38	\| One of 'a option	×
39	\| Two of ('a * 'a option) option	×
40	[@@deriving equal, compare, sexp, yojson]	×
41
42	let increase t ws =
43	match (t, ws) with	×
44	\| Zero, [] ->	×
45	Ok (One None)
46	\| Zero, [ a ] ->	×
47	Ok (One (Some a))
48	\| One _, [] ->	×
49	Ok (Two None)
50	\| One _, [ a ] ->	×
51	Ok (Two (Some (a, None)))
52	\| One _, [ a; a' ] ->	×
53	Ok (Two (Some (a', Some a)))
54	\| _ ->	×
55	Or_error.error_string "Error incrementing coinbase parts"
56	end
57
58	module At_most_one = struct
59	[%%versioned
60	module Stable = struct
61	[@@@no_toplevel_latest_type]
62
63	module V1 = struct
64	type 'a t = 'a A.At_most_one.V1.t = Zero \| One of 'a option	×
65	[@@deriving equal, compare, sexp, yojson]	60✔
66	end
67	end]
68
69	type 'a t = 'a Stable.Latest.t = Zero \| One of 'a option	×
70	[@@deriving equal, compare, sexp, yojson]
71
72	let increase t ws =
73	match (t, ws) with	×
74	\| Zero, [] ->	×
75	Ok (One None)
76	\| Zero, [ a ] ->	×
77	Ok (One (Some a))
78	\| _ ->	×
79	Or_error.error_string "Error incrementing coinbase parts"
80	end
81
82	module Ft = struct
83	[%%versioned
84	module Stable = struct
85	[@@@no_toplevel_latest_type]
86
87	module V1 = struct
88	type t = Coinbase.Fee_transfer.Stable.V1.t	×
89	[@@deriving equal, compare, sexp, yojson]	100✔
90
91	let to_latest = Fn.id
92	end
93	end]
94
95	type t = Stable.Latest.t [@@deriving equal, compare, sexp, yojson]	×
96	end
97
98	module Pre_diff_two = struct
99	[%%versioned
100	module Stable = struct
101	[@@@no_toplevel_latest_type]
102
103	module V2 = struct
104	type ('a, 'b) t = ('a, 'b) A.Pre_diff_two.V2.t =	100✔
105	{ completed_works : 'a list	×
106	; commands : 'b list	×
107	; coinbase : Ft.Stable.V1.t At_most_two.Stable.V1.t	×
108	; internal_command_statuses : Transaction_status.Stable.V2.t list	×
109	}
110	[@@deriving equal, compare, sexp, yojson]	60✔
111	end
112	end]
113
114	type ('a, 'b) t = ('a, 'b) Stable.Latest.t =	×
115	{ completed_works : 'a list	×
116	; commands : 'b list	×
117	; coinbase : Ft.t At_most_two.t	×
118	; internal_command_statuses : Transaction_status.t list	×
119	}
120	[@@deriving equal, compare, sexp, yojson]	×
121
122	let map t ~f1 ~f2 =
123	{ completed_works = List.map t.completed_works ~f:f1	×
124	; commands = List.map t.commands ~f:f2	×
125	; coinbase = t.coinbase
126	; internal_command_statuses = t.internal_command_statuses
127	}
128	end
129
130	module Pre_diff_one = struct
131	[%%versioned
132	module Stable = struct
133	[@@@no_toplevel_latest_type]
134
135	module V2 = struct
136	type ('a, 'b) t = ('a, 'b) A.Pre_diff_one.V2.t =	20✔
137	{ completed_works : 'a list	×
138	; commands : 'b list	×
139	; coinbase : Ft.Stable.V1.t At_most_one.Stable.V1.t	×
140	; internal_command_statuses : Transaction_status.Stable.V2.t list	×
141	}
142	[@@deriving equal, compare, sexp, yojson]	60✔
143	end
144	end]
145
146	type ('a, 'b) t = ('a, 'b) Stable.Latest.t =	×
147	{ completed_works : 'a list	×
148	; commands : 'b list	×
149	; coinbase : Ft.t At_most_one.t	×
150	; internal_command_statuses : Transaction_status.t list	×
151	}
152	[@@deriving equal, compare, sexp, yojson]	×
153
154	let map t ~f1 ~f2 =
155	{ completed_works = List.map t.completed_works ~f:f1	×
156	; commands = List.map t.commands ~f:f2	×
157	; coinbase = t.coinbase
158	; internal_command_statuses = t.internal_command_statuses
159	}
160	end
161
162	module Pre_diff_with_at_most_two_coinbase = struct
163	[%%versioned
164	module Stable = struct
165	[@@@no_toplevel_latest_type]
166
167	module V2 = struct
168	type t =	20✔
169	( Transaction_snark_work.Stable.V2.t	×
170	, User_command.Stable.V2.t With_status.Stable.V2.t )	×
171	Pre_diff_two.Stable.V2.t	×
172	[@@deriving equal, sexp, yojson]	100✔
173
174	let to_latest = Fn.id
175	end
176	end]
177
178	type t = Stable.Latest.t
179	end
180
181	module Pre_diff_with_at_most_one_coinbase = struct
182	[%%versioned
183	module Stable = struct
184	[@@@no_toplevel_latest_type]
185
186	module V2 = struct
187	type t =	20✔
188	( Transaction_snark_work.Stable.V2.t	×
189	, User_command.Stable.V2.t With_status.Stable.V2.t )	×
190	Pre_diff_one.Stable.V2.t	×
191	[@@deriving equal, sexp, yojson]	100✔
192
193	let to_latest = Fn.id
194	end
195	end]
196
197	type t = Stable.Latest.t
198	end
199
200	module Diff = struct
201	[%%versioned
202	module Stable = struct
203	[@@@no_toplevel_latest_type]
204
205	module V2 = struct
206	type t =	20✔
207	Pre_diff_with_at_most_two_coinbase.Stable.V2.t	×
208	* Pre_diff_with_at_most_one_coinbase.Stable.V2.t option	×
209	[@@deriving equal, sexp, yojson]	100✔
210
211	let to_latest = Fn.id
212	end
213	end]
214
215	type t = Stable.Latest.t
216	end
217
218	[%%versioned
219	module Stable = struct
220	[@@@no_toplevel_latest_type]
221
222	module V2 = struct
223	type t = A.V2.t = { diff : Diff.Stable.V2.t }	×
224	[@@deriving equal, sexp, yojson]	100✔
225
226	let to_latest = Fn.id
227	end
228	end]
229
230	type t = Stable.Latest.t = { diff : Diff.t } [@@deriving fields]	×
231
232	module With_valid_signatures_and_proofs = struct
233	type pre_diff_with_at_most_two_coinbase =
234	( Transaction_snark_work.Checked.t
235	, User_command.Valid.t With_status.t )
236	Pre_diff_two.t
237
238	type pre_diff_with_at_most_one_coinbase =
239	( Transaction_snark_work.Checked.t
240	, User_command.Valid.t With_status.t )
241	Pre_diff_one.t
242
243	type diff =
244	pre_diff_with_at_most_two_coinbase
245	* pre_diff_with_at_most_one_coinbase option
246
247	type t = { diff : diff }
248
249	let empty_diff : t =
250	{ diff =
251	( { completed_works = []
252	; commands = []
253	; coinbase = At_most_two.Zero
254	; internal_command_statuses = []
255	}
256	, None )
257	}
258
259	let commands t =
260	(fst t.diff).commands	×
261	@ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.commands)	×
262	end
263
264	let forget_cw cw_list = List.map ~f:Transaction_snark_work.forget cw_list	400✔
265
266	let coinbase_amount
267	~(constraint_constants : Genesis_constants.Constraint_constants.t)
268	~supercharge_coinbase =
269	if supercharge_coinbase then	781✔
270	Currency.Amount.scale constraint_constants.coinbase_amount	393✔
271	constraint_constants.supercharged_coinbase_factor
272	else Some constraint_constants.coinbase_amount	388✔
273
274	let coinbase
275	~(constraint_constants : Genesis_constants.Constraint_constants.t)
276	~supercharge_coinbase t =
277	let first_pre_diff, second_pre_diff_opt = t.diff in	381✔
278	let coinbase_amount =
279	coinbase_amount ~constraint_constants ~supercharge_coinbase
280	in
281	match
282	( first_pre_diff.coinbase
283	, Option.value_map second_pre_diff_opt ~default:At_most_one.Zero	381✔
284	~f:(fun d -> d.coinbase) )	×
285	with
286	\| At_most_two.Zero, At_most_one.Zero ->	221✔
287	Some Currency.Amount.zero
288	\| _ ->	160✔
289	coinbase_amount
290
291	module With_valid_signatures = struct
292	type pre_diff_with_at_most_two_coinbase =
293	( Transaction_snark_work.t
294	, User_command.Valid.t With_status.t )
295	Pre_diff_two.t
296
297	type pre_diff_with_at_most_one_coinbase =
298	( Transaction_snark_work.t
299	, User_command.Valid.t With_status.t )
300	Pre_diff_one.t
301
302	type diff =
303	pre_diff_with_at_most_two_coinbase
304	* pre_diff_with_at_most_one_coinbase option
305
306	type t = { diff : diff }
307
308	let coinbase
309	~(constraint_constants : Genesis_constants.Constraint_constants.t)
310	~supercharge_coinbase (t : t) =
311	let first_pre_diff, second_pre_diff_opt = t.diff in	400✔
312	let coinbase_amount =
313	coinbase_amount ~constraint_constants ~supercharge_coinbase
314	in
315	match
316	( first_pre_diff.coinbase
317	, Option.value_map second_pre_diff_opt ~default:At_most_one.Zero	400✔
318	~f:(fun d -> d.coinbase) )	×
319	with
320	\| At_most_two.Zero, At_most_one.Zero ->	240✔
321	Some Currency.Amount.zero
322	\| _ ->	160✔
323	coinbase_amount
324	end
325
326	let validate_commands (t : t)
327	~(check :
328	User_command.t With_status.t list
329	-> (User_command.Valid.t list, 'e) Result.t Async.Deferred.Or_error.t
330	) : (With_valid_signatures.t, 'e) Result.t Async.Deferred.Or_error.t =
331	let map t ~f = Async.Deferred.Or_error.map t ~f:(Result.map ~f) in	200✔
332	let validate cs =
333	map (check cs)	200✔
334	~f:
335	(List.map2_exn cs ~f:(fun c data ->	200✔
336	{ With_status.data; status = c.status } ) )	480✔
337	in
338	let d1, d2 = t.diff in
339	map
340	(validate	200✔
341	( d1.commands
342	@ Option.value_map d2 ~default:[] ~f:(fun d2 -> d2.commands) ) )	×
343	~f:(fun commands_all ->
344	let commands1, commands2 =	200✔
345	List.split_n commands_all (List.length d1.commands)	200✔
346	in
347	let p1 : With_valid_signatures.pre_diff_with_at_most_two_coinbase =	200✔
348	{ completed_works = d1.completed_works
349	; commands = commands1
350	; coinbase = d1.coinbase
351	; internal_command_statuses = d1.internal_command_statuses
352	}
353	in
354	let p2 =
355	Option.value_map ~default:None d2 ~f:(fun d2 ->
356	Some	×
357	{ Pre_diff_one.completed_works = d2.completed_works
358	; commands = commands2
359	; coinbase = d2.coinbase
360	; internal_command_statuses = d2.internal_command_statuses
361	} )
362	in
363	({ diff = (p1, p2) } : With_valid_signatures.t) )	200✔
364
365	let forget_proof_checks (d : With_valid_signatures_and_proofs.t) :
366	With_valid_signatures.t =
367	let d1 = fst d.diff in	200✔
368	let p1 : With_valid_signatures.pre_diff_with_at_most_two_coinbase =	200✔
369	{ completed_works = forget_cw d1.completed_works	200✔
370	; commands = d1.commands
371	; coinbase = d1.coinbase
372	; internal_command_statuses = d1.internal_command_statuses
373	}
374	in
375	let p2 =
376	Option.map (snd d.diff)	200✔
377	~f:(fun d2 : With_valid_signatures.pre_diff_with_at_most_one_coinbase ->
378	{ completed_works = forget_cw d2.completed_works	×
379	; commands = d2.commands
380	; coinbase = d2.coinbase
381	; internal_command_statuses = d2.internal_command_statuses
382	} )
383	in
384	{ diff = (p1, p2) }	200✔
385
386	let forget_pre_diff_with_at_most_two
387	(pre_diff :
388	With_valid_signatures_and_proofs.pre_diff_with_at_most_two_coinbase ) :
389	Pre_diff_with_at_most_two_coinbase.t =
390	{ completed_works = forget_cw pre_diff.completed_works	200✔
391	; commands =
392	List.map	200✔
393	~f:(With_status.map ~f:User_command.forget_check)
394	pre_diff.commands
395	; coinbase = pre_diff.coinbase
396	; internal_command_statuses = pre_diff.internal_command_statuses
397	}
398
399	let forget_pre_diff_with_at_most_one
400	(pre_diff :
401	With_valid_signatures_and_proofs.pre_diff_with_at_most_one_coinbase ) =
402	{ Pre_diff_one.completed_works = forget_cw pre_diff.completed_works	×
403	; commands =
404	List.map	×
405	~f:(With_status.map ~f:User_command.forget_check)
406	pre_diff.commands
407	; coinbase = pre_diff.coinbase
408	; internal_command_statuses = pre_diff.internal_command_statuses
409	}
410
411	let forget (t : With_valid_signatures_and_proofs.t) =
412	{ diff =	200✔
413	( forget_pre_diff_with_at_most_two (fst t.diff)	200✔
414	, Option.map (snd t.diff) ~f:forget_pre_diff_with_at_most_one )	200✔
415	}
416
417	let commands (t : t) =
418	(fst t.diff).commands	400✔
419	@ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.commands)	×
420
421	let completed_works (t : t) =
422	(fst t.diff).completed_works	400✔
423	@ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.completed_works)	×
424
425	let net_return
426	~(constraint_constants : Genesis_constants.Constraint_constants.t)
427	~supercharge_coinbase (t : t) =
428	let open Currency in	×
429	let open Option.Let_syntax in
430	let%bind coinbase =
431	coinbase ~constraint_constants ~supercharge_coinbase t	×
432	in
433	let%bind total_reward =
434	List.fold	×
435	~init:(Some (Amount.to_fee coinbase))	×
436	(commands t)	×
437	~f:(fun sum cmd ->
438	let%bind sum = sum in
439	Fee.( + ) sum (User_command.fee (With_status.data cmd)) )	×
440	in
441	let%bind completed_works_fees =
442	List.fold ~init:(Some Fee.zero) (completed_works t) ~f:(fun sum work ->	×
443	let%bind sum = sum in
444	Fee.(sum + Transaction_snark_work.fee work) )	×
445	in
446	Amount.(of_fee total_reward - of_fee completed_works_fees)	×
447
448	let empty_diff : t =
449	{ diff =
450	( { completed_works = []
451	; commands = []
452	; coinbase = At_most_two.Zero
453	; internal_command_statuses = []
454	}
455	, None )
456	}
457
458	let is_empty = function
459	\| { diff =	×
460	( { completed_works = []
461	; commands = []
462	; coinbase = At_most_two.Zero
463	; internal_command_statuses = []
464	}
465	, None )
466	} ->
467	true
468	\| _ ->	×
469	false
470	end
471
472	include Wire_types.Make (Make_sig) (Make_str)	40✔

MinaProtocol / mina / 3424

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

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