diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 9ae13680a66..83225c8c03e 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -153,7 +153,7 @@ let generate_next_state ~constraint_constants ~previous_protocol_state -> (*staged_ledger remains unchanged and transitioned_staged_ledger is discarded because the external transtion created out of this diff will be applied in Transition_frontier*) ignore - @@ Ledger.unregister_mask_exn + @@ Ledger.unregister_mask_exn ~loc:__LOC__ (Staged_ledger.ledger transitioned_staged_ledger) ; Some ( diff diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index 11e658265b3..71958633689 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -331,7 +331,8 @@ let run ~logger ~trust_system ~verifier ~network ~consensus_local_state ~snarked_ledger:temp_mask ~expected_merkle_root ~pending_coinbases ~get_state in - ignore (Ledger.Maskable.unregister_mask_exn temp_mask) ; + ignore + (Ledger.Maskable.unregister_mask_exn ~loc:__LOC__ temp_mask) ; Result.map result ~f: (const @@ -702,7 +703,9 @@ let%test_module "Bootstrap_controller tests" = Transition_frontier.( Breadcrumb.validated_transition (root my_net.state.frontier)) in - let%bind () = Transition_frontier.close my_net.state.frontier in + let%bind () = + Transition_frontier.close ~loc:__LOC__ my_net.state.frontier + in [%log info] "bootstrap begin" ; Block_time.Timeout.await_exn time_controller ~timeout_duration (run ~logger ~trust_system ~verifier ~network:my_net.network diff --git a/src/lib/coda_base/ledger.ml b/src/lib/coda_base/ledger.ml index 518063dbcaa..ef0d04c3841 100644 --- a/src/lib/coda_base/ledger.ml +++ b/src/lib/coda_base/ledger.ml @@ -212,12 +212,14 @@ module Ledger_inner = struct try let result = f masked_ledger in let (_ : Mask.t) = - Maskable.unregister_mask_exn ~grandchildren:`Recursive masked_ledger + Maskable.unregister_mask_exn ~loc:__LOC__ ~grandchildren:`Recursive + masked_ledger in result with exn -> let (_ : Mask.t) = - Maskable.unregister_mask_exn ~grandchildren:`Recursive masked_ledger + Maskable.unregister_mask_exn ~loc:__LOC__ ~grandchildren:`Recursive + masked_ledger in raise exn @@ -225,7 +227,7 @@ module Ledger_inner = struct let register_mask t mask = Maskable.register_mask (packed t) mask - let unregister_mask_exn mask = Maskable.unregister_mask_exn mask + let unregister_mask_exn ~loc mask = Maskable.unregister_mask_exn ~loc mask let remove_and_reparent_exn t t_as_mask = Maskable.remove_and_reparent_exn (packed t) t_as_mask diff --git a/src/lib/coda_base/ledger.mli b/src/lib/coda_base/ledger.mli index bfbbddfbfe2..94382483e8f 100644 --- a/src/lib/coda_base/ledger.mli +++ b/src/lib/coda_base/ledger.mli @@ -77,7 +77,7 @@ include Merkle_mask.Maskable_merkle_tree_intf.S because at this level callers aren't doing reparenting and shouldn't be able to turn off the check parameter. *) -val unregister_mask_exn : Mask.Attached.t -> Mask.t +val unregister_mask_exn : loc:string -> Mask.Attached.t -> Mask.t (* The maskable ledger is t = Mask.Attached.t because register/unregister * work off of this type *) diff --git a/src/lib/coda_lib/coda_lib.ml b/src/lib/coda_lib/coda_lib.ml index 0cdbbd54599..b710fd19ebb 100644 --- a/src/lib/coda_lib/coda_lib.ml +++ b/src/lib/coda_lib/coda_lib.ml @@ -834,7 +834,7 @@ let create ?wallets (config : Config.t) = | None -> Deferred.unit | Some frontier -> - Transition_frontier.close frontier ) ; + Transition_frontier.close ~loc:__LOC__ frontier ) ; let handle_request name ~f query_env = trace_recurring name (fun () -> let input = Envelope.Incoming.data query_env in diff --git a/src/lib/merkle_ledger_tests/test_mask.ml b/src/lib/merkle_ledger_tests/test_mask.ml index dc07bbe84ce..97f628861af 100644 --- a/src/lib/merkle_ledger_tests/test_mask.ml +++ b/src/lib/merkle_ledger_tests/test_mask.ml @@ -254,7 +254,7 @@ module Make (Test : Test_intf) = struct in try let (_unattached_mask : Mask.t) = - Maskable.unregister_mask_exn attached_mask + Maskable.unregister_mask_exn ~loc:__LOC__ attached_mask in true with Failure _ -> false ) diff --git a/src/lib/merkle_mask/maskable_merkle_tree.ml b/src/lib/merkle_mask/maskable_merkle_tree.ml index f4990d0b13b..96b5edebb3f 100644 --- a/src/lib/merkle_mask/maskable_merkle_tree.ml +++ b/src/lib/merkle_mask/maskable_merkle_tree.ml @@ -36,7 +36,7 @@ module Make (Inputs : Inputs_intf) = struct {hash: string; uuid: string; total_currency: int; num_accounts: int} [@@deriving yojson] - type dangling = {uuid: string} [@@deriving yojson] + type dangling = {uuid: string; nulled_at: string} [@@deriving yojson] type display = [`Attached of attached | `Dangling_parent of dangling] [@@deriving yojson] @@ -65,8 +65,8 @@ module Make (Inputs : Inputs_intf) = struct let display mask = try `Attached (display_attached_mask mask) - with Mask.Attached.Dangling_parent_reference _ -> - `Dangling_parent {uuid= format_uuid mask} + with Mask.Attached.Dangling_parent_reference (_, nulled_at) -> + `Dangling_parent {uuid= format_uuid mask; nulled_at} let equal mask1 mask2 = let open Mask.Attached in @@ -151,7 +151,7 @@ module Make (Inputs : Inputs_intf) = struct Uuid.Table.add_multi registered_masks ~key:(get_uuid t) ~data:attached_mask ; attached_mask - let rec unregister_mask_exn ?(grandchildren = `Check) + let rec unregister_mask_exn ?(grandchildren = `Check) ~loc (mask : Mask.Attached.t) : Mask.unattached = let parent_uuid = Mask.Attached.get_parent mask |> get_uuid in let error_msg suffix = @@ -181,8 +181,9 @@ module Make (Inputs : Inputs_intf) = struct ( Hashtbl.find registered_masks (Mask.Attached.get_uuid mask) |> Option.value ~default:[] ) ~f:(fun child_mask -> - ignore @@ unregister_mask_exn ~grandchildren:`Recursive child_mask - ) ) ; + ignore + @@ unregister_mask_exn ~loc ~grandchildren:`Recursive child_mask ) + ) ; match Uuid.Table.find registered_masks parent_uuid with | None -> failwith @@ error_msg "parent not in registered_masks" @@ -202,7 +203,7 @@ module Make (Inputs : Inputs_intf) = struct | other_masks -> Uuid.Table.set registered_masks ~key:parent_uuid ~data:other_masks ) ) ; - Mask.Attached.unset_parent mask + Mask.Attached.unset_parent ~loc mask (** a set calls the Base implementation set, notifies registered mask childen *) let set t location account = @@ -224,10 +225,10 @@ module Make (Inputs : Inputs_intf) = struct in let dangling_masks = List.map children ~f:(fun c -> - unregister_mask_exn + unregister_mask_exn ~loc:__LOC__ ~grandchildren:`I_promise_I_am_reparenting_this_mask c ) in - ignore (unregister_mask_exn t_as_mask) ; + ignore (unregister_mask_exn ~loc:__LOC__ t_as_mask) ; List.iter dangling_masks ~f:(fun m -> ignore (register_mask parent m)) let batch_notify_mask_children t accounts = diff --git a/src/lib/merkle_mask/maskable_merkle_tree_intf.ml b/src/lib/merkle_mask/maskable_merkle_tree_intf.ml index 67ecd807e09..d5a63687fd0 100644 --- a/src/lib/merkle_mask/maskable_merkle_tree_intf.ml +++ b/src/lib/merkle_mask/maskable_merkle_tree_intf.ml @@ -20,6 +20,7 @@ module type S = sig ?grandchildren:[ `Check | `Recursive | `I_promise_I_am_reparenting_this_mask ] + -> loc:string -> attached_mask -> unattached_mask diff --git a/src/lib/merkle_mask/masking_merkle_tree.ml b/src/lib/merkle_mask/masking_merkle_tree.ml index dcce6567e1a..d42b435af0f 100644 --- a/src/lib/merkle_mask/masking_merkle_tree.ml +++ b/src/lib/merkle_mask/masking_merkle_tree.ml @@ -25,7 +25,8 @@ module Make (Inputs : Inputs_intf.S) = struct attached one. We can capture this with a GADT but there's some annoying issues with bin_io to do so *) module Parent = struct - type t = Base.t option [@@deriving sexp] + type t = (Base.t, string (* Location where null was set *)) Result.t + [@@deriving sexp] end type t = @@ -44,7 +45,7 @@ module Make (Inputs : Inputs_intf.S) = struct let create ~depth () = { uuid= Uuid_unix.create () - ; parent= None + ; parent= Error __LOC__ ; account_tbl= Location_binable.Table.create () ; token_owners= Token_id.Table.create () ; next_available_token= None @@ -78,7 +79,9 @@ module Make (Inputs : Inputs_intf.S) = struct exception Location_is_not_account of Location.t - exception Dangling_parent_reference of Uuid.t + exception + Dangling_parent_reference of + Uuid.t * (* Location where null was set*) string let create () = failwith @@ -90,26 +93,26 @@ module Make (Inputs : Inputs_intf.S) = struct "Mask.Attached.with_ledger: cannot create an attached mask; use \ Mask.create and Mask.set_parent" - let unset_parent t = - assert (Option.is_some t.parent) ; - t.parent <- None ; + let unset_parent ~loc t = + assert (Result.is_ok t.parent) ; + t.parent <- Error loc ; t let assert_is_attached t = match t.parent with - | None -> - raise (Dangling_parent_reference t.uuid) - | Some _ -> + | Error loc -> + raise (Dangling_parent_reference (t.uuid, loc)) + | Ok _ -> () let get_parent ({parent= opt; _} as t) = - assert_is_attached t ; Option.value_exn opt + assert_is_attached t ; Result.ok_or_failwith opt let get_uuid t = assert_is_attached t ; t.uuid let get_directory t = assert_is_attached t ; - Option.bind ~f:Base.get_directory t.parent + Base.get_directory (Result.ok_or_failwith t.parent) let depth t = assert_is_attached t ; t.depth @@ -382,7 +385,7 @@ module Make (Inputs : Inputs_intf.S) = struct (* copy tables in t; use same parent *) let copy t = { uuid= Uuid_unix.create () - ; parent= Some (get_parent t) + ; parent= Ok (get_parent t) ; account_tbl= Location_binable.Table.copy t.account_tbl ; token_owners= Token_id.Table.copy t.token_owners ; next_available_token= t.next_available_token @@ -744,9 +747,9 @@ module Make (Inputs : Inputs_intf.S) = struct end let set_parent t parent = - assert (Option.is_none t.parent) ; + assert (Result.is_error t.parent) ; assert (Int.equal t.depth (Base.depth parent)) ; - t.parent <- Some parent ; + t.parent <- Ok parent ; t.current_location <- Attached.last_filled t ; t diff --git a/src/lib/merkle_mask/masking_merkle_tree_intf.ml b/src/lib/merkle_mask/masking_merkle_tree_intf.ml index a8c7efcf7a2..45e64ff077e 100644 --- a/src/lib/merkle_mask/masking_merkle_tree_intf.ml +++ b/src/lib/merkle_mask/masking_merkle_tree_intf.ml @@ -46,7 +46,9 @@ module type S = sig and type account_id := account_id and type account_id_set := account_id_set - exception Dangling_parent_reference of Uuid.t + exception + Dangling_parent_reference of + Uuid.t * (* Location where null was set*) string (** get hash from mask, if present, else from its parent *) val get_hash : t -> Addr.t -> hash option @@ -55,7 +57,7 @@ module type S = sig val commit : t -> unit (** remove parent *) - val unset_parent : t -> unattached + val unset_parent : loc:string -> t -> unattached (** get mask parent *) val get_parent : t -> parent diff --git a/src/lib/staged_ledger/staged_ledger.ml b/src/lib/staged_ledger/staged_ledger.ml index 9a3231b9af6..5e508af7fd0 100644 --- a/src/lib/staged_ledger/staged_ledger.ml +++ b/src/lib/staged_ledger/staged_ledger.ml @@ -1926,7 +1926,8 @@ let%test_module "test" = in let sl = ref @@ Sl.create_exn ~constraint_constants ~ledger in Async.Thread_safe.block_on_async_exn (fun () -> f sl test_mask) ; - ignore @@ Ledger.Maskable.unregister_mask_exn test_mask ) + ignore @@ Ledger.Maskable.unregister_mask_exn ~loc:__LOC__ test_mask + ) (* Assert the given staged ledger is in the correct state after applying the first n user commands passed to the given base ledger. Checks the diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 2fba15a16bd..5bd3411ca10 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -96,10 +96,10 @@ let protocol_states_for_root_scan_state t = let best_tip t = find_exn t t.best_tip -let close t = +let close ~loc t = Coda_metrics.(Gauge.set Transition_frontier.active_breadcrumbs 0.0) ; ignore - (Ledger.Maskable.unregister_mask_exn ~grandchildren:`Recursive + (Ledger.Maskable.unregister_mask_exn ~loc ~grandchildren:`Recursive (Breadcrumb.mask (root t))) let create ~logger ~root_data ~root_ledger ~consensus_local_state ~max_length @@ -385,7 +385,7 @@ let move_root t ~new_root_hash ~new_root_protocol_states ~garbage let breadcrumb = find_exn t hash in let mask = Breadcrumb.mask breadcrumb in (* this should get garbage collected and should not require additional destruction *) - ignore (Ledger.Maskable.unregister_mask_exn mask) ; + ignore (Ledger.Maskable.unregister_mask_exn ~loc:__LOC__ mask) ; Hashtbl.remove t.table hash ) ; (* STEP 2 *) (* go ahead and remove the old root from the frontier *) @@ -440,7 +440,7 @@ let move_root t ~new_root_hash ~new_root_protocol_states ~garbage (* STEP 6 *) Ledger.commit mt ; (* STEP 7 *) - ignore (Ledger.Maskable.unregister_mask_exn mt) ) ; + ignore (Ledger.Maskable.unregister_mask_exn ~loc:__LOC__ mt) ) ; new_staged_ledger in (* rewrite the new root breadcrumb to contain the new root mask *) diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.mli b/src/lib/transition_frontier/full_frontier/full_frontier.mli index 39daf0e3b24..525aaa38cae 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.mli +++ b/src/lib/transition_frontier/full_frontier/full_frontier.mli @@ -34,7 +34,7 @@ val create : -> precomputed_values:Precomputed_values.t -> t -val close : t -> unit +val close : loc:string -> t -> unit val root_data : t -> Root_data.t diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index a865de9a0fc..b2ce32033c1 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -249,7 +249,7 @@ let load ?(retry_with_fresh_db = true) ~logger ~verifier ~consensus_local_state (* The persistent root and persistent frontier as safe to ignore here * because their lifecycle is longer than the transition frontier's *) -let close +let close ~loc { logger ; verifier= _ ; consensus_local_state= _ @@ -261,7 +261,7 @@ let close ; extensions ; genesis_state_hash= _ } = [%log trace] "Closing transition frontier" ; - Full_frontier.close full_frontier ; + Full_frontier.close ~loc full_frontier ; Extensions.close extensions ; let%map () = Persistent_frontier.Instance.destroy persistent_frontier_instance diff --git a/src/lib/transition_frontier/transition_frontier.mli b/src/lib/transition_frontier/transition_frontier.mli index a3d3fa87398..f2b8fbc700b 100644 --- a/src/lib/transition_frontier/transition_frontier.mli +++ b/src/lib/transition_frontier/transition_frontier.mli @@ -45,7 +45,7 @@ val load : | `Persistent_frontier_malformed ] ) Deferred.Result.t -val close : t -> unit Deferred.t +val close : loc:string -> t -> unit Deferred.t val add_breadcrumb_exn : t -> Breadcrumb.t -> unit Deferred.t diff --git a/src/lib/transition_router/transition_router.ml b/src/lib/transition_router/transition_router.ml index 9464b557576..77d4c2440f5 100644 --- a/src/lib/transition_router/transition_router.ml +++ b/src/lib/transition_router/transition_router.ml @@ -306,7 +306,7 @@ let initialize ~logger ~network ~is_seed ~is_demo_mode ~verifier ~trust_system let initial_root_transition = Transition_frontier.(Breadcrumb.validated_transition (root frontier)) in - let%map () = Transition_frontier.close frontier in + let%map () = Transition_frontier.close ~loc:__LOC__ frontier in start_bootstrap_controller ~logger ~trust_system ~verifier ~network ~time_controller ~producer_transition_reader_ref ~producer_transition_writer_ref ~verified_transition_writer @@ -501,7 +501,9 @@ let run ~logger ~trust_system ~verifier ~network ~is_seed ~is_demo_mode let%bind () = Strict_pipe.Writer.write clear_writer `Clear in - let%map () = Transition_frontier.close frontier in + let%map () = + Transition_frontier.close ~loc:__LOC__ frontier + in start_bootstrap_controller ~logger ~trust_system ~verifier ~network ~time_controller ~producer_transition_reader_ref