From ef3180c5616760abc8bdfe17d35a4b2f6c8f41fa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Fri, 31 Mar 2017 13:04:05 +0200 Subject: [PATCH] Shell: Smaller Net_id. --- src/client/client_node_rpcs.ml | 4 +- src/client/client_node_rpcs.mli | 12 +- .../embedded/alpha/client_proto_rpcs.mli | 26 ++-- src/node/db/context.ml | 4 +- src/node/db/context.mli | 4 +- src/node/db/store.ml | 45 +----- src/node/db/store.mli | 22 +-- src/node/shell/distributed_db.ml | 1 - src/node/shell/distributed_db_message.ml | 4 +- src/node/shell/distributed_db_message.mli | 2 - src/node/shell/node.ml | 10 +- src/node/shell/node.mli | 2 +- src/node/shell/node_rpc_services.ml | 21 +-- src/node/shell/node_rpc_services.mli | 14 +- src/node/shell/prevalidator.ml | 2 +- src/node/shell/state.ml | 47 +++--- src/node/shell/state.mli | 4 +- src/node/shell/validator.ml | 34 ++--- src/node/shell/validator.mli | 4 +- src/node/updater/protocol.mli | 2 - src/node/updater/updater.ml | 2 - src/node/updater/updater.mli | 5 - src/proto/alpha/services.ml | 2 +- src/proto/environment/hash.mli | 2 + src/proto/environment/updater.mli | 5 - src/proto/genesis/services.ml | 2 +- src/utils/base58.ml | 3 + src/utils/base58.mli | 1 + src/utils/hash.ml | 143 +++++++++++++++++- src/utils/hash.mli | 5 + test/test_context.ml | 2 +- test/test_state.ml | 2 +- test/test_store.ml | 2 +- 33 files changed, 260 insertions(+), 180 deletions(-) diff --git a/src/client/client_node_rpcs.ml b/src/client/client_node_rpcs.ml index a55c29152..9a6761267 100644 --- a/src/client/client_node_rpcs.ml +++ b/src/client/client_node_rpcs.ml @@ -167,9 +167,9 @@ module Blocks = struct operations_hash: Operation_list_list_hash.t ; operations: Operation_hash.t list list option ; data: MBytes.t option ; - net: Updater.Net_id.t ; + net: Net_id.t ; test_protocol: Protocol_hash.t option ; - test_network: (Updater.Net_id.t * Time.t) option ; + test_network: (Net_id.t * Time.t) option ; } type preapply_param = Services.Blocks.preapply_param = { operations: Operation_hash.t list ; diff --git a/src/client/client_node_rpcs.mli b/src/client/client_node_rpcs.mli index 80660d008..be3794750 100644 --- a/src/client/client_node_rpcs.mli +++ b/src/client/client_node_rpcs.mli @@ -13,7 +13,7 @@ val errors: val forge_block: Client_commands.context -> - ?net:Updater.Net_id.t -> + ?net:Net_id.t -> ?predecessor:Block_hash.t -> ?timestamp:Time.t -> Fitness.fitness -> @@ -28,7 +28,7 @@ val forge_block: val validate_block: Client_commands.context -> - Updater.Net_id.t -> Block_hash.t -> + Net_id.t -> Block_hash.t -> unit tzresult Lwt.t val inject_block: @@ -65,7 +65,7 @@ module Blocks : sig val net: Client_commands.context -> - block -> Updater.Net_id.t Lwt.t + block -> Net_id.t Lwt.t val predecessor: Client_commands.context -> block -> Block_hash.t Lwt.t @@ -92,7 +92,7 @@ module Blocks : sig block -> Protocol_hash.t option Lwt.t val test_network: Client_commands.context -> - block -> (Updater.Net_id.t * Time.t) option Lwt.t + block -> (Net_id.t * Time.t) option Lwt.t val pending_operations: Client_commands.context -> @@ -107,9 +107,9 @@ module Blocks : sig operations_hash: Operation_list_list_hash.t ; operations: Operation_hash.t list list option ; data: MBytes.t option ; - net: Updater.Net_id.t ; + net: Net_id.t ; test_protocol: Protocol_hash.t option ; - test_network: (Updater.Net_id.t * Time.t) option ; + test_network: (Net_id.t * Time.t) option ; } val info: diff --git a/src/client/embedded/alpha/client_proto_rpcs.mli b/src/client/embedded/alpha/client_proto_rpcs.mli index a1b5ead37..82e3cd295 100644 --- a/src/client/embedded/alpha/client_proto_rpcs.mli +++ b/src/client/embedded/alpha/client_proto_rpcs.mli @@ -187,7 +187,7 @@ module Helpers : sig val operations: Client_commands.context -> block -> - net:Updater.Net_id.t -> + net:Net_id.t -> source:Contract.t -> ?sourcePubKey:public_key -> counter:int32 -> @@ -197,7 +197,7 @@ module Helpers : sig val transaction: Client_commands.context -> block -> - net:Updater.Net_id.t -> + net:Net_id.t -> source:Contract.t -> ?sourcePubKey:public_key -> counter:int32 -> @@ -209,7 +209,7 @@ module Helpers : sig val origination: Client_commands.context -> block -> - net:Updater.Net_id.t -> + net:Net_id.t -> source:Contract.t -> ?sourcePubKey:public_key -> counter:int32 -> @@ -225,7 +225,7 @@ module Helpers : sig val delegation: Client_commands.context -> block -> - net:Updater.Net_id.t -> + net:Net_id.t -> source:Contract.t -> ?sourcePubKey:public_key -> counter:int32 -> @@ -237,19 +237,19 @@ module Helpers : sig val operation: Client_commands.context -> block -> - net:Updater.Net_id.t -> + net:Net_id.t -> dictator_operation -> MBytes.t tzresult Lwt.t val activate: Client_commands.context -> block -> - net:Updater.Net_id.t -> + net:Net_id.t -> Protocol_hash.t -> MBytes.t tzresult Lwt.t val activate_testnet: Client_commands.context -> block -> - net:Updater.Net_id.t -> + net:Net_id.t -> Protocol_hash.t -> MBytes.t tzresult Lwt.t end @@ -257,14 +257,14 @@ module Helpers : sig val operations: Client_commands.context -> block -> - net:Updater.Net_id.t -> + net:Net_id.t -> source:public_key -> delegate_operation list -> MBytes.t tzresult Lwt.t val endorsement: Client_commands.context -> block -> - net:Updater.Net_id.t -> + net:Net_id.t -> source:public_key -> block:Block_hash.t -> slot:int -> @@ -274,27 +274,27 @@ module Helpers : sig val operations: Client_commands.context -> block -> - net:Updater.Net_id.t -> + net:Net_id.t -> anonymous_operation list -> MBytes.t tzresult Lwt.t val seed_nonce_revelation: Client_commands.context -> block -> - net:Updater.Net_id.t -> + net:Net_id.t -> level:Raw_level.t -> nonce:Nonce.t -> unit -> MBytes.t tzresult Lwt.t val faucet: Client_commands.context -> block -> - net:Updater.Net_id.t -> + net:Net_id.t -> id:public_key_hash -> unit -> MBytes.t tzresult Lwt.t end val block: Client_commands.context -> block -> - net:Updater.Net_id.t -> + net:Net_id.t -> predecessor:Block_hash.t -> timestamp:Time.t -> fitness:Fitness.t -> diff --git a/src/node/db/context.ml b/src/node/db/context.ml index 2fd7d1b2e..54338d8f2 100644 --- a/src/node/db/context.ml +++ b/src/node/db/context.ml @@ -305,9 +305,9 @@ let set_test_protocol v data = let get_test_network v = raw_get v current_test_network_key >>= function | None -> Lwt.return_none - | Some data -> Lwt.return (Some (Store.Net_id.of_bytes_exn data)) + | Some data -> Lwt.return (Some (Net_id.of_bytes_exn data)) let set_test_network v id = - raw_set v current_test_network_key (Store.Net_id.to_bytes id) + raw_set v current_test_network_key (Net_id.to_bytes id) let del_test_network v = raw_del v current_test_network_key let get_test_network_expiration v = diff --git a/src/node/db/context.mli b/src/node/db/context.mli index 150c8eda1..67339fcf2 100644 --- a/src/node/db/context.mli +++ b/src/node/db/context.mli @@ -50,8 +50,8 @@ val set_protocol: context -> Protocol_hash.t -> context Lwt.t val get_test_protocol: context -> Protocol_hash.t Lwt.t val set_test_protocol: context -> Protocol_hash.t -> context Lwt.t -val get_test_network: context -> Store.Net_id.t option Lwt.t -val set_test_network: context -> Store.Net_id.t -> context Lwt.t +val get_test_network: context -> Net_id.t option Lwt.t +val set_test_network: context -> Net_id.t -> context Lwt.t val del_test_network: context -> context Lwt.t val get_test_network_expiration: context -> Time.t option Lwt.t diff --git a/src/node/db/store.ml b/src/node/db/store.ml index a59d17fb6..4fb28b30a 100644 --- a/src/node/db/store.ml +++ b/src/node/db/store.ml @@ -16,45 +16,6 @@ type global_store = t * Net store under "net/" **************************************************************************) -module Net_id = struct - - module T = struct - type t = Id of Block_hash.t - type net_id = t - - let encoding = - let open Data_encoding in - conv - (fun (Id net_id) -> net_id) - (fun net_id -> Id net_id) - Block_hash.encoding - - let pp ppf (Id id) = Block_hash.pp_short ppf id - let compare (Id id1) (Id id2) = Block_hash.compare id1 id2 - let equal (Id id1) (Id id2) = Block_hash.equal id1 id2 - let hash (Id id) = - let raw_hash = Block_hash.to_string id in - let int64_hash = EndianString.BigEndian.get_int64 raw_hash 0 in - Int64.to_int int64_hash - - let to_path (Id id) = Block_hash.to_path id - let of_path p = - match Block_hash.of_path p with - | None -> None - | Some id -> Some (Id id) - let path_length = Block_hash.path_length - let of_bytes_exn data = Id (Block_hash.of_bytes_exn data) - let to_bytes (Id id) = Block_hash.to_bytes id - - end - - include T - module Set = Set.Make(T) - module Map = Map.Make(T) - module Table = Hashtbl.Make(T) - -end - module Net = struct type store = global_store * Net_id.t @@ -70,6 +31,12 @@ module Net = struct Indexed_store.fold_indexes t ~init:[] ~f:(fun h acc -> Lwt.return (h :: acc)) + module Genesis_hash = + Store_helpers.Make_single_store + (Indexed_store.Store) + (struct let name = ["genesis" ; "hash"] end) + (Store_helpers.Make_value(Block_hash)) + module Genesis_time = Store_helpers.Make_single_store (Indexed_store.Store) diff --git a/src/node/db/store.mli b/src/node/db/store.mli index 0bfc19d33..10da00986 100644 --- a/src/node/db/store.mli +++ b/src/node/db/store.mli @@ -18,24 +18,6 @@ val init: string -> t tzresult Lwt.t (** {2 Net store} ************************************************************) -module Net_id : sig - - type t = Id of Block_hash.t - type net_id = t - val encoding: net_id Data_encoding.t - val pp: Format.formatter -> net_id -> unit - val compare: net_id -> net_id -> int - val equal: net_id -> net_id -> bool - - val of_bytes_exn: MBytes.t -> net_id - val to_bytes: net_id -> MBytes.t - - module Set : Set.S with type elt = t - module Map : Map.S with type key = t - module Table : Hashtbl.S with type key = t - -end - module Net : sig val list: global_store -> Net_id.t list Lwt.t @@ -44,6 +26,10 @@ module Net : sig type store val get: global_store -> Net_id.t -> store + module Genesis_hash : SINGLE_STORE + with type t := store + and type value := Block_hash.t + module Genesis_time : SINGLE_STORE with type t := store and type value := Time.t diff --git a/src/node/shell/distributed_db.ml b/src/node/shell/distributed_db.ml index d2b56e8b3..a4e8720ed 100644 --- a/src/node/shell/distributed_db.ml +++ b/src/node/shell/distributed_db.ml @@ -7,7 +7,6 @@ (* *) (**************************************************************************) -module Net_id = State.Net_id module Message = Distributed_db_message module Metadata = Distributed_db_metadata diff --git a/src/node/shell/distributed_db_message.ml b/src/node/shell/distributed_db_message.ml index 45c86ec14..49320ed7e 100644 --- a/src/node/shell/distributed_db_message.ml +++ b/src/node/shell/distributed_db_message.ml @@ -7,8 +7,6 @@ (* *) (**************************************************************************) -module Net_id = Store.Net_id - type t = | Get_current_branch of Net_id.t @@ -38,7 +36,7 @@ let encoding = [ case ~tag:0x10 (obj1 - (req "get_current_branch" Store.Net_id.encoding)) + (req "get_current_branch" Net_id.encoding)) (function | Get_current_branch net_id -> Some net_id | _ -> None) diff --git a/src/node/shell/distributed_db_message.mli b/src/node/shell/distributed_db_message.mli index 0161acf58..505073ba1 100644 --- a/src/node/shell/distributed_db_message.mli +++ b/src/node/shell/distributed_db_message.mli @@ -7,8 +7,6 @@ (* *) (**************************************************************************) -module Net_id = Store.Net_id - type t = | Get_current_branch of Net_id.t diff --git a/src/node/shell/node.ml b/src/node/shell/node.ml index 5cf95f3d1..7ee15175e 100644 --- a/src/node/shell/node.ml +++ b/src/node/shell/node.ml @@ -93,7 +93,7 @@ type config = { } let may_create_net state ?test_protocol genesis = - State.Net.get state (State.Net_id.Id genesis.State.Net.block) >>= function + State.Net.get state (Net_id.of_block_hash genesis.State.Net.block) >>= function | Ok net -> Lwt.return net | Error _ -> State.Net.create state @@ -145,9 +145,9 @@ module RPC = struct operations_hash: Operation_list_list_hash.t ; operations: Operation_hash.t list list option ; data: MBytes.t option ; - net: Node_rpc_services.Blocks.net ; + net: Net_id.t ; test_protocol: Protocol_hash.t option ; - test_network: (Node_rpc_services.Blocks.net * Time.t) option ; + test_network: (Net_id.t * Time.t) option ; } let convert (block: State.Valid_block.t) = { @@ -213,14 +213,14 @@ module RPC = struct let get_validator_per_hash node hash = Distributed_db.read_block_exn node.distributed_db hash >>= fun (_net_db, block) -> - if State.Net_id.equal + if Net_id.equal (State.Net.id node.mainnet_net) block.shell.net_id then Lwt.return (Some (node.mainnet_validator, node.mainnet_db)) else match Validator.test_validator node.mainnet_validator with | Some (test_validator, net_db) - when State.Net_id.equal + when Net_id.equal (State.Net.id (Validator.net_state test_validator)) block.shell.net_id -> Lwt.return (Some (node.mainnet_validator, net_db)) diff --git a/src/node/shell/node.mli b/src/node/shell/node.mli index e5b26bb9c..502682f43 100644 --- a/src/node/shell/node.mli +++ b/src/node/shell/node.mli @@ -84,7 +84,7 @@ module RPC : sig Operation_hash.t list -> (Protocol.fitness * error Updater.preapply_result) tzresult Lwt.t - val validate: t -> State.Net_id.t -> Block_hash.t -> unit tzresult Lwt.t + val validate: t -> Net_id.t -> Block_hash.t -> unit tzresult Lwt.t val context_dir: t -> block -> 'a RPC.directory option Lwt.t diff --git a/src/node/shell/node_rpc_services.ml b/src/node/shell/node_rpc_services.ml index 27f79e75f..7084de800 100644 --- a/src/node/shell/node_rpc_services.ml +++ b/src/node/shell/node_rpc_services.ml @@ -55,11 +55,6 @@ module Blocks = struct | `Hash of Block_hash.t ] - type net = State.Net_id.t = Id of Block_hash.t - - let net_encoding = - conv (fun (Id id) -> id) (fun id -> Id id) Block_hash.encoding - type block_info = { hash: Block_hash.t ; predecessor: Block_hash.t ; @@ -69,9 +64,9 @@ module Blocks = struct operations_hash: Operation_list_list_hash.t ; operations: Operation_hash.t list list option ; data: MBytes.t option ; - net: net ; + net: Net_id.t ; test_protocol: Protocol_hash.t option ; - test_network: (net * Time.t) option ; + test_network: (Net_id.t * Time.t) option ; } let block_info_encoding = @@ -99,9 +94,9 @@ module Blocks = struct (req "operations_hash" Operation_list_list_hash.encoding) (opt "operations" (list (list Operation_hash.encoding))) (opt "data" bytes) - (req "net" net_encoding) + (req "net" Net_id.encoding) (opt "test_protocol" Protocol_hash.encoding) - (opt "test_network" (tup2 net_encoding Time.encoding)))) + (opt "test_network" (tup2 Net_id.encoding Time.encoding)))) let parse_block s = try @@ -195,7 +190,7 @@ module Blocks = struct RPC.service ~description:"Returns the net of the chain in which the block belongs." ~input: empty - ~output: (obj1 (req "net" net_encoding)) + ~output: (obj1 (req "net" Net_id.encoding)) RPC.Path.(block_path / "net") let predecessor = @@ -260,7 +255,7 @@ module Blocks = struct RPC.service ~description:"Returns the associated test network." ~input: empty - ~output: (obj1 (opt "net" (tup2 net_encoding Time.encoding))) + ~output: (obj1 (opt "net" (tup2 Net_id.encoding Time.encoding))) RPC.Path.(block_path / "test_network") let pending_operations = @@ -642,7 +637,7 @@ let forge_block = ~description: "Forge a block header" ~input: (obj6 - (opt "net_id" Updater.Net_id.encoding) + (opt "net_id" Net_id.encoding) (opt "predecessor" Block_hash.encoding) (opt "timestamp" Time.encoding) (req "fitness" Fitness.encoding) @@ -657,7 +652,7 @@ let validate_block = "Force the node to fetch and validate the given block hash." ~input: (obj2 - (req "net" Blocks.net_encoding) + (req "net" Net_id.encoding) (req "hash" Block_hash.encoding)) ~output: (Error.wrap @@ empty) diff --git a/src/node/shell/node_rpc_services.mli b/src/node/shell/node_rpc_services.mli index d06337209..2c399aba8 100644 --- a/src/node/shell/node_rpc_services.mli +++ b/src/node/shell/node_rpc_services.mli @@ -26,8 +26,6 @@ module Blocks : sig val parse_block: string -> (block, string) result val to_string: block -> string - type net = State.Net_id.t = Id of Block_hash.t - type block_info = { hash: Block_hash.t ; predecessor: Block_hash.t ; @@ -37,15 +35,15 @@ module Blocks : sig operations_hash: Operation_list_list_hash.t ; operations: Operation_hash.t list list option ; data: MBytes.t option ; - net: net ; + net: Net_id.t ; test_protocol: Protocol_hash.t option ; - test_network: (net * Time.t) option ; + test_network: (Net_id.t * Time.t) option ; } val info: (unit, unit * block, bool * bool, block_info) RPC.service val net: - (unit, unit * block, unit, net) RPC.service + (unit, unit * block, unit, Net_id.t) RPC.service val predecessor: (unit, unit * block, unit, Block_hash.t) RPC.service val predecessors: @@ -63,7 +61,7 @@ module Blocks : sig val test_protocol: (unit, unit * block, unit, Protocol_hash.t option) RPC.service val test_network: - (unit, unit * block, unit, (net * Time.t) option) RPC.service + (unit, unit * block, unit, (Net_id.t * Time.t) option) RPC.service val pending_operations: (unit, unit * block, unit, error Updater.preapply_result * Hash.Operation_hash.Set.t) RPC.service @@ -170,12 +168,12 @@ end val forge_block: (unit, unit, - Updater.Net_id.t option * Block_hash.t option * Time.t option * + Net_id.t option * Block_hash.t option * Time.t option * Fitness.fitness * Operation_list_list_hash.t * MBytes.t, MBytes.t) RPC.service val validate_block: - (unit, unit, Blocks.net * Block_hash.t, unit tzresult) RPC.service + (unit, unit, Net_id.t * Block_hash.t, unit tzresult) RPC.service type inject_block_param = { raw: MBytes.t ; diff --git a/src/node/shell/prevalidator.ml b/src/node/shell/prevalidator.ml index a2ae79087..58f8b26f6 100644 --- a/src/node/shell/prevalidator.ml +++ b/src/node/shell/prevalidator.ml @@ -400,7 +400,7 @@ let inject_operation pv ?(force = false) (op: Store.Operation.t) = failwith "unexpected protocol result" end >>=? fun errors -> Lwt.return (Error errors) in - fail_unless (Store.Net_id.equal net_id op.shell.net_id) + fail_unless (Net_id.equal net_id op.shell.net_id) (Unclassified "Prevalidator.inject_operation: invalid network") >>=? fun () -> pv.prevalidate_operations force [op] >>=? function diff --git a/src/node/shell/state.ml b/src/node/shell/state.ml index 7ef793bb3..bc4070dc2 100644 --- a/src/node/shell/state.ml +++ b/src/node/shell/state.ml @@ -9,8 +9,6 @@ open Logging.Node.State -module Net_id = Store.Net_id - type error += | Invalid_fitness of { block: Block_hash.t ; expected: Fitness.fitness ; @@ -55,7 +53,7 @@ let () = ~description:"TODO" ~pp:(fun ppf id -> Format.fprintf ppf "Unknown network %a" Net_id.pp id) - Data_encoding.(obj1 (req "net" Updater.Net_id.encoding)) + Data_encoding.(obj1 (req "net" Net_id.encoding)) (function Unknown_network x -> Some x | _ -> None) (fun x -> Unknown_network x) ; @@ -87,6 +85,7 @@ and global_data = { } and net = { + id: Net_id.t ; state: net_state Shared.t ; genesis: genesis ; expiration: Time.t option ; @@ -540,7 +539,7 @@ module Raw_block_header = struct let store_genesis store genesis = let shell : Store.Block_header.shell_header = { - net_id = Id genesis.block; + net_id = Net_id.of_block_hash genesis.block; predecessor = genesis.block ; timestamp = genesis.time ; fitness = [] ; @@ -556,7 +555,7 @@ module Raw_block_header = struct let store_testnet_genesis store genesis = let shell : Store.Block_header.shell_header = { - net_id = Id genesis.block; + net_id = Net_id.of_block_hash genesis.block; predecessor = genesis.block ; timestamp = genesis.time ; fitness = [] ; @@ -864,6 +863,7 @@ module Raw_net = struct context_index ; } in let net = { + id = Net_id.of_block_hash genesis.block ; state = Shared.create net_state ; genesis ; expiration ; @@ -878,18 +878,19 @@ module Raw_net = struct data ?initial_context ?forked_network_ttl ?test_protocol ?expiration genesis = - let net_store = - Store.Net.get data.global_store (Store.Net_id.Id genesis.block) in + let net_id = Net_id.of_block_hash genesis.block in + let net_store = Store.Net.get data.global_store net_id in let operation_store = Store.Operation.get net_store and block_header_store = Store.Block_header.get net_store and chain_store = Store.Chain.get net_store in + Store.Net.Genesis_hash.store net_store genesis.block >>= fun () -> Store.Net.Genesis_time.store net_store genesis.time >>= fun () -> Store.Net.Genesis_protocol.store net_store genesis.protocol >>= fun () -> let test_protocol = Utils.unopt ~default:genesis.protocol test_protocol in Store.Net.Genesis_test_protocol.store net_store test_protocol >>= fun () -> Store.Chain.Current_head.store chain_store genesis.block >>= fun () -> Store.Chain.Known_heads.store chain_store genesis.block >>= fun () -> - data.init_index (Id genesis.block) >>= fun context_index -> + data.init_index net_id >>= fun context_index -> begin match expiration with | None -> Lwt.return_unit @@ -1022,7 +1023,7 @@ module Valid_block = struct | Some ttl -> let eol = Time.(add block.shell.timestamp ttl) in Context.set_test_network - context (Store.Net_id.Id hash) >>= fun context -> + context (Net_id.of_block_hash hash) >>= fun context -> Context.set_test_network_expiration context eol >>= fun context -> Lwt.return context @@ -1096,7 +1097,7 @@ module Valid_block = struct Watcher.create_stream net.valid_block_watcher let fork_testnet state net block expiration = - assert (Net_id.equal block.net_id (Net_id.Id net.genesis.block)) ; + assert (Net_id.equal block.net_id (Net_id.of_block_hash net.genesis.block)) ; let hash = Block_hash.hash_bytes [Block_hash.to_bytes block.hash] in let genesis : genesis = { block = hash ; @@ -1104,7 +1105,7 @@ module Valid_block = struct protocol = block.test_protocol_hash ; } in Shared.use state.global_data begin fun data -> - if Net_id.Table.mem data.nets (Net_id.Id hash) then + if Net_id.Table.mem data.nets (Net_id.of_block_hash hash) then assert false (* This would mean a block is validated twice... *) else Context.init_test_network block.context @@ -1120,9 +1121,9 @@ module Valid_block = struct module Helpers = struct let path net b1 b2 = - let net_id = Store.Net_id.Id net.genesis.block in - if not ( Store.Net_id.equal b1.net_id net_id - && Store.Net_id.equal b2.net_id net_id ) then + let net_id = Net_id.of_block_hash net.genesis.block in + if not ( Net_id.equal b1.net_id net_id + && Net_id.equal b2.net_id net_id ) then invalid_arg "State.path" ; Raw_helpers.path net.block_header_store b1.hash b2.hash >>= function | None -> Lwt.return_none @@ -1132,9 +1133,9 @@ module Valid_block = struct Lwt.return (Some path) let common_ancestor net b1 b2 = - let net_id = Store.Net_id.Id net.genesis.block in - if not ( Store.Net_id.equal b1.net_id net_id - && Store.Net_id.equal b2.net_id net_id ) then + let net_id = Net_id.of_block_hash net.genesis.block in + if not ( Net_id.equal b1.net_id net_id + && Net_id.equal b2.net_id net_id ) then invalid_arg "State.path" ; Raw_block_header.read_exn (* The blocks are known valid. *) net.block_header_store b1.hash >>= fun { shell = header1 } -> @@ -1304,7 +1305,7 @@ module Net = struct type t = net type net = t - type nonrec genesis = genesis ={ + type nonrec genesis = genesis = { time: Time.t ; block: Block_hash.t ; protocol: Protocol_hash.t ; @@ -1320,22 +1321,24 @@ module Net = struct (req "protocol" Protocol_hash.encoding)) let create state ?test_protocol ?forked_network_ttl genesis = + let net_id = Net_id.of_block_hash genesis.block in let forked_network_ttl = map_option Int64.of_int forked_network_ttl in Shared.use state.global_data begin fun data -> - if Net_id.Table.mem data.nets (Net_id.Id genesis.block) then + if Net_id.Table.mem data.nets net_id then Pervasives.failwith "State.Net.create" else Raw_net.locked_create data ?test_protocol ?forked_network_ttl genesis >>= fun net -> - Net_id.Table.add data.nets (Net_id.Id genesis.block) net ; + Net_id.Table.add data.nets net_id net ; Lwt.return net end - let locked_read data (Net_id.Id genesis_hash as id) = + let locked_read data id = let net_store = Store.Net.get data.global_store id in let operation_store = Store.Operation.get net_store and block_header_store = Store.Block_header.get net_store and chain_store = Store.Chain.get net_store in + Store.Net.Genesis_hash.read net_store >>=? fun genesis_hash -> Store.Net.Genesis_time.read net_store >>=? fun time -> Store.Net.Genesis_protocol.read net_store >>=? fun protocol -> Store.Net.Expiration.read_opt net_store >>= fun expiration -> @@ -1387,7 +1390,7 @@ module Net = struct Net_id.Table.fold (fun _ net acc -> net :: acc) nets [] end - let id { genesis = { block } } = Net_id.Id block + let id { id } = id let genesis { genesis } = genesis let expiration { expiration } = expiration let forked_network_ttl { forked_network_ttl } = forked_network_ttl diff --git a/src/node/shell/state.mli b/src/node/shell/state.mli index 9facb9aad..6cab88577 100644 --- a/src/node/shell/state.mli +++ b/src/node/shell/state.mli @@ -20,8 +20,6 @@ type t type global_state = t -module Net_id = Store.Net_id - (** Read the internal state of the node and initialize the blocks/operations/contexts databases. *) @@ -42,7 +40,7 @@ type error += | Invalid_operations of { block: Block_hash.t ; expected: Operation_list_list_hash.t ; found: Operation_hash.t list list } - | Unknown_network of Store.Net_id.t + | Unknown_network of Net_id.t | Unknown_operation of Operation_hash.t | Unknown_block of Block_hash.t | Unknown_protocol of Protocol_hash.t diff --git a/src/node/shell/validator.ml b/src/node/shell/validator.ml index c6f9358ed..f3d2aebce 100644 --- a/src/node/shell/validator.ml +++ b/src/node/shell/validator.ml @@ -11,8 +11,8 @@ open Logging.Node.Validator type worker = { activate: ?parent:t -> State.Net.t -> t Lwt.t ; - get: State.Net_id.t -> t tzresult Lwt.t ; - get_exn: State.Net_id.t -> t Lwt.t ; + get: Net_id.t -> t tzresult Lwt.t ; + get_exn: Net_id.t -> t Lwt.t ; deactivate: t -> unit Lwt.t ; inject_block: ?force:bool -> @@ -67,7 +67,7 @@ let may_change_test_network v (block: State.Valid_block.t) = | None, Some _ -> true | Some (net_id, _), Some { net } -> let net_id' = State.Net.id net in - not (State.Net_id.equal net_id net_id') in + not (Net_id.equal net_id net_id') in if change then begin v.create_child block >>= function | Ok () -> Lwt.return_unit @@ -149,7 +149,7 @@ let apply_block net db lwt_log_notice "validate block %a (after %a), net %a" Block_hash.pp_short hash Block_hash.pp_short block.shell.predecessor - State.Net_id.pp id + Net_id.pp id >>= fun () -> lwt_log_info "validation of %a: looking for dependencies..." Block_hash.pp_short hash >>= fun () -> @@ -495,7 +495,7 @@ let rec create_validator ?parent worker state db net = let new_blocks = ref Lwt.return_unit in let shutdown () = - lwt_log_notice "shutdown %a" State.Net_id.pp net_id >>= fun () -> + lwt_log_notice "shutdown %a" Net_id.pp net_id >>= fun () -> Distributed_db.deactivate net_db >>= fun () -> Lwt_pipe.close queue ; Lwt.join [ @@ -611,27 +611,27 @@ let rec create_validator ?parent worker state db net = Lwt.return v -type error += Unknown_network of State.Net_id.t +type error += Unknown_network of Net_id.t let create_worker state db = - let validators : t Lwt.t State.Net_id.Table.t = - Store.Net_id.Table.create 7 in + let validators : t Lwt.t Net_id.Table.t = + Net_id.Table.create 7 in let valid_block_input = Watcher.create_input () in - let get_exn net = State.Net_id.Table.find validators net in + let get_exn net = Net_id.Table.find validators net in let get net = try get_exn net >>= fun v -> return v with Not_found -> fail (State.Unknown_network net) in - let remove net = State.Net_id.Table.remove validators net in + let remove net = Net_id.Table.remove validators net in let deactivate { net } = let id = State.Net.id net in get id >>= function | Error _ -> Lwt.return_unit | Ok v -> - lwt_log_notice "deactivate network %a" State.Net_id.pp id >>= fun () -> + lwt_log_notice "deactivate network %a" Net_id.pp id >>= fun () -> remove id ; v.shutdown () in @@ -650,7 +650,7 @@ let create_worker state db = let net_maintenance () = lwt_log_info "net maintenance" >>= fun () -> let time = Time.now () in - Store.Net_id.Table.fold + Net_id.Table.fold (fun _ v acc -> v >>= fun v -> acc >>= fun () -> @@ -664,7 +664,7 @@ let create_worker state db = match State.Net.expiration net with | Some eol when Time.(eol <= time) -> lwt_log_notice "destroy network %a" - State.Net_id.pp (State.Net.id net) >>= fun () -> + Net_id.pp (State.Net.id net) >>= fun () -> State.Net.destroy state net | Some _ | None -> Lwt.return_unit) all_net >>= fun () -> @@ -707,7 +707,7 @@ let create_worker state db = let shutdown () = cancel () >>= fun () -> let validators = - Store.Net_id.Table.fold + Net_id.Table.fold (fun _ (v: t Lwt.t) acc -> (v >>= fun v -> v.shutdown ()) :: acc) validators [] in Lwt.join (maintenance_worker :: validators) in @@ -741,14 +741,14 @@ let create_worker state db = return (hash, validation) in let rec activate ?parent net = + let net_id = State.Net.id net in lwt_log_notice "activate network %a" - State.Net_id.pp (State.Net.id net) >>= fun () -> + Net_id.pp net_id >>= fun () -> State.Valid_block.Current.genesis net >>= fun genesis -> - let net_id = State.Net_id.Id genesis.hash in get net_id >>= function | Error _ -> let v = create_validator ?parent worker state db net in - Store.Net_id.Table.add validators net_id v ; + Net_id.Table.add validators net_id v ; v | Ok v -> Lwt.return v diff --git a/src/node/shell/validator.mli b/src/node/shell/validator.mli index 96d4d5b9b..e203cb357 100644 --- a/src/node/shell/validator.mli +++ b/src/node/shell/validator.mli @@ -21,8 +21,8 @@ type error += | Non_increasing_fitness val activate: worker -> State.Net.t -> t Lwt.t -val get: worker -> State.Net_id.t -> t tzresult Lwt.t -val get_exn: worker -> State.Net_id.t -> t Lwt.t +val get: worker -> Net_id.t -> t tzresult Lwt.t +val get_exn: worker -> Net_id.t -> t Lwt.t val deactivate: t -> unit Lwt.t val net_state: t -> State.Net.t diff --git a/src/node/updater/protocol.mli b/src/node/updater/protocol.mli index 01c1a98c0..70f274892 100644 --- a/src/node/updater/protocol.mli +++ b/src/node/updater/protocol.mli @@ -13,8 +13,6 @@ by length and then by contents lexicographically. *) type fitness = Fitness.fitness -module Net_id = Store.Net_id - (** The version agnostic toplevel structure of operations. *) type shell_operation = Store.Operation.shell_header = { net_id: Net_id.t ; diff --git a/src/node/updater/updater.ml b/src/node/updater/updater.ml index 9b2611727..eba04a444 100644 --- a/src/node/updater/updater.ml +++ b/src/node/updater/updater.ml @@ -19,8 +19,6 @@ module type REGISTRED_PROTOCOL = sig val complete_b58prefix : Context.t -> string -> string list Lwt.t end -module Net_id = Store.Net_id - type shell_operation = Store.Operation.shell_header = { net_id: Net_id.t ; } diff --git a/src/node/updater/updater.mli b/src/node/updater/updater.mli index fd8872f80..cc60f7597 100644 --- a/src/node/updater/updater.mli +++ b/src/node/updater/updater.mli @@ -7,11 +7,6 @@ (* *) (**************************************************************************) -module Net_id : sig - type t = Store.Net_id.t - val encoding : t Data_encoding.t -end - type shell_operation = Store.Operation.shell_header = { net_id: Net_id.t ; } diff --git a/src/proto/alpha/services.ml b/src/proto/alpha/services.ml index 03f97c580..f40724963 100644 --- a/src/proto/alpha/services.ml +++ b/src/proto/alpha/services.ml @@ -557,7 +557,7 @@ module Helpers = struct ~description: "Forge a block header" ~input: (obj9 - (req "net_id" Updater.Net_id.encoding) + (req "net_id" Net_id.encoding) (req "predecessor" Block_hash.encoding) (req "timestamp" Timestamp.encoding) (req "fitness" Fitness.encoding) diff --git a/src/proto/environment/hash.mli b/src/proto/environment/hash.mli index bc33d1081..479544675 100644 --- a/src/proto/environment/hash.mli +++ b/src/proto/environment/hash.mli @@ -134,3 +134,5 @@ module Operation_list_list_hash : (** Protocol versions / source hashes. *) module Protocol_hash : HASH + +module Net_id : HASH diff --git a/src/proto/environment/updater.mli b/src/proto/environment/updater.mli index 9e4891bd0..52e452f6a 100644 --- a/src/proto/environment/updater.mli +++ b/src/proto/environment/updater.mli @@ -2,11 +2,6 @@ open Hash -module Net_id : sig - type t - val encoding : t Data_encoding.t -end - type shell_operation = { net_id: Net_id.t ; } diff --git a/src/proto/genesis/services.ml b/src/proto/genesis/services.ml index 82eb7ab1e..9f981c84e 100644 --- a/src/proto/genesis/services.ml +++ b/src/proto/genesis/services.ml @@ -39,7 +39,7 @@ module Forge = struct ~input: (merge_objs (obj4 - (req "net_id" Updater.Net_id.encoding) + (req "net_id" Net_id.encoding) (req "predecessor" Block_hash.encoding) (req "timestamp" Time.encoding) (req "fitness" Fitness.encoding)) diff --git a/src/utils/base58.ml b/src/utils/base58.ml index 9df8c58ff..e3c349b95 100644 --- a/src/utils/base58.ml +++ b/src/utils/base58.ml @@ -309,4 +309,7 @@ module Prefix = struct let ed25519_secret_key = "\043\246\078\007" (* edsk(98) *) let ed25519_signature = "\009\245\205\134\018" (* edsig(99) *) + (* 4 *) + let net_id = "\087\082\000" (* Net(15) *) + end diff --git a/src/utils/base58.mli b/src/utils/base58.mli index 990efe81b..094ddc797 100644 --- a/src/utils/base58.mli +++ b/src/utils/base58.mli @@ -21,6 +21,7 @@ module Prefix : sig val ed25519_public_key: string val ed25519_secret_key: string val ed25519_signature: string + val net_id: string end diff --git a/src/utils/hash.ml b/src/utils/hash.ml index 73e7c8e13..64a31374f 100644 --- a/src/utils/hash.ml +++ b/src/utils/hash.ml @@ -517,9 +517,150 @@ module Generic_hash = let size = None end) +module Net_id = struct + + type t = string + type net_id = t + + let name = "Net_id" + let title = "Network identifier" + + let size = 4 + + let of_block_hash bh = + MBytes.substring (Block_hash.to_bytes bh) 0 4 + + let hash_bytes l = of_block_hash (Block_hash.hash_bytes l) + let hash_string l = of_block_hash (Block_hash.hash_string l) + + type Base58.data += Hash of t + + let of_string s = + if String.length s <> size then None else Some s + let of_string_exn s = + match of_string s with + | None -> + let msg = + Printf.sprintf "%s.of_string: wrong string size (%d)" + name (String.length s) in + raise (Invalid_argument msg) + | Some h -> h + let to_string s = s + + let of_hex s = of_string (Hex_encode.hex_decode s) + let of_hex_exn s = of_string_exn (Hex_encode.hex_decode s) + let to_hex s = Hex_encode.hex_encode (to_string s) + + let compare = String.compare + let equal = String.equal + + let of_bytes b = + if MBytes.length b <> size then + None + else + Some (MBytes.to_string b) + let of_bytes_exn b = + match of_bytes b with + | None -> + let msg = + Printf.sprintf "%s.of_bytes: wrong string size (%d)" + name (MBytes.length b) in + raise (Invalid_argument msg) + | Some h -> h + let to_bytes = MBytes.of_string + + let read src off = of_bytes_exn @@ MBytes.sub src off size + let write dst off h = MBytes.blit (to_bytes h) 0 dst off size + + let b58check_encoding = + Base58.register_encoding + ~prefix: Base58.Prefix.net_id + ~length: size + ~wrap: (fun s -> Hash s) + ~of_raw:of_string ~to_raw: (fun h -> h) + + let of_b58check s = + match Base58.simple_decode b58check_encoding s with + | Some x -> x + | None -> Format.kasprintf failwith "Unexpected hash (%s)" name + let to_b58check s = Base58.simple_encode b58check_encoding s + let to_short_b58check = to_b58check + + let encoding = + let open Data_encoding in + splitted + ~binary: (Fixed.string size) + ~json: + (describe ~title: (title ^ " (Base58Check-encoded Sha256)") @@ + conv to_b58check (Data_encoding.Json.wrap_error of_b58check) string) + + let param ?(name=name) ?(desc=title) t = + Cli_entries.param ~name ~desc (fun _ str -> Lwt.return (of_b58check str)) t + + let pp ppf t = + Format.pp_print_string ppf (to_b58check t) + + let pp_short ppf t = + Format.pp_print_string ppf (to_short_b58check t) + + module Set = struct + include Set.Make(struct type nonrec t = t let compare = compare end) + let encoding = + Data_encoding.conv + elements + (fun l -> List.fold_left (fun m x -> add x m) empty l) + Data_encoding.(list encoding) + end + + module Map = struct + include Map.Make(struct type nonrec t = t let compare = compare end) + let encoding arg_encoding = + Data_encoding.conv + bindings + (fun l -> List.fold_left (fun m (k,v) -> add k v m) empty l) + Data_encoding.(list (tup2 encoding arg_encoding)) + end + + let fold_read f buf off len init = + let last = off + len * size in + if last > MBytes.length buf then + invalid_arg "Hash.read_set: invalid size."; + let rec loop acc off = + if off >= last then + acc + else + let hash = read buf off in + loop (f hash acc) (off + size) + in + loop init off + + let path_length = 1 + let to_path key = [to_hex key] + let of_path path = + let path = String.concat "" path in + of_hex path + let of_path_exn path = + let path = String.concat "" path in + of_hex_exn path + + let prefix_path p = + let p = Hex_encode.hex_encode p in + [ p ] + + module Table = struct + include Hashtbl.Make(struct + type nonrec t = t + let hash = Hashtbl.hash + let equal = equal + end) + end + +end + let () = Base58.check_encoded_prefix Block_hash.b58check_encoding "B" 51 ; Base58.check_encoded_prefix Operation_hash.b58check_encoding "o" 51 ; Base58.check_encoded_prefix Operation_list_hash.b58check_encoding "Lo" 52 ; Base58.check_encoded_prefix Operation_list_list_hash.b58check_encoding "LLo" 53 ; - Base58.check_encoded_prefix Protocol_hash.b58check_encoding "P" 51 + Base58.check_encoded_prefix Protocol_hash.b58check_encoding "P" 51 ; + Base58.check_encoded_prefix Net_id.b58check_encoding "Net" 15 diff --git a/src/utils/hash.mli b/src/utils/hash.mli index d33218bc0..a69f77192 100644 --- a/src/utils/hash.mli +++ b/src/utils/hash.mli @@ -174,6 +174,11 @@ module Operation_list_list_hash : (** Protocol versions / source hashes. *) module Protocol_hash : INTERNAL_HASH +module Net_id : sig + include INTERNAL_HASH + val of_block_hash: Block_hash.t -> t +end + module Generic_hash : INTERNAL_MINIMAL_HASH (**/**) diff --git a/test/test_context.ml b/test/test_context.ml index 448fcd97c..85b7f55c4 100644 --- a/test/test_context.ml +++ b/test/test_context.ml @@ -33,7 +33,7 @@ let genesis : State.Net.genesis = { protocol = genesis_protocol ; } -let net_id = State.Net_id.Id genesis_block +let net_id = Net_id.of_block_hash genesis_block (** Context creation *) diff --git a/test/test_state.ml b/test/test_state.ml index 6484bcfa7..7b3e866de 100644 --- a/test/test_state.ml +++ b/test/test_state.ml @@ -33,7 +33,7 @@ let genesis : State.Net.genesis = { protocol = genesis_protocol ; } -let net_id = State.Net_id.Id genesis_block +let net_id = Net_id.of_block_hash genesis_block let incr_fitness fitness = let new_fitness = diff --git a/test/test_store.ml b/test/test_store.ml index b9f908809..c72ad3ae4 100644 --- a/test/test_store.ml +++ b/test/test_store.ml @@ -58,7 +58,7 @@ let wrap_raw_store_init f base_dir = let test_init _ = Lwt.return_unit -let net_id = State.Net_id.Id genesis_block +let net_id = Net_id.of_block_hash genesis_block (** Operation store *)