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

2.44

/src/lib/network_pool/snark_pool_diff.ml

open Core_kernel
open Async_kernel
module Work = Transaction_snark_work.Statement
module Ledger_proof = Ledger_proof
module Work_info = Transaction_snark_work.Info
open Network_peer

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

    module V1 = struct
      type t = unit [@@deriving sexp, yojson]

      let to_latest = Fn.id
    end
  end]

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

module Make
    (Transition_frontier : T)
    (Pool : Intf.Snark_resource_pool_intf
              with type transition_frontier := Transition_frontier.t) :
  Intf.Snark_pool_diff_intf with type resource_pool := Pool.t = struct
  type t = Mina_wire_types.Network_pool.Snark_pool.Diff_versioned.V2.t =
    | Add_solved_work of Work.t * Ledger_proof.t One_or_two.t Priced_proof.t
    | Empty
  [@@deriving compare, sexp, to_yojson, hash]

  type verified = t [@@deriving compare, sexp, to_yojson]

  let t_of_verified = ident

  type rejected = Rejected.t [@@deriving sexp, yojson]

  let label = Pool.label

  let reject_overloaded_diff _ = ()

  type compact =
    { work_ids : int One_or_two.t
    ; fee : Currency.Fee.t
    ; prover : Signature_lib.Public_key.Compressed.t
    }
  [@@deriving yojson, hash]

  let to_compact = function
    | Add_solved_work (work, { proof = _; fee = { fee; prover } }) ->
        Some
          { work_ids = Transaction_snark_work.Statement.work_ids work
          ; fee
          ; prover
          }
    | Empty ->
        None

  let compact_json t = to_compact t |> Option.map ~f:compact_to_yojson

  let empty = Empty

  (* snark pool diffs are not bundled, so size is always 1 *)
  let size _ = 1

  let score = function
    | Add_solved_work (_w, p) ->
        One_or_two.length p.proof
    | Empty ->
        1

  (* Effectively disable rate limitting *)
  let max_per_15_seconds = 100000

  let summary = function
    | Add_solved_work (work, { proof = _; fee }) ->
        Printf.sprintf
          !"Snark_pool_diff for work %s added with fee-prover %s"
          (Yojson.Safe.to_string @@ Work.compact_json work)
          (Yojson.Safe.to_string @@ Mina_base.Fee_with_prover.to_yojson fee)
    | Empty ->
        "empty Snark_pool_diff"

  let is_empty _ = false

  let of_result
      (res :
        ( (_, _) Snark_work_lib.Work.Single.Spec.t Snark_work_lib.Work.Spec.t
        , Ledger_proof.t )
        Snark_work_lib.Work.Result.t ) =
    Add_solved_work
      ( One_or_two.map res.spec.instances
          ~f:Snark_work_lib.Work.Single.Spec.statement
      , { proof = res.proofs
        ; fee = { fee = res.spec.fee; prover = res.prover }
        } )

  (** Check whether there is a proof with lower fee in the pool.
      Returns [Ok ()] is the [~fee] would be the lowest in pool.
  *)
  let has_no_lower_fee pool work ~fee ~sender =
    let reject_and_log_if_local reason =
      [%log' trace (Pool.get_logger pool)]
        "Rejecting snark work $work from $sender: $reason"
        ~metadata:
          [ ("work", Work.compact_json work)
          ; ("sender", Envelope.Sender.to_yojson sender)
          ; ( "reason"
            , Error_json.error_to_yojson
              @@ Intf.Verification_error.to_error reason )
          ] ;
      Result.fail reason
    in
    match Pool.request_proof pool work with
    | None ->
        Ok ()
    | Some { fee = { fee = prev; _ }; _ } ->
        let cmp_res = Currency.Fee.compare fee prev in
        if cmp_res < 0 then Ok ()
        else if cmp_res = 0 then
          reject_and_log_if_local Intf.Verification_error.Fee_equal
        else reject_and_log_if_local Intf.Verification_error.Fee_higher

  let verify pool ({ data; sender; _ } as t : t Envelope.Incoming.t) =
    match data with
    | Empty ->
        Deferred.Result.fail
        @@ Intf.Verification_error.Invalid
             (Error.of_string "empty snark pool diff")
    | Add_solved_work (work, ({ Priced_proof.fee; _ } as p)) ->
        let is_local = match sender with Local -> true | _ -> false in
        let open Deferred.Result in
        let verify () =
          Pool.verify_and_act pool ~work:(work, p) ~sender >>| const t
        in
        (*reject higher priced gossiped proofs*)
        if is_local then verify ()
        else
          Deferred.return (has_no_lower_fee pool work ~fee:fee.fee ~sender)
          >>= verify

  (* This is called after verification has occurred.*)
  let unsafe_apply (pool : Pool.t) (t : t Envelope.Incoming.t) =
    let { Envelope.Incoming.data = diff; sender; _ } = t in
    match diff with
    | Empty ->
        Error (`Other (Error.of_string "cannot apply empty snark pool diff"))
    | Add_solved_work (work, { Priced_proof.proof; fee }) -> (
        let is_local = match sender with Local -> true | _ -> false in
        let to_or_error = function
          | `Statement_not_referenced ->
              Error (`Other (Error.of_string "statement not referenced"))
          | `Added ->
              Ok (diff, ())
        in
        match has_no_lower_fee pool work ~fee:fee.fee ~sender with
        | Ok () ->
            let%map.Result accepted, rejected =
              Pool.add_snark ~is_local pool ~work ~proof ~fee |> to_or_error
            in
            (`Accept, accepted, rejected)
        | Error e ->
            if is_local then Error (`Locally_generated (diff, ()))
            else Error (`Other (Intf.Verification_error.to_error e)) )

  type Structured_log_events.t +=
    | Snark_work_received of { work : compact; sender : Envelope.Sender.t }
    [@@deriving
      register_event { msg = "Received Snark-pool diff $work from $sender" }]

  let update_metrics ~logger ~log_gossip_heard
      (Envelope.Incoming.{ data = diff; sender; _ } : t Envelope.Incoming.t)
      valid_cb =
    Mina_metrics.(Counter.inc_one Network.gossip_messages_received) ;
    Mina_metrics.(Gauge.inc_one Network.snark_pool_diff_received) ;
    if log_gossip_heard then
      Option.iter (to_compact diff) ~f:(fun work ->
          [%str_log debug] (Snark_work_received { work; sender }) ) ;
    Mina_metrics.(Counter.inc_one Network.Snark_work.received) ;
    Mina_net2.Validation_callback.set_message_type valid_cb `Snark_work

  let log_internal ?reason ~logger msg = function
    | { Envelope.Incoming.data = Empty; _ } ->
        ()
    | { data = Add_solved_work (work, { fee = { fee; prover }; _ }); sender; _ }
      ->
        let metadata =
          [ ("work_ids", Transaction_snark_work.Statement.compact_json work)
          ; ("fee", Currency.Fee.to_yojson fee)
          ; ("prover", Signature_lib.Public_key.Compressed.to_yojson prover)
          ]
        in
        let metadata =
          match sender with
          | Remote addr ->
              ("sender", `String (Core.Unix.Inet_addr.to_string @@ Peer.ip addr))
              :: metadata
          | Local ->
              metadata
        in
        let metadata =
          Option.value_map reason
            ~f:(fun r -> List.cons ("reason", `String r))
            ~default:ident metadata
        in
        [%log internal] "%s" ("Snark_work_" ^ msg) ~metadata
end

1	open Core_kernel	1✔
2	open Async_kernel
3	module Work = Transaction_snark_work.Statement
4	module Ledger_proof = Ledger_proof
5	module Work_info = Transaction_snark_work.Info
6	open Network_peer
7
8	module Rejected = struct
9	[%%versioned
10	module Stable = struct
11	[@@@no_toplevel_latest_type]
12
13	module V1 = struct
14	type t = unit [@@deriving sexp, yojson]	×
15
16	let to_latest = Fn.id
17	end
18	end]
19
20	type t = Stable.Latest.t [@@deriving sexp, yojson]	×
21	end
22
23	module Make
24	(Transition_frontier : T)
25	(Pool : Intf.Snark_resource_pool_intf
26	with type transition_frontier := Transition_frontier.t) :
27	Intf.Snark_pool_diff_intf with type resource_pool := Pool.t = struct
28	type t = Mina_wire_types.Network_pool.Snark_pool.Diff_versioned.V2.t =	×
29	\| Add_solved_work of Work.t * Ledger_proof.t One_or_two.t Priced_proof.t	×
30	\| Empty	×
31	[@@deriving compare, sexp, to_yojson, hash]	×
32
33	type verified = t [@@deriving compare, sexp, to_yojson]	×
34
35	let t_of_verified = ident
36
37	type rejected = Rejected.t [@@deriving sexp, yojson]	×
38
39	let label = Pool.label
40
41	let reject_overloaded_diff _ = ()	×
42
43	type compact =	×
44	{ work_ids : int One_or_two.t	×
45	; fee : Currency.Fee.t	×
46	; prover : Signature_lib.Public_key.Compressed.t	×
47	}
48	[@@deriving yojson, hash]	×
49
50	let to_compact = function
51	\| Add_solved_work (work, { proof = _; fee = { fee; prover } }) ->	×
52	Some
53	{ work_ids = Transaction_snark_work.Statement.work_ids work	×
54	; fee
55	; prover
56	}
57	\| Empty ->	×
58	None
59
60	let compact_json t = to_compact t \|> Option.map ~f:compact_to_yojson	×
61
62	let empty = Empty
63
64	(* snark pool diffs are not bundled, so size is always 1 *)
65	let size _ = 1	×
66
67	let score = function
68	\| Add_solved_work (_w, p) ->	×
69	One_or_two.length p.proof
70	\| Empty ->	×
71	1
72
73	(* Effectively disable rate limitting *)
74	let max_per_15_seconds = 100000
75
76	let summary = function
77	\| Add_solved_work (work, { proof = _; fee }) ->	×
78	Printf.sprintf
79	!"Snark_pool_diff for work %s added with fee-prover %s"
80	(Yojson.Safe.to_string @@ Work.compact_json work)	×
81	(Yojson.Safe.to_string @@ Mina_base.Fee_with_prover.to_yojson fee)	×
82	\| Empty ->	×
83	"empty Snark_pool_diff"
84
85	let is_empty _ = false	×
86
87	let of_result
88	(res :
89	( (_, _) Snark_work_lib.Work.Single.Spec.t Snark_work_lib.Work.Spec.t
90	, Ledger_proof.t )
91	Snark_work_lib.Work.Result.t ) =
92	Add_solved_work	×
93	( One_or_two.map res.spec.instances	×
94	~f:Snark_work_lib.Work.Single.Spec.statement
95	, { proof = res.proofs
96	; fee = { fee = res.spec.fee; prover = res.prover }
97	} )
98
99	(** Check whether there is a proof with lower fee in the pool.
100	Returns [Ok ()] is the [~fee] would be the lowest in pool.
101	*)
102	let has_no_lower_fee pool work ~fee ~sender =
103	let reject_and_log_if_local reason =	×
104	[%log' trace (Pool.get_logger pool)]	×
105	"Rejecting snark work $work from $sender: $reason"
106	~metadata:
107	[ ("work", Work.compact_json work)	×
108	; ("sender", Envelope.Sender.to_yojson sender)	×
109	; ( "reason"
110	, Error_json.error_to_yojson	×
111	@@ Intf.Verification_error.to_error reason )	×
112	] ;
113	Result.fail reason	×
114	in
115	match Pool.request_proof pool work with
116	\| None ->	×
117	Ok ()
118	\| Some { fee = { fee = prev; _ }; _ } ->	×
119	let cmp_res = Currency.Fee.compare fee prev in
120	if cmp_res < 0 then Ok ()	×
121	else if cmp_res = 0 then	×
122	reject_and_log_if_local Intf.Verification_error.Fee_equal	×
123	else reject_and_log_if_local Intf.Verification_error.Fee_higher	×
124
125	let verify pool ({ data; sender; _ } as t : t Envelope.Incoming.t) =
126	match data with	×
127	\| Empty ->	×
128	Deferred.Result.fail
129	@@ Intf.Verification_error.Invalid
130	(Error.of_string "empty snark pool diff")	×
131	\| Add_solved_work (work, ({ Priced_proof.fee; _ } as p)) ->	×
132	let is_local = match sender with Local -> true \| _ -> false in	×
133	let open Deferred.Result in
134	let verify () =
135	Pool.verify_and_act pool ~work:(work, p) ~sender >>\| const t	×
136	in
137	(reject higher priced gossiped proofs)
138	if is_local then verify ()	×
139	else
140	Deferred.return (has_no_lower_fee pool work ~fee:fee.fee ~sender)	×
141	>>= verify
142
143	(* This is called after verification has occurred.*)
144	let unsafe_apply (pool : Pool.t) (t : t Envelope.Incoming.t) =
145	let { Envelope.Incoming.data = diff; sender; _ } = t in	×
146	match diff with
147	\| Empty ->	×
148	Error (`Other (Error.of_string "cannot apply empty snark pool diff"))	×
149	\| Add_solved_work (work, { Priced_proof.proof; fee }) -> (	×
150	let is_local = match sender with Local -> true \| _ -> false in	×
151	let to_or_error = function
152	\| `Statement_not_referenced ->	×
153	Error (`Other (Error.of_string "statement not referenced"))	×
154	\| `Added ->	×
155	Ok (diff, ())
156	in
157	match has_no_lower_fee pool work ~fee:fee.fee ~sender with
158	\| Ok () ->	×
159	let%map.Result accepted, rejected =
160	Pool.add_snark ~is_local pool ~work ~proof ~fee \|> to_or_error	×
161	in
162	(`Accept, accepted, rejected)	×
163	\| Error e ->	×
164	if is_local then Error (`Locally_generated (diff, ()))	×
165	else Error (`Other (Intf.Verification_error.to_error e)) )	×
166
167	type Structured_log_events.t +=
168	\| Snark_work_received of { work : compact; sender : Envelope.Sender.t }	×
169	[@@deriving
170	register_event { msg = "Received Snark-pool diff $work from $sender" }]	×
171
172	let update_metrics ~logger ~log_gossip_heard
173	(Envelope.Incoming.{ data = diff; sender; _ } : t Envelope.Incoming.t)
174	valid_cb =
175	Mina_metrics.(Counter.inc_one Network.gossip_messages_received) ;	×
176	Mina_metrics.(Gauge.inc_one Network.snark_pool_diff_received) ;	×
177	if log_gossip_heard then
178	Option.iter (to_compact diff) ~f:(fun work ->	×
179	[%str_log debug] (Snark_work_received { work; sender }) ) ;	×
180	Mina_metrics.(Counter.inc_one Network.Snark_work.received) ;	×
181	Mina_net2.Validation_callback.set_message_type valid_cb `Snark_work
182
183	let log_internal ?reason ~logger msg = function
184	\| { Envelope.Incoming.data = Empty; _ } ->	×
185	()
186	\| { data = Add_solved_work (work, { fee = { fee; prover }; _ }); sender; _ }	×
187	->
188	let metadata =
189	[ ("work_ids", Transaction_snark_work.Statement.compact_json work)	×
190	; ("fee", Currency.Fee.to_yojson fee)	×
191	; ("prover", Signature_lib.Public_key.Compressed.to_yojson prover)	×
192	]
193	in
194	let metadata =
195	match sender with
196	\| Remote addr ->	×
197	("sender", `String (Core.Unix.Inet_addr.to_string @@ Peer.ip addr))	×
198	:: metadata
199	\| Local ->	×
200	metadata
201	in
202	let metadata =
203	Option.value_map reason
204	~f:(fun r -> List.cons ("reason", `String r))	×
205	~default:ident metadata
206	in
207	[%log internal] "%s" ("Snark_work_" ^ msg) ~metadata	×
208	end	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