From a731a47d3ca1876641159f419eb08957bf561fc5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 10 Apr 2017 12:14:11 +0200 Subject: [PATCH] Proto: explicit fitness/timestamp in the signature This remove the data fomr the context where they "duplicate" the block header. --- src/node/db/context.ml | 64 ++------------ src/node/db/context.mli | 15 ++-- src/node/shell/node.ml | 39 +++++---- src/node/shell/prevalidation.ml | 7 +- src/node/shell/prevalidation.mli | 2 +- src/node/shell/prevalidator.ml | 2 +- src/node/shell/prevalidator.mli | 2 +- src/node/shell/state.ml | 13 ++- src/node/shell/state.mli | 3 +- src/node/shell/validator.ml | 9 +- src/node/updater/protocol.mli | 86 +++++-------------- src/node/updater/register.ml | 4 + src/node/updater/updater.ml | 20 +++-- src/node/updater/updater.mli | 20 +++-- src/proto/alpha/apply.ml | 17 ++-- src/proto/alpha/fitness_repr.ml | 8 +- src/proto/alpha/fitness_storage.ml | 16 +--- src/proto/alpha/init_storage.ml | 26 +++--- src/proto/alpha/main.ml | 26 ++++-- src/proto/alpha/mining.ml | 6 +- src/proto/alpha/reward_storage.ml | 2 +- src/proto/alpha/script_interpreter.ml | 2 +- src/proto/alpha/services_registration.ml | 19 +++-- src/proto/alpha/storage.ml | 41 ++++----- src/proto/alpha/storage.mli | 16 ++-- src/proto/alpha/storage_functors.ml | 101 ++++++++++++++--------- src/proto/alpha/storage_functors.mli | 7 +- src/proto/alpha/tezos_context.ml | 15 ++-- src/proto/alpha/tezos_context.mli | 23 +++--- src/proto/demo/main.ml | 65 ++++++--------- src/proto/demo/services.ml | 2 +- src/proto/environment/context.mli | 6 -- src/proto/environment/updater.mli | 19 ++++- src/proto/genesis/main.ml | 48 +++++------ src/proto/genesis/services.ml | 2 +- test/proto_alpha/proto_alpha_helpers.ml | 2 +- test/shell/test_context.ml | 2 + test/shell/test_state.ml | 5 +- 38 files changed, 342 insertions(+), 420 deletions(-) diff --git a/src/node/db/context.ml b/src/node/db/context.ml index 54338d8f2..5301d1194 100644 --- a/src/node/db/context.ml +++ b/src/node/db/context.ml @@ -84,15 +84,11 @@ type t = context (*-- Version Access and Update -----------------------------------------------*) let current_protocol_key = ["protocol"] -let current_fitness_key = ["fitness"] -let current_timestamp_key = ["timestamp"] let current_test_protocol_key = ["test_protocol"] let current_test_network_key = ["test_network"] let current_test_network_expiration_key = ["test_network_expiration"] let current_fork_test_network_key = ["fork_test_network"] -let transient_commit_message_key = ["message"] - let exists { repo } key = GitStore.of_branch_id Irmin.Task.none (Block_hash.to_b58check key) repo >>= fun t -> @@ -134,59 +130,17 @@ let exists index key = Block_hash.pp_short key exists >>= fun () -> Lwt.return exists -let get_and_erase_commit_message ctxt = - GitStore.FunView.get ctxt.view transient_commit_message_key >>= function - | None -> Lwt.return (None, ctxt) - | Some bytes -> - GitStore.FunView.del ctxt.view transient_commit_message_key >>= fun view -> - Lwt.return (Some (MBytes.to_string bytes), { ctxt with view }) -let set_commit_message ctxt msg = - GitStore.FunView.set ctxt.view - transient_commit_message_key - (MBytes.of_string msg) >>= fun view -> - Lwt.return { ctxt with view } - -let get_fitness { view } = - GitStore.FunView.get view current_fitness_key >>= function - | None -> assert false - | Some data -> - match Data_encoding.Binary.of_bytes Fitness.encoding data with - | None -> assert false - | Some data -> Lwt.return data -let set_fitness ctxt data = - GitStore.FunView.set ctxt.view current_fitness_key - (Data_encoding.Binary.to_bytes Fitness.encoding data) >>= fun view -> - Lwt.return { ctxt with view } - -let get_timestamp { view } = - GitStore.FunView.get view current_timestamp_key >>= function - | None -> assert false - | Some time -> - Lwt.return (Time.of_notation_exn (MBytes.to_string time)) -let set_timestamp ctxt time = - GitStore.FunView.set ctxt.view current_timestamp_key - (MBytes.of_string (Time.to_notation time)) >>= fun view -> - Lwt.return { ctxt with view } - exception Preexistent_context of Block_hash.t exception Empty_head of Block_hash.t -let commit key context = - get_timestamp context >>= fun timestamp -> - get_fitness context >>= fun fitness -> - let task = - Irmin.Task.create ~date:(Time.to_seconds timestamp) ~owner:"Tezos" in +let commit key ~time ~message context = + let task = Irmin.Task.create ~date:(Time.to_seconds time) ~owner:"Tezos" in GitStore.clone task context.store (Block_hash.to_b58check key) >>= function | `Empty_head -> Lwt.fail (Empty_head key) | `Duplicated_branch -> Lwt.fail (Preexistent_context key) | `Ok store -> - get_and_erase_commit_message context >>= fun (msg, context) -> - let msg = match msg with - | None -> - Format.asprintf "%a %a" - Fitness.pp fitness Block_hash.pp_short key - | Some msg -> msg in - GitStore.FunView.update_path (store msg) [] context.view >>= fun () -> + GitStore.FunView.update_path + (store message) [] context.view >>= fun () -> context.index.commits <- context.index.commits + 1 ; if context.index.commits mod 200 = 0 then Lwt_utils.Idle_waiter.force_idle @@ -267,18 +221,15 @@ let init ?patch_context ~root = } let commit_genesis index ~id:block ~time ~protocol ~test_protocol = + let task = Irmin.Task.create ~date:(Time.to_seconds time) ~owner:"Tezos" in GitStore.of_branch_id - Irmin.Task.none (Block_hash.to_b58check block) + task (Block_hash.to_b58check block) index.repo >>= fun t -> - let store = t () in + let store = t "Genesis" in GitStore.FunView.of_path store [] >>= fun view -> let view = (view, index.repack_scheduler) in - GitStore.FunView.set view current_timestamp_key - (MBytes.of_string (Time.to_notation time)) >>= fun view -> GitStore.FunView.set view current_protocol_key (Protocol_hash.to_bytes protocol) >>= fun view -> - GitStore.FunView.set view current_fitness_key - (Data_encoding.Binary.to_bytes Fitness.encoding []) >>= fun view -> GitStore.FunView.set view current_test_protocol_key (Protocol_hash.to_bytes test_protocol) >>= fun view -> let ctxt = { index ; store ; view } in @@ -334,7 +285,6 @@ let init_test_network v ~time ~genesis = get_test_protocol v >>= fun test_protocol -> del_test_network_expiration v >>= fun v -> set_protocol v test_protocol >>= fun v -> - set_timestamp v time >>= fun v -> let task = Irmin.Task.create ~date:(Time.to_seconds time) diff --git a/src/node/db/context.mli b/src/node/db/context.mli index 67339fcf2..fb81a6477 100644 --- a/src/node/db/context.mli +++ b/src/node/db/context.mli @@ -40,7 +40,11 @@ exception Preexistent_context of Block_hash.t val exists: index -> Block_hash.t -> bool Lwt.t val checkout: index -> Block_hash.t -> context option Lwt.t val checkout_exn: index -> Block_hash.t -> context Lwt.t -val commit: Block_hash.t -> context -> unit Lwt.t +val commit: + Block_hash.t -> + time:Time.t -> + message:string -> + context -> unit Lwt.t (** {2 Predefined Fields} ****************************************************) @@ -58,16 +62,9 @@ val get_test_network_expiration: context -> Time.t option Lwt.t val set_test_network_expiration: context -> Time.t -> context Lwt.t val del_test_network_expiration: context -> context Lwt.t +(* FIXME split in two (reset after commit *) val read_and_reset_fork_test_network: context -> (bool * context) Lwt.t val fork_test_network: context -> context Lwt.t -val set_fitness: context -> Fitness.fitness -> context Lwt.t -val get_fitness: context -> Fitness.fitness Lwt.t - -val set_timestamp: context -> Time.t -> context Lwt.t -val get_timestamp: context -> Time.t Lwt.t - -val set_commit_message: context -> string -> context Lwt.t - val init_test_network: context -> time:Time.t -> genesis:Block_hash.t -> context tzresult Lwt.t diff --git a/src/node/shell/node.ml b/src/node/shell/node.ml index bc5304276..40c7211ad 100644 --- a/src/node/shell/node.ml +++ b/src/node/shell/node.ml @@ -278,9 +278,8 @@ module RPC = struct State.Valid_block.Current.head net_state >>= fun head -> Prevalidator.context pv >>= function | Error _ -> Lwt.fail Not_found - | Ok ctxt -> - Context.get_fitness ctxt >>= fun fitness -> - Context.get_protocol ctxt >>= fun protocol -> + | Ok { context ; fitness } -> + Context.get_protocol context >>= fun protocol -> let operations = let pv_result, _ = Prevalidator.operations pv in Some [ pv_result.applied ] in @@ -291,29 +290,36 @@ module RPC = struct protocol = Some protocol ; fitness ; operations ; timestamp } - let get_context node block = + let rpc_context block : Updater.rpc_context = + { context = block.State.Valid_block.context ; + fitness = block.fitness ; + timestamp = block. timestamp } + + let get_rpc_context node block = match block with | `Genesis -> State.Valid_block.Current.genesis node.mainnet_net >>= fun block -> - Lwt.return (Some block.context) + Lwt.return (Some (rpc_context block)) | ( `Head n | `Test_head n ) as block -> let validator = get_validator node block in let net_state = Validator.net_state validator in let net_db = Validator.net_db validator in State.Valid_block.Current.head net_state >>= fun head -> - get_pred net_db n head >>= fun { context } -> - Lwt.return (Some context) + get_pred net_db n head >>= fun block -> + Lwt.return (Some (rpc_context block)) | `Hash hash-> begin read_valid_block node hash >|= function | None -> None - | Some { context } -> Some context + | Some block -> Some (rpc_context block) end | ( `Prevalidation | `Test_prevalidation ) as block -> let validator, _net = get_net node block in let pv = Validator.prevalidator validator in Prevalidator.context pv >>= function | Error _ -> Lwt.fail Not_found - | Ok ctxt -> Lwt.return (Some ctxt) + | Ok { context ; fitness } -> + let timestamp = Prevalidator.timestamp pv in + Lwt.return (Some { Updater.context ; fitness ; timestamp }) let operations node block = match block with @@ -417,8 +423,7 @@ module RPC = struct ~predecessor ~timestamp >>=? fun validation_state -> Prevalidation.prevalidate validation_state ~sort rops >>=? fun (validation_state, r) -> - Prevalidation.end_prevalidation validation_state >>=? fun ctxt -> - Context.get_fitness ctxt >>= fun fitness -> + Prevalidation.end_prevalidation validation_state >>=? fun { fitness } -> return (fitness, { r with applied = List.rev r.applied }) let complete node ?block str = @@ -426,9 +431,9 @@ module RPC = struct | None -> Base58.complete str | Some block -> - get_context node block >>= function + get_rpc_context node block >>= function | None -> Lwt.fail Not_found - | Some ctxt -> + | Some { context = ctxt } -> Context.get_protocol ctxt >>= fun protocol_hash -> let (module Proto) = Updater.get_exn protocol_hash in Base58.complete str >>= fun l1 -> @@ -436,12 +441,12 @@ module RPC = struct Lwt.return (l1 @ l2) let context_dir node block = - get_context node block >>= function + get_rpc_context node block >>= function | None -> Lwt.return None - | Some ctxt -> - Context.get_protocol ctxt >>= fun protocol_hash -> + | Some rpc_context -> + Context.get_protocol rpc_context.context >>= fun protocol_hash -> let (module Proto) = Updater.get_exn protocol_hash in - let dir = RPC.map (fun () -> ctxt) Proto.rpc_services in + let dir = RPC.map (fun () -> rpc_context) Proto.rpc_services in Lwt.return (Some (RPC.map (fun _ -> ()) dir)) let heads node = diff --git a/src/node/shell/prevalidation.ml b/src/node/shell/prevalidation.ml index 0822bae23..84e6df095 100644 --- a/src/node/shell/prevalidation.ml +++ b/src/node/shell/prevalidation.ml @@ -135,7 +135,8 @@ let start_prevalidation { State.Valid_block.protocol ; hash = predecessor ; context = predecessor_context ; - timestamp = predecessor_timestamp } + timestamp = predecessor_timestamp ; + fitness = predecessor_fitness } ~timestamp = let (module Proto) = match protocol with @@ -144,8 +145,10 @@ let start_prevalidation Proto.begin_construction ~predecessor_context ~predecessor_timestamp + ~predecessor_fitness ~predecessor - ~timestamp >>=? fun state -> + ~timestamp + >>=? fun state -> return (State { proto = (module Proto) ; state }) let prevalidate diff --git a/src/node/shell/prevalidation.mli b/src/node/shell/prevalidation.mli index ce9a31cd8..21ef80df3 100644 --- a/src/node/shell/prevalidation.mli +++ b/src/node/shell/prevalidation.mli @@ -39,4 +39,4 @@ val prevalidate : (prevalidation_state * error preapply_result) tzresult Lwt.t val end_prevalidation : - prevalidation_state -> Context.t tzresult Lwt.t + prevalidation_state -> Updater.validation_result tzresult Lwt.t diff --git a/src/node/shell/prevalidator.ml b/src/node/shell/prevalidator.ml index 93fc62209..a8b47fc24 100644 --- a/src/node/shell/prevalidator.ml +++ b/src/node/shell/prevalidator.ml @@ -54,7 +54,7 @@ type t = { operations: unit -> error preapply_result * Operation_hash.Set.t ; pending: ?block:State.Valid_block.t -> unit -> Operation_hash.Set.t Lwt.t ; timestamp: unit -> Time.t ; - context: unit -> Context.t tzresult Lwt.t ; + context: unit -> Updater.validation_result tzresult Lwt.t ; shutdown: unit -> unit Lwt.t ; } diff --git a/src/node/shell/prevalidator.mli b/src/node/shell/prevalidator.mli index 47cf052ae..e44e257d1 100644 --- a/src/node/shell/prevalidator.mli +++ b/src/node/shell/prevalidator.mli @@ -44,6 +44,6 @@ val inject_operation: val flush: t -> State.Valid_block.t -> unit val timestamp: t -> Time.t val operations: t -> error Prevalidation.preapply_result * Operation_hash.Set.t -val context: t -> Context.t tzresult Lwt.t +val context: t -> Updater.validation_result tzresult Lwt.t val pending: ?block:State.Valid_block.t -> t -> Operation_hash.Set.t Lwt.t diff --git a/src/node/shell/state.ml b/src/node/shell/state.ml index bc4070dc2..653385fd2 100644 --- a/src/node/shell/state.ml +++ b/src/node/shell/state.ml @@ -996,14 +996,13 @@ module Valid_block = struct block_header_store (net_state: net_state) valid_block_watcher - hash context ttl = + hash { Updater.context ; fitness ; message } ttl = (* Read the block header. *) Raw_block_header.Locked.read block_header_store hash >>=? fun block -> Raw_block_header.Locked.read_discovery_time block_header_store hash >>=? fun discovery_time -> (* Check fitness coherency. *) - Context.get_fitness context >>= fun fitness -> fail_unless (Fitness.equal fitness block.Store.Block_header.shell.fitness) (Invalid_fitness @@ -1041,7 +1040,15 @@ module Valid_block = struct Operation_list.Locked.read_all block_header_store hash >>=? fun operations -> (* Let's commit the context. *) - Context.commit hash context >>= fun () -> + let message = + match message with + | Some message -> message + | None -> + Format.asprintf "%a: %a" + Block_hash.pp_short hash + Fitness.pp fitness in + Context.commit + hash ~time:block.shell.timestamp ~message context >>= fun () -> (* Update the chain state. *) let store = net_state.chain_store in let predecessor = block.shell.predecessor in diff --git a/src/node/shell/state.mli b/src/node/shell/state.mli index 6cab88577..b8c64f6ea 100644 --- a/src/node/shell/state.mli +++ b/src/node/shell/state.mli @@ -284,7 +284,8 @@ module Valid_block : sig val read_opt: Net.t -> Block_hash.t -> valid_block option Lwt.t val read_exn: Net.t -> Block_hash.t -> valid_block Lwt.t val store: - Net.t -> Block_hash.t -> Context.t -> valid_block option tzresult Lwt.t + Net.t -> Block_hash.t -> Updater.validation_result -> + valid_block option tzresult Lwt.t val watcher: Net.t -> valid_block Lwt_stream.t * Watcher.stopper diff --git a/src/node/shell/validator.ml b/src/node/shell/validator.ml index 09af946f7..6b488bbe0 100644 --- a/src/node/shell/validator.ml +++ b/src/node/shell/validator.ml @@ -181,10 +181,8 @@ let apply_block net db begin match pred.protocol with | None -> fail (State.Unknown_protocol pred.protocol_hash) - | Some p -> - Context.set_timestamp pred.context block.shell.timestamp >>= fun c -> - return (p, c) - end >>=? fun ((module Proto), patched_context) -> + | Some p -> return p + end >>=? fun (module Proto) -> lwt_debug "validation of %a: Proto %a" Block_hash.pp_short hash Protocol_hash.pp_short Proto.hash >>= fun () -> @@ -201,8 +199,9 @@ let apply_block net db lwt_debug "validation of %a: applying block..." Block_hash.pp_short hash >>= fun () -> Proto.begin_application - ~predecessor_context:patched_context + ~predecessor_context:pred.context ~predecessor_timestamp:pred.timestamp + ~predecessor_fitness:pred.fitness block >>=? fun state -> fold_left_s (fun state op -> Proto.apply_operation state op >>=? fun state -> diff --git a/src/node/updater/protocol.mli b/src/node/updater/protocol.mli index c8fb8d788..dd6e9124e 100644 --- a/src/node/updater/protocol.mli +++ b/src/node/updater/protocol.mli @@ -9,11 +9,10 @@ (** Tezos Protocol Environment - Protocol Implementation Signature *) -(** The score of a block as a sequence of as unsigned bytes. Ordered - by length and then by contents lexicographically. *) +(* See `src/proto/updater.mli` for documentation. *) + type fitness = Fitness.fitness -(** The version agnostic toplevel structure of operations. *) type shell_operation = Store.Operation.shell_header = { net_id: Net_id.t ; } @@ -23,20 +22,12 @@ type raw_operation = Store.Operation.t = { proto: MBytes.t ; } -(** The version agnostic toplevel structure of blocks. *) type shell_block = Store.Block_header.shell_header = { net_id: Net_id.t ; - (** The genesis of the chain this block belongs to. *) predecessor: Block_hash.t ; - (** The preceding block in the chain. *) timestamp: Time.t ; - (** The date at which this block has been forged. *) operations: Operation_list_list_hash.t ; - (** The sequence of operations. *) fitness: MBytes.t list ; - (** The announced score of the block. As a sequence of sequences - of unsigned bytes. Ordered by length and then by contents - lexicographically. *) } type raw_block = Store.Block_header.t = { @@ -44,96 +35,59 @@ type raw_block = Store.Block_header.t = { proto: MBytes.t ; } -(** This is the signature of a Tezos protocol implementation. It has - access to the standard library and the Environment module. *) +type validation_result = { + context: Context.t ; + fitness: Fitness.fitness ; + message: string option ; +} + +type rpc_context = { + context: Context.t ; + timestamp: Time.t ; + fitness: Fitness.fitness ; +} + module type PROTOCOL = sig type error = .. type 'a tzresult = ('a, error list) result - (** The version specific type of operations. *) - type operation - - (** The maximum size of operations in bytes *) val max_operation_data_length : int - - (** The maximum size of block headers in bytes *) val max_block_length : int - - (** The maximum *) val max_number_of_operations : int - (** The parsing / preliminary validation function for - operations. Similar to {!parse_block}. *) + type operation + val parse_operation : Operation_hash.t -> raw_operation -> operation tzresult - - (** Basic ordering of operations. [compare_operations op1 op2] means - that [op1] should appear before [op2] in a block. *) val compare_operations : operation -> operation -> int - (** A functional state that is transmitted through the steps of a - block validation sequence. It must retain the current state of - the store (that can be extracted from the outside using - {!current_context}, and whose final value is produced by - {!finalize_block}). It can also contain the information that - must be remembered during the validation, which must be - immutable (as validator or baker implementations are allowed to - pause, replay or backtrack during the validation process). *) type validation_state - - (** Access the context at a given validation step. *) val current_context : validation_state -> Context.t tzresult Lwt.t - - (** 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 network as early as possible. The input context - is the one resulting of an ancestor block of same protocol - version, not necessarily the one of its predecessor. *) val precheck_block : ancestor_context: Context.t -> ancestor_timestamp: Time.t -> raw_block -> unit tzresult Lwt.t - - (** The first step in a block validation sequence. Initializes a - validation context for validating a block. Takes as argument the - {!raw_block} to initialize the context for this block, patching - the context resulting of the application of the predecessor - block passed as parameter. The function {!precheck_block} may - not have been called before [begin_application], so all the - check performed by the former must be repeated in the latter. *) val begin_application : predecessor_context: Context.t -> predecessor_timestamp: Time.t -> + predecessor_fitness: Fitness.fitness -> raw_block -> validation_state tzresult Lwt.t - - (** Initializes a validation context for constructing a new block - (as opposed to validating an existing block). Since there is no - {!raw_block} header available, the parts that it provides are - passed as arguments (predecessor block hash, context resulting - of the application of the predecessor block, and timestamp). *) val begin_construction : predecessor_context: Context.t -> predecessor_timestamp: Time.t -> + predecessor_fitness: Fitness.fitness -> predecessor: Block_hash.t -> timestamp: Time.t -> validation_state tzresult Lwt.t - - (** 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 - - (** 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 -> Context.t tzresult Lwt.t + validation_state -> validation_result tzresult Lwt.t - (** The list of remote procedures exported by this implementation *) - val rpc_services : Context.t RPC.directory + val rpc_services : rpc_context RPC.directory val configure_sandbox : Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t diff --git a/src/node/updater/register.ml b/src/node/updater/register.ml index df950446d..4a9827872 100644 --- a/src/node/updater/register.ml +++ b/src/node/updater/register.ml @@ -41,15 +41,19 @@ let register (module Proto : Protocol.PACKED_PROTOCOL) = raw_block >|= wrap_error let begin_application ~predecessor_context ~predecessor_timestamp + ~predecessor_fitness raw_block = begin_application ~predecessor_context ~predecessor_timestamp + ~predecessor_fitness raw_block >|= wrap_error let begin_construction ~predecessor_context ~predecessor_timestamp + ~predecessor_fitness ~predecessor ~timestamp = begin_construction ~predecessor_context ~predecessor_timestamp + ~predecessor_fitness ~predecessor ~timestamp >|= wrap_error let current_context c = current_context c >|= wrap_error diff --git a/src/node/updater/updater.ml b/src/node/updater/updater.ml index a0462d5ee..fde64bebb 100644 --- a/src/node/updater/updater.ml +++ b/src/node/updater/updater.ml @@ -11,6 +11,18 @@ open Logging.Updater let (//) = Filename.concat +type validation_result = Protocol.validation_result = { + context: Context.t ; + fitness: Fitness.fitness ; + message: string option ; +} + +type rpc_context = Protocol.rpc_context = { + context: Context.t ; + timestamp: Time.t ; + fitness: Fitness.fitness ; +} + module type PROTOCOL = Protocol.PROTOCOL module type REGISTRED_PROTOCOL = sig val hash: Protocol_hash.t @@ -30,20 +42,12 @@ type raw_operation = Store.Operation.t = { } let raw_operation_encoding = Store.Operation.encoding -(** The version agnostic toplevel structure of blocks. *) type shell_block = Store.Block_header.shell_header = { net_id: Net_id.t ; - (** The genesis of the chain this block belongs to. *) predecessor: Block_hash.t ; - (** The preceding block in the chain. *) timestamp: Time.t ; - (** The date at which this block has been forged. *) operations: Operation_list_list_hash.t ; - (** The sequence of operations. *) fitness: MBytes.t list ; - (** The announced score of the block. As a sequence of sequences - of unsigned bytes. Ordered by length and then by contents - lexicographically. *) } let shell_block_encoding = Store.Block_header.shell_header_encoding diff --git a/src/node/updater/updater.mli b/src/node/updater/updater.mli index bda578c43..0848878c5 100644 --- a/src/node/updater/updater.mli +++ b/src/node/updater/updater.mli @@ -18,20 +18,12 @@ type raw_operation = Store.Operation.t = { } val raw_operation_encoding: raw_operation Data_encoding.t -(** The version agnostic toplevel structure of blocks. *) type shell_block = Store.Block_header.shell_header = { net_id: Net_id.t ; - (** The genesis of the chain this block belongs to. *) predecessor: Block_hash.t ; - (** The preceding block in the chain. *) timestamp: Time.t ; - (** The date at which this block has been forged. *) operations: Operation_list_list_hash.t ; - (** The sequence of operations. *) fitness: MBytes.t list ; - (** The announced score of the block. As a sequence of sequences - of unsigned bytes. Ordered by length and then by contents - lexicographically. *) } val shell_block_encoding: shell_block Data_encoding.t @@ -41,6 +33,18 @@ type raw_block = Store.Block_header.t = { } val raw_block_encoding: raw_block Data_encoding.t +type validation_result = Protocol.validation_result = { + context: Context.t ; + fitness: Fitness.fitness ; + message: string option ; +} + +type rpc_context = Protocol.rpc_context = { + context: Context.t ; + timestamp: Time.t ; + fitness: Fitness.fitness ; +} + module type PROTOCOL = Protocol.PROTOCOL module type REGISTRED_PROTOCOL = sig val hash: Protocol_hash.t diff --git a/src/proto/alpha/apply.ml b/src/proto/alpha/apply.ml index e959b8578..3ad030a05 100644 --- a/src/proto/alpha/apply.ml +++ b/src/proto/alpha/apply.ml @@ -51,7 +51,7 @@ let apply_delegate_operation_content (Block_hash.equal block pred_block) (Wrong_endorsement_predecessor (pred_block, block)) >>=? fun () -> Mining.check_signing_rights ctxt slot delegate >>=? fun () -> - Fitness.increase ctxt >>=? fun ctxt -> + let ctxt = Fitness.increase ctxt in Mining.pay_endorsement_bond ctxt delegate >>=? fun (ctxt, bond) -> Mining.endorsement_reward ~block_priority >>=? fun reward -> Level.current ctxt >>=? fun { cycle = current_cycle } -> @@ -238,7 +238,7 @@ let may_start_new_cycle ctxt = Seed.compute_for_cycle ctxt (Cycle.succ new_cycle) >>=? fun ctxt -> Roll.clear_cycle ctxt last_cycle >>=? fun ctxt -> Roll.freeze_rolls_for_cycle ctxt (Cycle.succ new_cycle) >>=? fun ctxt -> - Timestamp.get_current ctxt >>= fun timestamp -> + let timestamp = Timestamp.current ctxt in Lwt.return (Timestamp.(timestamp +? (Constants.time_before_reward ctxt))) >>=? fun reward_date -> Reward.set_reward_time_for_cycle @@ -254,10 +254,10 @@ let begin_application ctxt block pred_timestamp = Mining.check_mining_rights ctxt block pred_timestamp >>=? fun miner -> Mining.check_signature ctxt block miner >>=? fun () -> Mining.pay_mining_bond ctxt block miner >>=? fun ctxt -> - Fitness.increase ctxt >>=? fun ctxt -> + let ctxt = Fitness.increase ctxt in return (ctxt, miner) -let finalize_application ctxt block miner op_count = +let finalize_application ctxt block miner = (* end of level (from this point nothing should fail) *) let priority = block.Block.proto.mining_slot.priority in let reward = Mining.base_mining_reward ctxt ~priority in @@ -268,14 +268,7 @@ let finalize_application ctxt block miner op_count = (* end of cycle *) may_start_new_cycle ctxt >>=? fun ctxt -> Amendment.may_start_new_voting_cycle ctxt >>=? fun ctxt -> - Level.current ctxt >>=? fun { level } -> - let level = Raw_level.to_int32 level in - Fitness.get ctxt >>=? fun fitness -> - let commit_message = - Format.asprintf - "lvl %ld, fit %Ld, prio %ld, %d ops" - level fitness priority op_count in - return (commit_message, ctxt) + return ctxt let compare_operations op1 op2 = match op1.contents, op2.contents with diff --git a/src/proto/alpha/fitness_repr.ml b/src/proto/alpha/fitness_repr.ml index e94599593..c5bdafab6 100644 --- a/src/proto/alpha/fitness_repr.ml +++ b/src/proto/alpha/fitness_repr.ml @@ -16,9 +16,9 @@ let int64_to_bytes i = let int64_of_bytes b = if Compare.Int.(MBytes.length b <> 8) then - fail Invalid_fitness + error Invalid_fitness else - return (MBytes.get_int64 b 0) + ok (MBytes.get_int64 b 0) let from_int64 fitness = [ MBytes.of_string Constants_repr.version_number ; @@ -30,5 +30,5 @@ let to_int64 = function when Compare.String. (MBytes.to_string version = Constants_repr.version_number) -> int64_of_bytes fitness - | [] -> return 0L - | _ -> fail Invalid_fitness + | [] -> ok 0L + | _ -> error Invalid_fitness diff --git a/src/proto/alpha/fitness_storage.ml b/src/proto/alpha/fitness_storage.ml index 47683b625..58cf30d18 100644 --- a/src/proto/alpha/fitness_storage.ml +++ b/src/proto/alpha/fitness_storage.ml @@ -7,17 +7,7 @@ (* *) (**************************************************************************) -let get ctxt = - Storage.get_fitness ctxt >>= fun fitness -> - Fitness_repr.to_int64 fitness - -let set ctxt v = - Storage.set_fitness ctxt (Fitness_repr.from_int64 v) >>= fun ctxt -> - Lwt.return ctxt - +let current = Storage.current_fitness let increase ctxt = - get ctxt >>=? fun v -> - set ctxt (Int64.succ v) >>= fun ctxt -> - return ctxt - -let init ctxt = set ctxt 0L + let fitness = current ctxt in + Storage.set_current_fitness ctxt (Int64.succ fitness) diff --git a/src/proto/alpha/init_storage.ml b/src/proto/alpha/init_storage.ml index a51f2ed04..fdae35666 100644 --- a/src/proto/alpha/init_storage.ml +++ b/src/proto/alpha/init_storage.ml @@ -14,15 +14,9 @@ let version_key = ["version"] let version_value = "alpha" (* This is the genesis protocol: initialise the state *) -let initialize ~from_genesis (ctxt:Context.t) = +let initialize ~timestamp ~fitness (ctxt: Context.t) = Context.set ctxt version_key (MBytes.of_string version_value) >>= fun ctxt -> - Storage.prepare ctxt >>=? fun store -> - begin - if from_genesis then - Lwt.return store - else - Fitness_storage.init store - end >>= fun store -> + Storage.prepare ~timestamp ~fitness ctxt >>=? fun store -> Level_storage.init store >>=? fun store -> Roll_storage.init store >>=? fun store -> Nonce_storage.init store >>=? fun store -> @@ -41,19 +35,20 @@ type error += | Incompatiple_protocol_version | Unimplemented_sandbox_migration -let may_initialize ctxt = +let may_initialize ctxt ~timestamp ~fitness = Context.get ctxt version_key >>= function | None -> (* This is the genesis protocol: The only acceptable preceding version is an empty context *) - initialize ~from_genesis:false ctxt + initialize ~timestamp ~fitness ctxt | Some bytes -> let s = MBytes.to_string bytes in - if Compare.String.(s = version_value) - then Storage.prepare ctxt + if Compare.String.(s = version_value) then + Storage.prepare ~timestamp ~fitness ctxt else if Compare.String.(s = "genesis") then - initialize ~from_genesis:true ctxt - else fail Incompatiple_protocol_version + initialize ~timestamp ~fitness ctxt + else + fail Incompatiple_protocol_version let configure_sandbox ctxt json = let json = @@ -63,8 +58,7 @@ let configure_sandbox ctxt json = Context.get ctxt version_key >>= function | None -> Storage.set_sandboxed ctxt json >>= fun ctxt -> - initialize ~from_genesis:false ctxt >>=? fun ctxt -> - return (Storage.recover ctxt) + return ctxt | Some _ -> Storage.get_sandboxed ctxt >>=? function | None -> diff --git a/src/proto/alpha/main.ml b/src/proto/alpha/main.ml index b764fe923..7b3d632c4 100644 --- a/src/proto/alpha/main.ml +++ b/src/proto/alpha/main.ml @@ -34,7 +34,7 @@ type validation_state = op_count : int } let current_context { ctxt } = - Tezos_context.finalize ctxt + return (Tezos_context.finalize ctxt).context let precheck_block ~ancestor_context:_ @@ -47,9 +47,11 @@ let precheck_block let begin_application ~predecessor_context:ctxt ~predecessor_timestamp:pred_timestamp + ~predecessor_fitness:pred_fitness raw_block = Lwt.return (Tezos_context.Block.parse_header raw_block) >>=? fun header -> - Tezos_context.init ctxt >>=? fun ctxt -> + let timestamp = header.shell.timestamp in + Tezos_context.init ~timestamp ~fitness:pred_fitness ctxt >>=? fun ctxt -> Apply.begin_application ctxt header pred_timestamp >>=? fun (ctxt, miner) -> let mode = Application (header, miner) in return { mode ; ctxt ; op_count = 0 } @@ -57,11 +59,12 @@ let begin_application let begin_construction ~predecessor_context:ctxt ~predecessor_timestamp:_ + ~predecessor_fitness:pred_fitness ~predecessor:pred_block ~timestamp = let mode = Construction { pred_block ; timestamp } in - Tezos_context.init ctxt >>=? fun ctxt -> - Apply.begin_construction ctxt >>=? fun ctxt -> + Tezos_context.init ~timestamp ~fitness:pred_fitness ctxt >>=? fun ctxt -> + let ctxt = Apply.begin_construction ctxt in return { mode ; ctxt ; op_count = 0 } let apply_operation ({ mode ; ctxt ; op_count } as data) operation = @@ -81,12 +84,19 @@ let apply_operation ({ mode ; ctxt ; op_count } as data) operation = let finalize_block { mode ; ctxt ; op_count } = match mode with | Construction _ -> - Tezos_context.finalize ctxt >>=? fun ctxt -> + let ctxt = Tezos_context.finalize ctxt in return ctxt | Application (block, miner) -> - Apply.finalize_application - ctxt block miner op_count >>=? fun (commit_message, ctxt) -> - Tezos_context.finalize ~commit_message ctxt >>=? fun ctxt -> + Apply.finalize_application ctxt block miner >>=? fun ctxt -> + Tezos_context.Level.current ctxt >>=? fun { level } -> + let priority = block.proto.mining_slot.priority in + let level = Tezos_context.Raw_level.to_int32 level in + let fitness = Tezos_context.Fitness.current ctxt in + let commit_message = + Format.asprintf + "lvl %ld, fit %Ld, prio %ld, %d ops" + level fitness priority op_count in + let ctxt = Tezos_context.finalize ~commit_message ctxt in return ctxt let compare_operations op1 op2 = diff --git a/src/proto/alpha/mining.ml b/src/proto/alpha/mining.ml index e1b1b7392..c5e8b0094 100644 --- a/src/proto/alpha/mining.ml +++ b/src/proto/alpha/mining.ml @@ -128,7 +128,7 @@ let minimal_time c priority pred_timestamp = let check_timestamp c priority pred_timestamp = minimal_time c priority pred_timestamp >>=? fun minimal_time -> - Tezos_context.Timestamp.get_current c >>= fun timestamp -> + let timestamp = Tezos_context.Timestamp.current c in fail_unless Timestamp.(minimal_time <= timestamp) (Timestamp_too_early (minimal_time, timestamp)) @@ -273,8 +273,8 @@ let max_fitness_gap ctxt = Int64.add slots 1L let check_fitness_gap ctxt (block : Block.header) = - Fitness.get ctxt >>=? fun current_fitness -> - Fitness.to_int64 block.shell.fitness >>=? fun announced_fitness -> + let current_fitness = Fitness.current ctxt in + Lwt.return (Fitness.to_int64 block.shell.fitness) >>=? fun announced_fitness -> let gap = Int64.sub announced_fitness current_fitness in if Compare.Int64.(gap <= 0L || max_fitness_gap ctxt < gap) then fail (Invalid_fitness_gap (max_fitness_gap ctxt, gap)) diff --git a/src/proto/alpha/reward_storage.ml b/src/proto/alpha/reward_storage.ml index ef1a78759..15c3ca797 100644 --- a/src/proto/alpha/reward_storage.ml +++ b/src/proto/alpha/reward_storage.ml @@ -56,7 +56,7 @@ let pay_rewards_for_cycle c cycle = amount) let pay_due_rewards c = - Storage.get_timestamp c >>= fun timestamp -> + let timestamp = Storage.current_timestamp c in let rec loop c cycle = Storage.Rewards.Date.get_option c cycle >>=? function | None -> diff --git a/src/proto/alpha/script_interpreter.ml b/src/proto/alpha/script_interpreter.ml index 0e8db053c..d2f186432 100644 --- a/src/proto/alpha/script_interpreter.ml +++ b/src/proto/alpha/script_interpreter.ml @@ -475,7 +475,7 @@ let rec interp Contract.get_balance ctxt source >>=? fun balance -> logged_return (Item (balance, rest), qta - 1, ctxt) | Now, rest -> - Timestamp.get_current ctxt >>= fun now -> + let now = Timestamp.current ctxt in logged_return (Item (now, rest), qta - 1, ctxt) | Check_signature, Item (key, Item ((signature, message), rest)) -> Public_key.get ctxt key >>=? fun key -> diff --git a/src/proto/alpha/services_registration.ml b/src/proto/alpha/services_registration.ml index 0d2261c22..2d6bff8eb 100644 --- a/src/proto/alpha/services_registration.ml +++ b/src/proto/alpha/services_registration.ml @@ -9,24 +9,27 @@ open Tezos_context -let rpc_services = ref (RPC.empty : Context.t RPC.directory) +let rpc_init { Updater.context ; timestamp ; fitness } = + Tezos_context.init ~timestamp ~fitness context + +let rpc_services = ref (RPC.empty : Updater.rpc_context RPC.directory) let register0 s f = rpc_services := RPC.register !rpc_services (s RPC.Path.root) (fun ctxt () -> - ( Tezos_context.init ctxt >>=? fun ctxt -> + ( rpc_init ctxt >>=? fun ctxt -> f ctxt ) >>= RPC.Answer.return) let register1 s f = rpc_services := RPC.register !rpc_services (s RPC.Path.root) (fun ctxt arg -> - ( Tezos_context.init ctxt >>=? fun ctxt -> + ( rpc_init ctxt >>=? fun ctxt -> f ctxt arg ) >>= RPC.Answer.return) let register2 s f = rpc_services := RPC.register !rpc_services (s RPC.Path.root) (fun (ctxt, arg1) arg2 -> - ( Tezos_context.init ctxt >>=? fun ctxt -> + ( rpc_init ctxt >>=? fun ctxt -> f ctxt arg1 arg2 ) >>= RPC.Answer.return) let register1_noctxt s f = rpc_services := @@ -143,7 +146,7 @@ let () = rpc_services := RPC.register !rpc_services (s RPC.Path.root) (fun (ctxt, contract) arg -> - ( Tezos_context.init ctxt >>=? fun ctxt -> + ( rpc_init ctxt >>=? fun ctxt -> Contract.exists ctxt contract >>=? function | true -> f ctxt contract arg | false -> raise Not_found ) >>= RPC.Answer.return) in @@ -177,7 +180,7 @@ let minimal_timestamp ctxt prio = let () = register1 Services.Helpers.minimal_timestamp (fun ctxt slot -> - Tezos_context.Timestamp.get_current ctxt >>= fun timestamp -> + let timestamp = Tezos_context.Timestamp.current ctxt in minimal_timestamp ctxt slot timestamp) let () = @@ -305,7 +308,7 @@ let () = Lwt_list.filter_map_p (fun x -> x) @@ List.mapi (fun prio c -> - Tezos_context.Timestamp.get_current ctxt >>= fun timestamp -> + let timestamp = Timestamp.current ctxt in Mining.minimal_time ctxt (Int32.of_int prio) timestamp >>= function | Error _ -> Lwt.return None @@ -343,7 +346,7 @@ let mining_rights_for_delegate let raw_level = level.level in Error_monad.map_s (fun priority -> - Tezos_context.Timestamp.get_current ctxt >>= fun timestamp -> + let timestamp = Timestamp.current ctxt in Mining.minimal_time ctxt priority timestamp >>=? fun time -> return (raw_level, Int32.to_int priority, time)) priorities >>=? fun priorities -> diff --git a/src/proto/alpha/storage.ml b/src/proto/alpha/storage.ml index 7f65834d7..ee8df6062 100644 --- a/src/proto/alpha/storage.ml +++ b/src/proto/alpha/storage.ml @@ -12,19 +12,14 @@ open Storage_functors let version = "v1" let sandboxed_key = [ version ; "sandboxed" ] -let prevalidation_key = [ version ; "prevalidation" ] type t = Storage_functors.context type error += Invalid_sandbox_parameter -let get_fitness (c, _) = Context.get_fitness c -let set_fitness (c, csts) v = - Context.set_fitness c v >>= fun c -> Lwt.return (c, csts) - -let get_timestamp (c, _) = Context.get_timestamp c -let set_commit_message (c, csts) msg = - Context.set_commit_message c msg >>= fun c -> Lwt.return (c, csts) +let current_timestamp { timestamp } = timestamp +let current_fitness { fitness } = fitness +let set_current_fitness c fitness = { c with fitness } let get_sandboxed c = Context.get c sandboxed_key >>= function @@ -38,22 +33,14 @@ let set_sandboxed c json = Context.set c sandboxed_key (Data_encoding.Binary.to_bytes Data_encoding.json json) -let prepare (c : Context.t) : t tzresult Lwt.t = +let prepare ~timestamp ~fitness (c : Context.t) : t tzresult Lwt.t = + Lwt.return (Fitness_repr.to_int64 fitness) >>=? fun fitness -> get_sandboxed c >>=? fun sandbox -> Constants_repr.read sandbox >>=? function constants -> - return (c, constants) -let recover (c, _ : t) : Context.t = c + return { context = c ; constants ; timestamp ; fitness } +let recover { context } : Context.t = context -let get_prevalidation (c, _ : t) = - Context.get c prevalidation_key >>= function - | None -> Lwt.return false - | Some _ -> Lwt.return true -let set_prevalidation (c, constants : t) = - Context.set c prevalidation_key (MBytes.of_string "prevalidation") >>= fun c -> - Lwt.return (c, constants) - - -let constants : t -> _ = snd +let constants { constants } = constants module Key = struct @@ -510,12 +497,12 @@ module Rewards = struct end -let activate (c, constants) h = - Updater.activate c h >>= fun c -> Lwt.return (c, constants) -let fork_test_network (c, constants) = - Updater.fork_test_network c >>= fun c -> Lwt.return (c, constants) -let set_test_protocol (c, constants) h = - Updater.set_test_protocol c h >>= fun c -> Lwt.return (c, constants) +let activate ({ context = c } as s) h = + Updater.activate c h >>= fun c -> Lwt.return { s with context = c } +let fork_test_network ({ context = c } as s) = + Updater.fork_test_network c >>= fun c -> Lwt.return { s with context = c } +let set_test_protocol ({ context = c } as s) h = + Updater.set_test_protocol c h >>= fun c -> Lwt.return { s with context = c } (** Resolver *) diff --git a/src/proto/alpha/storage.mli b/src/proto/alpha/storage.mli index 7ff2503ae..9f9cb1109 100644 --- a/src/proto/alpha/storage.mli +++ b/src/proto/alpha/storage.mli @@ -25,7 +25,10 @@ type t (** Rerieves the state of the database and gives its abstract view *) -val prepare : Context.t -> t tzresult Lwt.t +val prepare : + timestamp: Time.t -> + fitness: Fitness.fitness -> + Context.t -> t tzresult Lwt.t (** Returns the state of the database resulting of operations on its abstract view *) @@ -34,15 +37,10 @@ val recover : t -> Context.t val get_sandboxed : Context.t -> Data_encoding.json option tzresult Lwt.t val set_sandboxed : Context.t -> Data_encoding.json -> Context.t Lwt.t -val get_fitness : t -> Fitness.fitness Lwt.t -val set_fitness : t -> Fitness.fitness -> t Lwt.t +val current_timestamp : t -> Time.t -val get_timestamp: t -> Time.t Lwt.t - -val set_commit_message: t -> string -> t Lwt.t - -val get_prevalidation : t -> bool Lwt.t -val set_prevalidation : t -> t Lwt.t +val current_fitness : t -> Int64.t +val set_current_fitness : t -> Int64.t -> t val constants : t -> Constants_repr.constants diff --git a/src/proto/alpha/storage_functors.ml b/src/proto/alpha/storage_functors.ml index d99455c72..c8c9fb2b4 100644 --- a/src/proto/alpha/storage_functors.ml +++ b/src/proto/alpha/storage_functors.ml @@ -11,7 +11,12 @@ open Misc -type context = Context.t * Constants_repr.constants +type context = { + context: Context.t ; + constants: Constants_repr.constants ; + timestamp: Time.t ; + fitness: Int64.t ; +} (*-- Errors ------------------------------------------------------------------*) @@ -52,7 +57,7 @@ module Make_raw_data_storage (P : Raw_data_description) = struct let key_to_string l = String.concat "/" (key l) - let get (c, _) k = + let get { context = c } k = Context.get c (key k) >>= function | None -> let msg = @@ -61,16 +66,16 @@ module Make_raw_data_storage (P : Raw_data_description) = struct | Some bytes -> Lwt.return (P.of_bytes bytes) - let mem (c, _) k = Context.mem c (key k) + let mem { context = c } k = Context.mem c (key k) - let get_option (c, _) k = + let get_option { context = c } k = Context.get c (key k) >>= function | None -> return None | Some bytes -> Lwt.return (P.of_bytes bytes >|? fun v -> Some v) (* Verify that the key is present before modifying *) - let set (c, x) k v = + let set ({ context = c } as s) k v = let key = key k in Context.get c key >>= function | None -> @@ -80,13 +85,13 @@ module Make_raw_data_storage (P : Raw_data_description) = struct | Some old -> let bytes = P.to_bytes v in if MBytes.(old = bytes) then - return (c, x) + return { s with context = c } else Context.set c key (P.to_bytes v) >>= fun c -> - return (c, x) + return { s with context = c } (* Verify that the key is not present before inserting *) - let init (c, x) k v = + let init ({ context = c } as s) k v = let key = key k in Context.get c key >>= function @@ -96,27 +101,29 @@ module Make_raw_data_storage (P : Raw_data_description) = struct fail (Storage_error msg) | None -> Context.set c key (P.to_bytes v) >>= fun c -> - return (c, x) + return { s with context = c } (* Does not verify that the key is present or not *) - let init_set (c, x) k v = - Context.set c (key k) (P.to_bytes v) >>= fun c -> return (c, x) + let init_set ({ context = c } as s) k v = + Context.set c (key k) (P.to_bytes v) >>= fun c -> + return { s with context = c } (* Verify that the key is present before deleting *) - let delete (c, x) k = + let delete ({ context = c } as s) k = let key = key k in Context.get c key >>= function | Some _ -> Context.del c key >>= fun c -> - return (c, x) + return { s with context = c } | None -> let msg = "cannot delete undefined " ^ P.name ^ " key " ^ key_to_string k in fail (Storage_error msg) (* Do not verify before deleting *) - let remove (c, x) k = - Context.del c (key k) >>= fun c -> Lwt.return (c, x) + let remove ({ context = c } as s) k = + Context.del c (key k) >>= fun c -> + Lwt.return { s with context = c } end @@ -229,28 +236,34 @@ module Make_data_set_storage (P : Single_data_description) = struct error (Storage_error msg) | Some v -> Ok v - let add (c, x) v = + let add ({ context = c } as s) v = let hash, data = serial v in HashTbl.mem c hash >>= function - | true -> return (c, x) - | false -> HashTbl.set c hash data >>= fun c -> return (c, x) + | true -> + return { s with context = c } + | false -> + HashTbl.set c hash data >>= fun c -> + return { s with context = c } - let del (c, x) v = + let del ({ context = c } as s) v = let hash, _ = serial v in HashTbl.mem c hash >>= function - | false -> return (c, x) - | true -> HashTbl.del c hash >>= fun c -> return (c, x) + | false -> + return { s with context = c } + | true -> + HashTbl.del c hash >>= fun c -> + return { s with context = c } - let mem (c, _) v = + let mem { context = c } v = let hash, _ = serial v in HashTbl.mem c hash >>= fun v -> return v - let elements (c, _) = + let elements { context = c } = HashTbl.bindings c >>= fun elts -> map_s (fun (_, data) -> Lwt.return (unserial data)) elts - let fold (c, _) init ~f = + let fold { context = c } init ~f = HashTbl.fold c (ok init) ~f:(fun _ data acc -> match acc with @@ -262,9 +275,9 @@ module Make_data_set_storage (P : Single_data_description) = struct f data acc >>= fun acc -> return acc) - let clear (c, x) = + let clear ({ context = c } as s) = HashTbl.fold c c ~f:(fun hash _ c -> HashTbl.del c hash) >>= fun c -> - return (c, x) + return { s with context = c } end @@ -284,7 +297,7 @@ module Raw_make_iterable_data_storage let key_to_string k = String.concat "/" (K.to_path k) - let get (c, _) k = + let get { context = c } k = HashTbl.get c k >>= function | None -> let msg = @@ -293,15 +306,15 @@ module Raw_make_iterable_data_storage | Some v -> return v - let mem (c, _) k = HashTbl.mem c k + let mem { context = c } k = HashTbl.mem c k - let get_option (c, _) k = + let get_option { context = c } k = HashTbl.get c k >>= function | None -> return None | Some v -> return (Some v) (* Verify that the key is present before modifying *) - let set (c, x) k v = + let set ({ context = c } as s) k v = HashTbl.get c k >>= function | None -> let msg = @@ -309,10 +322,10 @@ module Raw_make_iterable_data_storage fail (Storage_error msg) | Some _ -> HashTbl.set c k v >>= fun c -> - return (c, x) + return { s with context = c } (* Verify that the key is not present before inserting *) - let init (c, x) k v = + let init ({ context = c } as s) k v = HashTbl.get c k >>= function | Some _ -> @@ -321,29 +334,35 @@ module Raw_make_iterable_data_storage fail (Storage_error msg) | None -> HashTbl.set c k v >>= fun c -> - return (c, x) + return { s with context = c } (* Does not verify that the key is present or not *) - let init_set (c, x) k v = HashTbl.set c k v >>= fun c -> return (c, x) + let init_set ({ context = c } as s) k v = + HashTbl.set c k v >>= fun c -> + return { s with context = c } (* Verify that the key is present before deleting *) - let delete (c, x) k = + let delete ({ context = c } as s) k = HashTbl.get c k >>= function | Some _ -> HashTbl.del c k >>= fun c -> - return (c, x) + return { s with context = c } | None -> let msg = "cannot delete undefined " ^ P.name ^ " key " ^ key_to_string k in fail (Storage_error msg) (* Do not verify before deleting *) - let remove (c, x) k = - HashTbl.del c k >>= fun c -> Lwt.return (c, x) + let remove ({ context = c } as s) k = + HashTbl.del c k >>= fun c -> + Lwt.return { s with context = c } - let clear (c, x) = HashTbl.clear c >>= fun c -> Lwt.return (c, x) - let fold (c, _) x ~f = HashTbl.fold c x ~f:(fun k v acc -> f k v acc) - let iter (c, _) ~f = HashTbl.fold c () ~f:(fun k v () -> f k v) + let clear ({ context = c } as s) = + HashTbl.clear c >>= fun c -> + Lwt.return { s with context = c } + + let fold { context = c } x ~f = HashTbl.fold c x ~f:(fun k v acc -> f k v acc) + let iter { context = c } ~f = HashTbl.fold c () ~f:(fun k v () -> f k v) end diff --git a/src/proto/alpha/storage_functors.mli b/src/proto/alpha/storage_functors.mli index 53593b868..ad1262a09 100644 --- a/src/proto/alpha/storage_functors.mli +++ b/src/proto/alpha/storage_functors.mli @@ -14,7 +14,12 @@ indexed data and homgeneous data set). *) -type context = Context.t * Constants_repr.constants +type context = { + context: Context.t ; + constants: Constants_repr.constants ; + timestamp: Time.t ; + fitness: Int64.t ; +} open Storage_sigs diff --git a/src/proto/alpha/tezos_context.ml b/src/proto/alpha/tezos_context.ml index 02810f9a1..f2a6c7646 100644 --- a/src/proto/alpha/tezos_context.ml +++ b/src/proto/alpha/tezos_context.ml @@ -22,7 +22,7 @@ module Period = Period_repr module Timestamp = struct include Time_repr - let get_current = Storage.get_timestamp + let current = Storage.current_timestamp end include Operation_repr @@ -110,17 +110,12 @@ end let init = Init_storage.may_initialize -let finalize ?commit_message c = - match commit_message with - | None -> - return (Storage.recover c) - | Some msg -> - Storage.set_commit_message c msg >>= fun c -> - return (Storage.recover c) +let finalize ?commit_message:message c = + let fitness = Fitness.from_int64 (Fitness.current c) in + let context = Storage.recover c in + { Updater.context ; fitness ; message } let configure_sandbox = Init_storage.configure_sandbox -let get_prevalidation = Storage.get_prevalidation -let set_prevalidation = Storage.set_prevalidation let activate = Storage.activate let fork_test_network = Storage.fork_test_network diff --git a/src/proto/alpha/tezos_context.mli b/src/proto/alpha/tezos_context.mli index 7e37928c4..3e8f33373 100644 --- a/src/proto/alpha/tezos_context.mli +++ b/src/proto/alpha/tezos_context.mli @@ -75,10 +75,7 @@ module Timestamp : sig val of_seconds: string -> time option val to_seconds: time -> string - val get_current: context -> Time.t Lwt.t - (** [get_current ctxt] returns the current timestamp of [ctxt]. When - [ctxt] is the context of a block, the block timestamp is used, - otherwise a timestamp is inferred otherwise. *) + val current: context -> Time.t end @@ -253,10 +250,11 @@ module Fitness : sig include (module type of Fitness) type t = fitness - val increase: context -> context tzresult Lwt.t + val increase: context -> context - val get: context -> int64 tzresult Lwt.t - val to_int64: fitness -> int64 tzresult Lwt.t + val current: context -> int64 + + val to_int64: fitness -> int64 tzresult end @@ -580,15 +578,16 @@ module Reward : sig end -val init: Context.t -> context tzresult Lwt.t -val finalize: ?commit_message:string -> context -> Context.t tzresult Lwt.t +val init: + Context.t -> + timestamp:Time.t -> + fitness:Fitness.t -> + context tzresult Lwt.t +val finalize: ?commit_message:string -> context -> Updater.validation_result val configure_sandbox: Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t -val get_prevalidation: context -> bool Lwt.t -val set_prevalidation: context -> context Lwt.t - val activate: context -> Protocol_hash.t -> context Lwt.t val set_test_protocol: context -> Protocol_hash.t -> context Lwt.t val fork_test_network: context -> context Lwt.t diff --git a/src/proto/demo/main.ml b/src/proto/demo/main.ml index 2dde8adf2..8bc1766db 100644 --- a/src/proto/demo/main.ml +++ b/src/proto/demo/main.ml @@ -17,9 +17,15 @@ let parse_operation h _ = Ok h let compare_operations _ _ = 0 -module Fitness = struct +type validation_state = { + context : Context.t ; + fitness : Int64.t ; +} - let version_number = "\000" +let current_context { context } = + return context + +module Fitness = struct type error += Invalid_fitness type error += Invalid_fitness2 @@ -36,67 +42,50 @@ module Fitness = struct return (MBytes.get_int64 b 0) let from_int64 fitness = - [ MBytes.of_string version_number ; - int64_to_bytes fitness ] + [ int64_to_bytes fitness ] let to_int64 = function - | [ version ; - fitness ] - when Compare.String. - (MBytes.to_string version = version_number) -> - int64_of_bytes fitness + | [ fitness ] -> int64_of_bytes fitness | [] -> return 0L | _ -> fail Invalid_fitness - let get ctxt = - Context.get_fitness ctxt >>= fun fitness -> - to_int64 fitness - - let set ctxt v = - Context.set_fitness ctxt (from_int64 v) >>= fun ctxt -> - Lwt.return ctxt - - let increase ctxt = - get ctxt >>=? fun v -> - set ctxt (Int64.succ v) >>= fun ctxt -> - return ctxt + let get { fitness } = fitness end -type validation_state = Context.t - -let current_context ctxt = - return ctxt - let precheck_block ~ancestor_context:_ ~ancestor_timestamp:_ - _raw_block = + raw_block = + Fitness.to_int64 raw_block.Updater.shell.fitness >>=? fun _ -> return () let begin_application - ~predecessor_context:ctxt + ~predecessor_context:context ~predecessor_timestamp:_ - _raw_block = - return ctxt + ~predecessor_fitness:_ + raw_block = + Fitness.to_int64 raw_block.Updater.shell.fitness >>=? fun fitness -> + return { context ; fitness } let begin_construction - ~predecessor_context:ctxt + ~predecessor_context:context ~predecessor_timestamp:_ + ~predecessor_fitness:pred_fitness ~predecessor:_ ~timestamp:_ = - return ctxt + Fitness.to_int64 pred_fitness >>=? function pred_fitness -> + let fitness = Int64.succ pred_fitness in + return { context ; fitness } let apply_operation ctxt _ = return ctxt let finalize_block ctxt = - Fitness.increase ctxt >>=? fun ctxt -> - Fitness.get ctxt >>=? fun fitness -> - let commit_message = - Format.asprintf "fitness <- %Ld" fitness in - Context.set_commit_message ctxt commit_message >>= fun ctxt -> - return 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 } let rpc_services = Services.rpc_services diff --git a/src/proto/demo/services.ml b/src/proto/demo/services.ml index daa0bfdc3..5401cf579 100644 --- a/src/proto/demo/services.ml +++ b/src/proto/demo/services.ml @@ -45,7 +45,7 @@ let failing_service custom_root = ~output: (wrap_tzerror Data_encoding.empty) RPC.Path.(custom_root / "failing") -let rpc_services : Context.t RPC.directory = +let rpc_services : Updater.rpc_context RPC.directory = let dir = RPC.empty in let dir = RPC.register diff --git a/src/proto/environment/context.mli b/src/proto/environment/context.mli index fa5920f69..ea07889f0 100644 --- a/src/proto/environment/context.mli +++ b/src/proto/environment/context.mli @@ -5,12 +5,6 @@ open Hash include Persist.STORE -val get_fitness: t -> Fitness.fitness Lwt.t -val set_fitness: t -> Fitness.fitness -> t Lwt.t - -val get_timestamp: t -> Time.t Lwt.t -val set_commit_message: t -> string -> t Lwt.t - val register_resolver: 'a Base58.encoding -> (t -> string -> 'a list Lwt.t) -> unit diff --git a/src/proto/environment/updater.mli b/src/proto/environment/updater.mli index 223d32b09..404cde61a 100644 --- a/src/proto/environment/updater.mli +++ b/src/proto/environment/updater.mli @@ -2,6 +2,7 @@ open Hash +(** The version agnostic toplevel structure of operations. *) type shell_operation = { net_id: Net_id.t ; } @@ -37,6 +38,18 @@ type raw_block = { } val raw_block_encoding: raw_block Data_encoding.t +type validation_result = { + context: Context.t ; + fitness: Fitness.fitness ; + message: string option ; +} + +type rpc_context = { + context: Context.t ; + timestamp: Time.t ; + fitness: Fitness.fitness ; +} + (** This is the signature of a Tezos protocol implementation. It has access to the standard library and the Environment module. *) module type PROTOCOL = sig @@ -99,6 +112,7 @@ module type PROTOCOL = sig val begin_application : predecessor_context: Context.t -> predecessor_timestamp: Time.t -> + predecessor_fitness: Fitness.fitness -> raw_block -> validation_state tzresult Lwt.t @@ -110,6 +124,7 @@ module type PROTOCOL = sig val begin_construction : predecessor_context: Context.t -> predecessor_timestamp: Time.t -> + predecessor_fitness: Fitness.fitness -> predecessor: Block_hash.t -> timestamp: Time.t -> validation_state tzresult Lwt.t @@ -123,10 +138,10 @@ module type PROTOCOL = sig context that will be used as input for the validation of its successor block candidates. *) val finalize_block : - validation_state -> Context.t tzresult Lwt.t + validation_state -> validation_result tzresult Lwt.t (** The list of remote procedures exported by this implementation *) - val rpc_services : Context.t RPC.directory + val rpc_services : rpc_context RPC.directory val configure_sandbox : Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t diff --git a/src/proto/genesis/main.ml b/src/proto/genesis/main.ml index aeee3f4c5..0a0c73f2f 100644 --- a/src/proto/genesis/main.ml +++ b/src/proto/genesis/main.ml @@ -61,10 +61,10 @@ let check_signature ctxt { shell ; command ; signature } = (Ed25519.Signature.check public_key signature bytes) Invalid_signature -type validation_state = block * Context.t +type validation_state = Updater.validation_result -let current_context (_, ctxt) = - return ctxt +let current_context ({ context } : validation_state) = + return context let precheck_block ~ancestor_context:_ @@ -76,38 +76,38 @@ let precheck_block let begin_application ~predecessor_context:ctxt ~predecessor_timestamp:_ + ~predecessor_fitness:_ raw_block = + Data.Init.may_initialize ctxt >>=? fun ctxt -> Lwt.return (parse_block raw_block) >>=? fun block -> - return (block, ctxt) + check_signature ctxt block >>=? fun () -> + let fitness = raw_block.shell.fitness in + match block.command with + | Data.Command.Activate hash -> + let message = + Some (Format.asprintf "activate %a" Protocol_hash.pp_short hash) in + Updater.activate ctxt hash >>= fun ctxt -> + return { Updater.message ; context = ctxt ; fitness } + | Activate_testnet hash -> + let message = + Some (Format.asprintf "activate testnet %a" Protocol_hash.pp_short hash) in + Updater.set_test_protocol ctxt hash >>= fun ctxt -> + Updater.fork_test_network ctxt >>= fun ctxt -> + return { Updater.message ; context = ctxt ; fitness } let begin_construction - ~predecessor_context:_ + ~predecessor_context:context ~predecessor_timestamp:_ + ~predecessor_fitness:fitness ~predecessor:_ ~timestamp:_ = - Lwt.return (Error []) (* absurd *) + (* Dummy result. *) + return { Updater.message = None ; context ; fitness } let apply_operation _vctxt _ = Lwt.return (Error []) (* absurd *) -let finalize_block (header, ctxt) = - check_signature ctxt header >>=? fun () -> - Data.Init.may_initialize ctxt >>=? fun ctxt -> - Context.set_fitness ctxt header.shell.fitness >>= fun ctxt -> - match header.command with - | Activate hash -> - let commit_message = - Format.asprintf "activate %a" Protocol_hash.pp_short hash in - Context.set_commit_message ctxt commit_message >>= fun ctxt -> - Updater.activate ctxt hash >>= fun ctxt -> - return ctxt - | Activate_testnet hash -> - let commit_message = - Format.asprintf "activate testnet %a" Protocol_hash.pp_short hash in - Context.set_commit_message ctxt commit_message >>= fun ctxt -> - Updater.set_test_protocol ctxt hash >>= fun ctxt -> - Updater.fork_test_network ctxt >>= fun ctxt -> - return ctxt +let finalize_block state = return state let rpc_services = Services.rpc_services diff --git a/src/proto/genesis/services.ml b/src/proto/genesis/services.ml index 9f981c84e..cb800e0d0 100644 --- a/src/proto/genesis/services.ml +++ b/src/proto/genesis/services.ml @@ -56,7 +56,7 @@ let int64_to_bytes i = let operations = Operation_list_list_hash.compute [Operation_list_hash.empty] -let rpc_services : Context.t RPC.directory = +let rpc_services : Updater.rpc_context RPC.directory = let dir = RPC.empty in let dir = RPC.register diff --git a/test/proto_alpha/proto_alpha_helpers.ml b/test/proto_alpha/proto_alpha_helpers.ml index d3edbc882..3c08bb9c3 100644 --- a/test/proto_alpha/proto_alpha_helpers.ml +++ b/test/proto_alpha/proto_alpha_helpers.ml @@ -434,7 +434,7 @@ module Mining = struct Client_proto_rpcs.Context.level rpc_config block >>=? fun level -> let level = Raw_level.succ level.level in get_first_priority level contract block >>=? fun priority -> - (Fitness_repr.to_int64 bi.fitness >|= + (Lwt.return (Fitness_repr.to_int64 bi.fitness) >|= Register_client_embedded_proto_alpha.wrap_error) >>=? fun fitness -> let fitness = Fitness_repr.from_int64 @@ diff --git a/test/shell/test_context.ml b/test/shell/test_context.ml index f0afffe63..770e4bf4e 100644 --- a/test/shell/test_context.ml +++ b/test/shell/test_context.ml @@ -37,6 +37,8 @@ let net_id = Net_id.of_block_hash genesis_block (** Context creation *) +let commit = commit ~time:Time.epoch ~message:"" + let block2 = Block_hash.of_hex_exn "2222222222222222222222222222222222222222222222222222222222222222" diff --git a/test/shell/test_state.ml b/test/shell/test_state.ml index de2771c0d..0b4bd3e85 100644 --- a/test/shell/test_state.ml +++ b/test/shell/test_state.ml @@ -38,7 +38,7 @@ let net_id = Net_id.of_block_hash genesis_block let incr_fitness fitness = let new_fitness = match fitness with - | [ _ ; fitness ] -> + | [ fitness ] -> Pervasives.( Data_encoding.Binary.of_bytes Data_encoding.int64 fitness |> Utils.unopt ~default:0L @@ -47,7 +47,7 @@ let incr_fitness fitness = ) | _ -> Data_encoding.Binary.to_bytes Data_encoding.int64 1L in - [ MBytes.of_string "\000" ; new_fitness ] + [ new_fitness ] let incr_timestamp timestamp = Time.add timestamp (Int64.add 1L (Random.int64 10L)) @@ -166,6 +166,7 @@ let build_valid_chain state tbl vtbl otbl pred names = Proto.begin_application ~predecessor_context: pred.context ~predecessor_timestamp: pred.timestamp + ~predecessor_fitness: pred.fitness block >>=? fun vstate -> (* no operations *) Proto.finalize_block vstate