Shell: Smaller Net_id.

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 ;

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:

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

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 =

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 get_test_network: context -> Net_id.t option Lwt.t
-val set_test_network: context -> Store.Net_id.t -> context 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

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)

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

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
 

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)

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

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

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

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)

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 ;

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

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 =
+    let net_id = Net_id.of_block_hash genesis.block in
-      Store.Net.get data.global_store (Store.Net_id.Id 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
+      let net_id = Net_id.of_block_hash net.genesis.block in
-      if not ( Store.Net_id.equal b1.net_id net_id
+      if not ( Net_id.equal b1.net_id net_id
-               && Store.Net_id.equal b2.net_id net_id ) then
+               && 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
+      let net_id = Net_id.of_block_hash net.genesis.block in
-      if not ( Store.Net_id.equal b1.net_id net_id
+      if not ( Net_id.equal b1.net_id net_id
-               && Store.Net_id.equal b2.net_id net_id ) then
+               && 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

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

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: Net_id.t -> t tzresult Lwt.t ;
-  get_exn: State.Net_id.t -> t 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 =
+  let validators : t Lwt.t Net_id.Table.t =
-    Store.Net_id.Table.create 7 in
+    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
 

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: worker -> Net_id.t -> t tzresult Lwt.t
-val get_exn: worker -> State.Net_id.t -> t 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

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 ;

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

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

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)

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

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

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

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

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
 

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

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

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

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 =

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