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

2.04

/src/lib/sync_handler/sync_handler.ml

open Core_kernel
open Async
open Mina_base
module Ledger = Mina_ledger.Ledger
module Sync_ledger = Mina_ledger.Sync_ledger
open Frontier_base
open Network_peer

module type CONTEXT = sig
  val logger : Logger.t

  val precomputed_values : Precomputed_values.t

  val constraint_constants : Genesis_constants.Constraint_constants.t

  val consensus_constants : Consensus.Constants.t

  val compile_config : Mina_compile_config.t
end

module type Inputs_intf = sig
  module Transition_frontier : module type of Transition_frontier

  module Best_tip_prover :
    Mina_intf.Best_tip_prover_intf
      with type transition_frontier := Transition_frontier.t
end

module Make (Inputs : Inputs_intf) :
  Mina_intf.Sync_handler_intf
    with type transition_frontier := Inputs.Transition_frontier.t = struct
  open Inputs

  let find_in_root_history frontier state_hash =
    let open Transition_frontier.Extensions in
    let root_history =
      get_extension (Transition_frontier.extensions frontier) Root_history
    in
    Root_history.lookup root_history state_hash

  let protocol_states_in_root_history frontier state_hash =
    let open Transition_frontier.Extensions in
    let root_history =
      get_extension (Transition_frontier.extensions frontier) Root_history
    in
    Root_history.protocol_states_for_scan_state root_history state_hash

  let get_ledger_by_hash ~frontier ledger_hash =
    let root_ledger =
      Ledger.Any_ledger.cast (module Ledger.Db)
      @@ Transition_frontier.root_snarked_ledger frontier
    in
    let staking_epoch_ledger =
      Transition_frontier.consensus_local_state frontier
      |> Consensus.Data.Local_state.staking_epoch_ledger
    in
    let next_epoch_ledger =
      Transition_frontier.consensus_local_state frontier
      |> Consensus.Data.Local_state.next_epoch_ledger
    in
    if
      Ledger_hash.equal ledger_hash
        (Ledger.Any_ledger.M.merkle_root root_ledger)
    then Some root_ledger
    else if
      Ledger_hash.equal ledger_hash
        (Consensus.Data.Local_state.Snapshot.Ledger_snapshot.merkle_root
           staking_epoch_ledger )
    then
      match staking_epoch_ledger with
      | Consensus.Data.Local_state.Snapshot.Ledger_snapshot.Genesis_epoch_ledger
          _ ->
          None
      | Ledger_db ledger ->
          Some (Ledger.Any_ledger.cast (module Ledger.Db) ledger)
    else if
      Ledger_hash.equal ledger_hash
        (Consensus.Data.Local_state.Snapshot.Ledger_snapshot.merkle_root
           next_epoch_ledger )
    then
      match next_epoch_ledger with
      | Consensus.Data.Local_state.Snapshot.Ledger_snapshot.Genesis_epoch_ledger
          _ ->
          None
      | Ledger_db ledger ->
          Some (Ledger.Any_ledger.cast (module Ledger.Db) ledger)
    else None

  let answer_query :
         frontier:Inputs.Transition_frontier.t
      -> Ledger_hash.t
      -> Sync_ledger.Query.t Envelope.Incoming.t
      -> logger:Logger.t
      -> trust_system:Trust_system.t
      -> Sync_ledger.Answer.t Option.t Deferred.t =
   fun ~frontier hash query ~logger ~trust_system ->
    match get_ledger_by_hash ~frontier hash with
    | None ->
        return None
    | Some ledger ->
        let responder =
          Sync_ledger.Any_ledger.Responder.create ledger ignore ~logger
            ~trust_system
        in
        Sync_ledger.Any_ledger.Responder.answer_query responder query

  let get_staged_ledger_aux_and_pending_coinbases_at_hash ~frontier state_hash =
    let open Option.Let_syntax in
    let protocol_states scan_state =
      Staged_ledger.Scan_state.required_state_hashes scan_state
      |> State_hash.Set.to_list
      |> List.fold_until ~init:(Some [])
           ~f:(fun acc hash ->
             match
               Option.map2
                 (Transition_frontier.find_protocol_state frontier hash)
                 acc ~f:List.cons
             with
             | None ->
                 Stop None
             | Some acc' ->
                 Continue (Some acc') )
           ~finish:Fn.id
    in
    match
      let%bind breadcrumb = Transition_frontier.find frontier state_hash in
      let staged_ledger =
        Transition_frontier.Breadcrumb.staged_ledger breadcrumb
      in
      let scan_state = Staged_ledger.scan_state staged_ledger in
      let merkle_root =
        Staged_ledger.hash staged_ledger |> Staged_ledger_hash.ledger_hash
      in
      let%map scan_state_protocol_states = protocol_states scan_state in
      let pending_coinbase =
        Staged_ledger.pending_coinbase_collection staged_ledger
      in
      (scan_state, merkle_root, pending_coinbase, scan_state_protocol_states)
    with
    | Some res ->
        Some res
    | None ->
        let open Root_data.Historical in
        let%bind root = find_in_root_history frontier state_hash in
        let%map scan_state_protocol_states =
          protocol_states_in_root_history frontier state_hash
        in
        ( scan_state root
        , staged_ledger_target_ledger_hash root
        , pending_coinbase root
        , scan_state_protocol_states )

  let get_transition_chain ~frontier hashes =
    let open Option.Let_syntax in
    let%bind () =
      let requested = List.length hashes in
      if requested <= Transition_frontier.max_catchup_chunk_length then Some ()
      else (
        [%log' trace (Logger.create ())]
          ~metadata:[ ("n", `Int requested) ]
          "get_transition_chain requested $n > %d hashes"
          Transition_frontier.max_catchup_chunk_length ;
        None )
    in
    let get hash =
      let%map validated_transition =
        Option.merge
          Transition_frontier.(
            find frontier hash >>| Breadcrumb.validated_transition)
          ( find_in_root_history frontier hash
          >>| Root_data.Historical.transition )
          ~f:Fn.const
      in
      With_hash.data @@ Mina_block.Validated.forget validated_transition
    in
    match Transition_frontier.catchup_state frontier with
    | Full _ ->
        (* Super catchup *)
        Option.return @@ List.filter_map hashes ~f:get
    | Hash _ ->
        (* Normal catchup *)
        Option.all @@ List.map hashes ~f:get

  let best_tip_path ~frontier =
    let rec go acc b =
      let acc = Breadcrumb.state_hash b :: acc in
      match Transition_frontier.find frontier (Breadcrumb.parent_hash b) with
      | None ->
          acc
      | Some b' ->
          go acc b'
    in
    go [] (Transition_frontier.best_tip frontier)

  module Root = struct
    let prove ~context:(module Context : CONTEXT) ~frontier seen_consensus_state
        =
      let module Context = struct
        include Context

        let logger =
          Logger.extend logger [ ("selection_context", `String "Root.prove") ]
      end in
      let open Option.Let_syntax in
      let%bind best_tip_with_witness =
        Best_tip_prover.prove ~context:(module Context) frontier
      in
      let is_tip_better =
        Consensus.Hooks.equal_select_status
          (Consensus.Hooks.select
             ~context:(module Context)
             ~existing:
               (With_hash.map ~f:Mina_block.consensus_state
                  best_tip_with_witness.data )
             ~candidate:seen_consensus_state )
          `Keep
      in
      let%map () = Option.some_if is_tip_better () in
      { best_tip_with_witness with
        data = With_hash.data best_tip_with_witness.data
      }

    let verify ~context:(module Context : CONTEXT) ~verifier ~genesis_constants
        observed_state peer_root =
      let module Context = struct
        include Context

        let logger =
          Logger.extend logger [ ("selection_context", `String "Root.verify") ]
      end in
      let open Context in
      let open Deferred.Result.Let_syntax in
      let%bind ( (`Root _, `Best_tip (best_tip_transition, _)) as
               verified_witness ) =
        Best_tip_prover.verify ~verifier ~genesis_constants ~precomputed_values
          peer_root
      in
      let is_before_best_tip candidate =
        Consensus.Hooks.equal_select_status
          (Consensus.Hooks.select
             ~context:(module Context)
             ~existing:
               (With_hash.map ~f:Mina_block.consensus_state best_tip_transition)
             ~candidate )
          `Keep
      in
      let%map () =
        Deferred.return
          (Result.ok_if_true
             (is_before_best_tip observed_state)
             ~error:
               (Error.createf
                  !"Peer lied about it's best tip %{sexp:State_hash.t}"
                  (State_hash.With_state_hashes.state_hash best_tip_transition) ) )
      in
      verified_witness
  end
end

include Make (struct
  module Transition_frontier = Transition_frontier
  module Best_tip_prover = Best_tip_prover
end)

(* TODO: port these tests *)
(*
let%test_module "Sync_handler" =
  ( module struct
    let logger = Logger.null ()

    let hb_logger = Logger.create ()

    let pids = Child_processes.Termination.create_pid_table ()

    let trust_system = Trust_system.null ()

    let f_with_verifier ~f ~logger ~pids =
      let%map verifier = Verifier.create ~logger ~pids in
      f ~logger ~verifier

    let%test "sync with ledgers from another peer via glue_sync_ledger" =
      Backtrace.elide := false ;
      Printexc.record_backtrace true ;
      heartbeat_flag := true ;
      Ledger.with_ephemeral_ledger ~f:(fun dest_ledger ->
          Thread_safe.block_on_async_exn (fun () ->
              print_heartbeat hb_logger |> don't_wait_for ;
              let%bind frontier =
                create_root_frontier ~logger ~pids Test_genesis_ledger.accounts
              in
              let source_ledger =
                Transition_frontier.For_tests.root_snarked_ledger frontier
                |> Ledger.of_database
              in
              let desired_root = Ledger.merkle_root source_ledger in
              let sync_ledger =
                Sync_ledger.Mask.create dest_ledger ~logger ~trust_system
              in
              let query_reader = Sync_ledger.Mask.query_reader sync_ledger in
              let answer_writer = Sync_ledger.Mask.answer_writer sync_ledger in
              let peer =
                Network_peer.Peer.create Unix.Inet_addr.localhost
                  ~discovery_port:0 ~communication_port:1
              in
              let network =
                Network.create_stub ~logger
                  ~ip_table:
                    (Hashtbl.of_alist_exn
                       (module Unix.Inet_addr)
                       [(peer.host, frontier)])
                  ~peers:(Hash_set.of_list (module Network_peer.Peer) [peer])
              in
              Network.glue_sync_ledger network query_reader answer_writer ;
              match%map
                Sync_ledger.Mask.fetch sync_ledger desired_root ~data:()
                  ~equal:(fun () () -> true)
              with
              | `Ok synced_ledger ->
                  heartbeat_flag := false ;
                  Ledger_hash.equal
                    (Ledger.merkle_root dest_ledger)
                    (Ledger.merkle_root source_ledger)
                  && Ledger_hash.equal
                       (Ledger.merkle_root synced_ledger)
                       (Ledger.merkle_root source_ledger)
              | `Target_changed _ ->
                  heartbeat_flag := false ;
                  failwith "target of sync_ledger should not change" ) )

    let to_external_transition breadcrumb =
      Transition_frontier.Breadcrumb.validated_transition breadcrumb
      |> Mina_block.Validated.forget

    let%test "a node should be able to give a valid proof of their root" =
      heartbeat_flag := true ;
      let max_length = 4 in
      (* Generating this many breadcrumbs will ernsure the transition_frontier to be full  *)
      let num_breadcrumbs = max_length + 2 in
      Thread_safe.block_on_async_exn (fun () ->
          print_heartbeat hb_logger |> don't_wait_for ;
          let%bind frontier =
            create_root_frontier ~logger ~pids Test_genesis_ledger.accounts
          in
          let%bind () =
            build_frontier_randomly frontier
              ~gen_root_breadcrumb_builder:
                (gen_linear_breadcrumbs ~logger ~pids ~trust_system
                   ~size:num_breadcrumbs
                   ~accounts_with_secret_keys:Test_genesis_ledger.accounts)
          in
          let seen_transition =
            Transition_frontier.(
              all_breadcrumbs frontier |> List.permute |> List.hd_exn
              |> Breadcrumb.validated_transition)
          in
          let observed_state =
            Mina_block.Validated.protocol_state seen_transition
            |> Protocol_state.consensus_state
          in
          let root_with_proof =
            Option.value_exn ~message:"Could not produce an ancestor proof"
              (Sync_handler.Root.prove ~logger ~frontier observed_state)
          in
          let%bind verify =
            f_with_verifier ~f:Sync_handler.Root.verify ~logger ~pids
          in
          let%map `Root (root_transition, _), `Best_tip (best_tip_transition, _)
              =
            verify observed_state root_with_proof |> Deferred.Or_error.ok_exn
          in
          heartbeat_flag := false ;
          Mina_block.(
            equal
              (With_hash.data root_transition)
              (to_external_transition (Transition_frontier.root frontier))
            && equal
                 (With_hash.data best_tip_transition)
                 (to_external_transition
                    (Transition_frontier.best_tip frontier))) )
  end )
*)

1	open Core_kernel	1✔
2	open Async
3	open Mina_base
4	module Ledger = Mina_ledger.Ledger
5	module Sync_ledger = Mina_ledger.Sync_ledger
6	open Frontier_base
7	open Network_peer
8
9	module type CONTEXT = sig
10	val logger : Logger.t
11
12	val precomputed_values : Precomputed_values.t
13
14	val constraint_constants : Genesis_constants.Constraint_constants.t
15
16	val consensus_constants : Consensus.Constants.t
17
18	val compile_config : Mina_compile_config.t
19	end
20
21	module type Inputs_intf = sig
22	module Transition_frontier : module type of Transition_frontier
23
24	module Best_tip_prover :
25	Mina_intf.Best_tip_prover_intf
26	with type transition_frontier := Transition_frontier.t
27	end
28
29	module Make (Inputs : Inputs_intf) :
30	Mina_intf.Sync_handler_intf
31	with type transition_frontier := Inputs.Transition_frontier.t = struct
32	open Inputs
33
34	let find_in_root_history frontier state_hash =
35	let open Transition_frontier.Extensions in	×
36	let root_history =
37	get_extension (Transition_frontier.extensions frontier) Root_history	×
38	in
39	Root_history.lookup root_history state_hash	×
40
41	let protocol_states_in_root_history frontier state_hash =
42	let open Transition_frontier.Extensions in	×
43	let root_history =
44	get_extension (Transition_frontier.extensions frontier) Root_history	×
45	in
46	Root_history.protocol_states_for_scan_state root_history state_hash	×
47
48	let get_ledger_by_hash ~frontier ledger_hash =
49	let root_ledger =	×
50	Ledger.Any_ledger.cast (module Ledger.Db)
51	@@ Transition_frontier.root_snarked_ledger frontier	×
52	in
53	let staking_epoch_ledger =	×
54	Transition_frontier.consensus_local_state frontier	×
55	\|> Consensus.Data.Local_state.staking_epoch_ledger
56	in
57	let next_epoch_ledger =	×
58	Transition_frontier.consensus_local_state frontier	×
59	\|> Consensus.Data.Local_state.next_epoch_ledger
60	in
61	if	×
62	Ledger_hash.equal ledger_hash
63	(Ledger.Any_ledger.M.merkle_root root_ledger)	×
64	then Some root_ledger	×
65	else if	×
66	Ledger_hash.equal ledger_hash
67	(Consensus.Data.Local_state.Snapshot.Ledger_snapshot.merkle_root	×
68	staking_epoch_ledger )
69	then
70	match staking_epoch_ledger with	×
71	\| Consensus.Data.Local_state.Snapshot.Ledger_snapshot.Genesis_epoch_ledger	×
72	_ ->
73	None
74	\| Ledger_db ledger ->	×
75	Some (Ledger.Any_ledger.cast (module Ledger.Db) ledger)	×
76	else if	×
77	Ledger_hash.equal ledger_hash
78	(Consensus.Data.Local_state.Snapshot.Ledger_snapshot.merkle_root	×
79	next_epoch_ledger )
80	then
81	match next_epoch_ledger with	×
82	\| Consensus.Data.Local_state.Snapshot.Ledger_snapshot.Genesis_epoch_ledger	×
83	_ ->
84	None
85	\| Ledger_db ledger ->	×
86	Some (Ledger.Any_ledger.cast (module Ledger.Db) ledger)	×
87	else None	×
88
89	let answer_query :
90	frontier:Inputs.Transition_frontier.t
91	-> Ledger_hash.t
92	-> Sync_ledger.Query.t Envelope.Incoming.t
93	-> logger:Logger.t
94	-> trust_system:Trust_system.t
95	-> Sync_ledger.Answer.t Option.t Deferred.t =
96	fun ~frontier hash query ~logger ~trust_system ->
97	match get_ledger_by_hash ~frontier hash with	×
98	\| None ->	×
99	return None
100	\| Some ledger ->	×
101	let responder =
102	Sync_ledger.Any_ledger.Responder.create ledger ignore ~logger
103	~trust_system
104	in
105	Sync_ledger.Any_ledger.Responder.answer_query responder query	×
106
107	let get_staged_ledger_aux_and_pending_coinbases_at_hash ~frontier state_hash =
108	let open Option.Let_syntax in	×
109	let protocol_states scan_state =
110	Staged_ledger.Scan_state.required_state_hashes scan_state	×
111	\|> State_hash.Set.to_list	×
112	\|> List.fold_until ~init:(Some [])
113	~f:(fun acc hash ->
114	match	×
115	Option.map2
116	(Transition_frontier.find_protocol_state frontier hash)	×
117	acc ~f:List.cons
118	with
119	\| None ->	×
120	Stop None
121	\| Some acc' ->	×
122	Continue (Some acc') )
123	~finish:Fn.id
124	in
125	match
126	let%bind breadcrumb = Transition_frontier.find frontier state_hash in	×
127	let staged_ledger =	×
128	Transition_frontier.Breadcrumb.staged_ledger breadcrumb
129	in
130	let scan_state = Staged_ledger.scan_state staged_ledger in	×
131	let merkle_root =	×
132	Staged_ledger.hash staged_ledger \|> Staged_ledger_hash.ledger_hash	×
133	in
134	let%map scan_state_protocol_states = protocol_states scan_state in	×
135	let pending_coinbase =	×
136	Staged_ledger.pending_coinbase_collection staged_ledger
137	in
138	(scan_state, merkle_root, pending_coinbase, scan_state_protocol_states)	×
139	with
140	\| Some res ->	×
141	Some res
142	\| None ->	×
143	let open Root_data.Historical in
144	let%bind root = find_in_root_history frontier state_hash in	×
145	let%map scan_state_protocol_states =
146	protocol_states_in_root_history frontier state_hash	×
147	in
148	( scan_state root	×
149	, staged_ledger_target_ledger_hash root	×
150	, pending_coinbase root	×
151	, scan_state_protocol_states )
152
153	let get_transition_chain ~frontier hashes =
154	let open Option.Let_syntax in	×
155	let%bind () =
156	let requested = List.length hashes in
157	if requested <= Transition_frontier.max_catchup_chunk_length then Some ()	×
158	else (	×
159	[%log' trace (Logger.create ())]	×
160	~metadata:[ ("n", `Int requested) ]
161	"get_transition_chain requested $n > %d hashes"
162	Transition_frontier.max_catchup_chunk_length ;
163	None )	×
164	in
165	let get hash =	×
166	let%map validated_transition =
167	Option.merge	×
168	Transition_frontier.(
169	find frontier hash >>\| Breadcrumb.validated_transition)	×
170	( find_in_root_history frontier hash	×
171	>>\| Root_data.Historical.transition )	×
172	~f:Fn.const
173	in
174	With_hash.data @@ Mina_block.Validated.forget validated_transition	×
175	in
176	match Transition_frontier.catchup_state frontier with
177	\| Full _ ->	×
178	(* Super catchup *)
179	Option.return @@ List.filter_map hashes ~f:get	×
180	\| Hash _ ->	×
181	(* Normal catchup *)
182	Option.all @@ List.map hashes ~f:get	×
183
184	let best_tip_path ~frontier =
185	let rec go acc b =	×
186	let acc = Breadcrumb.state_hash b :: acc in	×
187	match Transition_frontier.find frontier (Breadcrumb.parent_hash b) with	×
188	\| None ->	×
189	acc
190	\| Some b' ->	×
191	go acc b'
192	in
193	go [] (Transition_frontier.best_tip frontier)	×
194
195	module Root = struct
196	let prove ~context:(module Context : CONTEXT) ~frontier seen_consensus_state
197	=
198	let module Context = struct	×
199	include Context
200
201	let logger =
202	Logger.extend logger [ ("selection_context", `String "Root.prove") ]	×
203	end in
204	let open Option.Let_syntax in
205	let%bind best_tip_with_witness =
206	Best_tip_prover.prove ~context:(module Context) frontier	×
207	in
208	let is_tip_better =	×
209	Consensus.Hooks.equal_select_status
210	(Consensus.Hooks.select
211	~context:(module Context)
212	~existing:
213	(With_hash.map ~f:Mina_block.consensus_state	×
214	best_tip_with_witness.data )
215	~candidate:seen_consensus_state )
216	`Keep
217	in
218	let%map () = Option.some_if is_tip_better () in	×
219	{ best_tip_with_witness with	×
220	data = With_hash.data best_tip_with_witness.data	×
221	}
222
223	let verify ~context:(module Context : CONTEXT) ~verifier ~genesis_constants
224	observed_state peer_root =
225	let module Context = struct	×
226	include Context
227
228	let logger =
229	Logger.extend logger [ ("selection_context", `String "Root.verify") ]	×
230	end in
231	let open Context in
232	let open Deferred.Result.Let_syntax in
233	let%bind ( (`Root _, `Best_tip (best_tip_transition, _)) as
234	verified_witness ) =
235	Best_tip_prover.verify ~verifier ~genesis_constants ~precomputed_values	×
236	peer_root
237	in
238	let is_before_best_tip candidate =	×
239	Consensus.Hooks.equal_select_status	×
240	(Consensus.Hooks.select
241	~context:(module Context)
242	~existing:
243	(With_hash.map ~f:Mina_block.consensus_state best_tip_transition)	×
244	~candidate )
245	`Keep
246	in
247	let%map () =
248	Deferred.return	×
249	(Result.ok_if_true	×
250	(is_before_best_tip observed_state)	×
251	~error:
252	(Error.createf	×
253	!"Peer lied about it's best tip %{sexp:State_hash.t}"	×
254	(State_hash.With_state_hashes.state_hash best_tip_transition) ) )	×
255	in
256	verified_witness	×
257	end
258	end
259
260	include Make (struct
261	module Transition_frontier = Transition_frontier
262	module Best_tip_prover = Best_tip_prover
263	end)	2✔
264
265	(* TODO: port these tests *)
266	(*
267	let%test_module "Sync_handler" =
268	( module struct
269	let logger = Logger.null ()
270
271	let hb_logger = Logger.create ()
272
273	let pids = Child_processes.Termination.create_pid_table ()
274
275	let trust_system = Trust_system.null ()
276
277	let f_with_verifier ~f ~logger ~pids =
278	let%map verifier = Verifier.create ~logger ~pids in
279	f ~logger ~verifier
280
281	let%test "sync with ledgers from another peer via glue_sync_ledger" =
282	Backtrace.elide := false ;
283	Printexc.record_backtrace true ;
284	heartbeat_flag := true ;
285	Ledger.with_ephemeral_ledger ~f:(fun dest_ledger ->
286	Thread_safe.block_on_async_exn (fun () ->
287	print_heartbeat hb_logger \|> don't_wait_for ;
288	let%bind frontier =
289	create_root_frontier ~logger ~pids Test_genesis_ledger.accounts
290	in
291	let source_ledger =
292	Transition_frontier.For_tests.root_snarked_ledger frontier
293	\|> Ledger.of_database
294	in
295	let desired_root = Ledger.merkle_root source_ledger in
296	let sync_ledger =
297	Sync_ledger.Mask.create dest_ledger ~logger ~trust_system
298	in
299	let query_reader = Sync_ledger.Mask.query_reader sync_ledger in
300	let answer_writer = Sync_ledger.Mask.answer_writer sync_ledger in
301	let peer =
302	Network_peer.Peer.create Unix.Inet_addr.localhost
303	~discovery_port:0 ~communication_port:1
304	in
305	let network =
306	Network.create_stub ~logger
307	~ip_table:
308	(Hashtbl.of_alist_exn
309	(module Unix.Inet_addr)
310	[(peer.host, frontier)])
311	~peers:(Hash_set.of_list (module Network_peer.Peer) [peer])
312	in
313	Network.glue_sync_ledger network query_reader answer_writer ;
314	match%map
315	Sync_ledger.Mask.fetch sync_ledger desired_root ~data:()
316	~equal:(fun () () -> true)
317	with
318	\| `Ok synced_ledger ->
319	heartbeat_flag := false ;
320	Ledger_hash.equal
321	(Ledger.merkle_root dest_ledger)
322	(Ledger.merkle_root source_ledger)
323	&& Ledger_hash.equal
324	(Ledger.merkle_root synced_ledger)
325	(Ledger.merkle_root source_ledger)
326	\| `Target_changed _ ->
327	heartbeat_flag := false ;
328	failwith "target of sync_ledger should not change" ) )
329
330	let to_external_transition breadcrumb =
331	Transition_frontier.Breadcrumb.validated_transition breadcrumb
332	\|> Mina_block.Validated.forget
333
334	let%test "a node should be able to give a valid proof of their root" =
335	heartbeat_flag := true ;
336	let max_length = 4 in
337	(* Generating this many breadcrumbs will ernsure the transition_frontier to be full *)
338	let num_breadcrumbs = max_length + 2 in
339	Thread_safe.block_on_async_exn (fun () ->
340	print_heartbeat hb_logger \|> don't_wait_for ;
341	let%bind frontier =
342	create_root_frontier ~logger ~pids Test_genesis_ledger.accounts
343	in
344	let%bind () =
345	build_frontier_randomly frontier
346	~gen_root_breadcrumb_builder:
347	(gen_linear_breadcrumbs ~logger ~pids ~trust_system
348	~size:num_breadcrumbs
349	~accounts_with_secret_keys:Test_genesis_ledger.accounts)
350	in
351	let seen_transition =
352	Transition_frontier.(
353	all_breadcrumbs frontier \|> List.permute \|> List.hd_exn
354	\|> Breadcrumb.validated_transition)
355	in
356	let observed_state =
357	Mina_block.Validated.protocol_state seen_transition
358	\|> Protocol_state.consensus_state
359	in
360	let root_with_proof =
361	Option.value_exn ~message:"Could not produce an ancestor proof"
362	(Sync_handler.Root.prove ~logger ~frontier observed_state)
363	in
364	let%bind verify =
365	f_with_verifier ~f:Sync_handler.Root.verify ~logger ~pids
366	in
367	let%map `Root (root_transition, _), `Best_tip (best_tip_transition, _)
368	=
369	verify observed_state root_with_proof \|> Deferred.Or_error.ok_exn
370	in
371	heartbeat_flag := false ;
372	Mina_block.(
373	equal
374	(With_hash.data root_transition)
375	(to_external_transition (Transition_frontier.root frontier))
376	&& equal
377	(With_hash.data best_tip_transition)
378	(to_external_transition
379	(Transition_frontier.best_tip frontier))) )
380	end )
381	*)

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