3576

Committed 04 Apr 2025 06:20PM UTC coverage: 62.266% (-0.008%) from 62.274%

Build # 3576

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #16558 from MinaProtocol/georgeee/small-refactroing-tx-pool

Small refactroing of `transaction_pool.ml`

Run Details

30 of 33 new or added lines in 1 file covered. (90.91%)

147 existing lines in 10 files now uncovered.

49177 of 78979 relevant lines covered (62.27%)

483805.17 hits per line

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

51.94

/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
    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 (first_pre_diff, second_pre_diff_opt) =
      let coinbase_amount =
        coinbase_amount ~constraint_constants ~supercharge_coinbase
      in
      match
        ( first_pre_diff.Pre_diff_two.coinbase
        , Option.value_map second_pre_diff_opt ~default:At_most_one.Zero
            ~f:(fun d -> d.Pre_diff_one.coinbase) )
      with
      | At_most_two.Zero, At_most_one.Zero ->
          Some Currency.Amount.zero
      | _ ->
          coinbase_amount

    [%%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

        let coinbase = coinbase
      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

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

MinaProtocol / mina / 3576

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