2837

Committed 30 Oct 2024 07:56AM UTC coverage: 38.267% (-22.8%) from 61.098%

Build # 2837

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #16306 from MinaProtocol/dkijania/fix_promotion_to_gcr

Fix promotion job PUBLISH misuse

Run Details

7417 of 19382 relevant lines covered (38.27%)

298565.44 hits per line

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

32.91

/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, compare, sexp, yojson]

        let to_latest = Fn.id
      end
    end]

    type t = Stable.Latest.t [@@deriving equal, compare, sexp, yojson]
  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, compare, sexp, yojson]

        let to_latest = Fn.id
      end
    end]

    type t = Stable.Latest.t [@@deriving equal, compare, sexp, yojson]
  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, compare, sexp, yojson]

        let to_latest = Fn.id
      end
    end]

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

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

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

      let to_latest = Fn.id
    end
  end]

  type t = Stable.Latest.t = { diff : Diff.t }
  [@@deriving equal, compare, sexp, yojson, 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
    [@@deriving compare, sexp, to_yojson]

    type pre_diff_with_at_most_one_coinbase =
      ( Transaction_snark_work.Checked.t
      , User_command.Valid.t With_status.t )
      Pre_diff_one.t
    [@@deriving compare, sexp, to_yojson]

    type diff =
      pre_diff_with_at_most_two_coinbase
      * pre_diff_with_at_most_one_coinbase option
    [@@deriving compare, sexp, to_yojson]

    type t = { diff : diff } [@@deriving compare, sexp, to_yojson]

    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
    [@@deriving compare, sexp, to_yojson]

    type pre_diff_with_at_most_one_coinbase =
      ( Transaction_snark_work.t
      , User_command.Valid.t With_status.t )
      Pre_diff_one.t
    [@@deriving compare, sexp, to_yojson]

    type diff =
      pre_diff_with_at_most_two_coinbase
      * pre_diff_with_at_most_one_coinbase option
    [@@deriving compare, sexp, to_yojson]

    type t = { diff : diff } [@@deriving compare, sexp, to_yojson]

    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 work.Transaction_snark_work.fee )
    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 )
    }
end

include Wire_types.Make (Make_sig) (Make_str)

1	open Core_kernel	5✔
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 =	8✔
29	\| Zero	490✔
30	\| One of 'a option	×
31	\| Two of ('a * 'a option) option	×
32	[@@deriving equal, compare, sexp, yojson]	15✔
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]	15✔
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]	25✔
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 =	25✔
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]	15✔
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 =	5✔
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]	15✔
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 =	5✔
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, compare, sexp, yojson]	25✔
173
174	let to_latest = Fn.id
175	end
176	end]
177
178	type t = Stable.Latest.t [@@deriving equal, compare, sexp, yojson]	×
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 =	5✔
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, compare, sexp, yojson]	25✔
192
193	let to_latest = Fn.id
194	end
195	end]
196
197	type t = Stable.Latest.t [@@deriving equal, compare, sexp, yojson]	×
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 =	5✔
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, compare, sexp, yojson]	25✔
210
211	let to_latest = Fn.id
212	end
213	end]
214
215	type t = Stable.Latest.t [@@deriving equal, compare, sexp, yojson]	×
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, compare, sexp, yojson]	25✔
225
226	let to_latest = Fn.id
227	end
228	end]
229
230	type t = Stable.Latest.t = { diff : Diff.t }	×
231	[@@deriving equal, compare, sexp, yojson, fields]
232
233	module With_valid_signatures_and_proofs = struct
234	type pre_diff_with_at_most_two_coinbase =	×
235	( Transaction_snark_work.Checked.t	×
236	, User_command.Valid.t With_status.t )	×
237	Pre_diff_two.t	×
238	[@@deriving compare, sexp, to_yojson]	×
239
240	type pre_diff_with_at_most_one_coinbase =	×
241	( Transaction_snark_work.Checked.t	×
242	, User_command.Valid.t With_status.t )	×
243	Pre_diff_one.t	×
244	[@@deriving compare, sexp, to_yojson]	×
245
246	type diff =	×
247	pre_diff_with_at_most_two_coinbase	×
248	* pre_diff_with_at_most_one_coinbase option	×
249	[@@deriving compare, sexp, to_yojson]
250
251	type t = { diff : diff } [@@deriving compare, sexp, to_yojson]	×
252
253	let empty_diff : t =
254	{ diff =
255	( { completed_works = []
256	; commands = []
257	; coinbase = At_most_two.Zero
258	; internal_command_statuses = []
259	}
260	, None )
261	}
262
263	let commands t =
264	(fst t.diff).commands	×
265	@ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.commands)	×
266	end
267
268	let forget_cw cw_list = List.map ~f:Transaction_snark_work.forget cw_list	400✔
269
270	let coinbase_amount
271	~(constraint_constants : Genesis_constants.Constraint_constants.t)
272	~supercharge_coinbase =
273	if supercharge_coinbase then	781✔
274	Currency.Amount.scale constraint_constants.coinbase_amount	393✔
275	constraint_constants.supercharged_coinbase_factor
276	else Some constraint_constants.coinbase_amount	388✔
277
278	let coinbase
279	~(constraint_constants : Genesis_constants.Constraint_constants.t)
280	~supercharge_coinbase t =
281	let first_pre_diff, second_pre_diff_opt = t.diff in	381✔
282	let coinbase_amount =
283	coinbase_amount ~constraint_constants ~supercharge_coinbase
284	in
285	match
286	( first_pre_diff.coinbase
287	, Option.value_map second_pre_diff_opt ~default:At_most_one.Zero	381✔
288	~f:(fun d -> d.coinbase) )	×
289	with
290	\| At_most_two.Zero, At_most_one.Zero ->	221✔
291	Some Currency.Amount.zero
292	\| _ ->	160✔
293	coinbase_amount
294
295	module With_valid_signatures = struct
296	type pre_diff_with_at_most_two_coinbase =	×
297	( Transaction_snark_work.t	×
298	, User_command.Valid.t With_status.t )	×
299	Pre_diff_two.t	×
300	[@@deriving compare, sexp, to_yojson]	×
301
302	type pre_diff_with_at_most_one_coinbase =	×
303	( Transaction_snark_work.t	×
304	, User_command.Valid.t With_status.t )	×
305	Pre_diff_one.t	×
306	[@@deriving compare, sexp, to_yojson]	×
307
308	type diff =	×
309	pre_diff_with_at_most_two_coinbase	×
310	* pre_diff_with_at_most_one_coinbase option	×
311	[@@deriving compare, sexp, to_yojson]
312
313	type t = { diff : diff } [@@deriving compare, sexp, to_yojson]	×
314
315	let coinbase
316	~(constraint_constants : Genesis_constants.Constraint_constants.t)
317	~supercharge_coinbase (t : t) =
318	let first_pre_diff, second_pre_diff_opt = t.diff in	400✔
319	let coinbase_amount =
320	coinbase_amount ~constraint_constants ~supercharge_coinbase
321	in
322	match
323	( first_pre_diff.coinbase
324	, Option.value_map second_pre_diff_opt ~default:At_most_one.Zero	400✔
325	~f:(fun d -> d.coinbase) )	×
326	with
327	\| At_most_two.Zero, At_most_one.Zero ->	240✔
328	Some Currency.Amount.zero
329	\| _ ->	160✔
330	coinbase_amount
331	end
332
333	let validate_commands (t : t)
334	~(check :
335	User_command.t With_status.t list
336	-> (User_command.Valid.t list, 'e) Result.t Async.Deferred.Or_error.t
337	) : (With_valid_signatures.t, 'e) Result.t Async.Deferred.Or_error.t =
338	let map t ~f = Async.Deferred.Or_error.map t ~f:(Result.map ~f) in	200✔
339	let validate cs =
340	map (check cs)	200✔
341	~f:
342	(List.map2_exn cs ~f:(fun c data ->	200✔
343	{ With_status.data; status = c.status } ) )	480✔
344	in
345	let d1, d2 = t.diff in
346	map
347	(validate	200✔
348	( d1.commands
349	@ Option.value_map d2 ~default:[] ~f:(fun d2 -> d2.commands) ) )	×
350	~f:(fun commands_all ->
351	let commands1, commands2 =	200✔
352	List.split_n commands_all (List.length d1.commands)	200✔
353	in
354	let p1 : With_valid_signatures.pre_diff_with_at_most_two_coinbase =	200✔
355	{ completed_works = d1.completed_works
356	; commands = commands1
357	; coinbase = d1.coinbase
358	; internal_command_statuses = d1.internal_command_statuses
359	}
360	in
361	let p2 =
362	Option.value_map ~default:None d2 ~f:(fun d2 ->
363	Some	×
364	{ Pre_diff_one.completed_works = d2.completed_works
365	; commands = commands2
366	; coinbase = d2.coinbase
367	; internal_command_statuses = d2.internal_command_statuses
368	} )
369	in
370	({ diff = (p1, p2) } : With_valid_signatures.t) )	200✔
371
372	let forget_proof_checks (d : With_valid_signatures_and_proofs.t) :
373	With_valid_signatures.t =
374	let d1 = fst d.diff in	200✔
375	let p1 : With_valid_signatures.pre_diff_with_at_most_two_coinbase =	200✔
376	{ completed_works = forget_cw d1.completed_works	200✔
377	; commands = d1.commands
378	; coinbase = d1.coinbase
379	; internal_command_statuses = d1.internal_command_statuses
380	}
381	in
382	let p2 =
383	Option.map (snd d.diff)	200✔
384	~f:(fun d2 : With_valid_signatures.pre_diff_with_at_most_one_coinbase ->
385	{ completed_works = forget_cw d2.completed_works	×
386	; commands = d2.commands
387	; coinbase = d2.coinbase
388	; internal_command_statuses = d2.internal_command_statuses
389	} )
390	in
391	{ diff = (p1, p2) }	200✔
392
393	let forget_pre_diff_with_at_most_two
394	(pre_diff :
395	With_valid_signatures_and_proofs.pre_diff_with_at_most_two_coinbase ) :
396	Pre_diff_with_at_most_two_coinbase.t =
397	{ completed_works = forget_cw pre_diff.completed_works	200✔
398	; commands =
399	List.map	200✔
400	~f:(With_status.map ~f:User_command.forget_check)
401	pre_diff.commands
402	; coinbase = pre_diff.coinbase
403	; internal_command_statuses = pre_diff.internal_command_statuses
404	}
405
406	let forget_pre_diff_with_at_most_one
407	(pre_diff :
408	With_valid_signatures_and_proofs.pre_diff_with_at_most_one_coinbase ) =
409	{ Pre_diff_one.completed_works = forget_cw pre_diff.completed_works	×
410	; commands =
411	List.map	×
412	~f:(With_status.map ~f:User_command.forget_check)
413	pre_diff.commands
414	; coinbase = pre_diff.coinbase
415	; internal_command_statuses = pre_diff.internal_command_statuses
416	}
417
418	let forget (t : With_valid_signatures_and_proofs.t) =
419	{ diff =	200✔
420	( forget_pre_diff_with_at_most_two (fst t.diff)	200✔
421	, Option.map (snd t.diff) ~f:forget_pre_diff_with_at_most_one )	200✔
422	}
423
424	let commands (t : t) =
425	(fst t.diff).commands	400✔
426	@ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.commands)	×
427
428	let completed_works (t : t) =
429	(fst t.diff).completed_works	400✔
430	@ Option.value_map (snd t.diff) ~default:[] ~f:(fun d -> d.completed_works)	×
431
432	let net_return
433	~(constraint_constants : Genesis_constants.Constraint_constants.t)
434	~supercharge_coinbase (t : t) =
435	let open Currency in	×
436	let open Option.Let_syntax in
437	let%bind coinbase =
438	coinbase ~constraint_constants ~supercharge_coinbase t	×
439	in
440	let%bind total_reward =
441	List.fold	×
442	~init:(Some (Amount.to_fee coinbase))	×
443	(commands t)	×
444	~f:(fun sum cmd ->
445	let%bind sum = sum in
446	Fee.( + ) sum (User_command.fee (With_status.data cmd)) )	×
447	in
448	let%bind completed_works_fees =
449	List.fold ~init:(Some Fee.zero) (completed_works t) ~f:(fun sum work ->	×
450	let%bind sum = sum in
451	Fee.( + ) sum work.Transaction_snark_work.fee )	×
452	in
453	Amount.(of_fee total_reward - of_fee completed_works_fees)	×
454
455	let empty_diff : t =
456	{ diff =
457	( { completed_works = []
458	; commands = []
459	; coinbase = At_most_two.Zero
460	; internal_command_statuses = []
461	}
462	, None )
463	}
464	end
465
466	include Wire_types.Make (Make_sig) (Make_str)	10✔

MinaProtocol / mina / 2837

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