From d96eb19fdb24246a432b7402cdfb0bca9b2341b0 Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Thu, 19 Sep 2024 10:04:55 -0300 Subject: [PATCH 01/34] wide merkle query --- src/lib/syncable_ledger/syncable_ledger.ml | 139 ++++++++++++++++++++- 1 file changed, 135 insertions(+), 4 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 44f1f972064..573dd424314 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -23,6 +23,10 @@ module Query = struct | Num_accounts (** How many accounts are there? Used to size data structure and figure out what part of the tree is filled in. *) + | Subtree of 'addr + (** What are the 2^k nodes at depth k from the given prefix + address **) + (* TODO: Properly handle versioning *) [@@deriving sexp, yojson, hash, compare] end end] @@ -40,6 +44,8 @@ module Answer = struct | Num_accounts of int * 'hash (** There are this many accounts and the smallest subtree that contains all non-empty nodes has this hash. *) + | Subtree of 'hash list + (* TODO: Properly handle versioning *) [@@deriving sexp, yojson] let to_latest acct_to_latest = function @@ -49,6 +55,9 @@ module Answer = struct Contents_are (List.map ~f:acct_to_latest accts) | Num_accounts (i, h) -> Num_accounts (i, h) + | Subtree nodes -> + Subtree (List.map ~f:acct_to_latest nodes) + (* TODO: Properly handle versioning *) end end] end @@ -340,7 +349,13 @@ end = struct Either.First (Num_accounts (len, MT.get_inner_hash_at_addr_exn mt content_root_addr) ) + | Subtree a -> + (* TODO:giving error for now *) + Either.Second + ( Actions.Violated_protocol + , Some ("Error: $addr", [ ("addr", Addr.to_yojson a) ]) ) in + match response_or_punish with | Either.First answer -> Deferred.return @@ Some answer @@ -403,6 +418,17 @@ end = struct "Expecting content addr $address, expected: $hash" ; Addr.Table.add_exn t.waiting_content ~key:addr ~data:expected + (* Expects for a subtree with root at the given address *) + let expect_subtree : 'a t -> Addr.t -> Hash.t -> unit = + fun t parent_addr expected -> + [%log' trace t.logger] + ~metadata: + [ ("subtree prefix address", Addr.to_yojson parent_addr) + ; ("hash", Hash.to_yojson expected) + ] + "Expecting subtree at address $parent_address, expected: $hash" ; + Addr.Table.add_exn t.waiting_parents ~key:parent_addr ~data:expected + (** Given an address and the accounts below that address, fill in the tree with them. *) let add_content : @@ -427,6 +453,81 @@ end = struct if Hash.equal actual expected then `Success else `Hash_mismatch (expected, actual) + (* Provides addresses at an specific depth from this address *) + let rec intermediate_range : Addr.t -> index -> Addr.t list = + fun addr i -> + match i with + | 0 -> + [ addr ] + | i -> + let left, right = + Option.value_exn + ( Or_error.ok + @@ Or_error.both + (* TODO:use proper depth *) + (Addr.child ~ledger_depth:5 addr Direction.Left) + (Addr.child ~ledger_depth:5 addr Direction.Right) ) + in + let left = intermediate_range left (i - 1) in + let right = intermediate_range right (i - 1) in + left @ right + + (* Merges each 2 contigous nodes, halving the size of the list *) + let rec merge_siblings : Hash.t list -> Hash.t list = + (* TODO: domain separation *) + fun nodes -> + match nodes with + | [ l; r ] -> + [ Hash.merge ~height:5 l r ] + | l :: r :: rest -> + Hash.merge ~height:5 l r :: merge_siblings rest + | _ -> + (* TODO: give some error as this shouldn't really happen *) + [] + + (* Assumes nodes to be a power of 2 and merges them into their common root *) + (* TODO:domain separation *) + let rec merge_many : Hash.t list -> Hash.t = + fun nodes -> + match nodes with + | [ single ] -> + single + | many -> + let half = merge_siblings many in + merge_many half + + (* Adds the subtree given as the 2^k subtree leaves with the given prefix address *) + (* Returns next nodes to be checked *) + let add_subtree : + 'a t + -> Addr.t + -> Hash.t list + -> [ `Good of (Addr.t * Hash.t) list | `Hash_mismatch of Hash.t * Hash.t ] + = + fun t addr nodes -> + let prefix_depth = Addr.depth addr in + let expected = + Option.value_exn ~message:"Forgot to wait for a node" + (Addr.Table.find t.waiting_parents addr) + in + let merged = merge_many nodes in + if Hash.equal expected merged then ( + Addr.Table.remove t.waiting_parents addr ; + (* TODO: parameterize *) + let addresses = intermediate_range addr 5 in + let addresses_and_hashes = List.(zip_exn addresses nodes) in + + (* Filter to fetch only those that differ *) + let should_fetch_children addr hash = + not @@ Hash.equal (MT.get_inner_hash_at_addr_exn t.tree addr) hash + in + let subtrees_to_fetch = + addresses_and_hashes + |> List.filter ~f:(Tuple2.uncurry should_fetch_children) + in + `Good subtrees_to_fetch ) + else `Hash_mismatch (expected, merged) + (** Given an address and the hashes of the children of the corresponding node, check the children hash to the expected value. If they do, queue the children for retrieval if the values in the underlying ledger don't match @@ -509,10 +610,22 @@ end = struct expect_content t addr exp_hash ; Linear_pipe.write_without_pushback_if_open t.queries (desired_root_exn t, What_contents addr) ) - else ( - expect_children t addr exp_hash ; - Linear_pipe.write_without_pushback_if_open t.queries - (desired_root_exn t, What_child_hashes addr) ) + else + let account_subtree_depth = MT.depth t.tree - account_subtree_height in + let depth_to_account_subtree = account_subtree_depth - Addr.depth addr in + + (* If distance to the account subtree is big enough, use wide queries, + if not just request the next 2 children *) + (* TODO: parameterize depth *) + if depth_to_account_subtree >= 5 then ( + expect_subtree t addr exp_hash ; + Linear_pipe.write_without_pushback_if_open t.queries + (* TODO: verify purpose of sending the root *) + (desired_root_exn t, Subtree addr) ) + else ( + expect_children t addr exp_hash ; + Linear_pipe.write_without_pushback_if_open t.queries + (desired_root_exn t, What_child_hashes addr) ) (** Handle the initial Num_accounts message, starting the main syncing process. *) @@ -644,6 +757,24 @@ end = struct ] ) ) in requeue_query () ) + | Query.Subtree address, Answer.Subtree hashes -> ( + match add_subtree t address hashes with + | `Hash_mismatch (expected, actual) -> + let%map () = + record_envelope_sender t.trust_system t.logger sender + ( Actions.Sent_bad_hash + , Some + ( "hashes sent for subtree on address $address merge \ + to $actualmerge but we expected $expectedmerge" + , [ ("actualmerge", Hash.to_yojson actual) + ; ("expectedmerge", Hash.to_yojson expected) + ] ) ) + in + requeue_query () + | `Good children_to_verify -> + List.iter children_to_verify ~f:(fun (addr, hash) -> + handle_node t addr hash ) ; + credit_fulfilled_request () ) | query, answer -> let%map () = record_envelope_sender t.trust_system t.logger sender From cc3d2bfb294a9da1b6db80db44a202a29b6b1dc8 Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Thu, 19 Sep 2024 10:21:03 -0300 Subject: [PATCH 02/34] missing comment --- src/lib/syncable_ledger/syncable_ledger.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 573dd424314..0a0098d006f 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -27,6 +27,8 @@ module Query = struct (** What are the 2^k nodes at depth k from the given prefix address **) (* TODO: Properly handle versioning *) + (* TODO: Consider additional query to verify subtree suport, for + softfork compatibility *) [@@deriving sexp, yojson, hash, compare] end end] @@ -418,7 +420,7 @@ end = struct "Expecting content addr $address, expected: $hash" ; Addr.Table.add_exn t.waiting_content ~key:addr ~data:expected - (* Expects for a subtree with root at the given address *) + (* Waits for a subtree with root at the given address *) let expect_subtree : 'a t -> Addr.t -> Hash.t -> unit = fun t parent_addr expected -> [%log' trace t.logger] @@ -505,7 +507,7 @@ end = struct -> [ `Good of (Addr.t * Hash.t) list | `Hash_mismatch of Hash.t * Hash.t ] = fun t addr nodes -> - let prefix_depth = Addr.depth addr in + (* let prefix_depth = Addr.depth addr in *) let expected = Option.value_exn ~message:"Forgot to wait for a node" (Addr.Table.find t.waiting_parents addr) From c29b3f1f5ab6ccc463d6b6af06120088551b83e8 Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Thu, 19 Sep 2024 11:44:23 -0300 Subject: [PATCH 03/34] proper depth on range --- src/lib/syncable_ledger/syncable_ledger.ml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 0a0098d006f..c9647bd8886 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -456,8 +456,8 @@ end = struct else `Hash_mismatch (expected, actual) (* Provides addresses at an specific depth from this address *) - let rec intermediate_range : Addr.t -> index -> Addr.t list = - fun addr i -> + let rec intermediate_range : index -> Addr.t -> index -> Addr.t list = + fun ledger_depth addr i -> match i with | 0 -> [ addr ] @@ -466,12 +466,11 @@ end = struct Option.value_exn ( Or_error.ok @@ Or_error.both - (* TODO:use proper depth *) - (Addr.child ~ledger_depth:5 addr Direction.Left) - (Addr.child ~ledger_depth:5 addr Direction.Right) ) + (Addr.child ~ledger_depth addr Direction.Left) + (Addr.child ~ledger_depth addr Direction.Right) ) in - let left = intermediate_range left (i - 1) in - let right = intermediate_range right (i - 1) in + let left = intermediate_range ledger_depth left (i - 1) in + let right = intermediate_range ledger_depth right (i - 1) in left @ right (* Merges each 2 contigous nodes, halving the size of the list *) @@ -515,8 +514,9 @@ end = struct let merged = merge_many nodes in if Hash.equal expected merged then ( Addr.Table.remove t.waiting_parents addr ; + let ledger_depth = MT.depth t.tree in (* TODO: parameterize *) - let addresses = intermediate_range addr 5 in + let addresses = intermediate_range ledger_depth addr 5 in let addresses_and_hashes = List.(zip_exn addresses nodes) in (* Filter to fetch only those that differ *) From f4465635bcb57154f9f79e4ca370229515cccf21 Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Thu, 19 Sep 2024 14:42:12 -0300 Subject: [PATCH 04/34] domain separation --- src/lib/syncable_ledger/syncable_ledger.ml | 36 ++++++++++++---------- 1 file changed, 20 insertions(+), 16 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index c9647bd8886..6a2b61e372b 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -455,6 +455,9 @@ end = struct if Hash.equal actual expected then `Success else `Hash_mismatch (expected, actual) + (* TODO: parameterize *) + let subtree_depth : index = 4 + (* Provides addresses at an specific depth from this address *) let rec intermediate_range : index -> Addr.t -> index -> Addr.t list = fun ledger_depth addr i -> @@ -474,28 +477,31 @@ end = struct left @ right (* Merges each 2 contigous nodes, halving the size of the list *) - let rec merge_siblings : Hash.t list -> Hash.t list = - (* TODO: domain separation *) - fun nodes -> + let rec merge_siblings : Hash.t list -> index -> Hash.t list = + fun nodes height -> match nodes with | [ l; r ] -> - [ Hash.merge ~height:5 l r ] + [ Hash.merge ~height l r ] | l :: r :: rest -> - Hash.merge ~height:5 l r :: merge_siblings rest + Hash.merge ~height l r :: merge_siblings rest height | _ -> (* TODO: give some error as this shouldn't really happen *) [] (* Assumes nodes to be a power of 2 and merges them into their common root *) - (* TODO:domain separation *) - let rec merge_many : Hash.t list -> Hash.t = - fun nodes -> + let rec merge_many : Hash.t list -> index -> Hash.t = + fun nodes depth -> match nodes with | [ single ] -> single | many -> - let half = merge_siblings many in - merge_many half + let half = merge_siblings many depth in + merge_many half (depth - 1) + + let merge_many : Hash.t list -> index -> Hash.t = + fun nodes depth -> + let final_depth = depth + subtree_depth in + merge_many nodes final_depth (* Adds the subtree given as the 2^k subtree leaves with the given prefix address *) (* Returns next nodes to be checked *) @@ -507,16 +513,15 @@ end = struct = fun t addr nodes -> (* let prefix_depth = Addr.depth addr in *) + let ledger_depth = MT.depth t.tree in let expected = Option.value_exn ~message:"Forgot to wait for a node" (Addr.Table.find t.waiting_parents addr) in - let merged = merge_many nodes in + let merged = merge_many nodes (ledger_depth - Addr.depth addr) in if Hash.equal expected merged then ( Addr.Table.remove t.waiting_parents addr ; - let ledger_depth = MT.depth t.tree in - (* TODO: parameterize *) - let addresses = intermediate_range ledger_depth addr 5 in + let addresses = intermediate_range ledger_depth addr subtree_depth in let addresses_and_hashes = List.(zip_exn addresses nodes) in (* Filter to fetch only those that differ *) @@ -618,8 +623,7 @@ end = struct (* If distance to the account subtree is big enough, use wide queries, if not just request the next 2 children *) - (* TODO: parameterize depth *) - if depth_to_account_subtree >= 5 then ( + if depth_to_account_subtree >= subtree_depth then ( expect_subtree t addr exp_hash ; Linear_pipe.write_without_pushback_if_open t.queries (* TODO: verify purpose of sending the root *) From 38fb17b5252a91548e67ca215e41a1dccc22561c Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Thu, 19 Sep 2024 17:04:05 -0300 Subject: [PATCH 05/34] handle answer --- src/lib/syncable_ledger/syncable_ledger.ml | 51 +++++++++++----------- 1 file changed, 26 insertions(+), 25 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 6a2b61e372b..2ca999979f8 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -232,6 +232,27 @@ end = struct type query = Addr.t Query.t + (* TODO: parameterize *) + let subtree_depth : index = 4 + + (* Provides addresses at an specific depth from this address *) + let rec intermediate_range : index -> Addr.t -> index -> Addr.t list = + fun ledger_depth addr i -> + match i with + | 0 -> + [ addr ] + | i -> + let left, right = + Option.value_exn + ( Or_error.ok + @@ Or_error.both + (Addr.child ~ledger_depth addr Direction.Left) + (Addr.child ~ledger_depth addr Direction.Right) ) + in + let left = intermediate_range ledger_depth left (i - 1) in + let right = intermediate_range ledger_depth right (i - 1) in + left @ right + module Responder = struct type t = { mt : MT.t @@ -352,10 +373,11 @@ end = struct (Num_accounts (len, MT.get_inner_hash_at_addr_exn mt content_root_addr) ) | Subtree a -> - (* TODO:giving error for now *) - Either.Second - ( Actions.Violated_protocol - , Some ("Error: $addr", [ ("addr", Addr.to_yojson a) ]) ) + let ledger_depth = MT.depth mt in + let addresses = intermediate_range ledger_depth a subtree_depth in + let get_hash a = MT.get_inner_hash_at_addr_exn mt a in + let hashes = List.map addresses ~f:get_hash in + Either.First (Subtree hashes) in match response_or_punish with @@ -455,27 +477,6 @@ end = struct if Hash.equal actual expected then `Success else `Hash_mismatch (expected, actual) - (* TODO: parameterize *) - let subtree_depth : index = 4 - - (* Provides addresses at an specific depth from this address *) - let rec intermediate_range : index -> Addr.t -> index -> Addr.t list = - fun ledger_depth addr i -> - match i with - | 0 -> - [ addr ] - | i -> - let left, right = - Option.value_exn - ( Or_error.ok - @@ Or_error.both - (Addr.child ~ledger_depth addr Direction.Left) - (Addr.child ~ledger_depth addr Direction.Right) ) - in - let left = intermediate_range ledger_depth left (i - 1) in - let right = intermediate_range ledger_depth right (i - 1) in - left @ right - (* Merges each 2 contigous nodes, halving the size of the list *) let rec merge_siblings : Hash.t list -> index -> Hash.t list = fun nodes height -> From f5937a03dea80ed2d6d36097b222dc780459f8e7 Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Fri, 20 Sep 2024 12:22:00 -0300 Subject: [PATCH 06/34] versioning --- src/lib/syncable_ledger/syncable_ledger.ml | 53 +++++++++++++++++----- 1 file changed, 41 insertions(+), 12 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 2ca999979f8..48327b6b217 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -13,7 +13,7 @@ let rec funpow n f r = if n > 0 then funpow (n - 1) f (f r) else r module Query = struct [%%versioned module Stable = struct - module V1 = struct + module V2 = struct type 'addr t = | What_child_hashes of 'addr (** What are the hashes of the children of this address? *) @@ -26,18 +26,38 @@ module Query = struct | Subtree of 'addr (** What are the 2^k nodes at depth k from the given prefix address **) - (* TODO: Properly handle versioning *) - (* TODO: Consider additional query to verify subtree suport, for - softfork compatibility *) + | Subtree_supported + (* TODO: only use subtree after berifying its supported *) [@@deriving sexp, yojson, hash, compare] end + + module V1 = struct + type 'addr t = + | What_child_hashes of 'addr + (** What are the hashes of the children of this address? *) + | What_contents of 'addr + (** What accounts are at this address? addr must have depth + tree_depth - account_subtree_height *) + | Num_accounts + (** How many accounts are there? Used to size data structure and + figure out what part of the tree is filled in. *) + [@@deriving sexp, yojson, hash, compare] + + let to_latest = function + | What_child_hashes addr -> + V2.What_child_hashes addr + | What_contents addr -> + V2.What_contents addr + | Num_accounts -> + V2.Num_accounts + end end] end module Answer = struct [%%versioned module Stable = struct - module V1 = struct + module V2 = struct type ('hash, 'account) t = | Child_hashes_are of 'hash * 'hash (** The requested address's children have these hashes **) @@ -47,19 +67,26 @@ module Answer = struct (** There are this many accounts and the smallest subtree that contains all non-empty nodes has this hash. *) | Subtree of 'hash list - (* TODO: Properly handle versioning *) + | Subtree_supported + [@@deriving sexp, yojson] + end + + module V1 = struct + type ('hash, 'account) t = + | Child_hashes_are of 'hash * 'hash + (** The requested address's children have these hashes **) + | Contents_are of 'account list + (** The requested address has these accounts *) + | Num_accounts of int * 'hash [@@deriving sexp, yojson] let to_latest acct_to_latest = function | Child_hashes_are (h1, h2) -> - Child_hashes_are (h1, h2) + V2.Child_hashes_are (h1, h2) | Contents_are accts -> - Contents_are (List.map ~f:acct_to_latest accts) + V2.Contents_are (List.map ~f:acct_to_latest accts) | Num_accounts (i, h) -> - Num_accounts (i, h) - | Subtree nodes -> - Subtree (List.map ~f:acct_to_latest nodes) - (* TODO: Properly handle versioning *) + V2.Num_accounts (i, h) end end] end @@ -378,6 +405,8 @@ end = struct let get_hash a = MT.get_inner_hash_at_addr_exn mt a in let hashes = List.map addresses ~f:get_hash in Either.First (Subtree hashes) + | Subtree_supported -> + Either.First Subtree_supported in match response_or_punish with From 4f84b95dd04fd24ec42df8ae094f27bc84247f0c Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Fri, 20 Sep 2024 16:24:31 -0300 Subject: [PATCH 07/34] back to previous query --- src/lib/syncable_ledger/syncable_ledger.ml | 76 ++++------------------ 1 file changed, 12 insertions(+), 64 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 48327b6b217..760e0412063 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -13,24 +13,6 @@ let rec funpow n f r = if n > 0 then funpow (n - 1) f (f r) else r module Query = struct [%%versioned module Stable = struct - module V2 = struct - type 'addr t = - | What_child_hashes of 'addr - (** What are the hashes of the children of this address? *) - | What_contents of 'addr - (** What accounts are at this address? addr must have depth - tree_depth - account_subtree_height *) - | Num_accounts - (** How many accounts are there? Used to size data structure and - figure out what part of the tree is filled in. *) - | Subtree of 'addr - (** What are the 2^k nodes at depth k from the given prefix - address **) - | Subtree_supported - (* TODO: only use subtree after berifying its supported *) - [@@deriving sexp, yojson, hash, compare] - end - module V1 = struct type 'addr t = | What_child_hashes of 'addr @@ -45,11 +27,11 @@ module Query = struct let to_latest = function | What_child_hashes addr -> - V2.What_child_hashes addr + What_child_hashes addr | What_contents addr -> - V2.What_contents addr + What_contents addr | Num_accounts -> - V2.Num_accounts + Num_accounts end end] end @@ -67,7 +49,7 @@ module Answer = struct (** There are this many accounts and the smallest subtree that contains all non-empty nodes has this hash. *) | Subtree of 'hash list - | Subtree_supported + (** The subtree rooted on the requested address has these leaves *) [@@deriving sexp, yojson] end @@ -78,6 +60,8 @@ module Answer = struct | Contents_are of 'account list (** The requested address has these accounts *) | Num_accounts of int * 'hash + (** There are this many accounts and the smallest subtree that + contains all non-empty nodes has this hash. *) [@@deriving sexp, yojson] let to_latest acct_to_latest = function @@ -270,6 +254,7 @@ end = struct [ addr ] | i -> let left, right = + (* TODO: may be better to propagate the error *) Option.value_exn ( Or_error.ok @@ Or_error.both @@ -306,29 +291,6 @@ end = struct f query ; let response_or_punish = match query with - | What_child_hashes a -> ( - match - let open Or_error.Let_syntax in - let%bind lchild = Addr.child ~ledger_depth a Direction.Left in - let%bind rchild = Addr.child ~ledger_depth a Direction.Right in - Or_error.try_with (fun () -> - Answer.Child_hashes_are - ( MT.get_inner_hash_at_addr_exn mt lchild - , MT.get_inner_hash_at_addr_exn mt rchild ) ) - with - | Ok answer -> - Either.First answer - | Error e -> - let logger = Logger.create () in - [%log error] - ~metadata:[ ("error", Error_json.error_to_yojson e) ] - "When handling What_child_hashes request, the following \ - error happended: $error" ; - Either.Second - ( Actions.Violated_protocol - , Some - ( "invalid address $addr in What_child_hashes request" - , [ ("addr", Addr.to_yojson a) ] ) ) ) | What_contents a -> if Addr.height ~ledger_depth a > account_subtree_height then Either.Second @@ -399,14 +361,12 @@ end = struct Either.First (Num_accounts (len, MT.get_inner_hash_at_addr_exn mt content_root_addr) ) - | Subtree a -> + | What_child_hashes a -> let ledger_depth = MT.depth mt in let addresses = intermediate_range ledger_depth a subtree_depth in let get_hash a = MT.get_inner_hash_at_addr_exn mt a in let hashes = List.map addresses ~f:get_hash in Either.First (Subtree hashes) - | Subtree_supported -> - Either.First Subtree_supported in match response_or_punish with @@ -647,21 +607,9 @@ end = struct expect_content t addr exp_hash ; Linear_pipe.write_without_pushback_if_open t.queries (desired_root_exn t, What_contents addr) ) - else - let account_subtree_depth = MT.depth t.tree - account_subtree_height in - let depth_to_account_subtree = account_subtree_depth - Addr.depth addr in - - (* If distance to the account subtree is big enough, use wide queries, - if not just request the next 2 children *) - if depth_to_account_subtree >= subtree_depth then ( - expect_subtree t addr exp_hash ; - Linear_pipe.write_without_pushback_if_open t.queries - (* TODO: verify purpose of sending the root *) - (desired_root_exn t, Subtree addr) ) - else ( - expect_children t addr exp_hash ; - Linear_pipe.write_without_pushback_if_open t.queries - (desired_root_exn t, What_child_hashes addr) ) + else expect_children t addr exp_hash ; + Linear_pipe.write_without_pushback_if_open t.queries + (desired_root_exn t, What_child_hashes addr) (** Handle the initial Num_accounts message, starting the main syncing process. *) @@ -793,7 +741,7 @@ end = struct ] ) ) in requeue_query () ) - | Query.Subtree address, Answer.Subtree hashes -> ( + | Query.What_child_hashes address, Answer.Subtree hashes -> ( match add_subtree t address hashes with | `Hash_mismatch (expected, actual) -> let%map () = From ed16daba8d006d6c5d588f87e562a9a3a95ee1cc Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Mon, 23 Sep 2024 11:34:25 -0300 Subject: [PATCH 08/34] remove to_latest --- src/lib/syncable_ledger/syncable_ledger.ml | 8 -------- 1 file changed, 8 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 760e0412063..ca85e129220 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -24,14 +24,6 @@ module Query = struct (** How many accounts are there? Used to size data structure and figure out what part of the tree is filled in. *) [@@deriving sexp, yojson, hash, compare] - - let to_latest = function - | What_child_hashes addr -> - What_child_hashes addr - | What_contents addr -> - What_contents addr - | Num_accounts -> - Num_accounts end end] end From 77ab99b9f8bb534c3310085e956097d2530a5a34 Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Mon, 23 Sep 2024 11:44:27 -0300 Subject: [PATCH 09/34] unify in single query --- src/lib/syncable_ledger/syncable_ledger.ml | 36 +++++----------------- 1 file changed, 7 insertions(+), 29 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index ca85e129220..c5167d1ac43 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -33,15 +33,15 @@ module Answer = struct module Stable = struct module V2 = struct type ('hash, 'account) t = - | Child_hashes_are of 'hash * 'hash - (** The requested address's children have these hashes **) + | Child_hashes_are of 'hash list + (** The requested address's children have these hashes. + May be any power of 2 number of children, and not necessarily + immediate children *) | Contents_are of 'account list (** The requested address has these accounts *) | Num_accounts of int * 'hash (** There are this many accounts and the smallest subtree that contains all non-empty nodes has this hash. *) - | Subtree of 'hash list - (** The subtree rooted on the requested address has these leaves *) [@@deriving sexp, yojson] end @@ -58,7 +58,7 @@ module Answer = struct let to_latest acct_to_latest = function | Child_hashes_are (h1, h2) -> - V2.Child_hashes_are (h1, h2) + V2.Child_hashes_are [ h1; h2 ] | Contents_are accts -> V2.Contents_are (List.map ~f:acct_to_latest accts) | Num_accounts (i, h) -> @@ -358,7 +358,7 @@ end = struct let addresses = intermediate_range ledger_depth a subtree_depth in let get_hash a = MT.get_inner_hash_at_addr_exn mt a in let hashes = List.map addresses ~f:get_hash in - Either.First (Subtree hashes) + Either.First (Child_hashes_are hashes) in match response_or_punish with @@ -673,28 +673,6 @@ end = struct in let%bind _ = match (query, answer) with - | Query.What_child_hashes addr, Answer.Child_hashes_are (lh, rh) -> ( - match add_child_hashes_to t addr lh rh with - | `Hash_mismatch (expected, actual) -> - let%map () = - record_envelope_sender t.trust_system t.logger sender - ( Actions.Sent_bad_hash - , Some - ( "sent child hashes $lhash and $rhash for address \ - $addr, they merge hash to $actualmerge but we \ - expected $expectedmerge" - , [ ("lhash", Hash.to_yojson lh) - ; ("rhash", Hash.to_yojson rh) - ; ("actualmerge", Hash.to_yojson actual) - ; ("expectedmerge", Hash.to_yojson expected) - ] ) ) - in - requeue_query () - | `Good children_to_verify -> - (* TODO #312: Make sure we don't write too much *) - List.iter children_to_verify ~f:(fun (addr, hash) -> - handle_node t addr hash ) ; - credit_fulfilled_request () ) | Query.What_contents addr, Answer.Contents_are leaves -> ( match add_content t addr leaves with | `Success -> @@ -733,7 +711,7 @@ end = struct ] ) ) in requeue_query () ) - | Query.What_child_hashes address, Answer.Subtree hashes -> ( + | Query.What_child_hashes address, Answer.Child_hashes_are hashes -> ( match add_subtree t address hashes with | `Hash_mismatch (expected, actual) -> let%map () = From d633026587b6b3cb148062e35b22de9e6bdeadb2 Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Mon, 23 Sep 2024 11:51:32 -0300 Subject: [PATCH 10/34] check leaves are power of 2 --- src/lib/syncable_ledger/syncable_ledger.ml | 57 +++++++++++++--------- 1 file changed, 35 insertions(+), 22 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index c5167d1ac43..38d7437d36c 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -491,31 +491,34 @@ end = struct 'a t -> Addr.t -> Hash.t list - -> [ `Good of (Addr.t * Hash.t) list | `Hash_mismatch of Hash.t * Hash.t ] - = + -> [ `Good of (Addr.t * Hash.t) list + | `Hash_mismatch of Hash.t * Hash.t + | `Non_power ] = fun t addr nodes -> (* let prefix_depth = Addr.depth addr in *) - let ledger_depth = MT.depth t.tree in - let expected = - Option.value_exn ~message:"Forgot to wait for a node" - (Addr.Table.find t.waiting_parents addr) - in - let merged = merge_many nodes (ledger_depth - Addr.depth addr) in - if Hash.equal expected merged then ( - Addr.Table.remove t.waiting_parents addr ; - let addresses = intermediate_range ledger_depth addr subtree_depth in - let addresses_and_hashes = List.(zip_exn addresses nodes) in - - (* Filter to fetch only those that differ *) - let should_fetch_children addr hash = - not @@ Hash.equal (MT.get_inner_hash_at_addr_exn t.tree addr) hash - in - let subtrees_to_fetch = - addresses_and_hashes - |> List.filter ~f:(Tuple2.uncurry should_fetch_children) + if Int.is_pow2 (List.length nodes) then + let ledger_depth = MT.depth t.tree in + let expected = + Option.value_exn ~message:"Forgot to wait for a node" + (Addr.Table.find t.waiting_parents addr) in - `Good subtrees_to_fetch ) - else `Hash_mismatch (expected, merged) + let merged = merge_many nodes (ledger_depth - Addr.depth addr) in + if Hash.equal expected merged then ( + Addr.Table.remove t.waiting_parents addr ; + let addresses = intermediate_range ledger_depth addr subtree_depth in + let addresses_and_hashes = List.(zip_exn addresses nodes) in + + (* Filter to fetch only those that differ *) + let should_fetch_children addr hash = + not @@ Hash.equal (MT.get_inner_hash_at_addr_exn t.tree addr) hash + in + let subtrees_to_fetch = + addresses_and_hashes + |> List.filter ~f:(Tuple2.uncurry should_fetch_children) + in + `Good subtrees_to_fetch ) + else `Hash_mismatch (expected, merged) + else `Non_power (** Given an address and the hashes of the children of the corresponding node, check the children hash to the expected value. If they do, queue the @@ -725,6 +728,16 @@ end = struct ] ) ) in requeue_query () + | `Non_power -> + let%map () = + record_envelope_sender t.trust_system t.logger sender + ( Actions.Sent_bad_hash + , Some + ( "hashes sent for subtree on address $address are \ + not a power of 2" + , [] ) ) + in + requeue_query () | `Good children_to_verify -> List.iter children_to_verify ~f:(fun (addr, hash) -> handle_node t addr hash ) ; From c54ff14e32bf94fa96fb1b1dfe328309a9dc070d Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Tue, 24 Sep 2024 09:47:14 -0300 Subject: [PATCH 11/34] removed unused functions --- src/lib/syncable_ledger/syncable_ledger.ml | 57 ---------------------- 1 file changed, 57 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 38d7437d36c..6d7d7f591a0 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -423,17 +423,6 @@ end = struct "Expecting content addr $address, expected: $hash" ; Addr.Table.add_exn t.waiting_content ~key:addr ~data:expected - (* Waits for a subtree with root at the given address *) - let expect_subtree : 'a t -> Addr.t -> Hash.t -> unit = - fun t parent_addr expected -> - [%log' trace t.logger] - ~metadata: - [ ("subtree prefix address", Addr.to_yojson parent_addr) - ; ("hash", Hash.to_yojson expected) - ] - "Expecting subtree at address $parent_address, expected: $hash" ; - Addr.Table.add_exn t.waiting_parents ~key:parent_addr ~data:expected - (** Given an address and the accounts below that address, fill in the tree with them. *) let add_content : @@ -520,52 +509,6 @@ end = struct else `Hash_mismatch (expected, merged) else `Non_power - (** Given an address and the hashes of the children of the corresponding node, - check the children hash to the expected value. If they do, queue the - children for retrieval if the values in the underlying ledger don't match - the hashes we got from the network. *) - let add_child_hashes_to : - 'a t - -> Addr.t - -> Hash.t - -> Hash.t - -> [ `Good of (Addr.t * Hash.t) list - (** The addresses and expected hashes of the now-retrievable children *) - | `Hash_mismatch of Hash.t * Hash.t - (** Hash check failed, peer lied. First parameter expected, second parameter actual. *) - ] = - fun t parent_addr lh rh -> - let ledger_depth = MT.depth t.tree in - let la, ra = - Option.value_exn ~message:"Tried to fetch a leaf as if it was a node" - ( Or_error.ok - @@ Or_error.both - (Addr.child ~ledger_depth parent_addr Direction.Left) - (Addr.child ~ledger_depth parent_addr Direction.Right) ) - in - let expected = - Option.value_exn ~message:"Forgot to wait for a node" - (Addr.Table.find t.waiting_parents parent_addr) - in - let merged_hash = - (* Height here is the height of the things we're merging, so one less than - the parent height. *) - Hash.merge ~height:(ledger_depth - Addr.depth parent_addr - 1) lh rh - in - if Hash.equal merged_hash expected then ( - (* Fetch the children of a node if the hash in the underlying ledger - doesn't match what we got. *) - let should_fetch_children addr hash = - not @@ Hash.equal (MT.get_inner_hash_at_addr_exn t.tree addr) hash - in - let subtrees_to_fetch = - [ (la, lh); (ra, rh) ] - |> List.filter ~f:(Tuple2.uncurry should_fetch_children) - in - Addr.Table.remove t.waiting_parents parent_addr ; - `Good subtrees_to_fetch ) - else `Hash_mismatch (expected, merged_hash) - let all_done t = if not (Root_hash.equal (MT.merkle_root t.tree) (desired_root_exn t)) then failwith "We finished syncing, but made a mistake somewhere :(" From 250c655623e01ae7c2ec949466655813e0e6793c Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Tue, 24 Sep 2024 10:08:46 -0300 Subject: [PATCH 12/34] extra checks for length --- src/lib/syncable_ledger/syncable_ledger.ml | 24 ++++++++++++++-------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 6d7d7f591a0..0df82c18b0b 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -34,7 +34,7 @@ module Answer = struct module V2 = struct type ('hash, 'account) t = | Child_hashes_are of 'hash list - (** The requested address's children have these hashes. + (** The requested addresses' children have these hashes. May be any power of 2 number of children, and not necessarily immediate children *) | Contents_are of 'account list @@ -482,10 +482,16 @@ end = struct -> Hash.t list -> [ `Good of (Addr.t * Hash.t) list | `Hash_mismatch of Hash.t * Hash.t - | `Non_power ] = + | `Invalid_length ] = fun t addr nodes -> - (* let prefix_depth = Addr.depth addr in *) - if Int.is_pow2 (List.length nodes) then + let len = List.length nodes in + let is_power = Int.is_pow2 len in + let is_more_than_two = len >= 2 in + let less_than_max = len <= Int.pow 2 subtree_depth in + + let valid_length = is_power && is_more_than_two && less_than_max in + + if valid_length then let ledger_depth = MT.depth t.tree in let expected = Option.value_exn ~message:"Forgot to wait for a node" @@ -507,7 +513,7 @@ end = struct in `Good subtrees_to_fetch ) else `Hash_mismatch (expected, merged) - else `Non_power + else `Invalid_length let all_done t = if not (Root_hash.equal (MT.merkle_root t.tree) (desired_root_exn t)) then @@ -671,14 +677,14 @@ end = struct ] ) ) in requeue_query () - | `Non_power -> + | `Invalid_length -> let%map () = record_envelope_sender t.trust_system t.logger sender ( Actions.Sent_bad_hash , Some - ( "hashes sent for subtree on address $address are \ - not a power of 2" - , [] ) ) + ( "hashes sent for subtree on address $address must \ + be a power of 2 in the range 2-2^$depth" + , [ ("depth", `Int subtree_depth) ] ) ) in requeue_query () | `Good children_to_verify -> From 1229ef80309556b1b68d13638daceec43b85daa5 Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Tue, 24 Sep 2024 11:00:46 -0300 Subject: [PATCH 13/34] handle exception --- src/lib/syncable_ledger/syncable_ledger.ml | 25 ++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 0df82c18b0b..da2dcc1048c 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -353,12 +353,29 @@ end = struct Either.First (Num_accounts (len, MT.get_inner_hash_at_addr_exn mt content_root_addr) ) - | What_child_hashes a -> + | What_child_hashes a -> ( let ledger_depth = MT.depth mt in let addresses = intermediate_range ledger_depth a subtree_depth in - let get_hash a = MT.get_inner_hash_at_addr_exn mt a in - let hashes = List.map addresses ~f:get_hash in - Either.First (Child_hashes_are hashes) + match + let open Or_error.Let_syntax in + Or_error.try_with (fun () -> + let get_hash a = MT.get_inner_hash_at_addr_exn mt a in + let hashes = List.map addresses ~f:get_hash in + Answer.Child_hashes_are hashes ) + with + | Ok answer -> + Either.First answer + | Error e -> + let logger = Logger.create () in + [%log error] + ~metadata:[ ("error", Error_json.error_to_yojson e) ] + "When handling What_child_hashes request, the following \ + error happended: $error" ; + Either.Second + ( Actions.Violated_protocol + , Some + ( "invalid address $addr in What_child_hashes request" + , [ ("addr", Addr.to_yojson a) ] ) ) ) in match response_or_punish with From d4b9dba004da3cdc32959c60f43fafb6ad425999 Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Tue, 24 Sep 2024 12:51:10 -0300 Subject: [PATCH 14/34] misc --- src/lib/syncable_ledger/syncable_ledger.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index da2dcc1048c..02994def907 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -236,7 +236,7 @@ end = struct type query = Addr.t Query.t (* TODO: parameterize *) - let subtree_depth : index = 4 + let subtree_depth : int = 4 (* Provides addresses at an specific depth from this address *) let rec intermediate_range : index -> Addr.t -> index -> Addr.t list = @@ -473,8 +473,8 @@ end = struct | l :: r :: rest -> Hash.merge ~height l r :: merge_siblings rest height | _ -> - (* TODO: give some error as this shouldn't really happen *) - [] + (* Shouldn't happen as the length is being constrained *) + raise (Failure "length is odd") (* Assumes nodes to be a power of 2 and merges them into their common root *) let rec merge_many : Hash.t list -> index -> Hash.t = @@ -688,9 +688,9 @@ end = struct ( Actions.Sent_bad_hash , Some ( "hashes sent for subtree on address $address merge \ - to $actualmerge but we expected $expectedmerge" - , [ ("actualmerge", Hash.to_yojson actual) - ; ("expectedmerge", Hash.to_yojson expected) + to $actual_merge but we expected $expected_merge" + , [ ("actual_merge", Hash.to_yojson actual) + ; ("expected_merge", Hash.to_yojson expected) ] ) ) in requeue_query () From 812a188a47ad0878c6895de706d1d01b1205c9c2 Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Tue, 24 Sep 2024 14:24:11 -0300 Subject: [PATCH 15/34] move to array --- src/lib/syncable_ledger/syncable_ledger.ml | 53 +++++++++++----------- 1 file changed, 26 insertions(+), 27 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 02994def907..095e233971f 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -33,7 +33,7 @@ module Answer = struct module Stable = struct module V2 = struct type ('hash, 'account) t = - | Child_hashes_are of 'hash list + | Child_hashes_are of 'hash Bounded_types.ArrayN4000.Stable.V1.t (** The requested addresses' children have these hashes. May be any power of 2 number of children, and not necessarily immediate children *) @@ -58,7 +58,7 @@ module Answer = struct let to_latest acct_to_latest = function | Child_hashes_are (h1, h2) -> - V2.Child_hashes_are [ h1; h2 ] + V2.Child_hashes_are (List.to_array [ h1; h2 ]) | Contents_are accts -> V2.Contents_are (List.map ~f:acct_to_latest accts) | Num_accounts (i, h) -> @@ -356,11 +356,11 @@ end = struct | What_child_hashes a -> ( let ledger_depth = MT.depth mt in let addresses = intermediate_range ledger_depth a subtree_depth in + let addresses = List.to_array addresses in match - let open Or_error.Let_syntax in Or_error.try_with (fun () -> let get_hash a = MT.get_inner_hash_at_addr_exn mt a in - let hashes = List.map addresses ~f:get_hash in + let hashes = Array.map addresses ~f:get_hash in Answer.Child_hashes_are hashes ) with | Ok answer -> @@ -464,29 +464,27 @@ end = struct if Hash.equal actual expected then `Success else `Hash_mismatch (expected, actual) - (* Merges each 2 contigous nodes, halving the size of the list *) - let rec merge_siblings : Hash.t list -> index -> Hash.t list = + (* Merges each 2 contigous nodes, halving the size of the array *) + let merge_siblings : Hash.t array -> index -> Hash.t array = fun nodes height -> - match nodes with - | [ l; r ] -> - [ Hash.merge ~height l r ] - | l :: r :: rest -> - Hash.merge ~height l r :: merge_siblings rest height - | _ -> - (* Shouldn't happen as the length is being constrained *) - raise (Failure "length is odd") + let len = Array.length nodes in + if len mod 2 <> 0 then failwith "length must be even" ; + let half_len = len / 2 in + let f i = Hash.merge ~height nodes.(2 * i) nodes.((2 * i) + 1) in + Array.init half_len ~f (* Assumes nodes to be a power of 2 and merges them into their common root *) - let rec merge_many : Hash.t list -> index -> Hash.t = + let rec merge_many : Hash.t array -> index -> Hash.t = fun nodes depth -> - match nodes with - | [ single ] -> - single - | many -> - let half = merge_siblings many depth in + let len = Array.length nodes in + match len with + | 1 -> + nodes.(0) + | _ -> + let half = merge_siblings nodes depth in merge_many half (depth - 1) - let merge_many : Hash.t list -> index -> Hash.t = + let merge_many : Hash.t array -> index -> Hash.t = fun nodes depth -> let final_depth = depth + subtree_depth in merge_many nodes final_depth @@ -496,12 +494,12 @@ end = struct let add_subtree : 'a t -> Addr.t - -> Hash.t list - -> [ `Good of (Addr.t * Hash.t) list + -> Hash.t array + -> [ `Good of (Addr.t * Hash.t) array | `Hash_mismatch of Hash.t * Hash.t | `Invalid_length ] = fun t addr nodes -> - let len = List.length nodes in + let len = Array.length nodes in let is_power = Int.is_pow2 len in let is_more_than_two = len >= 2 in let less_than_max = len <= Int.pow 2 subtree_depth in @@ -518,7 +516,8 @@ end = struct if Hash.equal expected merged then ( Addr.Table.remove t.waiting_parents addr ; let addresses = intermediate_range ledger_depth addr subtree_depth in - let addresses_and_hashes = List.(zip_exn addresses nodes) in + let addresses = List.to_array addresses in + let addresses_and_hashes = Array.zip_exn addresses nodes in (* Filter to fetch only those that differ *) let should_fetch_children addr hash = @@ -526,7 +525,7 @@ end = struct in let subtrees_to_fetch = addresses_and_hashes - |> List.filter ~f:(Tuple2.uncurry should_fetch_children) + |> Array.filter ~f:(Tuple2.uncurry should_fetch_children) in `Good subtrees_to_fetch ) else `Hash_mismatch (expected, merged) @@ -705,7 +704,7 @@ end = struct in requeue_query () | `Good children_to_verify -> - List.iter children_to_verify ~f:(fun (addr, hash) -> + Array.iter children_to_verify ~f:(fun (addr, hash) -> handle_node t addr hash ) ; credit_fulfilled_request () ) | query, answer -> From d7eece37c7269d2c8d1810448c07764cec2e3579 Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Wed, 25 Sep 2024 09:37:48 -0300 Subject: [PATCH 16/34] update rpc --- src/lib/mina_ledger/sync_ledger.ml | 13 ++++++++++++- src/lib/mina_networking/rpcs.ml | 4 ++-- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/src/lib/mina_ledger/sync_ledger.ml b/src/lib/mina_ledger/sync_ledger.ml index 397cdbf3434..7d692c97bba 100644 --- a/src/lib/mina_ledger/sync_ledger.ml +++ b/src/lib/mina_ledger/sync_ledger.ml @@ -54,6 +54,16 @@ module Answer = struct module Stable = struct [@@@no_toplevel_latest_type] + module V3 = struct + type t = + ( Ledger_hash.Stable.V1.t + , Account.Stable.V2.t ) + Syncable_ledger.Answer.Stable.V2.t + [@@deriving sexp, to_yojson] + + let to_latest = Fn.id + end + module V2 = struct type t = ( Ledger_hash.Stable.V1.t @@ -61,7 +71,8 @@ module Answer = struct Syncable_ledger.Answer.Stable.V1.t [@@deriving sexp, to_yojson] - let to_latest = Fn.id + let to_latest (a, b, c) = + (a, b, Syncable_ledger.Answer.Stable.V1.to_latest c) end end] diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index 1d91b2f105e..96a8d698ba8 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -366,13 +366,13 @@ module Answer_sync_ledger_query = struct include Master end) - module V3 = struct + module V4 = struct module T = struct type query = Ledger_hash.Stable.V1.t * Sync_ledger.Query.Stable.V1.t [@@deriving sexp] type response = - (( Sync_ledger.Answer.Stable.V2.t + (( Sync_ledger.Answer.Stable.V3.t , Bounded_types.Wrapped_error.Stable.V1.t ) Result.t [@version_asserted] ) From 6250c3675e05732f25c289d5dd630b459c3d4387 Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Wed, 25 Sep 2024 14:34:36 -0300 Subject: [PATCH 17/34] proper rpc response update --- src/lib/mina_ledger/sync_ledger.ml | 9 +++-- src/lib/mina_networking/rpcs.ml | 41 ++++++++++++++++++++++ src/lib/syncable_ledger/syncable_ledger.ml | 12 +++++++ 3 files changed, 60 insertions(+), 2 deletions(-) diff --git a/src/lib/mina_ledger/sync_ledger.ml b/src/lib/mina_ledger/sync_ledger.ml index 7d692c97bba..7363b674bb1 100644 --- a/src/lib/mina_ledger/sync_ledger.ml +++ b/src/lib/mina_ledger/sync_ledger.ml @@ -71,8 +71,13 @@ module Answer = struct Syncable_ledger.Answer.Stable.V1.t [@@deriving sexp, to_yojson] - let to_latest (a, b, c) = - (a, b, Syncable_ledger.Answer.Stable.V1.to_latest c) + let to_latest x = Syncable_ledger.Answer.Stable.V1.to_latest Fn.id x + + (* Not a standard versioning function *) + + (** Attempts to downgrade v3 -> v2 *) + let from_v3 : V3.t -> t = + fun x -> Syncable_ledger.Answer.Stable.V1.from_v2 x end end] diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index 96a8d698ba8..2b83aafe5c9 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -399,6 +399,47 @@ module Answer_sync_ledger_query = struct include Register (T') end + module V3 = struct + module T = struct + type query = Ledger_hash.Stable.V1.t * Sync_ledger.Query.Stable.V1.t + [@@deriving sexp] + + type response = + (( Sync_ledger.Answer.Stable.V2.t + , Bounded_types.Wrapped_error.Stable.V1.t ) + Result.t + [@version_asserted] ) + [@@deriving sexp] + + let query_of_caller_model = Fn.id + + let callee_model_of_query = Fn.id + + let caller_model_of_response : response -> Master.T.response = function + | Ok a -> + Ok (Sync_ledger.Answer.Stable.V2.to_latest a) + | Error e -> + Error e + + let response_of_callee_model : Master.T.response -> response = function + | Ok a -> + Ok (Sync_ledger.Answer.Stable.V2.from_v3 a) + | Error e -> + Error e + end + + module T' = + Perf_histograms.Rpc.Plain.Decorate_bin_io + (struct + include M + include Master + end) + (T) + + include T' + include Register (T') + end + let receipt_trust_action_message (_, query) = ( "Answer_sync_ledger_query: $query" , [ ("query", Sync_ledger.Query.to_yojson query) ] ) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 095e233971f..ba737445263 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -63,6 +63,18 @@ module Answer = struct V2.Contents_are (List.map ~f:acct_to_latest accts) | Num_accounts (i, h) -> V2.Num_accounts (i, h) + + (* Not a standard versioning function *) + + (** Attempts to downgrade v2 -> v1 *) + let from_v2 : ('a, 'b) V2.t -> ('a, 'b) t = function + | Child_hashes_are h -> + if Array.length h = 2 then Child_hashes_are (h.(0), h.(1)) + else failwith "can't downgrade wide query" + | Contents_are accs -> + Contents_are accs + | Num_accounts (n, h) -> + Num_accounts (n, h) end end] end From 3f47ce7180fb81825883a26a08bf4f96c78dbbb3 Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Wed, 25 Sep 2024 16:56:06 -0300 Subject: [PATCH 18/34] variable with query --- src/lib/mina_ledger/sync_ledger.ml | 21 ++++- src/lib/mina_networking/rpcs.ml | 16 ++-- src/lib/syncable_ledger/syncable_ledger.ml | 95 ++++++++++++++++------ 3 files changed, 98 insertions(+), 34 deletions(-) diff --git a/src/lib/mina_ledger/sync_ledger.ml b/src/lib/mina_ledger/sync_ledger.ml index 7363b674bb1..c88cc1414ad 100644 --- a/src/lib/mina_ledger/sync_ledger.ml +++ b/src/lib/mina_ledger/sync_ledger.ml @@ -95,12 +95,31 @@ module Query = struct module Stable = struct [@@@no_toplevel_latest_type] + module V2 = struct + type t = + Ledger.Location.Addr.Stable.V1.t Syncable_ledger.Query.Stable.V2.t + [@@deriving sexp, to_yojson, hash, compare] + + let to_latest = Fn.id + end + module V1 = struct type t = Ledger.Location.Addr.Stable.V1.t Syncable_ledger.Query.Stable.V1.t [@@deriving sexp, to_yojson, hash, compare] - let to_latest = Fn.id + let to_latest : t -> V2.t = Syncable_ledger.Query.Stable.V1.to_latest + + (* Not a standard versioning function *) + + (** Attempts to downgrade v3 -> v2 *) + let from_v2 : V2.t -> t = function + | What_child_hashes (a, _) -> + What_child_hashes a + | What_contents a -> + What_contents a + | Num_accounts -> + Num_accounts end end] diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index 2b83aafe5c9..412ea0a0c4f 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -368,7 +368,7 @@ module Answer_sync_ledger_query = struct module V4 = struct module T = struct - type query = Ledger_hash.Stable.V1.t * Sync_ledger.Query.Stable.V1.t + type query = Ledger_hash.Stable.V1.t * Sync_ledger.Query.Stable.V2.t [@@deriving sexp] type response = @@ -411,19 +411,21 @@ module Answer_sync_ledger_query = struct [@version_asserted] ) [@@deriving sexp] - let query_of_caller_model = Fn.id + let query_of_caller_model : Master.T.query -> query = + fun (h, q) -> (h, Sync_ledger.Query.Stable.V1.from_v2 q) - let callee_model_of_query = Fn.id + let callee_model_of_query : query -> Master.T.query = + fun (h, q) -> (h, Sync_ledger.Query.Stable.V1.to_latest q) - let caller_model_of_response : response -> Master.T.response = function + let response_of_callee_model : Master.T.response -> response = function | Ok a -> - Ok (Sync_ledger.Answer.Stable.V2.to_latest a) + Ok (Sync_ledger.Answer.Stable.V2.from_v3 a) | Error e -> Error e - let response_of_callee_model : Master.T.response -> response = function + let caller_model_of_response : response -> Master.T.response = function | Ok a -> - Ok (Sync_ledger.Answer.Stable.V2.from_v3 a) + Ok (Sync_ledger.Answer.Stable.V2.to_latest a) | Error e -> Error e end diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index ba737445263..be6317eb94d 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -13,6 +13,19 @@ let rec funpow n f r = if n > 0 then funpow (n - 1) f (f r) else r module Query = struct [%%versioned module Stable = struct + module V2 = struct + type 'addr t = + | What_child_hashes of 'addr * int + (** What are the hashes of the children of this address? *) + | What_contents of 'addr + (** What accounts are at this address? addr must have depth + tree_depth - account_subtree_height *) + | Num_accounts + (** How many accounts are there? Used to size data structure and + figure out what part of the tree is filled in. *) + [@@deriving sexp, yojson, hash, compare] + end + module V1 = struct type 'addr t = | What_child_hashes of 'addr @@ -24,6 +37,14 @@ module Query = struct (** How many accounts are there? Used to size data structure and figure out what part of the tree is filled in. *) [@@deriving sexp, yojson, hash, compare] + + let to_latest : 'a t -> 'a V2.t = function + | What_child_hashes a -> + What_child_hashes (a, 1) + | What_contents a -> + What_contents a + | Num_accounts -> + Num_accounts end end] end @@ -247,8 +268,9 @@ end = struct type query = Addr.t Query.t - (* TODO: parameterize *) - let subtree_depth : int = 4 + let max_subtree_depth : int = 8 + + let default_subtree_depth : int = 4 (* Provides addresses at an specific depth from this address *) let rec intermediate_range : index -> Addr.t -> index -> Addr.t list = @@ -365,28 +387,43 @@ end = struct Either.First (Num_accounts (len, MT.get_inner_hash_at_addr_exn mt content_root_addr) ) - | What_child_hashes a -> ( - let ledger_depth = MT.depth mt in - let addresses = intermediate_range ledger_depth a subtree_depth in - let addresses = List.to_array addresses in - match - Or_error.try_with (fun () -> - let get_hash a = MT.get_inner_hash_at_addr_exn mt a in - let hashes = Array.map addresses ~f:get_hash in - Answer.Child_hashes_are hashes ) - with - | Ok answer -> - Either.First answer - | Error e -> + | What_child_hashes (a, subtree_depth) -> ( + match subtree_depth with + | n when n >= 1 && n <= max_subtree_depth -> ( + let ledger_depth = MT.depth mt in + let addresses = + intermediate_range ledger_depth a subtree_depth + in + let addresses = List.to_array addresses in + match + Or_error.try_with (fun () -> + let get_hash a = MT.get_inner_hash_at_addr_exn mt a in + let hashes = Array.map addresses ~f:get_hash in + Answer.Child_hashes_are hashes ) + with + | Ok answer -> + Either.First answer + | Error e -> + let logger = Logger.create () in + [%log error] + ~metadata:[ ("error", Error_json.error_to_yojson e) ] + "When handling What_child_hashes request, the following \ + error happended: $error" ; + Either.Second + ( Actions.Violated_protocol + , Some + ( "invalid address $addr in What_child_hashes request" + , [ ("addr", Addr.to_yojson a) ] ) ) ) + | _ -> let logger = Logger.create () in [%log error] - ~metadata:[ ("error", Error_json.error_to_yojson e) ] - "When handling What_child_hashes request, the following \ - error happended: $error" ; + "When handling What_child_hashes request, the depth was \ + outside the valid range" ; Either.Second ( Actions.Violated_protocol , Some - ( "invalid address $addr in What_child_hashes request" + ( "invalid depth requested at $addr in What_child_hashes \ + request" , [ ("addr", Addr.to_yojson a) ] ) ) ) in @@ -496,8 +533,8 @@ end = struct let half = merge_siblings nodes depth in merge_many half (depth - 1) - let merge_many : Hash.t array -> index -> Hash.t = - fun nodes depth -> + let merge_many : Hash.t array -> index -> index -> Hash.t = + fun nodes depth subtree_depth -> let final_depth = depth + subtree_depth in merge_many nodes final_depth @@ -514,7 +551,8 @@ end = struct let len = Array.length nodes in let is_power = Int.is_pow2 len in let is_more_than_two = len >= 2 in - let less_than_max = len <= Int.pow 2 subtree_depth in + let subtree_depth = Int.ceil_log2 len in + let less_than_max = len <= Int.pow 2 max_subtree_depth in let valid_length = is_power && is_more_than_two && less_than_max in @@ -524,7 +562,9 @@ end = struct Option.value_exn ~message:"Forgot to wait for a node" (Addr.Table.find t.waiting_parents addr) in - let merged = merge_many nodes (ledger_depth - Addr.depth addr) in + let merged = + merge_many nodes (ledger_depth - Addr.depth addr) subtree_depth + in if Hash.equal expected merged then ( Addr.Table.remove t.waiting_parents addr ; let addresses = intermediate_range ledger_depth addr subtree_depth in @@ -581,7 +621,7 @@ end = struct (desired_root_exn t, What_contents addr) ) else expect_children t addr exp_hash ; Linear_pipe.write_without_pushback_if_open t.queries - (desired_root_exn t, What_child_hashes addr) + (desired_root_exn t, What_child_hashes (addr, default_subtree_depth)) (** Handle the initial Num_accounts message, starting the main syncing process. *) @@ -691,7 +731,10 @@ end = struct ] ) ) in requeue_query () ) - | Query.What_child_hashes address, Answer.Child_hashes_are hashes -> ( + (* query depth is not checked as the response is allowed to use any + depth within the valid range *) + | Query.What_child_hashes (address, _), Answer.Child_hashes_are hashes + -> ( match add_subtree t address hashes with | `Hash_mismatch (expected, actual) -> let%map () = @@ -712,7 +755,7 @@ end = struct , Some ( "hashes sent for subtree on address $address must \ be a power of 2 in the range 2-2^$depth" - , [ ("depth", `Int subtree_depth) ] ) ) + , [ ("depth", `Int max_subtree_depth) ] ) ) in requeue_query () | `Good children_to_verify -> From bf3d52f050f1e37c6e481a0f5740d90ba9f40dde Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Mon, 30 Sep 2024 10:13:49 -0300 Subject: [PATCH 19/34] fix --- src/lib/syncable_ledger/syncable_ledger.ml | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index be6317eb94d..5f8409f61c5 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -563,7 +563,8 @@ end = struct (Addr.Table.find t.waiting_parents addr) in let merged = - merge_many nodes (ledger_depth - Addr.depth addr) subtree_depth + (* Subtracting 2 as we ultimately add 2 1-indexed depths *) + merge_many nodes (ledger_depth - Addr.depth addr - 2) subtree_depth in if Hash.equal expected merged then ( Addr.Table.remove t.waiting_parents addr ; @@ -619,9 +620,10 @@ end = struct expect_content t addr exp_hash ; Linear_pipe.write_without_pushback_if_open t.queries (desired_root_exn t, What_contents addr) ) - else expect_children t addr exp_hash ; - Linear_pipe.write_without_pushback_if_open t.queries - (desired_root_exn t, What_child_hashes (addr, default_subtree_depth)) + else ( + expect_children t addr exp_hash ; + Linear_pipe.write_without_pushback_if_open t.queries + (desired_root_exn t, What_child_hashes (addr, default_subtree_depth)) ) (** Handle the initial Num_accounts message, starting the main syncing process. *) From 0e777227170654a43d7d0c868db73f374209573b Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Thu, 3 Oct 2024 10:27:02 -0300 Subject: [PATCH 20/34] fix domain separation --- src/lib/syncable_ledger/syncable_ledger.ml | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 5f8409f61c5..1925be61c67 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -524,19 +524,21 @@ end = struct (* Assumes nodes to be a power of 2 and merges them into their common root *) let rec merge_many : Hash.t array -> index -> Hash.t = - fun nodes depth -> + fun nodes height -> let len = Array.length nodes in match len with | 1 -> nodes.(0) | _ -> - let half = merge_siblings nodes depth in - merge_many half (depth - 1) + let half = merge_siblings nodes height in + merge_many half (height + 1) let merge_many : Hash.t array -> index -> index -> Hash.t = - fun nodes depth subtree_depth -> - let final_depth = depth + subtree_depth in - merge_many nodes final_depth + fun nodes height subtree_depth -> + let bottom_height = height - subtree_depth in + let hash = merge_many nodes bottom_height in + Printf.printf "merged: %s \n" (Hash.to_base58_check hash) ; + hash (* Adds the subtree given as the 2^k subtree leaves with the given prefix address *) (* Returns next nodes to be checked *) @@ -563,8 +565,7 @@ end = struct (Addr.Table.find t.waiting_parents addr) in let merged = - (* Subtracting 2 as we ultimately add 2 1-indexed depths *) - merge_many nodes (ledger_depth - Addr.depth addr - 2) subtree_depth + merge_many nodes (ledger_depth - Addr.depth addr) subtree_depth in if Hash.equal expected merged then ( Addr.Table.remove t.waiting_parents addr ; From c5e5a97929ebfbb3ee57dd256352a618d812949e Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Thu, 3 Oct 2024 11:34:02 -0300 Subject: [PATCH 21/34] add comment about query depth --- src/lib/syncable_ledger/syncable_ledger.ml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 1925be61c67..9bb71db7155 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -16,7 +16,12 @@ module Query = struct module V2 = struct type 'addr t = | What_child_hashes of 'addr * int - (** What are the hashes of the children of this address? *) + (** What are the hashes of the children of this address? + If depth > 1 then we get the leaves of a subtree rooted + at address and of the given depth. + For depth = 1 we have the simplest case with just the 2 + direct children. + *) | What_contents of 'addr (** What accounts are at this address? addr must have depth tree_depth - account_subtree_height *) From 7fd1dd61543fa25d0287ab083300d09cf89f1fa4 Mon Sep 17 00:00:00 2001 From: Fabrizio Muraca Date: Fri, 4 Oct 2024 12:30:51 -0300 Subject: [PATCH 22/34] remove print --- src/lib/syncable_ledger/syncable_ledger.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 9bb71db7155..e7a752db7a7 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -542,7 +542,6 @@ end = struct fun nodes height subtree_depth -> let bottom_height = height - subtree_depth in let hash = merge_many nodes bottom_height in - Printf.printf "merged: %s \n" (Hash.to_base58_check hash) ; hash (* Adds the subtree given as the 2^k subtree leaves with the given prefix address *) From e9cb15494917188a4ac2dfcf7c578ad0e5bcdc12 Mon Sep 17 00:00:00 2001 From: Deepthi S Kumar Date: Fri, 8 Nov 2024 18:08:22 -0800 Subject: [PATCH 23/34] reject if depth of received subtree is is greater than the requested depth --- src/lib/syncable_ledger/syncable_ledger.ml | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index e7a752db7a7..3a21a167755 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -550,18 +550,20 @@ end = struct 'a t -> Addr.t -> Hash.t array + -> int -> [ `Good of (Addr.t * Hash.t) array | `Hash_mismatch of Hash.t * Hash.t | `Invalid_length ] = - fun t addr nodes -> + fun t addr nodes requested_depth -> let len = Array.length nodes in let is_power = Int.is_pow2 len in let is_more_than_two = len >= 2 in let subtree_depth = Int.ceil_log2 len in let less_than_max = len <= Int.pow 2 max_subtree_depth in - - let valid_length = is_power && is_more_than_two && less_than_max in - + let less_than_requested = subtree_depth <= requested_depth in + let valid_length = + is_power && is_more_than_two && less_than_requested && less_than_max + in if valid_length then let ledger_depth = MT.depth t.tree in let expected = @@ -738,11 +740,9 @@ end = struct ] ) ) in requeue_query () ) - (* query depth is not checked as the response is allowed to use any - depth within the valid range *) - | Query.What_child_hashes (address, _), Answer.Child_hashes_are hashes - -> ( - match add_subtree t address hashes with + | ( Query.What_child_hashes (address, requested_depth) + , Answer.Child_hashes_are hashes ) -> ( + match add_subtree t address hashes requested_depth with | `Hash_mismatch (expected, actual) -> let%map () = record_envelope_sender t.trust_system t.logger sender From c1c12c9656dd423764af4a630948aff7c83b7e52 Mon Sep 17 00:00:00 2001 From: Deepthi S Kumar Date: Sun, 10 Nov 2024 23:05:02 -0800 Subject: [PATCH 24/34] move subtree depth constants to compile-config --- .../src/cli_entrypoint/mina_cli_entrypoint.ml | 2 + src/lib/block_producer/block_producer.ml | 2 + .../bootstrap_controller.ml | 7 +- src/lib/consensus/intf.ml | 2 + src/lib/consensus/proof_of_stake.ml | 11 +- src/lib/mina_block/validation.ml | 2 + src/lib/mina_block/validation.mli | 2 + .../mina_compile_config.ml | 26 ++++- .../transition_frontier_components_intf.ml | 2 +- src/lib/mina_lib/mina_lib.ml | 3 +- src/lib/mina_lib/tests/tests.ml | 3 +- src/lib/mina_networking/rpcs.ml | 3 +- src/lib/node_config/intf/node_config_intf.mli | 4 + .../node_config_unconfigurable_constants.ml | 4 + src/lib/sync_handler/sync_handler.ml | 15 ++- src/lib/syncable_ledger/dune | 1 + src/lib/syncable_ledger/syncable_ledger.ml | 101 +++++++++++------- src/lib/syncable_ledger/test/test.ml | 19 +++- .../full_frontier/full_frontier.ml | 4 + .../full_frontier/full_frontier.mli | 2 + .../persistent_frontier.ml | 2 + .../transition_frontier.ml | 4 + .../transition_frontier.mli | 2 + src/lib/transition_handler/validator.ml | 2 + src/lib/vrf_evaluator/dune | 1 + src/lib/vrf_evaluator/vrf_evaluator.ml | 16 ++- 26 files changed, 184 insertions(+), 58 deletions(-) diff --git a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml index b90833be0a1..c5ee02445e7 100644 --- a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml +++ b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml @@ -1050,6 +1050,8 @@ let setup_daemon logger ~itn_features ~default_snark_worker_fee = let constraint_constants = precomputed_values.constraint_constants let consensus_constants = precomputed_values.consensus_constants + + let compile_config = compile_config end in let consensus_local_state = Consensus.Data.Local_state.create diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index ab54c4cbe31..fc82d60271f 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -20,6 +20,8 @@ module type CONTEXT = sig val zkapp_cmd_limit : int option ref val vrf_poll_interval : Time.Span.t + + val compile_config : Mina_compile_config.t end type Structured_log_events.t += Block_produced diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index ffdc8fb8c2f..70f23b0a488 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -335,7 +335,9 @@ let run ~context:(module Context : CONTEXT) ~trust_system ~verifier ~network let%bind sync_ledger_time, (hash, sender, expected_staged_ledger_hash) = time_deferred (let root_sync_ledger = - Sync_ledger.Db.create temp_snarked_ledger ~logger ~trust_system + Sync_ledger.Db.create temp_snarked_ledger + ~context:(module Context) + ~trust_system in don't_wait_for (sync_ledger t ~preferred:preferred_peers ~root_sync_ledger @@ -821,7 +823,8 @@ let%test_module "Bootstrap_controller tests" = let root_sync_ledger = Sync_ledger.Db.create (Transition_frontier.root_snarked_ledger me.state.frontier) - ~logger ~trust_system + ~context:(module Context) + ~trust_system in Async.Thread_safe.block_on_async_exn (fun () -> let sync_deferred = diff --git a/src/lib/consensus/intf.ml b/src/lib/consensus/intf.ml index d00f1b5b1b7..df4e178cac4 100644 --- a/src/lib/consensus/intf.ml +++ b/src/lib/consensus/intf.ml @@ -11,6 +11,8 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Constants.t + + val compile_config : Mina_compile_config.t end module type Constants = sig diff --git a/src/lib/consensus/proof_of_stake.ml b/src/lib/consensus/proof_of_stake.ml index 126d4797066..32abc3dd2e5 100644 --- a/src/lib/consensus/proof_of_stake.ml +++ b/src/lib/consensus/proof_of_stake.ml @@ -30,6 +30,8 @@ module Make_str (A : Wire_types.Concrete) = struct val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Constants.t + + val compile_config : Mina_compile_config.t end let make_checked t = Snark_params.Tick.Run.make_checked t @@ -2678,8 +2680,9 @@ module Make_str (A : Wire_types.Concrete) = struct (next_epoch_ledger_location local_state) in let sync_ledger = - Mina_ledger.Sync_ledger.Db.create ~logger ~trust_system - db_ledger + Mina_ledger.Sync_ledger.Db.create + ~context:(module Context) + ~trust_system db_ledger in let query_reader = Mina_ledger.Sync_ledger.Db.query_reader sync_ledger @@ -3107,6 +3110,8 @@ module Make_str (A : Wire_types.Concrete) = struct Genesis_constants.For_unit_tests.Constraint_constants.t let consensus_constants = Lazy.force Constants.for_unit_tests + + let compile_config = Mina_compile_config.For_unit_tests.t end in (* Even when consensus constants are of prod sizes, candidate should still trigger a bootstrap *) should_bootstrap_len @@ -3433,6 +3438,8 @@ module Make_str (A : Wire_types.Concrete) = struct let constraint_constants = constraint_constants let consensus_constants = constants + + let compile_config = Mina_compile_config.For_unit_tests.t end let test_update constraint_constants = diff --git a/src/lib/mina_block/validation.ml b/src/lib/mina_block/validation.ml index ae77576b521..5254a05d2c1 100644 --- a/src/lib/mina_block/validation.ml +++ b/src/lib/mina_block/validation.ml @@ -18,6 +18,8 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t + + val compile_config : Mina_compile_config.t end let validation (_, v) = v diff --git a/src/lib/mina_block/validation.mli b/src/lib/mina_block/validation.mli index edb63b48893..71881258304 100644 --- a/src/lib/mina_block/validation.mli +++ b/src/lib/mina_block/validation.mli @@ -19,6 +19,8 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t + + val compile_config : Mina_compile_config.t end val validation : diff --git a/src/lib/mina_compile_config/mina_compile_config.ml b/src/lib/mina_compile_config/mina_compile_config.ml index 067bc5b7bac..61f8d7f1d3b 100644 --- a/src/lib/mina_compile_config/mina_compile_config.ml +++ b/src/lib/mina_compile_config/mina_compile_config.ml @@ -29,15 +29,17 @@ module Inputs = struct ; max_action_elements : int ; zkapp_cmd_limit_hardcap : int ; zkapps_disabled : bool + ; sync_ledger_max_subtree_depth : int + ; sync_ledger_default_subtree_depth : int } - [@@deriving yojson] + [@@deriving yojson, bin_io_unversioned] end type t = { curve_size : int - ; default_transaction_fee : Currency.Fee.t - ; default_snark_worker_fee : Currency.Fee.t - ; minimum_user_command_fee : Currency.Fee.t + ; default_transaction_fee : Currency.Fee.Stable.Latest.t + ; default_snark_worker_fee : Currency.Fee.Stable.Latest.t + ; minimum_user_command_fee : Currency.Fee.Stable.Latest.t ; itn_features : bool ; compaction_interval : Time.Span.t option ; block_window_duration : Time.Span.t @@ -55,7 +57,10 @@ type t = ; max_action_elements : int ; zkapp_cmd_limit_hardcap : int ; zkapps_disabled : bool + ; sync_ledger_max_subtree_depth : int + ; sync_ledger_default_subtree_depth : int } +[@@deriving bin_io_unversioned] let make (inputs : Inputs.t) = { curve_size = inputs.curve_size @@ -88,6 +93,8 @@ let make (inputs : Inputs.t) = ; zkapp_cmd_limit = inputs.zkapp_cmd_limit ; zkapp_cmd_limit_hardcap = inputs.zkapp_cmd_limit_hardcap ; zkapps_disabled = inputs.zkapps_disabled + ; sync_ledger_max_subtree_depth = inputs.sync_ledger_max_subtree_depth + ; sync_ledger_default_subtree_depth = inputs.sync_ledger_default_subtree_depth } let to_yojson t = @@ -125,6 +132,9 @@ let to_yojson t = ) ; ("zkapp_cmd_limit_hardcap", `Int t.zkapp_cmd_limit_hardcap) ; ("zkapps_disabled", `Bool t.zkapps_disabled) + ; ("sync_ledger_max_subtree_depth", `Int t.sync_ledger_max_subtree_depth) + ; ( "sync_ledger_default_subtree_depth" + , `Int t.sync_ledger_default_subtree_depth ) ] (*TODO: Delete this module and read in a value from the environment*) @@ -154,6 +164,10 @@ module Compiled = struct ; zkapp_cmd_limit = Node_config.zkapp_cmd_limit ; zkapp_cmd_limit_hardcap = Node_config.zkapp_cmd_limit_hardcap ; zkapps_disabled = Node_config.zkapps_disabled + ; sync_ledger_max_subtree_depth = + Node_config.sync_ledger_max_subtree_depth + ; sync_ledger_default_subtree_depth = + Node_config.sync_ledger_default_subtree_depth } in make inputs @@ -195,6 +209,10 @@ module For_unit_tests = struct ; zkapp_cmd_limit_hardcap = Node_config_for_unit_tests.zkapp_cmd_limit_hardcap ; zkapps_disabled = Node_config_for_unit_tests.zkapps_disabled + ; sync_ledger_max_subtree_depth = + Node_config_for_unit_tests.sync_ledger_max_subtree_depth + ; sync_ledger_default_subtree_depth = + Node_config_for_unit_tests.sync_ledger_default_subtree_depth } in make inputs diff --git a/src/lib/mina_intf/transition_frontier_components_intf.ml b/src/lib/mina_intf/transition_frontier_components_intf.ml index ab57b4c3768..b9d042ba1b8 100644 --- a/src/lib/mina_intf/transition_frontier_components_intf.ml +++ b/src/lib/mina_intf/transition_frontier_components_intf.ml @@ -224,7 +224,7 @@ module type Sync_handler_intf = sig frontier:transition_frontier -> Ledger_hash.t -> Mina_ledger.Sync_ledger.Query.t Envelope.Incoming.t - -> logger:Logger.t + -> context:(module CONTEXT) -> trust_system:Trust_system.t -> Mina_ledger.Sync_ledger.Answer.t option Deferred.t diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index 972c8ec1375..a6410f96d8d 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -1606,7 +1606,8 @@ let create ~commit_id ?wallets (config : Config.t) = Vrf_evaluator.create ~commit_id ~constraint_constants ~pids:config.pids ~logger:config.logger ~conf_dir:config.conf_dir ~consensus_constants - ~keypairs:config.block_production_keypairs ) ) + ~keypairs:config.block_production_keypairs + ~compile_config:config.compile_config ) ) >>| Result.ok_exn in let snark_worker = diff --git a/src/lib/mina_lib/tests/tests.ml b/src/lib/mina_lib/tests/tests.ml index 4897b8a9b35..791b4027f59 100644 --- a/src/lib/mina_lib/tests/tests.ml +++ b/src/lib/mina_lib/tests/tests.ml @@ -425,7 +425,8 @@ let%test_module "Epoch ledger sync tests" = | Error _ -> failwith "Could not add starting account" ) ; let sync_ledger = - Mina_ledger.Sync_ledger.Db.create ~logger + Mina_ledger.Sync_ledger.Db.create + ~context:(module Context) ~trust_system:Context.trust_system db_ledger in let query_reader = diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index 412ea0a0c4f..e6f0048531b 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -456,7 +456,8 @@ module Answer_sync_ledger_query = struct let query = Envelope.Incoming.map request ~f:Tuple2.get2 in let%bind answer = let%bind.Deferred.Option frontier = return (get_transition_frontier ()) in - Sync_handler.answer_query ~frontier ledger_hash query ~logger + Sync_handler.answer_query ~frontier ledger_hash query + ~context:(module Context) ~trust_system in let result = diff --git a/src/lib/node_config/intf/node_config_intf.mli b/src/lib/node_config/intf/node_config_intf.mli index 3d2960cc380..82326fe2010 100644 --- a/src/lib/node_config/intf/node_config_intf.mli +++ b/src/lib/node_config/intf/node_config_intf.mli @@ -29,6 +29,10 @@ module type Unconfigurable_constants = sig val rpc_heartbeat_timeout_sec : float val rpc_heartbeat_send_every_sec : float + + val sync_ledger_max_subtree_depth : int + + val sync_ledger_default_subtree_depth : int end module type S = sig diff --git a/src/lib/node_config/unconfigurable_constants/node_config_unconfigurable_constants.ml b/src/lib/node_config/unconfigurable_constants/node_config_unconfigurable_constants.ml index 1097f348655..f841626d180 100644 --- a/src/lib/node_config/unconfigurable_constants/node_config_unconfigurable_constants.ml +++ b/src/lib/node_config/unconfigurable_constants/node_config_unconfigurable_constants.ml @@ -36,3 +36,7 @@ let rpc_handshake_timeout_sec = 60.0 let rpc_heartbeat_timeout_sec = 60.0 let rpc_heartbeat_send_every_sec = 10.0 (*same as the default*) + +let sync_ledger_max_subtree_depth = 8 + +let sync_ledger_default_subtree_depth = 6 diff --git a/src/lib/sync_handler/sync_handler.ml b/src/lib/sync_handler/sync_handler.ml index 0fd5643c7bf..5e6ebb65b41 100644 --- a/src/lib/sync_handler/sync_handler.ml +++ b/src/lib/sync_handler/sync_handler.ml @@ -90,16 +90,25 @@ module Make (Inputs : Inputs_intf) : frontier:Inputs.Transition_frontier.t -> Ledger_hash.t -> Sync_ledger.Query.t Envelope.Incoming.t - -> logger:Logger.t + -> context:(module CONTEXT) -> trust_system:Trust_system.t -> Sync_ledger.Answer.t Option.t Deferred.t = - fun ~frontier hash query ~logger ~trust_system -> + fun ~frontier hash query ~context ~trust_system -> + let (module Context) = context in + let (module C : Syncable_ledger.CONTEXT) = + ( module struct + let logger = Context.logger + + let compile_config = Context.compile_config + end ) + in match get_ledger_by_hash ~frontier hash with | None -> return None | Some ledger -> let responder = - Sync_ledger.Any_ledger.Responder.create ledger ignore ~logger + Sync_ledger.Any_ledger.Responder.create ledger ignore + ~context:(module C) ~trust_system in Sync_ledger.Any_ledger.Responder.answer_query responder query diff --git a/src/lib/syncable_ledger/dune b/src/lib/syncable_ledger/dune index fddc7b607a8..5e51630c4b9 100644 --- a/src/lib/syncable_ledger/dune +++ b/src/lib/syncable_ledger/dune @@ -22,6 +22,7 @@ direction error_json ppx_version.runtime + mina_compile_config ) (preprocess (pps ppx_mina ppx_version ppx_jane ppx_compare ppx_deriving_yojson ppx_register_event)) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 3a21a167755..ac8cb70bd4a 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -105,6 +105,12 @@ module Answer = struct end] end +module type CONTEXT = sig + val logger : Logger.t + + val compile_config : Mina_compile_config.t +end + module type Inputs_intf = sig module Addr : module type of Merkle_address @@ -159,7 +165,7 @@ module type S = sig val create : merkle_tree -> (query -> unit) - -> logger:Logger.t + -> context:(module CONTEXT) -> trust_system:Trust_system.t -> t @@ -168,7 +174,10 @@ module type S = sig end val create : - merkle_tree -> logger:Logger.t -> trust_system:Trust_system.t -> 'a t + merkle_tree + -> context:(module CONTEXT) + -> trust_system:Trust_system.t + -> 'a t val answer_writer : 'a t @@ -273,10 +282,6 @@ end = struct type query = Addr.t Query.t - let max_subtree_depth : int = 8 - - let default_subtree_depth : int = 4 - (* Provides addresses at an specific depth from this address *) let rec intermediate_range : index -> Addr.t -> index -> Addr.t list = fun ledger_depth addr i -> @@ -300,21 +305,23 @@ end = struct type t = { mt : MT.t ; f : query -> unit - ; logger : Logger.t + ; context : (module CONTEXT) ; trust_system : Trust_system.t } let create : MT.t -> (query -> unit) - -> logger:Logger.t + -> context:(module CONTEXT) -> trust_system:Trust_system.t -> t = - fun mt f ~logger ~trust_system -> { mt; f; logger; trust_system } + fun mt f ~context ~trust_system -> { mt; f; context; trust_system } let answer_query : t -> query Envelope.Incoming.t -> answer option Deferred.t = - fun { mt; f; logger; trust_system } query_envelope -> + fun { mt; f; context; trust_system } query_envelope -> + let (module Context) = context in + let open Context in let open Trust_system in let ledger_depth = MT.depth mt in let sender = Envelope.Incoming.sender query_envelope in @@ -394,7 +401,10 @@ end = struct (len, MT.get_inner_hash_at_addr_exn mt content_root_addr) ) | What_child_hashes (a, subtree_depth) -> ( match subtree_depth with - | n when n >= 1 && n <= max_subtree_depth -> ( + | n + when n >= 1 + && n <= Context.compile_config.sync_ledger_max_subtree_depth + -> ( let ledger_depth = MT.depth mt in let addresses = intermediate_range ledger_depth a subtree_depth @@ -409,7 +419,6 @@ end = struct | Ok answer -> Either.First answer | Error e -> - let logger = Logger.create () in [%log error] ~metadata:[ ("error", Error_json.error_to_yojson e) ] "When handling What_child_hashes request, the following \ @@ -420,7 +429,6 @@ end = struct ( "invalid address $addr in What_child_hashes request" , [ ("addr", Addr.to_yojson a) ] ) ) ) | _ -> - let logger = Logger.create () in [%log error] "When handling What_child_hashes request, the depth was \ outside the valid range" ; @@ -446,7 +454,6 @@ end = struct { mutable desired_root : Root_hash.t option ; mutable auxiliary_data : 'a option ; tree : MT.t - ; logger : Logger.t ; trust_system : Trust_system.t ; answers : (Root_hash.t * query * answer Envelope.Incoming.t) Linear_pipe.Reader.t @@ -460,6 +467,7 @@ end = struct ; waiting_content : Hash.t Addr.Table.t ; mutable validity_listener : [ `Ok | `Target_changed of Root_hash.t option * Root_hash.t ] Ivar.t + ; context : (module CONTEXT) } let t_of_sexp _ = failwith "t_of_sexp: not implemented" @@ -478,7 +486,9 @@ end = struct let expect_children : 'a t -> Addr.t -> Hash.t -> unit = fun t parent_addr expected -> - [%log' trace t.logger] + let (module Context) = t.context in + let open Context in + [%log trace] ~metadata: [ ("parent_address", Addr.to_yojson parent_addr) ; ("hash", Hash.to_yojson expected) @@ -488,7 +498,9 @@ end = struct let expect_content : 'a t -> Addr.t -> Hash.t -> unit = fun t addr expected -> - [%log' trace t.logger] + let (module Context) = t.context in + let open Context in + [%log trace] ~metadata: [ ("address", Addr.to_yojson addr); ("hash", Hash.to_yojson expected) ] "Expecting content addr $address, expected: $hash" ; @@ -503,13 +515,15 @@ end = struct -> [ `Success | `Hash_mismatch of Hash.t * Hash.t (** expected hash, actual *) ] = fun t addr content -> + let (module Context) = t.context in + let open Context in let expected = Addr.Table.find_exn t.waiting_content addr in (* TODO #444 should we batch all the updates and do them at the end? *) (* We might write the wrong data to the underlying ledger here, but if so we'll requeue the address and it'll be overwritten. *) MT.set_all_accounts_rooted_at_exn t.tree addr content ; Addr.Table.remove t.waiting_content addr ; - [%log' trace t.logger] + [%log trace] ~metadata: [ ("address", Addr.to_yojson addr); ("hash", Hash.to_yojson expected) ] "Found content addr $address, with hash $hash, removing from waiting \ @@ -555,11 +569,14 @@ end = struct | `Hash_mismatch of Hash.t * Hash.t | `Invalid_length ] = fun t addr nodes requested_depth -> + let (module Context) = t.context in let len = Array.length nodes in let is_power = Int.is_pow2 len in let is_more_than_two = len >= 2 in let subtree_depth = Int.ceil_log2 len in - let less_than_max = len <= Int.pow 2 max_subtree_depth in + let less_than_max = + len <= Int.pow 2 Context.compile_config.sync_ledger_max_subtree_depth + in let less_than_requested = subtree_depth <= requested_depth in let valid_length = is_power && is_more_than_two && less_than_requested && less_than_max @@ -592,11 +609,13 @@ end = struct else `Invalid_length let all_done t = + let (module Context) = t.context in + let open Context in if not (Root_hash.equal (MT.merkle_root t.tree) (desired_root_exn t)) then failwith "We finished syncing, but made a mistake somewhere :(" else ( if Ivar.is_full t.validity_listener then - [%log' error t.logger] "Ivar.fill bug is here!" ; + [%log error] "Ivar.fill bug is here!" ; Ivar.fill t.validity_listener `Ok ) (** Compute the hash of an empty tree of the specified height. *) @@ -623,6 +642,7 @@ end = struct the children. *) let handle_node t addr exp_hash = + let (module Context) = t.context in if Addr.depth addr >= MT.depth t.tree - account_subtree_height then ( expect_content t addr exp_hash ; Linear_pipe.write_without_pushback_if_open t.queries @@ -630,7 +650,9 @@ end = struct else ( expect_children t addr exp_hash ; Linear_pipe.write_without_pushback_if_open t.queries - (desired_root_exn t, What_child_hashes (addr, default_subtree_depth)) ) + ( desired_root_exn t + , What_child_hashes + (addr, Context.compile_config.sync_ledger_default_subtree_depth) ) ) (** Handle the initial Num_accounts message, starting the main syncing process. *) @@ -652,6 +674,8 @@ end = struct else `Hash_mismatch (rh, actual) let main_loop t = + let (module Context) = t.context in + let open Context in let handle_answer : Root_hash.t * Addr.t Query.t @@ -666,14 +690,14 @@ end = struct in let sender = Envelope.Incoming.sender env in let answer = Envelope.Incoming.data env in - [%log' trace t.logger] + [%log trace] ~metadata: [ ("root_hash", Root_hash.to_yojson root_hash) ; ("query", Query.to_yojson Addr.to_yojson query) ] "Handle answer for $root_hash" ; if not (Root_hash.equal root_hash (desired_root_exn t)) then ( - [%log' trace t.logger] + [%log trace] ~metadata: [ ("desired_hash", Root_hash.to_yojson (desired_root_exn t)) ; ("ignored_hash", Root_hash.to_yojson root_hash) @@ -683,8 +707,7 @@ end = struct else if already_done then ( (* This can happen if we asked for hashes that turn out to be equal in underlying ledger and the target. *) - [%log' debug t.logger] - "Got sync response when we're already finished syncing" ; + [%log debug] "Got sync response when we're already finished syncing" ; Deferred.unit ) else let open Trust_system in @@ -694,7 +717,7 @@ end = struct Linear_pipe.write_without_pushback_if_open t.queries (root_hash, query) in let credit_fulfilled_request () = - record_envelope_sender t.trust_system t.logger sender + record_envelope_sender t.trust_system logger sender ( Actions.Fulfilled_request , Some ( "sync ledger query $query" @@ -708,7 +731,7 @@ end = struct credit_fulfilled_request () | `Hash_mismatch (expected, actual) -> let%map () = - record_envelope_sender t.trust_system t.logger sender + record_envelope_sender t.trust_system logger sender ( Actions.Sent_bad_hash , Some ( "sent accounts $accounts for address $addr, they \ @@ -727,7 +750,7 @@ end = struct credit_fulfilled_request () | `Hash_mismatch (expected, actual) -> let%map () = - record_envelope_sender t.trust_system t.logger sender + record_envelope_sender t.trust_system logger sender ( Actions.Sent_bad_hash , Some ( "Claimed num_accounts $count, content root hash \ @@ -745,7 +768,7 @@ end = struct match add_subtree t address hashes requested_depth with | `Hash_mismatch (expected, actual) -> let%map () = - record_envelope_sender t.trust_system t.logger sender + record_envelope_sender t.trust_system logger sender ( Actions.Sent_bad_hash , Some ( "hashes sent for subtree on address $address merge \ @@ -757,12 +780,16 @@ end = struct requeue_query () | `Invalid_length -> let%map () = - record_envelope_sender t.trust_system t.logger sender + record_envelope_sender t.trust_system logger sender ( Actions.Sent_bad_hash , Some ( "hashes sent for subtree on address $address must \ be a power of 2 in the range 2-2^$depth" - , [ ("depth", `Int max_subtree_depth) ] ) ) + , [ ( "depth" + , `Int + Context.compile_config + .sync_ledger_max_subtree_depth ) + ] ) ) in requeue_query () | `Good children_to_verify -> @@ -771,7 +798,7 @@ end = struct credit_fulfilled_request () ) | query, answer -> let%map () = - record_envelope_sender t.trust_system t.logger sender + record_envelope_sender t.trust_system logger sender ( Actions.Violated_protocol , Some ( "Answered question we didn't ask! Query was $query \ @@ -789,13 +816,15 @@ end = struct (Option.value_exn t.desired_root) (MT.merkle_root t.tree) then ( - [%str_log' trace t.logger] Snarked_ledger_synced ; + [%str_log trace] Snarked_ledger_synced ; all_done t ) ; Deferred.unit in Linear_pipe.iter t.answers ~f:handle_answer let new_goal t h ~data ~equal = + let (module Context) = t.context in + let open Context in let should_skip = match t.desired_root with | None -> @@ -805,7 +834,7 @@ end = struct in if not should_skip then ( Option.iter t.desired_root ~f:(fun root_hash -> - [%log' debug t.logger] + [%log debug] ~metadata: [ ("old_root_hash", Root_hash.to_yojson root_hash) ; ("new_root_hash", Root_hash.to_yojson h) @@ -822,7 +851,7 @@ end = struct Option.fold t.auxiliary_data ~init:false ~f:(fun _ saved_data -> equal data saved_data ) then ( - [%log' debug t.logger] "New_goal to same hash, not doing anything" ; + [%log debug] "New_goal to same hash, not doing anything" ; `Repeat ) else ( t.auxiliary_data <- Some data ; @@ -856,14 +885,13 @@ end = struct ignore (new_goal t rh ~data ~equal : [ `New | `Repeat | `Update_data ]) ; wait_until_valid t rh - let create mt ~logger ~trust_system = + let create mt ~context ~trust_system = let qr, qw = Linear_pipe.create () in let ar, aw = Linear_pipe.create () in let t = { desired_root = None ; auxiliary_data = None ; tree = mt - ; logger ; trust_system ; answers = ar ; answer_writer = aw @@ -872,6 +900,7 @@ end = struct ; waiting_parents = Addr.Table.create () ; waiting_content = Addr.Table.create () ; validity_listener = Ivar.create () + ; context } in don't_wait_for (main_loop t) ; diff --git a/src/lib/syncable_ledger/test/test.ml b/src/lib/syncable_ledger/test/test.ml index 0d076706b12..e8e8046e52b 100644 --- a/src/lib/syncable_ledger/test/test.ml +++ b/src/lib/syncable_ledger/test/test.ml @@ -56,18 +56,25 @@ struct Async.Scheduler.set_record_backtraces true ; Core.Backtrace.elide := false + module Context : Syncable_ledger.CONTEXT = struct + let logger = logger + + let compile_config = Mina_compile_config.For_unit_tests.t + end + let%test "full_sync_entirely_different" = let l1, _k1 = Ledger.load_ledger 1 1 in let l2, _k2 = Ledger.load_ledger num_accts 2 in let desired_root = Ledger.merkle_root l2 in - let lsync = Sync_ledger.create l1 ~logger ~trust_system in + let lsync = Sync_ledger.create l1 ~context:(module Context) ~trust_system in let qr = Sync_ledger.query_reader lsync in let aw = Sync_ledger.answer_writer lsync in let seen_queries = ref [] in let sr = Sync_responder.create l2 (fun q -> seen_queries := q :: !seen_queries) - ~logger ~trust_system + ~context:(module Context) + ~trust_system in don't_wait_for (Linear_pipe.iter_unordered ~max_concurrency:3 qr @@ -103,7 +110,7 @@ struct let l2, _k2 = Ledger.load_ledger num_accts 2 in let l3, _k3 = Ledger.load_ledger num_accts 3 in let desired_root = ref @@ Ledger.merkle_root l2 in - let lsync = Sync_ledger.create l1 ~logger ~trust_system in + let lsync = Sync_ledger.create l1 ~context:(module Context) ~trust_system in let qr = Sync_ledger.query_reader lsync in let aw = Sync_ledger.answer_writer lsync in let seen_queries = ref [] in @@ -111,7 +118,8 @@ struct ref @@ Sync_responder.create l2 (fun q -> seen_queries := q :: !seen_queries) - ~logger ~trust_system + ~context:(module Context) + ~trust_system in let ctr = ref 0 in don't_wait_for @@ -123,7 +131,8 @@ struct sr := Sync_responder.create l3 (fun q -> seen_queries := q :: !seen_queries) - ~logger ~trust_system ; + ~context:(module Context) + ~trust_system ; desired_root := Ledger.merkle_root l3 ; ignore ( Sync_ledger.new_goal lsync !desired_root ~data:() diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 9d152fa7d8a..6ed2474988e 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -12,6 +12,8 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t + + val compile_config : Mina_compile_config.t end module Node = struct @@ -958,6 +960,8 @@ module For_tests = struct let precomputed_values = precomputed_values let consensus_constants = precomputed_values.consensus_constants + + let compile_config = Mina_compile_config.For_unit_tests.t end let verifier () = diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.mli b/src/lib/transition_frontier/full_frontier/full_frontier.mli index dc6614e3000..2d8f04c185b 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.mli +++ b/src/lib/transition_frontier/full_frontier/full_frontier.mli @@ -21,6 +21,8 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t + + val compile_config : Mina_compile_config.t end include Frontier_intf.S diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index 51a8715f4b9..b7519acd657 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -14,6 +14,8 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t + + val compile_config : Mina_compile_config.t end exception Invalid_genesis_state_hash of Mina_block.Validated.t diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index 52389205353..f1a63f517dc 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -24,6 +24,8 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t + + val compile_config : Mina_compile_config.t end let max_catchup_chunk_length = 20 @@ -719,6 +721,8 @@ module For_tests = struct let constraint_constants = precomputed_values.constraint_constants let consensus_constants = precomputed_values.consensus_constants + + let compile_config = Mina_compile_config.For_unit_tests.t end in let open Context in let open Quickcheck.Generator.Let_syntax in diff --git a/src/lib/transition_frontier/transition_frontier.mli b/src/lib/transition_frontier/transition_frontier.mli index 0e719016fa3..a2071bdd5e4 100644 --- a/src/lib/transition_frontier/transition_frontier.mli +++ b/src/lib/transition_frontier/transition_frontier.mli @@ -26,6 +26,8 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t + + val compile_config : Mina_compile_config.t end include Frontier_intf.S diff --git a/src/lib/transition_handler/validator.ml b/src/lib/transition_handler/validator.ml index dc8862b85fa..805a88b749e 100644 --- a/src/lib/transition_handler/validator.ml +++ b/src/lib/transition_handler/validator.ml @@ -14,6 +14,8 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t + + val compile_config : Mina_compile_config.t end let validate_header_is_relevant ~context:(module Context : CONTEXT) ~frontier diff --git a/src/lib/vrf_evaluator/dune b/src/lib/vrf_evaluator/dune index 02714054a68..cd1cacde338 100644 --- a/src/lib/vrf_evaluator/dune +++ b/src/lib/vrf_evaluator/dune @@ -28,6 +28,7 @@ logger logger.file_system ppx_version.runtime + mina_compile_config ) (instrumentation (backend bisect_ppx)) (preprocess (pps ppx_mina ppx_version ppx_jane))) diff --git a/src/lib/vrf_evaluator/vrf_evaluator.ml b/src/lib/vrf_evaluator/vrf_evaluator.ml index ff5b71ee4ed..561f9292f0a 100644 --- a/src/lib/vrf_evaluator/vrf_evaluator.ml +++ b/src/lib/vrf_evaluator/vrf_evaluator.ml @@ -10,6 +10,8 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t + + val compile_config : Mina_compile_config.t end (*Slot number within an epoch*) @@ -75,6 +77,7 @@ module Worker_state = struct type init_arg = { constraint_constants : Genesis_constants.Constraint_constants.t ; consensus_constants : Consensus.Constants.Stable.Latest.t + ; compile_config : Mina_compile_config.t ; conf_dir : string ; logger : Logger.t ; commit_id : string @@ -84,6 +87,7 @@ module Worker_state = struct let context_of_config ({ constraint_constants ; consensus_constants + ; compile_config ; logger ; conf_dir = _ ; commit_id = _ @@ -95,6 +99,8 @@ module Worker_state = struct let consensus_constants = consensus_constants let logger = logger + + let compile_config = compile_config end ) type t = @@ -414,7 +420,7 @@ let update_block_producer_keys { connection; process = _ } ~keypairs = ~arg:(Keypair.And_compressed_pk.Set.to_list keypairs) let create ~constraint_constants ~pids ~consensus_constants ~conf_dir ~logger - ~keypairs ~commit_id = + ~keypairs ~commit_id ~compile_config = let on_failure err = [%log error] "VRF evaluator process failed with error $err" ~metadata:[ ("err", Error_json.error_to_yojson err) ] ; @@ -424,7 +430,13 @@ let create ~constraint_constants ~pids ~consensus_constants ~conf_dir ~logger let%bind connection, process = Worker.spawn_in_foreground_exn ~connection_timeout:(Time.Span.of_min 1.) ~on_failure ~shutdown_on:Connection_closed ~connection_state_init_arg:() - { constraint_constants; consensus_constants; conf_dir; logger; commit_id } + { constraint_constants + ; consensus_constants + ; compile_config + ; conf_dir + ; logger + ; commit_id + } in [%log info] "Daemon started process of kind $process_kind with pid $vrf_evaluator_pid" From d26d01578ae711a1238f534510e8c54d286c05d8 Mon Sep 17 00:00:00 2001 From: Deepthi S Kumar Date: Mon, 11 Nov 2024 22:15:46 -0800 Subject: [PATCH 25/34] update sync ledger unit tests with variable subtree depths --- src/lib/syncable_ledger/test/test.ml | 228 ++++++++++++++++++++++----- 1 file changed, 189 insertions(+), 39 deletions(-) diff --git a/src/lib/syncable_ledger/test/test.ml b/src/lib/syncable_ledger/test/test.ml index e8e8046e52b..aa2bf874cb8 100644 --- a/src/lib/syncable_ledger/test/test.ml +++ b/src/lib/syncable_ledger/test/test.ml @@ -18,6 +18,8 @@ module type Input_intf = sig val equal : t -> t -> bool end + module Context : Syncable_ledger.CONTEXT + module Ledger : Ledger_intf with type root_hash := Root_hash.t @@ -35,6 +37,52 @@ module type Input_intf = sig and type answer := (Root_hash.t, Ledger.account) Syncable_ledger.Answer.t end +module Make_context (Subtree_depth : sig + val sync_ledger_max_subtree_depth : int + + val sync_ledger_default_subtree_depth : int +end) : Syncable_ledger.CONTEXT = struct + let logger = Logger.null () + + let compile_config = + { Mina_compile_config.For_unit_tests.t with + sync_ledger_max_subtree_depth = + Subtree_depth.sync_ledger_max_subtree_depth + ; sync_ledger_default_subtree_depth = + Subtree_depth.sync_ledger_default_subtree_depth + } +end + +module Context_subtree_depth32 = Make_context (struct + let sync_ledger_max_subtree_depth = 3 + + let sync_ledger_default_subtree_depth = 2 +end) + +module Context_subtree_depth81 = Make_context (struct + let sync_ledger_max_subtree_depth = 8 + + let sync_ledger_default_subtree_depth = 1 +end) + +module Context_subtree_depth82 = Make_context (struct + let sync_ledger_max_subtree_depth = 8 + + let sync_ledger_default_subtree_depth = 2 +end) + +module Context_subtree_depth86 = Make_context (struct + let sync_ledger_max_subtree_depth = 8 + + let sync_ledger_default_subtree_depth = 6 +end) + +module Context_subtree_depth88 = Make_context (struct + let sync_ledger_max_subtree_depth = 8 + + let sync_ledger_default_subtree_depth = 8 +end) + module Make_test (Input : Input_intf) (Input' : sig val num_accts : int @@ -48,20 +96,12 @@ struct * in before we need it. *) let total_queries = ref None - let logger = Logger.null () - let trust_system = Trust_system.null () let () = Async.Scheduler.set_record_backtraces true ; Core.Backtrace.elide := false - module Context : Syncable_ledger.CONTEXT = struct - let logger = logger - - let compile_config = Mina_compile_config.For_unit_tests.t - end - let%test "full_sync_entirely_different" = let l1, _k1 = Ledger.load_ledger 1 1 in let l2, _k2 = Ledger.load_ledger num_accts 2 in @@ -185,9 +225,10 @@ end (* Testing different ledger instantiations on Syncable_ledger *) module Db = struct - module Make (Depth : sig - val depth : int - end) = + module Make + (Context : Syncable_ledger.CONTEXT) (Depth : sig + val depth : int + end) = struct open Merkle_ledger_tests.Test_stubs @@ -251,19 +292,47 @@ module Db = struct module MT = Ledger include Base_ledger_inputs - let account_subtree_height = 3 + let account_subtree_height = 6 end module Sync_ledger = Syncable_ledger.Make (Syncable_ledger_inputs) + module Context = Context end - module DB3 = Make (struct - let depth = 3 - end) + module DB3 = + Make + (Context_subtree_depth32) + (struct + let depth = 3 + end) + + module DB16_subtree_depths81 = + Make + (Context_subtree_depth81) + (struct + let depth = 16 + end) + + module DB16_subtree_depths82 = + Make + (Context_subtree_depth82) + (struct + let depth = 16 + end) + + module DB16_subtree_depths86 = + Make + (Context_subtree_depth86) + (struct + let depth = 16 + end) - module DB16 = Make (struct - let depth = 16 - end) + module DB16_subtree_depths88 = + Make + (Context_subtree_depth88) + (struct + let depth = 16 + end) module TestDB3_3 = Make_test @@ -281,32 +350,55 @@ module Db = struct module TestDB16_20 = Make_test - (DB16) + (DB16_subtree_depths86) (struct let num_accts = 20 end) module TestDB16_1024 = Make_test - (DB16) + (DB16_subtree_depths86) (struct let num_accts = 1024 end) - module TestDB16_1026 = + module TestDB16_1026_subtree_depth81 = + Make_test + (DB16_subtree_depths81) + (struct + let num_accts = 1026 + end) + + module TestDB16_1026_subtree_depth82 = + Make_test + (DB16_subtree_depths82) + (struct + let num_accts = 1026 + end) + + module TestDB16_1026_subtree_depth86 = Make_test - (DB16) + (DB16_subtree_depths86) + (struct + let num_accts = 1026 + end) + + (*Test till sync_ledger_max_subtree_depth*) + module TestDB16_1026_subtree_depth88 = + Make_test + (DB16_subtree_depths88) (struct let num_accts = 1026 end) end module Mask = struct - module Make (Input : sig - val depth : int + module Make + (Context : Syncable_ledger.CONTEXT) (Input : sig + val depth : int - val mask_layers : int - end) = + val mask_layers : int + end) = struct open Merkle_ledger_tests.Test_stubs @@ -396,29 +488,66 @@ module Mask = struct module MT = Ledger include Base_ledger_inputs - let account_subtree_height = 3 + let account_subtree_height = 6 end module Sync_ledger = Syncable_ledger.Make (Syncable_ledger_inputs) + module Context = Context end - module Mask3_Layer1 = Make (struct - let depth = 3 + module Mask3_Layer1 = + Make + (Context_subtree_depth32) + (struct + let depth = 3 - let mask_layers = 1 - end) + let mask_layers = 1 + end) - module Mask16_Layer1 = Make (struct - let depth = 16 + module Mask16_Layer1 = + Make + (Context_subtree_depth32) + (struct + let depth = 16 - let mask_layers = 1 - end) + let mask_layers = 1 + end) + + module Mask16_Layer2 = + Make + (Context_subtree_depth32) + (struct + let depth = 16 + + let mask_layers = 2 + end) - module Mask16_Layer2 = Make (struct - let depth = 16 + module Mask16_Layer2_Depth81 = + Make + (Context_subtree_depth81) + (struct + let depth = 16 - let mask_layers = 2 - end) + let mask_layers = 2 + end) + + module Mask16_Layer2_Depth86 = + Make + (Context_subtree_depth86) + (struct + let depth = 16 + + let mask_layers = 2 + end) + + module Mask16_Layer2_Depth88 = + Make + (Context_subtree_depth88) + (struct + let depth = 16 + + let mask_layers = 2 + end) module TestMask3_Layer1_3 = Make_test @@ -461,4 +590,25 @@ module Mask = struct (struct let num_accts = 1024 end) + + module TestMask16_Layer2_1024_Depth81 = + Make_test + (Mask16_Layer2_Depth81) + (struct + let num_accts = 1024 + end) + + module TestMask16_Layer2_1024_Depth86 = + Make_test + (Mask16_Layer2_Depth86) + (struct + let num_accts = 1024 + end) + + module TestMask16_Layer2_1024_Depth88 = + Make_test + (Mask16_Layer2_Depth88) + (struct + let num_accts = 1024 + end) end From db106292cfc670c12df8d0b5cb488b9a5d2a3dab Mon Sep 17 00:00:00 2001 From: Deepthi S Kumar Date: Tue, 12 Nov 2024 15:42:45 -0800 Subject: [PATCH 26/34] move subtree depth constants to genesis constants, Runtime_config.daemon; use block window duration from runtime config and not compile config; remove compile_config from impacted contexts --- .../src/cli_entrypoint/mina_cli_entrypoint.ml | 4 +- src/lib/block_producer/block_producer.ml | 26 ++++++--- .../bootstrap_controller.ml | 58 ++++++++++--------- .../bootstrap_controller.mli | 2 - src/lib/consensus/intf.ml | 2 +- src/lib/consensus/proof_of_stake.ml | 6 +- src/lib/fake_network/fake_network.ml | 20 ++++--- src/lib/fake_network/fake_network.mli | 3 - .../genesis_constants/genesis_constants.ml | 5 ++ .../lib/genesis_ledger_helper_lib.ml | 6 ++ src/lib/ledger_catchup/ledger_catchup.ml | 2 - src/lib/ledger_catchup/ledger_catchup.mli | 2 - src/lib/ledger_catchup/normal_catchup.ml | 9 --- src/lib/ledger_catchup/super_catchup.ml | 21 ++++--- src/lib/mina_block/validation.ml | 2 +- src/lib/mina_block/validation.mli | 2 +- .../transition_frontier_components_intf.ml | 3 - src/lib/mina_lib/mina_lib.ml | 3 +- src/lib/mina_networking/mina_networking.ml | 2 - src/lib/mina_networking/mina_networking.mli | 2 - src/lib/mina_networking/rpcs.ml | 2 - src/lib/runtime_config/runtime_config.ml | 12 ++++ src/lib/sync_handler/sync_handler.ml | 18 +++--- src/lib/syncable_ledger/dune | 2 +- src/lib/syncable_ledger/syncable_ledger.ml | 12 ++-- src/lib/syncable_ledger/test/test.ml | 4 +- .../full_frontier/full_frontier.ml | 11 ++-- .../full_frontier/full_frontier.mli | 2 - .../persistent_frontier.ml | 2 - .../transition_frontier.ml | 4 +- .../transition_frontier.mli | 2 - .../transition_frontier_controller.ml | 2 - src/lib/transition_handler/processor.ml | 39 +++++++------ src/lib/transition_handler/validator.ml | 4 +- .../transition_router/transition_router.ml | 31 +++++++--- src/lib/vrf_evaluator/vrf_evaluator.ml | 12 ++-- 36 files changed, 184 insertions(+), 155 deletions(-) diff --git a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml index c5ee02445e7..06ddf962120 100644 --- a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml +++ b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml @@ -1045,13 +1045,11 @@ let setup_daemon logger ~itn_features ~default_snark_worker_fee = let module Context = struct let logger = logger - let precomputed_values = precomputed_values + let genesis_constants = precomputed_values.genesis_constants let constraint_constants = precomputed_values.constraint_constants let consensus_constants = precomputed_values.consensus_constants - - let compile_config = compile_config end in let consensus_local_state = Consensus.Data.Local_state.create diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index fc82d60271f..0a255388780 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -20,8 +20,6 @@ module type CONTEXT = sig val zkapp_cmd_limit : int option ref val vrf_poll_interval : Time.Span.t - - val compile_config : Mina_compile_config.t end type Structured_log_events.t += Block_produced @@ -664,7 +662,12 @@ let run ~context:(module Context : CONTEXT) ~vrf_evaluator ~prover ~verifier ~transition_writer ~set_next_producer_timing ~log_block_creation ~block_reward_threshold ~block_produced_bvar ~vrf_evaluation_state ~net ~zkapp_cmd_limit_hardcap = - let open Context in + let module Consensus_context = struct + include Context + + let genesis_constants = precomputed_values.genesis_constants + end in + let open Consensus_context in let constraint_constants = precomputed_values.constraint_constants in let consensus_constants = precomputed_values.consensus_constants in O1trace.sync_thread "produce_blocks" (fun () -> @@ -849,7 +852,7 @@ let run ~context:(module Context : CONTEXT) ~vrf_evaluator ~prover ~verifier Debug_assert.debug_assert (fun () -> [%test_result: [ `Take | `Keep ]] (Consensus.Hooks.select - ~context:(module Context) + ~context:(module Consensus_context) ~existing: (With_hash.map ~f:Mina_block.consensus_state previous_transition ) @@ -864,7 +867,7 @@ let run ~context:(module Context : CONTEXT) ~vrf_evaluator ~prover ~verifier in [%test_result: [ `Take | `Keep ]] (Consensus.Hooks.select - ~context:(module Context) + ~context:(module Consensus_context) ~existing:root_consensus_state_with_hashes ~candidate:consensus_state_with_hashes ) ~expect:`Take @@ -937,7 +940,7 @@ let run ~context:(module Context : CONTEXT) ~vrf_evaluator ~prover ~verifier `This_block_was_not_received_via_gossip >>= Validation.validate_frontier_dependencies ~to_header:Mina_block.header - ~context:(module Context) + ~context:(module Consensus_context) ~root_block: ( Transition_frontier.root frontier |> Breadcrumb.block_with_hash ) @@ -1412,10 +1415,15 @@ let run_precomputed ~context:(module Context : CONTEXT) ~verifier ~trust_system Header.protocol_state @@ Mina_block.header (With_hash.data previous_transition) in + let module Consensus_context = struct + include Context + + let genesis_constants = precomputed_values.genesis_constants + end in Debug_assert.debug_assert (fun () -> [%test_result: [ `Take | `Keep ]] (Consensus.Hooks.select - ~context:(module Context) + ~context:(module Consensus_context) ~existing: (With_hash.map ~f:Mina_block.consensus_state previous_transition ) @@ -1430,7 +1438,7 @@ let run_precomputed ~context:(module Context : CONTEXT) ~verifier ~trust_system in [%test_result: [ `Take | `Keep ]] (Consensus.Hooks.select - ~context:(module Context) + ~context:(module Consensus_context) ~existing:root_consensus_state_with_hashes ~candidate:consensus_state_with_hashes ) ~expect:`Take @@ -1468,7 +1476,7 @@ let run_precomputed ~context:(module Context : CONTEXT) ~verifier ~trust_system previous_protocol_state ) >>= Validation.validate_frontier_dependencies ~to_header:Mina_block.header - ~context:(module Context) + ~context:(module Consensus_context) ~root_block: ( Transition_frontier.root frontier |> Breadcrumb.block_with_hash ) diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index 70f23b0a488..5009e540988 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -18,8 +18,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end type Structured_log_events.t += Bootstrap_complete @@ -69,6 +67,8 @@ let worth_getting_root ({ context = (module Context); _ } as t) candidate = let module Context = struct include Context + let genesis_constants = precomputed_values.genesis_constants + let logger = Logger.extend logger [ ( "selection_context" @@ -153,7 +153,7 @@ let to_consensus_state h = the existing one, then reset the Sync_ledger's target by calling [start_sync_job_with_peer] function. *) let on_transition ({ context = (module Context); _ } as t) ~sender - ~root_sync_ledger ~genesis_constants candidate_header = + ~root_sync_ledger candidate_header = let open Context in let candidate_consensus_state = With_hash.map ~f:to_consensus_state candidate_header @@ -176,7 +176,7 @@ let on_transition ({ context = (module Context); _ } as t) ~sender match%bind Sync_handler.Root.verify ~context:(module Context) - ~verifier:t.verifier ~genesis_constants candidate_consensus_state + ~verifier:t.verifier candidate_consensus_state peer_root_with_proof.data with | Ok (`Root root, `Best_tip best_tip) -> @@ -190,7 +190,7 @@ let on_transition ({ context = (module Context); _ } as t) ~sender incoming transitions, add those to the transition_cache and calls [on_transition] function. *) let sync_ledger ({ context = (module Context); _ } as t) ~preferred - ~root_sync_ledger ~transition_graph ~sync_ledger_reader ~genesis_constants = + ~root_sync_ledger ~transition_graph ~sync_ledger_reader = let open Context in let query_reader = Sync_ledger.Db.query_reader root_sync_ledger in let response_writer = Sync_ledger.Db.answer_writer root_sync_ledger in @@ -233,11 +233,15 @@ let sync_ledger ({ context = (module Context); _ } as t) ~preferred ] ; Deferred.ignore_m - @@ on_transition t ~sender ~root_sync_ledger ~genesis_constants - header_with_hash ) + @@ on_transition t ~sender ~root_sync_ledger header_with_hash ) else Deferred.unit ) let external_transition_compare ~context:(module Context : CONTEXT) = + let module Consensus_context = struct + include Context + + let genesis_constants = precomputed_values.genesis_constants + end in let get_consensus_state = Fn.compose Protocol_state.consensus_state Mina_block.Header.protocol_state in @@ -251,7 +255,9 @@ let external_transition_compare ~context:(module Context : CONTEXT) = then 0 else if Consensus.Hooks.equal_select_status `Keep - @@ Consensus.Hooks.select ~context:(module Context) ~existing ~candidate + @@ Consensus.Hooks.select + ~context:(module Consensus_context) + ~existing ~candidate then -1 else 1 ) ~f:(With_hash.map ~f:get_consensus_state) @@ -274,10 +280,6 @@ let run ~context:(module Context : CONTEXT) ~trust_system ~verifier ~network ~persistent_frontier ~initial_root_transition ~catchup_mode = let open Context in O1trace.thread "bootstrap" (fun () -> - let genesis_constants = - Precomputed_values.genesis_constants precomputed_values - in - let constraint_constants = precomputed_values.constraint_constants in let rec loop previous_cycles = let sync_ledger_pipe = "sync ledger pipe" in let sync_ledger_reader, sync_ledger_writer = @@ -332,16 +334,21 @@ let run ~context:(module Context : CONTEXT) ~trust_system ~verifier ~network temp_persistent_root_instance in (* step 1. download snarked_ledger *) + let module Consensus_context = struct + include Context + + let genesis_constants = precomputed_values.genesis_constants + end in let%bind sync_ledger_time, (hash, sender, expected_staged_ledger_hash) = time_deferred (let root_sync_ledger = Sync_ledger.Db.create temp_snarked_ledger - ~context:(module Context) + ~context:(module Consensus_context) ~trust_system in don't_wait_for (sync_ledger t ~preferred:preferred_peers ~root_sync_ledger - ~transition_graph ~sync_ledger_reader ~genesis_constants ) ; + ~transition_graph ~sync_ledger_reader ) ; (* We ignore the resulting ledger returned here since it will always * be the same as the ledger we started with because we are syncing * a db ledger. *) @@ -568,7 +575,7 @@ let run ~context:(module Context : CONTEXT) ~trust_system ~verifier ~network [%log info] "Synchronizing consensus local state" ; let%map result = Consensus.Hooks.sync_local_state - ~context:(module Context) + ~context:(module Consensus_context) ~local_state:consensus_local_state ~trust_system ~glue_sync_ledger: (Mina_networking.glue_sync_ledger t.network) @@ -619,7 +626,7 @@ let run ~context:(module Context : CONTEXT) ~trust_system ~verifier ~network bootstrapping: " ^ msg ) in Transition_frontier.load - ~context:(module Context) + ~context:(module Consensus_context) ~retry_with_fresh_db:false ~verifier ~consensus_local_state ~persistent_root ~persistent_frontier ~catchup_mode () >>| function @@ -661,7 +668,7 @@ let run ~context:(module Context : CONTEXT) ~trust_system ~verifier ~network in Consensus.Hooks.equal_select_status `Take @@ Consensus.Hooks.select - ~context:(module Context) + ~context:(module Consensus_context) ~existing:root_consensus_state ~candidate: (With_hash.map @@ -730,8 +737,6 @@ let%test_module "Bootstrap_controller tests" = let constraint_constants = precomputed_values.constraint_constants - let compile_config = Mina_compile_config.For_unit_tests.t - module Context = struct let logger = Logger.create () @@ -741,8 +746,6 @@ let%test_module "Bootstrap_controller tests" = Genesis_constants.For_unit_tests.Constraint_constants.t let consensus_constants = precomputed_values.consensus_constants - - let compile_config = compile_config end let verifier = @@ -791,8 +794,7 @@ let%test_module "Bootstrap_controller tests" = let%bind fake_network = Fake_network.Generator.( gen ~precomputed_values ~verifier ~max_frontier_length - ~compile_config [ fresh_peer; fresh_peer ] - ~use_super_catchup:false) + [ fresh_peer; fresh_peer ] ~use_super_catchup:false) in let%map make_branch = Transition_frontier.Breadcrumb.For_tests.gen_seq ~precomputed_values @@ -820,17 +822,21 @@ let%test_module "Bootstrap_controller tests" = let bootstrap = make_non_running_bootstrap ~genesis_root ~network:me.network in + let module Consensus_context = struct + include Context + + let genesis_constants = precomputed_values.genesis_constants + end in let root_sync_ledger = Sync_ledger.Db.create (Transition_frontier.root_snarked_ledger me.state.frontier) - ~context:(module Context) + ~context:(module Consensus_context) ~trust_system in Async.Thread_safe.block_on_async_exn (fun () -> let sync_deferred = sync_ledger bootstrap ~root_sync_ledger ~transition_graph ~preferred:[] ~sync_ledger_reader - ~genesis_constants:Genesis_constants.For_unit_tests.t in let%bind () = Deferred.List.iter branch ~f:(fun breadcrumb -> @@ -927,7 +933,7 @@ let%test_module "Bootstrap_controller tests" = Quickcheck.test ~trials:1 Fake_network.Generator.( gen ~precomputed_values ~verifier ~max_frontier_length - ~use_super_catchup:false ~compile_config + ~use_super_catchup:false [ fresh_peer ; peer_with_branch ~frontier_branch_size:((max_frontier_length * 2) + 2) diff --git a/src/lib/bootstrap_controller/bootstrap_controller.mli b/src/lib/bootstrap_controller/bootstrap_controller.mli index df18118e515..d9730576a92 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.mli +++ b/src/lib/bootstrap_controller/bootstrap_controller.mli @@ -11,8 +11,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end type Structured_log_events.t += Bootstrap_complete [@@deriving register_event] diff --git a/src/lib/consensus/intf.ml b/src/lib/consensus/intf.ml index df4e178cac4..a00b0b62398 100644 --- a/src/lib/consensus/intf.ml +++ b/src/lib/consensus/intf.ml @@ -12,7 +12,7 @@ module type CONTEXT = sig val consensus_constants : Constants.t - val compile_config : Mina_compile_config.t + val genesis_constants : Genesis_constants.t end module type Constants = sig diff --git a/src/lib/consensus/proof_of_stake.ml b/src/lib/consensus/proof_of_stake.ml index 32abc3dd2e5..c3869c74ef9 100644 --- a/src/lib/consensus/proof_of_stake.ml +++ b/src/lib/consensus/proof_of_stake.ml @@ -31,7 +31,7 @@ module Make_str (A : Wire_types.Concrete) = struct val consensus_constants : Constants.t - val compile_config : Mina_compile_config.t + val genesis_constants : Genesis_constants.t end let make_checked t = Snark_params.Tick.Run.make_checked t @@ -3111,7 +3111,7 @@ module Make_str (A : Wire_types.Concrete) = struct let consensus_constants = Lazy.force Constants.for_unit_tests - let compile_config = Mina_compile_config.For_unit_tests.t + let genesis_constants = Genesis_constants.For_unit_tests.t end in (* Even when consensus constants are of prod sizes, candidate should still trigger a bootstrap *) should_bootstrap_len @@ -3439,7 +3439,7 @@ module Make_str (A : Wire_types.Concrete) = struct let consensus_constants = constants - let compile_config = Mina_compile_config.For_unit_tests.t + let genesis_constants = Genesis_constants.For_unit_tests.t end let test_update constraint_constants = diff --git a/src/lib/fake_network/fake_network.ml b/src/lib/fake_network/fake_network.ml index 81995f715b2..58cc462ac7b 100644 --- a/src/lib/fake_network/fake_network.ml +++ b/src/lib/fake_network/fake_network.ml @@ -14,8 +14,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end (* There must be at least 2 peers to create a network *) @@ -215,6 +213,11 @@ module Generator = struct ?get_transition_chain_proof ?get_ancestry ?get_best_tip ~context:(module Context : CONTEXT) ~verifier ~max_frontier_length ~use_super_catchup = + let module Consensus_context = struct + include Context + + let genesis_constants = precomputed_values.genesis_constants + end in let open Context in let epoch_ledger_location = Filename.temp_dir_name ^/ "epoch_ledger" @@ -223,7 +226,7 @@ module Generator = struct let genesis_ledger = Precomputed_values.genesis_ledger precomputed_values in let consensus_local_state = Consensus.Data.Local_state.create Public_key.Compressed.Set.empty - ~context:(module Context) + ~context:(module Consensus_context) ~genesis_ledger ~genesis_epoch_data:precomputed_values.genesis_epoch_data ~epoch_ledger_location @@ -257,6 +260,11 @@ module Generator = struct ?get_transition_chain_proof ?get_ancestry ?get_best_tip ~context:(module Context : CONTEXT) ~verifier ~max_frontier_length ~use_super_catchup = + let module Consensus_context = struct + include Context + + let genesis_constants = precomputed_values.genesis_constants + end in let open Context in let epoch_ledger_location = Filename.temp_dir_name ^/ "epoch_ledger" @@ -265,7 +273,7 @@ module Generator = struct let genesis_ledger = Precomputed_values.genesis_ledger precomputed_values in let consensus_local_state = Consensus.Data.Local_state.create Public_key.Compressed.Set.empty - ~context:(module Context) + ~context:(module Consensus_context) ~genesis_ledger ~genesis_epoch_data:precomputed_values.genesis_epoch_data ~epoch_ledger_location @@ -300,7 +308,7 @@ module Generator = struct let gen ?(logger = Logger.null ()) ~precomputed_values ~verifier ~max_frontier_length ~use_super_catchup - (configs : (peer_config, 'n num_peers) Gadt_lib.Vect.t) ~compile_config = + (configs : (peer_config, 'n num_peers) Gadt_lib.Vect.t) = (* TODO: Pass in *) let module Context = struct let logger = logger @@ -312,8 +320,6 @@ module Generator = struct let consensus_constants = precomputed_values.Precomputed_values.consensus_constants - - let compile_config = compile_config end in let open Quickcheck.Generator.Let_syntax in let%map states = diff --git a/src/lib/fake_network/fake_network.mli b/src/lib/fake_network/fake_network.mli index b3d041cf7f6..cee6df672f8 100644 --- a/src/lib/fake_network/fake_network.mli +++ b/src/lib/fake_network/fake_network.mli @@ -10,8 +10,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end (* There must be at least 2 peers to create a network *) @@ -100,6 +98,5 @@ module Generator : sig -> max_frontier_length:int -> use_super_catchup:bool -> (peer_config, 'n num_peers) Vect.t - -> compile_config:Mina_compile_config.t -> 'n num_peers t Generator.t end diff --git a/src/lib/genesis_constants/genesis_constants.ml b/src/lib/genesis_constants/genesis_constants.ml index 1f96fda1902..d2ba77df760 100644 --- a/src/lib/genesis_constants/genesis_constants.ml +++ b/src/lib/genesis_constants/genesis_constants.ml @@ -223,6 +223,8 @@ module T = struct ; max_action_elements : int ; zkapp_cmd_limit_hardcap : int ; minimum_user_command_fee : Currency.Fee.Stable.Latest.t + ; sync_ledger_default_subtree_depth : int + ; sync_ledger_max_subtree_depth : int } [@@deriving to_yojson, sexp_of, bin_io_unversioned] @@ -435,6 +437,9 @@ module Make (Node_config : Node_config_intf.S) : S = struct ; zkapp_cmd_limit_hardcap = Node_config.zkapp_cmd_limit_hardcap ; minimum_user_command_fee = Currency.Fee.of_mina_string_exn Node_config.minimum_user_command_fee + ; sync_ledger_max_subtree_depth = Node_config.sync_ledger_max_subtree_depth + ; sync_ledger_default_subtree_depth = + Node_config.sync_ledger_default_subtree_depth } end diff --git a/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml b/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml index 6ca2c3465b5..8e14b481e83 100644 --- a/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml +++ b/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml @@ -592,6 +592,12 @@ let make_genesis_constants ~logger ~(default : Genesis_constants.t) ; minimum_user_command_fee = Option.value ~default:default.minimum_user_command_fee (config.daemon >>= fun cfg -> cfg.minimum_user_command_fee) + ; sync_ledger_default_subtree_depth = + Option.value ~default:default.sync_ledger_default_subtree_depth + (config.daemon >>= fun cfg -> cfg.sync_ledger_default_subtree_depth) + ; sync_ledger_max_subtree_depth = + Option.value ~default:default.sync_ledger_max_subtree_depth + (config.daemon >>= fun cfg -> cfg.sync_ledger_max_subtree_depth) } let%test_module "Runtime config" = diff --git a/src/lib/ledger_catchup/ledger_catchup.ml b/src/lib/ledger_catchup/ledger_catchup.ml index 599dbcf587b..5e452ab565e 100644 --- a/src/lib/ledger_catchup/ledger_catchup.ml +++ b/src/lib/ledger_catchup/ledger_catchup.ml @@ -9,8 +9,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end let run ~context:(module Context : CONTEXT) ~trust_system ~verifier ~network diff --git a/src/lib/ledger_catchup/ledger_catchup.mli b/src/lib/ledger_catchup/ledger_catchup.mli index 03f94401b79..0a957e7e835 100644 --- a/src/lib/ledger_catchup/ledger_catchup.mli +++ b/src/lib/ledger_catchup/ledger_catchup.mli @@ -13,8 +13,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end module Catchup_jobs : sig diff --git a/src/lib/ledger_catchup/normal_catchup.ml b/src/lib/ledger_catchup/normal_catchup.ml index 99f0b38e200..bfd2607ad38 100644 --- a/src/lib/ledger_catchup/normal_catchup.ml +++ b/src/lib/ledger_catchup/normal_catchup.ml @@ -15,8 +15,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end (** [Ledger_catchup] is a procedure that connects a foreign external transition @@ -898,8 +896,6 @@ let%test_module "Ledger_catchup tests" = let constraint_constants = precomputed_values.constraint_constants - let compile_config = Mina_compile_config.For_unit_tests.t - let trust_system = Trust_system.null () let time_controller = Block_time.Controller.basic ~logger @@ -921,8 +917,6 @@ let%test_module "Ledger_catchup tests" = let constraint_constants = constraint_constants let consensus_constants = precomputed_values.consensus_constants - - let compile_config = compile_config end let downcast_transition transition = @@ -1047,7 +1041,6 @@ let%test_module "Ledger_catchup tests" = in gen ~precomputed_values ~verifier ~max_frontier_length ~use_super_catchup - ~compile_config:Mina_compile_config.For_unit_tests.t [ fresh_peer ; peer_with_branch ~frontier_branch_size:peer_branch_size ]) @@ -1069,7 +1062,6 @@ let%test_module "Ledger_catchup tests" = Fake_network.Generator.( gen ~precomputed_values ~verifier ~max_frontier_length ~use_super_catchup - ~compile_config:Mina_compile_config.For_unit_tests.t [ fresh_peer; peer_with_branch ~frontier_branch_size:1 ]) ~f:(fun network -> let open Fake_network in @@ -1085,7 +1077,6 @@ let%test_module "Ledger_catchup tests" = Fake_network.Generator.( gen ~precomputed_values ~verifier ~max_frontier_length ~use_super_catchup - ~compile_config:Mina_compile_config.For_unit_tests.t [ fresh_peer ; peer_with_branch ~frontier_branch_size:(max_frontier_length * 2) ]) diff --git a/src/lib/ledger_catchup/super_catchup.ml b/src/lib/ledger_catchup/super_catchup.ml index 4ca6305617c..507cd5eff88 100644 --- a/src/lib/ledger_catchup/super_catchup.ml +++ b/src/lib/ledger_catchup/super_catchup.ml @@ -16,8 +16,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end (** [Ledger_catchup] is a procedure that connects a foreign external transition @@ -768,6 +766,11 @@ let pick ~context:(module Context : CONTEXT) (x : Mina_state.Protocol_state.Value.t State_hash.With_state_hashes.t) (y : Mina_state.Protocol_state.Value.t State_hash.With_state_hashes.t) = let f = With_hash.map ~f:Mina_state.Protocol_state.consensus_state in + let module Context = struct + include Context + + let genesis_constants = precomputed_values.genesis_constants + end in match Consensus.Hooks.select ~context:(module Context) @@ -1449,8 +1452,6 @@ let%test_module "Ledger_catchup tests" = let use_super_catchup = true - let compile_config = Mina_compile_config.For_unit_tests.t - let verifier = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants @@ -1466,8 +1467,6 @@ let%test_module "Ledger_catchup tests" = let constraint_constants = constraint_constants let consensus_constants = precomputed_values.consensus_constants - - let compile_config = compile_config end (* let mock_verifier = @@ -1646,7 +1645,7 @@ let%test_module "Ledger_catchup tests" = Int.gen_incl (max_frontier_length / 2) (max_frontier_length - 1) in gen ~precomputed_values ~verifier ~max_frontier_length - ~use_super_catchup ~compile_config + ~use_super_catchup [ fresh_peer ; peer_with_branch ~frontier_branch_size:peer_branch_size ]) @@ -1666,7 +1665,7 @@ let%test_module "Ledger_catchup tests" = Quickcheck.test ~trials:1 Fake_network.Generator.( gen ~precomputed_values ~verifier ~max_frontier_length - ~use_super_catchup ~compile_config + ~use_super_catchup [ fresh_peer; peer_with_branch ~frontier_branch_size:1 ]) ~f:(fun network -> let open Fake_network in @@ -1682,7 +1681,7 @@ let%test_module "Ledger_catchup tests" = Quickcheck.test ~trials:1 Fake_network.Generator.( gen ~precomputed_values ~verifier ~max_frontier_length - ~use_super_catchup ~compile_config + ~use_super_catchup [ fresh_peer; peer_with_branch ~frontier_branch_size:1 ]) ~f:(fun network -> let open Fake_network in @@ -1699,7 +1698,7 @@ let%test_module "Ledger_catchup tests" = Quickcheck.test ~trials:1 Fake_network.Generator.( gen ~precomputed_values ~verifier ~max_frontier_length - ~use_super_catchup ~compile_config + ~use_super_catchup [ fresh_peer ; peer_with_branch ~frontier_branch_size:((max_frontier_length * 3) + 1) @@ -1777,7 +1776,7 @@ let%test_module "Ledger_catchup tests" = Quickcheck.test ~trials:1 Fake_network.Generator.( gen ~precomputed_values ~verifier ~max_frontier_length - ~use_super_catchup ~compile_config + ~use_super_catchup [ fresh_peer (* ; peer_with_branch ~frontier_branch_size:(max_frontier_length / 2) *) ; peer_with_branch_custom_rpc diff --git a/src/lib/mina_block/validation.ml b/src/lib/mina_block/validation.ml index 5254a05d2c1..d9bd83bdb73 100644 --- a/src/lib/mina_block/validation.ml +++ b/src/lib/mina_block/validation.ml @@ -19,7 +19,7 @@ module type CONTEXT = sig val consensus_constants : Consensus.Constants.t - val compile_config : Mina_compile_config.t + val genesis_constants : Genesis_constants.t end let validation (_, v) = v diff --git a/src/lib/mina_block/validation.mli b/src/lib/mina_block/validation.mli index 71881258304..97a4acb9d00 100644 --- a/src/lib/mina_block/validation.mli +++ b/src/lib/mina_block/validation.mli @@ -20,7 +20,7 @@ module type CONTEXT = sig val consensus_constants : Consensus.Constants.t - val compile_config : Mina_compile_config.t + val genesis_constants : Genesis_constants.t end val validation : diff --git a/src/lib/mina_intf/transition_frontier_components_intf.ml b/src/lib/mina_intf/transition_frontier_components_intf.ml index b9d042ba1b8..cfb4a797188 100644 --- a/src/lib/mina_intf/transition_frontier_components_intf.ml +++ b/src/lib/mina_intf/transition_frontier_components_intf.ml @@ -13,8 +13,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end module type Transition_handler_validator_intf = sig @@ -207,7 +205,6 @@ module type Consensus_best_tip_prover_intf = sig val verify : context:(module CONTEXT) -> verifier:Verifier.t - -> genesis_constants:Genesis_constants.t -> Consensus.Data.Consensus_state.Value.t State_hash.With_state_hashes.t -> ( Mina_block.t , State_body_hash.t list * Mina_block.t ) diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index a6410f96d8d..70c0fe033d6 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -1607,7 +1607,8 @@ let create ~commit_id ?wallets (config : Config.t) = ~pids:config.pids ~logger:config.logger ~conf_dir:config.conf_dir ~consensus_constants ~keypairs:config.block_production_keypairs - ~compile_config:config.compile_config ) ) + ~genesis_constants: + config.precomputed_values.genesis_constants ) ) >>| Result.ok_exn in let snark_worker = diff --git a/src/lib/mina_networking/mina_networking.ml b/src/lib/mina_networking/mina_networking.ml index 93a9522ec33..15dbc9ac89b 100644 --- a/src/lib/mina_networking/mina_networking.ml +++ b/src/lib/mina_networking/mina_networking.ml @@ -42,8 +42,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end module Node_status = Node_status diff --git a/src/lib/mina_networking/mina_networking.mli b/src/lib/mina_networking/mina_networking.mli index 1aaf511d8e2..d53ae824086 100644 --- a/src/lib/mina_networking/mina_networking.mli +++ b/src/lib/mina_networking/mina_networking.mli @@ -29,8 +29,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end module Node_status = Node_status diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index e6f0048531b..99882642c25 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -33,8 +33,6 @@ module type CONTEXT = sig val list_peers : unit -> Peer.t list Deferred.t val get_transition_frontier : unit -> Transition_frontier.t option - - val compile_config : Mina_compile_config.t end type ctx = (module CONTEXT) diff --git a/src/lib/runtime_config/runtime_config.ml b/src/lib/runtime_config/runtime_config.ml index 27cddee86de..7846e46f27e 100644 --- a/src/lib/runtime_config/runtime_config.ml +++ b/src/lib/runtime_config/runtime_config.ml @@ -514,6 +514,8 @@ module Json_layout = struct [@default None] [@key "validation-queue-size"] ; stop_time : int option [@default None] [@key "stop-time"] ; peers : string list option [@default None] [@key "peers"] + ; sync_ledger_max_subtree_depth : int option [@default None] + ; sync_ledger_default_subtree_depth : int option [@default None] } [@@deriving yojson, fields] @@ -1223,6 +1225,8 @@ module Daemon = struct ; validation_queue_size : int option [@default None] ; stop_time : int option [@default None] ; peers : string list option [@default None] + ; sync_ledger_max_subtree_depth : int option [@default None] + ; sync_ledger_default_subtree_depth : int option [@default None] } [@@deriving bin_io_unversioned, fields] @@ -1264,6 +1268,8 @@ module Daemon = struct ; validation_queue_size = None ; stop_time = None ; peers = None + ; sync_ledger_max_subtree_depth = None + ; sync_ledger_default_subtree_depth = None } let to_json_layout : t -> Json_layout.Daemon.t = Fn.id @@ -1354,6 +1360,12 @@ module Daemon = struct t2.validation_queue_size ; stop_time = opt_fallthrough ~default:t1.stop_time t2.stop_time ; peers = opt_fallthrough ~default:t1.peers t2.peers + ; sync_ledger_max_subtree_depth = + opt_fallthrough ~default:t1.sync_ledger_max_subtree_depth + t2.sync_ledger_max_subtree_depth + ; sync_ledger_default_subtree_depth = + opt_fallthrough ~default:t1.sync_ledger_default_subtree_depth + t2.sync_ledger_default_subtree_depth } end diff --git a/src/lib/sync_handler/sync_handler.ml b/src/lib/sync_handler/sync_handler.ml index 5e6ebb65b41..ef4e5d64efd 100644 --- a/src/lib/sync_handler/sync_handler.ml +++ b/src/lib/sync_handler/sync_handler.ml @@ -14,8 +14,6 @@ module type CONTEXT = sig 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 @@ -99,7 +97,7 @@ module Make (Inputs : Inputs_intf) : ( module struct let logger = Context.logger - let compile_config = Context.compile_config + let genesis_constants = Context.precomputed_values.genesis_constants end ) in match get_ledger_by_hash ~frontier hash with @@ -207,6 +205,8 @@ module Make (Inputs : Inputs_intf) : let module Context = struct include Context + let genesis_constants = precomputed_values.genesis_constants + let logger = Logger.extend logger [ ("selection_context", `String "Root.prove") ] end in @@ -229,20 +229,24 @@ module Make (Inputs : Inputs_intf) : data = With_hash.data best_tip_with_witness.data } - let verify ~context:(module Context : CONTEXT) ~verifier ~genesis_constants - observed_state peer_root = + let verify ~context:(module Context : CONTEXT) ~verifier observed_state + peer_root = let module Context = struct include Context + let genesis_constants = precomputed_values.genesis_constants + let logger = Logger.extend logger [ ("selection_context", `String "Root.verify") ] end in let open Context in let open Deferred.Result.Let_syntax in + (*TODO: use precomputed_values.genesis_constants that's already passed*) let%bind ( (`Root _, `Best_tip (best_tip_transition, _)) as verified_witness ) = - Best_tip_prover.verify ~verifier ~genesis_constants ~precomputed_values - peer_root + Best_tip_prover.verify ~verifier + ~genesis_constants:precomputed_values.genesis_constants + ~precomputed_values peer_root in let is_before_best_tip candidate = Consensus.Hooks.equal_select_status diff --git a/src/lib/syncable_ledger/dune b/src/lib/syncable_ledger/dune index 5e51630c4b9..d0c99d5fd6d 100644 --- a/src/lib/syncable_ledger/dune +++ b/src/lib/syncable_ledger/dune @@ -22,7 +22,7 @@ direction error_json ppx_version.runtime - mina_compile_config + genesis_constants ) (preprocess (pps ppx_mina ppx_version ppx_jane ppx_compare ppx_deriving_yojson ppx_register_event)) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index ac8cb70bd4a..9b9b4f50cf6 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -108,7 +108,7 @@ end module type CONTEXT = sig val logger : Logger.t - val compile_config : Mina_compile_config.t + val genesis_constants : Genesis_constants.t end module type Inputs_intf = sig @@ -403,7 +403,8 @@ end = struct match subtree_depth with | n when n >= 1 - && n <= Context.compile_config.sync_ledger_max_subtree_depth + && n + <= Context.genesis_constants.sync_ledger_max_subtree_depth -> ( let ledger_depth = MT.depth mt in let addresses = @@ -575,7 +576,7 @@ end = struct let is_more_than_two = len >= 2 in let subtree_depth = Int.ceil_log2 len in let less_than_max = - len <= Int.pow 2 Context.compile_config.sync_ledger_max_subtree_depth + len <= Int.pow 2 Context.genesis_constants.sync_ledger_max_subtree_depth in let less_than_requested = subtree_depth <= requested_depth in let valid_length = @@ -652,7 +653,8 @@ end = struct Linear_pipe.write_without_pushback_if_open t.queries ( desired_root_exn t , What_child_hashes - (addr, Context.compile_config.sync_ledger_default_subtree_depth) ) ) + (addr, Context.genesis_constants.sync_ledger_default_subtree_depth) + ) ) (** Handle the initial Num_accounts message, starting the main syncing process. *) @@ -787,7 +789,7 @@ end = struct be a power of 2 in the range 2-2^$depth" , [ ( "depth" , `Int - Context.compile_config + Context.genesis_constants .sync_ledger_max_subtree_depth ) ] ) ) in diff --git a/src/lib/syncable_ledger/test/test.ml b/src/lib/syncable_ledger/test/test.ml index aa2bf874cb8..078562e1d19 100644 --- a/src/lib/syncable_ledger/test/test.ml +++ b/src/lib/syncable_ledger/test/test.ml @@ -44,8 +44,8 @@ module Make_context (Subtree_depth : sig end) : Syncable_ledger.CONTEXT = struct let logger = Logger.null () - let compile_config = - { Mina_compile_config.For_unit_tests.t with + let genesis_constants = + { Genesis_constants.For_unit_tests.t with sync_ledger_max_subtree_depth = Subtree_depth.sync_ledger_max_subtree_depth ; sync_ledger_default_subtree_depth = diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 6ed2474988e..b999f0451fa 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -12,8 +12,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end module Node = struct @@ -565,6 +563,11 @@ let calculate_diffs ({ context = (module Context); _ } as t) breadcrumb = ] end in let open Diff in + let module Consensus_context = struct + include Context + + let genesis_constants = precomputed_values.genesis_constants + end in O1trace.sync_thread "calculate_diff_frontier_diffs" (fun () -> let breadcrumb_hash = Breadcrumb.state_hash breadcrumb in let parent_node = @@ -585,7 +588,7 @@ let calculate_diffs ({ context = (module Context); _ } as t) breadcrumb = if Consensus.Hooks.equal_select_status (Consensus.Hooks.select - ~context:(module Context) + ~context:(module Consensus_context) ~existing: (Breadcrumb.consensus_state_with_hashes current_best_tip) ~candidate:(Breadcrumb.consensus_state_with_hashes breadcrumb) ) @@ -961,7 +964,7 @@ module For_tests = struct let consensus_constants = precomputed_values.consensus_constants - let compile_config = Mina_compile_config.For_unit_tests.t + let genesis_constants = Genesis_constants.For_unit_tests.t end let verifier () = diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.mli b/src/lib/transition_frontier/full_frontier/full_frontier.mli index 2d8f04c185b..dc6614e3000 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.mli +++ b/src/lib/transition_frontier/full_frontier/full_frontier.mli @@ -21,8 +21,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end include Frontier_intf.S diff --git a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml index b7519acd657..51a8715f4b9 100644 --- a/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml +++ b/src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml @@ -14,8 +14,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end exception Invalid_genesis_state_hash of Mina_block.Validated.t diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index f1a63f517dc..b1c6c572337 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -24,8 +24,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end let max_catchup_chunk_length = 20 @@ -722,7 +720,7 @@ module For_tests = struct let consensus_constants = precomputed_values.consensus_constants - let compile_config = Mina_compile_config.For_unit_tests.t + let genesis_constants = precomputed_values.genesis_constants end in let open Context in let open Quickcheck.Generator.Let_syntax in diff --git a/src/lib/transition_frontier/transition_frontier.mli b/src/lib/transition_frontier/transition_frontier.mli index a2071bdd5e4..0e719016fa3 100644 --- a/src/lib/transition_frontier/transition_frontier.mli +++ b/src/lib/transition_frontier/transition_frontier.mli @@ -26,8 +26,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end include Frontier_intf.S diff --git a/src/lib/transition_frontier_controller/transition_frontier_controller.ml b/src/lib/transition_frontier_controller/transition_frontier_controller.ml index 738b7c3f577..7a28592ec8a 100644 --- a/src/lib/transition_frontier_controller/transition_frontier_controller.ml +++ b/src/lib/transition_frontier_controller/transition_frontier_controller.ml @@ -11,8 +11,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end let run ~context:(module Context : CONTEXT) ~trust_system ~verifier ~network diff --git a/src/lib/transition_handler/processor.ml b/src/lib/transition_handler/processor.ml index 78655b431c7..622d6b94391 100644 --- a/src/lib/transition_handler/processor.ml +++ b/src/lib/transition_handler/processor.ml @@ -25,8 +25,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end (* TODO: calculate a sensible value from postake consensus arguments *) @@ -114,7 +112,16 @@ let process_transition ~context:(module Context : CONTEXT) ~trust_system let is_block_in_frontier = Fn.compose Option.is_some @@ Transition_frontier.find frontier in - let open Context in + let module Consensus_context = struct + include Context + + let genesis_constants = precomputed_values.genesis_constants + end in + let open Consensus_context in + let block_window_duration = + Float.of_int constraint_constants.block_window_duration_ms + |> Time.Span.of_ms + in let header, transition_hash, transition_receipt_time, sender, validation = match block_or_header with | `Block cached_env -> @@ -165,15 +172,14 @@ let process_transition ~context:(module Context : CONTEXT) ~trust_system [%log internal] "Validate_frontier_dependencies" ; match Mina_block.Validation.validate_frontier_dependencies - ~context:(module Context) + ~context:(module Consensus_context) ~root_block ~is_block_in_frontier ~to_header:ident (Envelope.Incoming.data env) with | Ok _ | Error `Parent_missing_from_frontier -> [%log internal] "Schedule_catchup" ; Catchup_scheduler.watch_header catchup_scheduler ~valid_cb - ~block_window_duration:compile_config.block_window_duration - ~header_with_hash ; + ~block_window_duration ~header_with_hash ; return () | Error `Not_selected_over_frontier_root -> handle_not_selected () @@ -197,7 +203,7 @@ let process_transition ~context:(module Context : CONTEXT) ~trust_system [%log internal] "Validate_frontier_dependencies" ; match Mina_block.Validation.validate_frontier_dependencies - ~context:(module Context) + ~context:(module Consensus_context) ~root_block ~is_block_in_frontier ~to_header:Mina_block.header initially_validated_transition with @@ -240,8 +246,7 @@ let process_transition ~context:(module Context : CONTEXT) ~trust_system in Catchup_scheduler.watch catchup_scheduler ~timeout_duration ~cached_transition:cached_initially_validated_transition - ~valid_cb - ~block_window_duration:compile_config.block_window_duration ; + ~valid_cb ~block_window_duration ; return (Error ()) ) in (* TODO: only access parent in transition frontier once (already done in call to validate dependencies) #2485 *) @@ -286,7 +291,7 @@ let process_transition ~context:(module Context : CONTEXT) ~trust_system add_and_finalize ~logger ~frontier ~catchup_scheduler ~processed_transition_writer ~only_if_present:false ~time_controller ~source:`Gossip breadcrumb ~precomputed_values ~valid_cb - ~block_window_duration:compile_config.block_window_duration + ~block_window_duration in ( match result with | Ok () -> @@ -325,6 +330,10 @@ let run ~context:(module Context : CONTEXT) ~verifier ~trust_system , unit ) Writer.t ) ~processed_transition_writer = let open Context in + let block_window_duration = + Float.of_int constraint_constants.block_window_duration_ms + |> Time.Span.of_ms + in let catchup_scheduler = Catchup_scheduler.create ~logger ~precomputed_values ~verifier ~trust_system ~frontier ~time_controller ~catchup_job_writer ~catchup_breadcrumbs_writer @@ -380,8 +389,7 @@ let run ~context:(module Context : CONTEXT) ~verifier ~trust_system let%map result = add_and_finalize ~logger ~only_if_present:true ~source:`Catchup ~valid_cb b - ~block_window_duration: - compile_config.block_window_duration + ~block_window_duration in Internal_tracing.with_state_hash state_hash @@ fun () -> @@ -445,8 +453,7 @@ let run ~context:(module Context : CONTEXT) ~verifier ~trust_system match%map add_and_finalize ~logger ~only_if_present:false ~source:`Internal breadcrumb ~valid_cb:None - ~block_window_duration: - compile_config.block_window_duration + ~block_window_duration with | Ok () -> [%log internal] "Breadcrumb_integrated" ; @@ -494,8 +501,6 @@ let%test_module "Transition_handler.Processor tests" = let trust_system = Trust_system.null () - let compile_config = Mina_compile_config.For_unit_tests.t - let verifier = Async.Thread_safe.block_on_async_exn (fun () -> Verifier.create ~logger ~proof_level ~constraint_constants @@ -511,8 +516,6 @@ let%test_module "Transition_handler.Processor tests" = let constraint_constants = constraint_constants let consensus_constants = precomputed_values.consensus_constants - - let compile_config = compile_config end let downcast_breadcrumb breadcrumb = diff --git a/src/lib/transition_handler/validator.ml b/src/lib/transition_handler/validator.ml index 805a88b749e..20ee229dbfd 100644 --- a/src/lib/transition_handler/validator.ml +++ b/src/lib/transition_handler/validator.ml @@ -14,8 +14,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end let validate_header_is_relevant ~context:(module Context : CONTEXT) ~frontier @@ -24,6 +22,8 @@ let validate_header_is_relevant ~context:(module Context : CONTEXT) ~frontier let module Context = struct include Context + let genesis_constants = precomputed_values.genesis_constants + let logger = Logger.extend logger [ ("selection_context", `String "Transition_handler.Validator") ] diff --git a/src/lib/transition_router/transition_router.ml b/src/lib/transition_router/transition_router.ml index a8b57177966..21855ad463a 100644 --- a/src/lib/transition_router/transition_router.ml +++ b/src/lib/transition_router/transition_router.ml @@ -12,8 +12,6 @@ module type CONTEXT = sig val constraint_constants : Genesis_constants.Constraint_constants.t val consensus_constants : Consensus.Constants.t - - val compile_config : Mina_compile_config.t end type Structured_log_events.t += Starting_transition_frontier_controller @@ -57,8 +55,8 @@ let to_consensus_state h = (Fn.compose Mina_state.Protocol_state.consensus_state Mina_block.Header.protocol_state ) -let is_transition_for_bootstrap ~context:(module Context : CONTEXT) frontier - new_header = +let is_transition_for_bootstrap + ~context:(module Context : Consensus.Intf.CONTEXT) frontier new_header = let root_consensus_state = Transition_frontier.root frontier |> Transition_frontier.Breadcrumb.consensus_state_with_hashes @@ -285,6 +283,11 @@ let download_best_tip ~context:(module Context : CONTEXT) ~notify_online [ ("actual", `Int (List.length tips)); ("expected", `Int num_peers) ] "Finished requesting tips. Got $actual / $expected" ; let%map () = notify_online () in + let module Consensus_context = struct + include Context + + let genesis_constants = precomputed_values.genesis_constants + end in let res = List.fold tips ~init:None ~f:(fun acc enveloped_candidate_best_tip -> Option.merge acc (Option.return enveloped_candidate_best_tip) @@ -295,7 +298,7 @@ let download_best_tip ~context:(module Context : CONTEXT) ~notify_online in match Consensus.Hooks.select - ~context:(module Context) + ~context:(module Consensus_context) ~existing:(f enveloped_existing_best_tip.data.data) ~candidate:(f enveloped_candidate_best_tip.data.data) with @@ -404,6 +407,11 @@ let initialize ~context:(module Context : CONTEXT) ~sync_local_state ~network let genesis_constants = Precomputed_values.genesis_constants precomputed_values in + let module Consensus_context = struct + include Context + + let genesis_constants = precomputed_values.genesis_constants + end in match%bind Deferred.both (download_best_tip @@ -433,7 +441,7 @@ let initialize ~context:(module Context : CONTEXT) ~sync_local_state ~network (Option.map ~f:(fun x -> `Block x) best_seen_transition) | Some best_tip, Some frontier when is_transition_for_bootstrap - ~context:(module Context) + ~context:(module Consensus_context) frontier ( best_tip |> Envelope.Incoming.data |> Mina_block.Validation.to_header ) -> @@ -503,7 +511,7 @@ let initialize ~context:(module Context : CONTEXT) ~sync_local_state ~network Consensus.Hooks.sync_local_state ~local_state:consensus_local_state ~glue_sync_ledger:(Mina_networking.glue_sync_ledger network) - ~context:(module Context) + ~context:(module Consensus_context) ~trust_system sync_jobs with | Error e -> @@ -569,6 +577,11 @@ let run ?(sync_local_state = true) ?(cache_exceptions = false) ~get_most_recent_valid_block ~most_recent_valid_block_writer ~get_completed_work ~catchup_mode ~notify_online () = let open Context in + let module Consensus_context = struct + include Context + + let genesis_constants = precomputed_values.genesis_constants + end in [%log info] "Starting transition router" ; let initialization_finish_signal = Ivar.create () in let clear_reader, clear_writer = @@ -662,7 +675,7 @@ let run ?(sync_local_state = true) ?(cache_exceptions = false) if Consensus.Hooks.equal_select_status `Take (Consensus.Hooks.select - ~context:(module Context) + ~context:(module Consensus_context) ~existing:(to_consensus_state current_header_with_hash) ~candidate:(to_consensus_state header_with_hash) ) then @@ -682,7 +695,7 @@ let run ?(sync_local_state = true) ?(cache_exceptions = false) | Some frontier -> if is_transition_for_bootstrap - ~context:(module Context) + ~context:(module Consensus_context) frontier header_with_hash then ( Strict_pipe.Writer.kill !transition_writer_ref ; diff --git a/src/lib/vrf_evaluator/vrf_evaluator.ml b/src/lib/vrf_evaluator/vrf_evaluator.ml index 561f9292f0a..baab2b8e7e6 100644 --- a/src/lib/vrf_evaluator/vrf_evaluator.ml +++ b/src/lib/vrf_evaluator/vrf_evaluator.ml @@ -11,7 +11,7 @@ module type CONTEXT = sig val consensus_constants : Consensus.Constants.t - val compile_config : Mina_compile_config.t + val genesis_constants : Genesis_constants.t end (*Slot number within an epoch*) @@ -77,7 +77,7 @@ module Worker_state = struct type init_arg = { constraint_constants : Genesis_constants.Constraint_constants.t ; consensus_constants : Consensus.Constants.Stable.Latest.t - ; compile_config : Mina_compile_config.t + ; genesis_constants : Genesis_constants.t ; conf_dir : string ; logger : Logger.t ; commit_id : string @@ -87,7 +87,7 @@ module Worker_state = struct let context_of_config ({ constraint_constants ; consensus_constants - ; compile_config + ; genesis_constants ; logger ; conf_dir = _ ; commit_id = _ @@ -100,7 +100,7 @@ module Worker_state = struct let logger = logger - let compile_config = compile_config + let genesis_constants = genesis_constants end ) type t = @@ -420,7 +420,7 @@ let update_block_producer_keys { connection; process = _ } ~keypairs = ~arg:(Keypair.And_compressed_pk.Set.to_list keypairs) let create ~constraint_constants ~pids ~consensus_constants ~conf_dir ~logger - ~keypairs ~commit_id ~compile_config = + ~keypairs ~commit_id ~genesis_constants = let on_failure err = [%log error] "VRF evaluator process failed with error $err" ~metadata:[ ("err", Error_json.error_to_yojson err) ] ; @@ -432,7 +432,7 @@ let create ~constraint_constants ~pids ~consensus_constants ~conf_dir ~logger ~on_failure ~shutdown_on:Connection_closed ~connection_state_init_arg:() { constraint_constants ; consensus_constants - ; compile_config + ; genesis_constants ; conf_dir ; logger ; commit_id From c14616d7203223e20880a0135dca8ffd05c95af0 Mon Sep 17 00:00:00 2001 From: Deepthi S Kumar Date: Tue, 19 Nov 2024 11:24:21 -0800 Subject: [PATCH 27/34] move sync ledger constants back to compile time --- .../src/cli_entrypoint/mina_cli_entrypoint.ml | 2 +- src/config/dev.mlh | 4 ++++ src/config/devnet.mlh | 4 ++++ src/config/lightnet.mlh | 4 ++++ src/config/mainnet.mlh | 4 ++++ src/lib/block_producer/block_producer.ml | 4 ++-- .../bootstrap_controller.ml | 12 +++++----- src/lib/consensus/intf.ml | 2 +- src/lib/consensus/proof_of_stake.ml | 6 ++--- src/lib/fake_network/fake_network.ml | 4 ++-- .../genesis_constants/genesis_constants.ml | 4 ---- .../lib/genesis_ledger_helper_lib.ml | 6 ----- src/lib/ledger_catchup/super_catchup.ml | 2 +- src/lib/mina_block/validation.ml | 2 +- src/lib/mina_block/validation.mli | 2 +- .../mina_compile_config.ml | 23 ++++++++++++++++--- src/lib/mina_lib/mina_lib.ml | 6 +++-- .../node_config_for_unit_tests.ml | 4 ++++ .../node_config_for_unit_tests.mli | 4 ++++ src/lib/node_config/intf/node_config_intf.mli | 4 ++++ src/lib/node_config/node_config.ml | 5 ++++ src/lib/runtime_config/runtime_config.ml | 15 ++++++------ src/lib/sync_handler/sync_handler.ml | 6 ++--- src/lib/syncable_ledger/dune | 2 +- src/lib/syncable_ledger/syncable_ledger.ml | 12 ++++------ .../full_frontier/full_frontier.ml | 4 ++-- .../transition_frontier.ml | 2 +- src/lib/transition_handler/processor.ml | 2 +- src/lib/transition_handler/validator.ml | 2 +- .../transition_router/transition_router.ml | 6 ++--- src/lib/vrf_evaluator/vrf_evaluator.ml | 12 +++++----- 31 files changed, 105 insertions(+), 66 deletions(-) diff --git a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml index 0b2e187db3d..491c63c8125 100644 --- a/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml +++ b/src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml @@ -1006,7 +1006,7 @@ let setup_daemon logger ~itn_features = let module Context = struct let logger = logger - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config let constraint_constants = precomputed_values.constraint_constants diff --git a/src/config/dev.mlh b/src/config/dev.mlh index 85914d9c89a..a2bea1045b3 100644 --- a/src/config/dev.mlh +++ b/src/config/dev.mlh @@ -83,3 +83,7 @@ [%%undef compaction_interval] [%%define vrf_poll_interval 0] [%%undef zkapp_cmd_limit] + +(* Sync ledger query/response size*) +[%%define sync_ledger_max_subtree_depth 4] +[%%define sync_ledger_default_subtree_depth 3] diff --git a/src/config/devnet.mlh b/src/config/devnet.mlh index d3e0dbe3aa7..0b27ffe230b 100644 --- a/src/config/devnet.mlh +++ b/src/config/devnet.mlh @@ -78,3 +78,7 @@ [%%define vrf_poll_interval 5000] [%%define zkapp_cmd_limit 24] [%%undef scan_state_transaction_capacity_log_2] + +(* Constants determining sync ledger query/response size*) +[%%define sync_ledger_max_subtree_depth 8] +[%%define sync_ledger_default_subtree_depth 6] \ No newline at end of file diff --git a/src/config/lightnet.mlh b/src/config/lightnet.mlh index a1fdf739640..d59207c06cf 100644 --- a/src/config/lightnet.mlh +++ b/src/config/lightnet.mlh @@ -77,3 +77,7 @@ [%%define compaction_interval 360000] [%%define vrf_poll_interval 5000] [%%undef zkapp_cmd_limit] + +(* Constants determining sync ledger query/response size*) +[%%define sync_ledger_max_subtree_depth 8] +[%%define sync_ledger_default_subtree_depth 6] diff --git a/src/config/mainnet.mlh b/src/config/mainnet.mlh index 777cdb5ec6e..1af34773c8a 100644 --- a/src/config/mainnet.mlh +++ b/src/config/mainnet.mlh @@ -78,3 +78,7 @@ [%%define vrf_poll_interval 5000] [%%define zkapp_cmd_limit 24] [%%undef scan_state_transaction_capacity_log_2] + +(* Constants determining sync ledger query/response size*) +[%%define sync_ledger_max_subtree_depth 8] +[%%define sync_ledger_default_subtree_depth 6] diff --git a/src/lib/block_producer/block_producer.ml b/src/lib/block_producer/block_producer.ml index 2b8ee32c1c3..17d0904b90d 100644 --- a/src/lib/block_producer/block_producer.ml +++ b/src/lib/block_producer/block_producer.ml @@ -821,7 +821,7 @@ let produce ~genesis_breadcrumb ~context:(module Context : CONTEXT) ~prover let module Consensus_context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config end in Internal_tracing.with_state_hash protocol_state_hashes.state_hash @@ fun () -> @@ -1419,7 +1419,7 @@ let run_precomputed ~context:(module Context : CONTEXT) ~verifier ~trust_system let module Consensus_context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config end in Debug_assert.debug_assert (fun () -> [%test_result: [ `Take | `Keep ]] diff --git a/src/lib/bootstrap_controller/bootstrap_controller.ml b/src/lib/bootstrap_controller/bootstrap_controller.ml index cc54647d1a9..85c771e27b2 100644 --- a/src/lib/bootstrap_controller/bootstrap_controller.ml +++ b/src/lib/bootstrap_controller/bootstrap_controller.ml @@ -64,10 +64,10 @@ let time_deferred deferred = (Time.diff end_time start_time, result) let worth_getting_root ({ context = (module Context); _ } as t) candidate = - let module Context = struct + let module Consensus_context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config let logger = Logger.extend logger @@ -77,7 +77,7 @@ let worth_getting_root ({ context = (module Context); _ } as t) candidate = end in Consensus.Hooks.equal_select_status `Take @@ Consensus.Hooks.select - ~context:(module Context) + ~context:(module Consensus_context) ~existing: ( t.best_seen_transition |> Mina_block.Validation.block_with_hash |> With_hash.map ~f:Mina_block.consensus_state ) @@ -240,7 +240,7 @@ let external_transition_compare ~context:(module Context : CONTEXT) = let module Consensus_context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config end in let get_consensus_state = Fn.compose Protocol_state.consensus_state Mina_block.Header.protocol_state @@ -337,7 +337,7 @@ let run ~context:(module Context : CONTEXT) ~trust_system ~verifier ~network let module Consensus_context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config end in let%bind sync_ledger_time, (hash, sender, expected_staged_ledger_hash) = time_deferred @@ -823,7 +823,7 @@ let%test_module "Bootstrap_controller tests" = let module Consensus_context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config end in let root_sync_ledger = Sync_ledger.Db.create diff --git a/src/lib/consensus/intf.ml b/src/lib/consensus/intf.ml index a00b0b62398..df4e178cac4 100644 --- a/src/lib/consensus/intf.ml +++ b/src/lib/consensus/intf.ml @@ -12,7 +12,7 @@ module type CONTEXT = sig val consensus_constants : Constants.t - val genesis_constants : Genesis_constants.t + val compile_config : Mina_compile_config.t end module type Constants = sig diff --git a/src/lib/consensus/proof_of_stake.ml b/src/lib/consensus/proof_of_stake.ml index c3869c74ef9..32abc3dd2e5 100644 --- a/src/lib/consensus/proof_of_stake.ml +++ b/src/lib/consensus/proof_of_stake.ml @@ -31,7 +31,7 @@ module Make_str (A : Wire_types.Concrete) = struct val consensus_constants : Constants.t - val genesis_constants : Genesis_constants.t + val compile_config : Mina_compile_config.t end let make_checked t = Snark_params.Tick.Run.make_checked t @@ -3111,7 +3111,7 @@ module Make_str (A : Wire_types.Concrete) = struct let consensus_constants = Lazy.force Constants.for_unit_tests - let genesis_constants = Genesis_constants.For_unit_tests.t + let compile_config = Mina_compile_config.For_unit_tests.t end in (* Even when consensus constants are of prod sizes, candidate should still trigger a bootstrap *) should_bootstrap_len @@ -3439,7 +3439,7 @@ module Make_str (A : Wire_types.Concrete) = struct let consensus_constants = constants - let genesis_constants = Genesis_constants.For_unit_tests.t + let compile_config = Mina_compile_config.For_unit_tests.t end let test_update constraint_constants = diff --git a/src/lib/fake_network/fake_network.ml b/src/lib/fake_network/fake_network.ml index 58cc462ac7b..f79896b05c0 100644 --- a/src/lib/fake_network/fake_network.ml +++ b/src/lib/fake_network/fake_network.ml @@ -216,7 +216,7 @@ module Generator = struct let module Consensus_context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config end in let open Context in let epoch_ledger_location = @@ -263,7 +263,7 @@ module Generator = struct let module Consensus_context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config end in let open Context in let epoch_ledger_location = diff --git a/src/lib/genesis_constants/genesis_constants.ml b/src/lib/genesis_constants/genesis_constants.ml index a2fb1a3ff6c..c02e60fc7a5 100644 --- a/src/lib/genesis_constants/genesis_constants.ml +++ b/src/lib/genesis_constants/genesis_constants.ml @@ -223,8 +223,6 @@ module T = struct ; max_action_elements : int ; zkapp_cmd_limit_hardcap : int ; minimum_user_command_fee : Currency.Fee.Stable.Latest.t - ; sync_ledger_default_subtree_depth : int - ; sync_ledger_max_subtree_depth : int } [@@deriving to_yojson, sexp_of, bin_io_unversioned] @@ -436,8 +434,6 @@ module Make (Node_config : Node_config_intf.S) : S = struct ; zkapp_cmd_limit_hardcap = 128 ; minimum_user_command_fee = Currency.Fee.of_mina_string_exn Node_config.minimum_user_command_fee - ; sync_ledger_max_subtree_depth = 8 - ; sync_ledger_default_subtree_depth = 6 } end diff --git a/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml b/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml index 68bb2d2f151..7f886539d1d 100644 --- a/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml +++ b/src/lib/genesis_ledger_helper/lib/genesis_ledger_helper_lib.ml @@ -577,12 +577,6 @@ let make_genesis_constants ~logger ~(default : Genesis_constants.t) ; minimum_user_command_fee = Option.value ~default:default.minimum_user_command_fee (config.daemon >>= fun cfg -> cfg.minimum_user_command_fee) - ; sync_ledger_default_subtree_depth = - Option.value ~default:default.sync_ledger_default_subtree_depth - (config.daemon >>= fun cfg -> cfg.sync_ledger_default_subtree_depth) - ; sync_ledger_max_subtree_depth = - Option.value ~default:default.sync_ledger_max_subtree_depth - (config.daemon >>= fun cfg -> cfg.sync_ledger_max_subtree_depth) } let%test_module "Runtime config" = diff --git a/src/lib/ledger_catchup/super_catchup.ml b/src/lib/ledger_catchup/super_catchup.ml index a92306be64f..c276b5fbf2e 100644 --- a/src/lib/ledger_catchup/super_catchup.ml +++ b/src/lib/ledger_catchup/super_catchup.ml @@ -769,7 +769,7 @@ let pick ~context:(module Context : CONTEXT) let module Context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config end in match Consensus.Hooks.select diff --git a/src/lib/mina_block/validation.ml b/src/lib/mina_block/validation.ml index d9bd83bdb73..5254a05d2c1 100644 --- a/src/lib/mina_block/validation.ml +++ b/src/lib/mina_block/validation.ml @@ -19,7 +19,7 @@ module type CONTEXT = sig val consensus_constants : Consensus.Constants.t - val genesis_constants : Genesis_constants.t + val compile_config : Mina_compile_config.t end let validation (_, v) = v diff --git a/src/lib/mina_block/validation.mli b/src/lib/mina_block/validation.mli index 97a4acb9d00..71881258304 100644 --- a/src/lib/mina_block/validation.mli +++ b/src/lib/mina_block/validation.mli @@ -20,7 +20,7 @@ module type CONTEXT = sig val consensus_constants : Consensus.Constants.t - val genesis_constants : Genesis_constants.t + val compile_config : Mina_compile_config.t end val validation : diff --git a/src/lib/mina_compile_config/mina_compile_config.ml b/src/lib/mina_compile_config/mina_compile_config.ml index 17849c24d10..fd47b4f12b2 100644 --- a/src/lib/mina_compile_config/mina_compile_config.ml +++ b/src/lib/mina_compile_config/mina_compile_config.ml @@ -21,14 +21,16 @@ module Inputs = struct ; rpc_heartbeat_timeout_sec : float ; rpc_heartbeat_send_every_sec : float ; zkapps_disabled : bool + ; sync_ledger_max_subtree_depth : int + ; sync_ledger_default_subtree_depth : int } [@@deriving yojson, bin_io_unversioned] end type t = { curve_size : int - ; default_snark_worker_fee : Currency.Fee.t - ; minimum_user_command_fee : Currency.Fee.t + ; default_snark_worker_fee : Currency.Fee.Stable.Latest.t + ; minimum_user_command_fee : Currency.Fee.Stable.Latest.t ; itn_features : bool ; compaction_interval : Time.Span.t option ; block_window_duration : Time.Span.t @@ -39,8 +41,10 @@ type t = ; rpc_heartbeat_timeout : Time_ns.Span.t ; rpc_heartbeat_send_every : Time_ns.Span.t ; zkapps_disabled : bool + ; sync_ledger_max_subtree_depth : int + ; sync_ledger_default_subtree_depth : int } -[@@deriving sexp_of] +[@@deriving sexp_of, bin_io_unversioned] let make (inputs : Inputs.t) = { curve_size = inputs.curve_size @@ -64,6 +68,8 @@ let make (inputs : Inputs.t) = ; network_id = inputs.network_id ; zkapp_cmd_limit = inputs.zkapp_cmd_limit ; zkapps_disabled = inputs.zkapps_disabled + ; sync_ledger_max_subtree_depth = inputs.sync_ledger_max_subtree_depth + ; sync_ledger_default_subtree_depth = inputs.sync_ledger_default_subtree_depth } let to_yojson t = @@ -91,6 +97,9 @@ let to_yojson t = , Option.value_map ~default:`Null ~f:(fun x -> `Int x) t.zkapp_cmd_limit ) ; ("zkapps_disabled", `Bool t.zkapps_disabled) + ; ("sync_ledger_max_subtree_depth", `Int t.sync_ledger_max_subtree_depth) + ; ( "sync_ledger_default_subtree_depth" + , `Int t.sync_ledger_default_subtree_depth ) ] (*TODO: Delete this module and read in a value from the environment*) @@ -110,6 +119,10 @@ module Compiled = struct ; rpc_heartbeat_timeout_sec = 60.0 ; rpc_heartbeat_send_every_sec = 10.0 ; zkapps_disabled = false + ; sync_ledger_max_subtree_depth = + Node_config.sync_ledger_max_subtree_depth + ; sync_ledger_default_subtree_depth = + Node_config.sync_ledger_default_subtree_depth } in make inputs @@ -137,6 +150,10 @@ module For_unit_tests = struct ; network_id = Node_config_for_unit_tests.network ; zkapp_cmd_limit = Node_config_for_unit_tests.zkapp_cmd_limit ; zkapps_disabled = Node_config_for_unit_tests.zkapps_disabled + ; sync_ledger_max_subtree_depth = + Node_config_for_unit_tests.sync_ledger_max_subtree_depth + ; sync_ledger_default_subtree_depth = + Node_config_for_unit_tests.sync_ledger_default_subtree_depth } in make inputs diff --git a/src/lib/mina_lib/mina_lib.ml b/src/lib/mina_lib/mina_lib.ml index 6b12bededdf..9c89bf79b1c 100644 --- a/src/lib/mina_lib/mina_lib.ml +++ b/src/lib/mina_lib/mina_lib.ml @@ -1269,6 +1269,8 @@ let context ~commit_id (config : Config.t) : (module CONTEXT) = let compaction_interval = config.compile_config.compaction_interval + (*Same as config.precomputed_values.compile_config. + TODO: Remove redundant fields *) let compile_config = config.compile_config end ) @@ -1618,8 +1620,8 @@ let create ~commit_id ?wallets (config : Config.t) = ~pids:config.pids ~logger:config.logger ~conf_dir:config.conf_dir ~consensus_constants ~keypairs:config.block_production_keypairs - ~genesis_constants: - config.precomputed_values.genesis_constants ) ) + ~compile_config:config.precomputed_values.compile_config ) + ) >>| Result.ok_exn in let snark_worker = diff --git a/src/lib/node_config/for_unit_tests/node_config_for_unit_tests.ml b/src/lib/node_config/for_unit_tests/node_config_for_unit_tests.ml index 04f628d700a..5b35e3b0529 100644 --- a/src/lib/node_config/for_unit_tests/node_config_for_unit_tests.ml +++ b/src/lib/node_config/for_unit_tests/node_config_for_unit_tests.ml @@ -96,3 +96,7 @@ let rpc_handshake_timeout_sec = 60.0 let rpc_heartbeat_timeout_sec = 60.0 let rpc_heartbeat_send_every_sec = 10.0 (*same as the default*) + +let sync_ledger_max_subtree_depth = 4 + +let sync_ledger_default_subtree_depth = 3 diff --git a/src/lib/node_config/for_unit_tests/node_config_for_unit_tests.mli b/src/lib/node_config/for_unit_tests/node_config_for_unit_tests.mli index bbe3b4300d0..1037949c11e 100644 --- a/src/lib/node_config/for_unit_tests/node_config_for_unit_tests.mli +++ b/src/lib/node_config/for_unit_tests/node_config_for_unit_tests.mli @@ -21,3 +21,7 @@ val rpc_handshake_timeout_sec : float val rpc_heartbeat_timeout_sec : float val rpc_heartbeat_send_every_sec : float + +val sync_ledger_max_subtree_depth : int + +val sync_ledger_default_subtree_depth : int diff --git a/src/lib/node_config/intf/node_config_intf.mli b/src/lib/node_config/intf/node_config_intf.mli index 4daed897314..55d3e444ad6 100644 --- a/src/lib/node_config/intf/node_config_intf.mli +++ b/src/lib/node_config/intf/node_config_intf.mli @@ -62,4 +62,8 @@ module type S = sig val zkapp_cmd_limit : int option val scan_state_tps_goal_x10 : int option + + val sync_ledger_max_subtree_depth : int + + val sync_ledger_default_subtree_depth : int end diff --git a/src/lib/node_config/node_config.ml b/src/lib/node_config/node_config.ml index 4d519dd5a84..7b411144ee9 100644 --- a/src/lib/node_config/node_config.ml +++ b/src/lib/node_config/node_config.ml @@ -28,6 +28,11 @@ include Node_config_version [%%inject "scan_state_with_tps_goal", scan_state_with_tps_goal] +[%%inject "sync_ledger_max_subtree_depth", sync_ledger_max_subtree_depth] + +[%%inject +"sync_ledger_default_subtree_depth", sync_ledger_default_subtree_depth] + [%%ifndef scan_state_transaction_capacity_log_2] let scan_state_transaction_capacity_log_2 : int option = None diff --git a/src/lib/runtime_config/runtime_config.ml b/src/lib/runtime_config/runtime_config.ml index 347c2adf986..3daae5df956 100644 --- a/src/lib/runtime_config/runtime_config.ml +++ b/src/lib/runtime_config/runtime_config.ml @@ -1892,14 +1892,6 @@ module Constants : Constants_intf = struct ; minimum_user_command_fee = Option.value ~default:a.genesis_constants.minimum_user_command_fee Option.(b.daemon >>= fun d -> d.minimum_user_command_fee) - ; sync_ledger_default_subtree_depth = - Option.value - ~default:a.genesis_constants.sync_ledger_default_subtree_depth - Option.(b.daemon >>= fun d -> d.sync_ledger_default_subtree_depth) - ; sync_ledger_max_subtree_depth = - Option.value - ~default:a.genesis_constants.sync_ledger_max_subtree_depth - Option.(b.daemon >>= fun d -> d.sync_ledger_max_subtree_depth) } in let constraint_constants = @@ -1975,6 +1967,13 @@ module Constants : Constants_intf = struct ; network_id = Option.value ~default:a.compile_config.network_id Option.(b.daemon >>= fun d -> d.network_id) + ; sync_ledger_max_subtree_depth = + Option.value ~default:a.compile_config.sync_ledger_max_subtree_depth + Option.(b.daemon >>= fun d -> d.sync_ledger_max_subtree_depth) + ; sync_ledger_default_subtree_depth = + Option.value + ~default:a.compile_config.sync_ledger_default_subtree_depth + Option.(b.daemon >>= fun d -> d.sync_ledger_default_subtree_depth) } in { genesis_constants; constraint_constants; proof_level; compile_config } diff --git a/src/lib/sync_handler/sync_handler.ml b/src/lib/sync_handler/sync_handler.ml index ef4e5d64efd..27e4c961c98 100644 --- a/src/lib/sync_handler/sync_handler.ml +++ b/src/lib/sync_handler/sync_handler.ml @@ -97,7 +97,7 @@ module Make (Inputs : Inputs_intf) : ( module struct let logger = Context.logger - let genesis_constants = Context.precomputed_values.genesis_constants + let compile_config = Context.precomputed_values.compile_config end ) in match get_ledger_by_hash ~frontier hash with @@ -205,7 +205,7 @@ module Make (Inputs : Inputs_intf) : let module Context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config let logger = Logger.extend logger [ ("selection_context", `String "Root.prove") ] @@ -234,7 +234,7 @@ module Make (Inputs : Inputs_intf) : let module Context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config let logger = Logger.extend logger [ ("selection_context", `String "Root.verify") ] diff --git a/src/lib/syncable_ledger/dune b/src/lib/syncable_ledger/dune index d0c99d5fd6d..5e51630c4b9 100644 --- a/src/lib/syncable_ledger/dune +++ b/src/lib/syncable_ledger/dune @@ -22,7 +22,7 @@ direction error_json ppx_version.runtime - genesis_constants + mina_compile_config ) (preprocess (pps ppx_mina ppx_version ppx_jane ppx_compare ppx_deriving_yojson ppx_register_event)) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 9b9b4f50cf6..ac8cb70bd4a 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -108,7 +108,7 @@ end module type CONTEXT = sig val logger : Logger.t - val genesis_constants : Genesis_constants.t + val compile_config : Mina_compile_config.t end module type Inputs_intf = sig @@ -403,8 +403,7 @@ end = struct match subtree_depth with | n when n >= 1 - && n - <= Context.genesis_constants.sync_ledger_max_subtree_depth + && n <= Context.compile_config.sync_ledger_max_subtree_depth -> ( let ledger_depth = MT.depth mt in let addresses = @@ -576,7 +575,7 @@ end = struct let is_more_than_two = len >= 2 in let subtree_depth = Int.ceil_log2 len in let less_than_max = - len <= Int.pow 2 Context.genesis_constants.sync_ledger_max_subtree_depth + len <= Int.pow 2 Context.compile_config.sync_ledger_max_subtree_depth in let less_than_requested = subtree_depth <= requested_depth in let valid_length = @@ -653,8 +652,7 @@ end = struct Linear_pipe.write_without_pushback_if_open t.queries ( desired_root_exn t , What_child_hashes - (addr, Context.genesis_constants.sync_ledger_default_subtree_depth) - ) ) + (addr, Context.compile_config.sync_ledger_default_subtree_depth) ) ) (** Handle the initial Num_accounts message, starting the main syncing process. *) @@ -789,7 +787,7 @@ end = struct be a power of 2 in the range 2-2^$depth" , [ ( "depth" , `Int - Context.genesis_constants + Context.compile_config .sync_ledger_max_subtree_depth ) ] ) ) in diff --git a/src/lib/transition_frontier/full_frontier/full_frontier.ml b/src/lib/transition_frontier/full_frontier/full_frontier.ml index 3c799c9c66a..73d1079b544 100644 --- a/src/lib/transition_frontier/full_frontier/full_frontier.ml +++ b/src/lib/transition_frontier/full_frontier/full_frontier.ml @@ -566,7 +566,7 @@ let calculate_diffs ({ context = (module Context); _ } as t) breadcrumb = let module Consensus_context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config end in O1trace.sync_thread "calculate_diff_frontier_diffs" (fun () -> let breadcrumb_hash = Breadcrumb.state_hash breadcrumb in @@ -964,7 +964,7 @@ module For_tests = struct let consensus_constants = precomputed_values.consensus_constants - let genesis_constants = Genesis_constants.For_unit_tests.t + let compile_config = precomputed_values.compile_config end let verifier () = diff --git a/src/lib/transition_frontier/transition_frontier.ml b/src/lib/transition_frontier/transition_frontier.ml index b1c6c572337..f2fdff6036c 100644 --- a/src/lib/transition_frontier/transition_frontier.ml +++ b/src/lib/transition_frontier/transition_frontier.ml @@ -720,7 +720,7 @@ module For_tests = struct let consensus_constants = precomputed_values.consensus_constants - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config end in let open Context in let open Quickcheck.Generator.Let_syntax in diff --git a/src/lib/transition_handler/processor.ml b/src/lib/transition_handler/processor.ml index 3a3749ab299..6c36a9d0720 100644 --- a/src/lib/transition_handler/processor.ml +++ b/src/lib/transition_handler/processor.ml @@ -115,7 +115,7 @@ let process_transition ~context:(module Context : CONTEXT) ~trust_system let module Consensus_context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config end in let open Consensus_context in let block_window_duration = diff --git a/src/lib/transition_handler/validator.ml b/src/lib/transition_handler/validator.ml index 20ee229dbfd..cb1e39b4df2 100644 --- a/src/lib/transition_handler/validator.ml +++ b/src/lib/transition_handler/validator.ml @@ -22,7 +22,7 @@ let validate_header_is_relevant ~context:(module Context : CONTEXT) ~frontier let module Context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config let logger = Logger.extend logger diff --git a/src/lib/transition_router/transition_router.ml b/src/lib/transition_router/transition_router.ml index 21855ad463a..57489dd5dc8 100644 --- a/src/lib/transition_router/transition_router.ml +++ b/src/lib/transition_router/transition_router.ml @@ -286,7 +286,7 @@ let download_best_tip ~context:(module Context : CONTEXT) ~notify_online let module Consensus_context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config end in let res = List.fold tips ~init:None ~f:(fun acc enveloped_candidate_best_tip -> @@ -410,7 +410,7 @@ let initialize ~context:(module Context : CONTEXT) ~sync_local_state ~network let module Consensus_context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config end in match%bind Deferred.both @@ -580,7 +580,7 @@ let run ?(sync_local_state = true) ?(cache_exceptions = false) let module Consensus_context = struct include Context - let genesis_constants = precomputed_values.genesis_constants + let compile_config = precomputed_values.compile_config end in [%log info] "Starting transition router" ; let initialization_finish_signal = Ivar.create () in diff --git a/src/lib/vrf_evaluator/vrf_evaluator.ml b/src/lib/vrf_evaluator/vrf_evaluator.ml index baab2b8e7e6..561f9292f0a 100644 --- a/src/lib/vrf_evaluator/vrf_evaluator.ml +++ b/src/lib/vrf_evaluator/vrf_evaluator.ml @@ -11,7 +11,7 @@ module type CONTEXT = sig val consensus_constants : Consensus.Constants.t - val genesis_constants : Genesis_constants.t + val compile_config : Mina_compile_config.t end (*Slot number within an epoch*) @@ -77,7 +77,7 @@ module Worker_state = struct type init_arg = { constraint_constants : Genesis_constants.Constraint_constants.t ; consensus_constants : Consensus.Constants.Stable.Latest.t - ; genesis_constants : Genesis_constants.t + ; compile_config : Mina_compile_config.t ; conf_dir : string ; logger : Logger.t ; commit_id : string @@ -87,7 +87,7 @@ module Worker_state = struct let context_of_config ({ constraint_constants ; consensus_constants - ; genesis_constants + ; compile_config ; logger ; conf_dir = _ ; commit_id = _ @@ -100,7 +100,7 @@ module Worker_state = struct let logger = logger - let genesis_constants = genesis_constants + let compile_config = compile_config end ) type t = @@ -420,7 +420,7 @@ let update_block_producer_keys { connection; process = _ } ~keypairs = ~arg:(Keypair.And_compressed_pk.Set.to_list keypairs) let create ~constraint_constants ~pids ~consensus_constants ~conf_dir ~logger - ~keypairs ~commit_id ~genesis_constants = + ~keypairs ~commit_id ~compile_config = let on_failure err = [%log error] "VRF evaluator process failed with error $err" ~metadata:[ ("err", Error_json.error_to_yojson err) ] ; @@ -432,7 +432,7 @@ let create ~constraint_constants ~pids ~consensus_constants ~conf_dir ~logger ~on_failure ~shutdown_on:Connection_closed ~connection_state_init_arg:() { constraint_constants ; consensus_constants - ; genesis_constants + ; compile_config ; conf_dir ; logger ; commit_id From 8848b695013f3ef3386c68b1f4a9e6bd53a9a064 Mon Sep 17 00:00:00 2001 From: Deepthi S Kumar Date: Tue, 19 Nov 2024 11:37:45 -0800 Subject: [PATCH 28/34] fix typo in comment Co-authored-by: Sai Vegasena --- src/lib/mina_ledger/sync_ledger.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/mina_ledger/sync_ledger.ml b/src/lib/mina_ledger/sync_ledger.ml index c88cc1414ad..cd64a36c2f8 100644 --- a/src/lib/mina_ledger/sync_ledger.ml +++ b/src/lib/mina_ledger/sync_ledger.ml @@ -112,7 +112,7 @@ module Query = struct (* Not a standard versioning function *) - (** Attempts to downgrade v3 -> v2 *) +(* Attempts to downgrade v2 -> v1 *) let from_v2 : V2.t -> t = function | What_child_hashes (a, _) -> What_child_hashes a From 4a159629d15e98e2209bf11189a799e59cf78398 Mon Sep 17 00:00:00 2001 From: Deepthi S Kumar Date: Tue, 19 Nov 2024 12:17:04 -0800 Subject: [PATCH 29/34] update syncable ledger tests --- src/lib/mina_ledger/sync_ledger.ml | 2 +- src/lib/syncable_ledger/test/dune | 1 + src/lib/syncable_ledger/test/test.ml | 4 ++-- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/lib/mina_ledger/sync_ledger.ml b/src/lib/mina_ledger/sync_ledger.ml index cd64a36c2f8..aa704b2abfe 100644 --- a/src/lib/mina_ledger/sync_ledger.ml +++ b/src/lib/mina_ledger/sync_ledger.ml @@ -112,7 +112,7 @@ module Query = struct (* Not a standard versioning function *) -(* Attempts to downgrade v2 -> v1 *) + (* Attempts to downgrade v2 -> v1 *) let from_v2 : V2.t -> t = function | What_child_hashes (a, _) -> What_child_hashes a diff --git a/src/lib/syncable_ledger/test/dune b/src/lib/syncable_ledger/test/dune index 11927311d65..c1573d877b2 100644 --- a/src/lib/syncable_ledger/test/dune +++ b/src/lib/syncable_ledger/test/dune @@ -30,6 +30,7 @@ mina_base.import signature_lib bounded_types + mina_compile_config ) (preprocess (pps ppx_version ppx_jane ppx_compare ppx_deriving_yojson)) diff --git a/src/lib/syncable_ledger/test/test.ml b/src/lib/syncable_ledger/test/test.ml index 078562e1d19..aa2bf874cb8 100644 --- a/src/lib/syncable_ledger/test/test.ml +++ b/src/lib/syncable_ledger/test/test.ml @@ -44,8 +44,8 @@ module Make_context (Subtree_depth : sig end) : Syncable_ledger.CONTEXT = struct let logger = Logger.null () - let genesis_constants = - { Genesis_constants.For_unit_tests.t with + let compile_config = + { Mina_compile_config.For_unit_tests.t with sync_ledger_max_subtree_depth = Subtree_depth.sync_ledger_max_subtree_depth ; sync_ledger_default_subtree_depth = From 8f500b80b2072f77955aab87630e3579d3abf8f3 Mon Sep 17 00:00:00 2001 From: Deepthi S Kumar Date: Wed, 20 Nov 2024 18:54:10 -0800 Subject: [PATCH 30/34] return sync ledger answer or error, not option --- .../transition_frontier_components_intf.ml | 2 +- src/lib/mina_networking/rpcs.ml | 22 ++++++++++--------- src/lib/sync_handler/sync_handler.ml | 11 ++++++---- src/lib/syncable_ledger/syncable_ledger.ml | 22 ++++++++++--------- 4 files changed, 32 insertions(+), 25 deletions(-) diff --git a/src/lib/mina_intf/transition_frontier_components_intf.ml b/src/lib/mina_intf/transition_frontier_components_intf.ml index cfb4a797188..4521e31c0f8 100644 --- a/src/lib/mina_intf/transition_frontier_components_intf.ml +++ b/src/lib/mina_intf/transition_frontier_components_intf.ml @@ -223,7 +223,7 @@ module type Sync_handler_intf = sig -> Mina_ledger.Sync_ledger.Query.t Envelope.Incoming.t -> context:(module CONTEXT) -> trust_system:Trust_system.t - -> Mina_ledger.Sync_ledger.Answer.t option Deferred.t + -> Mina_ledger.Sync_ledger.Answer.t Or_error.t Deferred.t val get_staged_ledger_aux_and_pending_coinbases_at_hash : frontier:transition_frontier diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index 99882642c25..e98cc91e506 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -453,18 +453,20 @@ module Answer_sync_ledger_query = struct let ledger_hash, _ = Envelope.Incoming.data request in let query = Envelope.Incoming.map request ~f:Tuple2.get2 in let%bind answer = - let%bind.Deferred.Option frontier = return (get_transition_frontier ()) in - Sync_handler.answer_query ~frontier ledger_hash query - ~context:(module Context) - ~trust_system + match get_transition_frontier () with + | Some frontier -> + Sync_handler.answer_query ~frontier ledger_hash query + ~context:(module Context) + ~trust_system + | None -> + return (Or_error.error_string "No Frontier") in let result = - Result.of_option answer - ~error: - (Error.createf - !"Refusing to answer sync ledger query for ledger_hash: \ - %{sexp:Ledger_hash.t}" - ledger_hash ) + Result.map_error answer ~f:(fun e -> + Error.createf + !"Refusing to answer sync ledger query for ledger_hash: \ + %{sexp:Ledger_hash.t}. Error: %s" + ledger_hash (Error.to_string_hum e) ) in let%map () = match result with diff --git a/src/lib/sync_handler/sync_handler.ml b/src/lib/sync_handler/sync_handler.ml index 27e4c961c98..13bec079662 100644 --- a/src/lib/sync_handler/sync_handler.ml +++ b/src/lib/sync_handler/sync_handler.ml @@ -90,9 +90,8 @@ module Make (Inputs : Inputs_intf) : -> Sync_ledger.Query.t Envelope.Incoming.t -> context:(module CONTEXT) -> trust_system:Trust_system.t - -> Sync_ledger.Answer.t Option.t Deferred.t = - fun ~frontier hash query ~context ~trust_system -> - let (module Context) = context in + -> Sync_ledger.Answer.t Or_error.t Deferred.t = + fun ~frontier hash query ~context:(module Context) ~trust_system -> let (module C : Syncable_ledger.CONTEXT) = ( module struct let logger = Context.logger @@ -102,7 +101,11 @@ module Make (Inputs : Inputs_intf) : in match get_ledger_by_hash ~frontier hash with | None -> - return None + return + (Or_error.error_string + (sprintf + !"Failed to find ledger for hash %{sexp:Ledger_hash.t}" + hash ) ) | Some ledger -> let responder = Sync_ledger.Any_ledger.Responder.create ledger ignore diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index ac8cb70bd4a..38118f709d0 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -170,7 +170,7 @@ module type S = sig -> t val answer_query : - t -> query Envelope.Incoming.t -> answer option Deferred.t + t -> query Envelope.Incoming.t -> answer Or_error.t Deferred.t end val create : @@ -318,7 +318,7 @@ end = struct fun mt f ~context ~trust_system -> { mt; f; context; trust_system } let answer_query : - t -> query Envelope.Incoming.t -> answer option Deferred.t = + t -> query Envelope.Incoming.t -> answer Or_error.t Deferred.t = fun { mt; f; context; trust_system } query_envelope -> let (module Context) = context in let open Context in @@ -334,7 +334,7 @@ end = struct Either.Second ( Actions.Violated_protocol , Some - ( "requested too big of a subtree at once: $addr" + ( "Requested too big of a subtree at once" , [ ("addr", Addr.to_yojson a) ] ) ) else let addresses_and_accounts = @@ -350,8 +350,8 @@ end = struct Either.Second ( Actions.Violated_protocol , Some - ( "Requested empty subtree: $addr" - , [ ("addr", Addr.to_yojson a) ] ) ) + ("Requested empty subtree", [ ("addr", Addr.to_yojson a) ]) + ) else let first_address, rest_address = (List.hd_exn addresses, List.tl_exn addresses) @@ -426,7 +426,7 @@ end = struct Either.Second ( Actions.Violated_protocol , Some - ( "invalid address $addr in What_child_hashes request" + ( "Invalid address in What_child_hashes request" , [ ("addr", Addr.to_yojson a) ] ) ) ) | _ -> [%log error] @@ -435,19 +435,21 @@ end = struct Either.Second ( Actions.Violated_protocol , Some - ( "invalid depth requested at $addr in What_child_hashes \ - request" + ( "Invalid depth requested in What_child_hashes request" , [ ("addr", Addr.to_yojson a) ] ) ) ) in match response_or_punish with | Either.First answer -> - Deferred.return @@ Some answer + Deferred.return @@ Ok answer | Either.Second action -> let%map _ = record_envelope_sender trust_system logger sender action in - None + let err = + Option.value_map ~default:"Violated protocol" (snd action) ~f:fst + in + Or_error.error_string err end type 'a t = From 12fb30434536ebc4ef5a4b97a16ad068c5152549 Mon Sep 17 00:00:00 2001 From: Deepthi S Kumar Date: Thu, 21 Nov 2024 01:39:36 -0800 Subject: [PATCH 31/34] tests for requested subtree depth > max subtree depth --- src/lib/syncable_ledger/test/test.ml | 130 +++++++++++++++++++++++++-- 1 file changed, 122 insertions(+), 8 deletions(-) diff --git a/src/lib/syncable_ledger/test/test.ml b/src/lib/syncable_ledger/test/test.ml index aa2bf874cb8..b5ed8fcb8c1 100644 --- a/src/lib/syncable_ledger/test/test.ml +++ b/src/lib/syncable_ledger/test/test.ml @@ -83,6 +83,12 @@ module Context_subtree_depth88 = Make_context (struct let sync_ledger_default_subtree_depth = 8 end) +module Context_subtree_depth68 = Make_context (struct + let sync_ledger_max_subtree_depth = 6 + + let sync_ledger_default_subtree_depth = 8 +end) + module Make_test (Input : Input_intf) (Input' : sig val num_accts : int @@ -119,12 +125,10 @@ struct don't_wait_for (Linear_pipe.iter_unordered ~max_concurrency:3 qr ~f:(fun (root_hash, query) -> - let%bind answ_opt = + let%bind answ_or_error = Sync_responder.answer_query sr (Envelope.Incoming.local query) in - let answ = - Option.value_exn ~message:"refused to answer query" answ_opt - in + let answ = Or_error.ok_exn answ_or_error in let%bind () = if match query with What_contents _ -> true | _ -> false then Clock_ns.after @@ -180,13 +184,11 @@ struct : [ `New | `Repeat | `Update_data ] ) ; Deferred.unit ) else - let%bind answ_opt = + let%bind answ_or_error = Sync_responder.answer_query !sr (Envelope.Incoming.local query) in - let answ = - Option.value_exn ~message:"refused to answer query" answ_opt - in + let answ = Or_error.ok_exn answ_or_error in Linear_pipe.write aw (!desired_root, query, Envelope.Incoming.local answ) in @@ -211,6 +213,92 @@ struct failwith "the target changed again" ) end +module Make_test_failure_cases (Input : Input_intf) = struct + open Input + module Sync_responder = Sync_ledger.Responder + + let trust_system = Trust_system.null () + + let num_accts = 1026 + + let () = + Async.Scheduler.set_record_backtraces true ; + Core.Backtrace.elide := false + + let check_answer (query : Ledger.addr Syncable_ledger.Query.t) answer = + match query with + | What_child_hashes (_, depth) -> ( + let invalid_depth = + depth > Context.compile_config.sync_ledger_max_subtree_depth + in + match answer with + | Error s -> + (*fail if requested depth is > max depth configured*) + if + invalid_depth + && String.is_substring (Error.to_string_hum s) + ~substring: + "Invalid depth requested in What_child_hashes request" + then `Failure_as_expected + else + failwithf + "Expected failure due to invalid subtree depth, returned %s" + (Error.to_string_hum s) () + | Ok a -> + if invalid_depth then + failwith + "Expected failure due to invalid subtree depth, returned a \ + successful answer" + else `Answer a ) + | _ -> + `Answer (Or_error.ok_exn answer) + + let%test "try full_sync_entirely_different with failures" = + let l1, _k1 = Ledger.load_ledger 1 1 in + let l2, _k2 = Ledger.load_ledger num_accts 2 in + let desired_root = Ledger.merkle_root l2 in + let got_failure_ivar = Ivar.create () in + + let lsync = Sync_ledger.create l1 ~context:(module Context) ~trust_system in + let qr = Sync_ledger.query_reader lsync in + let aw = Sync_ledger.answer_writer lsync in + let sr = + Sync_responder.create l2 ignore ~context:(module Context) ~trust_system + in + don't_wait_for + (Linear_pipe.iter_unordered ~max_concurrency:3 qr + ~f:(fun (root_hash, query) -> + let%bind answ_or_error = + Sync_responder.answer_query sr (Envelope.Incoming.local query) + in + match check_answer query answ_or_error with + | `Answer answ -> + let%bind () = + if match query with What_contents _ -> true | _ -> false then + Clock_ns.after + (Time_ns.Span.randomize (Time_ns.Span.of_ms 0.2) + ~percent:(Percent.of_percentage 20.) ) + else Deferred.unit + in + Linear_pipe.write aw + (root_hash, query, Envelope.Incoming.local answ) + | `Failure_as_expected -> + Ivar.fill got_failure_ivar true ; + Deferred.unit ) ) ; + Async.Thread_safe.block_on_async_exn (fun () -> + let deferred_res = + match%map + Sync_ledger.fetch lsync desired_root ~data:() ~equal:(fun () () -> + true ) + with + | `Ok mt -> + Root_hash.equal desired_root (Ledger.merkle_root mt) + | `Target_changed _ -> + false + in + Deferred.any [ deferred_res; Ivar.read got_failure_ivar ] ) +end + module Root_hash = struct include Merkle_ledger_tests.Test_stubs.Hash @@ -334,6 +422,13 @@ module Db = struct let depth = 16 end) + module DB16_subtree_depths68 = + Make + (Context_subtree_depth68) + (struct + let depth = 16 + end) + module TestDB3_3 = Make_test (DB3) @@ -390,6 +485,11 @@ module Db = struct (struct let num_accts = 1026 end) + + module TestDB16_1026_subtree_depth68_Failure = + Make_test_failure_cases (DB16_subtree_depths68) + module TestDB16_1026_subtree_depth86_Success = + Make_test_failure_cases (DB16_subtree_depths86) end module Mask = struct @@ -549,6 +649,15 @@ module Mask = struct let mask_layers = 2 end) + module Mask16_Layer2_Depth68 = + Make + (Context_subtree_depth68) + (struct + let depth = 16 + + let mask_layers = 2 + end) + module TestMask3_Layer1_3 = Make_test (Mask3_Layer1) @@ -611,4 +720,9 @@ module Mask = struct (struct let num_accts = 1024 end) + + module TestMask16_Layer2_1024_Depth68_Failure = + Make_test_failure_cases (Mask16_Layer2_Depth68) + module TestMask16_Layer2_1024_Depth86_Success = + Make_test_failure_cases (Mask16_Layer2_Depth86) end From 305fba1dcd57c4400a40d8ab67bdf4eddf53dae6 Mon Sep 17 00:00:00 2001 From: Deepthi S Kumar Date: Thu, 21 Nov 2024 02:26:16 -0800 Subject: [PATCH 32/34] return error if downgrading; other review comments --- src/lib/mina_ledger/sync_ledger.ml | 2 +- src/lib/mina_networking/rpcs.ml | 2 +- src/lib/syncable_ledger/syncable_ledger.ml | 49 +++++++++------------- 3 files changed, 22 insertions(+), 31 deletions(-) diff --git a/src/lib/mina_ledger/sync_ledger.ml b/src/lib/mina_ledger/sync_ledger.ml index aa704b2abfe..ed6f62c52ae 100644 --- a/src/lib/mina_ledger/sync_ledger.ml +++ b/src/lib/mina_ledger/sync_ledger.ml @@ -76,7 +76,7 @@ module Answer = struct (* Not a standard versioning function *) (** Attempts to downgrade v3 -> v2 *) - let from_v3 : V3.t -> t = + let from_v3 : V3.t -> t Or_error.t = fun x -> Syncable_ledger.Answer.Stable.V1.from_v2 x end end] diff --git a/src/lib/mina_networking/rpcs.ml b/src/lib/mina_networking/rpcs.ml index e98cc91e506..4e5fbf76869 100644 --- a/src/lib/mina_networking/rpcs.ml +++ b/src/lib/mina_networking/rpcs.ml @@ -417,7 +417,7 @@ module Answer_sync_ledger_query = struct let response_of_callee_model : Master.T.response -> response = function | Ok a -> - Ok (Sync_ledger.Answer.Stable.V2.from_v3 a) + Sync_ledger.Answer.Stable.V2.from_v3 a | Error e -> Error e diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 38118f709d0..377c3f77d35 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -84,7 +84,7 @@ module Answer = struct let to_latest acct_to_latest = function | Child_hashes_are (h1, h2) -> - V2.Child_hashes_are (List.to_array [ h1; h2 ]) + V2.Child_hashes_are [| h1; h2 |] | Contents_are accts -> V2.Contents_are (List.map ~f:acct_to_latest accts) | Num_accounts (i, h) -> @@ -93,14 +93,14 @@ module Answer = struct (* Not a standard versioning function *) (** Attempts to downgrade v2 -> v1 *) - let from_v2 : ('a, 'b) V2.t -> ('a, 'b) t = function + let from_v2 : ('a, 'b) V2.t -> ('a, 'b) t Or_error.t = function | Child_hashes_are h -> - if Array.length h = 2 then Child_hashes_are (h.(0), h.(1)) - else failwith "can't downgrade wide query" + if Array.length h = 2 then Ok (Child_hashes_are (h.(0), h.(1))) + else Or_error.error_string "can't downgrade wide query" | Contents_are accs -> - Contents_are accs + Ok (Contents_are accs) | Num_accounts (n, h) -> - Num_accounts (n, h) + Ok (Num_accounts (n, h)) end end] end @@ -320,8 +320,7 @@ end = struct let answer_query : t -> query Envelope.Incoming.t -> answer Or_error.t Deferred.t = fun { mt; f; context; trust_system } query_envelope -> - let (module Context) = context in - let open Context in + let open (val context) in let open Trust_system in let ledger_depth = MT.depth mt in let sender = Envelope.Incoming.sender query_envelope in @@ -401,9 +400,7 @@ end = struct (len, MT.get_inner_hash_at_addr_exn mt content_root_addr) ) | What_child_hashes (a, subtree_depth) -> ( match subtree_depth with - | n - when n >= 1 - && n <= Context.compile_config.sync_ledger_max_subtree_depth + | n when n >= 1 && n <= compile_config.sync_ledger_max_subtree_depth -> ( let ledger_depth = MT.depth mt in let addresses = @@ -488,8 +485,7 @@ end = struct let expect_children : 'a t -> Addr.t -> Hash.t -> unit = fun t parent_addr expected -> - let (module Context) = t.context in - let open Context in + let open (val t.context) in [%log trace] ~metadata: [ ("parent_address", Addr.to_yojson parent_addr) @@ -500,8 +496,7 @@ end = struct let expect_content : 'a t -> Addr.t -> Hash.t -> unit = fun t addr expected -> - let (module Context) = t.context in - let open Context in + let open (val t.context) in [%log trace] ~metadata: [ ("address", Addr.to_yojson addr); ("hash", Hash.to_yojson expected) ] @@ -517,8 +512,7 @@ end = struct -> [ `Success | `Hash_mismatch of Hash.t * Hash.t (** expected hash, actual *) ] = fun t addr content -> - let (module Context) = t.context in - let open Context in + let open (val t.context) in let expected = Addr.Table.find_exn t.waiting_content addr in (* TODO #444 should we batch all the updates and do them at the end? *) (* We might write the wrong data to the underlying ledger here, but if so @@ -571,13 +565,13 @@ end = struct | `Hash_mismatch of Hash.t * Hash.t | `Invalid_length ] = fun t addr nodes requested_depth -> - let (module Context) = t.context in + let open (val t.context) in let len = Array.length nodes in let is_power = Int.is_pow2 len in let is_more_than_two = len >= 2 in let subtree_depth = Int.ceil_log2 len in let less_than_max = - len <= Int.pow 2 Context.compile_config.sync_ledger_max_subtree_depth + len <= Int.pow 2 compile_config.sync_ledger_max_subtree_depth in let less_than_requested = subtree_depth <= requested_depth in let valid_length = @@ -611,8 +605,7 @@ end = struct else `Invalid_length let all_done t = - let (module Context) = t.context in - let open Context in + let open (val t.context) in if not (Root_hash.equal (MT.merkle_root t.tree) (desired_root_exn t)) then failwith "We finished syncing, but made a mistake somewhere :(" else ( @@ -644,7 +637,7 @@ end = struct the children. *) let handle_node t addr exp_hash = - let (module Context) = t.context in + let open (val t.context) in if Addr.depth addr >= MT.depth t.tree - account_subtree_height then ( expect_content t addr exp_hash ; Linear_pipe.write_without_pushback_if_open t.queries @@ -654,7 +647,7 @@ end = struct Linear_pipe.write_without_pushback_if_open t.queries ( desired_root_exn t , What_child_hashes - (addr, Context.compile_config.sync_ledger_default_subtree_depth) ) ) + (addr, compile_config.sync_ledger_default_subtree_depth) ) ) (** Handle the initial Num_accounts message, starting the main syncing process. *) @@ -676,8 +669,7 @@ end = struct else `Hash_mismatch (rh, actual) let main_loop t = - let (module Context) = t.context in - let open Context in + let open (val t.context) in let handle_answer : Root_hash.t * Addr.t Query.t @@ -789,8 +781,8 @@ end = struct be a power of 2 in the range 2-2^$depth" , [ ( "depth" , `Int - Context.compile_config - .sync_ledger_max_subtree_depth ) + compile_config.sync_ledger_max_subtree_depth + ) ] ) ) in requeue_query () @@ -825,8 +817,7 @@ end = struct Linear_pipe.iter t.answers ~f:handle_answer let new_goal t h ~data ~equal = - let (module Context) = t.context in - let open Context in + let open (val t.context) in let should_skip = match t.desired_root with | None -> From 45c651755684ba026d61d0d61fa6f86925cac994 Mon Sep 17 00:00:00 2001 From: Deepthi S Kumar Date: Fri, 22 Nov 2024 11:56:32 -0800 Subject: [PATCH 33/34] remove max depth check by receiver; add tests for edge cases --- src/lib/syncable_ledger/syncable_ledger.ml | 13 +++--- src/lib/syncable_ledger/test/test.ml | 49 ++++++++++++++++------ 2 files changed, 41 insertions(+), 21 deletions(-) diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 377c3f77d35..7fee41dd1b3 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -400,8 +400,10 @@ end = struct (len, MT.get_inner_hash_at_addr_exn mt content_root_addr) ) | What_child_hashes (a, subtree_depth) -> ( match subtree_depth with - | n when n >= 1 && n <= compile_config.sync_ledger_max_subtree_depth - -> ( + | n when n >= 1 -> ( + let subtree_depth = + min n compile_config.sync_ledger_max_subtree_depth + in let ledger_depth = MT.depth mt in let addresses = intermediate_range ledger_depth a subtree_depth @@ -570,13 +572,8 @@ end = struct let is_power = Int.is_pow2 len in let is_more_than_two = len >= 2 in let subtree_depth = Int.ceil_log2 len in - let less_than_max = - len <= Int.pow 2 compile_config.sync_ledger_max_subtree_depth - in let less_than_requested = subtree_depth <= requested_depth in - let valid_length = - is_power && is_more_than_two && less_than_requested && less_than_max - in + let valid_length = is_power && is_more_than_two && less_than_requested in if valid_length then let ledger_depth = MT.depth t.tree in let expected = diff --git a/src/lib/syncable_ledger/test/test.ml b/src/lib/syncable_ledger/test/test.ml index b5ed8fcb8c1..5cc21424ba8 100644 --- a/src/lib/syncable_ledger/test/test.ml +++ b/src/lib/syncable_ledger/test/test.ml @@ -89,6 +89,12 @@ module Context_subtree_depth68 = Make_context (struct let sync_ledger_default_subtree_depth = 8 end) +module Context_subtree_depth80 = Make_context (struct + let sync_ledger_max_subtree_depth = 8 + + let sync_ledger_default_subtree_depth = 0 +end) + module Make_test (Input : Input_intf) (Input' : sig val num_accts : int @@ -213,7 +219,7 @@ struct failwith "the target changed again" ) end -module Make_test_failure_cases (Input : Input_intf) = struct +module Make_test_edge_cases (Input : Input_intf) = struct open Input module Sync_responder = Sync_ledger.Responder @@ -228,12 +234,9 @@ module Make_test_failure_cases (Input : Input_intf) = struct let check_answer (query : Ledger.addr Syncable_ledger.Query.t) answer = match query with | What_child_hashes (_, depth) -> ( - let invalid_depth = - depth > Context.compile_config.sync_ledger_max_subtree_depth - in + let invalid_depth = depth < 1 in match answer with | Error s -> - (*fail if requested depth is > max depth configured*) if invalid_depth && String.is_substring (Error.to_string_hum s) @@ -429,6 +432,13 @@ module Db = struct let depth = 16 end) + module DB16_subtree_depths80 = + Make + (Context_subtree_depth80) + (struct + let depth = 16 + end) + module TestDB3_3 = Make_test (DB3) @@ -486,10 +496,12 @@ module Db = struct let num_accts = 1026 end) - module TestDB16_1026_subtree_depth68_Failure = - Make_test_failure_cases (DB16_subtree_depths68) - module TestDB16_1026_subtree_depth86_Success = - Make_test_failure_cases (DB16_subtree_depths86) + module TestDB16_Edge_Cases_subtree_depth68 = + Make_test_edge_cases (DB16_subtree_depths68) + module TestDB16_Edge_Cases_subtree_depth86 = + Make_test_edge_cases (DB16_subtree_depths81) + module TestDB16_Edge_Cases_subtree_depth80 = + Make_test_edge_cases (DB16_subtree_depths80) end module Mask = struct @@ -658,6 +670,15 @@ module Mask = struct let mask_layers = 2 end) + module Mask16_Layer2_Depth80 = + Make + (Context_subtree_depth80) + (struct + let depth = 16 + + let mask_layers = 2 + end) + module TestMask3_Layer1_3 = Make_test (Mask3_Layer1) @@ -721,8 +742,10 @@ module Mask = struct let num_accts = 1024 end) - module TestMask16_Layer2_1024_Depth68_Failure = - Make_test_failure_cases (Mask16_Layer2_Depth68) - module TestMask16_Layer2_1024_Depth86_Success = - Make_test_failure_cases (Mask16_Layer2_Depth86) + module TestMask16_Edge_Cases_Depth68 = + Make_test_edge_cases (Mask16_Layer2_Depth68) + module TestMask16_Edge_Cases_Depth81 = + Make_test_edge_cases (Mask16_Layer2_Depth81) + module TestMask16_Edge_Cases_Depth80 = + Make_test_edge_cases (Mask16_Layer2_Depth80) end From 77324044e601cc655b71fd6040b746af9ba3f71d Mon Sep 17 00:00:00 2001 From: mrmr1993 Date: Wed, 20 Nov 2024 12:27:15 +0000 Subject: [PATCH 34/34] Add Merkle_address.extend, use it for array init in ledger sync --- src/lib/merkle_address/merkle_address.ml | 12 ++++++++++++ src/lib/merkle_address/merkle_address.mli | 4 ++++ src/lib/syncable_ledger/syncable_ledger.ml | 22 +++------------------- 3 files changed, 19 insertions(+), 19 deletions(-) diff --git a/src/lib/merkle_address/merkle_address.ml b/src/lib/merkle_address/merkle_address.ml index 69568280e53..3a7d3304d18 100644 --- a/src/lib/merkle_address/merkle_address.ml +++ b/src/lib/merkle_address/merkle_address.ml @@ -133,6 +133,18 @@ let child ~ledger_depth (path : t) dir : t Or_error.t = let child_exn ~ledger_depth (path : t) dir : t = child ~ledger_depth path dir |> Or_error.ok_exn +let extend ~ledger_depth (path : t) ~num_bits (child_idx : int64) = + let final_len = bitstring_length path + num_bits in + if Int.(final_len > ledger_depth) then + Or_error.errorf "The address length cannot be greater than depth (%i > %i)" + final_len ledger_depth + else + let%bitstring path = {| path: -1: bitstring; child_idx: num_bits: int |} in + Or_error.return path + +let extend_exn ~ledger_depth path ~num_bits child_idx = + extend ~ledger_depth path ~num_bits child_idx |> Or_error.ok_exn + let to_int (path : t) : int = Sequence.range 0 (depth path) |> Sequence.fold ~init:0 ~f:(fun acc i -> diff --git a/src/lib/merkle_address/merkle_address.mli b/src/lib/merkle_address/merkle_address.mli index af169723da8..a65b35cdb6e 100644 --- a/src/lib/merkle_address/merkle_address.mli +++ b/src/lib/merkle_address/merkle_address.mli @@ -33,6 +33,10 @@ val child : ledger_depth:int -> t -> Direction.t -> t Or_error.t val child_exn : ledger_depth:int -> t -> Direction.t -> t +val extend : ledger_depth:int -> t -> num_bits:int -> int64 -> t Or_error.t + +val extend_exn : ledger_depth:int -> t -> num_bits:int -> int64 -> t + val parent_exn : t -> t val dirs_from_root : t -> Direction.t list diff --git a/src/lib/syncable_ledger/syncable_ledger.ml b/src/lib/syncable_ledger/syncable_ledger.ml index 7fee41dd1b3..15f97bf9876 100644 --- a/src/lib/syncable_ledger/syncable_ledger.ml +++ b/src/lib/syncable_ledger/syncable_ledger.ml @@ -283,23 +283,9 @@ end = struct type query = Addr.t Query.t (* Provides addresses at an specific depth from this address *) - let rec intermediate_range : index -> Addr.t -> index -> Addr.t list = - fun ledger_depth addr i -> - match i with - | 0 -> - [ addr ] - | i -> - let left, right = - (* TODO: may be better to propagate the error *) - Option.value_exn - ( Or_error.ok - @@ Or_error.both - (Addr.child ~ledger_depth addr Direction.Left) - (Addr.child ~ledger_depth addr Direction.Right) ) - in - let left = intermediate_range ledger_depth left (i - 1) in - let right = intermediate_range ledger_depth right (i - 1) in - left @ right + let intermediate_range ledger_depth addr i = + Array.init (1 lsl i) ~f:(fun idx -> + Addr.extend_exn ~ledger_depth addr ~num_bits:i (Int64.of_int idx) ) module Responder = struct type t = @@ -408,7 +394,6 @@ end = struct let addresses = intermediate_range ledger_depth a subtree_depth in - let addresses = List.to_array addresses in match Or_error.try_with (fun () -> let get_hash a = MT.get_inner_hash_at_addr_exn mt a in @@ -586,7 +571,6 @@ end = struct if Hash.equal expected merged then ( Addr.Table.remove t.waiting_parents addr ; let addresses = intermediate_range ledger_depth addr subtree_depth in - let addresses = List.to_array addresses in let addresses_and_hashes = Array.zip_exn addresses nodes in (* Filter to fetch only those that differ *)