balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Shell: Smaller Net_id.

Browse Source
This commit is contained in:
Grégoire Henry 2017-03-31 13:04:05 +02:00
parent ffc8fa0383
commit ef3180c561
33 changed files with 260 additions and 180 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/client/client_node_rpcs.ml
View File

@ -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 ;

12
src/client/client_node_rpcs.mli
View File

@ -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:

26
src/client/embedded/alpha/client_proto_rpcs.mli
View File

@ -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 ->

4
src/node/db/context.ml
View File

@ -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 =

4
src/node/db/context.mli
View File

@ -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

45
src/node/db/store.ml
View File

@ -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)

22
src/node/db/store.mli
View File

@ -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

1
src/node/shell/distributed_db.ml
View File

@ -7,7 +7,6 @@
(* *)
(**************************************************************************)
module Net_id = State.Net_id
module Message = Distributed_db_message
module Metadata = Distributed_db_metadata

4
src/node/shell/distributed_db_message.ml
View File

@ -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)

2
src/node/shell/distributed_db_message.mli
View File

@ -7,8 +7,6 @@
(* *)
(**************************************************************************)
module Net_id = Store.Net_id
type t =
| Get_current_branch of Net_id.t

10
src/node/shell/node.ml
View File

@ -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))

2
src/node/shell/node.mli
View File

@ -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

21
src/node/shell/node_rpc_services.ml
View File

@ -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)

14
src/node/shell/node_rpc_services.mli
View File

@ -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 ;

2
src/node/shell/prevalidator.ml
View File

@ -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

45
src/node/shell/state.ml
View File

@ -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 } ->
@ -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

4
src/node/shell/state.mli
View File

@ -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

34
src/node/shell/validator.ml
View File

@ -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

4
src/node/shell/validator.mli
View File

@ -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

2
src/node/updater/protocol.mli
View File

@ -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 ;

2
src/node/updater/updater.ml
View File

@ -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 ;
}

5
src/node/updater/updater.mli
View File

@ -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 ;
}

2
src/proto/alpha/services.ml
View File

@ -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)

2
src/proto/environment/hash.mli
View File

@ -134,3 +134,5 @@ module Operation_list_list_hash :
(** Protocol versions / source hashes. *)
module Protocol_hash : HASH
module Net_id : HASH

5
src/proto/environment/updater.mli
View File

@ -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 ;
}

2
src/proto/genesis/services.ml
View File

@ -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))

3
src/utils/base58.ml
View File

@ -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

1
src/utils/base58.mli
View File

@ -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

143
src/utils/hash.ml
View File

@ -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

5
src/utils/hash.mli
View File

@ -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
(**/**)

2
test/test_context.ml
View File

@ -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 *)

2
test/test_state.ml
View File

@ -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 =

2
test/test_store.ml
View File

@ -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 *)