2863

Committed 05 Nov 2024 06:20PM UTC coverage: 30.754% (-16.6%) from 47.311%

Build # 2863

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #16296 from MinaProtocol/dkijania/more_multi_jobs

more multi jobs in CI

Run Details

20276 of 65930 relevant lines covered (30.75%)

8631.7 hits per line

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

45.88

/src/lib/staged_ledger/diff_creation_log.ml

open Core_kernel
open Mina_base

type count_and_fee = int * Currency.Fee.t [@@deriving sexp, to_yojson]

module Fee_Summable = struct
  open Currency

  type t = Fee.t

  let zero = Fee.zero

  let ( + ) (x : Fee.t) (x' : Fee.t) = Fee.add x x' |> Option.value_exn
end

module Summary = struct
  type resources =
    { completed_work : count_and_fee
    ; commands : count_and_fee
    ; coinbase_work_fees : Currency.Fee.t Staged_ledger_diff.At_most_two.t
    }
  [@@deriving sexp, to_yojson, lens]

  type command_constraints =
    { insufficient_work : int; insufficient_space : int }
  [@@deriving sexp, to_yojson, lens]

  type completed_work_constraints =
    { insufficient_fees : int; extra_work : int }
  [@@deriving sexp, to_yojson, lens]

  type t =
    { partition : [ `First | `Second ]
    ; start_resources : resources
    ; available_slots : int
    ; required_work_count : int
    ; discarded_commands : command_constraints
    ; discarded_completed_work : completed_work_constraints
    ; end_resources : resources
    }
  [@@deriving sexp, to_yojson, lens]

  let coinbase_fees
      (coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) =
    match coinbase with
    | One (Some x) ->
        Staged_ledger_diff.At_most_two.One (Some x.fee)
    | Two (Some (x, None)) ->
        Two (Some (x.fee, None))
    | Two (Some (x, Some x')) ->
        Two (Some (x.fee, Some x'.fee))
    | Zero ->
        Zero
    | One None ->
        One None
    | Two None ->
        Two None

  let init_resources
      ~(completed_work : Transaction_snark_work.Checked.t Sequence.t)
      ~(commands : User_command.Valid.t Sequence.t)
      ~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) =
    let completed_work =
      ( Sequence.length completed_work
      , Sequence.sum
          (module Fee_Summable)
          completed_work ~f:Transaction_snark_work.fee )
    in
    let commands =
      ( Sequence.length commands
      , Sequence.sum
          (module Fee_Summable)
          commands
          ~f:(fun cmd -> User_command.fee (User_command.forget_check cmd)) )
    in
    let coinbase_work_fees = coinbase_fees coinbase in
    { completed_work; commands; coinbase_work_fees }

  let init ~(completed_work : Transaction_snark_work.Checked.t Sequence.t)
      ~(commands : User_command.Valid.t Sequence.t)
      ~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t)
      ~partition ~available_slots ~required_work_count =
    let start_resources = init_resources ~completed_work ~commands ~coinbase in
    let discarded_commands =
      { insufficient_work = 0; insufficient_space = 0 }
    in
    let discarded_completed_work = { insufficient_fees = 0; extra_work = 0 } in
    let end_resources =
      { completed_work = (0, Currency.Fee.zero)
      ; commands = (0, Currency.Fee.zero)
      ; coinbase_work_fees = Staged_ledger_diff.At_most_two.Zero
      }
    in
    { partition
    ; available_slots
    ; required_work_count
    ; start_resources
    ; discarded_completed_work
    ; discarded_commands
    ; end_resources
    }

  let end_log t ~(completed_work : Transaction_snark_work.Checked.t Sequence.t)
      ~(commands : User_command.Valid.t Sequence.t)
      ~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) =
    end_resources.set (init_resources ~completed_work ~commands ~coinbase) t

  let incr (top : ('a, 'b) Lens.t) (nested : ('b, int) Lens.t) (t : 'a) =
    let nested_field = top.get t in
    top.set (nested.set (nested.get nested_field + 1) nested_field) t

  let discard_command (why : [> `No_work | `No_space ]) t =
    match why with
    | `No_work ->
        incr discarded_commands command_constraints_insufficient_work t
    | `No_space ->
        incr discarded_commands command_constraints_insufficient_space t
    | _ ->
        t

  let discard_completed_work (why : [> `Insufficient_fees | `Extra_work ]) t =
    match why with
    | `Insufficient_fees ->
        incr discarded_completed_work
          completed_work_constraints_insufficient_fees t
    | `Extra_work ->
        incr discarded_completed_work completed_work_constraints_extra_work t
    | _ ->
        t
end

module Detail = struct
  type line =
    { reason :
        [ `No_space
        | `No_work
        | `Insufficient_fees
        | `Extra_work
        | `Init
        | `End ]
    ; commands : count_and_fee
    ; completed_work : count_and_fee
    ; coinbase : Currency.Fee.t Staged_ledger_diff.At_most_two.t
    }
  [@@deriving sexp, to_yojson, lens]

  type t = line list [@@deriving sexp, to_yojson]

  let init ~(completed_work : Transaction_snark_work.Checked.t Sequence.t)
      ~(commands : User_command.Valid.t Sequence.t)
      ~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) =
    let init = Summary.init_resources ~completed_work ~commands ~coinbase in
    [ { reason = `Init
      ; commands = init.commands
      ; completed_work = init.completed_work
      ; coinbase = init.coinbase_work_fees
      }
    ]

  let discard_command (why : [> `No_work | `No_space ]) command = function
    | [] ->
        failwith "Log not initialized"
    | x :: xs ->
        let new_line =
          { x with
            reason = why
          ; commands =
              ( fst x.commands - 1
              , Currency.Fee.sub (snd x.commands) (User_command.fee command)
                |> Option.value_exn )
          }
        in
        new_line :: x :: xs

  let discard_completed_work (why : [> `Insufficient_fees | `Extra_work ])
      completed_work = function
    | [] ->
        failwith "Log not initialized"
    | x :: xs ->
        let new_line =
          { x with
            reason = why
          ; completed_work =
              ( fst x.completed_work - 1
              , Currency.Fee.sub (snd x.completed_work)
                  (Transaction_snark_work.fee completed_work)
                |> Option.value_exn )
          }
        in
        new_line :: x :: xs

  let end_log coinbase = function
    | [] ->
        failwith "Log not initialized"
    | x :: xs ->
        (*Because coinbase could be updated ooutside of the check_constraints_and_update function*)
        { x with reason = `End; coinbase = Summary.coinbase_fees coinbase }
        :: x :: xs
end

type t = Summary.t * Detail.t [@@deriving sexp, to_yojson]

type log_list = t list [@@deriving sexp, to_yojson]

type summary_list = Summary.t list [@@deriving sexp, to_yojson]

type detail_list = Detail.t list [@@deriving sexp, to_yojson]

let init ~(completed_work : Transaction_snark_work.Checked.t Sequence.t)
    ~(commands : User_command.Valid.t Sequence.t)
    ~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t)
    ~partition ~available_slots ~required_work_count =
  let summary =
    Summary.init ~completed_work ~commands ~coinbase ~partition ~available_slots
      ~required_work_count
  in
  let detailed = Detail.init ~completed_work ~commands ~coinbase in
  (summary, detailed)

let discard_command why command t =
  let detailed = Detail.discard_command why command (snd t) in
  let summary = Summary.discard_command why (fst t) in
  (summary, detailed)

let discard_completed_work why completed_work t =
  let detailed = Detail.discard_completed_work why completed_work (snd t) in
  let summary = Summary.discard_completed_work why (fst t) in
  (summary, detailed)

let end_log ~(completed_work : Transaction_snark_work.Checked.t Sequence.t)
    ~(commands : User_command.Valid.t Sequence.t)
    ~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) t =
  let summary = Summary.end_log (fst t) ~completed_work ~commands ~coinbase in
  let detailed = Detail.end_log coinbase (snd t) in
  (summary, detailed)

1	open Core_kernel	3✔
2	open Mina_base
3
4	type count_and_fee = int * Currency.Fee.t [@@deriving sexp, to_yojson]	×
5
6	module Fee_Summable = struct
7	open Currency
8
9	type t = Fee.t
10
11	let zero = Fee.zero
12
13	let ( + ) (x : Fee.t) (x' : Fee.t) = Fee.add x x' \|> Option.value_exn	7,520✔
14	end
15
16	module Summary = struct
17	type resources =	800✔
18	{ completed_work : count_and_fee	×
19	; commands : count_and_fee	×
20	; coinbase_work_fees : Currency.Fee.t Staged_ledger_diff.At_most_two.t	×
21	}
22	[@@deriving sexp, to_yojson, lens]	800✔
23
24	type command_constraints =	6,480✔
25	{ insufficient_work : int; insufficient_space : int }	×
26	[@@deriving sexp, to_yojson, lens]
27
28	type completed_work_constraints =	400✔
29	{ insufficient_fees : int; extra_work : int }	×
30	[@@deriving sexp, to_yojson, lens]
31
32	type t =	7,080✔
33	{ partition : [ `First \| `Second ]	×
34	; start_resources : resources	×
35	; available_slots : int	×
36	; required_work_count : int	×
37	; discarded_commands : command_constraints	×
38	; discarded_completed_work : completed_work_constraints	×
39	; end_resources : resources	×
40	}
41	[@@deriving sexp, to_yojson, lens]	400✔
42
43	let coinbase_fees
44	(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) =
45	match coinbase with	1,280✔
46	\| One (Some x) ->	×
47	Staged_ledger_diff.At_most_two.One (Some x.fee)
48	\| Two (Some (x, None)) ->	×
49	Two (Some (x.fee, None))
50	\| Two (Some (x, Some x')) ->	×
51	Two (Some (x.fee, Some x'.fee))
52	\| Zero ->	960✔
53	Zero
54	\| One None ->	320✔
55	One None
56	\| Two None ->	×
57	Two None
58
59	let init_resources
60	~(completed_work : Transaction_snark_work.Checked.t Sequence.t)
61	~(commands : User_command.Valid.t Sequence.t)
62	~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) =
63	let completed_work =	1,080✔
64	( Sequence.length completed_work	1,080✔
65	, Sequence.sum	1,080✔
66	(module Fee_Summable)
67	completed_work ~f:Transaction_snark_work.fee )
68	in
69	let commands =
70	( Sequence.length commands	1,080✔
71	, Sequence.sum	1,080✔
72	(module Fee_Summable)
73	commands
74	~f:(fun cmd -> User_command.fee (User_command.forget_check cmd)) )	7,520✔
75	in
76	let coinbase_work_fees = coinbase_fees coinbase in
77	{ completed_work; commands; coinbase_work_fees }	1,080✔
78
79	let init ~(completed_work : Transaction_snark_work.Checked.t Sequence.t)
80	~(commands : User_command.Valid.t Sequence.t)
81	~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t)
82	~partition ~available_slots ~required_work_count =
83	let start_resources = init_resources ~completed_work ~commands ~coinbase in	440✔
84	let discarded_commands =
85	{ insufficient_work = 0; insufficient_space = 0 }
86	in
87	let discarded_completed_work = { insufficient_fees = 0; extra_work = 0 } in
88	let end_resources =
89	{ completed_work = (0, Currency.Fee.zero)
90	; commands = (0, Currency.Fee.zero)
91	; coinbase_work_fees = Staged_ledger_diff.At_most_two.Zero
92	}
93	in
94	{ partition
95	; available_slots
96	; required_work_count
97	; start_resources
98	; discarded_completed_work
99	; discarded_commands
100	; end_resources
101	}
102
103	let end_log t ~(completed_work : Transaction_snark_work.Checked.t Sequence.t)
104	~(commands : User_command.Valid.t Sequence.t)
105	~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) =
106	end_resources.set (init_resources ~completed_work ~commands ~coinbase) t	200✔
107
108	let incr (top : ('a, 'b) Lens.t) (nested : ('b, int) Lens.t) (t : 'a) =
109	let nested_field = top.get t in	3,040✔
110	top.set (nested.set (nested.get nested_field + 1) nested_field) t	3,040✔
111
112	let discard_command (why : [> `No_work \| `No_space ]) t =
113	match why with	3,040✔
114	\| `No_work ->	2,980✔
115	incr discarded_commands command_constraints_insufficient_work t
116	\| `No_space ->	60✔
117	incr discarded_commands command_constraints_insufficient_space t
118	\| _ ->	×
119	t
120
121	let discard_completed_work (why : [> `Insufficient_fees \| `Extra_work ]) t =
122	match why with	×
123	\| `Insufficient_fees ->	×
124	incr discarded_completed_work
125	completed_work_constraints_insufficient_fees t
126	\| `Extra_work ->	×
127	incr discarded_completed_work completed_work_constraints_extra_work t
128	\| _ ->	×
129	t
130	end
131
132	module Detail = struct
133	type line =	×
134	{ reason :	×
135	[ `No_space	×
136	\| `No_work
137	\| `Insufficient_fees
138	\| `Extra_work
139	\| `Init
140	\| `End ]	×
141	; commands : count_and_fee	×
142	; completed_work : count_and_fee	×
143	; coinbase : Currency.Fee.t Staged_ledger_diff.At_most_two.t	×
144	}
145	[@@deriving sexp, to_yojson, lens]	×
146
147	type t = line list [@@deriving sexp, to_yojson]	×
148
149	let init ~(completed_work : Transaction_snark_work.Checked.t Sequence.t)
150	~(commands : User_command.Valid.t Sequence.t)
151	~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) =
152	let init = Summary.init_resources ~completed_work ~commands ~coinbase in	440✔
153	[ { reason = `Init
154	; commands = init.commands
155	; completed_work = init.completed_work
156	; coinbase = init.coinbase_work_fees
157	}
158	]
159
160	let discard_command (why : [> `No_work \| `No_space ]) command = function
161	\| [] ->	×
162	failwith "Log not initialized"
163	\| x :: xs ->	3,040✔
164	let new_line =
165	{ x with
166	reason = why
167	; commands =
168	( fst x.commands - 1	3,040✔
169	, Currency.Fee.sub (snd x.commands) (User_command.fee command)	3,040✔
170	\|> Option.value_exn )	3,040✔
171	}
172	in
173	new_line :: x :: xs
174
175	let discard_completed_work (why : [> `Insufficient_fees \| `Extra_work ])
176	completed_work = function
177	\| [] ->	×
178	failwith "Log not initialized"
179	\| x :: xs ->	×
180	let new_line =
181	{ x with
182	reason = why
183	; completed_work =
184	( fst x.completed_work - 1	×
185	, Currency.Fee.sub (snd x.completed_work)	×
186	(Transaction_snark_work.fee completed_work)	×
187	\|> Option.value_exn )	×
188	}
189	in
190	new_line :: x :: xs
191
192	let end_log coinbase = function
193	\| [] ->	×
194	failwith "Log not initialized"
195	\| x :: xs ->	200✔
196	(Because coinbase could be updated ooutside of the check_constraints_and_update function)
197	{ x with reason = `End; coinbase = Summary.coinbase_fees coinbase }	200✔
198	:: x :: xs
199	end
200
201	type t = Summary.t * Detail.t [@@deriving sexp, to_yojson]	×
202
203	type log_list = t list [@@deriving sexp, to_yojson]	×
204
205	type summary_list = Summary.t list [@@deriving sexp, to_yojson]	×
206
207	type detail_list = Detail.t list [@@deriving sexp, to_yojson]	×
208
209	let init ~(completed_work : Transaction_snark_work.Checked.t Sequence.t)
210	~(commands : User_command.Valid.t Sequence.t)
211	~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t)
212	~partition ~available_slots ~required_work_count =
213	let summary =	440✔
214	Summary.init ~completed_work ~commands ~coinbase ~partition ~available_slots
215	~required_work_count
216	in
217	let detailed = Detail.init ~completed_work ~commands ~coinbase in
218	(summary, detailed)
219
220	let discard_command why command t =
221	let detailed = Detail.discard_command why command (snd t) in	3,040✔
222	let summary = Summary.discard_command why (fst t) in	3,040✔
223	(summary, detailed)	3,040✔
224
225	let discard_completed_work why completed_work t =
226	let detailed = Detail.discard_completed_work why completed_work (snd t) in	×
227	let summary = Summary.discard_completed_work why (fst t) in	×
228	(summary, detailed)	×
229
230	let end_log ~(completed_work : Transaction_snark_work.Checked.t Sequence.t)
231	~(commands : User_command.Valid.t Sequence.t)
232	~(coinbase : Coinbase.Fee_transfer.t Staged_ledger_diff.At_most_two.t) t =
233	let summary = Summary.end_log (fst t) ~completed_work ~commands ~coinbase in	200✔
234	let detailed = Detail.end_log coinbase (snd t) in	200✔
235	(summary, detailed)	1✔

MinaProtocol / mina / 2863

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