diff --git a/docs/protocols/alpha.rst b/docs/protocols/alpha.rst index 890f58a87eee170ff3d83f096826187a12ca4880..f9db68742f5f853732fba9760424ac3697d4bcf1 100644 --- a/docs/protocols/alpha.rst +++ b/docs/protocols/alpha.rst @@ -42,6 +42,9 @@ It requires protocol environment V7, compared to V6 for Kathmandu. - Introduce a ``Bls`` module to gather both high and low level functions for BLS cryptography. (MR :gl:`!6295`) +- Introduce a new protocol API adapted to pipelined validation. + (MR :gl:`!6335`) + Consensus key ------------- diff --git a/src/bin_client/test/proto_test_injection/main.ml b/src/bin_client/test/proto_test_injection/main.ml index bb03954f4801ea8a9abcf2723c2f93d4c2b9863c..c3f1b9fc2270fd806d2bc16a5917de98b985bb6f 100644 --- a/src/bin_client/test/proto_test_injection/main.ml +++ b/src/bin_client/test/proto_test_injection/main.ml @@ -66,7 +66,9 @@ let compare_operations _ _ = 0 let acceptable_pass _ = Some 0 -type validation_state = {context : Context.t; fitness : Int64.t} +type validation_state = unit + +type application_state = {context : Context.t; fitness : Int64.t} module Fitness = struct type error += Invalid_fitness @@ -92,38 +94,48 @@ module Fitness = struct let get {fitness; _} = fitness end -let begin_application ~chain_id:_ ~predecessor_context:context - ~predecessor_timestamp:_ ~predecessor_fitness:_ (raw_block : block_header) = - Fitness.to_int64 raw_block.shell.fitness >>=? fun fitness -> - return {context; fitness} +type mode = + | Application of block_header + | Partial_validation of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + +let begin_validation _ctxt _chain_id _mode ~predecessor:_ = return () + +let validate_operation ?check_signature:_ _validation_state _oph _op = return () + +let finalize_validation _validation_state = return () -let begin_partial_application ~chain_id ~ancestor_context ~predecessor_timestamp - ~predecessor_fitness raw_block = - begin_application - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp - ~predecessor_fitness - raw_block - -let begin_construction ~chain_id:_ ~predecessor_context:context - ~predecessor_timestamp:_ ~predecessor_level:_ - ~predecessor_fitness:pred_fitness ~predecessor:_ ~timestamp:_ - ?protocol_data:_ () = - Fitness.to_int64 pred_fitness >>=? fun pred_fitness -> - let fitness = Int64.succ pred_fitness in +let begin_application context _chain_id mode + ~(predecessor : Block_header.shell_header) = + let open Lwt_result_syntax in + let* fitness = + match mode with + | Application block_header | Partial_validation block_header -> + Fitness.to_int64 block_header.shell.fitness + | Construction _ | Partial_construction _ -> + let* predecessor_fitness = Fitness.to_int64 predecessor.fitness in + return (Int64.succ predecessor_fitness) + in return {context; fitness} -let apply_operation ctxt _ = return (ctxt, ()) +let apply_operation application_state _oph _op = return (application_state, ()) -let finalize_block ctxt _block_header = - let fitness = Fitness.get ctxt in +let finalize_application application_state _block_header = + let fitness = Fitness.get application_state in let message = Some (Format.asprintf "fitness <- %Ld" fitness) in let fitness = Fitness.from_int64 fitness in return ( { Updater.message; - context = ctxt.context; + context = application_state.context; fitness; max_operations_ttl = 0; last_allowed_fork_level = 0l; @@ -180,8 +192,7 @@ module Mempool = struct | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ = - Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit diff --git a/src/lib_mockup/local_services.ml b/src/lib_mockup/local_services.ml index 10e6034650f49d593db00cdaaee44dd16b363a03..228f9312457e5cf0d28785f31f3d864f4b7d196d 100644 --- a/src/lib_mockup/local_services.ml +++ b/src/lib_mockup/local_services.ml @@ -194,25 +194,48 @@ module Make (E : MENV) = struct E.Protocol.block_header_data_encoding E.protocol_data + let begin_validation_and_application ctxt chain_id mode ~predecessor ~cache = + let open Lwt_result_syntax in + let* validation_state = + E.Protocol.begin_validation ctxt chain_id mode ~predecessor ~cache + in + let* application_state = + E.Protocol.begin_application ctxt chain_id mode ~predecessor ~cache + in + return (validation_state, application_state) + + let validate_and_apply_operation (validation_state, application_state) oph op + = + let open Lwt_result_syntax in + let* validation_state = + E.Protocol.validate_operation validation_state oph op + in + let* application_state, receipt = + E.Protocol.apply_operation application_state oph op + in + return ((validation_state, application_state), receipt) + + let finalize_validation_and_application (validation_state, application_state) + shell_header = + let open Lwt_result_syntax in + let* () = E.Protocol.finalize_validation validation_state in + E.Protocol.finalize_application application_state shell_header + let partial_construction ~cache () = - let predecessor = E.rpc_context.block_hash in - let header = E.rpc_context.block_header in + let predecessor_hash = E.rpc_context.block_hash in + let predecessor = E.rpc_context.block_header in let predecessor_context = E.rpc_context.context in let timestamp = Time.System.to_protocol @@ Tezos_base.Time.System.now () in - E.Protocol.begin_construction - ~chain_id:E.chain_id - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_level:header.level - ~predecessor_fitness:header.fitness + begin_validation_and_application + predecessor_context + E.chain_id + (Partial_construction {predecessor_hash; timestamp}) ~predecessor - ~timestamp ~cache - () let full_construction ?timestamp ~protocol_data ~cache () = - let predecessor = E.rpc_context.block_hash in - let header = E.rpc_context.block_header in + let predecessor_hash = E.rpc_context.block_hash in + let predecessor = E.rpc_context.block_header in let predecessor_context = E.rpc_context.context in let timestamp = let default () = @@ -220,17 +243,13 @@ module Make (E : MENV) = struct in Option.value_f timestamp ~default in - E.Protocol.begin_construction - ~chain_id:E.chain_id - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_level:header.level - ~predecessor_fitness:header.fitness + begin_validation_and_application + predecessor_context + E.chain_id + (Construction + {predecessor_hash; timestamp; block_header_data = protocol_data}) ~predecessor - ~protocol_data - ~timestamp ~cache - () let op_data_encoding = E.Protocol.operation_data_encoding @@ -405,7 +424,7 @@ module Make (E : MENV) = struct let set = Block_hash.Set.singleton E.rpc_context.block_hash in RPC_answer.return set)) - let simulate_operation (validation_state, preapply_result) op = + let simulate_operation (state, preapply_result) op = let open Lwt_result_syntax in match Data_encoding.Binary.to_bytes @@ -416,12 +435,12 @@ module Make (E : MENV) = struct | Ok proto -> ( let op_t = {Operation.shell = op.shell; proto} in let hash = Operation.hash op_t in - let*! r = E.Protocol.apply_operation validation_state op in + let*! r = validate_and_apply_operation state hash op in match r with | Error e -> let open Preapply_result in return - ( validation_state, + ( state, { preapply_result with refused = @@ -430,10 +449,10 @@ module Make (E : MENV) = struct (op_t, e) preapply_result.refused; } ) - | Ok (validation_state, _) -> + | Ok (state, _) -> let open Preapply_result in return - ( validation_state, + ( state, { preapply_result with applied = (hash, op_t) :: preapply_result.applied; @@ -454,23 +473,21 @@ module Make (E : MENV) = struct with_chain ~caller_name:"preapply_block" chain (fun () -> let*! r = let timestamp = o#timestamp in - let* validation_state = + let* proto_state = full_construction ~cache:`Lazy ?timestamp:o#timestamp ~protocol_data () in - let* validation_passes, validation_state, preapply_results = + let* validation_passes, proto_state, preapply_results = List.fold_left_es - (fun ( validation_passes, - validation_state, - validation_result ) + (fun (validation_passes, proto_state, validation_result) operations -> let* state, result = List.fold_left_es simulate_operation - (validation_state, Preapply_result.empty) + (proto_state, Preapply_result.empty) operations in let open Preapply_result in @@ -481,12 +498,13 @@ module Make (E : MENV) = struct ( succ validation_passes, state, p_result :: validation_result )) - (0, validation_state, []) + (0, proto_state, []) operations in - let cache_nonce = Some E.rpc_context.block_header in let* validation_result, _metadata = - E.Protocol.finalize_block validation_state cache_nonce + finalize_validation_and_application + proto_state + (Some E.rpc_context.block_header) in (* Similar to lib_shell.Prevalidation.preapply *) let operations_hash = @@ -525,6 +543,18 @@ module Make (E : MENV) = struct | Error errs -> RPC_answer.fail errs | Ok v -> RPC_answer.return v)) + let hash_protocol_operation op = + match + Data_encoding.Binary.to_bytes + E.Protocol.operation_data_encoding + op.E.Protocol.protocol_data + with + | Error _ -> + failwith "mockup preapply_operations: cannot deserialize operation" + | Ok proto -> + let op_t = {Operation.shell = op.shell; proto} in + Lwt_result.return (Operation.hash op_t) + let preapply () = let open Lwt_result_syntax in Directory.prefix @@ -540,21 +570,24 @@ module Make (E : MENV) = struct (fun ((_, chain), _block) () op_list -> with_chain ~caller_name:"preapply operations" chain (fun () -> let*! outcome = - let* state = partial_construction ~cache:`Lazy () in - let* state, acc = + let* proto_state = partial_construction ~cache:`Lazy () in + let* proto_state, acc = List.fold_left_es - (fun (state, acc) op -> - let* state, result = - E.Protocol.apply_operation state op + (fun (proto_state, acc) op -> + let* oph = hash_protocol_operation op in + let* proto_state, result = + validate_and_apply_operation proto_state oph op in - return (state, (op.protocol_data, result) :: acc)) - (state, []) + return (proto_state, (op.protocol_data, result) :: acc)) + (proto_state, []) op_list in (* A pre-application should not commit into the protocol caches. For this reason, [cache_nonce] is [None]. *) - let* _ = E.Protocol.finalize_block state None in + let* _ = + finalize_validation_and_application proto_state None + in return (List.rev acc) in match outcome with @@ -584,16 +617,16 @@ module Make (E : MENV) = struct if List.mem ~equal:equal_op op mempool_operations then return `Equal else let operations = op :: mempool_operations in - let* validation_state = partial_construction ~cache:`Lazy () in - let* validation_state, preapply_result = + let* proto_state = partial_construction ~cache:`Lazy () in + let* proto_state, preapply_result = List.fold_left_es (fun rstate (shell, protocol_data) -> simulate_operation rstate E.Protocol.{shell; protocol_data}) - (validation_state, Preapply_result.empty) + (proto_state, Preapply_result.empty) operations in if Operation_hash.Map.is_empty preapply_result.refused then - let* _ = E.Protocol.finalize_block validation_state None in + let* _ = finalize_validation_and_application proto_state None in return `Applicable else return `Refused @@ -654,13 +687,12 @@ module Make (E : MENV) = struct {E.Protocol.shell = shell_header; protocol_data = operation_data} in let*! result = - let* state = partial_construction ~cache:`Lazy () in - let* state, receipt = E.Protocol.apply_operation state op in - (* The following finalization does not have to update protocol - caches because we are not interested in block creation here. - Hence, [cache_nonce] is set to [None]. *) + let* proto_state = partial_construction ~cache:`Lazy () in + let* proto_state, receipt = + validate_and_apply_operation proto_state operation_hash op + in let* validation_result, _block_header_metadata = - E.Protocol.finalize_block state None + finalize_validation_and_application proto_state None in return (validation_result, receipt) in @@ -685,20 +717,22 @@ module Make (E : MENV) = struct with | None -> assert false | Some protocol_data -> - let header = E.rpc_context.block_header in + let predecessor = E.rpc_context.block_header in let predecessor_context = E.rpc_context.context in - let* validation_state = - E.Protocol.begin_application - ~chain_id:E.chain_id - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_fitness:header.fitness - {shell = block_header.shell; protocol_data} + let mode = + E.Protocol.Application {shell = block_header.shell; protocol_data} + in + let* proto_state = + begin_validation_and_application + predecessor_context + E.chain_id + mode + ~predecessor ~cache:`Lazy in - let* validation_state, _ = + let* proto_state, _ = List.fold_left_es - (List.fold_left_es (fun (validation_state, results) op -> + (List.fold_left_es (fun (proto_state, results) op -> match Data_encoding.Binary.of_bytes op_data_encoding @@ -706,20 +740,23 @@ module Make (E : MENV) = struct with | Error _ -> failwith "Cannot parse" | Ok operation_data -> + let oph = Operation.hash op in let op = { E.Protocol.shell = op.shell; protocol_data = operation_data; } in - let* validation_state, receipt = - E.Protocol.apply_operation validation_state op + let* proto_state, receipt = + validate_and_apply_operation proto_state oph op in - return (validation_state, receipt :: results))) - (validation_state, []) + return (proto_state, receipt :: results))) + (proto_state, []) operations in - E.Protocol.finalize_block validation_state (Some block_header.shell) + finalize_validation_and_application + proto_state + (Some block_header.shell) in Directory.register Directory.empty diff --git a/src/lib_protocol_environment/environment_V3.ml b/src/lib_protocol_environment/environment_V3.ml index f079a8b7f1e24ff13cf7774c33f54816898e2e1e..bf67ffb229778a0ee050080a552ccce610280227 100644 --- a/src/lib_protocol_environment/environment_V3.ml +++ b/src/lib_protocol_environment/environment_V3.ml @@ -98,6 +98,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t @@ -1053,113 +1054,141 @@ struct let*! r = f x in Lwt.return (wrap_tzresult r)) - (* - [load_predecessor_cache] ensures that the cache is correctly - loaded in memory before running any operations. - *) - let load_predecessor_cache ~chain_id ~predecessor_context - ~predecessor_timestamp ~predecessor_level ~predecessor_fitness - ~predecessor ~timestamp ~cache = + type application_state = validation_state + + type mode = + | Application of block_header + | Partial_validation of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + + (** Ensure that the cache is correctly loaded in memory + before running any operations. *) + let load_predecessor_cache predecessor_context chain_id mode + (predecessor_shell_header : Block_header.shell_header) cache = let open Lwt_result_syntax in + let predecessor, timestamp = + match mode with + | Application block_header | Partial_validation block_header -> + (block_header.shell.predecessor, block_header.shell.timestamp) + | Construction {predecessor_hash; timestamp; _} + | Partial_construction {predecessor_hash; timestamp} -> + (predecessor_hash, timestamp) + in let* value_of_key = value_of_key ~chain_id ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness + ~predecessor_timestamp:predecessor_shell_header.timestamp + ~predecessor_level:predecessor_shell_header.level + ~predecessor_fitness:predecessor_shell_header.fitness ~predecessor ~timestamp in Context.load_cache predecessor predecessor_context cache value_of_key - let begin_partial_application ~chain_id ~ancestor_context - ~(predecessor : Block_header.t) ~predecessor_hash ~cache - (raw_block : block_header) = + let begin_validation_or_application validation_or_application ctxt chain_id + mode ~(predecessor : Block_header.shell_header) ~cache = let open Lwt_result_syntax in - let* ancestor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_level:predecessor.shell.level - ~predecessor_fitness:predecessor.shell.fitness - ~predecessor:predecessor_hash - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_partial_application - ~chain_id - ~ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_fitness:predecessor.shell.fitness - raw_block + let* ctxt = load_predecessor_cache ctxt chain_id mode predecessor cache in + let*! validation_state = + match (validation_or_application, mode) with + | `Validation, Application block_header + | _, Partial_validation block_header -> + (* For the validation of an existing block, we always use the + old [begin_partial_application], even in full [Application] + mode. Indeed, this maintains the behavior of old block + [precheck] (from [lib_validation/block_validation.ml]), which + relied on [Partial_validation] mode to quickly assess the + viability of the block. *) + begin_partial_application + ~chain_id + ~ancestor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | `Application, Application block_header -> + begin_application + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | _, Construction {predecessor_hash; timestamp; block_header_data} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + ~protocol_data:block_header_data + () + | _, Partial_construction {predecessor_hash; timestamp} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + () in - Lwt.return (wrap_tzresult r) + Lwt.return (wrap_tzresult validation_state) - let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness ~cache (raw_block : block_header) = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level:(Int32.pred raw_block.shell.level) - ~predecessor_fitness - ~predecessor:raw_block.shell.predecessor - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_fitness - raw_block - in - Lwt.return (wrap_tzresult r) + let begin_validation = begin_validation_or_application `Validation - let begin_construction ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness ~predecessor ~timestamp - ?protocol_data ~cache () = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ~cache - in - let*! r = - begin_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ?protocol_data - () - in - Lwt.return (wrap_tzresult r) + let begin_application = begin_validation_or_application `Application - let apply_operation c o = + let wrap_apply_operation state operation = let open Lwt_syntax in - let+ r = apply_operation c o in - wrap_tzresult r + let+ state = apply_operation state operation in + wrap_tzresult state + + let validate_operation ?check_signature:_ state _oph operation = + let open Lwt_result_syntax in + let* state, _operation_receipt = wrap_apply_operation state operation in + return state + + let apply_operation state _oph operation = + wrap_apply_operation state operation - let finalize_block c shell_header = + let wrap_finalize_block state shell_header = let open Lwt_syntax in - let+ r = finalize_block c shell_header in - wrap_tzresult r + let+ res = finalize_block state shell_header in + wrap_tzresult res + + let finalize_validation state = + let open Lwt_result_syntax in + let dummy_shell_header = + (* A shell header is required in construction mode so that + [finalize_block] does not return an error. However, it is + only used to compute the cache nonce, which is discarded + here anyway. *) + { + Block_header.level = 0l; + proto_level = 0; + predecessor = Block_hash.zero; + timestamp = Time.epoch; + validation_passes = 0; + operations_hash = Operation_list_list_hash.zero; + fitness = []; + context = Context_hash.zero; + } + in + let* _ = wrap_finalize_block state (Some dummy_shell_header) in + return_unit + + let finalize_application = wrap_finalize_block let init _chain_id c bh = let open Lwt_syntax in @@ -1204,8 +1233,7 @@ struct | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ ~cache:_ = - Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ ~cache:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit diff --git a/src/lib_protocol_environment/environment_V3.mli b/src/lib_protocol_environment/environment_V3.mli index c67f6d016b95c2f2274f528f6fa7d236ab329335..ff4c37fbbfa55ce814abaa26f12e9526c79734d8 100644 --- a/src/lib_protocol_environment/environment_V3.mli +++ b/src/lib_protocol_environment/environment_V3.mli @@ -121,6 +121,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t diff --git a/src/lib_protocol_environment/environment_V4.ml b/src/lib_protocol_environment/environment_V4.ml index 3436a6bdeb441ef2bb991a8ff2146696fc2f8ffe..b91c03739fa92bf1bf2e3a52e67ffd46168db524 100644 --- a/src/lib_protocol_environment/environment_V4.ml +++ b/src/lib_protocol_environment/environment_V4.ml @@ -104,6 +104,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t @@ -1070,113 +1071,141 @@ struct let*! r = f x in Lwt.return (wrap_tzresult r)) - (* - [load_predecessor_cache] ensures that the cache is correctly - loaded in memory before running any operations. - *) - let load_predecessor_cache ~chain_id ~predecessor_context - ~predecessor_timestamp ~predecessor_level ~predecessor_fitness - ~predecessor ~timestamp ~cache = + type application_state = validation_state + + type mode = + | Application of block_header + | Partial_validation of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + + (** Ensure that the cache is correctly loaded in memory + before running any operations. *) + let load_predecessor_cache predecessor_context chain_id mode + (predecessor_shell_header : Block_header.shell_header) cache = let open Lwt_result_syntax in + let predecessor, timestamp = + match mode with + | Application block_header | Partial_validation block_header -> + (block_header.shell.predecessor, block_header.shell.timestamp) + | Construction {predecessor_hash; timestamp; _} + | Partial_construction {predecessor_hash; timestamp} -> + (predecessor_hash, timestamp) + in let* value_of_key = value_of_key ~chain_id ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness + ~predecessor_timestamp:predecessor_shell_header.timestamp + ~predecessor_level:predecessor_shell_header.level + ~predecessor_fitness:predecessor_shell_header.fitness ~predecessor ~timestamp in Context.load_cache predecessor predecessor_context cache value_of_key - let begin_partial_application ~chain_id ~ancestor_context - ~(predecessor : Block_header.t) ~predecessor_hash ~cache - (raw_block : block_header) = + let begin_validation_or_application validation_or_application ctxt chain_id + mode ~(predecessor : Block_header.shell_header) ~cache = let open Lwt_result_syntax in - let* ancestor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_level:predecessor.shell.level - ~predecessor_fitness:predecessor.shell.fitness - ~predecessor:predecessor_hash - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_partial_application - ~chain_id - ~ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_fitness:predecessor.shell.fitness - raw_block + let* ctxt = load_predecessor_cache ctxt chain_id mode predecessor cache in + let*! validation_state = + match (validation_or_application, mode) with + | `Validation, Application block_header + | _, Partial_validation block_header -> + (* For the validation of an existing block, we always use the + old [begin_partial_application], even in full [Application] + mode. Indeed, this maintains the behavior of old block + [precheck] (from [lib_validation/block_validation.ml]), which + relied on [Partial_validation] mode to quickly assess the + viability of the block. *) + begin_partial_application + ~chain_id + ~ancestor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | `Application, Application block_header -> + begin_application + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | _, Construction {predecessor_hash; timestamp; block_header_data} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + ~protocol_data:block_header_data + () + | _, Partial_construction {predecessor_hash; timestamp} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + () in - Lwt.return (wrap_tzresult r) + Lwt.return (wrap_tzresult validation_state) - let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness ~cache (raw_block : block_header) = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level:(Int32.pred raw_block.shell.level) - ~predecessor_fitness - ~predecessor:raw_block.shell.predecessor - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_fitness - raw_block - in - Lwt.return (wrap_tzresult r) + let begin_validation = begin_validation_or_application `Validation - let begin_construction ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness ~predecessor ~timestamp - ?protocol_data ~cache () = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ~cache - in - let*! r = - begin_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ?protocol_data - () - in - Lwt.return (wrap_tzresult r) + let begin_application = begin_validation_or_application `Application - let apply_operation c o = + let wrap_apply_operation state operation = let open Lwt_syntax in - let+ r = apply_operation c o in - wrap_tzresult r + let+ state = apply_operation state operation in + wrap_tzresult state + + let validate_operation ?check_signature:_ state _oph operation = + let open Lwt_result_syntax in + let* state, _operation_receipt = wrap_apply_operation state operation in + return state + + let apply_operation state _oph operation = + wrap_apply_operation state operation - let finalize_block c shell_header = + let wrap_finalize_block state shell_header = let open Lwt_syntax in - let+ r = finalize_block c shell_header in - wrap_tzresult r + let+ res = finalize_block state shell_header in + wrap_tzresult res + + let finalize_validation state = + let open Lwt_result_syntax in + let dummy_shell_header = + (* A shell header is required in construction mode so that + [finalize_block] does not return an error. However, it is + only used to compute the cache nonce, which is discarded + here anyway. *) + { + Block_header.level = 0l; + proto_level = 0; + predecessor = Block_hash.zero; + timestamp = Time.epoch; + validation_passes = 0; + operations_hash = Operation_list_list_hash.zero; + fitness = []; + context = Context_hash.zero; + } + in + let* _ = wrap_finalize_block state (Some dummy_shell_header) in + return_unit + + let finalize_application = wrap_finalize_block let init _chain_id c bh = let open Lwt_syntax in @@ -1221,8 +1250,7 @@ struct | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ ~cache:_ = - Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ ~cache:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit diff --git a/src/lib_protocol_environment/environment_V4.mli b/src/lib_protocol_environment/environment_V4.mli index 86bb09abed9b0dad6aa2a0b8b09ae9359b4fe778..ce50e7d43c322316d197b71bf60a5bed576b12d8 100644 --- a/src/lib_protocol_environment/environment_V4.mli +++ b/src/lib_protocol_environment/environment_V4.mli @@ -123,6 +123,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t diff --git a/src/lib_protocol_environment/environment_V5.ml b/src/lib_protocol_environment/environment_V5.ml index d5c46e84fe3d6924909f4de1df6a7ba2a4c0b740..23b56ed9f0f3a29ff637636274909249d9b025b1 100644 --- a/src/lib_protocol_environment/environment_V5.ml +++ b/src/lib_protocol_environment/environment_V5.ml @@ -111,6 +111,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t @@ -1047,113 +1048,141 @@ struct let*! r = f x in Lwt.return (wrap_tzresult r)) - (* - [load_predecessor_cache] ensures that the cache is correctly - loaded in memory before running any operations. - *) - let load_predecessor_cache ~chain_id ~predecessor_context - ~predecessor_timestamp ~predecessor_level ~predecessor_fitness - ~predecessor ~timestamp ~cache = + type application_state = validation_state + + type mode = + | Application of block_header + | Partial_validation of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + + (** Ensure that the cache is correctly loaded in memory + before running any operations. *) + let load_predecessor_cache predecessor_context chain_id mode + (predecessor_shell_header : Block_header.shell_header) cache = let open Lwt_result_syntax in + let predecessor, timestamp = + match mode with + | Application block_header | Partial_validation block_header -> + (block_header.shell.predecessor, block_header.shell.timestamp) + | Construction {predecessor_hash; timestamp; _} + | Partial_construction {predecessor_hash; timestamp} -> + (predecessor_hash, timestamp) + in let* value_of_key = value_of_key ~chain_id ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness + ~predecessor_timestamp:predecessor_shell_header.timestamp + ~predecessor_level:predecessor_shell_header.level + ~predecessor_fitness:predecessor_shell_header.fitness ~predecessor ~timestamp in Context.load_cache predecessor predecessor_context cache value_of_key - let begin_partial_application ~chain_id ~ancestor_context - ~(predecessor : Block_header.t) ~predecessor_hash ~cache - (raw_block : block_header) = + let begin_validation_or_application validation_or_application ctxt chain_id + mode ~(predecessor : Block_header.shell_header) ~cache = let open Lwt_result_syntax in - let* ancestor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_level:predecessor.shell.level - ~predecessor_fitness:predecessor.shell.fitness - ~predecessor:predecessor_hash - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_partial_application - ~chain_id - ~ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_fitness:predecessor.shell.fitness - raw_block + let* ctxt = load_predecessor_cache ctxt chain_id mode predecessor cache in + let*! validation_state = + match (validation_or_application, mode) with + | `Validation, Application block_header + | _, Partial_validation block_header -> + (* For the validation of an existing block, we always use the + old [begin_partial_application], even in full [Application] + mode. Indeed, this maintains the behavior of old block + [precheck] (from [lib_validation/block_validation.ml]), which + relied on [Partial_validation] mode to quickly assess the + viability of the block. *) + begin_partial_application + ~chain_id + ~ancestor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | `Application, Application block_header -> + begin_application + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | _, Construction {predecessor_hash; timestamp; block_header_data} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + ~protocol_data:block_header_data + () + | _, Partial_construction {predecessor_hash; timestamp} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + () in - Lwt.return (wrap_tzresult r) + Lwt.return (wrap_tzresult validation_state) - let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness ~cache (raw_block : block_header) = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level:(Int32.pred raw_block.shell.level) - ~predecessor_fitness - ~predecessor:raw_block.shell.predecessor - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_fitness - raw_block - in - Lwt.return (wrap_tzresult r) + let begin_validation = begin_validation_or_application `Validation - let begin_construction ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness ~predecessor ~timestamp - ?protocol_data ~cache () = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ~cache - in - let*! r = - begin_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ?protocol_data - () - in - Lwt.return (wrap_tzresult r) + let begin_application = begin_validation_or_application `Application - let apply_operation c o = + let wrap_apply_operation state operation = let open Lwt_syntax in - let+ r = apply_operation c o in - wrap_tzresult r + let+ state = apply_operation state operation in + wrap_tzresult state + + let validate_operation ?check_signature:_ state _oph operation = + let open Lwt_result_syntax in + let* state, _operation_receipt = wrap_apply_operation state operation in + return state + + let apply_operation state _oph operation = + wrap_apply_operation state operation - let finalize_block c shell_header = + let wrap_finalize_block state shell_header = let open Lwt_syntax in - let+ r = finalize_block c shell_header in - wrap_tzresult r + let+ res = finalize_block state shell_header in + wrap_tzresult res + + let finalize_validation state = + let open Lwt_result_syntax in + let dummy_shell_header = + (* A shell header is required in construction mode so that + [finalize_block] does not return an error. However, it is + only used to compute the cache nonce, which is discarded + here anyway. *) + { + Block_header.level = 0l; + proto_level = 0; + predecessor = Block_hash.zero; + timestamp = Time.epoch; + validation_passes = 0; + operations_hash = Operation_list_list_hash.zero; + fitness = []; + context = Context_hash.zero; + } + in + let* _ = wrap_finalize_block state (Some dummy_shell_header) in + return_unit + + let finalize_application = wrap_finalize_block let init _chain_id c bh = let open Lwt_syntax in @@ -1198,8 +1227,7 @@ struct | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ ~cache:_ = - Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ ~cache:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit diff --git a/src/lib_protocol_environment/environment_V5.mli b/src/lib_protocol_environment/environment_V5.mli index 9f6b75249fb0477aaae257b5f7900d696993145e..8df6da5fdad3462dc25d444c6e51ca019689fac4 100644 --- a/src/lib_protocol_environment/environment_V5.mli +++ b/src/lib_protocol_environment/environment_V5.mli @@ -136,6 +136,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t diff --git a/src/lib_protocol_environment/environment_V6.ml b/src/lib_protocol_environment/environment_V6.ml index 9c2e32c4cbe9c458a7c5288e6d15b8126adb64d4..57b2e79960549346f0321e13e223d8a7de6b5002 100644 --- a/src/lib_protocol_environment/environment_V6.ml +++ b/src/lib_protocol_environment/environment_V6.ml @@ -117,6 +117,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t @@ -1139,113 +1140,141 @@ struct let*! r = f x in Lwt.return (wrap_tzresult r)) - (* - [load_predecessor_cache] ensures that the cache is correctly - loaded in memory before running any operations. - *) - let load_predecessor_cache ~chain_id ~predecessor_context - ~predecessor_timestamp ~predecessor_level ~predecessor_fitness - ~predecessor ~timestamp ~cache = + type application_state = validation_state + + type mode = + | Application of block_header + | Partial_validation of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + + (** Ensure that the cache is correctly loaded in memory + before running any operations. *) + let load_predecessor_cache predecessor_context chain_id mode + (predecessor_shell_header : Block_header.shell_header) cache = let open Lwt_result_syntax in + let predecessor, timestamp = + match mode with + | Application block_header | Partial_validation block_header -> + (block_header.shell.predecessor, block_header.shell.timestamp) + | Construction {predecessor_hash; timestamp; _} + | Partial_construction {predecessor_hash; timestamp} -> + (predecessor_hash, timestamp) + in let* value_of_key = value_of_key ~chain_id ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness + ~predecessor_timestamp:predecessor_shell_header.timestamp + ~predecessor_level:predecessor_shell_header.level + ~predecessor_fitness:predecessor_shell_header.fitness ~predecessor ~timestamp in Context.load_cache predecessor predecessor_context cache value_of_key - let begin_partial_application ~chain_id ~ancestor_context - ~(predecessor : Block_header.t) ~predecessor_hash ~cache - (raw_block : block_header) = + let begin_validation_or_application validation_or_application ctxt chain_id + mode ~(predecessor : Block_header.shell_header) ~cache = let open Lwt_result_syntax in - let* ancestor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_level:predecessor.shell.level - ~predecessor_fitness:predecessor.shell.fitness - ~predecessor:predecessor_hash - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_partial_application - ~chain_id - ~ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_fitness:predecessor.shell.fitness - raw_block + let* ctxt = load_predecessor_cache ctxt chain_id mode predecessor cache in + let*! validation_state = + match (validation_or_application, mode) with + | `Validation, Application block_header + | _, Partial_validation block_header -> + (* For the validation of an existing block, we always use the + old [begin_partial_application], even in full [Application] + mode. Indeed, this maintains the behavior of old block + [precheck] (from [lib_validation/block_validation.ml]), which + relied on [Partial_validation] mode to quickly assess the + viability of the block. *) + begin_partial_application + ~chain_id + ~ancestor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | `Application, Application block_header -> + begin_application + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | _, Construction {predecessor_hash; timestamp; block_header_data} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + ~protocol_data:block_header_data + () + | _, Partial_construction {predecessor_hash; timestamp} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + () in - Lwt.return (wrap_tzresult r) + Lwt.return (wrap_tzresult validation_state) - let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness ~cache (raw_block : block_header) = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level:(Int32.pred raw_block.shell.level) - ~predecessor_fitness - ~predecessor:raw_block.shell.predecessor - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_fitness - raw_block - in - Lwt.return (wrap_tzresult r) + let begin_validation = begin_validation_or_application `Validation - let begin_construction ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness ~predecessor ~timestamp - ?protocol_data ~cache () = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ~cache - in - let*! r = - begin_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ?protocol_data - () - in - Lwt.return (wrap_tzresult r) + let begin_application = begin_validation_or_application `Application - let apply_operation c o = + let wrap_apply_operation state operation = let open Lwt_syntax in - let+ r = apply_operation c o in - wrap_tzresult r + let+ state = apply_operation state operation in + wrap_tzresult state + + let validate_operation ?check_signature:_ state _oph operation = + let open Lwt_result_syntax in + let* state, _operation_receipt = wrap_apply_operation state operation in + return state + + let apply_operation state _oph operation = + wrap_apply_operation state operation - let finalize_block c shell_header = + let wrap_finalize_block state shell_header = let open Lwt_syntax in - let+ r = finalize_block c shell_header in - wrap_tzresult r + let+ res = finalize_block state shell_header in + wrap_tzresult res + + let finalize_validation state = + let open Lwt_result_syntax in + let dummy_shell_header = + (* A shell header is required in construction mode so that + [finalize_block] does not return an error. However, it is + only used to compute the cache nonce, which is discarded + here anyway. *) + { + Block_header.level = 0l; + proto_level = 0; + predecessor = Block_hash.zero; + timestamp = Time.epoch; + validation_passes = 0; + operations_hash = Operation_list_list_hash.zero; + fitness = []; + context = Context_hash.zero; + } + in + let* _ = wrap_finalize_block state (Some dummy_shell_header) in + return_unit + + let finalize_application = wrap_finalize_block let init chain_id c bh = let open Lwt_syntax in @@ -1290,8 +1319,7 @@ struct | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ ~cache:_ = - Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ ~cache:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit diff --git a/src/lib_protocol_environment/environment_V6.mli b/src/lib_protocol_environment/environment_V6.mli index 4127a8ae429327fc450f772375346e83ce2537e9..5117b46be127023103953e07e54a46873cc6be3c 100644 --- a/src/lib_protocol_environment/environment_V6.mli +++ b/src/lib_protocol_environment/environment_V6.mli @@ -142,6 +142,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.validation_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t diff --git a/src/lib_protocol_environment/environment_V7.ml b/src/lib_protocol_environment/environment_V7.ml index 6f43324a37e89b54353880b23ad01741cadc4a62..d09bc8e95c85527c9149b71705d06fc04f79e645 100644 --- a/src/lib_protocol_environment/environment_V7.ml +++ b/src/lib_protocol_environment/environment_V7.ml @@ -120,6 +120,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.application_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t @@ -1102,113 +1103,70 @@ struct let*! r = f x in Lwt.return (wrap_tzresult r)) - (* - [load_predecessor_cache] ensures that the cache is correctly - loaded in memory before running any operations. - *) - let load_predecessor_cache ~chain_id ~predecessor_context - ~predecessor_timestamp ~predecessor_level ~predecessor_fitness - ~predecessor ~timestamp ~cache = + (** Ensure that the cache is correctly loaded in memory + before running any operations. *) + let load_predecessor_cache predecessor_context chain_id mode + (predecessor_header : Block_header.shell_header) cache = let open Lwt_result_syntax in + let predecessor_hash, timestamp = + match mode with + | Application block_header | Partial_validation block_header -> + (block_header.shell.predecessor, block_header.shell.timestamp) + | Construction {predecessor_hash; timestamp; _} + | Partial_construction {predecessor_hash; timestamp} -> + (predecessor_hash, timestamp) + in let* value_of_key = value_of_key ~chain_id ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor + ~predecessor_timestamp:predecessor_header.timestamp + ~predecessor_level:predecessor_header.level + ~predecessor_fitness:predecessor_header.fitness + ~predecessor:predecessor_hash ~timestamp in - Context.load_cache predecessor predecessor_context cache value_of_key + Context.load_cache predecessor_hash predecessor_context cache value_of_key - let begin_partial_application ~chain_id ~ancestor_context - ~(predecessor : Block_header.t) ~predecessor_hash ~cache - (raw_block : block_header) = + let begin_validation ctxt chain_id mode ~predecessor ~cache = let open Lwt_result_syntax in - let* ancestor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_level:predecessor.shell.level - ~predecessor_fitness:predecessor.shell.fitness - ~predecessor:predecessor_hash - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_partial_application - ~chain_id - ~ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_fitness:predecessor.shell.fitness - raw_block + let* ctxt = load_predecessor_cache ctxt chain_id mode predecessor cache in + let*! validation_state = + begin_validation ctxt chain_id mode ~predecessor in - Lwt.return (wrap_tzresult r) + Lwt.return (wrap_tzresult validation_state) - let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness ~cache (raw_block : block_header) = - let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level:(Int32.pred raw_block.shell.level) - ~predecessor_fitness - ~predecessor:raw_block.shell.predecessor - ~timestamp:raw_block.shell.timestamp - ~cache - in - let*! r = - begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_fitness - raw_block + let validate_operation ?check_signature validation_state oph operation = + let open Lwt_syntax in + let+ validation_state = + validate_operation ?check_signature validation_state oph operation in - Lwt.return (wrap_tzresult r) + wrap_tzresult validation_state - let begin_construction ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness ~predecessor ~timestamp - ?protocol_data ~cache () = + let finalize_validation validation_state = + let open Lwt_syntax in + let+ res = finalize_validation validation_state in + wrap_tzresult res + + let begin_application ctxt chain_id mode ~predecessor ~cache = let open Lwt_result_syntax in - let* predecessor_context = - load_predecessor_cache - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ~cache - in - let*! r = - begin_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ?protocol_data - () + let* ctxt = load_predecessor_cache ctxt chain_id mode predecessor cache in + let*! application_state = + begin_application ctxt chain_id ~predecessor mode in - Lwt.return (wrap_tzresult r) + Lwt.return (wrap_tzresult application_state) - let apply_operation c o = + let apply_operation application_state oph operation = let open Lwt_syntax in - let+ r = apply_operation c o in - wrap_tzresult r + let+ application_state = + apply_operation application_state oph operation + in + wrap_tzresult application_state - let finalize_block c shell_header = + let finalize_application state shell_header = let open Lwt_syntax in - let+ r = finalize_block c shell_header in - wrap_tzresult r + let+ res = finalize_application state shell_header in + wrap_tzresult res let init chain_id c bh = let open Lwt_syntax in @@ -1241,22 +1199,21 @@ struct Error (Validation_error (wrap_tztrace e)) | Error (Mempool.Add_conflict c) -> Error (Add_conflict c) - let init ctxt chain_id ~head_hash ~head_header ~current_timestamp ~cache = + let init ctxt chain_id ~head_hash ~head ~cache = let open Lwt_result_syntax in let* ctxt = load_predecessor_cache - ~chain_id - ~predecessor_context:ctxt - ~predecessor_timestamp:head_header.Block_header.timestamp - ~predecessor_level:head_header.Block_header.level - ~predecessor_fitness:head_header.Block_header.fitness - ~predecessor:head_hash - ~timestamp:current_timestamp - ~cache - in - let*! r = - init ctxt chain_id ~head_hash ~head_header ~current_timestamp + ctxt + chain_id + (Partial_construction + { + predecessor_hash = head_hash; + timestamp = head.Block_header.timestamp; + }) + head + cache in + let*! r = init ctxt chain_id ~head_hash ~head in Lwt.return (wrap_tzresult r) end end diff --git a/src/lib_protocol_environment/environment_V7.mli b/src/lib_protocol_environment/environment_V7.mli index 86c63b663cf660c3991b8f9440e1431e2bf4835c..c629499392e2e3920bcb84e0855279b4217bc18b 100644 --- a/src/lib_protocol_environment/environment_V7.mli +++ b/src/lib_protocol_environment/environment_V7.mli @@ -144,6 +144,7 @@ module type T = sig and type operation_receipt = P.operation_receipt and type operation = P.operation and type validation_state = P.validation_state + and type application_state = P.application_state class ['chain, 'block] proto_rpc_context : Tezos_rpc.RPC_context.t diff --git a/src/lib_protocol_environment/environment_protocol_T.ml b/src/lib_protocol_environment/environment_protocol_T.ml index 5414af7f3b9fb33b8a4c53b75399720d008e917c..f888482a8069b38591489154ee610397dd0b6c03 100644 --- a/src/lib_protocol_environment/environment_protocol_T.ml +++ b/src/lib_protocol_environment/environment_protocol_T.ml @@ -75,11 +75,93 @@ module V0toV7 and type operation = E.operation and type operation_receipt = E.operation_receipt and type validation_state = E.validation_state + and type application_state = E.validation_state and type cache_key = Context.Cache.key and type cache_value = Context.Cache.value = struct include E - let finalize_block vs _ = E.finalize_block vs + type application_state = validation_state + + type mode = + | Application of block_header + | Partial_validation of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.Protocol.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.Protocol.t; + } + + let begin_validation_or_application validation_or_application ctxt chain_id + mode ~(predecessor : Block_header.shell_header) = + match (validation_or_application, mode) with + | `Validation, Application block_header | _, Partial_validation block_header + -> + (* For the validation of an existing block, we always use the + old [begin_partial_application], even in full [Application] + mode. Indeed, this maintains the behavior of old block + [precheck] (from [lib_validation/block_validation.ml]), which + relied on [Partial_validation] mode to quickly assess the + viability of the block. *) + begin_partial_application + ~chain_id + ~ancestor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | `Application, Application block_header -> + begin_application + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_fitness:predecessor.fitness + block_header + | _, Construction {predecessor_hash; timestamp; block_header_data} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + ~protocol_data:block_header_data + () + | _, Partial_construction {predecessor_hash; timestamp} -> + begin_construction + ~chain_id + ~predecessor_context:ctxt + ~predecessor_timestamp:predecessor.timestamp + ~predecessor_level:predecessor.level + ~predecessor_fitness:predecessor.fitness + ~predecessor:predecessor_hash + ~timestamp + () + + let begin_validation = begin_validation_or_application `Validation + + let begin_application = begin_validation_or_application `Application + + let validate_operation ?check_signature:_ validation_state _oph operation = + let open Lwt_result_syntax in + let* validation_state, _operation_receipt = + apply_operation validation_state operation + in + return validation_state + + let apply_operation application_state _oph operation = + apply_operation application_state operation + + let finalize_validation validation_state = + let open Lwt_result_syntax in + let* _ = finalize_block validation_state in + return_unit + + let finalize_application application_state _shell_header = + finalize_block application_state let compare_operations (_, op) (_, op') = compare_operations op op' @@ -129,8 +211,7 @@ module V0toV7 | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ = - Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit @@ -168,41 +249,21 @@ module type PROTOCOL = sig val environment_version : Protocol.env_version - val begin_partial_application : - chain_id:Chain_id.t -> - ancestor_context:Context.t -> - predecessor:Block_header.t -> - predecessor_hash:Block_hash.t -> + val begin_validation : + Context.t -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> cache:Context.source_of_cache -> - block_header -> validation_state Error_monad.tzresult Lwt.t val begin_application : - chain_id:Chain_id.t -> - predecessor_context:Context.t -> - predecessor_timestamp:Time.Protocol.t -> - predecessor_fitness:Fitness.t -> + Context.t -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> cache:Context.source_of_cache -> - block_header -> - validation_state Error_monad.tzresult Lwt.t - - val begin_construction : - chain_id:Chain_id.t -> - predecessor_context:Context.t -> - predecessor_timestamp:Time.Protocol.t -> - predecessor_level:Int32.t -> - predecessor_fitness:Fitness.t -> - predecessor:Block_hash.t -> - timestamp:Time.Protocol.t -> - ?protocol_data:block_header_data -> - cache:Context.source_of_cache -> - unit -> - validation_state Error_monad.tzresult Lwt.t - - val finalize_block : - validation_state -> - Block_header.shell_header option -> - (validation_result * block_header_metadata) tzresult Lwt.t + application_state Error_monad.tzresult Lwt.t module Mempool : sig include module type of Mempool @@ -211,8 +272,7 @@ module type PROTOCOL = sig Context.t -> Chain_id.t -> head_hash:Block_hash.t -> - head_header:Block_header.shell_header -> - current_timestamp:Time.Protocol.t -> + head:Block_header.shell_header -> cache:Context.source_of_cache -> (validation_info * t) tzresult Lwt.t end @@ -241,45 +301,16 @@ struct let* context = Context.Cache.set_cache_layout context [] in init chain_id context header - let begin_partial_application ~chain_id ~ancestor_context - ~(predecessor : Block_header.t) ~predecessor_hash:_ ~cache:_ - (raw_block : block_header) = - begin_partial_application - ~chain_id - ~ancestor_context - ~predecessor_timestamp:predecessor.shell.timestamp - ~predecessor_fitness:predecessor.shell.fitness - raw_block - - let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness ~cache:_ raw_block = - begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_fitness - raw_block - - let begin_construction ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness ~predecessor ~timestamp - ?protocol_data ~cache:_ () = - begin_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level - ~predecessor_fitness - ~predecessor - ~timestamp - ?protocol_data - () - - let finalize_block c shell_header = P.finalize_block c shell_header + let begin_validation ctxt chain_id mode ~predecessor ~cache:_ = + begin_validation ctxt chain_id mode ~predecessor + + let begin_application ctxt chain_id mode ~predecessor ~cache:_ = + begin_application ctxt chain_id mode ~predecessor module Mempool = struct include Mempool - let init ctxt chain_id ~head_hash ~head_header ~current_timestamp ~cache:_ = - init ctxt chain_id ~head_hash ~head_header ~current_timestamp + let init ctxt chain_id ~head_hash ~head ~cache:_ = + init ctxt chain_id ~head_hash ~head end end diff --git a/src/lib_protocol_environment/environment_protocol_T_V7.ml b/src/lib_protocol_environment/environment_protocol_T_V7.ml index 36b72de4c7be219e9d92828c1330f78b4921b816..1ca58c075ef9922c0d6ea342b527927a9d616975 100644 --- a/src/lib_protocol_environment/environment_protocol_T_V7.ml +++ b/src/lib_protocol_environment/environment_protocol_T_V7.ml @@ -82,41 +82,52 @@ module type T = sig type validation_state - val begin_partial_application : - chain_id:Chain_id.t -> - ancestor_context:context -> - predecessor_timestamp:Time.Protocol.t -> - predecessor_fitness:Fitness.t -> - block_header -> + type application_state + + type mode = + | Application of block_header + | Partial_validation of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.Protocol.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.Protocol.t; + } + + val begin_validation : + context -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> validation_state tzresult Lwt.t - val begin_application : - chain_id:Chain_id.t -> - predecessor_context:context -> - predecessor_timestamp:Time.Protocol.t -> - predecessor_fitness:Fitness.t -> - block_header -> + val validate_operation : + ?check_signature:bool -> + validation_state -> + Operation_hash.t -> + operation -> validation_state tzresult Lwt.t - val begin_construction : - chain_id:Chain_id.t -> - predecessor_context:context -> - predecessor_timestamp:Time.Protocol.t -> - predecessor_level:Int32.t -> - predecessor_fitness:Fitness.t -> - predecessor:Block_hash.t -> - timestamp:Time.Protocol.t -> - ?protocol_data:block_header_data -> - unit -> - validation_state tzresult Lwt.t + val finalize_validation : validation_state -> unit tzresult Lwt.t + + val begin_application : + context -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> + application_state tzresult Lwt.t val apply_operation : - validation_state -> + application_state -> + Operation_hash.t -> operation -> - (validation_state * operation_receipt) tzresult Lwt.t + (application_state * operation_receipt) tzresult Lwt.t - val finalize_block : - validation_state -> + val finalize_application : + application_state -> Block_header.shell_header option -> (validation_result * block_header_metadata) tzresult Lwt.t @@ -175,8 +186,7 @@ module type T = sig context -> Chain_id.t -> head_hash:Block_hash.t -> - head_header:Block_header.shell_header -> - current_timestamp:Time.Protocol.t -> + head:Block_header.shell_header -> (validation_info * t) tzresult Lwt.t val encoding : t Data_encoding.t diff --git a/src/lib_protocol_environment/environment_protocol_T_test.ml b/src/lib_protocol_environment/environment_protocol_T_test.ml index 7b6c3a7abe850dc4b05b4fbd2ba8e8f78a950f60..41cb6147f7b2784c3e73865ad25a413b0f1d9f6e 100644 --- a/src/lib_protocol_environment/environment_protocol_T_test.ml +++ b/src/lib_protocol_environment/environment_protocol_T_test.ml @@ -32,9 +32,8 @@ module Mock_all_unit : with type block_header_data = unit and type operation_data = unit and type operation_receipt = unit - and type validation_state = unit = struct - type nonrec validation_state = unit - + and type validation_state = unit + and type application_state = unit = struct type block_header_data = unit type operation = { @@ -57,24 +56,36 @@ module Mock_all_unit : let init _ = assert false - let rpc_services = RPC_directory.empty + type nonrec validation_state = unit - let finalize_block _ = assert false + type nonrec application_state = unit - let apply_operation _ = assert false + type mode = + | Application of block_header + | Partial_validation of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.Protocol.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.Protocol.t; + } - let begin_construction ~chain_id:_ ~predecessor_context:_ - ~predecessor_timestamp:_ ~predecessor_level:_ ~predecessor_fitness:_ - ~predecessor:_ ~timestamp:_ ?protocol_data:_ ~cache:_ _ = - assert false + let begin_validation _ = assert false - let begin_application ~chain_id:_ ~predecessor_context:_ - ~predecessor_timestamp:_ ~predecessor_fitness:_ ~cache:_ _ = - assert false + let validate_operation ?check_signature:_ = assert false - let begin_partial_application ~chain_id:_ ~ancestor_context:_ ~predecessor:_ - ~predecessor_hash:_ ~cache:_ _ = - assert false + let finalize_validation _ = assert false + + let begin_application _ = assert false + + let apply_operation _ = assert false + + let finalize_application _ = assert false + + let rpc_services = RPC_directory.empty let compare_operations _ = assert false @@ -135,8 +146,7 @@ module Mock_all_unit : | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ ~cache:_ = - Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ ~cache:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit diff --git a/src/lib_protocol_environment/sigs/v7.ml b/src/lib_protocol_environment/sigs/v7.ml index 34fdaf29dc6218a632c4ea906d4dd580ad336d4f..23234d810470a2f10530177c72649761e521989c 100644 --- a/src/lib_protocol_environment/sigs/v7.ml +++ b/src/lib_protocol_environment/sigs/v7.ml @@ -2549,13 +2549,13 @@ val divexact: t -> t -> t external divisible: t -> t -> bool = "ml_z_divisible" (** [divisible a b] returns [true] if [a] is exactly divisible by [b]. - Unlike the other division functions, [b = 0] is accepted + Unlike the other division functions, [b = 0] is accepted (only 0 is considered divisible by 0). *) external congruent: t -> t -> t -> bool = "ml_z_congruent" (** [congruent a b c] returns [true] if [a] is congruent to [b] modulo [c]. - Unlike the other division functions, [c = 0] is accepted + Unlike the other division functions, [c = 0] is accepted (only equal numbers are considered equal congruent 0). *) @@ -2571,27 +2571,27 @@ external congruent: t -> t -> t -> bool = "ml_z_congruent" val logand: t -> t -> t (** Bitwise logical and. *) - + val logor: t -> t -> t (** Bitwise logical or. *) - + val logxor: t -> t -> t (** Bitwise logical exclusive or. *) val lognot: t -> t -(** Bitwise logical negation. +(** Bitwise logical negation. The identity [lognot a]=[-a-1] always hold. *) val shift_left: t -> int -> t -(** Shifts to the left. +(** Shifts to the left. Equivalent to a multiplication by a power of 2. The second argument must be nonnegative. *) val shift_right: t -> int -> t -(** Shifts to the right. - This is an arithmetic shift, +(** Shifts to the right. + This is an arithmetic shift, equivalent to a division by a power of 2 with rounding towards -oo. The second argument must be nonnegative. *) @@ -11090,28 +11090,28 @@ type validation_result = { (** The resulting context, it will be used for the next block. *) fitness : Fitness.t; (** The effective fitness of the block (to be compared with the one - 'announced' in the block header). *) + 'announced' in the block header). *) message : string option; (** An optional informative message, akin to a 'git commit' message, - which can be attached to the [context] when it's being commited. *) + which can be attached to the [context] when it's being commited. *) max_operations_ttl : int; (** The "time-to-live" of operations for the next block: any - operation whose 'branch' is older than 'ttl' blocks in the past - cannot be included in the next block. *) + operation whose 'branch' is older than 'ttl' blocks in the past + cannot be included in the next block. *) last_allowed_fork_level : Int32.t; (** The level of the last block for which the node might consider an - alternate branch. The shell should consider as invalid any branch - whose fork point is older (has a lower level) than the - given value. *) + alternate branch. The shell should consider as invalid any branch + whose fork point is older (has a lower level) than the + given value. *) } type quota = { max_size : int; (** The maximum size (in bytes) of the serialized list of - operations. *) + operations. *) max_op : int option; (** The maximum number of operations in a block. - [None] means no limit. *) + [None] means no limit. *) } type rpc_context = { @@ -11148,11 +11148,11 @@ module type PROTOCOL = sig } (** Economic protocol-specific side information computed by the - protocol during the validation of a block. Should not include - information about the evaluation of operations which is handled - separately by {!operation_metadata}. To be used as an execution - trace by tools (client, indexer). Not necessary for - validation. *) + protocol during the validation of a block. Should not include + information about the evaluation of operations which is handled + separately by {!operation_metadata}. To be used as an execution + trace by tools (client, indexer). Not necessary for + validation. *) type block_header_metadata (** Encoding for economic protocol-specific block metadata. *) @@ -11162,8 +11162,8 @@ module type PROTOCOL = sig type operation_data (** Economic protocol-specific side information computed by the - protocol during the validation of each operation, to be used - conjointly with {!block_header_metadata}. *) + protocol during the validation of each operation, to be used + conjointly with {!block_header_metadata}. *) type operation_receipt (** A fully parsed operation. *) @@ -11189,144 +11189,224 @@ module type PROTOCOL = sig val acceptable_pass : operation -> int option (** [compare_operations (oph1,op1) (oph2,op2)] defines a total - ordering relation on valid operations. - - The following requirements must be satisfied: [oph1] is the - [Operation.hash.p1], [oph2] is [Operation.hash op2] and that - [op1] and [op2] are valid in the same context. - - [compare_operations (oph1,op1) (oph2,op2) = 0] happens only if - [Operation_hash.compare oph1 oph2 = 0], meaning [op1 = op2] only - when [op1] and [op2] are structurally identical. - - Two operations of different validation_passes are compared in the - reverse order of their [validation_pass]: the one with the - smaller [validation_pass] is compared as being the greater. - - When belonging to the same validation_pass, two operations - comparison depends on their static parameters. An abstract weight - is computed for each operation based on its static parameters. - When two operations' weights are compared as equal, - [compare_operation (oph1,op1) (oph2,op2)] is - [Operation_hash.compare oph1 oph2]. - - [compare_operations] can be used as a [compare] component of an - {!Stdlib.Map.OrderedType}, or any such collection which relies on - a total comparison function. *) + ordering relation on valid operations. + + The following requirements must be satisfied: [oph1] is the + [Operation.hash.p1], [oph2] is [Operation.hash op2] and that + [op1] and [op2] are valid in the same context. + + [compare_operations (oph1,op1) (oph2,op2) = 0] happens only if + [Operation_hash.compare oph1 oph2 = 0], meaning [op1 = op2] only + when [op1] and [op2] are structurally identical. + + Two operations of different validation_passes are compared in the + reverse order of their [validation_pass]: the one with the + smaller [validation_pass] is compared as being the greater. + + When belonging to the same validation_pass, two operations + comparison depends on their static parameters. An abstract weight + is computed for each operation based on its static parameters. + When two operations' weights are compared as equal, + [compare_operation (oph1,op1) (oph2,op2)] is + [Operation_hash.compare oph1 oph2]. + + [compare_operations] can be used as a [compare] component of an + {!Stdlib.Map.OrderedType}, or any such collection which relies on + a total comparison function. *) val compare_operations : Operation_hash.t * operation -> Operation_hash.t * operation -> int - (** A functional state that is transmitted through the steps of a - block validation sequence: it can be created by any of the - [begin_x] functions below, and its final value is produced by - {!finalize_block}. It must retain the current state of the store, - and it can also contain additional information that must be - remembered during the validation process. Said extra content must - however be immutable: validator or baker implementations are - allowed to pause, replay or backtrack throughout validation - steps. *) + (** {2 Block (and operation) validation and application} + + The following functions may be used when an existing block is + received through the network, when a new block is created, or + when operations are considered on their own e.g. in a mempool or + during an RPC call. + + Validation aims at deciding quickly whether a block or + an operation is valid, with minimal computations and without + writing anything in the storage. A block is valid if it can be + applied without failure. An operation is valid if it can be + safely included in a block without causing it to fail. + + The application of an operation updates the {!Context.t} with + regards to its semantics (e.g. updating balances after a + transaction). The application of a block updates the context + with all its operations and some additional global + effects. Isolated operations may be applied as part of an RPC + call to simulate their effects. + + Blocks and operations must always be validated before they are + applied. Indeed, the application assumes their validity as a + precondition, meaning that the application of an invalid block + might yield incorrect results instead of failing cleanly. + + Note that in protocol versions <= K, where the validation + functions do not yet exist, the validation of existing blocks is + done by trying to apply it using the [Partial_validation] mode + below. Therefore, the application of a validated block may still + fail in these protocols. *) + + (** The mode indicates the circumstances in which a block and/or + operations are validated or applied, and contains specific + information. It must be provided as an argument to + [begin_validation] and [begin_application]. *) + type mode = + | Application of block_header + (** Standard validation or application of a preexisting block. *) + | Partial_validation of block_header + (** Partial validation of a preexisting block. This mode is + meant to quickly reject obviously invalid alternate + branches by only performing a subset of checks. + Therefore, application of blocks or operations makes no + sense in this mode: calling [begin_application] with this + mode returns an error. *) + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + (** Construction of a new block. The main difference with the + previous modes is that we cannot provide the block header to the + [begin_] functions, since the block does not exist yet. Note that + the [begin_] functions may be called in this mode without knowing + yet which operations will be included in the future block. + + The provided [block_header_data] is not expected to be the final + value of the field of the same type in the {!block_header} of the + constructed block. Instead, it should be a protocol-specific, + good enough, "prototype" of the final value. E.g. if the + {!block_header_data} type for the current economic protocol + includes a signature, then the provided [block_header_data] + should contain a fake signature (since providing a correct + signature is not possible at this stage). *) + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + (** Minimal construction of a new virtual block, with the purpose of + being able to validate/apply operations of interest. This mode may + be used by the mempool (though the [Mempool] module below is better + suited for this) or by some RPCs + e.g. [preapply/operations]. Calling the [finalize_] functions makes + no sense in this mode. *) + + (** A functional state that is transmitted throughout the validation + of a block (or during the lifetime of a mempool or RPC). It is + created by [begin_validation] below, updated by + [validate_operation], and required by [finalize_validation]. + This state is immutable thus validator or baker implementations + are allowed to pause, replay or backtrack throughout validation + steps. *) type validation_state - (** [begin_partial_application cid ctxt] checks that a block is - well-formed in a given context. This function should run quickly, - as its main use is to reject bad blocks from the chain as early - as possible. The input [ancestor_context] is expected to result - from the application of an ancestor block of the current head - with the same economic protocol. Said ancestor block is also - required to be more recent (i.e., it has a greater level), than - the current head's "last_allowed_fork_level". - - The resulting `validation_state` will be used for multi-pass - validation. *) - val begin_partial_application : - chain_id:Chain_id.t -> - ancestor_context:Context.t -> - predecessor_timestamp:Time.t -> - predecessor_fitness:Fitness.t -> - block_header -> + (** Similar to {!validation_state}, but for the application process. *) + type application_state + + (** [begin_validation predecessor_context chain_id mode + ~predecessor] initializes the {!validation_state} for the + validation process of an existing or new block. + + [predecessor_context] and [predecessor] are the resulting + context and shell header of the predecessor block. Exceptionally + in {!Partial_validation} mode, they may instead come from any + ancestor block that is more recent (i.e. has a greater level) + than the current head's "last_allowed_fork_level". + + [mode] specifies the circumstances of validation and also + carries additional information: see {!mode}. + + Note that for protocol versions <= K where [begin_validation] + does not exist yet, this calls the old [begin_application] by + necessity. However, in [Application] mode, this calls the old + [begin_application] in [Partial_validation] mode in order to run + more quickly. This preserves the behavior of [precheck] in + [lib_validation/block_validation.ml] for old protocols. It does + mean that the application of a validated block may fail in these + protocols. *) + val begin_validation : + Context.t -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> validation_state tzresult Lwt.t - (** [begin_application chain_id ... bh] defines the first step in a - block validation sequence. It initializes a validation context - for validating a block, whose header is [bh]. *) - val begin_application : - chain_id:Chain_id.t -> - predecessor_context:Context.t -> - predecessor_timestamp:Time.t -> - predecessor_fitness:Fitness.t -> - block_header -> + (** Validate an operation. If successful, return the updated + {!validation_state}. + + [check_signature] indicates whether the signature should be + checked. It defaults to [true] because the signature needs to be + correct for the operation to be valid. This argument exists for + special cases where it is acceptable to bypass this check, + e.g. if we know that the operation has already been successfully + validated in another context. *) + val validate_operation : + ?check_signature:bool -> + validation_state -> + Operation_hash.t -> + operation -> validation_state tzresult Lwt.t - (** [begin_construction] initializes a validation context for - constructing a new block, as opposed to validating an existing - block. - - This function can be used in two modes: with and without the - optional [protocol_data] argument. With the latter, it is used by - bakers to start the process for baking a new block. Without it, - is used by the Shell's prevalidator to construct a virtual block, - which carries the contents of the pre-applied operations of the - mempool. - - When [protocol_data] is provided, it is not expected to be the - final value of the field of the same name in the {!block_header} - of the block eventually being baked. Instead, it is expected to - construct a protocol-specific, good enough, "prototype" of its - final value. For instance, if the economic protocol specifies - that its block headers include a signature, [protocol_data] must - include a (faked) signature. - - Moreover, these prototypes should not be distinguishable after - the application of [begin_construction]: the function must - produce the exact same context regardless of being passed a - prototype, or an "equivalent-but-complete" header. *) - val begin_construction : - chain_id:Chain_id.t -> - predecessor_context:Context.t -> - predecessor_timestamp:Time.t -> - predecessor_level:Int32.t -> - predecessor_fitness:Fitness.t -> - predecessor:Block_hash.t -> - timestamp:Time.t -> - ?protocol_data:block_header_data -> - unit -> - validation_state tzresult Lwt.t + (** Run final and global checks on the block that must come after + the validation of all its operations to establish its + validity. *) + val finalize_validation : validation_state -> unit tzresult Lwt.t - (** [apply_operation vs op] applies the input operation [op] on top - of the given {!validation_state} [vs]. It must be called after - {!begin_application} or {!begin_construction}, and before - {!finalize_block}, for each operation in a block. On a successful - application, it returns a pair consisting of the resulting - [validation_state], and the corresponding [operation_receipt]. *) - val apply_operation : - validation_state -> - operation -> - (validation_state * operation_receipt) tzresult Lwt.t + (** Initialize the {!application_state} for the application process + of an existing or new block. See {!begin_validation} for details + on the arguments. + + In protocol versions > K, calling this function with the + {!Partial_validation} mode returns an error. *) + val begin_application : + Context.t -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> + application_state tzresult Lwt.t - (** [finalize_block vs] finalizes the context resulting from the - application of the contents of the block being validated. + (** Apply an operation. If successful, return the updated + {!application_state} and the corresponding {!operation_receipt}. - If there is no protocol migration, i.e., if the block being - applied is not the last block of the current economic protocol, the - resulting context can be used in the future as input for the - validation of its successor blocks. *) - val finalize_block : - validation_state -> + This should be called for all operations in a block, after + {!begin_application} and before + {!finalize_application}. Moreover, the operation should have + already been validated by {!validate_operation}. *) + val apply_operation : + application_state -> + Operation_hash.t -> + operation -> + (application_state * operation_receipt) tzresult Lwt.t + + (** Finalize the context resulting from the application of the + contents of the block. + + If there is no protocol migration, i.e. if the block being + applied is not the last block of the current economic protocol, + then the resulting context can be used in the future as input for + the validation and application of its successor blocks. + + In {!Construction} mode, the [Block_header.shell_header option] + argument must contain a value, which will be used to compute the + [cache_nonce]. In other modes, it can as well be [None] since it + will not be used. *) + val finalize_application : + application_state -> Block_header.shell_header option -> (validation_result * block_header_metadata) tzresult Lwt.t (** [rpc_services] provides the list of remote procedures exported - by this protocol implementation. *) + by this protocol implementation. *) val rpc_services : rpc_context RPC_directory.t (** [init chain_id ctxt hd] initializes the context, or upgrades the - context after a protocol amendment. This function receives as - arguments the [chain_id] of the current chain and the context - [ctxt] resulting from the application of the block that triggered - the amendment, as well as its header [hd]. This function should - fail if the "protocol stitching", i.e., the transition from a - valid previous protocol to the one being activated, has not been - implemented. *) + context after a protocol amendment. This function receives as + arguments the [chain_id] of the current chain and the context + [ctxt] resulting from the application of the block that triggered + the amendment, as well as its header [hd]. This function should + fail if the "protocol stitching", i.e., the transition from a + valid previous protocol to the one being activated, has not been + implemented. *) val init : Chain_id.t -> Context.t -> @@ -11334,18 +11414,18 @@ module type PROTOCOL = sig validation_result tzresult Lwt.t (** [value_of_key chain_id predecessor_context - predecessor_timestamp predecessor_level predecessor_fitness - predecessor timestamp] returns a function to build one value of - the cache from its key. - - This function is used to restore all or part of the cache, for - instance when booting a validator to preheat the cache, or when a - reorganization happens. This function should never fail, returned - errors are fatal. - - The generated function is passed to [Context.Cache.load_caches] - which will use it either immediately a cache-loading time or - on-demand, when a given cached value is accessed. *) + predecessor_timestamp predecessor_level predecessor_fitness + predecessor timestamp] returns a function to build one value of + the cache from its key. + + This function is used to restore all or part of the cache, for + instance when booting a validator to preheat the cache, or when a + reorganization happens. This function should never fail, returned + errors are fatal. + + The generated function is passed to [Context.Cache.load_caches] + which will use it either immediately a cache-loading time or + on-demand, when a given cached value is accessed. *) val value_of_key : chain_id:Chain_id.t -> predecessor_context:Context.t -> @@ -11357,7 +11437,9 @@ module type PROTOCOL = sig (Context.Cache.key -> Context.Cache.value tzresult Lwt.t) tzresult Lwt.t module Mempool : sig - (** Mempool type *) + (** Mempool type. This immutable functional state keeps track of + operations added to the mempool, and allows to detect conflicts + between them and a new candidate operation. *) type t (** Validation info type required to validate and add operations to a @@ -11431,8 +11513,7 @@ module type PROTOCOL = sig Context.t -> Chain_id.t -> head_hash:Block_hash.t -> - head_header:Block_header.shell_header -> - current_timestamp:Time.t -> + head:Block_header.shell_header -> (validation_info * t) tzresult Lwt.t (** Mempool encoding *) @@ -11490,9 +11571,9 @@ module type PROTOCOL = sig end (** [activate ctxt ph] activates an economic protocol (given by its - hash [ph]) from the context [ctxt]. The resulting context is still - a context for the current economic protocol, and the migration is - not complete until [init] in invoked. *) + hash [ph]) from the context [ctxt]. The resulting context is still + a context for the current economic protocol, and the migration is + not complete until [init] in invoked. *) val activate : Context.t -> Protocol_hash.t -> Context.t Lwt.t end # 128 "v7.in.ml" diff --git a/src/lib_protocol_environment/sigs/v7/updater.mli b/src/lib_protocol_environment/sigs/v7/updater.mli index 299685d6887dd6faeb38f810d387a1fd9c658d82..d68ad345b025a351a49e8b05b78910721054c59b 100644 --- a/src/lib_protocol_environment/sigs/v7/updater.mli +++ b/src/lib_protocol_environment/sigs/v7/updater.mli @@ -32,28 +32,28 @@ type validation_result = { (** The resulting context, it will be used for the next block. *) fitness : Fitness.t; (** The effective fitness of the block (to be compared with the one - 'announced' in the block header). *) + 'announced' in the block header). *) message : string option; (** An optional informative message, akin to a 'git commit' message, - which can be attached to the [context] when it's being commited. *) + which can be attached to the [context] when it's being commited. *) max_operations_ttl : int; (** The "time-to-live" of operations for the next block: any - operation whose 'branch' is older than 'ttl' blocks in the past - cannot be included in the next block. *) + operation whose 'branch' is older than 'ttl' blocks in the past + cannot be included in the next block. *) last_allowed_fork_level : Int32.t; (** The level of the last block for which the node might consider an - alternate branch. The shell should consider as invalid any branch - whose fork point is older (has a lower level) than the - given value. *) + alternate branch. The shell should consider as invalid any branch + whose fork point is older (has a lower level) than the + given value. *) } type quota = { max_size : int; (** The maximum size (in bytes) of the serialized list of - operations. *) + operations. *) max_op : int option; (** The maximum number of operations in a block. - [None] means no limit. *) + [None] means no limit. *) } type rpc_context = { @@ -90,11 +90,11 @@ module type PROTOCOL = sig } (** Economic protocol-specific side information computed by the - protocol during the validation of a block. Should not include - information about the evaluation of operations which is handled - separately by {!operation_metadata}. To be used as an execution - trace by tools (client, indexer). Not necessary for - validation. *) + protocol during the validation of a block. Should not include + information about the evaluation of operations which is handled + separately by {!operation_metadata}. To be used as an execution + trace by tools (client, indexer). Not necessary for + validation. *) type block_header_metadata (** Encoding for economic protocol-specific block metadata. *) @@ -104,8 +104,8 @@ module type PROTOCOL = sig type operation_data (** Economic protocol-specific side information computed by the - protocol during the validation of each operation, to be used - conjointly with {!block_header_metadata}. *) + protocol during the validation of each operation, to be used + conjointly with {!block_header_metadata}. *) type operation_receipt (** A fully parsed operation. *) @@ -131,144 +131,224 @@ module type PROTOCOL = sig val acceptable_pass : operation -> int option (** [compare_operations (oph1,op1) (oph2,op2)] defines a total - ordering relation on valid operations. - - The following requirements must be satisfied: [oph1] is the - [Operation.hash.p1], [oph2] is [Operation.hash op2] and that - [op1] and [op2] are valid in the same context. - - [compare_operations (oph1,op1) (oph2,op2) = 0] happens only if - [Operation_hash.compare oph1 oph2 = 0], meaning [op1 = op2] only - when [op1] and [op2] are structurally identical. - - Two operations of different validation_passes are compared in the - reverse order of their [validation_pass]: the one with the - smaller [validation_pass] is compared as being the greater. - - When belonging to the same validation_pass, two operations - comparison depends on their static parameters. An abstract weight - is computed for each operation based on its static parameters. - When two operations' weights are compared as equal, - [compare_operation (oph1,op1) (oph2,op2)] is - [Operation_hash.compare oph1 oph2]. - - [compare_operations] can be used as a [compare] component of an - {!Stdlib.Map.OrderedType}, or any such collection which relies on - a total comparison function. *) + ordering relation on valid operations. + + The following requirements must be satisfied: [oph1] is the + [Operation.hash.p1], [oph2] is [Operation.hash op2] and that + [op1] and [op2] are valid in the same context. + + [compare_operations (oph1,op1) (oph2,op2) = 0] happens only if + [Operation_hash.compare oph1 oph2 = 0], meaning [op1 = op2] only + when [op1] and [op2] are structurally identical. + + Two operations of different validation_passes are compared in the + reverse order of their [validation_pass]: the one with the + smaller [validation_pass] is compared as being the greater. + + When belonging to the same validation_pass, two operations + comparison depends on their static parameters. An abstract weight + is computed for each operation based on its static parameters. + When two operations' weights are compared as equal, + [compare_operation (oph1,op1) (oph2,op2)] is + [Operation_hash.compare oph1 oph2]. + + [compare_operations] can be used as a [compare] component of an + {!Stdlib.Map.OrderedType}, or any such collection which relies on + a total comparison function. *) val compare_operations : Operation_hash.t * operation -> Operation_hash.t * operation -> int - (** A functional state that is transmitted through the steps of a - block validation sequence: it can be created by any of the - [begin_x] functions below, and its final value is produced by - {!finalize_block}. It must retain the current state of the store, - and it can also contain additional information that must be - remembered during the validation process. Said extra content must - however be immutable: validator or baker implementations are - allowed to pause, replay or backtrack throughout validation - steps. *) + (** {2 Block (and operation) validation and application} + + The following functions may be used when an existing block is + received through the network, when a new block is created, or + when operations are considered on their own e.g. in a mempool or + during an RPC call. + + Validation aims at deciding quickly whether a block or + an operation is valid, with minimal computations and without + writing anything in the storage. A block is valid if it can be + applied without failure. An operation is valid if it can be + safely included in a block without causing it to fail. + + The application of an operation updates the {!Context.t} with + regards to its semantics (e.g. updating balances after a + transaction). The application of a block updates the context + with all its operations and some additional global + effects. Isolated operations may be applied as part of an RPC + call to simulate their effects. + + Blocks and operations must always be validated before they are + applied. Indeed, the application assumes their validity as a + precondition, meaning that the application of an invalid block + might yield incorrect results instead of failing cleanly. + + Note that in protocol versions <= K, where the validation + functions do not yet exist, the validation of existing blocks is + done by trying to apply it using the [Partial_validation] mode + below. Therefore, the application of a validated block may still + fail in these protocols. *) + + (** The mode indicates the circumstances in which a block and/or + operations are validated or applied, and contains specific + information. It must be provided as an argument to + [begin_validation] and [begin_application]. *) + type mode = + | Application of block_header + (** Standard validation or application of a preexisting block. *) + | Partial_validation of block_header + (** Partial validation of a preexisting block. This mode is + meant to quickly reject obviously invalid alternate + branches by only performing a subset of checks. + Therefore, application of blocks or operations makes no + sense in this mode: calling [begin_application] with this + mode returns an error. *) + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + (** Construction of a new block. The main difference with the + previous modes is that we cannot provide the block header to the + [begin_] functions, since the block does not exist yet. Note that + the [begin_] functions may be called in this mode without knowing + yet which operations will be included in the future block. + + The provided [block_header_data] is not expected to be the final + value of the field of the same type in the {!block_header} of the + constructed block. Instead, it should be a protocol-specific, + good enough, "prototype" of the final value. E.g. if the + {!block_header_data} type for the current economic protocol + includes a signature, then the provided [block_header_data] + should contain a fake signature (since providing a correct + signature is not possible at this stage). *) + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + (** Minimal construction of a new virtual block, with the purpose of + being able to validate/apply operations of interest. This mode may + be used by the mempool (though the [Mempool] module below is better + suited for this) or by some RPCs + e.g. [preapply/operations]. Calling the [finalize_] functions makes + no sense in this mode. *) + + (** A functional state that is transmitted throughout the validation + of a block (or during the lifetime of a mempool or RPC). It is + created by [begin_validation] below, updated by + [validate_operation], and required by [finalize_validation]. + This state is immutable thus validator or baker implementations + are allowed to pause, replay or backtrack throughout validation + steps. *) type validation_state - (** [begin_partial_application cid ctxt] checks that a block is - well-formed in a given context. This function should run quickly, - as its main use is to reject bad blocks from the chain as early - as possible. The input [ancestor_context] is expected to result - from the application of an ancestor block of the current head - with the same economic protocol. Said ancestor block is also - required to be more recent (i.e., it has a greater level), than - the current head's "last_allowed_fork_level". - - The resulting `validation_state` will be used for multi-pass - validation. *) - val begin_partial_application : - chain_id:Chain_id.t -> - ancestor_context:Context.t -> - predecessor_timestamp:Time.t -> - predecessor_fitness:Fitness.t -> - block_header -> + (** Similar to {!validation_state}, but for the application process. *) + type application_state + + (** [begin_validation predecessor_context chain_id mode + ~predecessor] initializes the {!validation_state} for the + validation process of an existing or new block. + + [predecessor_context] and [predecessor] are the resulting + context and shell header of the predecessor block. Exceptionally + in {!Partial_validation} mode, they may instead come from any + ancestor block that is more recent (i.e. has a greater level) + than the current head's "last_allowed_fork_level". + + [mode] specifies the circumstances of validation and also + carries additional information: see {!mode}. + + Note that for protocol versions <= K where [begin_validation] + does not exist yet, this calls the old [begin_application] by + necessity. However, in [Application] mode, this calls the old + [begin_application] in [Partial_validation] mode in order to run + more quickly. This preserves the behavior of [precheck] in + [lib_validation/block_validation.ml] for old protocols. It does + mean that the application of a validated block may fail in these + protocols. *) + val begin_validation : + Context.t -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> validation_state tzresult Lwt.t - (** [begin_application chain_id ... bh] defines the first step in a - block validation sequence. It initializes a validation context - for validating a block, whose header is [bh]. *) - val begin_application : - chain_id:Chain_id.t -> - predecessor_context:Context.t -> - predecessor_timestamp:Time.t -> - predecessor_fitness:Fitness.t -> - block_header -> + (** Validate an operation. If successful, return the updated + {!validation_state}. + + [check_signature] indicates whether the signature should be + checked. It defaults to [true] because the signature needs to be + correct for the operation to be valid. This argument exists for + special cases where it is acceptable to bypass this check, + e.g. if we know that the operation has already been successfully + validated in another context. *) + val validate_operation : + ?check_signature:bool -> + validation_state -> + Operation_hash.t -> + operation -> validation_state tzresult Lwt.t - (** [begin_construction] initializes a validation context for - constructing a new block, as opposed to validating an existing - block. - - This function can be used in two modes: with and without the - optional [protocol_data] argument. With the latter, it is used by - bakers to start the process for baking a new block. Without it, - is used by the Shell's prevalidator to construct a virtual block, - which carries the contents of the pre-applied operations of the - mempool. - - When [protocol_data] is provided, it is not expected to be the - final value of the field of the same name in the {!block_header} - of the block eventually being baked. Instead, it is expected to - construct a protocol-specific, good enough, "prototype" of its - final value. For instance, if the economic protocol specifies - that its block headers include a signature, [protocol_data] must - include a (faked) signature. - - Moreover, these prototypes should not be distinguishable after - the application of [begin_construction]: the function must - produce the exact same context regardless of being passed a - prototype, or an "equivalent-but-complete" header. *) - val begin_construction : - chain_id:Chain_id.t -> - predecessor_context:Context.t -> - predecessor_timestamp:Time.t -> - predecessor_level:Int32.t -> - predecessor_fitness:Fitness.t -> - predecessor:Block_hash.t -> - timestamp:Time.t -> - ?protocol_data:block_header_data -> - unit -> - validation_state tzresult Lwt.t + (** Run final and global checks on the block that must come after + the validation of all its operations to establish its + validity. *) + val finalize_validation : validation_state -> unit tzresult Lwt.t - (** [apply_operation vs op] applies the input operation [op] on top - of the given {!validation_state} [vs]. It must be called after - {!begin_application} or {!begin_construction}, and before - {!finalize_block}, for each operation in a block. On a successful - application, it returns a pair consisting of the resulting - [validation_state], and the corresponding [operation_receipt]. *) - val apply_operation : - validation_state -> - operation -> - (validation_state * operation_receipt) tzresult Lwt.t + (** Initialize the {!application_state} for the application process + of an existing or new block. See {!begin_validation} for details + on the arguments. - (** [finalize_block vs] finalizes the context resulting from the - application of the contents of the block being validated. + In protocol versions > K, calling this function with the + {!Partial_validation} mode returns an error. *) + val begin_application : + Context.t -> + Chain_id.t -> + mode -> + predecessor:Block_header.shell_header -> + application_state tzresult Lwt.t - If there is no protocol migration, i.e., if the block being - applied is not the last block of the current economic protocol, the - resulting context can be used in the future as input for the - validation of its successor blocks. *) - val finalize_block : - validation_state -> + (** Apply an operation. If successful, return the updated + {!application_state} and the corresponding {!operation_receipt}. + + This should be called for all operations in a block, after + {!begin_application} and before + {!finalize_application}. Moreover, the operation should have + already been validated by {!validate_operation}. *) + val apply_operation : + application_state -> + Operation_hash.t -> + operation -> + (application_state * operation_receipt) tzresult Lwt.t + + (** Finalize the context resulting from the application of the + contents of the block. + + If there is no protocol migration, i.e. if the block being + applied is not the last block of the current economic protocol, + then the resulting context can be used in the future as input for + the validation and application of its successor blocks. + + In {!Construction} mode, the [Block_header.shell_header option] + argument must contain a value, which will be used to compute the + [cache_nonce]. In other modes, it can as well be [None] since it + will not be used. *) + val finalize_application : + application_state -> Block_header.shell_header option -> (validation_result * block_header_metadata) tzresult Lwt.t (** [rpc_services] provides the list of remote procedures exported - by this protocol implementation. *) + by this protocol implementation. *) val rpc_services : rpc_context RPC_directory.t (** [init chain_id ctxt hd] initializes the context, or upgrades the - context after a protocol amendment. This function receives as - arguments the [chain_id] of the current chain and the context - [ctxt] resulting from the application of the block that triggered - the amendment, as well as its header [hd]. This function should - fail if the "protocol stitching", i.e., the transition from a - valid previous protocol to the one being activated, has not been - implemented. *) + context after a protocol amendment. This function receives as + arguments the [chain_id] of the current chain and the context + [ctxt] resulting from the application of the block that triggered + the amendment, as well as its header [hd]. This function should + fail if the "protocol stitching", i.e., the transition from a + valid previous protocol to the one being activated, has not been + implemented. *) val init : Chain_id.t -> Context.t -> @@ -276,18 +356,18 @@ module type PROTOCOL = sig validation_result tzresult Lwt.t (** [value_of_key chain_id predecessor_context - predecessor_timestamp predecessor_level predecessor_fitness - predecessor timestamp] returns a function to build one value of - the cache from its key. - - This function is used to restore all or part of the cache, for - instance when booting a validator to preheat the cache, or when a - reorganization happens. This function should never fail, returned - errors are fatal. - - The generated function is passed to [Context.Cache.load_caches] - which will use it either immediately a cache-loading time or - on-demand, when a given cached value is accessed. *) + predecessor_timestamp predecessor_level predecessor_fitness + predecessor timestamp] returns a function to build one value of + the cache from its key. + + This function is used to restore all or part of the cache, for + instance when booting a validator to preheat the cache, or when a + reorganization happens. This function should never fail, returned + errors are fatal. + + The generated function is passed to [Context.Cache.load_caches] + which will use it either immediately a cache-loading time or + on-demand, when a given cached value is accessed. *) val value_of_key : chain_id:Chain_id.t -> predecessor_context:Context.t -> @@ -299,7 +379,9 @@ module type PROTOCOL = sig (Context.Cache.key -> Context.Cache.value tzresult Lwt.t) tzresult Lwt.t module Mempool : sig - (** Mempool type *) + (** Mempool type. This immutable functional state keeps track of + operations added to the mempool, and allows to detect conflicts + between them and a new candidate operation. *) type t (** Validation info type required to validate and add operations to a @@ -373,8 +455,7 @@ module type PROTOCOL = sig Context.t -> Chain_id.t -> head_hash:Block_hash.t -> - head_header:Block_header.shell_header -> - current_timestamp:Time.t -> + head:Block_header.shell_header -> (validation_info * t) tzresult Lwt.t (** Mempool encoding *) @@ -432,7 +513,7 @@ module type PROTOCOL = sig end (** [activate ctxt ph] activates an economic protocol (given by its - hash [ph]) from the context [ctxt]. The resulting context is still - a context for the current economic protocol, and the migration is - not complete until [init] in invoked. *) + hash [ph]) from the context [ctxt]. The resulting context is still + a context for the current economic protocol, and the migration is + not complete until [init] in invoked. *) val activate : Context.t -> Protocol_hash.t -> Context.t Lwt.t diff --git a/src/lib_protocol_environment/sigs/v7/z.mli b/src/lib_protocol_environment/sigs/v7/z.mli index e04b459a7f0ea4b602d2be2a6f104924483f46cc..bc93f0cdcd0a4018f15dd4a6c783617c1acb11c8 100644 --- a/src/lib_protocol_environment/sigs/v7/z.mli +++ b/src/lib_protocol_environment/sigs/v7/z.mli @@ -185,13 +185,13 @@ val divexact: t -> t -> t external divisible: t -> t -> bool = "ml_z_divisible" (** [divisible a b] returns [true] if [a] is exactly divisible by [b]. - Unlike the other division functions, [b = 0] is accepted + Unlike the other division functions, [b = 0] is accepted (only 0 is considered divisible by 0). *) external congruent: t -> t -> t -> bool = "ml_z_congruent" (** [congruent a b c] returns [true] if [a] is congruent to [b] modulo [c]. - Unlike the other division functions, [c = 0] is accepted + Unlike the other division functions, [c = 0] is accepted (only equal numbers are considered equal congruent 0). *) @@ -207,27 +207,27 @@ external congruent: t -> t -> t -> bool = "ml_z_congruent" val logand: t -> t -> t (** Bitwise logical and. *) - + val logor: t -> t -> t (** Bitwise logical or. *) - + val logxor: t -> t -> t (** Bitwise logical exclusive or. *) val lognot: t -> t -(** Bitwise logical negation. +(** Bitwise logical negation. The identity [lognot a]=[-a-1] always hold. *) val shift_left: t -> int -> t -(** Shifts to the left. +(** Shifts to the left. Equivalent to a multiplication by a power of 2. The second argument must be nonnegative. *) val shift_right: t -> int -> t -(** Shifts to the right. - This is an arithmetic shift, +(** Shifts to the right. + This is an arithmetic shift, equivalent to a division by a power of 2 with rounding towards -oo. The second argument must be nonnegative. *) diff --git a/src/lib_shell/block_directory.ml b/src/lib_shell/block_directory.ml index eb2f7f940f1f2857bb448dfca893630bc40424d4..efc9df8367ba4f47da9261bf15b0daf5eb957fdc 100644 --- a/src/lib_shell/block_directory.ml +++ b/src/lib_shell/block_directory.ml @@ -657,29 +657,55 @@ let build_raw_rpc_directory (module Proto : Block_services.PROTO) operations) ; register0 S.Helpers.Preapply.operations (fun (chain_store, block) () ops -> let* ctxt = Store.Block.context chain_store block in - let predecessor = Store.Block.hash block in - let header = Store.Block.shell_header block in - let predecessor_context = ctxt in - let* state = - Next_proto.begin_construction - ~chain_id:(Store.Chain.chain_id chain_store) - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_level:header.level - ~predecessor_fitness:header.fitness + let chain_id = Store.Chain.chain_id chain_store in + let mode = + let predecessor_hash = Store.Block.hash block in + let timestamp = Time.System.to_protocol (Time.System.now ()) in + Next_proto.Partial_construction {predecessor_hash; timestamp} + in + let predecessor = Store.Block.shell_header block in + let* validation_state = + Next_proto.begin_validation ctxt chain_id mode ~predecessor ~cache:`Lazy + in + let* application_state = + Next_proto.begin_application + ctxt + chain_id + mode ~predecessor - ~timestamp:(Time.System.to_protocol (Time.System.now ())) ~cache:`Lazy - () in - let* _state, acc = - List.fold_left_es - (fun (state, acc) op -> - let* state, result = Next_proto.apply_operation state op in - return (state, (op.protocol_data, result) :: acc)) - (state, []) + let* hashed_ops = + List.map_es + (fun op -> + match + Data_encoding.Binary.to_bytes + Next_proto.operation_data_encoding + op.Next_proto.protocol_data + with + | Error _ -> + failwith "preapply_operations: cannot deserialize operation" + | Ok proto -> + let op_t = {Operation.shell = op.shell; proto} in + Lwt_result.return (Operation.hash op_t, op)) ops in + let* _validation_state, _application_state, acc = + List.fold_left_es + (fun (validation_state, application_state, acc) (oph, op) -> + let* validation_state = + Next_proto.validate_operation validation_state oph op + in + let* application_state, result = + Next_proto.apply_operation application_state oph op + in + return + ( validation_state, + application_state, + (op.protocol_data, result) :: acc )) + (validation_state, application_state, []) + hashed_ops + in return (List.rev acc)) ; register1 S.Helpers.complete (fun (chain_store, block) prefix () () -> let* ctxt = Store.Block.context chain_store block in diff --git a/src/lib_shell/prevalidation.ml b/src/lib_shell/prevalidation.ml index 9a06dfdcf51dd2eefeb98e4720f65c3e6d4c54a1..443b6b9b69621cc85179b3edeb05bcb8e18a1f46 100644 --- a/src/lib_shell/prevalidation.ml +++ b/src/lib_shell/prevalidation.ml @@ -78,7 +78,6 @@ module type T = sig val create : chain_store -> - ?protocol_data:Bytes.t -> predecessor:Store.Block.t -> live_operations:Operation_hash.Set.t -> timestamp:Time.Protocol.t -> @@ -131,7 +130,8 @@ module MakeAbstract type chain_store = Chain_store.chain_store type t = { - state : Proto.validation_state; + validation_state : validation_state; + application_state : Proto.application_state; applied : (protocol_operation operation * Proto.operation_receipt) list; live_operations : Operation_hash.Set.t; } @@ -172,23 +172,10 @@ module MakeAbstract count_successful_prechecks = op.count_successful_prechecks + 1; } - let create chain_store ?protocol_data ~predecessor ~live_operations ~timestamp - () = + let create chain_store ~predecessor ~live_operations ~timestamp () = (* The prevalidation module receives input from the system byt handles protocol values. It translates timestamps here. *) let open Lwt_result_syntax in - let { - Block_header.shell = - { - fitness = predecessor_fitness; - timestamp = predecessor_timestamp; - level = predecessor_level; - _; - }; - _; - } = - Store.Block.header predecessor - in let* predecessor_context = Chain_store.context chain_store predecessor in let predecessor_hash = Store.Block.hash predecessor in let*! predecessor_context = @@ -197,32 +184,26 @@ module MakeAbstract ~predecessor_hash timestamp in - let* protocol_data = - match protocol_data with - | None -> return_none - | Some protocol_data -> ( - match - Data_encoding.Binary.of_bytes_opt - Proto.block_header_data_encoding - protocol_data - with - | None -> failwith "Invalid block header" - | Some protocol_data -> return_some protocol_data) + let chain_id = Chain_store.chain_id chain_store in + let mode = Proto.Partial_construction {predecessor_hash; timestamp} in + let predecessor = (Store.Block.header predecessor).shell in + let* validation_state = + Proto.begin_validation + predecessor_context + chain_id + mode + ~predecessor + ~cache:`Lazy in - let* state = - Proto.begin_construction - ~chain_id:(Chain_store.chain_id chain_store) - ~predecessor_context - ~predecessor_timestamp - ~predecessor_fitness - ~predecessor_level - ~predecessor:predecessor_hash - ~timestamp - ?protocol_data + let* application_state = + Proto.begin_application + predecessor_context + chain_id + mode + ~predecessor ~cache:`Lazy - () in - return {state; applied = []; live_operations} + return {validation_state; application_state; applied = []; live_operations} let apply_operation pv op = let open Lwt_syntax in @@ -232,12 +213,23 @@ module MakeAbstract hence the returned error. *) Lwt.return (Outdated [Endorsement_branch_not_live]) else - let+ r = protect (fun () -> Proto.apply_operation pv.state op.protocol) in + let+ r = + protect (fun () -> + let open Lwt_result_syntax in + let* validation_state = + Proto.validate_operation pv.validation_state op.hash op.protocol + in + let* application_state, receipt = + Proto.apply_operation pv.application_state op.hash op.protocol + in + return (validation_state, application_state, receipt)) + in match r with - | Ok (state, receipt) -> ( + | Ok (validation_state, application_state, receipt) -> ( let pv = { - state; + validation_state; + application_state; applied = (op, receipt) :: pv.applied; live_operations = Operation_hash.Set.add op.hash pv.live_operations; @@ -261,9 +253,9 @@ module MakeAbstract | Temporary -> Branch_delayed trace | Outdated -> Outdated trace) - let validation_state {state; _} = state + let validation_state {validation_state; _} = validation_state - let set_validation_state t state = {t with state} + let set_validation_state t validation_state = {t with validation_state} let pp_result ppf = let open Format in diff --git a/src/lib_shell/prevalidation.mli b/src/lib_shell/prevalidation.mli index 3fc0a837337e3e1f5d9e698dbdf9aa687d0419b1..12e20f9ddaeb8282c10be23e4a2ecf764f09fef9 100644 --- a/src/lib_shell/prevalidation.mli +++ b/src/lib_shell/prevalidation.mli @@ -87,11 +87,9 @@ module type T = sig protocol_operation operation -> protocol_operation operation (** Creates a new prevalidation context w.r.t. the protocol associated with - the predecessor block. When [?protocol_data] is passed to this function, - it will be used to create the new block. *) + the predecessor block. *) val create : chain_store -> - ?protocol_data:Bytes.t -> predecessor:Store.Block.t -> live_operations:Operation_hash.Set.t -> timestamp:Time.Protocol.t -> diff --git a/src/lib_shell/prevalidator.ml b/src/lib_shell/prevalidator.ml index c53a8b1236f12c698395e76b3c5603ae5da4e0df..193a427b698f4ecb54d0fc47df033f690dafffc2 100644 --- a/src/lib_shell/prevalidator.ml +++ b/src/lib_shell/prevalidator.ml @@ -1470,7 +1470,6 @@ module Make let chain_store = Distributed_db.chain_store chain_db in Prevalidation_t.create chain_store - ?protocol_data:None ~predecessor ~live_operations ~timestamp diff --git a/src/lib_shell/test/test_prevalidation_t.ml b/src/lib_shell/test/test_prevalidation_t.ml index 95589530f4e249f4cf7dd5832e62e0c62243d1b9..19edf742676dbe79d911fe3985dc3d632a989546 100644 --- a/src/lib_shell/test/test_prevalidation_t.ml +++ b/src/lib_shell/test/test_prevalidation_t.ml @@ -34,16 +34,19 @@ module Mock_protocol : Tezos_protocol_environment.PROTOCOL with type operation_data = unit and type operation_receipt = unit - and type validation_state = unit = struct + and type validation_state = unit + and type application_state = unit = struct open Tezos_protocol_environment.Internal_for_tests include Environment_protocol_T_test.Mock_all_unit - let begin_construction ~chain_id:_ ~predecessor_context:_ - ~predecessor_timestamp:_ ~predecessor_level:_ ~predecessor_fitness:_ - ~predecessor:_ ~timestamp:_ ?protocol_data:_ ~cache:_ _ = - (* We need to override this function (so that it's not [assert false]), - because Prevalidation.create calls this function, so we need it - to work in all tests below. *) + (* We need to override these functions so that they're not [assert + false], because the tests below use [Prevalidation.create] which + calls them. *) + + let begin_validation _ctxt _chain_id _mode ~predecessor:_ ~cache:_ = + Lwt_result_syntax.return_unit + + let begin_application _ctxt _chain_id _mode ~predecessor:_ ~cache:_ = Lwt_result_syntax.return_unit end @@ -233,11 +236,12 @@ let test_apply_operation_live_operations ctxt = let (module Protocol : Tezos_protocol_environment.PROTOCOL with type operation_data = unit and type operation_receipt = unit - and type validation_state = unit) = + and type validation_state = unit + and type application_state = unit) = (module struct include Mock_protocol - let apply_operation _ _ = + let apply_operation _ _ _ = Lwt.return (if Random.State.bool rand then Ok ((), ()) else error_with "Operation doesn't apply") @@ -286,7 +290,7 @@ let test_apply_operation_applied ctxt = (module struct include Mock_protocol - let apply_operation _ _ = + let apply_operation _ _ _ = Lwt.return (if Random.State.bool rand then Ok ((), ()) else error_with "Operation doesn't apply") diff --git a/src/lib_store/unix/test/alpha_utils.ml b/src/lib_store/unix/test/alpha_utils.ml index 954a7b85cb0dfe5b51329158e08f29b699d578f4..9ca1930ca7ebd9ab56f1b08fc44f51540aa747bc 100644 --- a/src/lib_store/unix/test/alpha_utils.ml +++ b/src/lib_store/unix/test/alpha_utils.ml @@ -462,6 +462,31 @@ let nb_validation_passes = List.length Main.validation_passes let empty_operations = WithExceptions.List.init ~loc:__LOC__ nb_validation_passes (fun _ -> []) +let begin_validation_and_application ctxt chain_id mode ~predecessor = + let open Lwt_result_syntax in + let* validation_state = + Main.begin_validation ctxt chain_id mode ~predecessor + in + let* application_state = + Main.begin_application ctxt chain_id mode ~predecessor + in + return (validation_state, application_state) + +let validate_and_apply_operation (validation_state, application_state) op = + let open Lwt_result_syntax in + let oph = Operation.hash_packed op in + let* validation_state = Main.validate_operation validation_state oph op in + let* application_state, receipt = + Main.apply_operation application_state oph op + in + return ((validation_state, application_state), receipt) + +let finalize_validation_and_application (validation_state, application_state) + shell_header = + let open Lwt_result_syntax in + let* () = Main.finalize_validation validation_state in + Main.finalize_application application_state shell_header + let apply ctxt chain_id ~policy ?(operations = empty_operations) pred = let open Lwt_result_syntax in let* rpc_ctxt = make_rpc_context ~chain_id ctxt pred in @@ -519,26 +544,26 @@ let apply ctxt chain_id ~policy ?(operations = empty_operations) pred = let*! r = let open Environment.Error_monad in let* vstate = - Main.begin_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp:(Store.Block.timestamp pred) - ~predecessor_level:(Store.Block.level pred) - ~predecessor_fitness:(Store.Block.fitness pred) - ~predecessor:(Store.Block.hash pred) - ~timestamp:shell.timestamp - ~protocol_data - () + begin_validation_and_application + predecessor_context + chain_id + (Construction + { + predecessor_hash = Store.Block.hash pred; + timestamp = shell.timestamp; + block_header_data = protocol_data; + }) + ~predecessor:(Store.Block.shell_header pred) in let* vstate = List.fold_left_es (List.fold_left_es (fun vstate op -> - let* state, _result = apply_operation vstate op in + let* state, _result = validate_and_apply_operation vstate op in return state)) vstate operations in - Main.finalize_block vstate (Some shell) + finalize_validation_and_application vstate (Some shell) in let*? r = Environment.wrap_tzresult r in return r diff --git a/src/lib_validation/block_validation.ml b/src/lib_validation/block_validation.ml index 9ff2100efdb7cda59787ecbd76cd5002cf28d34f..d0b8d82e01ec08794b42b417baa79178555ac02f 100644 --- a/src/lib_validation/block_validation.ml +++ b/src/lib_validation/block_validation.ml @@ -276,7 +276,8 @@ module Make (Proto : Registered_protocol.T) = struct } type preapply_state = { - state : Proto.validation_state; + validation_state : Proto.validation_state; + application_state : Proto.application_state; applied : (Proto.operation_data preapplied_operation * Proto.operation_receipt) list; live_blocks : Block_hash.Set.t; @@ -415,7 +416,7 @@ module Make (Proto : Registered_protocol.T) = struct block_hash (Unallowed_pass {operation = op_hash; pass; allowed_pass})) in - return op)) + return (op_hash, op))) operations (* FIXME: This code is used by preapply but emitting time @@ -527,20 +528,21 @@ module Make (Proto : Registered_protocol.T) = struct (invalid_block block_hash Economic_protocol_error) (let* state = (Proto.begin_application - ~chain_id - ~predecessor_context:context - ~predecessor_timestamp:predecessor_block_header.shell.timestamp - ~predecessor_fitness:predecessor_block_header.shell.fitness - ~cache - block_header [@time.duration_lwt application_beginning]) + context + chain_id + (Application block_header) + ~predecessor:predecessor_block_header.shell + ~cache [@time.duration_lwt application_beginning]) in let* state, ops_metadata = (List.fold_left_es (fun (state, acc) ops -> let* state, ops_metadata = List.fold_left_es - (fun (state, acc) op -> - let* state, op_metadata = Proto.apply_operation state op in + (fun (state, acc) (oph, op) -> + let* state, op_metadata = + Proto.apply_operation state oph op + in return (state, op_metadata :: acc)) (state, []) ops @@ -551,7 +553,7 @@ module Make (Proto : Registered_protocol.T) = struct in let ops_metadata = List.rev ops_metadata in let* validation_result, block_data = - (Proto.finalize_block + (Proto.finalize_application state (Some block_header.shell) [@time.duration_lwt block_finalization]) in @@ -787,15 +789,24 @@ module Make (Proto : Registered_protocol.T) = struct else let+ r = protect (fun () -> - Proto.apply_operation - pv.state - {shell = op.raw.shell; protocol_data = op.protocol_data}) + let operation : Proto.operation = + {shell = op.raw.shell; protocol_data = op.protocol_data} + in + let open Lwt_result_syntax in + let* validation_state = + Proto.validate_operation pv.validation_state op.hash operation + in + let* application_state, receipt = + Proto.apply_operation pv.application_state op.hash operation + in + return (validation_state, application_state, receipt)) in match r with - | Ok (state, receipt) -> ( + | Ok (validation_state, application_state, receipt) -> ( let pv = { - state; + validation_state; + application_state; applied = (op, receipt) :: pv.applied; live_blocks = pv.live_blocks; live_operations = @@ -884,20 +895,35 @@ module Make (Proto : Registered_protocol.T) = struct Lwt_result.ok @@ Context_ops.add_predecessor_ops_metadata_hash context hash in - let* state = - Proto.begin_construction - ~chain_id - ~predecessor_context:context - ~predecessor_timestamp:predecessor_shell_header.Block_header.timestamp - ~predecessor_fitness:predecessor_shell_header.Block_header.fitness - ~predecessor_level:predecessor_shell_header.level - ~predecessor:predecessor_hash - ~timestamp - ~protocol_data + let mode = + Proto.Construction + {predecessor_hash; timestamp; block_header_data = protocol_data} + in + let* validation_state = + Proto.begin_validation + context + chain_id + mode + ~predecessor:predecessor_shell_header + ~cache + in + let* application_state = + Proto.begin_application + context + chain_id + mode + ~predecessor:predecessor_shell_header ~cache - () in - let preapply_state = {state; applied = []; live_blocks; live_operations} in + let preapply_state = + { + validation_state; + application_state; + applied = []; + live_blocks; + live_operations; + } + in let apply_operation_with_preapply_result preapp t receipts op = let open Preapply_result in let*! r = preapply_operation t op in @@ -994,8 +1020,11 @@ module Make (Proto : Registered_protocol.T) = struct fitness = []; } in + let* () = Proto.finalize_validation preapply_state.validation_state in let* validation_result, block_header_metadata = - Proto.finalize_block preapply_state.state (Some shell_header) + Proto.finalize_application + preapply_state.application_state + (Some shell_header) in let*! validation_result = may_patch_protocol @@ -1101,27 +1130,26 @@ module Make (Proto : Registered_protocol.T) = struct in let* operations = parse_operations block_hash operations in let* state = - Proto.begin_partial_application - ~chain_id - ~ancestor_context:context - ~predecessor:predecessor_block_header - ~predecessor_hash:predecessor_block_hash + Proto.begin_validation + context + chain_id + (Application block_header) + ~predecessor:predecessor_block_header.shell ~cache - block_header in let* state = List.fold_left_es (fun state ops -> List.fold_left_es - (fun state op -> - let* state, _op_metadata = Proto.apply_operation state op in + (fun state (oph, op) -> + let* state = Proto.validate_operation state oph op in return state) state ops) state operations in - let* _validation_result, _block_data = Proto.finalize_block state None in + let* () = Proto.finalize_validation state in return_unit let precheck chain_id ~(predecessor_block_header : Block_header.t) diff --git a/src/lib_validation/block_validation.mli b/src/lib_validation/block_validation.mli index 3bce57c5b38a3c0ea03f6e05c02eafc4b5eca69c..6d53db17f11fe838d7122ef5b29d3b4bf9f5c430 100644 --- a/src/lib_validation/block_validation.mli +++ b/src/lib_validation/block_validation.mli @@ -120,8 +120,8 @@ type apply_environment = { (** Default size limit for operation metadata *) val default_operation_metadata_size_limit : int option -(** [apply env header ops] gets the protocol [P] of the context of the predecessor - block and calls successively: +(** [apply env header ops] gets the protocol [P] of the context of the + predecessor block and calls successively: 1. [P.begin_application] 2. [P.apply] 3. [P.finalize_block] @@ -129,7 +129,9 @@ val default_operation_metadata_size_limit : int option If [simulate] is true, the context resulting from the application is not committed to disk using `Context.commit`, only the commit hash is computed, using `Context.hash`. Set to false by default. -*) + + Hypothesis: we assume that the given block has already been + validated -- E.g. by calling [precheck]. *) val apply : ?simulate:bool -> ?cached_result:apply_result * Tezos_protocol_environment.Context.t -> @@ -142,8 +144,10 @@ val apply : (** [precheck chain_id ~predecessor_block_header ~predecessor_block_hash ~predecessor_context ~cache header ops] gets the protocol [P] of the context of the predecessor block and - calls successively: 1. [P.begin_partial_application] 2. [P.apply] - 3. [P.finalize_block] *) + calls successively: + 1. [P.begin_validate] + 2. [P.validate_operation] + 3. [P.finalize_validation] *) val precheck : chain_id:Chain_id.t -> predecessor_block_header:Block_header.t -> @@ -175,6 +179,8 @@ val preapply : tzresult Lwt.t +(** Hypothesis: we assume that the given block has already been + validated -- E.g. by calling [precheck]. *) val recompute_metadata : chain_id:Chain_id.t -> predecessor_block_header:Block_header.t -> diff --git a/src/proto_012_Psithaca/lib_delegate/baking_simulator.ml b/src/proto_012_Psithaca/lib_delegate/baking_simulator.ml index 08fb0417b4653fe3ebb306194a0e4ad4758f250b..125ab0fbf45ce05e7811be683047509508f7d229 100644 --- a/src/proto_012_Psithaca/lib_delegate/baking_simulator.ml +++ b/src/proto_012_Psithaca/lib_delegate/baking_simulator.ml @@ -80,7 +80,7 @@ let check_context_consistency (abstract_index : Abstract_context_index.t) | true -> return_unit | false -> fail Invalid_context)) -let begin_construction ~timestamp ?protocol_data +let begin_construction ~timestamp ~protocol_data (abstract_index : Abstract_context_index.t) predecessor chain_id = protect (fun () -> let {Baking_state.shell = pred_shell; hash = pred_hash; _} = @@ -103,17 +103,17 @@ let begin_construction ~timestamp ?protocol_data Operation_list_list_hash.zero (* fake op hash *); } in - Lifted_protocol.begin_construction - ~chain_id - ~predecessor_context:context - ~predecessor_timestamp:pred_shell.timestamp - ~predecessor_fitness:pred_shell.fitness - ~predecessor_level:pred_shell.level - ~predecessor:pred_hash - ?protocol_data - ~timestamp + Lifted_protocol.begin_application + context + chain_id + (Construction + { + predecessor_hash = predecessor.hash; + timestamp; + block_header_data = protocol_data; + }) + ~predecessor:pred_shell ~cache:`Lazy - () >>=? fun state -> return {predecessor; context; state; rev_operations = []; header}) diff --git a/src/proto_012_Psithaca/lib_delegate/baking_simulator.mli b/src/proto_012_Psithaca/lib_delegate/baking_simulator.mli index 582fbd3e29221be4b706b715777a367b0038e37c..eff536a60cda98ec2235e049b112d93af96b63c6 100644 --- a/src/proto_012_Psithaca/lib_delegate/baking_simulator.mli +++ b/src/proto_012_Psithaca/lib_delegate/baking_simulator.mli @@ -43,7 +43,7 @@ val check_context_consistency : val begin_construction : timestamp:Time.Protocol.t -> - ?protocol_data:block_header_data -> + protocol_data:block_header_data -> Abstract_context_index.t -> Baking_state.block_info -> Chain_id.t -> diff --git a/src/proto_012_Psithaca/lib_delegate/test/mockup_simulator/mockup_simulator.ml b/src/proto_012_Psithaca/lib_delegate/test/mockup_simulator/mockup_simulator.ml index 3b8acb2d6e1135efe3fcd7b51877d8a028370835..289181dcb9ed3f12146a5a7b626950905a37ec8f 100644 --- a/src/proto_012_Psithaca/lib_delegate/test/mockup_simulator/mockup_simulator.ml +++ b/src/proto_012_Psithaca/lib_delegate/test/mockup_simulator/mockup_simulator.ml @@ -488,12 +488,11 @@ let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) let predecessor_context = rpc_context.context in parse_protocol_data block_header.protocol_data >>=? fun protocol_data -> Mockup.M.Protocol.begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_fitness:header.fitness + predecessor_context + chain_id + (Application {shell = block_header.shell; protocol_data}) + ~predecessor:header ~cache:`Lazy - {shell = block_header.shell; protocol_data} >>=? fun validation_state -> let i = ref 0 in List.fold_left_es @@ -507,13 +506,18 @@ let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) let op = {Mockup.M.Protocol.shell = op.shell; protocol_data = operation_data} in - Mockup.M.Protocol.apply_operation validation_state op + Mockup.M.Protocol.apply_operation + validation_state + (* The operation hash argument is ignored in protocol + environment versions < V7. *) + Operation_hash.zero + op >>=? fun (validation_state, receipt) -> return (validation_state, receipt :: results))) (validation_state, []) operations >>=? fun (validation_state, _) -> - Mockup.M.Protocol.finalize_block validation_state None + Mockup.M.Protocol.finalize_application validation_state None (** Process an incoming block. If validation succeeds: - update the current head to this new block diff --git a/src/proto_013_PtJakart/lib_delegate/baking_simulator.ml b/src/proto_013_PtJakart/lib_delegate/baking_simulator.ml index 08fb0417b4653fe3ebb306194a0e4ad4758f250b..125ab0fbf45ce05e7811be683047509508f7d229 100644 --- a/src/proto_013_PtJakart/lib_delegate/baking_simulator.ml +++ b/src/proto_013_PtJakart/lib_delegate/baking_simulator.ml @@ -80,7 +80,7 @@ let check_context_consistency (abstract_index : Abstract_context_index.t) | true -> return_unit | false -> fail Invalid_context)) -let begin_construction ~timestamp ?protocol_data +let begin_construction ~timestamp ~protocol_data (abstract_index : Abstract_context_index.t) predecessor chain_id = protect (fun () -> let {Baking_state.shell = pred_shell; hash = pred_hash; _} = @@ -103,17 +103,17 @@ let begin_construction ~timestamp ?protocol_data Operation_list_list_hash.zero (* fake op hash *); } in - Lifted_protocol.begin_construction - ~chain_id - ~predecessor_context:context - ~predecessor_timestamp:pred_shell.timestamp - ~predecessor_fitness:pred_shell.fitness - ~predecessor_level:pred_shell.level - ~predecessor:pred_hash - ?protocol_data - ~timestamp + Lifted_protocol.begin_application + context + chain_id + (Construction + { + predecessor_hash = predecessor.hash; + timestamp; + block_header_data = protocol_data; + }) + ~predecessor:pred_shell ~cache:`Lazy - () >>=? fun state -> return {predecessor; context; state; rev_operations = []; header}) diff --git a/src/proto_013_PtJakart/lib_delegate/baking_simulator.mli b/src/proto_013_PtJakart/lib_delegate/baking_simulator.mli index 582fbd3e29221be4b706b715777a367b0038e37c..eff536a60cda98ec2235e049b112d93af96b63c6 100644 --- a/src/proto_013_PtJakart/lib_delegate/baking_simulator.mli +++ b/src/proto_013_PtJakart/lib_delegate/baking_simulator.mli @@ -43,7 +43,7 @@ val check_context_consistency : val begin_construction : timestamp:Time.Protocol.t -> - ?protocol_data:block_header_data -> + protocol_data:block_header_data -> Abstract_context_index.t -> Baking_state.block_info -> Chain_id.t -> diff --git a/src/proto_013_PtJakart/lib_delegate/test/mockup_simulator/mockup_simulator.ml b/src/proto_013_PtJakart/lib_delegate/test/mockup_simulator/mockup_simulator.ml index 0af160aed4a363d0e7e9a5bffce657126e89accc..c7b89de683985e2d7b94ab09d80f88397077500a 100644 --- a/src/proto_013_PtJakart/lib_delegate/test/mockup_simulator/mockup_simulator.ml +++ b/src/proto_013_PtJakart/lib_delegate/test/mockup_simulator/mockup_simulator.ml @@ -488,12 +488,11 @@ let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) let predecessor_context = rpc_context.context in parse_protocol_data block_header.protocol_data >>=? fun protocol_data -> Mockup.M.Protocol.begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_fitness:header.fitness + predecessor_context + chain_id + (Application {shell = block_header.shell; protocol_data}) + ~predecessor:header ~cache:`Lazy - {shell = block_header.shell; protocol_data} >>=? fun validation_state -> let i = ref 0 in List.fold_left_es @@ -507,13 +506,18 @@ let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) let op = {Mockup.M.Protocol.shell = op.shell; protocol_data = operation_data} in - Mockup.M.Protocol.apply_operation validation_state op + Mockup.M.Protocol.apply_operation + validation_state + (* The operation hash argument is ignored in protocol + environment versions < V7. *) + Operation_hash.zero + op >>=? fun (validation_state, receipt) -> return (validation_state, receipt :: results))) (validation_state, []) operations >>=? fun (validation_state, _) -> - Mockup.M.Protocol.finalize_block validation_state None + Mockup.M.Protocol.finalize_application validation_state None (** Process an incoming block. If validation succeeds: - update the current head to this new block diff --git a/src/proto_014_PtKathma/lib_delegate/baking_simulator.ml b/src/proto_014_PtKathma/lib_delegate/baking_simulator.ml index 08fb0417b4653fe3ebb306194a0e4ad4758f250b..125ab0fbf45ce05e7811be683047509508f7d229 100644 --- a/src/proto_014_PtKathma/lib_delegate/baking_simulator.ml +++ b/src/proto_014_PtKathma/lib_delegate/baking_simulator.ml @@ -80,7 +80,7 @@ let check_context_consistency (abstract_index : Abstract_context_index.t) | true -> return_unit | false -> fail Invalid_context)) -let begin_construction ~timestamp ?protocol_data +let begin_construction ~timestamp ~protocol_data (abstract_index : Abstract_context_index.t) predecessor chain_id = protect (fun () -> let {Baking_state.shell = pred_shell; hash = pred_hash; _} = @@ -103,17 +103,17 @@ let begin_construction ~timestamp ?protocol_data Operation_list_list_hash.zero (* fake op hash *); } in - Lifted_protocol.begin_construction - ~chain_id - ~predecessor_context:context - ~predecessor_timestamp:pred_shell.timestamp - ~predecessor_fitness:pred_shell.fitness - ~predecessor_level:pred_shell.level - ~predecessor:pred_hash - ?protocol_data - ~timestamp + Lifted_protocol.begin_application + context + chain_id + (Construction + { + predecessor_hash = predecessor.hash; + timestamp; + block_header_data = protocol_data; + }) + ~predecessor:pred_shell ~cache:`Lazy - () >>=? fun state -> return {predecessor; context; state; rev_operations = []; header}) diff --git a/src/proto_014_PtKathma/lib_delegate/baking_simulator.mli b/src/proto_014_PtKathma/lib_delegate/baking_simulator.mli index 582fbd3e29221be4b706b715777a367b0038e37c..eff536a60cda98ec2235e049b112d93af96b63c6 100644 --- a/src/proto_014_PtKathma/lib_delegate/baking_simulator.mli +++ b/src/proto_014_PtKathma/lib_delegate/baking_simulator.mli @@ -43,7 +43,7 @@ val check_context_consistency : val begin_construction : timestamp:Time.Protocol.t -> - ?protocol_data:block_header_data -> + protocol_data:block_header_data -> Abstract_context_index.t -> Baking_state.block_info -> Chain_id.t -> diff --git a/src/proto_014_PtKathma/lib_delegate/test/mockup_simulator/mockup_simulator.ml b/src/proto_014_PtKathma/lib_delegate/test/mockup_simulator/mockup_simulator.ml index 0af160aed4a363d0e7e9a5bffce657126e89accc..c7b89de683985e2d7b94ab09d80f88397077500a 100644 --- a/src/proto_014_PtKathma/lib_delegate/test/mockup_simulator/mockup_simulator.ml +++ b/src/proto_014_PtKathma/lib_delegate/test/mockup_simulator/mockup_simulator.ml @@ -488,12 +488,11 @@ let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) let predecessor_context = rpc_context.context in parse_protocol_data block_header.protocol_data >>=? fun protocol_data -> Mockup.M.Protocol.begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_fitness:header.fitness + predecessor_context + chain_id + (Application {shell = block_header.shell; protocol_data}) + ~predecessor:header ~cache:`Lazy - {shell = block_header.shell; protocol_data} >>=? fun validation_state -> let i = ref 0 in List.fold_left_es @@ -507,13 +506,18 @@ let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) let op = {Mockup.M.Protocol.shell = op.shell; protocol_data = operation_data} in - Mockup.M.Protocol.apply_operation validation_state op + Mockup.M.Protocol.apply_operation + validation_state + (* The operation hash argument is ignored in protocol + environment versions < V7. *) + Operation_hash.zero + op >>=? fun (validation_state, receipt) -> return (validation_state, receipt :: results))) (validation_state, []) operations >>=? fun (validation_state, _) -> - Mockup.M.Protocol.finalize_block validation_state None + Mockup.M.Protocol.finalize_application validation_state None (** Process an incoming block. If validation succeeds: - update the current head to this new block diff --git a/src/proto_alpha/lib_benchmarks_proto/sc_rollup_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/sc_rollup_benchmarks.ml index 90c24f32cdeb5ddbbb9dc479dee113966685ce7d..30cdec2015a6e0bfbf8175dc993896543fee59da 100644 --- a/src/proto_alpha/lib_benchmarks_proto/sc_rollup_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/sc_rollup_benchmarks.ml @@ -206,8 +206,7 @@ module Sc_rollup_add_external_messages_benchmark = struct let open Lwt_result_syntax in let* block, _ = Context.init1 () in let+ b = Incremental.begin_construction block in - let state = Incremental.validation_state b in - let ctxt = state.application_state.ctxt in + let ctxt = Incremental.alpha_ctxt b in (* Necessary to originate rollups. *) let ctxt = Alpha_context.Origination_nonce.init ctxt Operation_hash.zero diff --git a/src/proto_alpha/lib_delegate/baking_simulator.ml b/src/proto_alpha/lib_delegate/baking_simulator.ml index 08fb0417b4653fe3ebb306194a0e4ad4758f250b..957768d1b412cecb857d1ed8198d34a5ac496cf4 100644 --- a/src/proto_alpha/lib_delegate/baking_simulator.ml +++ b/src/proto_alpha/lib_delegate/baking_simulator.ml @@ -31,10 +31,6 @@ type error += Failed_to_checkout_context type error += Invalid_context -let wrap_error_lwt x = x >>= fun x -> Lwt.return @@ Environment.wrap_tzresult x - -let ( >>=?? ) x k = wrap_error_lwt x >>=? k - let () = register_error_kind `Permanent @@ -58,7 +54,7 @@ let () = type incremental = { predecessor : Baking_state.block_info; context : Tezos_protocol_environment.Context.t; - state : Protocol.validation_state; + state : Protocol.validation_state * Protocol.application_state; rev_operations : Operation.packed list; header : Tezos_base.Block_header.shell_header; } @@ -80,7 +76,7 @@ let check_context_consistency (abstract_index : Abstract_context_index.t) | true -> return_unit | false -> fail Invalid_context)) -let begin_construction ~timestamp ?protocol_data +let begin_construction ~timestamp ~protocol_data (abstract_index : Abstract_context_index.t) predecessor chain_id = protect (fun () -> let {Baking_state.shell = pred_shell; hash = pred_hash; _} = @@ -103,25 +99,55 @@ let begin_construction ~timestamp ?protocol_data Operation_list_list_hash.zero (* fake op hash *); } in - Lifted_protocol.begin_construction - ~chain_id - ~predecessor_context:context - ~predecessor_timestamp:pred_shell.timestamp - ~predecessor_fitness:pred_shell.fitness - ~predecessor_level:pred_shell.level - ~predecessor:pred_hash - ?protocol_data - ~timestamp + let mode = + Lifted_protocol.Construction + { + predecessor_hash = predecessor.hash; + timestamp; + block_header_data = protocol_data; + } + in + Lifted_protocol.begin_validation + context + chain_id + mode + ~predecessor:pred_shell ~cache:`Lazy - () - >>=? fun state -> + >>=? fun validation_state -> + Lifted_protocol.begin_application + context + chain_id + mode + ~predecessor:pred_shell + ~cache:`Lazy + >>=? fun application_state -> + let state = (validation_state, application_state) in return {predecessor; context; state; rev_operations = []; header}) +let ( let** ) x k = + let open Lwt_result_syntax in + let*! x = x in + let*? x = Environment.wrap_tzresult x in + k x + let add_operation st (op : Operation.packed) = protect (fun () -> - Protocol.apply_operation st.state op >>=?? fun (state, receipt) -> + let validation_state, application_state = st.state in + let oph = Operation.hash_packed op in + let** validation_state = + Protocol.validate_operation validation_state oph op + in + let** application_state, receipt = + Protocol.apply_operation application_state oph op + in + let state = (validation_state, application_state) in return ({st with state; rev_operations = op :: st.rev_operations}, receipt)) let finalize_construction inc = protect (fun () -> - Protocol.finalize_block inc.state (Some inc.header) >>=?? return) + let validation_state, application_state = inc.state in + let** () = Protocol.finalize_validation validation_state in + let** result = + Protocol.finalize_application application_state (Some inc.header) + in + return result) diff --git a/src/proto_alpha/lib_delegate/baking_simulator.mli b/src/proto_alpha/lib_delegate/baking_simulator.mli index 582fbd3e29221be4b706b715777a367b0038e37c..0d0c7ac9f4d2fee3a7036c81a7ea04ba7a581ca5 100644 --- a/src/proto_alpha/lib_delegate/baking_simulator.mli +++ b/src/proto_alpha/lib_delegate/baking_simulator.mli @@ -29,7 +29,7 @@ open Alpha_context type incremental = { predecessor : Baking_state.block_info; context : Tezos_protocol_environment.Context.t; - state : validation_state; + state : validation_state * application_state; rev_operations : Operation.packed list; header : Tezos_base.Block_header.shell_header; } @@ -43,7 +43,7 @@ val check_context_consistency : val begin_construction : timestamp:Time.Protocol.t -> - ?protocol_data:block_header_data -> + protocol_data:block_header_data -> Abstract_context_index.t -> Baking_state.block_info -> Chain_id.t -> diff --git a/src/proto_alpha/lib_delegate/test/mockup_simulator/mockup_simulator.ml b/src/proto_alpha/lib_delegate/test/mockup_simulator/mockup_simulator.ml index 48ba5170d77f5208a054d2c7f43c23182f6bc1cf..ca26b7547a25be9e0eed13dcd7e9b175ebf20388 100644 --- a/src/proto_alpha/lib_delegate/test/mockup_simulator/mockup_simulator.ml +++ b/src/proto_alpha/lib_delegate/test/mockup_simulator/mockup_simulator.ml @@ -481,24 +481,50 @@ let clear_mempool state = state.mempool <- mempool ; return_unit +let begin_validation_and_application ctxt chain_id mode ~predecessor ~cache = + let open Lwt_result_syntax in + let* validation_state = + Mockup.M.Protocol.begin_validation ctxt chain_id mode ~predecessor ~cache + in + let* application_state = + Mockup.M.Protocol.begin_application ctxt chain_id mode ~predecessor ~cache + in + return (validation_state, application_state) + +let validate_and_apply_operation (validation_state, application_state) oph op = + let open Lwt_result_syntax in + let* validation_state = + Mockup.M.Protocol.validate_operation validation_state oph op + in + let* application_state, receipt = + Mockup.M.Protocol.apply_operation application_state oph op + in + return ((validation_state, application_state), receipt) + +let finalize_validation_and_application (validation_state, application_state) + shell_header = + let open Lwt_result_syntax in + let* () = Mockup.M.Protocol.finalize_validation validation_state in + Mockup.M.Protocol.finalize_application application_state shell_header + (** Apply a block to the given [rpc_context]. *) let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) (operations : Operation.t list list) (block_header : Block_header.t) = - let header = rpc_context.block_header in + let predecessor = rpc_context.block_header in let predecessor_context = rpc_context.context in parse_protocol_data block_header.protocol_data >>=? fun protocol_data -> - Mockup.M.Protocol.begin_application - ~chain_id - ~predecessor_context - ~predecessor_timestamp:header.timestamp - ~predecessor_fitness:header.fitness + begin_validation_and_application + predecessor_context + chain_id + (Application {shell = block_header.shell; protocol_data}) + ~predecessor ~cache:`Lazy - {shell = block_header.shell; protocol_data} - >>=? fun validation_state -> + >>=? fun state -> let i = ref 0 in List.fold_left_es - (List.fold_left_es (fun (validation_state, results) op -> + (List.fold_left_es (fun (state, results) op -> incr i ; + let oph = Operation.hash op in let operation_data = Data_encoding.Binary.of_bytes_exn Mockup.M.Protocol.operation_data_encoding @@ -507,13 +533,11 @@ let reconstruct_context (rpc_context : Tezos_protocol_environment.rpc_context) let op = {Mockup.M.Protocol.shell = op.shell; protocol_data = operation_data} in - Mockup.M.Protocol.apply_operation validation_state op - >>=? fun (validation_state, receipt) -> - return (validation_state, receipt :: results))) - (validation_state, []) + validate_and_apply_operation state oph op >>=? fun (state, receipt) -> + return (state, receipt :: results))) + (state, []) operations - >>=? fun (validation_state, _) -> - Mockup.M.Protocol.finalize_block validation_state None + >>=? fun (state, _) -> finalize_validation_and_application state None (** Process an incoming block. If validation succeeds: - update the current head to this new block diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 440c7215fdf870b9dbd0c092236480b453b0c14e..38ef501df1de01979e16ddee031d220d920fc3bb 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -852,21 +852,15 @@ module Scripts = struct let oph = Operation.hash_packed packed_operation in let validity_state = Validate.begin_no_predecessor_info context chain_id in Validate.validate_operation + ~check_signature:false validity_state - ~should_check_signature:false oph packed_operation >>=? fun _validate_operation_state -> Raw_level.of_int32 block_header.level >>?= fun predecessor_level -> - Alpha_context.Fitness.round_from_raw block_header.fitness - >>?= fun predecessor_round -> let application_mode = Apply.Partial_construction - { - predecessor_level; - predecessor_round; - predecessor_fitness = block_header.fitness; - } + {predecessor_level; predecessor_fitness = block_header.fitness} in let application_state = Apply. diff --git a/src/proto_alpha/lib_plugin/mempool.ml b/src/proto_alpha/lib_plugin/mempool.ml index 74c6c924cd38efc701dae4418a3b16f928fbc586..369082de7e34612687a195afc57717c51cc280b4 100644 --- a/src/proto_alpha/lib_plugin/mempool.ml +++ b/src/proto_alpha/lib_plugin/mempool.ml @@ -208,9 +208,18 @@ module ManagerOpWeightSet = Set.Make (struct let compare = compare_manager_op_weight end) +(** Static information to store in the filter state. *) +type state_info = { + grandparent_level_start : Timestamp.t; + round_zero_duration : Period.t; + proposal_round : Round.t; + alpha_ctxt : Alpha_context.t; + (** Protocol context at the initialization of the mempool filter. + Note that it never gets updated. *) +} + type state = { - grandparent_level_start : Timestamp.t option; - round_zero_duration : Period.t option; + state_info : state_info option; prechecked_manager_op_count : int; (** Number of prechecked manager operations. Invariants: @@ -231,8 +240,7 @@ type state = { let empty : state = { - grandparent_level_start = None; - round_zero_duration = None; + state_info = None; prechecked_manager_op_count = 0; prechecked_manager_ops = Operation_hash.Map.empty; prechecked_op_weights = ManagerOpWeightSet.empty; @@ -243,7 +251,8 @@ let init config ?(validation_state : validation_state option) ~predecessor () = ignore config ; (match validation_state with | None -> return empty - | Some {application_state = {ctxt; _}; _} -> + | Some validation_state -> + let ctxt = Validate.get_initial_ctxt validation_state in let { Tezos_base.Block_header.fitness = predecessor_fitness; timestamp = predecessor_timestamp; @@ -267,13 +276,16 @@ let init config ?(validation_state : validation_state option) ~predecessor () = >>?= fun proposal_round_offset -> Period.(add proposal_level_offset proposal_round_offset) >>?= fun proposal_offset -> - return + let state_info = { - empty with grandparent_level_start = - Some Timestamp.(predecessor_timestamp - proposal_offset); - round_zero_duration = Some round_zero_duration; - }) + Timestamp.(predecessor_timestamp - proposal_offset); + round_zero_duration; + proposal_round = predecessor_round; + alpha_ctxt = ctxt; + } + in + return {empty with state_info = Some state_info}) >|= Environment.wrap_tzresult let manager_prio p = `Low p @@ -448,7 +460,8 @@ let size_of_operation op = let weight_and_resources_manager_operation ~validation_state ?size ~fee ~gas op = let hard_gas_limit_per_block = - Constants.hard_gas_limit_per_block validation_state.application_state.ctxt + Constants.hard_gas_limit_per_block + (Validate.get_initial_ctxt validation_state) in let max_size = managers_quota.max_size in let size = match size with None -> size_of_operation op | Some s -> s in @@ -757,50 +770,37 @@ let acceptable_op ~config ~round_durations ~round_zero_duration ~proposal_level acceptable *) acceptable ~drift ~op_earliest_ts ~now_timestamp -let pre_filter_far_future_consensus_ops config - ~filter_state:({grandparent_level_start; round_zero_duration; _} : state) - ?validation_state_before +let pre_filter_far_future_consensus_ops config ~filter_state ({level = op_level; round = op_round; _} : consensus_content) : bool Lwt.t = - match - (grandparent_level_start, validation_state_before, round_zero_duration) - with - | None, _, _ | _, None, _ | _, _, None -> Lwt.return_true - | ( Some grandparent_level_start, - Some validation_state_before, - Some round_zero_duration ) -> ( - let ctxt : t = validation_state_before.application_state.ctxt in - match validation_state_before.application_state.mode with - | Application _ | Partial_application _ | Full_construction _ -> - assert false - (* Prefilter is always applied in mempool mode aka Partial_construction *) - | Partial_construction {predecessor_round = proposal_round; _} -> ( - (let proposal_timestamp = Alpha_context.Timestamp.predecessor ctxt in - let now_timestamp = Time.System.now () |> Time.System.to_protocol in - let Level.{level; _} = Alpha_context.Level.current ctxt in - let proposal_level = - match Raw_level.pred level with - | None -> - (* mempool level is set to the successor of the - current head *) - assert false - | Some proposal_level -> proposal_level - in - let round_durations = Alpha_context.Constants.round_durations ctxt in - Lwt.return - @@ acceptable_op - ~config - ~round_durations - ~round_zero_duration - ~proposal_level - ~proposal_round - ~proposal_timestamp - ~proposal_predecessor_level_start:grandparent_level_start - ~op_level - ~op_round - ~now_timestamp) - >>= function - | Ok b -> Lwt.return b - | _ -> Lwt.return_false)) + match filter_state.state_info with + | None -> Lwt.return_true + | Some state_info -> ( + (let proposal_timestamp = Timestamp.predecessor state_info.alpha_ctxt in + let now_timestamp = Time.System.now () |> Time.System.to_protocol in + let Level.{level; _} = Level.current state_info.alpha_ctxt in + let proposal_level = + match Raw_level.pred level with + | None -> + (* mempool level is set to the successor of the current head *) + assert false + | Some proposal_level -> proposal_level + in + let round_durations = Constants.round_durations state_info.alpha_ctxt in + Lwt.return + @@ acceptable_op + ~config + ~round_durations + ~round_zero_duration:state_info.round_zero_duration + ~proposal_level + ~proposal_round:state_info.proposal_round + ~proposal_timestamp + ~proposal_predecessor_level_start:state_info.grandparent_level_start + ~op_level + ~op_round + ~now_timestamp) + >>= function + | Ok b -> Lwt.return b + | _ -> Lwt.return_false) (** A quasi infinite amount of "valid" (pre)endorsements could be sent by a committee member, one for each possible round number. @@ -835,11 +835,7 @@ let pre_filter config ~(filter_state : state) ?validation_state_before Lwt.return (`Refused [Environment.wrap_tzerror Wrong_operation]) | Single (Preendorsement consensus_content) | Single (Endorsement consensus_content) -> - pre_filter_far_future_consensus_ops - ~filter_state - config - ?validation_state_before - consensus_content + pre_filter_far_future_consensus_ops ~filter_state config consensus_content >>= fun keep -> if keep then Lwt.return @@ `Passed_prefilter consensus_prio else @@ -877,13 +873,13 @@ let proto_validate_operation validation_state oph ~nb_successful_prechecks let open Lwt_result_syntax in let*! res = Validate.validate_operation - validation_state.validity_state - ~should_check_signature:(nb_successful_prechecks <= 0) + ~check_signature:(nb_successful_prechecks <= 0) + validation_state oph operation in match res with - | Ok validity_state -> return {validation_state with validity_state} + | Ok validation_state -> return validation_state | Error tztrace -> let err = Environment.wrap_tztrace tztrace in let error_classification = @@ -944,10 +940,9 @@ let proto_validate_manager_operation validation_state oph (** Remove a manager operation from the protocol's [validation_state]. *) let remove_from_validation_state validation_state (Manager_op op) = let operation_state = - Validate.remove_operation validation_state.validity_state.operation_state op + Validate.remove_operation validation_state.Validate.operation_state op in - let validity_state = {validation_state.validity_state with operation_state} in - {validation_state with validity_state} + {validation_state with operation_state} (** Call the protocol validation on a manager operation and handle potential conflicts: if either the 1M restriction is triggered or @@ -1367,11 +1362,14 @@ let rec post_filter_manager : | `Refused _ as errs -> errs) let post_filter config ~(filter_state : state) ~validation_state_before:_ - ~validation_state_after: - ({application_state = {ctxt; _}; _} : validation_state) (_op, receipt) = + ~validation_state_after (_op, receipt) = match receipt with | No_operation_metadata -> assert false (* only for multipass validator *) | Operation_metadata {contents} -> ( + let handle_manager result = + let ctxt = Validate.get_initial_ctxt validation_state_after in + Lwt.return (post_filter_manager ctxt filter_state result config) + in match contents with | Single_result (Preendorsement_result _) | Single_result (Endorsement_result _) @@ -1387,6 +1385,6 @@ let post_filter config ~(filter_state : state) ~validation_state_before:_ | Single_result Ballot_result -> Lwt.return (`Passed_postfilter filter_state) | Single_result (Manager_operation_result _) as result -> - Lwt.return (post_filter_manager ctxt filter_state result config) + handle_manager result | Cons_result (Manager_operation_result _, _) as result -> - Lwt.return (post_filter_manager ctxt filter_state result config)) + handle_manager result) diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 1b9527b40b129011f9ec44fe9d2775fa92e649b9..5091a026a19fd7b7c26d090894a829727db05ff3 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1958,14 +1958,6 @@ type mode = predecessor_level : Level.t; predecessor_round : Round.t; } - | Partial_application of { - block_header : Block_header.t; - fitness : Fitness.t; - payload_producer : Consensus_key.t; - block_producer : Consensus_key.t; - predecessor_level : Level.t; - predecessor_round : Round.t; - } | Full_construction of { predecessor : Block_hash.t; payload_producer : Consensus_key.t; @@ -1977,7 +1969,6 @@ type mode = } | Partial_construction of { predecessor_level : Raw_level.t; - predecessor_round : Round.t; predecessor_fitness : Fitness.raw; } @@ -2015,7 +2006,7 @@ let record_preendorsement ctxt (mode : mode) (content : consensus_content) : match Consensus.get_preendorsements_quorum_round ctxt with | None -> Consensus.set_preendorsements_quorum_round ctxt content.round | Some _ -> ctxt) - | Partial_application _ | Application _ | Partial_construction _ -> ctxt + | Application _ | Partial_construction _ -> ctxt in match Slot.Map.find content.slot (Consensus.allowed_preendorsements ctxt) with | None -> @@ -2175,7 +2166,7 @@ let apply_contents_list (type kind) ctxt chain_id (mode : mode) let mempool_mode = match mode with | Partial_construction _ -> true - | Full_construction _ | Application _ | Partial_application _ -> false + | Full_construction _ | Application _ -> false in match contents_list with | Single (Preendorsement consensus_content) -> @@ -2300,20 +2291,6 @@ let apply_operation application_state operation_hash operation = Operation_metadata {contents = result} ) in match application_state.mode with - | Partial_application {payload_producer; _} -> ( - match Operation.acceptable_pass operation with - | None -> - (* Only occurs with Failing_noop *) - fail Validate_errors.Failing_noop_error - | Some n -> - if - (* Multipass validation only considers operations in - consensus pass. *) - Compare.Int.(n = Operation_repr.consensus_pass) - then apply_operation application_state operation ~payload_producer - else - let op_count = application_state.op_count + 1 in - return ({application_state with op_count}, No_operation_metadata)) | Application {payload_producer; _} -> apply_operation application_state operation ~payload_producer | Full_construction {payload_producer; _} -> @@ -2572,59 +2549,6 @@ let begin_application ctxt chain_id ~migration_balance_updates @ liquidity_baking_operations_results; } -let begin_partial_application ~ancestor_context chain_id - ~migration_balance_updates ~migration_operation_results - ~(predecessor_fitness : Fitness.raw) (block_header : Block_header.t) = - let open Lwt_tzresult_syntax in - let*? fitness = Fitness.from_raw block_header.shell.fitness in - let level = block_header.shell.level in - let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in - let*? predecessor_level = Raw_level.of_int32 (Int32.pred level) in - let predecessor_level = Level.(from_raw ancestor_context predecessor_level) in - (* Note: we don't have access to the predecessor context. *) - let round = Fitness.round fitness in - let current_level = Level.current ancestor_context in - let* ctxt, _slot, block_producer = - Stake_distribution.baking_rights_owner ancestor_context current_level ~round - in - let* ctxt, _slot, payload_producer = - Stake_distribution.baking_rights_owner - ctxt - current_level - ~round:block_header.protocol_data.contents.payload_round - in - let toggle_vote = - block_header.Block_header.protocol_data.contents - .liquidity_baking_toggle_vote - in - let* ctxt, liquidity_baking_operations_results, liquidity_baking_toggle_ema = - apply_liquidity_baking_subsidy ctxt ~toggle_vote - in - let mode = - Partial_application - { - block_header; - fitness; - predecessor_level; - predecessor_round; - payload_producer = Consensus_key.pkh payload_producer; - block_producer = Consensus_key.pkh block_producer; - } - in - return - { - mode; - chain_id; - ctxt; - op_count = 0; - migration_balance_updates; - liquidity_baking_toggle_ema; - implicit_operations_results = - Apply_results.pack_migration_operation_results - migration_operation_results - @ liquidity_baking_operations_results; - } - let begin_full_construction ctxt chain_id ~migration_balance_updates ~migration_operation_results ~predecessor_timestamp ~predecessor_level ~predecessor_round ~predecessor ~timestamp @@ -2684,15 +2608,11 @@ let begin_partial_construction ctxt chain_id ~migration_balance_updates ~migration_operation_results ~predecessor_level ~(predecessor_fitness : Fitness.raw) : application_state tzresult Lwt.t = let open Lwt_tzresult_syntax in - let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in let toggle_vote = Liquidity_baking.LB_pass in let* ctxt, liquidity_baking_operations_results, liquidity_baking_toggle_ema = apply_liquidity_baking_subsidy ctxt ~toggle_vote in - let mode = - Partial_construction - {predecessor_level; predecessor_round; predecessor_fitness} - in + let mode = Partial_construction {predecessor_level; predecessor_fitness} in return { mode; @@ -2953,25 +2873,5 @@ let finalize_block (application_state : application_state) shell_header_opt = finalize_with_commit_message ctxt ~cache_nonce fitness round op_count in return (result, receipt) - | Partial_application {payload_producer; block_producer; fitness; _} -> - let* voting_period_info = Voting_period.get_rpc_current_info ctxt in - let level_info = Level.current ctxt in - let ctxt = finalize ctxt (Fitness.to_raw fitness) in - return - ( ctxt, - Apply_results. - { - proposer = payload_producer; - baker = block_producer; - level_info; - voting_period_info; - nonce_hash = None; - consumed_gas = Gas.Arith.zero; - deactivated = []; - balance_updates = migration_balance_updates; - liquidity_baking_toggle_ema; - implicit_operations_results; - dal_slot_availability = None; - } ) let value_of_key ctxt k = Cache.Admin.value_of_key ctxt k diff --git a/src/proto_alpha/lib_protocol/apply.mli b/src/proto_alpha/lib_protocol/apply.mli index 56433919ddd32626354bf7c6086a2cfd1c9fa621..3b5094d2b19ef9d8fdb20aebbd779d00b6bd9031 100644 --- a/src/proto_alpha/lib_protocol/apply.mli +++ b/src/proto_alpha/lib_protocol/apply.mli @@ -52,14 +52,6 @@ type mode = predecessor_level : Level.t; predecessor_round : Round.t; } - | Partial_application of { - block_header : Block_header.t; - fitness : Fitness.t; - payload_producer : Consensus_key.t; - block_producer : Consensus_key.t; - predecessor_level : Level.t; - predecessor_round : Round.t; - } | Full_construction of { predecessor : Block_hash.t; payload_producer : Consensus_key.t; @@ -71,7 +63,6 @@ type mode = } | Partial_construction of { predecessor_level : Raw_level.t; - predecessor_round : Round.t; predecessor_fitness : Fitness.raw; } (** This mode is mainly intended to be used by a mempool. *) @@ -97,21 +88,6 @@ val begin_application : Block_header.t -> application_state tzresult Lwt.t -(** Initialize an {!application_state} for the partial application of - an existing block. In this mode, an old [ancestor_context] can - provided. This [ancestor_context] must be above the - [last_allowed_fork_level] of the chain so that consensus - operations may be validated. In this mode, only consensus - operations will be applied. *) -val begin_partial_application : - ancestor_context:context -> - Chain_id.t -> - migration_balance_updates:Receipt.balance_updates -> - migration_operation_results:Migration.origination_result list -> - predecessor_fitness:Fitness.raw -> - Block_header.t -> - application_state tzresult Lwt.t - (** Initialize an {!application_state} for the construction of a fresh block. *) val begin_full_construction : diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml index 2f0c42c1788bc2951ae36314383487b52638c561..8ac765436a6b033cf55119f7169bc6c079b3626a 100644 --- a/src/proto_alpha/lib_protocol/main.ml +++ b/src/proto_alpha/lib_protocol/main.ml @@ -90,17 +90,13 @@ let rpc_services = Alpha_services.register () ; Services_registration.get_rpc_services () -type validation_state = { - validity_state : Validate.validation_state; - application_state : Apply.application_state; -} +type validation_state = Validate.validation_state -let prepare_context ctxt ~level ~predecessor_timestamp ~timestamp = - Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ctxt +type application_state = Apply.application_state let init_allowed_consensus_operations ctxt ~endorsement_level ~preendorsement_level = - let open Lwt_result_syntax in + let open Lwt_tzresult_syntax in let open Alpha_context in let* ctxt = Delegate.prepare_stake_distribution ctxt in let* ctxt, allowed_endorsements, allowed_preendorsements = @@ -127,247 +123,193 @@ let init_allowed_consensus_operations ctxt ~endorsement_level in return ctxt -let begin_application ~chain_id ~predecessor_context ~predecessor_timestamp - ~(predecessor_fitness : Fitness.t) - (block_header : Alpha_context.Block_header.t) = +(** Circumstances and relevant information for [begin_validation] and + [begin_application] below. *) +type mode = + | Application of block_header + | Partial_validation of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + +let prepare_ctxt ctxt mode ~(predecessor : Block_header.shell_header) = let open Lwt_tzresult_syntax in let open Alpha_context in + let level, timestamp = + match mode with + | Application block_header | Partial_validation block_header -> + (block_header.shell.level, block_header.shell.timestamp) + | Construction {timestamp; _} | Partial_construction {timestamp; _} -> + (Int32.succ predecessor.level, timestamp) + in let* ctxt, migration_balance_updates, migration_operation_results = - prepare_context - predecessor_context - ~level:block_header.shell.level - ~predecessor_timestamp - ~timestamp:block_header.shell.timestamp + prepare ctxt ~level ~predecessor_timestamp:predecessor.timestamp ~timestamp in - let*? predecessor_level = - Alpha_context.Raw_level.of_int32 (Int32.pred block_header.shell.level) + let*? predecessor_raw_level = Raw_level.of_int32 predecessor.level in + let predecessor_level = Level.from_raw ctxt predecessor_raw_level in + (* During block (full or partial) application or full construction, + endorsements must be for [predecessor_level] and preendorsements, + if any, for the block's level. In the mempool (partial + construction), only consensus operations for [predecessor_level] + (that is, head's level) are allowed (except for grandparent + endorsements, which are handled differently). *) + let preendorsement_level = + match mode with + | Application _ | Partial_validation _ | Construction _ -> + Level.current ctxt + | Partial_construction _ -> predecessor_level in - let predecessor_level = Alpha_context.Level.from_raw ctxt predecessor_level in - let current_level = Level.current ctxt in let* ctxt = init_allowed_consensus_operations ctxt ~endorsement_level:predecessor_level - ~preendorsement_level:current_level - in - let*? fitness = Alpha_context.Fitness.from_raw block_header.shell.fitness in - let* validity_state = - Validate.begin_application - ctxt - chain_id - ~predecessor_level - ~predecessor_timestamp - block_header - fitness - in - let* application_state = - Apply.begin_application - ctxt - chain_id - ~migration_balance_updates - ~migration_operation_results - ~predecessor_fitness - (block_header : Alpha_context.Block_header.t) - in - return {validity_state; application_state} - -let begin_partial_application ~chain_id ~ancestor_context ~predecessor_timestamp - ~(predecessor_fitness : Fitness.t) - (block_header : Alpha_context.Block_header.t) = - let open Lwt_tzresult_syntax in - let open Alpha_context in - let* ancestor_context, migration_balance_updates, migration_operation_results - = - prepare_context - ancestor_context - ~level:block_header.shell.level - ~predecessor_timestamp - ~timestamp:block_header.shell.timestamp - in - let*? predecessor_level = - Raw_level.of_int32 (Int32.pred block_header.shell.level) - in - let predecessor_level = Level.from_raw ancestor_context predecessor_level in - let current_level = Level.current ancestor_context in - let* ancestor_context = - init_allowed_consensus_operations - ancestor_context - ~endorsement_level:predecessor_level - ~preendorsement_level:current_level + ~preendorsement_level in - let*? fitness = Fitness.from_raw block_header.shell.fitness in - let* validity_state = - Validate.begin_partial_application - ~ancestor_context - chain_id - ~predecessor_level - ~predecessor_timestamp - block_header - fitness - in - let* application_state = - Apply.begin_partial_application - chain_id - ~ancestor_context - ~migration_balance_updates - ~migration_operation_results - ~predecessor_fitness - block_header - in - return {validity_state; application_state} + return + ( ctxt, + migration_balance_updates, + migration_operation_results, + predecessor_level, + predecessor_raw_level ) -let begin_full_construction ~chain_id ~predecessor_context - ~predecessor_timestamp ~predecessor_level ~(predecessor_fitness : Fitness.t) - ~predecessor ~timestamp - (block_header_contents : Alpha_context.Block_header.contents) = +let begin_validation ctxt chain_id mode ~predecessor = let open Lwt_tzresult_syntax in let open Alpha_context in - let level = Int32.succ predecessor_level in - let* ctxt, migration_balance_updates, migration_operation_results = - prepare_context ~level ~predecessor_timestamp ~timestamp predecessor_context - in - let*? predecessor_level = Raw_level.of_int32 predecessor_level in - let predecessor_level = Level.from_raw ctxt predecessor_level in - let current_level = Level.current ctxt in - let* ctxt = - init_allowed_consensus_operations - ctxt - ~endorsement_level:predecessor_level - ~preendorsement_level:current_level - in - let round_durations = Constants.round_durations ctxt in - let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in - let*? round = - Round.round_of_timestamp - round_durations - ~predecessor_timestamp - ~predecessor_round - ~timestamp - in - let* validity_state = - Validate.begin_full_construction - ctxt - chain_id - ~predecessor_level - ~predecessor_round - ~predecessor_timestamp - ~predecessor_hash:predecessor - round - block_header_contents + let* ( ctxt, + _migration_balance_updates, + _migration_operation_results, + predecessor_level, + _predecessor_raw_level ) = + prepare_ctxt ctxt ~predecessor mode in - let* application_state = - Apply.begin_full_construction - ctxt - chain_id - ~migration_balance_updates - ~migration_operation_results - ~predecessor_timestamp - ~predecessor_level - ~predecessor_round - ~predecessor - ~timestamp - block_header_contents - in - return {validity_state; application_state} - -let begin_partial_construction ~chain_id ~predecessor_context - ~predecessor_timestamp ~predecessor_level ~predecessor_fitness - ~predecessor:_ ~timestamp = + let predecessor_timestamp = predecessor.timestamp in + let predecessor_fitness = predecessor.fitness in + match mode with + | Application block_header -> + let*? fitness = Fitness.from_raw block_header.shell.fitness in + Validate.begin_application + ctxt + chain_id + ~predecessor_level + ~predecessor_timestamp + block_header + fitness + | Partial_validation block_header -> + let*? fitness = Fitness.from_raw block_header.shell.fitness in + Validate.begin_partial_validation + ctxt + chain_id + ~predecessor_level + ~predecessor_timestamp + block_header + fitness + | Construction {predecessor_hash; timestamp; block_header_data} -> + let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in + let*? round = + Round.round_of_timestamp + (Constants.round_durations ctxt) + ~predecessor_timestamp + ~predecessor_round + ~timestamp + in + Validate.begin_full_construction + ctxt + chain_id + ~predecessor_level + ~predecessor_round + ~predecessor_timestamp + ~predecessor_hash + round + block_header_data.contents + | Partial_construction _ -> + let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in + let*? grandparent_round = + Fitness.predecessor_round_from_raw predecessor_fitness + in + return + (Validate.begin_partial_construction + ctxt + chain_id + ~predecessor_level + ~predecessor_round + ~grandparent_round) + +let validate_operation = Validate.validate_operation + +let finalize_validation = Validate.finalize_block + +type error += Cannot_apply_in_partial_validation + +let () = + register_error_kind + `Permanent + ~id:"main.begin_application.cannot_apply_in_partial_validation" + ~title:"cannot_apply_in_partial_validation" + ~description: + "Cannot instantiate an application state using the 'Partial_validation' \ + mode." + ~pp:(fun ppf () -> + Format.fprintf + ppf + "Cannot instantiate an application state using the \ + 'Partial_validation' mode.") + Data_encoding.(empty) + (function Cannot_apply_in_partial_validation -> Some () | _ -> None) + (fun () -> Cannot_apply_in_partial_validation) + +let begin_application ctxt chain_id mode ~predecessor = let open Lwt_tzresult_syntax in let open Alpha_context in - let level = Int32.succ predecessor_level in - let* ctxt, migration_balance_updates, migration_operation_results = - prepare ~level ~predecessor_timestamp ~timestamp predecessor_context - in - let*? predecessor_raw_level = Raw_level.of_int32 predecessor_level in - let predecessor_level = Level.from_raw ctxt predecessor_raw_level in - (* In the mempool, only consensus operations for [predecessor_level] - (that is, head's level) are allowed, contrary to block validation - where endorsements are for the previous level and - preendorsements, if any, for the block's level. *) - let* ctxt = - init_allowed_consensus_operations - ctxt - ~endorsement_level:predecessor_level - ~preendorsement_level:predecessor_level - in - let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in - let*? grandparent_round = - Alpha_context.Fitness.predecessor_round_from_raw predecessor_fitness + let* ( ctxt, + migration_balance_updates, + migration_operation_results, + predecessor_level, + predecessor_raw_level ) = + prepare_ctxt ctxt ~predecessor mode in - let validity_state = - Validate.begin_partial_construction - ctxt - chain_id - ~predecessor_level - ~predecessor_round - ~grandparent_round - in - let* application_state = - Apply.begin_partial_construction - ctxt - chain_id - ~migration_balance_updates - ~migration_operation_results - ~predecessor_level:predecessor_raw_level - ~predecessor_fitness - in - return {validity_state; application_state} - -(* Updater's signature compliant function *) -let begin_construction ~chain_id ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~(predecessor_fitness : Fitness.t) ~predecessor - ~timestamp ?(protocol_data : block_header_data option) () = - match protocol_data with - | None -> - begin_partial_construction - ~chain_id - ~predecessor_context - ~predecessor_timestamp - ~predecessor_level + let predecessor_timestamp = predecessor.timestamp in + let predecessor_fitness = predecessor.fitness in + match mode with + | Application block_header -> + Apply.begin_application + ctxt + chain_id + ~migration_balance_updates + ~migration_operation_results ~predecessor_fitness - ~predecessor - ~timestamp - | Some protocol_data -> - begin_full_construction - ~chain_id - ~predecessor_context + block_header + | Partial_validation _ -> fail Cannot_apply_in_partial_validation + | Construction {predecessor_hash; timestamp; block_header_data; _} -> + let*? predecessor_round = Fitness.round_from_raw predecessor_fitness in + Apply.begin_full_construction + ctxt + chain_id + ~migration_balance_updates + ~migration_operation_results ~predecessor_timestamp ~predecessor_level - ~predecessor_fitness - ~predecessor + ~predecessor_round + ~predecessor:predecessor_hash ~timestamp - protocol_data.contents + block_header_data.contents + | Partial_construction _ -> + Apply.begin_partial_construction + ctxt + chain_id + ~migration_balance_updates + ~migration_operation_results + ~predecessor_level:predecessor_raw_level + ~predecessor_fitness -let validate_operation validity_state - (packed_operation : Alpha_context.packed_operation) = - let {shell; protocol_data = Operation_data protocol_data} = - packed_operation - in - let operation : _ Alpha_context.operation = {shell; protocol_data} in - let oph = Alpha_context.Operation.hash operation in - Validate.validate_operation validity_state oph packed_operation - -let apply_operation (state : validation_state) - (packed_operation : Alpha_context.packed_operation) = - let open Lwt_result_syntax in - let* validation_state = - validate_operation state.validity_state packed_operation - in - let operation_hash = Alpha_context.Operation.hash_packed packed_operation in - let* application_state, operation_receipt = - Apply.apply_operation - state.application_state - operation_hash - packed_operation - in - return - ({validity_state = validation_state; application_state}, operation_receipt) +let apply_operation = Apply.apply_operation -let finalize_block state shell_header = - let open Lwt_result_syntax in - let* () = Validate.finalize_block state.validity_state in - Apply.finalize_block state.application_state shell_header +let finalize_application = Apply.finalize_block let compare_operations (oph1, op1) (oph2, op2) = Alpha_context.Operation.compare (oph1, op1) (oph2, op2) @@ -446,27 +388,22 @@ let value_of_key ~chain_id:_ ~predecessor_context:ctxt ~predecessor_timestamp module Mempool = struct include Mempool_validation - let init ctxt chain_id ~head_hash ~(head_header : Block_header.shell_header) - ~current_timestamp = + let init ctxt chain_id ~head_hash ~(head : Block_header.shell_header) = let open Lwt_tzresult_syntax in let open Alpha_context in - let level = Int32.succ head_header.level in - let* ctxt, _migration_balance_updates, _migration_operation_results = - prepare - ~level - ~predecessor_timestamp:head_header.timestamp - ~timestamp:current_timestamp - ctxt - in - let*? raw_pred_level = Raw_level.of_int32 head_header.level in - let head_level = Level.from_raw ctxt raw_pred_level in - let* ctxt = - init_allowed_consensus_operations + let* ( ctxt, + _migration_balance_updates, + _migration_operation_results, + head_level, + _head_raw_level ) = + (* We use Partial_construction to factorize the [prepare_ctxt]. *) + prepare_ctxt ctxt - ~endorsement_level:head_level - ~preendorsement_level:head_level + (Partial_construction + {predecessor_hash = head_hash; timestamp = head.timestamp}) + ~predecessor:head in - let*? fitness = Fitness.from_raw head_header.fitness in + let*? fitness = Fitness.from_raw head.fitness in let predecessor_round = Fitness.round fitness in let grandparent_round = Fitness.predecessor_round fitness in return diff --git a/src/proto_alpha/lib_protocol/main.mli b/src/proto_alpha/lib_protocol/main.mli index eaab25a35f98f0f9eb0a61cf179319c54487bfd2..d6d5913c57dad658b26b5db3835484b6e6971d39 100644 --- a/src/proto_alpha/lib_protocol/main.mli +++ b/src/proto_alpha/lib_protocol/main.mli @@ -25,9 +25,9 @@ (** Tezos Protocol Implementation - Protocol Signature Instance - This module is the entrypoint to the protocol for shells and other - embedders. This signature is an instance of - {{!Tezos_protocol_environment_sigs.V5.T.Updater.PROTOCOL} the + This module is the entrypoint to the protocol for shells and other + embedders. This signature is an instance of + {{!Tezos_protocol_environment_sigs.V7.T.Updater.PROTOCOL} the [Updater.PROTOCOL] signature} from the {{:https://tezos.gitlab.io/shell/the_big_picture.html#the-economic-protocol-environment-and-compiler} Protocol Environment}. @@ -40,11 +40,6 @@ {{:https://tezos.gitlab.io/shell/the_big_picture.html} this overview}. *) -type validation_state = { - validity_state : Validate.validation_state; - application_state : Apply.application_state; -} - type operation_data = Alpha_context.packed_protocol_data type operation = Alpha_context.packed_operation = { @@ -60,4 +55,5 @@ include and type operation_data := operation_data and type operation_receipt = Apply_results.packed_operation_metadata and type operation := operation - and type validation_state := validation_state + and type validation_state = Validate.validation_state + and type application_state = Apply.application_state diff --git a/src/proto_alpha/lib_protocol/mempool_validation.ml b/src/proto_alpha/lib_protocol/mempool_validation.ml index 2debf1f8e6cb83bbd749ec0718a090bbfbe6a36e..8493f18a7e13f9994ccc55028e453c8b73b2d7f8 100644 --- a/src/proto_alpha/lib_protocol/mempool_validation.ml +++ b/src/proto_alpha/lib_protocol/mempool_validation.ml @@ -100,9 +100,7 @@ let add_operation ?(check_signature = true) let open Lwt_syntax in let {shell; protocol_data = Operation_data protocol_data} = packed_op in let operation : _ Alpha_context.operation = {shell; protocol_data} in - let* validate_result = - check_operation info ~should_check_signature:check_signature operation - in + let* validate_result = check_operation ~check_signature info operation in match validate_result with | Error err -> Lwt.return_error (Validation_error err) | Ok () -> ( diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml index 9319e69656cc35efc08d90ba46c7d646cbe391e4..efd8480d5bc187db18a43236f206816608aff110 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml @@ -695,50 +695,68 @@ let alpha_context ?commitments ?min_proposal_quorum (********* Baking *************) -(* Note that by calling this function without [protocol_data], we force the mode - to be partial construction (by correspondingly calling [begin_construction] - without [protocol_data]). *) +let begin_validation_and_application ctxt chain_id mode ~predecessor = + let open Lwt_result_syntax in + let* validation_state = begin_validation ctxt chain_id mode ~predecessor in + let* application_state = begin_application ctxt chain_id mode ~predecessor in + return (validation_state, application_state) + let get_application_vstate (pred : t) (operations : Protocol.operation trace) = Forge.forge_header pred ~operations >>=? fun header -> Forge.sign_header header >>=? fun header -> let open Environment.Error_monad in - Main.begin_application - ~chain_id:Chain_id.zero - ~predecessor_context:pred.context - ~predecessor_fitness:pred.header.shell.fitness - ~predecessor_timestamp:pred.header.shell.timestamp - header + begin_validation_and_application + pred.context + Chain_id.zero + (Application header) + ~predecessor:pred.header.shell >|= Environment.wrap_tzresult +(* Note that by calling this function without [protocol_data], we + force the mode to be partial construction. *) let get_construction_vstate ?(policy = By_round 0) ?timestamp ?(protocol_data = None) (pred : t) = let open Protocol in dispatch_policy policy pred >>=? fun (_pkh, _ck, _round, expected_timestamp) -> let timestamp = Option.value ~default:expected_timestamp timestamp in - Main.begin_construction - ~chain_id:Chain_id.zero - ~predecessor_context:pred.context - ~predecessor_timestamp:pred.header.shell.timestamp - ~predecessor_level:pred.header.shell.level - ~predecessor_fitness:pred.header.shell.fitness - ~predecessor:pred.hash - ?protocol_data - ~timestamp - () + let mode = + match protocol_data with + | None -> Partial_construction {predecessor_hash = pred.hash; timestamp} + | Some block_header_data -> + Construction + {predecessor_hash = pred.hash; timestamp; block_header_data} + in + begin_validation_and_application + pred.context + Chain_id.zero + mode + ~predecessor:pred.header.shell >|= Environment.wrap_tzresult +let validate_and_apply_operation (validation_state, application_state) op = + let open Lwt_result_syntax in + let oph = Operation.hash_packed op in + let* validation_state = validate_operation validation_state oph op in + let* application_state, receipt = apply_operation application_state oph op in + return ((validation_state, application_state), receipt) + +let finalize_validation_and_application (validation_state, application_state) + shell_header = + let open Lwt_result_syntax in + let* () = finalize_validation validation_state in + finalize_application application_state shell_header + let apply_with_metadata ?(policy = By_round 0) ?(check_size = true) ~baking_mode header ?(operations = []) pred = let open Environment.Error_monad in ( (match baking_mode with | Application -> - Main.begin_application - ~chain_id:Chain_id.zero - ~predecessor_context:pred.context - ~predecessor_fitness:pred.header.shell.fitness - ~predecessor_timestamp:pred.header.shell.timestamp - header + begin_validation_and_application + pred.context + Chain_id.zero + (Application header) + ~predecessor:pred.header.shell >|= Environment.wrap_tzresult | Baking -> get_construction_vstate @@ -760,12 +778,13 @@ let apply_with_metadata ?(policy = By_round 0) ?(check_size = true) ~baking_mode size %d" operation_size Constants_repr.max_operation_data_length))) ; - apply_operation vstate op >|= Environment.wrap_tzresult + validate_and_apply_operation vstate op >|= Environment.wrap_tzresult >|=? fun (state, _result) -> state) vstate operations >>=? fun vstate -> - Main.finalize_block vstate (Some header.shell) >|= Environment.wrap_tzresult + finalize_validation_and_application vstate (Some header.shell) + >|= Environment.wrap_tzresult >|=? fun (validation, result) -> (validation.context, result) ) >|=? fun (context, result) -> let hash = Block_header.hash header in diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.mli b/src/proto_alpha/lib_protocol/test/helpers/block.mli index 7a381919f32cbf18e3f93cd3517256d6e957bc94..768c698dc105717506118670e6e9350ed6e2232f 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/block.mli @@ -162,7 +162,9 @@ val alpha_context : with the given operations. It's a shortcut for [begin_application] *) val get_application_vstate : - t -> Protocol.operation list -> validation_state tzresult Lwt.t + t -> + Protocol.operation list -> + (validation_state * application_state) tzresult Lwt.t (** [get_construction_vstate ?policy ?timestamp ?protocol_data pred] @@ -176,7 +178,7 @@ val get_construction_vstate : ?timestamp:Timestamp.time -> ?protocol_data:block_header_data option -> block -> - validation_state tzresult Lwt.t + (validation_state * application_state) tzresult Lwt.t (** applies a signed header and its operations to a block and obtains a new block *) diff --git a/src/proto_alpha/lib_protocol/test/helpers/consensus_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/consensus_helpers.ml index 2b22c3df9d4d010ed54197edb3d9cb78f7a71daf..8c6e139df83bb213c649bbf48137cdaaa4fa1e37 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/consensus_helpers.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/consensus_helpers.ml @@ -57,8 +57,11 @@ let test_consensus_operation ?construction_mode ?level ?block_payload_hash ?slot | Some (pred, protocol_data) -> (* meaning partial construction or full construction mode, depending on [protocol_data] *) - Block.get_construction_vstate ~protocol_data pred >>=? fun vstate -> - apply_operation vstate op >|= Environment.wrap_tzresult >>= assert_error + Block.get_construction_vstate ~protocol_data pred + >>=? fun (validation_state, _application_state) -> + let oph = Operation.hash_packed op in + validate_operation validation_state oph op + >|= Environment.wrap_tzresult >>= assert_error let delegate_of_first_slot b = let module V = Plugin.RPC.Validators in diff --git a/src/proto_alpha/lib_protocol/test/helpers/incremental.ml b/src/proto_alpha/lib_protocol/test/helpers/incremental.ml index f3ebdd9db24a3f478977f4800be62f361772c3bd..da83665012c41cc6d45f10a8bb77e49d68b3650a 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/incremental.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/incremental.ml @@ -29,7 +29,7 @@ open Alpha_context type t = { predecessor : Block.t; - state : validation_state; + state : validation_state * application_state; rev_operations : Operation.packed list; rev_tickets : operation_receipt list; header : Block_header.t; @@ -44,13 +44,15 @@ let header {header; _} = header let rev_tickets {rev_tickets; _} = rev_tickets -let validation_state {state; _} = state +let validation_state {state = vs, _; _} = vs let level st = st.header.shell.level +let alpha_ctxt {state = _, application_state; _} = application_state.ctxt + let rpc_context st = let fitness = (header st).shell.fitness in - let result = Alpha_context.finalize st.state.application_state.ctxt fitness in + let result = Alpha_context.finalize (alpha_ctxt st) fitness in { Environment.Updater.block_hash = Block_hash.zero; block_header = {st.header.shell with fitness = result.fitness}; @@ -62,14 +64,14 @@ let rpc_ctxt = rpc_context Plugin.RPC.rpc_services -let alpha_ctxt st = st.state.application_state.ctxt - let set_alpha_ctxt st ctxt = - { - st with - state = - {st.state with application_state = {st.state.application_state with ctxt}}; - } + {st with state = (fst st.state, {(snd st.state) with ctxt})} + +let begin_validation_and_application ctxt chain_id mode ~predecessor = + let open Lwt_result_syntax in + let* validation_state = begin_validation ctxt chain_id mode ~predecessor in + let* application_state = begin_application ctxt chain_id mode ~predecessor in + return (validation_state, application_state) let begin_construction ?timestamp ?seed_nonce_hash ?(mempool_mode = false) ?(policy = Block.By_round 0) (predecessor : Block.t) = @@ -93,9 +95,15 @@ let begin_construction ?timestamp ?seed_nonce_hash ?(mempool_mode = false) ~payload_round () in - let protocol_data = - if mempool_mode then None - else Some {Block_header.contents; signature = Signature.zero} + let mode = + if mempool_mode then + Partial_construction {predecessor_hash = predecessor.hash; timestamp} + else + let block_header_data = + {Block_header.contents; signature = Signature.zero} + in + Construction + {predecessor_hash = predecessor.hash; timestamp; block_header_data} in let header = { @@ -113,16 +121,11 @@ let begin_construction ?timestamp ?seed_nonce_hash ?(mempool_mode = false) protocol_data = {contents; signature = Signature.zero}; } in - begin_construction - ~chain_id:Chain_id.zero - ~predecessor_context:predecessor.context - ~predecessor_timestamp:predecessor.header.shell.timestamp - ~predecessor_fitness:predecessor.header.shell.fitness - ~predecessor_level:predecessor.header.shell.level - ~predecessor:predecessor.hash - ~timestamp - ?protocol_data - () + begin_validation_and_application + predecessor.context + Chain_id.zero + mode + ~predecessor:predecessor.header.shell >|= fun state -> Environment.wrap_tzresult state >|? fun state -> {predecessor; state; rev_operations = []; rev_tickets = []; header; delegate} @@ -164,68 +167,77 @@ let detect_script_failure : in fun {contents} -> detect_script_failure contents -let apply_operation ?(check_size = true) st op = - (if check_size then - let operation_size = Data_encoding.Binary.length Operation.encoding op in - if operation_size > Constants_repr.max_operation_data_length then - raise - (invalid_arg - (Format.sprintf - "The operation size is %d, it exceeds the constant maximum size %d" - operation_size - Constants_repr.max_operation_data_length))) ; - apply_operation st.state op >|= Environment.wrap_tzresult +let check_operation_size ?(check_size = true) op = + if check_size then + let operation_size = Data_encoding.Binary.length Operation.encoding op in + if operation_size > Constants_repr.max_operation_data_length then + raise + (invalid_arg + (Format.sprintf + "The operation size is %d: it exceeds the constant maximum size \ + %d." + operation_size + Constants_repr.max_operation_data_length)) let validate_operation ?expect_failure ?check_size st op = - apply_operation ?check_size st op >>= fun result -> - match (expect_failure, result) with + let open Lwt_result_syntax in + check_operation_size ?check_size op ; + let validation_state, application_state = st.state in + let oph = Operation.hash_packed op in + let*! res = validate_operation validation_state oph op in + match (expect_failure, Environment.wrap_tzresult res) with | Some _, Ok _ -> failwith "Error expected while validating operation" - | Some f, Error err -> f err >|=? fun () -> st - | None, Error err -> failwith "Error %a was not expected" pp_print_trace err - | None, Ok (state, (Operation_metadata _ as metadata)) - | None, Ok (state, (No_operation_metadata as metadata)) -> - return + | Some f, Error err -> + let* () = f err in + return st + | None, Error err -> fail err + | None, Ok validation_state -> + return {st with state = (validation_state, application_state)} + +let add_operation ?expect_failure ?expect_apply_failure ?check_size st op = + let open Lwt_result_syntax in + let open Apply_results in + let* st = validate_operation ?expect_failure ?check_size st op in + match expect_failure with + | Some _ -> + (* The expected failure has already been observed in + [validate_operation]. *) + return st + | None -> ( + let validation_state, application_state = st.state in + let oph = Operation.hash_packed op in + let*! res = apply_operation application_state oph op in + let*? application_state, metadata = Environment.wrap_tzresult res in + let st = { st with - state; + state = (validation_state, application_state); rev_operations = op :: st.rev_operations; rev_tickets = metadata :: st.rev_tickets; } + in + match (expect_apply_failure, metadata) with + | None, No_operation_metadata -> return st + | None, Operation_metadata result -> + let*? () = detect_script_failure result in + return st + | Some _, No_operation_metadata -> + failwith "Error expected while adding operation" + | Some f, Operation_metadata result -> ( + match detect_script_failure result with + | Ok _ -> failwith "Error expected while adding operation" + | Error err -> + let* () = f err in + return st)) -let add_operation ?expect_failure ?expect_apply_failure ?check_size st op = - let open Apply_results in - apply_operation ?check_size st op >>= fun result -> - match (expect_failure, result) with - | Some _, Ok _ -> failwith "Error expected while adding operation" - | Some f, Error err -> f err >|=? fun () -> st - | None, result -> ( - result >>?= fun result -> - match result with - | state, (Operation_metadata result as metadata) -> - detect_script_failure result |> fun result -> - (match expect_apply_failure with - | None -> Lwt.return result - | Some f -> ( - match result with - | Ok _ -> failwith "Error expected while adding operation" - | Error e -> f e)) - >|=? fun () -> - { - st with - state; - rev_operations = op :: st.rev_operations; - rev_tickets = metadata :: st.rev_tickets; - } - | state, (No_operation_metadata as metadata) -> - return - { - st with - state; - rev_operations = op :: st.rev_operations; - rev_tickets = metadata :: st.rev_tickets; - }) +let finalize_validation_and_application (validation_state, application_state) + shell_header = + let open Lwt_result_syntax in + let* () = finalize_validation validation_state in + finalize_application application_state shell_header let finalize_block st = + let open Lwt_result_syntax in let operations = List.rev st.rev_operations in let operations_hash = Operation_list_list_hash.compute @@ -238,8 +250,10 @@ let finalize_block st = operations_hash; } in - finalize_block st.state (Some shell_header) >|= fun x -> - Environment.wrap_tzresult x >|? fun (result, _) -> + let*! res = + finalize_validation_and_application st.state (Some shell_header) + in + let*? validation_result, _ = Environment.wrap_tzresult res in let operations = List.rev st.rev_operations in let operations_hash = Operation_list_list_hash.compute @@ -253,12 +267,12 @@ let finalize_block st = st.header.shell with level = Int32.succ st.header.shell.level; operations_hash; - fitness = result.fitness; + fitness = validation_result.fitness; }; } in let hash = Block_header.hash header in - {Block.hash; header; operations; context = result.context} + return {Block.hash; header; operations; context = validation_result.context} let assert_validate_operation_fails expect_failure op block = let open Lwt_result_syntax in diff --git a/src/proto_alpha/lib_protocol/test/helpers/incremental.mli b/src/proto_alpha/lib_protocol/test/helpers/incremental.mli index 72541d86ccfe05784d3f9da880a90b420e679798..dc543c0d78e78372b624b2b5f26e1f9aef4fc1c5 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/incremental.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/incremental.mli @@ -41,14 +41,14 @@ val validation_state : incremental -> validation_state val level : incremental -> int32 (** [begin_construction ?mempool_mode predecessor] uses - [Main.begin_construction] to create a validation state on top of - [predecessor]. + {!Main.begin_validation_and_application} to create a validation and + application state on top of [predecessor] for the construction of a + new block. Optional arguments allow to override defaults: - {ul {li [?mempool_mode:bool]: set the validation state to - [partial_construction], [construction] otherwise (default).}} -*) + {ul {li [?mempool_mode:bool]: when [true], use [Partial_construction] + mode. By default, it is [false] and the mode is [Construction].}} *) val begin_construction : ?timestamp:Time.Protocol.t -> ?seed_nonce_hash:Nonce_hash.t -> @@ -81,10 +81,11 @@ val validate_operation : incremental tzresult Lwt.t (** [add_operation ?expect_failure ?expect_apply_failure ?check_size i - op] tries to apply [op] in the validation state of [i]. If the - validation of [op] succeeds, the function returns the incremental - value with a validation state updated after the application of - [op]. Otherwise raise the error from the validation of [op]. + op] tries to validate then apply [op] in the validation and + application state of [i]. If the validation of [op] succeeds, the + function returns the incremental value with a validation state + updated after the application of [op]. Otherwise raise the error + from the validation of [op]. Optional arguments allow to override defaults: @@ -110,10 +111,9 @@ val add_operation : Operation.packed -> incremental tzresult Lwt.t -(** [finalize_block i] creates a [Block.t] based on the - validation_state and the operations contained in [i]. The function - calls [Main.finalize_block] to compute a new context. -*) +(** [finalize_block i] creates a [Block.t] based on the protocol + states and the operations contained in [i]. The function calls + [Main.finalize_application] to compute a new context. *) val finalize_block : incremental -> Block.t tzresult Lwt.t (** [assert_validate_operation_fails expect_failure operation block] diff --git a/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_levels.ml b/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_levels.ml index 1866f629aeade9ec731217af7e4e24bbd9fb5437..678a6c79844c8eb5b3f2b51a04c2284eb8779d9b 100644 --- a/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_levels.ml +++ b/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_levels.ml @@ -194,24 +194,42 @@ let test_set_gas_limited () = (*** Tests with blocks ***) +let begin_validation_and_application ctxt chain_id mode ~predecessor = + let open Lwt_result_syntax in + let* validation_state = begin_validation ctxt chain_id mode ~predecessor in + let* application_state = begin_application ctxt chain_id mode ~predecessor in + return (validation_state, application_state) + +let validate_and_apply_operation (validation_state, application_state) op = + let open Lwt_result_syntax in + let oph = Alpha_context.Operation.hash_packed op in + let* validation_state = validate_operation validation_state oph op in + let* application_state, receipt = apply_operation application_state oph op in + return ((validation_state, application_state), receipt) + +let finalize_validation_and_application (validation_state, application_state) + shell_header = + let open Lwt_result_syntax in + let* () = finalize_validation validation_state in + finalize_application application_state shell_header + let apply_with_gas header ?(operations = []) (pred : Block.t) = let open Alpha_context in (let open Environment.Error_monad in - begin_application - ~chain_id:Chain_id.zero - ~predecessor_context:pred.context - ~predecessor_fitness:pred.header.shell.fitness - ~predecessor_timestamp:pred.header.shell.timestamp - header + begin_validation_and_application + pred.context + Chain_id.zero + (Application header) + ~predecessor:pred.header.shell >>=? fun vstate -> List.fold_left_es (fun vstate op -> - apply_operation vstate op >|=? fun (state, _result) -> state) + validate_and_apply_operation vstate op >|=? fun (state, _result) -> state) vstate operations >>=? fun vstate -> - finalize_block vstate (Some header.shell) >|=? fun (validation, result) -> - (validation.context, result.consumed_gas)) + finalize_validation_and_application vstate (Some header.shell) + >|=? fun (validation, result) -> (validation.context, result.consumed_gas)) >|= Environment.wrap_tzresult >|=? fun (context, consumed_gas) -> let hash = Block_header.hash header in diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_gas_properties.ml b/src/proto_alpha/lib_protocol/test/pbt/test_gas_properties.ml index 77839e7b385258f4c2ffffdde0ce07504eedb0ea..7d882937ddbb209e65268af6a1a49deab9247280 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/test_gas_properties.ml +++ b/src/proto_alpha/lib_protocol/test/pbt/test_gas_properties.ml @@ -97,9 +97,8 @@ let context_gen : Alpha_context.t QCheck2.Gen.t = (let open Lwt_result_syntax in let* b, _contract = Context.init1 () in let+ inc = Incremental.begin_construction b in - let state = Incremental.validation_state inc in Alpha_context.Gas.set_limit - state.application_state.ctxt + (Incremental.alpha_ctxt inc) Alpha_context.Gas.Arith.(fp (integral_of_int_exn 100_000_000))) |> function | Ok a -> a diff --git a/src/proto_alpha/lib_protocol/test/unit/test_gas_monad.ml b/src/proto_alpha/lib_protocol/test/unit/test_gas_monad.ml index e1d563b5fc3ef714b8e95ee8916a242ea0da86c3..1ef3b1b84067bff150a5e255762d3941d23751c1 100644 --- a/src/proto_alpha/lib_protocol/test/unit/test_gas_monad.ml +++ b/src/proto_alpha/lib_protocol/test/unit/test_gas_monad.ml @@ -40,8 +40,7 @@ let ten_milligas = Gas.fp_of_milligas_int 10 let new_context ~limit = Context.init1 () >>=? fun (b, _contract) -> Incremental.begin_construction b >|=? fun inc -> - let state = Incremental.validation_state inc in - Gas.set_limit state.application_state.ctxt limit + Gas.set_limit (Incremental.alpha_ctxt inc) limit let assert_gas_exhaustion ~loc ctxt gas_monad = match GM.run ctxt gas_monad with diff --git a/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml b/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml index f171ae3e04eda278f97cb8c47d65b4933e039308..1846fd0353ae873ec7bb62c96d2f45c2141edc33 100644 --- a/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml +++ b/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml @@ -58,8 +58,7 @@ let new_context_with_stakers nb_stakers = () in let+ inc = Incremental.begin_construction b in - let state = Incremental.validation_state inc in - let ctxt = state.application_state.ctxt in + let ctxt = Incremental.alpha_ctxt inc in (* Necessary to originate rollups. *) let ctxt = Alpha_context.Origination_nonce.init ctxt Operation_hash.zero in let ctxt = Alpha_context.Internal_for_tests.to_raw ctxt in diff --git a/src/proto_alpha/lib_protocol/validate.ml b/src/proto_alpha/lib_protocol/validate.ml index 4c2a0549fe43ddcaf45bfff024a1a43b2d4719ae..26cd81643ad4de114d414430657a17f98fcdd5d7 100644 --- a/src/proto_alpha/lib_protocol/validate.ml +++ b/src/proto_alpha/lib_protocol/validate.ml @@ -391,8 +391,8 @@ type application_info = { - [Application] is used for the validation of preexisting block. Corresponds to [Application] of {!Main.validation_mode}. - - [Partial_application] is used to partially validate preexisting - block. Corresponds to [Partial_application] of + - [Partial_validation] is used to partially validate preexisting + block. Corresponds to [Partial_validation] of {!Main.validation_mode}. - [Construction] is used for the construction of a new block. @@ -406,7 +406,7 @@ type application_info = { the size of the map {!recfield:managers_seen}. *) type mode = | Application of application_info - | Partial_application of application_info + | Partial_validation of application_info | Construction of { predecessor_round : Round.t; predecessor_hash : Block_hash.t; @@ -502,6 +502,8 @@ let init_block_state vi = endorsement_power = 0; } +let get_initial_ctxt {info; _} = info.ctxt + (** Validation of consensus operations (validation pass [0]): preendorsement, endorsement, and dal_slot_availability. *) module Consensus = struct @@ -706,7 +708,7 @@ module Consensus = struct (Slot.Map.find consensus_content.slot slot_map) ~error:(trace_of_error (Wrong_slot_used_for_consensus_operation {kind})) - let check_preendorsement vi ~should_check_signature + let check_preendorsement vi ~check_signature (operation : Kind.preendorsement operation) = let open Lwt_tzresult_syntax in let (Single (Preendorsement consensus_content)) = @@ -736,7 +738,7 @@ module Consensus = struct check_frozen_deposits_are_positive vi.ctxt consensus_key.delegate in let*? () = - if should_check_signature then + if check_signature then Operation.check_signature consensus_key.consensus_pk vi.chain_id @@ -783,7 +785,7 @@ module Consensus = struct let locked_round_evidence = match mode with | Mempool -> None - | Application _ | Partial_application _ | Construction _ -> ( + | Application _ | Partial_validation _ | Construction _ -> ( match block_state.locked_round_evidence with | None -> Some (consensus_content.round, voting_power) | Some (_stored_round, evidences) -> @@ -811,10 +813,10 @@ module Consensus = struct in {vs with consensus_state = {vs.consensus_state with preendorsements_seen}} - (** Validates an endorsement pointing to the grandparent block. This + (** Validate an endorsement pointing to the grandparent block. This function will only be called in [Partial_construction] mode. *) - let check_grandparent_endorsement vi ~should_check_signature expected - operation (consensus_content : consensus_content) = + let check_grandparent_endorsement vi ~check_signature expected operation + (consensus_content : consensus_content) = let open Lwt_tzresult_syntax in let kind = Grandparent_endorsement in let level = Level.from_raw vi.ctxt consensus_content.level in @@ -825,7 +827,7 @@ module Consensus = struct check_consensus_features kind expected consensus_content operation in let*? () = - if should_check_signature then + if check_signature then Operation.check_signature consensus_key.consensus_pk vi.chain_id @@ -894,7 +896,7 @@ module Consensus = struct (** Validate an endorsement pointing to the predecessor, aka a "normal" endorsement. Only this kind of endorsement may be found during block validation or construction. *) - let check_normal_endorsement vi ~should_check_signature + let check_normal_endorsement vi ~check_signature (operation : Kind.endorsement operation) = let open Lwt_tzresult_syntax in let (Single (Endorsement consensus_content)) = @@ -921,7 +923,7 @@ module Consensus = struct check_frozen_deposits_are_positive vi.ctxt consensus_key.delegate in let*? () = - if should_check_signature then + if check_signature then Operation.check_signature consensus_key.consensus_pk vi.chain_id @@ -966,7 +968,7 @@ module Consensus = struct in {vs with consensus_state = {vs.consensus_state with endorsements_seen}} - let check_endorsement vi ~should_check_signature + let check_endorsement vi ~check_signature (operation : Kind.endorsement operation) = let open Lwt_tzresult_syntax in let (Single (Endorsement consensus_content)) = @@ -983,7 +985,7 @@ module Consensus = struct let* () = check_grandparent_endorsement vi - ~should_check_signature + ~check_signature expected_grandparent_endorsement operation (consensus_content : consensus_content) @@ -991,7 +993,7 @@ module Consensus = struct return Grandparent_endorsement | _ -> let* voting_power = - check_normal_endorsement vi ~should_check_signature operation + check_normal_endorsement vi ~check_signature operation in return (Normal_endorsement voting_power) @@ -1147,15 +1149,13 @@ module Consensus = struct them. *) check_round kind expected consensus_content) - let validate_preendorsement ~should_check_signature info operation_state - block_state oph (operation : Kind.preendorsement operation) = + let validate_preendorsement ~check_signature info operation_state block_state + oph (operation : Kind.preendorsement operation) = let open Lwt_tzresult_syntax in let (Single (Preendorsement consensus_content)) = operation.protocol_data.contents in - let* voting_power = - check_preendorsement info ~should_check_signature operation - in + let* voting_power = check_preendorsement info ~check_signature operation in let*? () = check_construction_preendorsement_round_consistency info @@ -1178,10 +1178,10 @@ module Consensus = struct let operation_state = add_preendorsement operation_state oph operation in return {info; operation_state; block_state} - let validate_endorsement ~should_check_signature info operation_state - block_state oph operation = + let validate_endorsement ~check_signature info operation_state block_state oph + operation = let open Lwt_tzresult_syntax in - let* kind = check_endorsement info ~should_check_signature operation in + let* kind = check_endorsement info ~check_signature operation in let*? () = check_endorsement_conflict operation_state oph operation |> wrap_endorsement_conflict @@ -1360,8 +1360,8 @@ module Voting = struct @return [Error Operation.Missing_signature] or [Error Operation.Invalid_signature] if the operation is unsigned or incorrectly signed. *) - let check_proposals vi ~should_check_signature - (operation : Kind.proposals operation) = + let check_proposals vi ~check_signature (operation : Kind.proposals operation) + = let open Lwt_tzresult_syntax in let (Single (Proposals {source; period; proposals})) = operation.protocol_data.contents @@ -1382,7 +1382,7 @@ module Voting = struct let*? () = check_count ~count_in_ctxt ~proposals_length in check_already_proposed vi.ctxt source proposals in - if should_check_signature then + if check_signature then (* Retrieving the public key should not fail as it *should* be called after checking that the delegate is in the vote listings (or is a testnet dictator), which implies that it @@ -1459,8 +1459,7 @@ module Voting = struct @return [Error Operation.Missing_signature] or [Error Operation.Invalid_signature] if the operation is unsigned or incorrectly signed. *) - let check_ballot vi ~should_check_signature - (operation : Kind.ballot operation) = + let check_ballot vi ~check_signature (operation : Kind.ballot operation) = let open Lwt_tzresult_syntax in let (Single (Ballot {source; period; proposal; ballot = _})) = operation.protocol_data.contents @@ -1472,7 +1471,7 @@ module Voting = struct let* () = check_current_proposal vi.ctxt proposal in let* () = check_source_has_not_already_voted vi.ctxt source in let* () = check_in_listings vi.ctxt source in - when_ should_check_signature (fun () -> + when_ check_signature (fun () -> (* Retrieving the public key cannot fail. Indeed, we have already checked that the delegate is in the vote listings, which implies that it is a manager with a revealed key. *) @@ -1880,7 +1879,7 @@ module Anonymous = struct in {vs with anonymous_state} - let check_drain_delegate info ~should_check_signature + let check_drain_delegate info ~check_signature (operation : Kind.drain_delegate Operation.t) = let open Lwt_tzresult_syntax in let (Single (Drain_delegate {delegate; destination; consensus_key})) = @@ -1938,7 +1937,7 @@ module Anonymous = struct {delegate; destination; min_amount}) in let*? () = - if should_check_signature then + if check_signature then Operation.check_signature active_pk.consensus_pk info.chain_id operation else ok_unit in @@ -2189,7 +2188,7 @@ module Manager = struct key. This includes the case where the key ends up not being used because the signature check is skipped in {!validate_manager_operation} called with - [~should_check_signature:false]. Indeed, the mempool may use + [~check_signature:false]. Indeed, the mempool may use this argument when it has already checked the signature of the operation in the past; but if there has been a branch reorganization since then, the key might not be revealed in @@ -2341,7 +2340,7 @@ module Manager = struct let may_trace_gas_limit_too_high info = match info.mode with - | Application _ | Partial_application _ | Construction _ -> fun x -> x + | Application _ | Partial_validation _ | Construction _ -> fun x -> x | Mempool -> (* [Gas.check_limit] will only raise a "temporary" error, however when @@ -2480,7 +2479,7 @@ module Manager = struct in check_contents_list vi batch_state tail remaining_gas - let check_manager_operation vi ~should_check_signature + let check_manager_operation vi ~check_signature (operation : _ Kind.manager operation) remaining_block_gas = let open Lwt_tzresult_syntax in let contents_list = operation.protocol_data.contents in @@ -2491,7 +2490,7 @@ module Manager = struct check_contents_list vi batch_state contents_list remaining_block_gas in let*? () = - if should_check_signature then + if check_signature then Operation.check_signature source_pk vi.chain_id operation else ok_unit in @@ -2555,7 +2554,7 @@ module Manager = struct let may_update_remaining_gas_used mode (block_state : block_state) operation_gas_used = match mode with - | Application _ | Partial_application _ | Construction _ -> + | Application _ | Partial_validation _ | Construction _ -> let remaining_block_gas = Gas.Arith.(sub block_state.remaining_block_gas operation_gas_used) in @@ -2575,13 +2574,13 @@ module Manager = struct in {vs with manager_state = {managers_seen}} - let validate_manager_operation ~should_check_signature info operation_state + let validate_manager_operation ~check_signature info operation_state block_state oph operation = let open Lwt_tzresult_syntax in let* gas_used = check_manager_operation info - ~should_check_signature + ~check_signature operation block_state.remaining_block_gas in @@ -2612,8 +2611,8 @@ let init_validation_state ctxt mode chain_id all_expected_consensus_features established by the protocol - the size of an operation does not exceed [max_operation_data_length] *) -let begin_application ctxt chain_id ~predecessor_level ~predecessor_timestamp - (block_header : Block_header.t) fitness ~is_partial = +let begin_any_application ctxt chain_id ~predecessor_level + ~predecessor_timestamp (block_header : Block_header.t) fitness ~is_partial = let open Lwt_tzresult_syntax in let predecessor_round = Fitness.predecessor_round fitness in let round = Fitness.round fitness in @@ -2655,7 +2654,7 @@ let begin_application ctxt chain_id ~predecessor_level ~predecessor_timestamp } in let mode = - if is_partial then Partial_application application_info + if is_partial then Partial_validation application_info else Application application_info in let all_expected_consensus_features = @@ -2676,10 +2675,10 @@ let begin_application ctxt chain_id ~predecessor_level ~predecessor_timestamp all_expected_consensus_features ~predecessor_level) -let begin_partial_application ~ancestor_context chain_id ~predecessor_level - ~predecessor_timestamp (block_header : Block_header.t) fitness = - begin_application - ancestor_context +let begin_partial_validation ctxt chain_id ~predecessor_level + ~predecessor_timestamp block_header fitness = + begin_any_application + ctxt chain_id ~predecessor_level ~predecessor_timestamp @@ -2688,8 +2687,8 @@ let begin_partial_application ~ancestor_context chain_id ~predecessor_level ~is_partial:true let begin_application ctxt chain_id ~predecessor_level ~predecessor_timestamp - (block_header : Block_header.t) fitness = - begin_application + block_header fitness = + begin_any_application ctxt chain_id ~predecessor_level @@ -2795,26 +2794,25 @@ let begin_no_predecessor_info ctxt chain_id = all_expected_consensus_features ~predecessor_level -let check_operation info ?(should_check_signature = true) (type kind) +let check_operation ?(check_signature = true) info (type kind) (operation : kind operation) : unit tzresult Lwt.t = let open Lwt_tzresult_syntax in match operation.protocol_data.contents with | Single (Preendorsement _) -> let* (_voting_power : int) = - Consensus.check_preendorsement info ~should_check_signature operation + Consensus.check_preendorsement info ~check_signature operation in return_unit | Single (Endorsement _) -> let* (_kind : Consensus.endorsement_kind) = - Consensus.check_endorsement info ~should_check_signature operation + Consensus.check_endorsement info ~check_signature operation in return_unit | Single (Dal_slot_availability _) -> Consensus.check_dal_slot_availability info operation | Single (Proposals _) -> - Voting.check_proposals info ~should_check_signature operation - | Single (Ballot _) -> - Voting.check_ballot info ~should_check_signature operation + Voting.check_proposals info ~check_signature operation + | Single (Ballot _) -> Voting.check_ballot info ~check_signature operation | Single (Activate_account _) -> Anonymous.check_activate_account info operation | Single (Double_preendorsement_evidence _) -> @@ -2824,7 +2822,7 @@ let check_operation info ?(should_check_signature = true) (type kind) | Single (Double_baking_evidence _) -> Anonymous.check_double_baking_evidence info operation | Single (Drain_delegate _) -> - Anonymous.check_drain_delegate info ~should_check_signature operation + Anonymous.check_drain_delegate info ~check_signature operation | Single (Seed_nonce_revelation _) -> Anonymous.check_seed_nonce_revelation info operation | Single (Vdf_revelation _) -> Anonymous.check_vdf_revelation info operation @@ -2835,7 +2833,7 @@ let check_operation info ?(should_check_signature = true) (type kind) let* (_remaining_gas : Gas.Arith.fp) = Manager.check_manager_operation info - ~should_check_signature + ~check_signature operation remaining_gas in @@ -2847,7 +2845,7 @@ let check_operation info ?(should_check_signature = true) (type kind) let* (_remaining_gas : Gas.Arith.fp) = Manager.check_manager_operation info - ~should_check_signature + ~check_signature operation remaining_gas in @@ -3017,7 +3015,7 @@ let check_validation_pass_consistency vi vs validation_pass = let open Lwt_tzresult_syntax in match vi.mode with | Mempool | Construction _ -> return vs - | Application _ | Partial_application _ -> ( + | Application _ | Partial_validation _ -> ( match (vs.last_op_validation_pass, validation_pass) with | None, validation_pass -> return {vs with last_op_validation_pass = validation_pass} @@ -3045,8 +3043,9 @@ let record_operation vs ophash validation_pass_opt = recorded_operations_rev = ophash :: vs.recorded_operations_rev; } -let validate_operation {info; operation_state; block_state} - ?(should_check_signature = true) oph (packed_operation : packed_operation) = +let validate_operation ?(check_signature = true) + {info; operation_state; block_state} oph + (packed_operation : packed_operation) = let open Lwt_tzresult_syntax in let {shell; protocol_data = Operation_data protocol_data} = packed_operation @@ -3060,16 +3059,16 @@ let validate_operation {info; operation_state; block_state} let block_state = record_operation block_state oph validation_pass_opt in let operation : _ Alpha_context.operation = {shell; protocol_data} in match (info.mode, validation_pass_opt) with - | Partial_application _, Some n + | Partial_validation _, Some n when Compare.Int.(n <> Operation_repr.consensus_pass) -> - (* Do not validate non-consensus operation in [Partial_application] mode *) + (* Do not validate non-consensus operation in [Partial_validation] mode *) return {info; operation_state; block_state} - | Partial_application _, _ | Mempool, _ | Construction _, _ | Application _, _ + | Partial_validation _, _ | Mempool, _ | Construction _, _ | Application _, _ -> ( match operation.protocol_data.contents with | Single (Preendorsement _) -> Consensus.validate_preendorsement - ~should_check_signature + ~check_signature info operation_state block_state @@ -3077,7 +3076,7 @@ let validate_operation {info; operation_state; block_state} operation | Single (Endorsement _) -> Consensus.validate_endorsement - ~should_check_signature + ~check_signature info operation_state block_state @@ -3096,7 +3095,7 @@ let validate_operation {info; operation_state; block_state} return {info; operation_state; block_state} | Single (Proposals _) -> let open Voting in - let* () = check_proposals info ~should_check_signature operation in + let* () = check_proposals info ~check_signature operation in let*? () = check_proposals_conflict operation_state oph operation |> wrap_proposals_conflict @@ -3105,7 +3104,7 @@ let validate_operation {info; operation_state; block_state} return {info; operation_state; block_state} | Single (Ballot _) -> let open Voting in - let* () = check_ballot info ~should_check_signature operation in + let* () = check_ballot info ~check_signature operation in let*? () = check_ballot_conflict operation_state oph operation |> wrap_ballot_conflict @@ -3164,9 +3163,7 @@ let validate_operation {info; operation_state; block_state} return {info; operation_state; block_state} | Single (Drain_delegate _) -> let open Anonymous in - let* () = - check_drain_delegate info ~should_check_signature operation - in + let* () = check_drain_delegate info ~check_signature operation in let*? () = check_drain_delegate_conflict operation_state oph operation |> wrap_drain_delegate_conflict operation @@ -3197,7 +3194,7 @@ let validate_operation {info; operation_state; block_state} return {info; operation_state; block_state} | Single (Manager_operation _) -> Manager.validate_manager_operation - ~should_check_signature + ~check_signature info operation_state block_state @@ -3205,7 +3202,7 @@ let validate_operation {info; operation_state; block_state} operation | Cons (Manager_operation _, _) -> Manager.validate_manager_operation - ~should_check_signature + ~check_signature info operation_state block_state @@ -3283,7 +3280,7 @@ let finalize_block {info; block_state; _} = fitness in return_unit - | Partial_application _ -> + | Partial_validation _ -> let* are_endorsements_required = are_endorsements_required info in let*? () = if are_endorsements_required then diff --git a/src/proto_alpha/lib_protocol/validate.mli b/src/proto_alpha/lib_protocol/validate.mli index e38a68c5ef0eaee18f0504b02ec5f00d588a6677..5bf2650d14f11a49149d79d31800d1589ffdedfd 100644 --- a/src/proto_alpha/lib_protocol/validate.mli +++ b/src/proto_alpha/lib_protocol/validate.mli @@ -62,6 +62,11 @@ type validation_state = { block_state : block_state; } +(** Return the context stored in the state. Note that this is the + context at the beginning of the block / mempool: indeed, it is not + modified by [validate_operation]. *) +val get_initial_ctxt : validation_state -> context + (** Initialize the {!info} and {!state} for the validation of an existing block (in preparation for its future application). *) val begin_application : @@ -74,9 +79,14 @@ val begin_application : validation_state tzresult Lwt.t (** Initialize the {!info} and {!state} for the partial validation of - an existing block. *) -val begin_partial_application : - ancestor_context:context -> + an existing block. + + Note that the given context may be based on an ancestor + block. Indeed, we may not have access to the predecessor context + when trying to quickly assess a series of blocks in a cousin branch + (multipass validation). *) +val begin_partial_validation : + context -> Chain_id.t -> predecessor_level:Level.t -> predecessor_timestamp:Time.t -> @@ -163,7 +173,7 @@ val begin_no_predecessor_info : context -> Chain_id.t -> validation_state validation of such an operation must ensure that its application will fully succeed. - @param should_check_signature indicates whether the signature + @param check_signature indicates whether the signature check should happen. It defaults to [true] because the signature needs to be correct for the operation to be valid. This argument exists for special cases where it is acceptable to bypass this @@ -172,14 +182,14 @@ val begin_no_predecessor_info : context -> Chain_id.t -> validation_state - The mempool may keep track of operations whose signatures have already been checked: if such an operation needs to be validated again (typically when the head block changes), then the mempool may - call [validate_operation] with [should_check_signature:false]. + call [validate_operation] with [check_signature:false]. - The [run_operation] RPC provided by the plugin explicitly excludes signature checks: see its documentation in [lib_plugin/RPC.Scripts.S.run_operation]. *) val validate_operation : + ?check_signature:bool -> validation_state -> - ?should_check_signature:bool -> Operation_hash.t -> packed_operation -> validation_state tzresult Lwt.t @@ -189,7 +199,7 @@ val validate_operation : Note: Should only be called in mempool mode *) val check_operation : - info -> ?should_check_signature:bool -> 'kind operation -> unit tzresult Lwt.t + ?check_signature:bool -> info -> 'kind operation -> unit tzresult Lwt.t (** Check that the operation does not conflict with other operations already validated and included in the {!operation_conflict_state} diff --git a/src/proto_demo_counter/lib_protocol/main.ml b/src/proto_demo_counter/lib_protocol/main.ml index eb30b8387c8ab98cbc8708ff5668802bd5e30629..07551afdf8d3ef0f1dce072848abd1a01796efff 100644 --- a/src/proto_demo_counter/lib_protocol/main.ml +++ b/src/proto_demo_counter/lib_protocol/main.ml @@ -64,29 +64,47 @@ type operation = { type validation_state = {context : Context.t; fitness : Fitness.t} -let begin_application ~chain_id:_ ~predecessor_context:context - ~predecessor_timestamp:_ ~predecessor_fitness (raw_block : block_header) = - let fitness = raw_block.shell.fitness in - Logging.log Notice - "begin_application: pred_fitness = %a block_fitness = %a%!" +type application_state = validation_state + +type mode = + | Application of block_header + | Partial_validation of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } + +let mode_str = function + | Application _ -> "application" + | Partial_validation _ -> "partial_validation" + | Construction _ -> "construction" + | Partial_construction _ -> "partial_construction" + +let validation_or_application_str = function + | `Validation -> "validation" + | `Application -> "application" + +let begin_any_application_mode validation_or_application mode context + ~(predecessor : Block_header.shell_header) (block_header : block_header) = + let fitness = block_header.shell.fitness in + Logging.log + Notice + "begin_%s (%s mode): pred_fitness = %a block_fitness = %a%!" + (validation_or_application_str validation_or_application) + (mode_str mode) Fitness.pp - predecessor_fitness + predecessor.fitness Fitness.pp fitness ; (* Note: Logging is only available for debugging purposes and should not appear in a real protocol. *) return {context; fitness} -let begin_partial_application ~chain_id ~ancestor_context - ~predecessor_timestamp ~predecessor_fitness block_header = - Logging.log Notice "begin_partial_application%!" ; - begin_application - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp - ~predecessor_fitness - block_header - (* we use here the same fitness format than proto alpha, but with higher [version_number] to allow testing migration from alpha to demo_counter. *) @@ -98,57 +116,94 @@ let int64_to_bytes i = b let fitness_from_level level = - [Bytes.of_string version_number; - Bytes.of_string "\000"; - Bytes.of_string "\000"; - Bytes.of_string "\000"; - int64_to_bytes level] - -let begin_construction ~chain_id:_ ~predecessor_context:context - ~predecessor_timestamp:_ ~predecessor_level ~predecessor_fitness - ~predecessor:_ ~timestamp:_ ?protocol_data () = - let fitness = fitness_from_level Int64.(succ (of_int32 predecessor_level)) in - let mode = - match protocol_data with Some _ -> "block" | None -> "mempool" - in - Logging.log Notice - "begin_construction (%s): pred_fitness = %a constructed fitness = %a%!" - mode + [ + Bytes.of_string version_number; + Bytes.of_string "\000"; + Bytes.of_string "\000"; + Bytes.of_string "\000"; + int64_to_bytes level; + ] + +let begin_any_construction_mode validation_or_application mode context + ~(predecessor : Block_header.shell_header) = + let fitness = fitness_from_level Int64.(succ (of_int32 predecessor.level)) in + Logging.log + Notice + "begin_%s (%s mode): pred_fitness = %a constructed fitness = %a%!" + (validation_or_application_str validation_or_application) + (mode_str mode) Fitness.pp - predecessor_fitness + predecessor.fitness Fitness.pp fitness ; return {context; fitness} -let apply_operation validation_state operation = - Logging.log Notice "apply_operation" ; - let {context; fitness} = validation_state in - State.get_state context - >>= fun state -> +let begin_validation_or_application validation_or_application ctxt _chain_id + mode ~predecessor = + match mode with + | Application block_header | Partial_validation block_header -> + begin_any_application_mode + validation_or_application + mode + ctxt + ~predecessor + block_header + | Construction _ | Partial_construction _ -> + begin_any_construction_mode + validation_or_application + mode + ctxt + ~predecessor + +let begin_validation = begin_validation_or_application `Validation + +let begin_application = begin_validation_or_application `Application + +let apply_operation_aux application_state operation = + let {context; fitness} = application_state in + State.get_state context >>= fun state -> match Apply.apply state operation.protocol_data with - | None -> - Error_monad.fail Error.Invalid_operation + | None -> Error_monad.fail Error.Invalid_operation | Some state -> - let receipt = Receipt.create "operation applied successfully" in - State.update_state context state - >>= fun context -> return ({context; fitness}, receipt) - -let finalize_block validation_state _header = - let fitness = validation_state.fitness in - Logging.log Notice "finalize_block: fitness = %a%!" Fitness.pp fitness ; - let fitness = validation_state.fitness in + State.update_state context state >>= fun context -> + return {context; fitness} + +let validate_operation ?check_signature:_ validation_state _oph operation = + Logging.log Notice "validate_operation" ; + apply_operation_aux validation_state operation + +let apply_operation application_state _oph operation = + Logging.log Notice "apply_operation" ; + apply_operation_aux application_state operation >>=? fun application_state -> + let receipt = Receipt.create "operation applied successfully" in + return (application_state, receipt) + +let log_finalize validation_or_application validation_state = + Logging.log + Notice + "finalize_%s: fitness = %a%!" + (validation_or_application_str validation_or_application) + Fitness.pp + validation_state.fitness + +let finalize_validation validation_state = + log_finalize `Validation validation_state ; + return_unit + +let finalize_application application_state _shell_header = + log_finalize `Application application_state ; + let fitness = application_state.fitness in let message = Some (Format.asprintf "fitness <- %a" Fitness.pp fitness) in - let context = validation_state.context in - State.get_state context - >>= fun state -> + let context = application_state.context in + State.get_state context >>= fun state -> return ( { - Updater.message; - context; - fitness; - max_operations_ttl = 0; - last_allowed_fork_level = 0l; - }, + Updater.message; + context; + fitness; + max_operations_ttl = 0; + last_allowed_fork_level = 0l; + }, state ) let decode_json json = @@ -235,7 +290,7 @@ module Mempool = struct | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ = Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit diff --git a/src/proto_demo_noops/lib_protocol/main.ml b/src/proto_demo_noops/lib_protocol/main.ml index 977cbcd8b15a812dd6fd5690a3be429295186e95..93394ecbd1d5cafb4e9e133d5eaa0b08d58a8e98 100644 --- a/src/proto_demo_noops/lib_protocol/main.ml +++ b/src/proto_demo_noops/lib_protocol/main.ml @@ -68,19 +68,20 @@ let compare_operations _ _ = 0 type validation_state = {context : Context.t; fitness : Fitness.t} -let begin_application ~chain_id:_ ~predecessor_context:context - ~predecessor_timestamp:_ ~predecessor_fitness:_ (raw_block : block_header) = - let fitness = raw_block.shell.fitness in - return {context; fitness} - -let begin_partial_application ~chain_id ~ancestor_context ~predecessor_timestamp - ~predecessor_fitness block_header = - begin_application - ~chain_id - ~predecessor_context:ancestor_context - ~predecessor_timestamp - ~predecessor_fitness - block_header +type application_state = validation_state + +type mode = + | Application of block_header + | Partial_validation of block_header + | Construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + block_header_data : block_header_data; + } + | Partial_construction of { + predecessor_hash : Block_hash.t; + timestamp : Time.t; + } let version_number = "\001" @@ -92,15 +93,19 @@ let int64_to_bytes i = let fitness_from_level level = [Bytes.of_string version_number; int64_to_bytes level] -let begin_construction ~chain_id:_ ~predecessor_context:context - ~predecessor_timestamp:_ ~predecessor_level ~predecessor_fitness:_ - ~predecessor:_ ~timestamp:_ ?protocol_data () = - let fitness = fitness_from_level Int64.(succ (of_int32 predecessor_level)) in - let _mode = - match protocol_data with Some _ -> "block" | None -> "mempool" +let begin_validation context _chain_id mode + ~(predecessor : Block_header.shell_header) = + let fitness = + match mode with + | Application block_header | Partial_validation block_header -> + block_header.shell.fitness + | Construction _ | Partial_construction _ -> + fitness_from_level Int64.(succ (of_int32 predecessor.level)) in return {context; fitness} +let begin_application = begin_validation + type error += No_error let () = @@ -114,18 +119,21 @@ let () = (function No_error -> Some () | _ -> None) (fun () -> No_error) -let apply_operation _state _op = fail No_error +let validate_operation ?check_signature:_ _state _oph _op = fail No_error + +let apply_operation _state _oph _op = fail No_error -let finalize_block state _ = - let fitness = state.fitness in +let finalize_validation _state = return_unit + +let finalize_application application_state _shell_header = return ( { - Updater.message = None; - context = state.context; - fitness; - max_operations_ttl = 0; - last_allowed_fork_level = 0l; - }, + Updater.message = None; + context = application_state.context; + fitness = application_state.fitness; + max_operations_ttl = 0; + last_allowed_fork_level = 0l; + }, () ) let init _chain_id context block_header = @@ -177,7 +185,7 @@ module Mempool = struct | Incompatible_mempool | Merge_conflict of operation_conflict - let init _ _ ~head_hash:_ ~head_header:_ ~current_timestamp:_ = Lwt.return_ok ((), ()) + let init _ _ ~head_hash:_ ~head:_ = Lwt.return_ok ((), ()) let encoding = Data_encoding.unit diff --git a/tezt/tests/precheck.ml b/tezt/tests/precheck.ml index 5c1fdec627651043731e79adde47e1a106f4afa8..15574700297cd42fab3c7ee27ca8b3319d891571 100644 --- a/tezt/tests/precheck.ml +++ b/tezt/tests/precheck.ml @@ -276,12 +276,12 @@ let propagate_precheckable_bad_block = (* activation block + four blocks + the final bake *) wait_for_cluster_at_level cluster (1 + blocks_to_bake + 1) -let propagate_precheckable_bad_block_signature = +let propagate_precheckable_bad_block_payload = let blocks_to_bake = 4 in Protocol.register_test ~__FILE__ - ~title:"forge block with wrong signature" - ~tags:["precheck"; "fake_block"; "propagation"; "signature"] + ~title:"forge block with wrong payload" + ~tags:["precheck"; "fake_block"; "propagation"; "payload"] @@ fun protocol -> (* Expected topology is : N3 @@ -291,14 +291,14 @@ let propagate_precheckable_bad_block_signature = N4 *) Log.info "Setting up the node topology" ; - let n1 = Node.create [] in + let node_client = Node.create [] in let ring = Cluster.create ~name:"ring" 4 [Private_mode; Synchronisation_threshold 0] in let n2 = List.hd ring in Cluster.ring ring ; - Cluster.connect [n1] [n2] ; - let cluster = n1 :: ring in + Cluster.connect [node_client] [n2] ; + let cluster = node_client :: ring in Log.info "Starting up cluster" ; let* () = Cluster.start @@ -307,7 +307,7 @@ let propagate_precheckable_bad_block_signature = cluster in Log.info "Cluster initialized" ; - let* client = Client.(init ~endpoint:(Node n1) ()) in + let* client = Client.(init ~endpoint:(Node node_client) ()) in let* () = Client.activate_protocol ~protocol client in let bootstrap1 = Constant.bootstrap1.alias in let* () = @@ -317,8 +317,12 @@ let propagate_precheckable_bad_block_signature = let* () = Client.bake_for_and_wait ~keys:[bootstrap1] client in wait_for_cluster_at_level cluster i) in - let* op_block_header = forge_block ~client n1 ~key:bootstrap1 ~with_op:true in - let* block_header = forge_block ~client n1 ~key:bootstrap1 ~with_op:false in + let* op_block_header = + forge_block ~client node_client ~key:bootstrap1 ~with_op:true + in + let* block_header = + forge_block ~client node_client ~key:bootstrap1 ~with_op:false + in (* Put a bad context *) Log.info "Crafting a block header with a bad context hash" ; let bad_block_header = @@ -338,12 +342,12 @@ let propagate_precheckable_bad_block_signature = let unsigned_bad_block_header_hex = String.sub bad_block_header_hex 0 (String.length bad_block_header_hex - 128) in - let* bad_signature = + let* signature = Client.sign_block client unsigned_bad_block_header_hex ~delegate:bootstrap1 >>= fun s -> String.trim s |> return in let signed_bad_block_header_hex = - String.concat "" [unsigned_bad_block_header_hex; bad_signature] + String.concat "" [unsigned_bad_block_header_hex; signature] in let injection_json = `O @@ -367,9 +371,18 @@ let propagate_precheckable_bad_block_signature = else Test.fail "The block was not expected to be prechecked"); ] in - (* Wait all nodes to precheck the block but fail on validation *) + let expect_precheck_failure node = + Node.wait_for node "precheck_failure.v0" (fun _ -> Some ()) + in let precheck_waiter = - Lwt_list.iter_p wait_precheck_but_validation_fail cluster + if Protocol.(protocol <= Kathmandu) then + (* On Kathmandu and below: wait all nodes to precheck the block + but fail on validation *) + Lwt_list.iter_p wait_precheck_but_validation_fail cluster + else + (* Post Kathmandu: the precheck is not an over-approximation + anymore and cannot even be considered precheckable. *) + expect_precheck_failure node_client in let p = Client.spawn_rpc ~data:injection_json POST ["injection"; "block"] client @@ -378,7 +391,7 @@ let propagate_precheckable_bad_block_signature = let* () = Lwt.pick [ - ( Lwt_unix.sleep 30. >>= fun () -> + ( Lwt_unix.sleep 10. >>= fun () -> Test.fail "timeout while waiting for precheck" ); precheck_waiter; ] @@ -400,4 +413,4 @@ let propagate_precheckable_bad_block_signature = let register ~protocols = precheck_block protocols ; propagate_precheckable_bad_block protocols ; - propagate_precheckable_bad_block_signature protocols + propagate_precheckable_bad_block_payload protocols