Shell: replace missing Netparams with Tezos_p2p

src/Makefile

@@ -227,6 +227,7 @@ NODE_LIB_INTFS := \
   node/updater/proto_environment.mli \
   node/updater/register.mli \
   \
+  node/shell/tezos_p2p.mli \
   node/shell/state.mli \
   node/shell/prevalidator.mli \
   node/shell/validator.mli \
@@ -256,10 +257,8 @@ NODE_LIB_IMPLS := \
   node/updater/proto_environment.ml \
   node/updater/register.ml \
   \
-  node/shell/messages.ml \
+  node/shell/tezos_p2p.ml \
-  node/shell/netparams.ml \
   node/shell/state.ml \
-  \
   node/shell/prevalidator.ml \
   node/shell/validator.ml \
   \

src/node/shell/discoverer.ml

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-module P2p = Netparams
-
 type worker = {
   shutdown: unit -> unit Lwt.t;
 }
@@ -17,7 +15,7 @@ let create_worker p2p state =
 
   let cancelation, cancel, _on_cancel = Lwt_utils.canceler () in
 
-  let broadcast m = P2p.broadcast p2p m in
+  let broadcast m = Tezos_p2p.broadcast p2p m in
 
   let discovery_worker =
     let rec worker_loop () =
@@ -26,8 +24,8 @@ let create_worker p2p state =
         (fun net ->
            State.Net.Blockchain.head net >>= fun head ->
            State.Valid_block.block_locator state 50 head >>= fun locator ->
-           broadcast Messages.(Discover_blocks (State.Net.id net, locator)) ;
+           broadcast Tezos_p2p.(Discover_blocks (State.Net.id net, locator)) ;
-           broadcast Messages.(Current_operations (State.Net.id net)) ;
+           broadcast Tezos_p2p.(Current_operations (State.Net.id net)) ;
            Lwt.return_unit)
         nets >>= fun () ->
       let timeout = 15. +. Random.float 15. in

src/node/shell/discoverer.mli

@@ -9,6 +9,6 @@
 
 type worker
 
-val create_worker: Netparams.net -> State.t -> worker
+val create_worker: Tezos_p2p.net -> State.t -> worker
 
 val shutdown: worker -> unit Lwt.t

src/node/shell/messages.ml

@@ -1,78 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*    Copyright (c) 2014 - 2016.                                          *)
-(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
-(*                                                                        *)
-(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
-(*                                                                        *)
-(**************************************************************************)
-
-type net_id = Store.net_id
-
-type t =
-
-  | Discover_blocks of net_id * Block_hash.t list (* Block locator *)
-  | Block_inventory of net_id * Block_hash.t list
-
-  | Get_blocks of Block_hash.t list
-  | Block of MBytes.t
-
-  | Current_operations of net_id
-  | Operation_inventory of net_id * Operation_hash.t list
-
-  | Get_operations of Operation_hash.t list
-  | Operation of MBytes.t
-
-  | Get_protocols of Protocol_hash.t list
-  | Protocol of MBytes.t
-
-let encoding =
-  let open Data_encoding in
-  let case ?max_length ~tag encoding unwrap wrap =
-    P2p.Encoding { tag; encoding; wrap; unwrap; max_length }
-  in [
-    case ~tag:0x10 (tup2 Block_hash.encoding (list Block_hash.encoding))
-      (function
-        | Discover_blocks (Net genesis_bh, bhs) -> Some (genesis_bh, bhs)
-        | _ -> None)
-      (fun (genesis_bh, bhs) -> Discover_blocks (Net genesis_bh, bhs));
-    case ~tag:0x11 (tup2 Block_hash.encoding (list Block_hash.encoding))
-      (function
-        | Block_inventory (Net genesis_bh, bhs) -> Some (genesis_bh, bhs)
-        | _ -> None)
-      (fun (genesis_bh, bhs) -> Block_inventory (Net genesis_bh, bhs));
-
-    case ~tag:0x12 (list Block_hash.encoding)
-      (function
-        | Get_blocks bhs -> Some bhs
-        | _ -> None)
-      (fun bhs -> Get_blocks bhs);
-    case ~tag:0x13 Data_encoding.bytes
-      (function Block b -> Some b  | _ -> None)
-      (fun b -> Block b);
-
-    case ~tag:0x20 Block_hash.encoding
-      (function Current_operations (Net genesis_bh) -> Some genesis_bh | _ -> None)
-      (fun genesis_bh -> Current_operations (Net genesis_bh));
-    case ~tag:0x21 (tup2 Block_hash.encoding (list Operation_hash.encoding))
-      (function Operation_inventory ((Net genesis_bh), ops) -> Some (genesis_bh, ops) | _ -> None)
-      (fun (genesis_bh, ops) -> Operation_inventory (Net genesis_bh, ops));
-
-    case ~tag:0x22 (list Operation_hash.encoding)
-      (function
-        | Get_operations ops -> Some ops
-        | _ -> None)
-      (fun ops -> Get_operations ops);
-    case ~tag:0x23 Data_encoding.bytes
-      (function Operation o -> Some o  | _ -> None)
-      (fun o -> Operation o);
-
-    case ~tag:0x32 (list Protocol_hash.encoding)
-      (function
-        | Get_protocols protos -> Some protos
-        | _ -> None)
-      (fun protos -> Get_protocols protos);
-    case ~tag:0x33 Data_encoding.bytes
-      (function Protocol proto -> Some proto  | _ -> None)
-      (fun proto -> Protocol proto);
-]

src/node/shell/messages.mli

@@ -1,28 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*    Copyright (c) 2014 - 2016.                                          *)
-(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
-(*                                                                        *)
-(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
-(*                                                                        *)
-(**************************************************************************)
-
-(** High level messages *)
-type t =
-
-  | Discover_blocks of Store.net_id * Block_hash.t list (* Block locator *)
-  | Block_inventory of Store.net_id * Block_hash.t list
-
-  | Get_blocks of Block_hash.t list
-  | Block of MBytes.t
-
-  | Current_operations of Store.net_id
-  | Operation_inventory of Store.net_id * Operation_hash.t list
-
-  | Get_operations of Operation_hash.t list
-  | Operation of MBytes.t
-
-  | Get_protocols of Protocol_hash.t list
-  | Protocol of MBytes.t
-
-val encoding : t P2p.msg_encoding list

src/node/shell/node.ml

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-module P2p = Netparams
-
 open Logging.Node.Worker
 
 let (>|=) = Lwt.(>|=)
@@ -93,7 +91,7 @@ let inject_block state validator ?(force = false) bytes =
   Lwt.return (hash, validation)
 
 let process state validator msg =
-  let open Messages in
+  let open Tezos_p2p in
   match msg with
 
   | Discover_blocks (net_id, blocks) ->
@@ -194,26 +192,26 @@ type t = {
 let request_operations net _net_id operations =
   (* TODO improve the lookup strategy.
           For now simply broadcast the request to all our neighbours. *)
-  P2p.broadcast net (Get_operations operations)
+  Tezos_p2p.broadcast net (Get_operations operations)
 
 let request_blocks net _net_id blocks =
   (* TODO improve the lookup strategy.
           For now simply broadcast the request to all our neighbours. *)
-  P2p.broadcast net (Get_blocks blocks)
+  Tezos_p2p.broadcast net (Get_blocks blocks)
 
 let request_protocols net protocols =
   (* TODO improve the lookup strategy.
           For now simply broadcast the request to all our neighbours. *)
-  P2p.broadcast net (Get_protocols protocols)
+  Tezos_p2p.broadcast net (Get_protocols protocols)
 
 let init_p2p net_params =
   match net_params with
   | None ->
       lwt_log_notice "P2P layer is disabled" >>= fun () ->
-      Lwt.return P2p.faked_network
+      Lwt.return Tezos_p2p.faked_network
   | Some (config, limits) ->
       lwt_log_notice "bootstraping network..." >>= fun () ->
-      P2p.bootstrap config limits
+      Tezos_p2p.bootstrap config limits
 
 let create
     ~genesis ~store_root ~context_root ?test_protocol ?patch_context net_params =
@@ -246,12 +244,12 @@ let create
     let handle_msg peer msg =
       process state validator msg >>= fun msgs ->
       List.iter
-        (fun msg -> ignore @@ P2p.try_send p2p peer msg)
+        (fun msg -> ignore @@ Tezos_p2p.try_send p2p peer msg)
         msgs;
       Lwt.return_unit
     in
     let rec worker_loop () =
-      P2p.recv p2p >>= fun (peer, msg) ->
+      Tezos_p2p.recv p2p >>= fun (peer, msg) ->
       handle_msg peer msg >>= fun () ->
       worker_loop () in
     Lwt.catch
@@ -261,12 +259,12 @@ let create
         | exn ->
             lwt_log_error "unexpected exception in worker\n%s"
               (Printexc.to_string exn) >>= fun () ->
-            P2p.shutdown p2p >>= fun () ->
+            Tezos_p2p.shutdown p2p >>= fun () ->
             cleanup ())
   in
   let shutdown () =
     lwt_log_info "stopping worker..." >>= fun () ->
-    P2p.shutdown p2p >>= fun () ->
+    Tezos_p2p.shutdown p2p >>= fun () ->
     worker >>= fun () ->
     lwt_log_info "stopped"
   in

src/node/shell/prevalidator.ml

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-module P2p = Netparams
-
 open Logging.Node.Prevalidator
 
 let preapply
@@ -97,7 +95,7 @@ let create p2p net =
     Lwt.return_unit in
 
   let broadcast_operation ops =
-    P2p.broadcast p2p (Operation_inventory (State.Net.id net, ops)) in
+    Tezos_p2p.broadcast p2p (Operation_inventory (State.Net.id net, ops)) in
 
   let handle_unprocessed () =
     if Operation_hash_set.is_empty !unprocessed then

src/node/shell/prevalidator.mli

@@ -26,12 +26,10 @@
 
 *)
 
-module P2p = Netparams
-
 type t
 
 (** Creation and destruction of a "prevalidation" worker. *)
-val create: P2p.net -> State.Net.t -> t Lwt.t
+val create: Tezos_p2p.net -> State.Net.t -> t Lwt.t
 val shutdown: t -> unit Lwt.t
 
 (** Notify the prevalidator of a new operation. This is the

src/node/shell/tezos_p2p.ml

@@ -0,0 +1,90 @@
+
+module Param = struct
+
+  type net_id = Store.net_id
+
+  type msg =
+
+    | Discover_blocks of net_id * Block_hash.t list (* Block locator *)
+    | Block_inventory of net_id * Block_hash.t list
+
+    | Get_blocks of Block_hash.t list
+    | Block of MBytes.t
+
+    | Current_operations of net_id
+    | Operation_inventory of net_id * Operation_hash.t list
+
+    | Get_operations of Operation_hash.t list
+    | Operation of MBytes.t
+
+    | Get_protocols of Protocol_hash.t list
+    | Protocol of MBytes.t
+
+  let msg_encodings =
+    let open Data_encoding in
+    let case ?max_length ~tag encoding unwrap wrap =
+      P2p.Encoding { tag; encoding; wrap; unwrap; max_length } in
+    [
+      case ~tag:0x10 (tup2 Block_hash.encoding (list Block_hash.encoding))
+        (function
+          | Discover_blocks (Net genesis_bh, bhs) -> Some (genesis_bh, bhs)
+          | _ -> None)
+        (fun (genesis_bh, bhs) -> Discover_blocks (Net genesis_bh, bhs));
+      case ~tag:0x11 (tup2 Block_hash.encoding (list Block_hash.encoding))
+        (function
+          | Block_inventory (Net genesis_bh, bhs) -> Some (genesis_bh, bhs)
+          | _ -> None)
+        (fun (genesis_bh, bhs) -> Block_inventory (Net genesis_bh, bhs));
+
+      case ~tag:0x12 (list Block_hash.encoding)
+        (function
+          | Get_blocks bhs -> Some bhs
+          | _ -> None)
+        (fun bhs -> Get_blocks bhs);
+      case ~tag:0x13 Data_encoding.bytes
+        (function Block b -> Some b  | _ -> None)
+        (fun b -> Block b);
+
+      case ~tag:0x20 Block_hash.encoding
+        (function Current_operations (Net genesis_bh) -> Some genesis_bh | _ -> None)
+        (fun genesis_bh -> Current_operations (Net genesis_bh));
+      case ~tag:0x21 (tup2 Block_hash.encoding (list Operation_hash.encoding))
+        (function Operation_inventory ((Net genesis_bh), ops) -> Some (genesis_bh, ops) | _ -> None)
+        (fun (genesis_bh, ops) -> Operation_inventory (Net genesis_bh, ops));
+
+      case ~tag:0x22 (list Operation_hash.encoding)
+        (function
+          | Get_operations ops -> Some ops
+          | _ -> None)
+        (fun ops -> Get_operations ops);
+      case ~tag:0x23 Data_encoding.bytes
+        (function Operation o -> Some o  | _ -> None)
+        (fun o -> Operation o);
+
+      case ~tag:0x32 (list Protocol_hash.encoding)
+        (function
+          | Get_protocols protos -> Some protos
+          | _ -> None)
+        (fun protos -> Get_protocols protos);
+      case ~tag:0x33 Data_encoding.bytes
+        (function Protocol proto -> Some proto  | _ -> None)
+        (fun proto -> Protocol proto);
+    ]
+
+  type meta = unit
+  let init_meta = ()
+  let score_enc = Data_encoding.empty
+  let score () = 0.
+
+  let supported_versions =
+    let open P2p in
+    [ { name = "TEZOS" ;
+        major = 0 ;
+        minor = 0 ;
+      }
+    ]
+
+end
+
+include Param
+include P2p.Make(Param)

src/node/shell/tezos_p2p.mli

@@ -0,0 +1,86 @@
+
+open P2p
+
+type net
+
+(** A faked p2p layer, which do not initiate any connection
+    nor open any listening socket *)
+val faked_network : net
+
+(** Main network initialisation function *)
+val bootstrap : config:config -> limits:limits -> net Lwt.t
+
+(** A maintenance operation : try and reach the ideal number of peers *)
+val maintain : net -> unit Lwt.t
+
+(** Voluntarily drop some peers and replace them by new buddies *)
+val roll : net -> unit Lwt.t
+
+(** Close all connections properly *)
+val shutdown : net -> unit Lwt.t
+
+(** A connection to a peer *)
+type peer
+
+(** Access the domain of active peers *)
+val peers : net -> peer list
+
+(** Return the active peer with identity [gid] *)
+val find_peer : net -> gid -> peer option
+
+type peer_info = {
+  gid : gid ;
+  addr : addr ;
+  port : port ;
+  version : version ;
+}
+
+(** Access the info of an active peer, if available *)
+val peer_info : net -> peer -> peer_info
+
+(** Accessors for meta information about a global identifier *)
+
+type meta = unit
+
+val get_meta : net -> gid -> meta option
+val set_meta : net -> gid -> meta -> unit
+
+type net_id = Store.net_id
+
+type msg =
+
+  | Discover_blocks of net_id * Block_hash.t list (* Block locator *)
+  | Block_inventory of net_id * Block_hash.t list
+
+  | Get_blocks of Block_hash.t list
+  | Block of MBytes.t
+
+  | Current_operations of net_id
+  | Operation_inventory of net_id * Operation_hash.t list
+
+  | Get_operations of Operation_hash.t list
+  | Operation of MBytes.t
+
+  | Get_protocols of Protocol_hash.t list
+  | Protocol of MBytes.t
+
+(** Wait for a payload from any peer in the network *)
+val recv : net -> (peer * msg) Lwt.t
+
+(** Send a payload to a peer and wait for it to be in the tube *)
+val send : net -> peer -> msg -> unit Lwt.t
+
+(** Send a payload to a peer without waiting for the result. Return
+    [true] if the msg can be enqueued in the peer's output queue
+    or [false] otherwise. *)
+val try_send : net -> peer -> msg -> bool
+
+(** Send a payload to all peers *)
+val broadcast : net -> msg -> unit
+
+(** Shutdown the connection to all peers at this address and stop the
+    communications with this machine for [duration] seconds *)
+val blacklist : net -> gid -> unit
+
+(** Keep a connection to this pair as often as possible *)
+val whitelist : net -> gid -> unit

src/node/shell/validator.ml

@@ -7,12 +7,10 @@
 (*                                                                        *)
 (**************************************************************************)
 
-module P2p = Netparams
-
 open Logging.Node.Validator
 
 type worker = {
-  p2p: P2p.net ;
+  p2p: Tezos_p2p.net ;
   activate: ?parent:t -> State.Net.t -> t Lwt.t ;
   get: State.net_id -> t tzresult Lwt.t ;
   get_exn: State.net_id -> t Lwt.t ;
@@ -45,7 +43,7 @@ let test_validator w = w.test_validator ()
 let fetch_block v = v.fetch_block
 let prevalidator v = v.prevalidator
 
-let broadcast w m = P2p.broadcast w.p2p m
+let broadcast w m = Tezos_p2p.broadcast w.p2p m
 
 (** Current block computation *)
 
@@ -75,7 +73,7 @@ let rec may_set_head v (block: State.Valid_block.t) =
     State.Net.Blockchain.test_and_set_head v.net ~old:head block >>= function
     | false -> may_set_head v block
     | true ->
-        broadcast v.worker Messages.(Block_inventory (State.Net.id v.net, [])) ;
+        broadcast v.worker Tezos_p2p.(Block_inventory (State.Net.id v.net, [])) ;
         Prevalidator.flush v.prevalidator ;
         may_change_test_network v block >>= fun () ->
         lwt_log_notice "update current head %a %a %a(%t)"

src/node/shell/validator.mli

@@ -9,9 +9,7 @@
 
 type worker
 
-module P2p = Netparams
+val create_worker: Tezos_p2p.net -> State.t -> worker
-
-val create_worker: P2p.net -> State.t -> worker
 val shutdown: worker -> unit Lwt.t
 
 val notify_block: worker -> Block_hash.t -> Store.block -> unit Lwt.t