diff --git a/src/bin_client/test/demo/main.ml b/src/bin_client/test/demo/main.ml index e28bd2ad8..9758bbecf 100644 --- a/src/bin_client/test/demo/main.ml +++ b/src/bin_client/test/demo/main.ml @@ -15,12 +15,17 @@ type block_header = { let block_header_data_encoding = Data_encoding.(obj1 (req "random_data" Variable.bytes)) +type block_header_metadata = unit +let block_header_metadata_encoding = Data_encoding.unit + type operation_data = unit type operation = { shell : Operation.shell_header ; protocol_data : operation_data ; } let operation_data_encoding = Data_encoding.unit +type operation_metadata = unit +let operation_metadata_encoding = Data_encoding.unit let max_block_length = 42 let validation_passes = [] @@ -91,16 +96,16 @@ let begin_construction return { context ; fitness } let apply_operation ctxt _ = - return ctxt + return (ctxt, ()) let finalize_block ctxt = let fitness = Fitness.get ctxt in let message = Some (Format.asprintf "fitness <- %Ld" fitness) in let fitness = Fitness.from_int64 fitness in - return { Updater.message ; context = ctxt.context ; fitness ; - max_operations_ttl = 0 ; max_operation_data_length = 0 ; - last_allowed_fork_level = 0l ; - } + return ({ Updater.message ; context = ctxt.context ; fitness ; + max_operations_ttl = 0 ; max_operation_data_length = 0 ; + last_allowed_fork_level = 0l ; + }, ()) let rpc_services = RPC_directory.empty diff --git a/src/bin_client/test/test_injection.sh b/src/bin_client/test/test_injection.sh index 3a58ac89b..38f00315f 100755 --- a/src/bin_client/test/test_injection.sh +++ b/src/bin_client/test/test_injection.sh @@ -14,7 +14,7 @@ show_logs="no" sleep 2 # autogenerated from the demo source -protocol_version="PsbyjqSF59ENfaQxUcRqVa4DXjzUG8gP2NVEGiXpN3GntcXrV8Q" +protocol_version="PtamL2BUfeNFM2A8Thq2Wde8vNaVD9DhoARDVB41QsHFj89kQpT" $admin_client inject protocol "$test_dir/demo" $admin_client list protocols diff --git a/src/lib_protocol_environment/sigs/v1/updater.mli b/src/lib_protocol_environment/sigs/v1/updater.mli index 1e1d77d8b..aa165e57a 100644 --- a/src/lib_protocol_environment/sigs/v1/updater.mli +++ b/src/lib_protocol_environment/sigs/v1/updater.mli @@ -79,6 +79,12 @@ module type PROTOCOL = sig protocol_data: block_header_data ; } + (** ... *) + type block_header_metadata + + (** ... *) + val block_header_metadata_encoding: block_header_metadata Data_encoding.t + (** The version specific type of operations. *) type operation_data @@ -91,6 +97,12 @@ module type PROTOCOL = sig protocol_data: operation_data ; } + (** ... *) + type operation_metadata + + (** ... *) + val operation_metadata_encoding: operation_metadata Data_encoding.t + (** The Validation passes in which an operation can appear. For instance [[0]] if it only belongs to the first pass. An answer of [[]] means that the operation is ill-formed @@ -160,13 +172,16 @@ module type PROTOCOL = sig (** Called after {!begin_application} (or {!begin_construction}) and before {!finalize_block}, with each operation in the block. *) val apply_operation: - validation_state -> operation -> validation_state tzresult Lwt.t + validation_state -> + operation -> + (validation_state * operation_metadata) tzresult Lwt.t (** The last step in a block validation sequence. It produces the context that will be used as input for the validation of its successor block candidates. *) val finalize_block: - validation_state -> validation_result tzresult Lwt.t + validation_state -> + (validation_result * block_header_metadata) tzresult Lwt.t (** The list of remote procedures exported by this implementation *) val rpc_services: rpc_context Lwt.t RPC_directory.t diff --git a/src/lib_protocol_environment/tezos_protocol_environment.ml b/src/lib_protocol_environment/tezos_protocol_environment.ml index a28bd00e0..9c5b1625d 100644 --- a/src/lib_protocol_environment/tezos_protocol_environment.ml +++ b/src/lib_protocol_environment/tezos_protocol_environment.ml @@ -67,12 +67,16 @@ module Make (Context : CONTEXT) = struct shell: Block_header.shell_header ; protocol_data: block_header_data ; } + type block_header_metadata + val block_header_metadata_encoding: block_header_metadata Data_encoding.t type operation_data val operation_data_encoding: operation_data Data_encoding.t type operation = { shell: Operation.shell_header ; protocol_data: operation_data ; } + type operation_metadata + val operation_metadata_encoding: operation_metadata Data_encoding.t val acceptable_passes: operation -> int list val compare_operations: operation -> operation -> int type validation_state @@ -98,9 +102,11 @@ module Make (Context : CONTEXT) = struct ?protocol_data: block_header_data -> unit -> validation_state tzresult Lwt.t val apply_operation: - validation_state -> operation -> validation_state tzresult Lwt.t + validation_state -> operation -> + (validation_state * operation_metadata) tzresult Lwt.t val finalize_block: - validation_state -> validation_result tzresult Lwt.t + validation_state -> + (validation_result * block_header_metadata) tzresult Lwt.t val rpc_services: rpc_context Lwt.t RPC_directory.t val init: context -> Block_header.shell_header -> validation_result tzresult Lwt.t diff --git a/src/lib_protocol_environment/tezos_protocol_environment.mli b/src/lib_protocol_environment/tezos_protocol_environment.mli index b58539a73..5f58646eb 100644 --- a/src/lib_protocol_environment/tezos_protocol_environment.mli +++ b/src/lib_protocol_environment/tezos_protocol_environment.mli @@ -60,12 +60,16 @@ module Make (Context : CONTEXT) : sig shell: Block_header.shell_header ; protocol_data: block_header_data ; } + type block_header_metadata + val block_header_metadata_encoding: block_header_metadata Data_encoding.t type operation_data val operation_data_encoding: operation_data Data_encoding.t type operation = { shell: Operation.shell_header ; protocol_data: operation_data ; } + type operation_metadata + val operation_metadata_encoding: operation_metadata Data_encoding.t val acceptable_passes: operation -> int list val compare_operations: operation -> operation -> int type validation_state @@ -91,9 +95,11 @@ module Make (Context : CONTEXT) : sig ?protocol_data: block_header_data -> unit -> validation_state tzresult Lwt.t val apply_operation: - validation_state -> operation -> validation_state tzresult Lwt.t + validation_state -> operation -> + (validation_state * operation_metadata) tzresult Lwt.t val finalize_block: - validation_state -> validation_result tzresult Lwt.t + validation_state -> + (validation_result * block_header_metadata) tzresult Lwt.t val rpc_services: rpc_context Lwt.t RPC_directory.t val init: context -> Block_header.shell_header -> validation_result tzresult Lwt.t diff --git a/src/lib_shell/block_validator.ml b/src/lib_shell/block_validator.ml index 5bdbea669..bde7e7797 100644 --- a/src/lib_shell/block_validator.ml +++ b/src/lib_shell/block_validator.ml @@ -180,10 +180,10 @@ let apply_block ~predecessor_fitness:pred_header.shell.fitness header >>=? fun state -> fold_left_s (fold_left_s (fun state op -> - Proto.apply_operation state op >>=? fun state -> + Proto.apply_operation state op >>=? fun (state, _metadata) -> return state)) state parsed_operations >>=? fun state -> - Proto.finalize_block state >>=? fun validation_result -> + Proto.finalize_block state >>=? fun (validation_result, _metadata) -> Context.get_protocol validation_result.context >>= fun new_protocol -> let expected_proto_level = if Protocol_hash.equal new_protocol Proto.hash then diff --git a/src/lib_shell/prevalidation.ml b/src/lib_shell/prevalidation.ml index 6d4964181..647a60e6b 100644 --- a/src/lib_shell/prevalidation.ml +++ b/src/lib_shell/prevalidation.ml @@ -14,7 +14,7 @@ let rec apply_operations apply_operation state r max_ops ~sort ops = Lwt_list.fold_left_s (fun (state, max_ops, r) (hash, op, parsed_op) -> apply_operation state max_ops op parsed_op >>= function - | Ok state -> + | Ok (state, _metadata) -> let applied = (hash, op) :: r.applied in Lwt.return (state, max_ops - 1, { r with applied }) | Error errors -> @@ -164,4 +164,5 @@ let prevalidate r) let end_prevalidation (State { proto = (module Proto) ; state }) = - Proto.finalize_block state + Proto.finalize_block state >>=? fun (result, _metadata) -> + return result diff --git a/src/lib_shell/test/test_state.ml b/src/lib_shell/test/test_state.ml index 422d31dae..9ca3c5705 100644 --- a/src/lib_shell/test/test_state.ml +++ b/src/lib_shell/test/test_state.ml @@ -101,7 +101,7 @@ let build_valid_chain state vtbl pred names = (parsed_block block) >>=? fun vstate -> (* no operations *) Proto.finalize_block vstate - end >>=? fun ctxt -> + end >>=? fun (ctxt, _metadata) -> State.Block.store state block [[op]] ctxt >>=? fun _vblock -> State.Block.read state hash >>=? fun vblock -> Hashtbl.add vtbl name vblock ; diff --git a/src/lib_shell_services/block_services.mli b/src/lib_shell_services/block_services.mli index 089fa9f47..e9cd02bab 100644 --- a/src/lib_shell_services/block_services.mli +++ b/src/lib_shell_services/block_services.mli @@ -64,7 +64,6 @@ val protocol: val test_chain: #simple -> block -> Test_chain_status.t tzresult Lwt.t - val info: #simple -> ?include_ops:bool -> block -> block_info tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/src/main.ml b/src/proto_alpha/lib_protocol/src/main.ml index 151d2f10b..737c217b1 100644 --- a/src/proto_alpha/lib_protocol/src/main.ml +++ b/src/proto_alpha/lib_protocol/src/main.ml @@ -17,6 +17,9 @@ type block_header = Alpha_context.Block_header.t = { let block_header_data_encoding = Alpha_context.Block_header.protocol_data_encoding +type block_header_metadata = unit +let block_header_metadata_encoding = Data_encoding.unit + type operation_data = Alpha_context.Operation.protocol_data type operation = Alpha_context.Operation.t = { shell: Operation.shell_header ; @@ -25,6 +28,9 @@ type operation = Alpha_context.Operation.t = { let operation_data_encoding = Alpha_context.Operation.protocol_data_encoding +type operation_metadata = unit +let operation_metadata_encoding = Data_encoding.unit + let acceptable_passes = Alpha_context.Operation.acceptable_passes let max_block_length = @@ -124,13 +130,13 @@ let apply_operation ({ mode ; ctxt ; op_count ; _ } as data) operation = Apply.apply_operation ctxt Optimized predecessor (Alpha_context.Operation.hash operation) operation >>=? fun (ctxt, _) -> let op_count = op_count + 1 in - return { data with ctxt ; op_count } + return ({ data with ctxt ; op_count }, ()) let finalize_block { mode ; ctxt ; op_count ; deposit = _ } = match mode with | Partial_construction _ -> let ctxt = Alpha_context.finalize ctxt in - return ctxt + return (ctxt, ()) | Application { baker ; block_header = { protocol_data = { contents = protocol_data ; _ } ; _ } } | Full_construction { protocol_data ; baker ; _ } -> @@ -145,7 +151,7 @@ let finalize_block { mode ; ctxt ; op_count ; deposit = _ } = "lvl %ld, fit %Ld, prio %d, %d ops" level fitness priority op_count in let ctxt = Alpha_context.finalize ~commit_message ctxt in - return ctxt + return (ctxt, ()) let compare_operations op1 op2 = Apply.compare_operations op1 op2 diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml index d30eff927..180a3973d 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml @@ -167,10 +167,12 @@ let make init_block = let (operations,_) = List.split init_block.sourced_operations in begin_construction_pre init_block >>=? fun vs -> Proto_alpha.Error_monad.fold_left_s - Main.apply_operation + (fun ctxt op -> Main.apply_operation ctxt op >>=? fun (ctxt, _) -> return ctxt) vs operations - >>=? Main.finalize_block >>=? get_header_hash init_block + >>=? fun ctxt -> + Main.finalize_block ctxt >>=? fun (ctxt, _) -> + get_header_hash init_block ctxt let make_init psh pbh lvl prio ops ctxt = diff --git a/src/proto_demo/lib_protocol/src/main.ml b/src/proto_demo/lib_protocol/src/main.ml index a587e4ce6..837f8dbd7 100644 --- a/src/proto_demo/lib_protocol/src/main.ml +++ b/src/proto_demo/lib_protocol/src/main.ml @@ -13,15 +13,21 @@ type block_header = { shell : Block_header.shell_header ; protocol_data : block_header_data ; } + let block_header_data_encoding = Data_encoding.(obj1 (req "random_data" Variable.bytes)) +type block_header_metadata = unit +let block_header_metadata_encoding = Data_encoding.unit + type operation_data = unit type operation = { shell : Operation.shell_header ; protocol_data : operation_data ; } let operation_data_encoding = Data_encoding.unit +type operation_metadata = unit +let operation_metadata_encoding = Data_encoding.unit let max_operation_data_length = 42 let max_block_length = 42 @@ -94,16 +100,16 @@ let begin_construction return { context ; fitness } let apply_operation ctxt _ = - return ctxt + return (ctxt, ()) let finalize_block ctxt = let fitness = Fitness.get ctxt in let message = Some (Format.asprintf "fitness <- %Ld" fitness) in let fitness = Fitness.from_int64 fitness in - return { Updater.message ; context = ctxt.context ; fitness ; - max_operations_ttl = 0 ; max_operation_data_length = 0 ; - last_allowed_fork_level = 0l ; - } + return ({ Updater.message ; context = ctxt.context ; fitness ; + max_operations_ttl = 0 ; max_operation_data_length = 0 ; + last_allowed_fork_level = 0l ; + }, ()) let rpc_services = Services.rpc_services diff --git a/src/proto_genesis/lib_protocol/src/main.ml b/src/proto_genesis/lib_protocol/src/main.ml index 2f90c226d..d4d4ca736 100644 --- a/src/proto_genesis/lib_protocol/src/main.ml +++ b/src/proto_genesis/lib_protocol/src/main.ml @@ -37,8 +37,12 @@ type operation = { shell: Operation.shell_header ; protocol_data: operation_data ; } + let operation_data_encoding = Data_encoding.unit +type operation_metadata = unit +let operation_metadata_encoding = Data_encoding.unit + let acceptable_passes _op = [] let compare_operations _ _ = 0 let validation_passes = [] @@ -58,6 +62,9 @@ let block_header_data_encoding = (fun (command, signature) -> { command ; signature }) Data.Command.signed_encoding +type block_header_metadata = unit +let block_header_metadata_encoding = Data_encoding.unit + let max_block_length = Data_encoding.Binary.length Data.Command.encoding @@ -142,7 +149,7 @@ let begin_construction let apply_operation _vctxt _ = Lwt.return (Error []) (* absurd *) -let finalize_block state = return state +let finalize_block state = return (state, ()) let rpc_services = Services.rpc_services