MinaProtocol / mina / 820

Committed 17 Nov 2025 08:58AM UTC coverage: 37.322% (-1.6%) from 38.943%

Build # 820

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #18121 from MinaProtocol/lyh/compat-into-dev-nov17-2025

Compatible into develop Nov17th 2025

Run Details

82 of 261 new or added lines in 23 files covered. (31.42%)

1312 existing lines in 63 files now uncovered.

27536 of 73780 relevant lines covered (37.32%)

51720.0 hits per line

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

50.71

/src/lib/transition_frontier/persistent_root/persistent_root.ml

open Core
open Mina_base
module Ledger = Mina_ledger.Ledger
open Frontier_base
module Ledger_transfer_any =
  Mina_ledger.Ledger_transfer.Make (Ledger.Any_ledger.M) (Ledger.Any_ledger.M)
module Root_ledger = Mina_ledger.Root

let with_file ?size filename access_level ~f =
  let open Unix in
  let shared, mode =
    match access_level with
    | `Read ->
        (false, [ O_RDONLY ])
    | `Write ->
        (true, [ O_RDWR; O_TRUNC; O_CREAT ])
  in
  let fd = Unix.openfile filename ~mode in
  let buf_size =
    match size with
    | None ->
        Int64.to_int_exn Unix.(fstat fd).st_size
    | Some sz ->
        sz
  in
  (* Bigstring.map_file has been removed. We copy its old implementation. *)
  let buf =
    Bigarray.(
      array1_of_genarray
        (Core.Unix.map_file fd char c_layout ~shared [| buf_size |]))
  in
  let x = f buf in
  Bigstring.unsafe_destroy buf ;
  Unix.close fd ;
  x

(* TODO: create a reusable singleton factory abstraction *)
module rec Instance_type : sig
  type t =
    { snarked_ledger : Root_ledger.t
    ; potential_snarked_ledgers : Root_ledger.Config.t Queue.t
    ; factory : Factory_type.t
    }
end =
  Instance_type

and Factory_type : sig
  type t =
    { directory : string
    ; logger : Logger.t
    ; mutable instance : Instance_type.t option
    ; ledger_depth : int
    ; backing_type : Root_ledger.Config.backing_type
    }
end =
  Factory_type

open Instance_type
open Factory_type

module Config = struct
  (** Helper to create a filesystem location (for a file or directory) inside
        the [Factory_type.t] directory. *)
  let make_instance_location filename t = Filename.concat t.directory filename

  (** Helper to create a [Root_ledger.Config.t] for a snarked ledger based on a
        subdirectory of the [Factory_type.t] directory *)
  let make_instance_config subdirectory t =
    Root_ledger.Config.with_directory ~backing_type:t.backing_type
      ~directory_name:(make_instance_location subdirectory t)

  (** The config for the actual snarked ledger that is initialized and used by
        the daemon *)
  let snarked_ledger = make_instance_config "snarked_ledger"

  (** The config for the temporary snarked ledger, used while recovering a
        vaild potential snarked ledger during startup *)
  let tmp_snarked_ledger = make_instance_config "tmp_snarked_ledger"

  (** The name of a json file that lists the directory names of the potential
        snarked ledgers in the [potential_snarked_ledgers] queue *)
  let potential_snarked_ledgers =
    make_instance_location "potential_snarked_ledgers.json"

  (** A method that generates fresh potential snarked ledger configs, each
        using a distinct root subdirectory *)
  let make_potential_snarked_ledger t =
    let uuid = Uuid_unix.create () in
    make_instance_config ("snarked_ledger" ^ Uuid.to_string_hum uuid) t

  (** The name of the file recording the [Root_identifier.t] of the snarked
        root *)
  let root_identifier = make_instance_location "root"
end

module Instance = struct
  type t = Instance_type.t

  (* There is a breaking change in the (Yojson) schema for the Mesa HF ledger
     config type -- previously a list of directories (ie strings), it became
     a list of objects. This loader is compatible with both for the awkward
     period when we don't everyone is running a post-Mesa build.
  *)
  let potential_snarked_ledgers_to_yojson queue =
    `List
      (List.map (Queue.to_list queue) ~f:(fun cfg ->
           `String (Root_ledger.Config.primary_directory cfg) ) )

  (* See comment for potential_snarked_ledgers_to_yojson above *)
  let potential_snarked_ledgers_of_yojson json =
    Yojson.Safe.Util.to_list json
    |> List.map ~f:(fun json ->
           match json with
           | `String directory_name ->
               Root_ledger.Config.with_directory
                 ~backing_type:Root_ledger.Config.Stable_db ~directory_name
           | _ ->
               Root_ledger.Config.of_yojson json |> Result.ok_or_failwith )

  let load_potential_snarked_ledgers_from_disk factory =
    let location = Config.potential_snarked_ledgers factory in
    if phys_equal (Sys.file_exists location) `Yes then
      Yojson.Safe.from_file location |> potential_snarked_ledgers_of_yojson
    else []

  let write_potential_snarked_ledgers_to_disk t =
    Yojson.Safe.to_file
      (Config.potential_snarked_ledgers t.factory)
      (potential_snarked_ledgers_to_yojson t.potential_snarked_ledgers)

  let enqueue_snarked_ledger ~config t =
    Queue.enqueue t.potential_snarked_ledgers config ;
    write_potential_snarked_ledgers_to_disk t

  let dequeue_snarked_ledger t =
    let config = Queue.dequeue_exn t.potential_snarked_ledgers in
    Root_ledger.Config.delete_any_backing config ;
    write_potential_snarked_ledgers_to_disk t

  let destroy t =
    List.iter
      (Queue.to_list t.potential_snarked_ledgers)
      ~f:Root_ledger.Config.delete_any_backing ;
    Mina_stdlib_unix.File_system.rmrf
      (Config.potential_snarked_ledgers t.factory) ;
    Root_ledger.close t.snarked_ledger ;
    t.factory.instance <- None

  let close t =
    Root_ledger.close t.snarked_ledger ;
    t.factory.instance <- None

  let create ~logger factory =
    let snarked_ledger =
      Root_ledger.create ~logger ~depth:factory.ledger_depth
        ~config:(Config.snarked_ledger factory)
        ()
    in
    { snarked_ledger; potential_snarked_ledgers = Queue.create (); factory }

  (** When we load from disk,
      1. Check the potential_snarked_ledgers to see if any one of these
         matches the snarked_ledger_hash in persistent_frontier;
      2. if none of those works, we load the old snarked_ledger and check if
         the old snarked_ledger matches with persistent_frontier;
      3. if not, we just reset all the persisted data and start from genesis
   *)
  let load_from_disk factory ~snarked_ledger_hash ~logger =
    let potential_snarked_ledgers =
      load_potential_snarked_ledgers_from_disk factory
    in
    let snarked_ledger =
      List.fold_until potential_snarked_ledgers ~init:None
        ~f:(fun _ config ->
          let potential_snarked_ledger =
            Root_ledger.create ~logger ~depth:factory.ledger_depth ~config ()
          in
          let potential_snarked_ledger_hash =
            Frozen_ledger_hash.of_ledger_hash
            @@ Root_ledger.merkle_root potential_snarked_ledger
          in
          [%log debug]
            ~metadata:
              [ ( "potential_snarked_ledger_hash"
                , Frozen_ledger_hash.to_yojson potential_snarked_ledger_hash )
              ]
            "loaded potential_snarked_ledger from disk" ;
          if
            Frozen_ledger_hash.equal potential_snarked_ledger_hash
              snarked_ledger_hash
          then (
            let snarked_ledger =
              Root_ledger.create ~logger ~depth:factory.ledger_depth
                ~config:(Config.tmp_snarked_ledger factory)
                ()
            in
            match
              Ledger_transfer_any.transfer_accounts
                ~src:(Root_ledger.as_unmasked potential_snarked_ledger)
                ~dest:(Root_ledger.as_unmasked snarked_ledger)
            with
            | Ok _ ->
                Root_ledger.close potential_snarked_ledger ;
                Root_ledger.Config.delete_any_backing
                @@ Config.snarked_ledger factory ;
                Root_ledger.Config.move_backing_exn
                  ~src:(Config.tmp_snarked_ledger factory)
                  ~dst:(Config.snarked_ledger factory) ;
                List.iter potential_snarked_ledgers
                  ~f:Root_ledger.Config.delete_any_backing ;
                Mina_stdlib_unix.File_system.rmrf
                  (Config.potential_snarked_ledgers factory) ;
                Stop (Some snarked_ledger)
            | Error e ->
                Root_ledger.close potential_snarked_ledger ;
                List.iter potential_snarked_ledgers
                  ~f:Root_ledger.Config.delete_any_backing ;
                Mina_stdlib_unix.File_system.rmrf
                  (Config.potential_snarked_ledgers factory) ;
                [%log' error factory.logger]
                  ~metadata:[ ("error", `String (Error.to_string_hum e)) ]
                  "Ledger_transfer failed" ;
                Stop None )
          else (
            Root_ledger.close potential_snarked_ledger ;
            Continue None ) )
        ~finish:(fun _ ->
          List.iter potential_snarked_ledgers
            ~f:Root_ledger.Config.delete_any_backing ;
          Mina_stdlib_unix.File_system.rmrf
            (Config.potential_snarked_ledgers factory) ;
          None )
    in
    match snarked_ledger with
    | None ->
        let snarked_ledger =
          Root_ledger.create ~logger ~depth:factory.ledger_depth
            ~config:(Config.snarked_ledger factory)
            ()
        in
        let potential_snarked_ledger_hash =
          Frozen_ledger_hash.of_ledger_hash
          @@ Root_ledger.merkle_root snarked_ledger
        in
        if
          Frozen_ledger_hash.equal potential_snarked_ledger_hash
            snarked_ledger_hash
        then
          Ok
            { snarked_ledger
            ; potential_snarked_ledgers = Queue.create ()
            ; factory
            }
        else (
          Root_ledger.close snarked_ledger ;
          Error `Snarked_ledger_mismatch )
    | Some snarked_ledger ->
        Ok
          { snarked_ledger
          ; potential_snarked_ledgers = Queue.create ()
          ; factory
          }

  let snarked_ledger { snarked_ledger; _ } = snarked_ledger
end

type t = Factory_type.t

let create ~logger ~directory ~backing_type ~ledger_depth =
  { directory; logger; instance = None; ledger_depth; backing_type }

let create_instance_exn t =
  assert (Option.is_none t.instance) ;
  let instance = Instance.create ~logger:t.logger t in
  t.instance <- Some instance ;
  instance

let load_from_disk_exn t ~snarked_ledger_hash ~logger =
  let open Result.Let_syntax in
  assert (Option.is_none t.instance) ;
  let%map instance = Instance.load_from_disk t ~snarked_ledger_hash ~logger in
  t.instance <- Some instance ;
  instance

let with_instance_exn t ~f =
  let instance = create_instance_exn t in
  let x = f instance in
  Instance.close instance ; x

let set_root_identifier t new_root_identifier =
  [%log' trace t.logger]
    ~metadata:
      [ ("root_identifier", Root_identifier.to_yojson new_root_identifier) ]
    "Setting persistent root identifier" ;
  let size = Root_identifier.Stable.Latest.bin_size_t new_root_identifier in
  with_file (Config.root_identifier t) `Write ~size ~f:(fun buf ->
      ignore
        ( Root_identifier.Stable.Latest.bin_write_t buf ~pos:0
            new_root_identifier
          : int ) )

(* defaults to genesis *)
let load_root_identifier t =
  let file = Config.root_identifier t in
  match Unix.access file [ `Exists; `Read ] with
  | Error _ ->
      None
  | Ok () ->
      with_file file `Read ~f:(fun buf ->
          let root_identifier =
            Root_identifier.Stable.Latest.bin_read_t buf ~pos_ref:(ref 0)
          in
          [%log' trace t.logger]
            ~metadata:
              [ ("root_identifier", Root_identifier.to_yojson root_identifier) ]
            "Loaded persistent root identifier" ;
          Some root_identifier )

let set_root_state_hash t state_hash = set_root_identifier t { state_hash }

(** Clear the factory directory and recreate the snarked ledger instance for
    this factory with [create_root] and [setup] *)
let reset_factory_root_exn t ~create_root ~root_state_hash =
  let open Async.Deferred.Let_syntax in
  assert (Option.is_none t.instance) ;
  (* Certain database initialization methods, e.g. creation from a checkpoint,
     depend on the parent directory existing and the target directory _not_
     existing. *)
  let%bind () = Mina_stdlib_unix.File_system.remove_dir t.directory in
  let%map () = Mina_stdlib_unix.File_system.create_dir t.directory in
  let root =
    create_root ~config:(Config.snarked_ledger t) ~depth:t.ledger_depth ()
    |> Or_error.ok_exn
  in
  Root_ledger.close root ;
  set_root_state_hash t root_state_hash

let reset_to_genesis_exn t ~precomputed_values =
  let open Async.Deferred.Let_syntax in
  let logger = t.logger in
  [%log debug] "Resetting snarked_root in $directory to genesis"
    ~metadata:[ ("directory", `String t.directory) ] ;
  let%map () =
    reset_factory_root_exn t
      ~create_root:(Precomputed_values.create_root precomputed_values)
      ~root_state_hash:
        (Precomputed_values.genesis_state_hashes precomputed_values).state_hash
  in
  [%log debug] "Finished resetting snarked_root to genesis"

1	open Core	131✔
2	open Mina_base
3	module Ledger = Mina_ledger.Ledger
4	open Frontier_base
5	module Ledger_transfer_any =
6	Mina_ledger.Ledger_transfer.Make (Ledger.Any_ledger.M) (Ledger.Any_ledger.M)
7	module Root_ledger = Mina_ledger.Root
8
9	let with_file ?size filename access_level ~f =
10	let open Unix in	20✔
11	let shared, mode =
12	match access_level with
13	\| `Read ->	10✔
14	(false, [ O_RDONLY ])
15	\| `Write ->	10✔
16	(true, [ O_RDWR; O_TRUNC; O_CREAT ])
17	in
18	let fd = Unix.openfile filename ~mode in
19	let buf_size =	20✔
20	match size with
21	\| None ->	10✔
22	Int64.to_int_exn Unix.(fstat fd).st_size	10✔
23	\| Some sz ->	10✔
24	sz
25	in
26	(* Bigstring.map_file has been removed. We copy its old implementation. *)
27	let buf =
28	Bigarray.(
29	array1_of_genarray	20✔
30	(Core.Unix.map_file fd char c_layout ~shared [\| buf_size \|]))	20✔
31	in
32	let x = f buf in
33	Bigstring.unsafe_destroy buf ;	20✔
34	Unix.close fd ;	20✔
35	x	20✔
36
37	(* TODO: create a reusable singleton factory abstraction *)
38	module rec Instance_type : sig
39	type t =
40	{ snarked_ledger : Root_ledger.t
41	; potential_snarked_ledgers : Root_ledger.Config.t Queue.t
42	; factory : Factory_type.t
43	}
44	end =
45	Instance_type
46
47	and Factory_type : sig
48	type t =
49	{ directory : string
50	; logger : Logger.t
51	; mutable instance : Instance_type.t option
52	; ledger_depth : int
53	; backing_type : Root_ledger.Config.backing_type
54	}
55	end =
56	Factory_type
57
58	open Instance_type
59	open Factory_type
60
61	module Config = struct
62	(** Helper to create a filesystem location (for a file or directory) inside
63	the [Factory_type.t] directory. *)
64	let make_instance_location filename t = Filename.concat t.directory filename	60✔
65
66	(** Helper to create a [Root_ledger.Config.t] for a snarked ledger based on a
67	subdirectory of the [Factory_type.t] directory *)
68	let make_instance_config subdirectory t =
69	Root_ledger.Config.with_directory ~backing_type:t.backing_type	20✔
70	~directory_name:(make_instance_location subdirectory t)	20✔
71
72	(** The config for the actual snarked ledger that is initialized and used by
73	the daemon *)
74	let snarked_ledger = make_instance_config "snarked_ledger"	131✔
75
76	(** The config for the temporary snarked ledger, used while recovering a
77	vaild potential snarked ledger during startup *)
78	let tmp_snarked_ledger = make_instance_config "tmp_snarked_ledger"	131✔
79
80	(** The name of a json file that lists the directory names of the potential
81	snarked ledgers in the [potential_snarked_ledgers] queue *)
82	let potential_snarked_ledgers =
83	make_instance_location "potential_snarked_ledgers.json"	131✔
84
85	(** A method that generates fresh potential snarked ledger configs, each
86	using a distinct root subdirectory *)
87	let make_potential_snarked_ledger t =
NEW 88	let uuid = Uuid_unix.create () in	×
NEW 89	make_instance_config ("snarked_ledger" ^ Uuid.to_string_hum uuid) t	×
90
91	(** The name of the file recording the [Root_identifier.t] of the snarked
92	root *)
93	let root_identifier = make_instance_location "root"	131✔
94	end
95
96	module Instance = struct
97	type t = Instance_type.t
98
99	(* There is a breaking change in the (Yojson) schema for the Mesa HF ledger
100	config type -- previously a list of directories (ie strings), it became
101	a list of objects. This loader is compatible with both for the awkward
102	period when we don't everyone is running a post-Mesa build.
103	*)
104	let potential_snarked_ledgers_to_yojson queue =
NEW 105	`List	×
NEW 106	(List.map (Queue.to_list queue) ~f:(fun cfg ->	×
NEW 107	`String (Root_ledger.Config.primary_directory cfg) ) )	×
108
109	(* See comment for potential_snarked_ledgers_to_yojson above *)
110	let potential_snarked_ledgers_of_yojson json =
111	Yojson.Safe.Util.to_list json	×
112	\|> List.map ~f:(fun json ->
NEW 113	match json with	×
NEW 114	\| `String directory_name ->	×
115	Root_ledger.Config.with_directory
116	~backing_type:Root_ledger.Config.Stable_db ~directory_name
NEW 117	\| _ ->	×
NEW 118	Root_ledger.Config.of_yojson json \|> Result.ok_or_failwith )	×
119
120	let load_potential_snarked_ledgers_from_disk factory =
121	let location = Config.potential_snarked_ledgers factory in	10✔
122	if phys_equal (Sys.file_exists location) `Yes then	10✔
123	Yojson.Safe.from_file location \|> potential_snarked_ledgers_of_yojson	×
124	else []	10✔
125
126	let write_potential_snarked_ledgers_to_disk t =
127	Yojson.Safe.to_file	×
128	(Config.potential_snarked_ledgers t.factory)	×
129	(potential_snarked_ledgers_to_yojson t.potential_snarked_ledgers)	×
130
131	let enqueue_snarked_ledger ~config t =
132	Queue.enqueue t.potential_snarked_ledgers config ;	×
133	write_potential_snarked_ledgers_to_disk t	×
134
135	let dequeue_snarked_ledger t =
136	let config = Queue.dequeue_exn t.potential_snarked_ledgers in	×
137	Root_ledger.Config.delete_any_backing config ;	×
138	write_potential_snarked_ledgers_to_disk t	×
139
140	let destroy t =
141	List.iter	×
142	(Queue.to_list t.potential_snarked_ledgers)	×
143	~f:Root_ledger.Config.delete_any_backing ;
144	Mina_stdlib_unix.File_system.rmrf	×
145	(Config.potential_snarked_ledgers t.factory) ;	×
146	Root_ledger.close t.snarked_ledger ;	×
147	t.factory.instance <- None	×
148
149	let close t =
UNCOV 150	Root_ledger.close t.snarked_ledger ;	×
UNCOV 151	t.factory.instance <- None	×
152
153	let create ~logger factory =
UNCOV 154	let snarked_ledger =	×
155	Root_ledger.create ~logger ~depth:factory.ledger_depth
UNCOV 156	~config:(Config.snarked_ledger factory)	×
157	()
158	in
UNCOV 159	{ snarked_ledger; potential_snarked_ledgers = Queue.create (); factory }	×
160
161	(** When we load from disk,
162	1. Check the potential_snarked_ledgers to see if any one of these
163	matches the snarked_ledger_hash in persistent_frontier;
164	2. if none of those works, we load the old snarked_ledger and check if
165	the old snarked_ledger matches with persistent_frontier;
166	3. if not, we just reset all the persisted data and start from genesis
167	*)
168	let load_from_disk factory ~snarked_ledger_hash ~logger =
169	let potential_snarked_ledgers =	10✔
170	load_potential_snarked_ledgers_from_disk factory
171	in
172	let snarked_ledger =	10✔
173	List.fold_until potential_snarked_ledgers ~init:None
174	~f:(fun _ config ->
175	let potential_snarked_ledger =	×
176	Root_ledger.create ~logger ~depth:factory.ledger_depth ~config ()
177	in
178	let potential_snarked_ledger_hash =	×
179	Frozen_ledger_hash.of_ledger_hash
180	@@ Root_ledger.merkle_root potential_snarked_ledger	×
181	in
182	[%log debug]	×
183	~metadata:
184	[ ( "potential_snarked_ledger_hash"
185	, Frozen_ledger_hash.to_yojson potential_snarked_ledger_hash )	×
186	]
187	"loaded potential_snarked_ledger from disk" ;
188	if	×
189	Frozen_ledger_hash.equal potential_snarked_ledger_hash
190	snarked_ledger_hash
191	then (	×
192	let snarked_ledger =
193	Root_ledger.create ~logger ~depth:factory.ledger_depth
194	~config:(Config.tmp_snarked_ledger factory)	×
195	()
196	in
197	match	×
198	Ledger_transfer_any.transfer_accounts
199	~src:(Root_ledger.as_unmasked potential_snarked_ledger)	×
200	~dest:(Root_ledger.as_unmasked snarked_ledger)	×
201	with
202	\| Ok _ ->	×
203	Root_ledger.close potential_snarked_ledger ;
204	Root_ledger.Config.delete_any_backing	×
205	@@ Config.snarked_ledger factory ;	×
206	Root_ledger.Config.move_backing_exn	×
207	~src:(Config.tmp_snarked_ledger factory)	×
208	~dst:(Config.snarked_ledger factory) ;	×
209	List.iter potential_snarked_ledgers
210	~f:Root_ledger.Config.delete_any_backing ;
211	Mina_stdlib_unix.File_system.rmrf	×
212	(Config.potential_snarked_ledgers factory) ;	×
213	Stop (Some snarked_ledger)	×
214	\| Error e ->	×
215	Root_ledger.close potential_snarked_ledger ;
216	List.iter potential_snarked_ledgers	×
217	~f:Root_ledger.Config.delete_any_backing ;
218	Mina_stdlib_unix.File_system.rmrf	×
219	(Config.potential_snarked_ledgers factory) ;	×
220	[%log' error factory.logger]	×
221	~metadata:[ ("error", `String (Error.to_string_hum e)) ]	×
222	"Ledger_transfer failed" ;
223	Stop None )	×
224	else (	×
225	Root_ledger.close potential_snarked_ledger ;
226	Continue None ) )	×
227	~finish:(fun _ ->
228	List.iter potential_snarked_ledgers	10✔
229	~f:Root_ledger.Config.delete_any_backing ;
230	Mina_stdlib_unix.File_system.rmrf	10✔
231	(Config.potential_snarked_ledgers factory) ;	10✔
232	None )	10✔
233	in
234	match snarked_ledger with	10✔
235	\| None ->	10✔
236	let snarked_ledger =
237	Root_ledger.create ~logger ~depth:factory.ledger_depth
238	~config:(Config.snarked_ledger factory)	10✔
239	()
240	in
241	let potential_snarked_ledger_hash =	10✔
242	Frozen_ledger_hash.of_ledger_hash
243	@@ Root_ledger.merkle_root snarked_ledger	10✔
244	in
245	if	10✔
246	Frozen_ledger_hash.equal potential_snarked_ledger_hash
247	snarked_ledger_hash
248	then
249	Ok	10✔
250	{ snarked_ledger
251	; potential_snarked_ledgers = Queue.create ()	10✔
252	; factory
253	}
254	else (	×
255	Root_ledger.close snarked_ledger ;
256	Error `Snarked_ledger_mismatch )	×
257	\| Some snarked_ledger ->	×
258	Ok
259	{ snarked_ledger
260	; potential_snarked_ledgers = Queue.create ()	×
261	; factory
262	}
263
264	let snarked_ledger { snarked_ledger; _ } = snarked_ledger	55✔
265	end
266
267	type t = Factory_type.t
268
269	let create ~logger ~directory ~backing_type ~ledger_depth =
270	{ directory; logger; instance = None; ledger_depth; backing_type }	10✔
271
272	let create_instance_exn t =
UNCOV 273	assert (Option.is_none t.instance) ;	×
274	let instance = Instance.create ~logger:t.logger t in
UNCOV 275	t.instance <- Some instance ;	×
276	instance
277
278	let load_from_disk_exn t ~snarked_ledger_hash ~logger =
279	let open Result.Let_syntax in	10✔
280	assert (Option.is_none t.instance) ;	10✔
281	let%map instance = Instance.load_from_disk t ~snarked_ledger_hash ~logger in	10✔
282	t.instance <- Some instance ;	10✔
283	instance
284
285	let with_instance_exn t ~f =
UNCOV 286	let instance = create_instance_exn t in	×
UNCOV 287	let x = f instance in	×
UNCOV 288	Instance.close instance ; x	×
289
290	let set_root_identifier t new_root_identifier =
291	[%log' trace t.logger]	10✔
292	~metadata:
293	[ ("root_identifier", Root_identifier.to_yojson new_root_identifier) ]	10✔
294	"Setting persistent root identifier" ;
295	let size = Root_identifier.Stable.Latest.bin_size_t new_root_identifier in	10✔
296	with_file (Config.root_identifier t) `Write ~size ~f:(fun buf ->	10✔
297	ignore	10✔
298	( Root_identifier.Stable.Latest.bin_write_t buf ~pos:0	10✔
299	new_root_identifier
300	: int ) )
301
302	(* defaults to genesis *)
303	let load_root_identifier t =
304	let file = Config.root_identifier t in	10✔
305	match Unix.access file [ `Exists; `Read ] with	10✔
NEW 306	\| Error _ ->	×
307	None
308	\| Ok () ->	10✔
309	with_file file `Read ~f:(fun buf ->
310	let root_identifier =	10✔
311	Root_identifier.Stable.Latest.bin_read_t buf ~pos_ref:(ref 0)
312	in
313	[%log' trace t.logger]	10✔
314	~metadata:
315	[ ("root_identifier", Root_identifier.to_yojson root_identifier) ]	10✔
316	"Loaded persistent root identifier" ;
317	Some root_identifier )	10✔
318
319	let set_root_state_hash t state_hash = set_root_identifier t { state_hash }	10✔
320
321	(** Clear the factory directory and recreate the snarked ledger instance for
322	this factory with [create_root] and [setup] *)
323	let reset_factory_root_exn t ~create_root ~root_state_hash =
324	let open Async.Deferred.Let_syntax in	10✔
325	assert (Option.is_none t.instance) ;	10✔
326	(* Certain database initialization methods, e.g. creation from a checkpoint,
327	depend on the parent directory existing and the target directory _not_
328	existing. *)
329	let%bind () = Mina_stdlib_unix.File_system.remove_dir t.directory in	10✔
330	let%map () = Mina_stdlib_unix.File_system.create_dir t.directory in	10✔
331	let root =	10✔
332	create_root ~config:(Config.snarked_ledger t) ~depth:t.ledger_depth ()	10✔
333	\|> Or_error.ok_exn
334	in
335	Root_ledger.close root ;	10✔
336	set_root_state_hash t root_state_hash	10✔
337
338	let reset_to_genesis_exn t ~precomputed_values =
339	let open Async.Deferred.Let_syntax in	10✔
340	let logger = t.logger in
341	[%log debug] "Resetting snarked_root in $directory to genesis"	10✔
342	~metadata:[ ("directory", `String t.directory) ] ;
343	let%map () =
344	reset_factory_root_exn t	10✔
345	~create_root:(Precomputed_values.create_root precomputed_values)	10✔
346	~root_state_hash:
347	(Precomputed_values.genesis_state_hashes precomputed_values).state_hash	10✔
348	in
349	[%log debug] "Finished resetting snarked_root to genesis"	2✔

MinaProtocol / mina / 820

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