diff --git a/CHANGES.rst b/CHANGES.rst index f134fe7f88016762375ec9a8d8dd8c3d3ca38ca7..9ae4ea61c3fc74d7695f9c075b5d14bd38c84bfe 100644 --- a/CHANGES.rst +++ b/CHANGES.rst @@ -182,6 +182,9 @@ Smart Rollup client They can be imported with ``octez-client import secret key ``, or by merging the key files between the ``octez-client`` base directory and the ``smart-rollup-client-`` base directory. +- Fix a critical bug that could lead to data loss when chain + reorganizations happen while a GC is running. (MR :gl:`!11358`) + Smart Rollup WASM Debugger -------------------------- diff --git a/src/lib_layer2_store/indexed_store.ml b/src/lib_layer2_store/indexed_store.ml index 5ecec426f77b4bfe1146017de21ab5ad9c641ff1..8f915393464dee967b0518d9dfe46a88948617db 100644 --- a/src/lib_layer2_store/indexed_store.ml +++ b/src/lib_layer2_store/indexed_store.ml @@ -58,10 +58,6 @@ let read_int8 str offset = (* Functors to build stores on indexes *) -type ('key, 'value) gc_iterator = - | Retain of 'key list - | Iterator of {first : 'key; next : 'key -> 'value -> 'key option Lwt.t} - module type NAME = sig val name : string end @@ -103,7 +99,10 @@ module type INDEXABLE_STORE = sig val readonly : [> `Read] t -> [`Read] t val gc : - ?async:bool -> rw t -> (key, value) gc_iterator -> unit tzresult Lwt.t + ?async:bool -> + rw t -> + (key -> value -> bool tzresult Lwt.t) -> + unit tzresult Lwt.t val wait_gc_completion : 'a t -> unit Lwt.t @@ -153,7 +152,7 @@ module type INDEXED_FILE = sig val gc : ?async:bool -> rw t -> - (key, value * header) gc_iterator -> + (key -> header -> value -> bool tzresult Lwt.t) -> unit tzresult Lwt.t val wait_gc_completion : 'a t -> unit Lwt.t @@ -246,16 +245,6 @@ end) : INDEX_KEY with type t = E.t = struct (Data_encoding.Json.construct E.encoding k) end -let gc_reachable_of_iter = - let open Lwt_syntax in - function - | Iterator {first; next} -> ( - (Some first, fun k -> function Some v -> next k v | None -> return_none)) - | Retain keys -> - let dispenser = Seq.to_dispenser (List.to_seq keys) in - let first = dispenser () in - (first, fun _k _v -> return (dispenser ())) - module Make_indexable (N : NAME) (K : INDEX_KEY) (V : Index.Value.S) = struct module I = Index_unix.Make (K) (V) (Index.Cache.Unbounded) @@ -454,21 +443,6 @@ module Make_indexable (N : NAME) (K : INDEX_KEY) (V : Index.Value.S) = struct store.gc_status <- No_gc ; rm_internal_index tmp_index - (** Copy item associated to [k] from the [store] stale indexes to - [tmp_index]. *) - let unsafe_retain_one_item store tmp_index filter k = - let open Lwt_syntax in - let value = unsafe_find ~only_stale:true store k in - let* () = - match value with - | None -> - Store_events.missing_value_gc N.name (Format.asprintf "%a" K.pp k) - | Some v -> - if filter v then I.replace tmp_index.index k v ; - return_unit - in - return value - (** When the gc operation finishes, i.e. we have copied all elements to retain to the temporary index, we can replace all the stale indexes by the temporary one. *) @@ -484,25 +458,40 @@ module Make_indexable (N : NAME) (K : INDEX_KEY) (V : Index.Value.S) = struct let*! () = Store_events.finished_gc N.name in return_unit - (** The background task for a gc operation consists in copying all items - reachable by [gc_iter] from the stale indexes to the temporary one. While - this is happening, the stale indexes can still be queried and new bindings - can still be added to the store because only the fresh index is - modified. *) - let gc_background_task store tmp_index gc_iter filter resolve = + (** Returns the elements of an index in an unspecified order. NOTE: the elements + are stored in memory. *) + let index_bindings i = + let acc = ref [] in + I.iter (fun k v -> acc := (k, v) :: !acc) i ; + !acc + + (** The background task for a gc operation consists in copying all items that + satisfy [filter] from the stale indexes of [store] to the temporary one + [tmp_index]. While this is happening, the stale indexes can still be + queried and new bindings can still be added to the store because only the + fresh index is modified. *) + let gc_background_task store tmp_index filter resolve = let open Lwt_syntax in Lwt.dont_wait (fun () -> let* res = trace (Gc_failed N.name) @@ protect @@ fun () -> - let first, next = gc_reachable_of_iter gc_iter in - let rec copy elt = - let* value = unsafe_retain_one_item store tmp_index filter elt in - let* next = next elt value in - match next with None -> return_unit | Some elt -> copy elt + let open Lwt_result_syntax in + let process_key_value (k, v) = + let* keep = filter k v in + if keep then I.replace tmp_index.index k v ; + return_unit + in + let process_internal_index i = + List.iter_es process_key_value (index_bindings i.index) + in + let stale_internal_indexes = + internal_indexes ~only_stale:true store |> List.rev + in + let* () = + List.iter_es process_internal_index stale_internal_indexes in - let* () = Option.iter_s copy first in finalize_gc store tmp_index in let* () = @@ -521,24 +510,24 @@ module Make_indexable (N : NAME) (K : INDEX_KEY) (V : Index.Value.S) = struct (Printexc.to_string exn)) (** This function is called every time a gc operation starts. *) - let gc_internal ~async store gc_iter filter = + let gc_internal ~async store filter = let open Lwt_syntax in match store.gc_status with | Ongoing _ -> Store_events.ignore_gc N.name | No_gc -> let* tmp_index, promise, resolve = initiate_gc store in - gc_background_task store tmp_index gc_iter filter resolve ; + gc_background_task store tmp_index filter resolve ; if async then return_unit else Lwt.catch (fun () -> promise) (function Lwt.Canceled -> return_unit | e -> raise e) - let gc ?(async = true) store gc_iter = + let gc ?(async = true) store filter = let open Lwt_result_syntax in trace (Gc_failed N.name) @@ protect @@ fun () -> - let*! () = gc_internal ~async store gc_iter (fun _ -> true) in + let*! () = gc_internal ~async store filter in return_unit let wait_gc_completion store = @@ -615,21 +604,14 @@ struct if flush then I.flush store.fresh.index ; return_unit) - let gc ?(async = true) store gc_iter = + let gc ?(async = true) store filter = let open Lwt_result_syntax in trace (Gc_failed N.name) @@ protect @@ fun () -> - let gc_iter = - match gc_iter with - | Retain keys -> Retain keys - | Iterator {first; next} -> - let next k = function - | None -> Lwt.return_none - | Some v -> next k v - in - Iterator {first; next} - in - let*! () = gc_internal ~async store gc_iter Option.is_some in + (* Also remove bindings that point to None, i.e. the ones that were + artificially removed with {!remove}. *) + let filter k = function None -> return_false | Some v -> filter k v in + let*! () = gc_internal ~async store filter in return_unit end @@ -1067,23 +1049,6 @@ struct | Ok () -> () | Error _e -> (* ignore error when reverting *) ()) - (** Copy item associated to [k] from the [store] stale stores to - [tmp_store]. *) - let unsafe_retain_one_item store tmp_store key = - let open Lwt_result_syntax in - let* v = unsafe_read_from_disk_opt ~only_stale:true store key in - let* () = - match v with - | None -> - let*! () = - Store_events.missing_value_gc N.name (Format.asprintf "%a" K.pp key) - in - return_unit - | Some (value, header) -> - unsafe_append_internal tmp_store ~key ~header ~value - in - return v - (** When the gc operation finishes, i.e. we have copied all elements to retain to the temporary store, we can replace all the stale stores by the temporary one. *) @@ -1100,25 +1065,43 @@ struct let*! () = Store_events.finished_gc N.name in return_unit - (** The background task for a gc operation consists in copying all items - reachable by [gc_iter] from the stale stores to the temporary one. While - this is happening, the stale stores can still be queried and new bindings - can still be added to the store because only the fresh store is - modified. *) - let gc_background_task store tmp_store gc_iter resolve = + (** Returns the elements of an index in an unspecified order. NOTE: the elements + are stored in memory. *) + let index_header_bindings i = + let acc = ref [] in + Header_index.iter (fun k v -> acc := (k, v) :: !acc) i ; + !acc + + (** The background task for a gc operation consists in copying all items from + the stale stores of [store] that satisfy [filter] to the temporary one + [tmp_store]. While this is happening, the stale stores can still be + queried and new bindings can still be added to the store because only the + fresh store is modified. *) + let gc_background_task store tmp_store filter resolve = let open Lwt_result_syntax in Lwt.dont_wait (fun () -> let*! res = trace (Gc_failed N.name) @@ protect @@ fun () -> - let first, next = gc_reachable_of_iter gc_iter in - let rec copy elt = - let* value = unsafe_retain_one_item store tmp_store elt in - let*! next = next elt value in - match next with None -> return_unit | Some elt -> copy elt + let process_key_header internal_store (key, {IHeader.offset; header}) + = + let* value, _ofs = + Values_file.pread_value internal_store.fd ~file_offset:offset + in + let* keep = filter key header value in + if keep then unsafe_append_internal tmp_store ~key ~header ~value + else return_unit + in + let process_internal_store internal_store = + List.iter_es + (process_key_header internal_store) + (index_header_bindings internal_store.index) + in + let stale_internal_stores = + internal_stores ~only_stale:true store |> List.rev in - let* () = Option.iter_es copy first in + let* () = List.iter_es process_internal_store stale_internal_stores in finalize_gc store tmp_store in let*! () = @@ -1137,7 +1120,7 @@ struct N.name (Printexc.to_string exn)) - let gc_internal ~async store gc_iter = + let gc_internal ~async store filter = let open Lwt_result_syntax in match store.gc_status with | Ongoing _ -> @@ -1145,7 +1128,7 @@ struct return_unit | No_gc -> let* tmp_store, promise, resolve = initiate_gc store in - gc_background_task store tmp_store gc_iter resolve ; + gc_background_task store tmp_store filter resolve ; if async then return_unit else Lwt.catch @@ -1154,8 +1137,8 @@ struct return_unit) (function Lwt.Canceled -> return_unit | e -> raise e) - let gc ?(async = true) store gc_iter = - trace (Gc_failed N.name) @@ gc_internal ~async store gc_iter + let gc ?(async = true) store filter = + trace (Gc_failed N.name) @@ gc_internal ~async store filter let wait_gc_completion store = match store.gc_status with diff --git a/src/lib_layer2_store/indexed_store.mli b/src/lib_layer2_store/indexed_store.mli index 44760f1089cbd6179702472ac2ab2b8704c9897a..5a772a44d2199da7825ddb7b3ad6144f534480a4 100644 --- a/src/lib_layer2_store/indexed_store.mli +++ b/src/lib_layer2_store/indexed_store.mli @@ -39,20 +39,6 @@ open Store_sigs (** {2 Signatures} *) -(** An iterator for the GC functions. *) -type ('key, 'value) gc_iterator = - | Retain of 'key list (** A simple list of keys to retain. *) - | Iterator of { - first : 'key; (** The key at which the iteration starts for the GC. *) - next : 'key -> 'value -> 'key option Lwt.t; - (** A function to compute the next element to explore from the last - expired key, value binding in the store. We explicit the value - here because the next element can be computed from it without - accessing the store (e.g. to iterate over L2 blocks, we start from - the head and the next element is computed from the predecessor - field of the block. *) - } (** An iterator. The GC stops when the [next] function returns [None]. *) - (** A store for single updatable values. Values are stored in a file on disk and are kept in memory in a cache. *) module type SINGLETON_STORE = sig @@ -115,12 +101,15 @@ module type INDEXABLE_STORE = sig (** [readonly t] returns a read only version of the store [t]. *) val readonly : [> `Read] t -> [`Read] t - (** [gc ?async t iter] garbage collects data stored in the index [t] by - keeping only the ones that are reachable by [iter]. This call - runs the GC asynchronously unless [async] is [false]. If a GC is already + (** [gc ?async t filter] garbage collects data stored in the index [t] by + keeping only elements that satisfy the predicate [filter]. This call runs + the GC asynchronously unless [async] is [false]. If a GC is already ongoing this new request is ignored and this call is a no-op. *) val gc : - ?async:bool -> rw t -> (key, value) gc_iterator -> unit tzresult Lwt.t + ?async:bool -> + rw t -> + (key -> value -> bool tzresult Lwt.t) -> + unit tzresult Lwt.t (** [wait_gc_completion t] returns a blocking thread if a GC run is ongoing. *) val wait_gc_completion : 'a t -> unit Lwt.t @@ -193,14 +182,14 @@ module type INDEXED_FILE = sig (** [readonly t] returns a read only version of the store [t]. *) val readonly : [> `Read] t -> [`Read] t - (** [gc ?async t iter] garbage collects data stored in the store [t] by - keeping only the ones reachable by [iter]. This call runs the GC - asynchronously unless [async] is [false]. If a GC is already + (** [gc ?async t filter] garbage collects data stored in the store [t] by + keeping only elements that satisfy the predicate [filter]. This call runs + the GC asynchronously unless [async] is [false]. If a GC is already ongoing this new request is ignored and this call is a no-op. *) val gc : ?async:bool -> rw t -> - (key, value * header) gc_iterator -> + (key -> header -> value -> bool tzresult Lwt.t) -> unit tzresult Lwt.t (** [wait_gc_completion t] returns a blocking thread if a GC run is currently diff --git a/src/lib_layer2_store/test/test_indexed_store.ml b/src/lib_layer2_store/test/test_indexed_store.ml index 5859c4e8997b2ee1028a82c4039fa82e8269808b..b164bc027fab06652f3b4198c0a7c9400be1c200 100644 --- a/src/lib_layer2_store/test/test_indexed_store.ml +++ b/src/lib_layer2_store/test/test_indexed_store.ml @@ -554,7 +554,9 @@ module Indexable_for_test = struct let close = S.close - let gc s ~retain = S.gc ~async:false s (Retain retain) + let gc s ~retain = + S.gc ~async:false s (fun x _ -> + Lwt_result.return @@ List.mem ~equal:String.equal x retain) end let () = @@ -601,7 +603,9 @@ module Indexable_removable_for_test = struct let close = S.close - let gc s ~retain = S.gc ~async:false s (Retain retain) + let gc s ~retain = + S.gc ~async:false s (fun x _ -> + Lwt_result.return @@ List.mem ~equal:String.equal x retain) end let () = @@ -679,7 +683,9 @@ module Indexed_file_for_test = struct let close = S.close - let gc s ~retain = S.gc ~async:false s (Retain retain) + let gc s ~retain = + S.gc ~async:false s (fun x _ _ -> + Lwt_result.return @@ List.mem ~equal:String.equal x retain) end module Indexed_file_integers = struct @@ -713,17 +719,8 @@ module Indexed_file_integers = struct let close = S.close let gc s ~largest ~smallest = - S.gc - ~async:false - s - (Iterator - { - first = largest; - next = - (fun i _ -> - if i <= smallest then Lwt.return_none - else Lwt.return_some (Int32.pred i)); - }) + S.gc ~async:false s (fun i _ _ -> + Lwt_result.return (i >= smallest && i <= largest)) end let () = diff --git a/src/lib_smart_rollup_node/store_v0.ml b/src/lib_smart_rollup_node/store_v0.ml index 8b3479311b0d13a6bb156115f0be5016cf6cdf49..0eb7540279ba5b9afacd1c0dabefb70a1827a9e7 100644 --- a/src/lib_smart_rollup_node/store_v0.ml +++ b/src/lib_smart_rollup_node/store_v0.ml @@ -182,7 +182,7 @@ module Commitments_published_at_level = struct include Indexed_store.Make_indexable (struct - let name = "commitments" + let name = "commitments_published_at_level" end) (Make_hash_index_key (Octez_smart_rollup.Commitment.Hash)) (Indexed_store.Make_index_value (Indexed_store.Make_fixed_encodable (struct diff --git a/src/lib_smart_rollup_node/store_v2.ml b/src/lib_smart_rollup_node/store_v2.ml index 8ad1843ade4428eaabb1dc0a0c953a31fb350cbf..e92cd2753ef3259888a081be0af5592c3f203d47 100644 --- a/src/lib_smart_rollup_node/store_v2.ml +++ b/src/lib_smart_rollup_node/store_v2.ml @@ -508,114 +508,40 @@ let iter_l2_blocks ?progress metadata ({l2_blocks; l2_head; _} as store) f = in loop head.header.block_hash -let gc_l2_blocks l2_blocks ~(head : Sc_rollup_block.t) ~level = - L2_blocks.gc - l2_blocks - (Indexed_store.Iterator - { - first = head.header.block_hash; - next = - (fun _hash (_content, header) -> - if header.Sc_rollup_block.level <= level then Lwt.return_none - else Lwt.return_some header.predecessor); - }) - -let gc_commitments commitments ~last_commitment ~level = - Commitments.gc - commitments - (Indexed_store.Iterator - { - first = last_commitment; - next = - (fun _hash (commitment, ()) -> - if commitment.Commitment.inbox_level <= level then Lwt.return_none - else Lwt.return_some commitment.predecessor); - }) - -let gc_levels_to_hashes levels_to_hashes ~(head : Sc_rollup_block.t) ~level = - Levels_to_hashes.gc - levels_to_hashes - (Indexed_store.Iterator - { - first = head.header.level; - next = - (fun blevel _bhash -> - if blevel <= level then Lwt.return_none - else Lwt.return_some (Int32.pred blevel)); - }) - -let gc_messages messages l2_blocks ~(head : Sc_rollup_block.t) ~level = - Messages.gc - messages - (Indexed_store.Iterator - { - first = head.header.inbox_witness; - next = - (fun _witness (_msgs, predecessor) -> - let open Lwt_syntax in - let* pred_inbox_witness = - let open Lwt_result_syntax in - let+ pred = L2_blocks.header l2_blocks predecessor in - match pred with - | Some {level = pred_level; inbox_witness; _} - when pred_level >= level -> - Some inbox_witness - | _ -> None - in - match pred_inbox_witness with - | Error e -> - Fmt.failwith - "Could not compute messages witness for GC: %a" - pp_print_trace - e - | Ok witness -> return witness); - }) +let gc_l2_blocks l2_blocks ~level = + L2_blocks.gc l2_blocks (fun _hash header _content -> + Lwt_result.return (header.Sc_rollup_block.level >= level)) + +let gc_commitments commitments ~level = + Commitments.gc commitments (fun _hash () commitment -> + Lwt_result.return (commitment.Commitment.inbox_level >= level)) + +let gc_levels_to_hashes levels_to_hashes ~level = + Levels_to_hashes.gc levels_to_hashes (fun block_level _block_hash -> + Lwt_result.return (block_level >= level)) + +let gc_messages messages l2_blocks ~level = + Messages.gc messages (fun _witness predecessor _msgs -> + let open Lwt_result_syntax in + let+ pred = L2_blocks.header l2_blocks predecessor in + match pred with + | Some {level = pred_level; _} -> pred_level >= Int32.pred level + | None -> false) let gc_commitments_published_at_level commitments_published_at_level commitments - lpc ~level = - let open Lwt_result_syntax in - let* lpc = Lpc.read lpc in - match lpc with - | None -> return_unit - | Some lpc -> - Commitments_published_at_level.gc - commitments_published_at_level - (Indexed_store.Iterator - { - first = Commitment.hash lpc; - next = - (fun commitment_hash _ -> - let open Lwt_syntax in - let* commitment = - Commitments.read commitments commitment_hash - in - match commitment with - | Error e -> - Fmt.failwith - "Could not compute commitment published at level for \ - GC: %a" - pp_print_trace - e - | Ok None -> return_none - | Ok (Some (commitment, ())) -> - if commitment.Commitment.inbox_level <= level then - return_none - else return_some commitment.predecessor); - }) - -let gc_inboxes inboxes ~(head : Sc_rollup_block.t) ~level = - Inboxes.gc - inboxes - (Indexed_store.Iterator - { - first = head.header.inbox_hash; - next = - (fun _inbox_hash (inbox, ()) -> - let open Lwt_syntax in - if inbox.level <= level then return_none - else - return (Inbox.Skip_list.back_pointer inbox.old_levels_messages 0)); - }) + ~level = + Commitments_published_at_level.gc + commitments_published_at_level + (fun commitment_hash _ -> + let open Lwt_result_syntax in + let* commitment = Commitments.read commitments commitment_hash in + match commitment with + | None -> return_false + | Some ({inbox_level; _}, ()) -> return (inbox_level >= level)) + +let gc_inboxes inboxes ~level = + Inboxes.gc inboxes (fun _inbox_hash () inbox -> + Lwt_result.return (inbox.level >= level)) let gc ({ @@ -624,10 +550,10 @@ let gc inboxes; commitments; commitments_published_at_level; - l2_head; + l2_head = _; last_finalized_level = _; lcc = _; - lpc; + lpc = _; levels_to_hashes; irmin_store = _; protocols = _; @@ -636,29 +562,18 @@ let gc } : _ t) ~level = let open Lwt_result_syntax in - let* head = L2_head.read l2_head in - match head with - | None -> return_unit - | Some head -> - let last_commitment = - Sc_rollup_block.most_recent_commitment head.header - in - let* () = - tzjoin - [ - gc_l2_blocks l2_blocks ~head ~level; - gc_commitments commitments ~last_commitment ~level; - gc_levels_to_hashes levels_to_hashes ~head ~level; - gc_messages messages l2_blocks ~head ~level; - gc_commitments_published_at_level - commitments_published_at_level - commitments - lpc - ~level; - gc_inboxes inboxes ~head ~level; - ] - in - return_unit + tzjoin + [ + gc_l2_blocks l2_blocks ~level; + gc_commitments commitments ~level; + gc_levels_to_hashes levels_to_hashes ~level; + gc_messages messages l2_blocks ~level; + gc_commitments_published_at_level + commitments_published_at_level + commitments + ~level; + gc_inboxes inboxes ~level; + ] let wait_gc_completion ({ diff --git a/src/lib_smart_rollup_node/test/helpers/helpers.ml b/src/lib_smart_rollup_node/test/helpers/helpers.ml index 73b0b5cea79c2675f9e8b1c8ceb23f67d3882cf2..15bc62570ee835c7bbba8a30c4c38eabf2e6bdf7 100644 --- a/src/lib_smart_rollup_node/test/helpers/helpers.ml +++ b/src/lib_smart_rollup_node/test/helpers/helpers.ml @@ -25,11 +25,17 @@ let uid = ref 0 -let block_hash_of_level level = - let s = Z.of_int32 level |> Z.to_bits in - let len = String.length s in +(* Create a block hash that depends deterministically on the level and messages + content. *) +let make_block_hash level messages = + let h_msgs = Hashtbl.hash messages in + (* Rudimentary hash for level and messages. *) + let hash_string = Z.of_int (Int32.to_int level + (7 * h_msgs)) |> Z.to_bits in + let len = String.length hash_string in + (* Left pad hash_string with null bytes *) let s = - String.init Block_hash.size (fun i -> if i >= len then '\000' else s.[i]) + String.init Block_hash.size (fun i -> + if i >= len then '\000' else hash_string.[i]) in Block_hash.of_string_exn s @@ -173,8 +179,8 @@ let with_node_context ?constants kind protocol ~boot_sector f = let* _ = Node_context.close node_ctxt in return_unit -let head_of_level ~predecessor level = - let hash = block_hash_of_level level in +let make_header ~predecessor level messages = + let hash = make_block_hash level messages in let timestamp = Time.Protocol.of_seconds (Int64.of_int32 level) in let header : Block_header.shell_header = { @@ -191,25 +197,45 @@ let head_of_level ~predecessor level = in {Layer1.hash; level; header} -let append_l2_block (node_ctxt : _ Node_context.t) ?(is_first_block = false) - messages = +let header_of_block (block : Sc_rollup_block.t) = + let hash = block.header.block_hash in + let level = block.header.level in + let timestamp = Time.Protocol.of_seconds (Int64.of_int32 level) in + let header : Block_header.shell_header = + { + level; + predecessor = block.header.predecessor; + timestamp; + (* dummy values below *) + proto_level = 0; + validation_passes = 3; + operations_hash = Tezos_crypto.Hashed.Operation_list_list_hash.zero; + fitness = []; + context = Tezos_crypto.Hashed.Context_hash.zero; + } + in + {Layer1.hash; level; header} + +let add_l2_block (node_ctxt : _ Node_context.t) ?(is_first_block = false) + ~(predecessor_l2_block : Sc_rollup_block.t) messages = let open Lwt_result_syntax in - let* predecessor_l2_block = Node_context.last_processed_head_opt node_ctxt in - let* predecessor_l2_block = - match predecessor_l2_block with - | Some b -> return b - | None -> - failwith "No genesis block, please add one with add_l2_genesis_block" + let* () = + Node_context.save_level + node_ctxt + { + Layer1.hash = predecessor_l2_block.header.block_hash; + level = predecessor_l2_block.header.level; + } in + let* () = Node_context.set_l2_head node_ctxt predecessor_l2_block in let pred_level = predecessor_l2_block.header.level in - let predecessor = - head_of_level - ~predecessor:predecessor_l2_block.header.predecessor - pred_level - in let head = - head_of_level ~predecessor:predecessor.hash (Int32.succ pred_level) + make_header + ~predecessor:predecessor_l2_block.header.block_hash + (Int32.succ pred_level) + messages in + let predecessor = header_of_block predecessor_l2_block in let*? plugin = Protocol_plugins.proto_plugin_for_protocol node_ctxt.current_protocol.hash in @@ -221,6 +247,18 @@ let append_l2_block (node_ctxt : _ Node_context.t) ?(is_first_block = false) head messages +let append_l2_block (node_ctxt : _ Node_context.t) ?(is_first_block = false) + messages = + let open Lwt_result_syntax in + let* predecessor_l2_block = Node_context.last_processed_head_opt node_ctxt in + let* predecessor_l2_block = + match predecessor_l2_block with + | Some b -> return b + | None -> + failwith "No genesis block, please add one with add_l2_genesis_block" + in + add_l2_block node_ctxt ~is_first_block ~predecessor_l2_block messages + let append_l2_blocks node_ctxt message_batches = List.map_es (append_l2_block node_ctxt) message_batches diff --git a/src/lib_smart_rollup_node/test/helpers/helpers.mli b/src/lib_smart_rollup_node/test/helpers/helpers.mli index a3a3b39db84b4a47a289e3afdbf4755bfedd2e7d..006a163183ad8b3b30b16611ffe0578da9e557e3 100644 --- a/src/lib_smart_rollup_node/test/helpers/helpers.mli +++ b/src/lib_smart_rollup_node/test/helpers/helpers.mli @@ -84,6 +84,17 @@ val append_dummy_l2_chain : length:int -> Sc_rollup_block.t list tzresult Lwt.t +(** [add_l2_block node_ctxt ?is_first_block ~predecessor_l2_block messages] + creates and append an L2 block containing the [messages] given in + argument. The block is added on top [predecessor_l2_block], set as the new + head of the chain and it is returned. *) +val add_l2_block : + [`Read | `Write] Node_context.t -> + ?is_first_block:bool -> + predecessor_l2_block:Sc_rollup_block.t -> + string list -> + Sc_rollup_block.t tzresult Lwt.t + (** {2 Assertions} *) module Assert : sig diff --git a/src/lib_smart_rollup_node/test/test_store_gc.ml b/src/lib_smart_rollup_node/test/test_store_gc.ml index e75d21b92a17f1d138be88af9849defc41b68daf..e483ec4c6e5511170ae72e4a44babc06a37568c3 100644 --- a/src/lib_smart_rollup_node/test/test_store_gc.ml +++ b/src/lib_smart_rollup_node/test/test_store_gc.ml @@ -35,6 +35,96 @@ let check_raw_read name store ~gc_level (block : Sc_rollup_block.t) block.header.level | _ -> () +(** This function ensures that blocks in the [chain] that are after [gc_level] + are fully available and that information for blocks before [gc_level] has + indeed been collected. It is meant to be called after a GC finishes. *) +let check_chain_ok ~gc_level node_ctxt store chain = + let open Lwt_result_syntax in + List.iter_es + (fun (block : Sc_rollup_block.t) -> + (* Checking low-level accesses through raw store *) + let* () = + check_raw_read + "l2_blocks" + store + ~gc_level + block + (fun s -> s.Store.l2_blocks) + Store.L2_blocks.read + block.header.block_hash + in + let* () = + check_raw_read + "messages" + store + ~gc_level + block + (fun s -> s.Store.messages) + Store.Messages.read + block.header.inbox_witness + in + let* () = + check_raw_read + "inboxes" + store + ~gc_level + block + (fun s -> s.Store.inboxes) + Store.Inboxes.read + block.header.inbox_hash + in + let* () = + match block.header.commitment_hash with + | None -> return_unit + | Some commitment_hash -> + check_raw_read + "commitments" + store + ~gc_level + block + (fun s -> s.Store.commitments) + Store.Commitments.read + commitment_hash + in + let* () = + check_raw_read + "levels" + store + ~gc_level + block + (fun s -> s.Store.levels_to_hashes) + Store.Levels_to_hashes.find + block.header.level + in + (* Checking access through Node_context *) + let* stored_block_by_hash = + Node_context.find_l2_block node_ctxt block.header.block_hash + in + let* stored_block_by_level = + Node_context.find_l2_block_by_level node_ctxt block.header.level + in + (match (stored_block_by_hash, stored_block_by_level) with + | None, None when block.header.level < gc_level -> () + | (Some _, _ | _, Some _) when block.header.level < gc_level -> + Assert.fail_msg + "Block %ld is available but should have been removed by the GC" + block.header.level + | _, None | None, _ -> assert false + | Some stored_block_by_hash, Some stored_block_by_level -> + Helpers.Assert.L2_block.equal + ~loc:__LOC__ + ~msg:"stored_block_by_hash_ok" + stored_block_by_hash + block ; + Helpers.Assert.L2_block.equal + ~loc:__LOC__ + ~msg:"stored_block_by_level_ok" + stored_block_by_level + block) ; + return_unit) + chain + +(* Test that garbage collection on store performs as expected. *) let gc_test node_ctxt ~genesis = let open Lwt_result_syntax in let length = 100 in @@ -46,102 +136,71 @@ let gc_test node_ctxt ~genesis = let* last_block = Helpers.append_l2_block node_ctxt ["\001I'm new"] in let*! () = Store.wait_gc_completion store in (* Checking result of GC *) + let* () = check_chain_ok ~gc_level node_ctxt store (chain @ [last_block]) in + return_unit + +(* Test that garbage collection on store works correctly in the presence of + reorganizations which happen during GC. In particular this test ensures that + no useful data is removed by the GC in this case. + + This test creates a chain with a fork: + + --- A --- B + `--- B' (head) + + The GC is started and a reorganization is triggered while it is running. + + --- A --- B --- C (head) + `--- B' +*) +let gc_test_reorg node_ctxt ~genesis = + let open Lwt_result_syntax in + let length = 100 in + let gc_level = 50l in + let* chain = build_chain node_ctxt ~genesis ~length in + let head, pred, rest = + match List.rev chain with + | [] | [_] -> assert false + | head :: pred :: r -> (head, pred, List.rev r) + in + (* Create a fork at the same level as head *) + let* head' = + Helpers.add_l2_block node_ctxt ["\001Forked"] ~predecessor_l2_block:pred + in + (* Garbage collecting everything below level 50 *) + let store = Node_context.Internal_for_tests.unsafe_get_store node_ctxt in + let* () = Store.gc store ~level:gc_level in + (* Trigger a reorganization by adding a new block on top of the alternative + head. *) + let* last_block = + Helpers.add_l2_block node_ctxt ["\001Reorged"] ~predecessor_l2_block:head + in + let*! () = Store.wait_gc_completion store in + (* Ensure both forked blocks are available *) + let* reorged_block_by_hash = + Node_context.find_l2_block node_ctxt head.header.block_hash + in + if reorged_block_by_hash = None then + Assert.fail_msg "Reorged block is unavailable after GC" ; + let* alternative_block_by_hash = + Node_context.find_l2_block node_ctxt head'.header.block_hash + in + if alternative_block_by_hash = None then + Assert.fail_msg "Alternative block after reorg is unavailable after GC" ; + (* Checking result of GC *) let* () = - List.iter_es - (fun (block : Sc_rollup_block.t) -> - (* Checking low-level accesses through raw store *) - let* () = - check_raw_read - "l2_blocks" - store - ~gc_level - block - (fun s -> s.Store.l2_blocks) - Store.L2_blocks.read - block.header.block_hash - in - let* () = - check_raw_read - "messages" - store - ~gc_level - block - (fun s -> s.Store.messages) - Store.Messages.read - block.header.inbox_witness - in - let* () = - check_raw_read - "inboxes" - store - ~gc_level - block - (fun s -> s.Store.inboxes) - Store.Inboxes.read - block.header.inbox_hash - in - let* () = - match block.header.commitment_hash with - | None -> return_unit - | Some commitment_hash -> - check_raw_read - "commitments" - store - ~gc_level - block - ~should_exist:(block.header.level > Int32.sub gc_level 3l) - (* We may keep an extra commitment because we jump over commitment - periods (a commitment period is 3 blocks for tests). *) - (fun s -> s.Store.commitments) - Store.Commitments.read - commitment_hash - in - let* () = - check_raw_read - "levels" - store - ~gc_level - block - (fun s -> s.Store.levels_to_hashes) - Store.Levels_to_hashes.find - block.header.level - in - (* Checking access through Node_context *) - let* store_block_by_hash = - Node_context.find_l2_block node_ctxt block.header.block_hash - in - let* store_block_by_level = - Node_context.find_l2_block_by_level node_ctxt block.header.level - in - (match (store_block_by_hash, store_block_by_level) with - | None, None when block.header.level < gc_level -> () - | (Some _, _ | _, Some _) when block.header.level < gc_level -> - Assert.fail_msg - "Block %ld is available but should have been removed by the GC" - block.header.level - | _, None | None, _ -> assert false - | Some store_block_by_hash, Some store_block_by_level -> - Helpers.Assert.L2_block.equal - ~loc:__LOC__ - ~msg:"stored_block_by_hash_ok" - store_block_by_hash - block ; - Helpers.Assert.L2_block.equal - ~loc:__LOC__ - ~msg:"stored_block_by_level_ok" - store_block_by_level - block) ; - return_unit) - (chain @ [last_block]) + check_chain_ok ~gc_level node_ctxt store (rest @ [pred; head; last_block]) in return_unit -let tests = +let mk_tests t = List.map - (fun proto -> - Helpers.alcotest `Quick Wasm_2_0_0 proto ~boot_sector:"" gc_test) + (fun proto -> Helpers.alcotest `Quick Wasm_2_0_0 proto ~boot_sector:"" t) (Protocol_plugins.registered_protocols ()) let () = - Alcotest_lwt.run ~__FILE__ "lib_smart_rollup_node" [("store_gc", tests)] + Alcotest_lwt.run + ~__FILE__ + "lib_smart_rollup_node" + [("store_gc", mk_tests gc_test); ("store_gc_reorg", mk_tests gc_test_reorg)] |> Lwt_main.run