diff --git a/src/Makefile b/src/Makefile index 8fee528f6..2f3bf66c7 100644 --- a/src/Makefile +++ b/src/Makefile @@ -40,10 +40,10 @@ $(addprefix proto/environment/, \ hash.mli \ ed25519.mli \ persist.mli \ + fitness.mli \ context.mli \ RPC.mli \ \ - fitness.mli \ updater.mli \ ) diff --git a/src/node/db/context.ml b/src/node/db/context.ml index 4e369e43c..8f2ca7415 100644 --- a/src/node/db/context.ml +++ b/src/node/db/context.ml @@ -62,6 +62,7 @@ let genesis_block_key = ["genesis";"block"] let genesis_protocol_key = ["genesis";"protocol"] let genesis_time_key = ["genesis";"time"] let current_protocol_key = ["protocol"] +let current_fitness_key = ["fitness"] let current_test_protocol_key = ["test_protocol"] let current_test_network_key = ["test_network"] let current_test_network_expiration_key = ["test_network_expiration"] @@ -195,6 +196,8 @@ let commit_genesis index ~id:block ~time ~protocol ~test_protocol = (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 @@ -211,6 +214,17 @@ let get_protocol v = let set_protocol v key = raw_set v current_protocol_key (Protocol_hash.to_bytes key) +let get_fitness v = + raw_get v 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 v data = + raw_set v current_fitness_key + (Data_encoding.Binary.to_bytes Fitness.encoding data) + let get_test_protocol v = raw_get v current_test_protocol_key >>= function | None -> assert false diff --git a/src/node/db/context.mli b/src/node/db/context.mli index 7e4e1b1d3..35a60f207 100644 --- a/src/node/db/context.mli +++ b/src/node/db/context.mli @@ -64,5 +64,8 @@ val fork_test_network: context -> context Lwt.t val get_genesis_time: context -> Time.t Lwt.t val get_genesis_block: context -> Block_hash.t Lwt.t +val set_fitness: context -> Fitness.fitness -> context Lwt.t +val get_fitness: context -> Fitness.fitness 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 eaa4fe03b..f432d851f 100644 --- a/src/node/shell/node.ml +++ b/src/node/shell/node.ml @@ -261,8 +261,7 @@ module RPC = struct let net_state = Validator.net_state validator in State.Valid_block.Current.head net_state >>= fun head -> let ctxt = Prevalidator.context pv in - let (module Proto) = Prevalidator.protocol pv in - Proto.fitness ctxt >|= fun fitness -> + Context.get_fitness ctxt >|= fun fitness -> { (convert head) with hash = prevalidation_hash ; fitness ; @@ -387,11 +386,11 @@ module RPC = struct match protocol with | None -> failwith "Unknown protocol version" | Some protocol -> return protocol - end >>=? function (module Proto) as protocol -> - let net_db = Validator.net_db node.global_validator in + end >>=? fun ((module Proto) as protocol) -> + let net_db = Validator.net_db node.global_validator in Prevalidator.preapply net_db context protocol hash timestamp sort ops >>=? fun (ctxt, r) -> - Proto.fitness ctxt >>= fun fitness -> + Context.get_fitness ctxt >>= fun fitness -> return (fitness, r) let complete node ?block str = diff --git a/src/node/shell/state.ml b/src/node/shell/state.ml index 21a47dc74..fe6410b9c 100644 --- a/src/node/shell/state.ml +++ b/src/node/shell/state.ml @@ -22,7 +22,7 @@ type error += let () = Error_monad.register_error_kind - `Temporary + `Permanent ~id:"state.invalid_fitness" ~title:"Invalid fitness" ~description:"The computed fitness differs from the fitness found \ @@ -830,18 +830,8 @@ module Valid_block = struct block_header_store hash >>=? fun block -> Raw_block_header.Locked.read_discovery_time block_header_store hash >>=? fun discovery_time -> - begin (* Load the associated version of the economical protocol . *) - Context.get_protocol context >>= fun protocol_hash -> - match Updater.get protocol_hash with - | None -> - lwt_log_error - "State.Validated_block: unknown protocol (%a)" - Protocol_hash.pp_short protocol_hash >>= fun () -> - fail (Unknown_protocol protocol_hash) - | Some proto -> return proto - end >>=? fun (module Proto) -> (* Check fitness coherency. *) - Proto.fitness context >>= fun fitness -> + Context.get_fitness context >>= fun fitness -> fail_unless (Fitness.equal fitness block.Store.Block_header.shell.fitness) (Invalid_fitness diff --git a/src/node/shell/validator.ml b/src/node/shell/validator.ml index 8ac0c93c8..a8750c751 100644 --- a/src/node/shell/validator.ml +++ b/src/node/shell/validator.ml @@ -187,8 +187,8 @@ module Validation_scheduler = struct | Ok new_context -> (* The sanity check `set_context` detects differences between the computed fitness and the fitness announced - in the block header. When distinct `Valid_block.read` - will return an error. *) + in the block header. Then `Valid_block.read` will + return an error. *) set_context hash (Ok new_context) >>= fun () -> State.Valid_block.read state hash >>= function | Error err -> diff --git a/src/node/updater/protocol.ml b/src/node/updater/protocol.ml index 1be9be558..1cf819452 100644 --- a/src/node/updater/protocol.ml +++ b/src/node/updater/protocol.ml @@ -117,10 +117,6 @@ module type PROTOCOL = sig Context.t -> Block_hash.t -> Time.t -> bool -> operation list -> (Context.t * error preapply_result) tzresult Lwt.t - (** The context rating function to determine the winning block chain. *) - val fitness : - Context.t -> fitness Lwt.t - (** The list of remote procedures exported by this implementation *) val rpc_services : Context.t RPC.directory diff --git a/src/proto/alpha/fitness_repr.ml b/src/proto/alpha/fitness_repr.ml index 3c8661e8d..e94599593 100644 --- a/src/proto/alpha/fitness_repr.ml +++ b/src/proto/alpha/fitness_repr.ml @@ -9,7 +9,6 @@ type error += Invalid_fitness - let int64_to_bytes i = let b = MBytes.create 8 in MBytes.set_int64 b 0 i; @@ -22,9 +21,8 @@ let int64_of_bytes b = return (MBytes.get_int64 b 0) let from_int64 fitness = - return - [ MBytes.of_string Constants_repr.version_number ; - int64_to_bytes fitness ] + [ MBytes.of_string Constants_repr.version_number ; + int64_to_bytes fitness ] let to_int64 = function | [ version ; @@ -32,4 +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 diff --git a/src/proto/alpha/fitness_storage.ml b/src/proto/alpha/fitness_storage.ml index 1996c2166..47683b625 100644 --- a/src/proto/alpha/fitness_storage.ml +++ b/src/proto/alpha/fitness_storage.ml @@ -7,16 +7,17 @@ (* *) (**************************************************************************) -let increase ctxt = - Storage.Current_fitness.get ctxt >>=? fun fitness -> - Storage.Current_fitness.set ctxt (Int64.succ fitness) - -let raw_get = Storage.Current_fitness.get -let raw_read = Fitness_repr.to_int64 - let get ctxt = - Storage.Current_fitness.get ctxt >>=? fun fitness -> - Fitness_repr.from_int64 fitness + Storage.get_fitness ctxt >>= fun fitness -> + Fitness_repr.to_int64 fitness -let init ctxt = - Storage.Current_fitness.init ctxt 0L +let set ctxt v = + Storage.set_fitness ctxt (Fitness_repr.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 init ctxt = set ctxt 0L diff --git a/src/proto/alpha/init_storage.ml b/src/proto/alpha/init_storage.ml index 957503994..d97d14140 100644 --- a/src/proto/alpha/init_storage.ml +++ b/src/proto/alpha/init_storage.ml @@ -21,10 +21,10 @@ let initialize ~from_genesis (ctxt:Context.t) = Storage.Current_timestamp.init_set store time >>=? fun store -> begin if from_genesis then - return store + Lwt.return store else Fitness_storage.init store - end >>=? fun store -> + end >>= fun store -> Level_storage.init store >>=? fun store -> Roll_storage.init store >>=? fun store -> Nonce_storage.init store >>=? fun store -> diff --git a/src/proto/alpha/main.ml b/src/proto/alpha/main.ml index 6b07d6bdf..5003a901f 100644 --- a/src/proto/alpha/main.ml +++ b/src/proto/alpha/main.ml @@ -30,14 +30,6 @@ let max_block_length = let rpc_services = Services_registration.rpc_services -let fitness ctxt = - begin - Tezos_context.init ctxt >>=? fun ctxt -> - Tezos_context.Fitness.get ctxt - end >|= function - | Ok fitness -> fitness - | Error _ -> [] - let apply ctxt header ops = Apply.apply ctxt true header ops let preapply = Apply.preapply diff --git a/src/proto/alpha/mining.ml b/src/proto/alpha/mining.ml index 1815764da..a50468353 100644 --- a/src/proto/alpha/mining.ml +++ b/src/proto/alpha/mining.ml @@ -186,8 +186,8 @@ let max_fitness_gap ctxt = type error += Invalid_fitness_gap let check_fitness_gap ctxt (block : Block.header) = - Fitness.raw_get ctxt >>=? fun current_fitness -> - Fitness.raw_read block.shell.fitness >>=? fun announced_fitness -> + Fitness.get ctxt >>=? fun current_fitness -> + 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 diff --git a/src/proto/alpha/storage.ml b/src/proto/alpha/storage.ml index 8fdfb7252..351ef9c70 100644 --- a/src/proto/alpha/storage.ml +++ b/src/proto/alpha/storage.ml @@ -18,6 +18,10 @@ 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_sandboxed c = Context.get c sandboxed_key >>= function | None -> return None diff --git a/src/proto/alpha/storage.mli b/src/proto/alpha/storage.mli index 6c20b856e..30f6a66d7 100644 --- a/src/proto/alpha/storage.mli +++ b/src/proto/alpha/storage.mli @@ -34,6 +34,9 @@ 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 get_prevalidation : t -> bool Lwt.t val set_prevalidation : t -> t Lwt.t @@ -53,12 +56,6 @@ module Current_timestamp : Single_data_storage with type value = Time.t and type context := t -(** The fitness of the current block, which is the number of ancestor - blocks in the chain as an [int64] *) -module Current_fitness : Single_data_storage - with type value = int64 - and type context := t - module Roll : sig (** Storage from this submodule must only be accessed through the diff --git a/src/proto/alpha/tezos_context.mli b/src/proto/alpha/tezos_context.mli index bb59fd7f3..e89cf4a40 100644 --- a/src/proto/alpha/tezos_context.mli +++ b/src/proto/alpha/tezos_context.mli @@ -253,11 +253,10 @@ module Fitness : sig include (module type of Fitness) type t = fitness - val get: context -> fitness tzresult Lwt.t val increase: context -> context tzresult Lwt.t - val raw_get: context -> int64 tzresult Lwt.t - val raw_read: fitness -> int64 tzresult Lwt.t + val get: context -> int64 tzresult Lwt.t + val to_int64: fitness -> int64 tzresult Lwt.t end diff --git a/src/proto/demo/main.ml b/src/proto/demo/main.ml index 9e184ecdf..e4b578b0b 100644 --- a/src/proto/demo/main.ml +++ b/src/proto/demo/main.ml @@ -18,37 +18,54 @@ let max_number_of_operations = 42 let parse_block _ = Ok () let parse_operation h _ = Ok h -let fitness_key = ["v1";"store";"fitness"] +module Fitness = struct -let get_fitness ctxt = - Context.get ctxt fitness_key >>= function - | None -> Lwt.return 0L - | Some b -> - match Data_encoding.Binary.of_bytes Data_encoding.int64 b with - | None -> Lwt.return 0L - | Some v -> Lwt.return v + let version_number = "\000" -let set_fitness ctxt v = - Context.set ctxt fitness_key @@ - Data_encoding.Binary.to_bytes Data_encoding.int64 v + type error += Invalid_fitness + type error += Invalid_fitness2 -let int64_to_bytes i = - let b = MBytes.create 8 in - MBytes.set_int64 b 0 i; - b + let int64_to_bytes i = + let b = MBytes.create 8 in + MBytes.set_int64 b 0 i; + b -let fitness ctxt = - get_fitness ctxt >|= fun v -> - [ MBytes.of_string "\000" ; - int64_to_bytes v ] + let int64_of_bytes b = + if Compare.Int.(MBytes.length b <> 8) then + fail Invalid_fitness2 + else + return (MBytes.get_int64 b 0) -let increase_fitness ctxt = - get_fitness ctxt >>= fun v -> - set_fitness ctxt (Int64.succ v) >>= fun ctxt -> - Lwt.return ctxt + let from_int64 fitness = + [ MBytes.of_string version_number ; + int64_to_bytes fitness ] + + let to_int64 = function + | [ version ; + fitness ] + when Compare.String. + (MBytes.to_string version = version_number) -> + 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 + +end let apply ctxt () _operations = - increase_fitness ctxt >>= fun ctxt -> + Fitness.increase ctxt >>=? fun ctxt -> return ctxt let preapply context _block_pred _timestamp _sort operations = diff --git a/src/proto/environment/context.mli b/src/proto/environment/context.mli index 762ea90eb..f9ccae1d5 100644 --- a/src/proto/environment/context.mli +++ b/src/proto/environment/context.mli @@ -5,6 +5,9 @@ open Hash include Persist.STORE +val get_fitness: t -> Fitness.fitness Lwt.t +val set_fitness: t -> Fitness.fitness -> t Lwt.t + val get_genesis_time: t -> Time.t Lwt.t val get_genesis_block: t -> Block_hash.t Lwt.t diff --git a/src/proto/environment/updater.mli b/src/proto/environment/updater.mli index 0f0e08706..492b3ec34 100644 --- a/src/proto/environment/updater.mli +++ b/src/proto/environment/updater.mli @@ -110,10 +110,6 @@ module type PROTOCOL = sig Context.t -> Block_hash.t -> Time.t -> bool -> operation list -> (Context.t * error preapply_result) tzresult Lwt.t - (** The context rating function to determine the winning block chain. *) - val fitness : - Context.t -> Fitness.fitness Lwt.t - (** The list of remote procedures exported by this implementation *) val rpc_services : Context.t RPC.directory diff --git a/src/proto/genesis/data.ml b/src/proto/genesis/data.ml index e3ad79c3b..e817cd605 100644 --- a/src/proto/genesis/data.ml +++ b/src/proto/genesis/data.ml @@ -53,51 +53,6 @@ module Command = struct end -module Fitness = struct - - let fitness_key = ["v1";"store";"fitness"] - - let get ctxt = - Context.get ctxt fitness_key >>= function - | None -> Lwt.return 0L - | Some b -> - match Data_encoding.Binary.of_bytes Data_encoding.int64 b with - | None -> Lwt.return 0L - | Some v -> Lwt.return v - - let set ctxt v = - Context.set ctxt fitness_key @@ - Data_encoding.Binary.to_bytes Data_encoding.int64 v - - type error += Invalid_fitness - - let int64_to_bytes i = - let b = MBytes.create 8 in - MBytes.set_int64 b 0 i; - b - - let int64_of_bytes b = - if Compare.Int.(MBytes.length b <> 8) then - Error [Invalid_fitness] - else - Ok (MBytes.get_int64 b 0) - - let version_number = "\000" - - let from_int64 fitness = - [ MBytes.of_string version_number ; - int64_to_bytes fitness ] - - let to_int64 = function - | [ version ; - fitness ] - when Compare.String. - (MBytes.to_string version = version_number) -> - int64_of_bytes fitness - | _ -> Error [Invalid_fitness] - -end - module Pubkey = struct let pubkey_key = ["genesis_key"] diff --git a/src/proto/genesis/main.ml b/src/proto/genesis/main.ml index b5266cd18..3945d7992 100644 --- a/src/proto/genesis/main.ml +++ b/src/proto/genesis/main.ml @@ -39,7 +39,6 @@ let max_number_of_operations = 0 type block = { shell: Updater.shell_block ; - fitness: Int64.t ; command: Data.Command.t ; signature: Ed25519.signature ; } @@ -52,9 +51,7 @@ let max_block_length = let parse_block { Updater.shell ; proto } : block tzresult = match Data_encoding.Binary.of_bytes Data.Command.signed_encoding proto with | None -> Error [Parsing_error] - | Some (command, signature) -> - Data.Fitness.to_int64 shell.fitness >>? fun fitness -> - Ok { shell ; fitness ; command ; signature } + | Some (command, signature) -> Ok { shell ; command ; signature } let check_signature ctxt { shell ; command ; signature } = let bytes = Data.Command.forge shell command in @@ -63,14 +60,10 @@ let check_signature ctxt { shell ; command ; signature } = (Ed25519.check_signature public_key signature bytes) Invalid_signature -let fitness ctxt = - Data.Fitness.get ctxt >>= fun fitness -> - Lwt.return (Data.Fitness.from_int64 fitness) - let apply ctxt header _ops = check_signature ctxt header >>=? fun () -> Data.Init.may_initialize ctxt >>=? fun ctxt -> - Data.Fitness.set ctxt header.fitness >>= fun ctxt -> + Context.set_fitness ctxt header.shell.fitness >>= fun ctxt -> match header.command with | Activate hash -> Updater.activate ctxt hash >>= fun ctxt -> diff --git a/src/proto/genesis/services.ml b/src/proto/genesis/services.ml index cd46b5bce..acec82c3f 100644 --- a/src/proto/genesis/services.ml +++ b/src/proto/genesis/services.ml @@ -48,6 +48,11 @@ module Forge = struct RPC.Path.(custom_root / "helpers" / "forge" / "block") end +let int64_to_bytes i = + let b = MBytes.create 8 in + MBytes.set_int64 b 0 i; + b + let rpc_services : Context.t RPC.directory = let dir = RPC.empty in let dir = @@ -55,7 +60,7 @@ let rpc_services : Context.t RPC.directory = dir (Forge.block RPC.Path.root) (fun _ctxt ((net_id, predecessor, timestamp, fitness), command) -> - let fitness = Data.Fitness.from_int64 fitness in + let fitness = [ MBytes.of_string "\000" ; int64_to_bytes fitness ] in let shell = { Updater.net_id ; predecessor ; timestamp ; fitness ; operations = [] } in let bytes = Data.Command.forge shell command in