Refactor: Move/split P2p_types into lib_base

.gitlab-ci.yml

@@ -111,15 +111,15 @@ test:p2p:io-scheduler:
   script:
     - jbuilder build @test/p2p/runtest_p2p_io_scheduler
 
-test:p2p:connection:
+test:p2p:socket:
   <<: *test_definition
   script:
-    - jbuilder build @test/p2p/runtest_p2p_connection
+    - jbuilder build @test/p2p/runtest_p2p_socket
 
-test:p2p:connection-pool:
+test:p2p:pool:
   <<: *test_definition
   script:
-    - jbuilder build @test/p2p/runtest_p2p_connection_pool
+    - jbuilder build @test/p2p/runtest_p2p_pool
 
 test:proto_alpha:transaction:
   <<: *test_definition

src/bin_attacker/attacker_minimal.ml

@@ -103,7 +103,7 @@ let ballot_forged period prop vote =
       operations = [ballot] }) in
   forge { net_id = network } op
 
-let identity = P2p_types.Identity.generate Crypto_box.default_target
+let identity = P2p_identity.generate Crypto_box.default_target
 
 (* connect to the network, run an action and then disconnect *)
 let try_action addr port action =

src/bin_node/node_config_file.ml

@@ -529,7 +529,7 @@ let update
   return { data_dir ; net ; rpc ; log ; shell }
 
 let resolve_addr ?default_port ?(passive = false) peer =
-  let addr, port = P2p.Point.parse_addr_port peer in
+  let addr, port = P2p_point.Id.parse_addr_port peer in
   let node = if addr = "" || addr = "_" then "::" else addr
   and service =
     match port, default_port with

src/bin_node/node_config_file.mli

@@ -80,8 +80,8 @@ val to_string: t -> string
 val read: string -> t tzresult Lwt.t
 val write: string -> t -> unit tzresult Lwt.t
 
-val resolve_listening_addrs: string -> (P2p_types.addr * int) list Lwt.t
+val resolve_listening_addrs: string -> (P2p_addr.t * int) list Lwt.t
-val resolve_rpc_listening_addrs: string -> (P2p_types.addr * int) list Lwt.t
+val resolve_rpc_listening_addrs: string -> (P2p_addr.t * int) list Lwt.t
-val resolve_bootstrap_addrs: string list -> (P2p_types.addr * int) list Lwt.t
+val resolve_bootstrap_addrs: string list -> (P2p_addr.t * int) list Lwt.t
 
 val check: t -> unit Lwt.t

src/bin_node/node_identity_command.ml

@@ -15,7 +15,7 @@ let identity_file data_dir = data_dir // Node_data_version.default_identity_file
 
 let show { Node_config_file.data_dir } =
   Node_identity_file.read (identity_file data_dir) >>=? fun id ->
-  Format.printf "Peer_id: %a.@." P2p_types.Peer_id.pp id.peer_id ;
+  Format.printf "Peer_id: %a.@." P2p_peer.Id.pp id.peer_id ;
   return ()
 
 let generate { Node_config_file.data_dir ; net } =
@@ -26,11 +26,11 @@ let generate { Node_config_file.data_dir ; net } =
     let target = Crypto_box.make_target net.expected_pow in
     Format.eprintf "Generating a new identity... (level: %.2f) " net.expected_pow ;
     let id =
-      P2p.Identity.generate_with_animation Format.err_formatter target in
+      P2p_identity.generate_with_animation Format.err_formatter target in
     Node_identity_file.write identity_file id >>=? fun () ->
     Format.eprintf
       "Stored the new identity (%a) into '%s'.@."
-      P2p.Peer_id.pp id.peer_id identity_file ;
+      P2p_peer.Id.pp id.peer_id identity_file ;
     return ()
 
 let check { Node_config_file.data_dir ; net = { expected_pow } } =
@@ -38,7 +38,7 @@ let check { Node_config_file.data_dir ; net = { expected_pow } } =
     ~expected_pow (identity_file data_dir) >>=? fun id ->
   Format.printf
     "Peer_id: %a. Proof of work is higher than %.2f.@."
-    P2p_types.Peer_id.pp id.peer_id expected_pow ;
+    P2p_peer.Id.pp id.peer_id expected_pow ;
   return ()
 
 (** Main *)

src/bin_node/node_identity_file.ml

@@ -47,7 +47,7 @@ let read ?expected_pow file =
       fail (No_identity_file file)
   | true ->
       Data_encoding_ezjsonm.read_file file >>=? fun json ->
-      let id = Data_encoding.Json.destruct P2p.Identity.encoding json in
+      let id = Data_encoding.Json.destruct P2p_identity.encoding json in
       match expected_pow with
       | None -> return id
       | Some expected ->
@@ -81,4 +81,4 @@ let write file identity =
   else
     Node_data_version.ensure_data_dir (Filename.dirname file) >>=? fun () ->
     Data_encoding_ezjsonm.write_file file
-      (Data_encoding.Json.construct P2p.Identity.encoding identity)
+      (Data_encoding.Json.construct P2p_identity.encoding identity)

src/bin_node/node_identity_file.mli

@@ -12,8 +12,8 @@ type error += Insufficient_proof_of_work of { expected: float }
 
 val read:
   ?expected_pow:float ->
-  string -> P2p.Identity.t tzresult Lwt.t
+  string -> P2p_identity.t tzresult Lwt.t
 
 type error += Existent_identity_file of string
 
-val write: string -> P2p.Identity.t -> unit tzresult Lwt.t
+val write: string -> P2p_identity.t -> unit tzresult Lwt.t

src/bin_node/node_run_command.ml

@@ -20,8 +20,8 @@ let genesis : State.Net.genesis = {
       "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im" ;
 }
 
-type error += Non_private_sandbox of P2p_types.addr
+type error += Non_private_sandbox of P2p_addr.t
-type error += RPC_Port_already_in_use of P2p_types.addr
+type error += RPC_Port_already_in_use of P2p_addr.t
 
 let () =
   register_error_kind
@@ -36,7 +36,7 @@ let () =
            See `%s run --help` on how to change the listening address."
         Ipaddr.V6.pp_hum addr Sys.argv.(0)
     end
-    Data_encoding.(obj1 (req "addr" P2p_types.addr_encoding))
+    Data_encoding.(obj1 (req "addr" P2p_addr.encoding))
     (function Non_private_sandbox addr -> Some addr | _ -> None)
     (fun addr -> Non_private_sandbox addr);
   register_error_kind
@@ -50,7 +50,7 @@ let () =
          Please choose another RPC port."
         Ipaddr.V6.pp_hum addr
     end
-    Data_encoding.(obj1 (req "addr" P2p_types.addr_encoding))
+    Data_encoding.(obj1 (req "addr" P2p_addr.encoding))
     (function RPC_Port_already_in_use addr -> Some addr | _ -> None)
     (fun addr -> RPC_Port_already_in_use addr)
 
@@ -146,7 +146,7 @@ let init_node ?sandbox (config : Node_config_file.t) =
            Node_data_version.default_identity_file_name) >>=? fun identity ->
         lwt_log_notice
           "Peer's global id: %a"
-          P2p.Peer_id.pp identity.peer_id >>= fun () ->
+          P2p_peer.Id.pp identity.peer_id >>= fun () ->
         let p2p_config : P2p.config =
           { listening_addr ;
             listening_port ;

src/lib_base/p2p_addr.ml

@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t = Ipaddr.V6.t
+
+let encoding =
+  let open Data_encoding in
+  splitted
+    ~json:begin
+      conv
+        Ipaddr.V6.to_string
+        Ipaddr.V6.of_string_exn
+        string
+    end
+    ~binary:begin
+      conv
+        Ipaddr.V6.to_bytes
+        Ipaddr.V6.of_bytes_exn
+        string
+    end
+
+type port = int

src/lib_base/p2p_addr.mli

@@ -0,0 +1,13 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t = Ipaddr.V6.t
+type port = int
+
+val encoding : t Data_encoding.t

src/lib_base/p2p_connection.ml

@@ -0,0 +1,252 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type peer_id = Crypto_box.Public_key_hash.t
+let peer_id_encoding = Crypto_box.Public_key_hash.encoding
+let peer_id_pp = Crypto_box.Public_key_hash.pp
+
+module Id = struct
+
+  (* A net point (address x port). *)
+  type t = P2p_addr.t * P2p_addr.port option
+  let compare (a1, p1) (a2, p2) =
+    match Ipaddr.V6.compare a1 a2 with
+    | 0 -> Pervasives.compare p1 p2
+    | x -> x
+  let equal p1 p2 = compare p1 p2 = 0
+  let hash = Hashtbl.hash
+  let pp ppf (addr, port) =
+    match port with
+    | None ->
+        Format.fprintf ppf "[%a]:??" Ipaddr.V6.pp_hum addr
+    | Some port ->
+        Format.fprintf ppf "[%a]:%d" Ipaddr.V6.pp_hum addr port
+  let pp_opt ppf = function
+    | None -> Format.pp_print_string ppf "none"
+    | Some point -> pp ppf point
+  let to_string t = Format.asprintf "%a" pp t
+
+  let is_local (addr, _) = Ipaddr.V6.is_private addr
+  let is_global (addr, _) = not @@ Ipaddr.V6.is_private addr
+
+  let of_point (addr, port) = addr, Some port
+  let to_point = function
+    | _, None -> None
+    | addr, Some port -> Some (addr, port)
+  let to_point_exn = function
+    | _, None -> invalid_arg "to_point_exn"
+    | addr, Some port -> addr, port
+
+  let encoding =
+    let open Data_encoding in
+    (obj2
+       (req "addr" P2p_addr.encoding)
+       (opt "port" uint16))
+
+end
+
+module Map = Map.Make (Id)
+module Set = Set.Make (Id)
+module Table = Hashtbl.Make (Id)
+
+module Info = struct
+
+  type t = {
+    incoming : bool;
+    peer_id : peer_id;
+    id_point : Id.t;
+    remote_socket_port : P2p_addr.port;
+    versions : P2p_version.t list ;
+  }
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { incoming ; peer_id ; id_point ; remote_socket_port ; versions } ->
+         (incoming, peer_id, id_point, remote_socket_port, versions))
+      (fun (incoming, peer_id, id_point, remote_socket_port, versions) ->
+         { incoming ; peer_id ; id_point ; remote_socket_port ; versions })
+      (obj5
+         (req "incoming" bool)
+         (req "peer_id" peer_id_encoding)
+         (req "id_point" Id.encoding)
+         (req "remote_socket_port" uint16)
+         (req "versions" (list P2p_version.encoding)))
+
+  let pp ppf
+      { incoming ; id_point = (remote_addr, remote_port) ;
+        remote_socket_port ; peer_id ; versions } =
+    let version = List.hd versions in
+    let point = match remote_port with
+      | None -> remote_addr, remote_socket_port
+      | Some port -> remote_addr, port in
+    Format.fprintf ppf "%s %a %a (%a)"
+      (if incoming then "↘" else "↗")
+      peer_id_pp peer_id
+      P2p_point.Id.pp point
+      P2p_version.pp version
+
+end
+
+module Pool_event = struct
+
+  (** Pool-level events *)
+
+  type t =
+
+    | Too_few_connections
+    | Too_many_connections
+
+    | New_point of P2p_point.Id.t
+    | New_peer of peer_id
+
+    | Gc_points
+    | Gc_peer_ids
+
+    | Incoming_connection of P2p_point.Id.t
+    | Outgoing_connection of P2p_point.Id.t
+    | Authentication_failed of P2p_point.Id.t
+    | Accepting_request of P2p_point.Id.t * Id.t * peer_id
+    | Rejecting_request of P2p_point.Id.t * Id.t * peer_id
+    | Request_rejected of P2p_point.Id.t * (Id.t * peer_id) option
+    | Connection_established of Id.t * peer_id
+
+    | Swap_request_received of { source : peer_id }
+    | Swap_ack_received of { source : peer_id }
+    | Swap_request_sent of { source : peer_id }
+    | Swap_ack_sent of { source : peer_id }
+    | Swap_request_ignored of { source : peer_id }
+    | Swap_success of { source : peer_id }
+    | Swap_failure of { source : peer_id }
+
+    | Disconnection of peer_id
+    | External_disconnection of peer_id
+
+  let encoding =
+    let open Data_encoding in
+    let branch_encoding name obj =
+      conv (fun x -> (), x) (fun ((), x) -> x)
+        (merge_objs
+           (obj1 (req "event" (constant name))) obj) in
+    union ~tag_size:`Uint8 [
+      case (Tag 0) (branch_encoding "too_few_connections" empty)
+        (function Too_few_connections -> Some () | _ -> None)
+        (fun () -> Too_few_connections) ;
+      case (Tag 1) (branch_encoding "too_many_connections" empty)
+        (function Too_many_connections -> Some () | _ -> None)
+        (fun () -> Too_many_connections) ;
+      case (Tag 2) (branch_encoding "new_point"
+                      (obj1 (req "point" P2p_point.Id.encoding)))
+        (function New_point p -> Some p | _ -> None)
+        (fun p -> New_point p) ;
+      case (Tag 3) (branch_encoding "new_peer"
+                      (obj1 (req "peer_id" peer_id_encoding)))
+        (function New_peer p -> Some p | _ -> None)
+        (fun p -> New_peer p) ;
+      case (Tag 4) (branch_encoding "incoming_connection"
+                      (obj1 (req "point" P2p_point.Id.encoding)))
+        (function Incoming_connection p -> Some p | _ -> None)
+        (fun p -> Incoming_connection p) ;
+      case (Tag 5) (branch_encoding "outgoing_connection"
+                      (obj1 (req "point" P2p_point.Id.encoding)))
+        (function Outgoing_connection p -> Some p | _ -> None)
+        (fun p -> Outgoing_connection p) ;
+      case (Tag 6) (branch_encoding "authentication_failed"
+                      (obj1 (req "point" P2p_point.Id.encoding)))
+        (function Authentication_failed p -> Some p | _ -> None)
+        (fun p -> Authentication_failed p) ;
+      case (Tag 7) (branch_encoding "accepting_request"
+                      (obj3
+                         (req "point" P2p_point.Id.encoding)
+                         (req "id_point" Id.encoding)
+                         (req "peer_id" peer_id_encoding)))
+        (function Accepting_request (p, id_p, g) ->
+           Some (p, id_p, g) | _ -> None)
+        (fun (p, id_p, g) -> Accepting_request (p, id_p, g)) ;
+      case (Tag 8) (branch_encoding "rejecting_request"
+                      (obj3
+                         (req "point" P2p_point.Id.encoding)
+                         (req "id_point" Id.encoding)
+                         (req "peer_id" peer_id_encoding)))
+        (function Rejecting_request (p, id_p, g) ->
+           Some (p, id_p, g) | _ -> None)
+        (fun (p, id_p, g) -> Rejecting_request (p, id_p, g)) ;
+      case (Tag 9) (branch_encoding "request_rejected"
+                      (obj2
+                         (req "point" P2p_point.Id.encoding)
+                         (opt "identity"
+                            (tup2 Id.encoding peer_id_encoding))))
+        (function Request_rejected (p, id) -> Some (p, id) | _ -> None)
+        (fun (p, id) -> Request_rejected (p, id)) ;
+      case (Tag 10) (branch_encoding "connection_established"
+                       (obj2
+                          (req "id_point" Id.encoding)
+                          (req "peer_id" peer_id_encoding)))
+        (function Connection_established (id_p, g) ->
+           Some (id_p, g) | _ -> None)
+        (fun (id_p, g) -> Connection_established (id_p, g)) ;
+      case (Tag 11) (branch_encoding "disconnection"
+                       (obj1 (req "peer_id" peer_id_encoding)))
+        (function Disconnection g -> Some g | _ -> None)
+        (fun g -> Disconnection g) ;
+      case (Tag 12) (branch_encoding "external_disconnection"
+                       (obj1 (req "peer_id" peer_id_encoding)))
+        (function External_disconnection g -> Some g | _ -> None)
+        (fun g -> External_disconnection g) ;
+      case (Tag 13) (branch_encoding "gc_points" empty)
+        (function Gc_points -> Some () | _ -> None)
+        (fun () -> Gc_points) ;
+      case (Tag 14) (branch_encoding "gc_peer_ids" empty)
+        (function Gc_peer_ids -> Some () | _ -> None)
+        (fun () -> Gc_peer_ids) ;
+      case (Tag 15) (branch_encoding "swap_request_received"
+                       (obj1 (req "source" peer_id_encoding)))
+        (function
+          | Swap_request_received { source } -> Some source
+          | _ -> None)
+        (fun source -> Swap_request_received { source }) ;
+      case (Tag 16) (branch_encoding "swap_ack_received"
+                       (obj1 (req "source" peer_id_encoding)))
+        (function
+          | Swap_ack_received { source } -> Some source
+          | _ -> None)
+        (fun source -> Swap_ack_received { source }) ;
+      case (Tag 17) (branch_encoding "swap_request_sent"
+                       (obj1 (req "source" peer_id_encoding)))
+        (function
+          | Swap_request_sent { source } -> Some source
+          | _ -> None)
+        (fun source -> Swap_request_sent { source }) ;
+      case (Tag 18) (branch_encoding "swap_ack_sent"
+                       (obj1 (req "source" peer_id_encoding)))
+        (function
+          | Swap_ack_sent { source } -> Some source
+          | _ -> None)
+        (fun source -> Swap_ack_sent { source }) ;
+      case (Tag 19) (branch_encoding "swap_request_ignored"
+                       (obj1 (req "source" peer_id_encoding)))
+        (function
+          | Swap_request_ignored { source } -> Some source
+          | _ -> None)
+        (fun source -> Swap_request_ignored { source }) ;
+      case (Tag 20) (branch_encoding "swap_success"
+                       (obj1 (req "source" peer_id_encoding)))
+        (function
+          | Swap_success { source } -> Some source
+          | _ -> None)
+        (fun source -> Swap_success { source }) ;
+      case (Tag 21) (branch_encoding "swap_failure"
+                       (obj1 (req "source" peer_id_encoding)))
+        (function
+          | Swap_failure { source } -> Some source
+          | _ -> None)
+        (fun source -> Swap_failure { source }) ;
+    ]
+
+end

src/lib_base/p2p_connection.mli

@@ -0,0 +1,107 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type peer_id = Crypto_box.Public_key_hash.t
+(* = P2p_peer.Id.t, but we should break cycles *)
+
+module Id : sig
+
+  type t = P2p_addr.t * P2p_addr.port option
+  val compare : t -> t -> int
+  val equal : t -> t -> bool
+  val pp : Format.formatter -> t -> unit
+  val pp_opt : Format.formatter -> t option -> unit
+  val to_string : t -> string
+  val encoding : t Data_encoding.t
+  val is_local : t -> bool
+  val is_global : t -> bool
+  val of_point : P2p_point.Id.t -> t
+  val to_point : t -> P2p_point.Id.t option
+  val to_point_exn : t -> P2p_point.Id.t
+
+end
+
+module Map : Map.S with type key = Id.t
+module Set : Set.S with type elt = Id.t
+module Table : Hashtbl.S with type key = Id.t
+
+(** Information about a connection *)
+module Info : sig
+
+  type t = {
+    incoming : bool;
+    peer_id : peer_id;
+    id_point : Id.t;
+    remote_socket_port : P2p_addr.port;
+    versions : P2p_version.t list ;
+  }
+
+  val pp : Format.formatter -> t -> unit
+  val encoding : t Data_encoding.t
+
+end
+
+module Pool_event : sig
+
+  type t =
+
+    | Too_few_connections
+    | Too_many_connections
+
+    | New_point of P2p_point.Id.t
+    | New_peer of peer_id
+
+    | Gc_points
+    (** Garbage collection of known point table has been triggered. *)
+
+    | Gc_peer_ids
+    (** Garbage collection of known peer_ids table has been triggered. *)
+
+    (* Connection-level events *)
+
+    | Incoming_connection of P2p_point.Id.t
+    (** We accept(2)-ed an incoming connection *)
+    | Outgoing_connection of P2p_point.Id.t
+    (** We connect(2)-ed to a remote endpoint *)
+    | Authentication_failed of P2p_point.Id.t
+    (** Remote point failed authentication *)
+
+    | Accepting_request of P2p_point.Id.t * Id.t * peer_id
+    (** We accepted a connection after authentifying the remote peer. *)
+    | Rejecting_request of P2p_point.Id.t * Id.t * peer_id
+    (** We rejected a connection after authentifying the remote peer. *)
+    | Request_rejected of P2p_point.Id.t * (Id.t * peer_id) option
+    (** The remote peer rejected our connection. *)
+
+    | Connection_established of Id.t * peer_id
+    (** We succesfully established a authentified connection. *)
+
+    | Swap_request_received of { source : peer_id }
+    (** A swap request has been received. *)
+    | Swap_ack_received of { source : peer_id }
+    (** A swap ack has been received *)
+    | Swap_request_sent of { source : peer_id }
+    (** A swap request has been sent *)
+    | Swap_ack_sent of { source : peer_id }
+    (** A swap ack has been sent *)
+    | Swap_request_ignored of { source : peer_id }
+    (** A swap request has been ignored *)
+    | Swap_success of { source : peer_id }
+    (** A swap operation has succeeded *)
+    | Swap_failure of { source : peer_id }
+    (** A swap operation has failed *)
+
+    | Disconnection of peer_id
+    (** We decided to close the connection. *)
+    | External_disconnection of peer_id
+    (** The connection was closed for external reason. *)
+
+  val encoding : t Data_encoding.t
+
+end

src/lib_base/p2p_connection_id.ml

@@ -0,0 +1,9 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+

src/lib_base/p2p_connection_id.mli

@@ -0,0 +1,11 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** P2p_point representing a reachable socket address *)
+

src/lib_base/p2p_id_point.mli

@@ -0,0 +1,9 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+

src/lib_base/p2p_identity.ml

@@ -0,0 +1,77 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t = {
+  peer_id : P2p_peer.Id.t ;
+  public_key : Crypto_box.public_key ;
+  secret_key : Crypto_box.secret_key ;
+  proof_of_work_stamp : Crypto_box.nonce ;
+}
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { public_key ; secret_key ; proof_of_work_stamp ; _ } ->
+       (public_key, secret_key, proof_of_work_stamp))
+    (fun (public_key, secret_key, proof_of_work_stamp) ->
+       let peer_id = Tezos_crypto.Crypto_box.hash public_key in
+       { peer_id ; public_key ; secret_key ; proof_of_work_stamp })
+    (obj3
+       (req "public_key" Crypto_box.public_key_encoding)
+       (req "secret_key" Crypto_box.secret_key_encoding)
+       (req "proof_of_work_stamp" Crypto_box.nonce_encoding))
+
+let generate ?max target =
+  let secret_key, public_key, peer_id = Crypto_box.random_keypair () in
+  let proof_of_work_stamp =
+    Crypto_box.generate_proof_of_work ?max public_key target in
+  { peer_id ; public_key ; secret_key ; proof_of_work_stamp }
+
+let animation = [|
+  "|.....|" ;
+  "|o....|" ;
+  "|oo...|" ;
+  "|ooo..|" ;
+  "|.ooo.|" ;
+  "|..ooo|" ;
+  "|...oo|" ;
+  "|....o|" ;
+  "|.....|" ;
+  "|.....|" ;
+  "|.....|" ;
+  "|.....|" ;
+|]
+
+let init = String.make (String.length animation.(0)) '\ '
+let clean = String.make (String.length animation.(0)) '\b'
+let animation = Array.map (fun x -> clean ^ x) animation
+let animation_size = Array.length animation
+let duration = 1200 / animation_size
+
+let generate_with_animation ppf target =
+  Format.fprintf ppf "%s%!" init ;
+  let count = ref 10000 in
+  let rec loop n =
+    let start = Mtime_clock.counter () in
+    Format.fprintf ppf "%s%!" animation.(n mod animation_size);
+    try generate ~max:!count target
+    with Not_found ->
+      let time = Mtime.Span.to_ms (Mtime_clock.count start) in
+      count :=
+        if time <= 0. then
+          !count * 10
+        else
+          !count * duration / int_of_float time ;
+      loop (n+1)
+  in
+  let id = loop 0 in
+  Format.fprintf ppf "%s%s\n%!" clean init ;
+  id
+
+let generate target = generate target

src/lib_base/p2p_identity.mli

@@ -0,0 +1,29 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t = {
+  peer_id : P2p_peer.Id.t ;
+  public_key : Crypto_box.public_key ;
+  secret_key : Crypto_box.secret_key ;
+  proof_of_work_stamp : Crypto_box.nonce ;
+}
+(** Type of an identity, comprising a peer_id, a crypto keypair, and a
+    proof of work stamp with enough difficulty so that the network
+    accept this identity as genuine. *)
+
+val encoding : t Data_encoding.t
+
+val generate : Crypto_box.target -> t
+(** [generate target] is a freshly minted identity whose proof of
+    work stamp difficulty is at least equal to [target]. *)
+
+val generate_with_animation :
+  Format.formatter -> Crypto_box.target -> t
+(** [generate_with_animation ppf target] is a freshly minted identity
+    whose proof of work stamp difficulty is at least equal to [target]. *)

src/lib_base/p2p_peer.ml

@@ -0,0 +1,339 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Error_monad
+
+module Id = Tezos_crypto.Crypto_box.Public_key_hash
+
+module Table = Id.Table
+module Map = Id.Map
+module Set = Id.Set
+
+module State = struct
+
+  type t =
+    | Accepted
+    | Running
+    | Disconnected
+
+  let pp_digram ppf = function
+    | Accepted -> Format.fprintf ppf "⚎"
+    | Running -> Format.fprintf ppf "⚌"
+    | Disconnected -> Format.fprintf ppf "⚏"
+
+  let encoding =
+    let open Data_encoding in
+    string_enum [
+      "accepted", Accepted ;
+      "running", Running ;
+      "disconnected", Disconnected ;
+    ]
+
+end
+
+module Info = struct
+
+  type t = {
+    score : float ;
+    trusted : bool ;
+    state : State.t ;
+    id_point : P2p_connection.Id.t option ;
+    stat : P2p_stat.t ;
+    last_failed_connection : (P2p_connection.Id.t * Time.t) option ;
+    last_rejected_connection : (P2p_connection.Id.t * Time.t) option ;
+    last_established_connection : (P2p_connection.Id.t * Time.t) option ;
+    last_disconnection : (P2p_connection.Id.t * Time.t) option ;
+    last_seen : (P2p_connection.Id.t * Time.t) option ;
+    last_miss : (P2p_connection.Id.t * Time.t) option ;
+  }
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun (
+         { score ; trusted ; state ; id_point ; stat ;
+           last_failed_connection ; last_rejected_connection ;
+           last_established_connection ; last_disconnection ;
+           last_seen ; last_miss }) ->
+         ((score, trusted, state, id_point, stat),
+          (last_failed_connection, last_rejected_connection,
+           last_established_connection, last_disconnection,
+           last_seen, last_miss)))
+      (fun ((score, trusted, state, id_point, stat),
+            (last_failed_connection, last_rejected_connection,
+             last_established_connection, last_disconnection,
+             last_seen, last_miss)) ->
+        { score ; trusted ; state ; id_point ; stat ;
+          last_failed_connection ; last_rejected_connection ;
+          last_established_connection ; last_disconnection ;
+          last_seen ; last_miss })
+      (merge_objs
+         (obj5
+            (req "score" float)
+            (req "trusted" bool)
+            (req "state" State.encoding)
+            (opt "reachable_at" P2p_connection.Id.encoding)
+            (req "stat" P2p_stat.encoding))
+         (obj6
+            (opt "last_failed_connection" (tup2 P2p_connection.Id.encoding Time.encoding))
+            (opt "last_rejected_connection" (tup2 P2p_connection.Id.encoding Time.encoding))
+            (opt "last_established_connection" (tup2 P2p_connection.Id.encoding Time.encoding))
+            (opt "last_disconnection" (tup2 P2p_connection.Id.encoding Time.encoding))
+            (opt "last_seen" (tup2 P2p_connection.Id.encoding Time.encoding))
+            (opt "last_miss" (tup2 P2p_connection.Id.encoding Time.encoding))))
+
+end
+
+module Event = struct
+
+  type kind =
+    | Accepting_request
+    | Rejecting_request
+    | Request_rejected
+    | Connection_established
+    | Disconnection
+    | External_disconnection
+
+  let kind_encoding =
+    Data_encoding.string_enum [
+      "incoming_request", Accepting_request ;
+      "rejecting_request", Rejecting_request ;
+      "request_rejected", Request_rejected ;
+      "connection_established", Connection_established ;
+      "disconnection", Disconnection ;
+      "external_disconnection", External_disconnection ;
+    ]
+
+  type t = {
+    kind : kind ;
+    timestamp : Time.t ;
+    point : P2p_connection.Id.t ;
+  }
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { kind ; timestamp ; point = (addr, port) } ->
+         (kind, timestamp, addr, port))
+      (fun (kind, timestamp, addr, port) ->
+         { kind ; timestamp ; point = (addr, port) })
+      (obj4
+         (req "kind" kind_encoding)
+         (req "timestamp" Time.encoding)
+         (req "addr" P2p_addr.encoding)
+         (opt "port" int16))
+
+end
+
+module Pool_info = struct
+
+  type 'data state =
+    | Accepted of { current_point: P2p_connection.Id.t ;
+                    cancel: Lwt_canceler.t }
+    | Running of { data: 'data ;
+                   current_point: P2p_connection.Id.t }
+    | Disconnected
+
+  type ('conn, 'meta) t = {
+    peer_id : Id.t ;
+    created : Time.t ;
+    mutable state : 'conn state ;
+    mutable metadata : 'meta ;
+    mutable trusted : bool ;
+    mutable last_failed_connection : (P2p_connection.Id.t * Time.t) option ;
+    mutable last_rejected_connection : (P2p_connection.Id.t * Time.t) option ;
+    mutable last_established_connection : (P2p_connection.Id.t * Time.t) option ;
+    mutable last_disconnection : (P2p_connection.Id.t * Time.t) option ;
+    events : Event.t Ring.t ;
+    watchers : Event.t Lwt_watcher.input ;
+  }
+  type ('conn, 'meta) peer_info = ('conn, 'meta) t
+
+  let compare gi1 gi2 = Id.compare gi1.peer_id gi2.peer_id
+
+  let log_size = 100
+
+  let create ?(created = Time.now ()) ?(trusted = false) ~metadata peer_id =
+    { peer_id ;
+      created ;
+      state = Disconnected ;
+      metadata ;
+      trusted ;
+      last_failed_connection = None ;
+      last_rejected_connection = None ;
+      last_established_connection = None ;
+      last_disconnection = None ;
+      events = Ring.create log_size ;
+      watchers = Lwt_watcher.create_input () ;
+    }
+
+  let encoding metadata_encoding =
+    let open Data_encoding in
+    conv
+      (fun { peer_id ; trusted ; metadata ; events ; created ;
+             last_failed_connection ; last_rejected_connection ;
+             last_established_connection ; last_disconnection ; _ } ->
+        (peer_id, created, trusted, metadata, Ring.elements events,
+         last_failed_connection, last_rejected_connection,
+         last_established_connection, last_disconnection))
+      (fun (peer_id, created, trusted, metadata, event_list,
+            last_failed_connection, last_rejected_connection,
+            last_established_connection, last_disconnection) ->
+        let info = create ~trusted ~metadata peer_id in
+        let events = Ring.create log_size in
+        Ring.add_list info.events event_list ;
+        { state = Disconnected ;
+          trusted ; peer_id ; metadata ; created ;
+          last_failed_connection ;
+          last_rejected_connection ;
+          last_established_connection ;
+          last_disconnection ;
+          events ;
+          watchers = Lwt_watcher.create_input () ;
+        })
+      (obj9
+         (req "peer_id" Id.encoding)
+         (req "created" Time.encoding)
+         (dft "trusted" bool false)
+         (req "metadata" metadata_encoding)
+         (dft "events" (list Event.encoding) [])
+         (opt "last_failed_connection"
+            (tup2 P2p_connection.Id.encoding Time.encoding))
+         (opt "last_rejected_connection"
+            (tup2 P2p_connection.Id.encoding Time.encoding))
+         (opt "last_established_connection"
+            (tup2 P2p_connection.Id.encoding Time.encoding))
+         (opt "last_disconnection"
+            (tup2 P2p_connection.Id.encoding Time.encoding)))
+
+  let peer_id { peer_id ; _ } = peer_id
+  let created { created ; _ } = created
+  let metadata { metadata ; _ } = metadata
+  let set_metadata gi metadata = gi.metadata <- metadata
+  let trusted { trusted ; _ } = trusted
+  let set_trusted gi = gi.trusted <- true
+  let unset_trusted gi = gi.trusted <- false
+  let last_established_connection s = s.last_established_connection
+  let last_disconnection s = s.last_disconnection
+  let last_failed_connection s = s.last_failed_connection
+  let last_rejected_connection s = s.last_rejected_connection
+
+  let last_seen s =
+    Time.recent
+      s.last_established_connection
+      (Time.recent s.last_rejected_connection s.last_disconnection)
+  let last_miss s =
+    Time.recent
+      s.last_failed_connection
+      (Time.recent s.last_rejected_connection s.last_disconnection)
+
+  let log { events ; watchers ; _ } ?(timestamp = Time.now ()) point kind =
+    let event = { Event.kind ; timestamp ; point } in
+    Ring.add events event ;
+    Lwt_watcher.notify watchers event
+
+  let log_incoming_rejection ?timestamp peer_info point =
+    log peer_info ?timestamp point Rejecting_request
+
+  module File = struct
+
+    let load path metadata_encoding =
+      let enc = Data_encoding.list (encoding metadata_encoding) in
+      if path <> "/dev/null" && Sys.file_exists path then
+        Data_encoding_ezjsonm.read_file path >>=? fun json ->
+        return (Data_encoding.Json.destruct enc json)
+      else
+        return []
+
+    let save path metadata_encoding peers =
+      let open Data_encoding in
+      Data_encoding_ezjsonm.write_file path @@
+      Json.construct (list (encoding metadata_encoding)) peers
+
+  end
+
+end
+
+module Pool_event = struct
+  include Event
+  let watch { Pool_info.watchers ; _ } = Lwt_watcher.create_stream watchers
+  let fold { Pool_info.events ; _ } ~init ~f = Ring.fold events ~init ~f
+end
+
+module Pool_state = struct
+
+  type 'data t = 'data Pool_info.state =
+    | Accepted of { current_point: P2p_connection.Id.t ;
+                    cancel: Lwt_canceler.t }
+    | Running of { data: 'data ;
+                   current_point: P2p_connection.Id.t }
+    | Disconnected
+  type 'data state = 'data t
+
+  let pp ppf = function
+    | Accepted { current_point ; _ } ->
+        Format.fprintf ppf "accepted %a" P2p_connection.Id.pp current_point
+    | Running { current_point ; _ } ->
+        Format.fprintf ppf "running %a" P2p_connection.Id.pp current_point
+    | Disconnected ->
+        Format.fprintf ppf "disconnected"
+
+  let get { Pool_info.state ; _ } = state
+
+  let is_disconnected { Pool_info.state ; _ } =
+    match state with
+    | Disconnected -> true
+    | Accepted _ | Running _ -> false
+
+  let set_accepted
+      ?(timestamp = Time.now ())
+      peer_info current_point cancel =
+    assert begin
+      match peer_info.Pool_info.state with
+      | Accepted _ | Running _ -> false
+      | Disconnected -> true
+    end ;
+    peer_info.state <- Accepted { current_point ; cancel } ;
+    Pool_info.log peer_info ~timestamp current_point Accepting_request
+
+  let set_running
+      ?(timestamp = Time.now ())
+      peer_info point data =
+    assert begin
+      match peer_info.Pool_info.state with
+      | Disconnected -> true (* request to unknown peer_id. *)
+      | Running _ -> false
+      | Accepted { current_point ; _ } ->
+          P2p_connection.Id.equal point current_point
+    end ;
+    peer_info.state <- Running { data ; current_point = point } ;
+    peer_info.last_established_connection <- Some (point, timestamp) ;
+    Pool_info.log peer_info ~timestamp point Connection_established
+
+  let set_disconnected
+      ?(timestamp = Time.now ()) ?(requested = false) peer_info =
+    let current_point, (event : Event.kind) =
+      match peer_info.Pool_info.state with
+      | Accepted { current_point ; _ } ->
+          peer_info.last_rejected_connection <-
+            Some (current_point, timestamp) ;
+          current_point, Request_rejected
+      | Running { current_point ; _ } ->
+          peer_info.last_disconnection <-
+            Some (current_point, timestamp) ;
+          current_point,
+          if requested then Disconnection else External_disconnection
+      | Disconnected -> assert false
+    in
+    peer_info.state <- Disconnected ;
+    Pool_info.log peer_info ~timestamp current_point event
+
+
+
+end

src/lib_base/p2p_peer.mli

@@ -0,0 +1,184 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Error_monad
+
+module Id = Tezos_crypto.Crypto_box.Public_key_hash
+
+module Map = Id.Map
+module Set = Id.Set
+module Table = Id.Table
+
+module State : sig
+
+  type t =
+    | Accepted
+    | Running
+    | Disconnected
+
+  val pp_digram : Format.formatter -> t -> unit
+  val encoding : t Data_encoding.t
+
+end
+
+module Info : sig
+
+  type t = {
+    score : float ;
+    trusted : bool ;
+    state : State.t ;
+    id_point : P2p_connection.Id.t option ;
+    stat : P2p_stat.t ;
+    last_failed_connection : (P2p_connection.Id.t * Time.t) option ;
+    last_rejected_connection : (P2p_connection.Id.t * Time.t) option ;
+    last_established_connection : (P2p_connection.Id.t * Time.t) option ;
+    last_disconnection : (P2p_connection.Id.t * Time.t) option ;
+    last_seen : (P2p_connection.Id.t * Time.t) option ;
+    last_miss : (P2p_connection.Id.t * Time.t) option ;
+  }
+
+  val encoding : t Data_encoding.t
+
+end
+
+(** P2p_peer.Id info: current and historical information about a peer_id *)
+
+module Pool_info : sig
+
+  type ('conn, 'meta) t
+  type ('conn, 'meta) peer_info = ('conn, 'meta) t
+
+  val compare : ('conn, 'meta) t -> ('conn, 'meta) t -> int
+
+  val create :
+    ?created:Time.t ->
+    ?trusted:bool ->
+    metadata:'meta ->
+    Id.t -> ('conn, 'meta) peer_info
+  (** [create ~trusted ~meta peer_id] is a freshly minted peer_id info for
+      [peer_id]. *)
+
+  val peer_id : ('conn, 'meta) peer_info -> Id.t
+
+  val created : ('conn, 'meta) peer_info -> Time.t
+  val metadata : ('conn, 'meta) peer_info -> 'meta
+  val set_metadata : ('conn, 'meta) peer_info -> 'meta -> unit
+
+  val trusted : ('conn, 'meta) peer_info -> bool
+  val set_trusted : ('conn, 'meta) peer_info -> unit
+  val unset_trusted : ('conn, 'meta) peer_info -> unit
+
+  val last_failed_connection :
+    ('conn, 'meta) peer_info -> (P2p_connection.Id.t * Time.t) option
+  val last_rejected_connection :
+    ('conn, 'meta) peer_info -> (P2p_connection.Id.t * Time.t) option
+  val last_established_connection :
+    ('conn, 'meta) peer_info -> (P2p_connection.Id.t * Time.t) option
+  val last_disconnection :
+    ('conn, 'meta) peer_info -> (P2p_connection.Id.t * Time.t) option
+
+  val last_seen :
+    ('conn, 'meta) peer_info -> (P2p_connection.Id.t * Time.t) option
+  (** [last_seen gi] is the most recent of:
+
+      * last established connection
+      * last rejected connection
+      * last disconnection
+  *)
+
+  val last_miss :
+    ('conn, 'meta) peer_info -> (P2p_connection.Id.t * Time.t) option
+  (** [last_miss gi] is the most recent of:
+
+      * last failed connection
+      * last rejected connection
+      * last disconnection
+  *)
+
+  val log_incoming_rejection :
+    ?timestamp:Time.t ->
+    ('conn, 'meta) peer_info -> P2p_connection.Id.t -> unit
+
+  module File : sig
+    val load :
+      string -> 'meta Data_encoding.t ->
+      ('conn, 'meta) peer_info list tzresult Lwt.t
+    val save :
+      string -> 'meta Data_encoding.t ->
+      ('conn, 'meta) peer_info list -> unit tzresult Lwt.t
+  end
+
+end
+
+module Pool_state : sig
+
+  type 'conn t =
+    | Accepted of { current_point: P2p_connection.Id.t ;
+                    cancel: Lwt_canceler.t }
+    (** We accepted a incoming connection, we greeted back and
+        we are waiting for an acknowledgement. *)
+    | Running of { data: 'conn ;
+                   current_point: P2p_connection.Id.t }
+    (** Successfully authentificated connection, normal business. *)
+    | Disconnected
+    (** No connection established currently. *)
+  type 'conn state = 'conn t
+
+  val pp : Format.formatter -> 'conn t -> unit
+
+  val get : ('conn, 'meta) Pool_info.t -> 'conn state
+
+  val is_disconnected : ('conn, 'meta) Pool_info.t -> bool
+
+  val set_accepted :
+    ?timestamp:Time.t ->
+    ('conn, 'meta) Pool_info.t -> P2p_connection.Id.t -> Lwt_canceler.t -> unit
+
+  val set_running :
+    ?timestamp:Time.t ->
+    ('conn, 'meta) Pool_info.t -> P2p_connection.Id.t -> 'conn -> unit
+
+  val set_disconnected :
+    ?timestamp:Time.t ->
+    ?requested:bool ->
+    ('conn, 'meta) Pool_info.t -> unit
+
+end
+
+module Pool_event : sig
+
+  type kind =
+    | Accepting_request
+    (** We accepted a connection after authentifying the remote peer. *)
+    | Rejecting_request
+    (** We rejected a connection after authentifying the remote peer. *)
+    | Request_rejected
+    (** The remote peer rejected our connection. *)
+    | Connection_established
+    (** We succesfully established a authentified connection. *)
+    | Disconnection
+    (** We decided to close the connection. *)
+    | External_disconnection
+    (** The connection was closed for external reason. *)
+
+  type t = {
+    kind : kind ;
+    timestamp : Time.t ;
+    point : P2p_connection.Id.t ;
+  }
+
+  val encoding : t Data_encoding.t
+
+  val fold :
+    ('conn, 'meta) Pool_info.t -> init:'a -> f:('a -> t -> 'a) -> 'a
+
+  val watch :
+    ('conn, 'meta) Pool_info.t -> t Lwt_stream.t * Lwt_watcher.stopper
+
+end

src/lib_base/p2p_point.ml

@@ -0,0 +1,477 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type peer_id = Crypto_box.Public_key_hash.t
+let peer_id_encoding = Crypto_box.Public_key_hash.encoding
+let peer_id_pp = Crypto_box.Public_key_hash.pp
+let peer_id_equal = Crypto_box.Public_key_hash.equal
+
+module Id = struct
+
+  (* A net point (address x port). *)
+  type t = P2p_addr.t * P2p_addr.port
+  let compare (a1, p1) (a2, p2) =
+    match Ipaddr.V6.compare a1 a2 with
+    | 0 -> p1 - p2
+    | x -> x
+  let equal p1 p2 = compare p1 p2 = 0
+  let hash = Hashtbl.hash
+  let pp ppf (addr, port) =
+    match Ipaddr.v4_of_v6 addr with
+    | Some addr ->
+        Format.fprintf ppf "%a:%d" Ipaddr.V4.pp_hum addr port
+    | None ->
+        Format.fprintf ppf "[%a]:%d" Ipaddr.V6.pp_hum addr port
+  let pp_opt ppf = function
+    | None -> Format.pp_print_string ppf "none"
+    | Some point -> pp ppf point
+
+  let is_local (addr, _) = Ipaddr.V6.is_private addr
+  let is_global (addr, _) = not @@ Ipaddr.V6.is_private addr
+
+  let check_port port =
+    if TzString.mem_char port '[' ||
+       TzString.mem_char port ']' ||
+       TzString.mem_char port ':' then
+      invalid_arg "Utils.parse_addr_port (invalid character in port)"
+
+  let parse_addr_port s =
+    let len = String.length s in
+    if len = 0 then
+      ("", "")
+    else if s.[0] = '[' then begin (* inline IPv6 *)
+      match String.rindex s ']' with
+      | exception Not_found ->
+          invalid_arg "Utils.parse_addr_port (missing ']')"
+      | pos ->
+          let addr = String.sub s 1 (pos - 1) in
+          let port =
+            if pos = len - 1 then
+              ""
+            else if s.[pos+1] <> ':' then
+              invalid_arg "Utils.parse_addr_port (unexpected char after ']')"
+            else
+              String.sub s (pos + 2) (len - pos - 2) in
+          check_port port ;
+          addr, port
+    end else begin
+      match String.rindex s ']' with
+      | _pos ->
+          invalid_arg "Utils.parse_addr_port (unexpected char ']')"
+      | exception Not_found ->
+          match String.index s ':' with
+          | exception _ -> s, ""
+          | pos ->
+              match String.index_from s (pos+1) ':'  with
+              | exception _ ->
+                  let addr = String.sub s 0 pos in
+                  let port = String.sub s (pos + 1) (len - pos - 1) in
+                  check_port port ;
+                  addr, port
+              | _pos ->
+                  invalid_arg "Utils.parse_addr_port: IPv6 addresses must be bracketed"
+    end
+
+  let of_string_exn str =
+    let addr, port = parse_addr_port str in
+    let port = int_of_string port in
+    if port < 0 && port > 1 lsl 16 - 1 then
+      invalid_arg "port must be between 0 and 65535" ;
+    match Ipaddr.of_string_exn addr with
+    | V4 addr -> Ipaddr.v6_of_v4 addr, port
+    | V6 addr -> addr, port
+
+  let of_string str =
+    try Ok (of_string_exn str) with
+    | Invalid_argument s -> Error s
+    | Failure s -> Error s
+    | _ -> Error "P2p_point.of_string"
+
+  let to_string saddr = Format.asprintf "%a" pp saddr
+
+  let encoding =
+    Data_encoding.conv to_string of_string_exn Data_encoding.string
+
+end
+
+module Map = Map.Make (Id)
+module Set = Set.Make (Id)
+module Table = Hashtbl.Make (Id)
+
+module State = struct
+
+  type t =
+    | Requested
+    | Accepted of peer_id
+    | Running of peer_id
+    | Disconnected
+
+  let of_peer_id = function
+    | Requested -> None
+    | Accepted pi -> Some pi
+    | Running pi -> Some pi
+    | Disconnected -> None
+
+  let of_peerid_state state pi =
+    match state, pi with
+    | Requested, _ -> Requested
+    | Accepted _, Some pi -> Accepted pi
+    | Running _, Some pi -> Running pi
+    | Disconnected, _ -> Disconnected
+    | _ -> invalid_arg "state_of_state_peerid"
+
+  let pp_digram ppf = function
+    | Requested -> Format.fprintf ppf "⚎"
+    | Accepted _ -> Format.fprintf ppf "⚍"
+    | Running _ -> Format.fprintf ppf "⚌"
+    | Disconnected -> Format.fprintf ppf "⚏"
+
+  let encoding =
+    let open Data_encoding in
+    let branch_encoding name obj =
+      conv (fun x -> (), x) (fun ((), x) -> x)
+        (merge_objs
+           (obj1 (req "event_kind" (constant name))) obj) in
+    union ~tag_size:`Uint8 [
+      case (Tag 0) (branch_encoding "requested" empty)
+        (function Requested -> Some () | _ -> None)
+        (fun () -> Requested) ;
+      case (Tag 1) (branch_encoding "accepted"
+                      (obj1 (req "peer_id" peer_id_encoding)))
+        (function Accepted peer_id -> Some peer_id | _ -> None)
+        (fun peer_id -> Accepted peer_id) ;
+      case (Tag 2) (branch_encoding "running"
+                      (obj1 (req "peer_id" peer_id_encoding)))
+        (function Running peer_id -> Some peer_id | _ -> None)
+        (fun peer_id -> Running peer_id) ;
+      case (Tag 3) (branch_encoding "disconnected" empty)
+        (function Disconnected -> Some () | _ -> None)
+        (fun () -> Disconnected) ;
+    ]
+
+end
+
+module Info = struct
+
+  type t = {
+    trusted : bool ;
+    greylisted_until : Time.t ;
+    state : State.t ;
+    last_failed_connection : Time.t option ;
+    last_rejected_connection : (peer_id * Time.t) option ;
+    last_established_connection : (peer_id * Time.t) option ;
+    last_disconnection : (peer_id * Time.t) option ;
+    last_seen : (peer_id * Time.t) option ;
+    last_miss : Time.t option ;
+  }
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { trusted ; greylisted_until ; state ;
+             last_failed_connection ; last_rejected_connection ;
+             last_established_connection ; last_disconnection ;
+             last_seen ; last_miss } ->
+        let peer_id = State.of_peer_id state in
+        (trusted, greylisted_until, state, peer_id,
+         last_failed_connection, last_rejected_connection,
+         last_established_connection, last_disconnection,
+         last_seen, last_miss))
+      (fun (trusted, greylisted_until, state, peer_id,
+            last_failed_connection, last_rejected_connection,
+            last_established_connection, last_disconnection,
+            last_seen, last_miss) ->
+        let state = State.of_peerid_state state peer_id in
+        { trusted ; greylisted_until ; state ;
+          last_failed_connection ; last_rejected_connection ;
+          last_established_connection ; last_disconnection ;
+          last_seen ; last_miss })
+      (obj10
+         (req "trusted" bool)
+         (dft "greylisted_until" Time.encoding Time.epoch)
+         (req "state" State.encoding)
+         (opt "peer_id" peer_id_encoding)
+         (opt "last_failed_connection" Time.encoding)
+         (opt "last_rejected_connection" (tup2 peer_id_encoding Time.encoding))
+         (opt "last_established_connection" (tup2 peer_id_encoding Time.encoding))
+         (opt "last_disconnection" (tup2 peer_id_encoding Time.encoding))
+         (opt "last_seen" (tup2 peer_id_encoding Time.encoding))
+         (opt "last_miss" Time.encoding))
+
+end
+
+module Event = struct
+
+  type kind =
+    | Outgoing_request
+    | Accepting_request of peer_id
+    | Rejecting_request of peer_id
+    | Request_rejected of peer_id option
+    | Connection_established of peer_id
+    | Disconnection of peer_id
+    | External_disconnection of peer_id
+
+  let kind_encoding =
+    let open Data_encoding in
+    let branch_encoding name obj =
+      conv (fun x -> (), x) (fun ((), x) -> x)
+        (merge_objs
+           (obj1 (req "event_kind" (constant name))) obj) in
+    union ~tag_size:`Uint8 [
+      case (Tag 0) (branch_encoding "outgoing_request" empty)
+        (function Outgoing_request -> Some () | _ -> None)
+        (fun () -> Outgoing_request) ;
+      case (Tag 1) (branch_encoding "accepting_request"
+                      (obj1 (req "peer_id" peer_id_encoding)))
+        (function Accepting_request peer_id -> Some peer_id | _ -> None)
+        (fun peer_id -> Accepting_request peer_id) ;
+      case (Tag 2) (branch_encoding "rejecting_request"
+                      (obj1 (req "peer_id" peer_id_encoding)))
+        (function Rejecting_request peer_id -> Some peer_id | _ -> None)
+        (fun peer_id -> Rejecting_request peer_id) ;
+      case (Tag 3) (branch_encoding "request_rejected"
+                      (obj1 (opt "peer_id" peer_id_encoding)))
+        (function Request_rejected peer_id -> Some peer_id | _ -> None)
+        (fun peer_id -> Request_rejected peer_id) ;
+      case (Tag 4) (branch_encoding "rejecting_request"
+                      (obj1 (req "peer_id" peer_id_encoding)))
+        (function Connection_established peer_id -> Some peer_id | _ -> None)
+        (fun peer_id -> Connection_established peer_id) ;
+      case (Tag 5) (branch_encoding "rejecting_request"
+                      (obj1 (req "peer_id" peer_id_encoding)))
+        (function Disconnection peer_id -> Some peer_id | _ -> None)
+        (fun peer_id -> Disconnection peer_id) ;
+      case (Tag 6) (branch_encoding "rejecting_request"
+                      (obj1 (req "peer_id" peer_id_encoding)))
+        (function External_disconnection peer_id -> Some peer_id | _ -> None)
+        (fun peer_id -> External_disconnection peer_id) ;
+    ]
+
+  type t = {
+    kind : kind ;
+    timestamp : Time.t ;
+  }
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { kind ; timestamp ; } -> (kind, timestamp))
+      (fun (kind, timestamp) -> { kind ; timestamp ; })
+      (obj2
+         (req "kind" kind_encoding)
+         (req "timestamp" Time.encoding))
+end
+
+module Pool_info = struct
+
+  type 'data state =
+    | Requested of { cancel: Lwt_canceler.t }
+    | Accepted of { current_peer_id: peer_id ;
+                    cancel: Lwt_canceler.t }
+    | Running of { data: 'data ;
+                   current_peer_id: peer_id }
+    | Disconnected
+
+  type greylisting_config = {
+    factor: float ;
+    initial_delay: int ;
+    disconnection_delay: int ;
+  }
+
+  type 'data t = {
+    point : Id.t ;
+    mutable trusted : bool ;
+    mutable state : 'data state ;
+    mutable last_failed_connection : Time.t option ;
+    mutable last_rejected_connection : (peer_id * Time.t) option ;
+    mutable last_established_connection : (peer_id * Time.t) option ;
+    mutable last_disconnection : (peer_id * Time.t) option ;
+    greylisting : greylisting_config ;
+    mutable greylisting_delay : float ;
+    mutable greylisting_end : Time.t ;
+    events : Event.t Ring.t ;
+    watchers : Event.t Lwt_watcher.input ;
+  }
+  type 'data point_info = 'data t
+
+  let compare pi1 pi2 = Id.compare pi1.point pi2.point
+
+  let log_size = 100
+
+  let default_greylisting_config = {
+    factor = 1.2 ;
+    initial_delay = 1 ;
+    disconnection_delay = 60 ;
+  }
+
+  let create
+      ?(trusted = false)
+      ?(greylisting_config = default_greylisting_config) addr  port = {
+    point = (addr, port) ;
+    trusted ;
+    state = Disconnected ;
+    last_failed_connection = None ;
+    last_rejected_connection = None ;
+    last_established_connection = None ;
+    last_disconnection = None ;
+    events = Ring.create log_size ;
+    greylisting = greylisting_config ;
+    greylisting_delay = 1. ;
+    greylisting_end = Time.epoch ;
+    watchers = Lwt_watcher.create_input () ;
+  }
+
+  let point s = s.point
+  let trusted s = s.trusted
+  let set_trusted gi = gi.trusted <- true
+  let unset_trusted gi = gi.trusted <- false
+  let last_established_connection s = s.last_established_connection
+  let last_disconnection s = s.last_disconnection
+  let last_failed_connection s = s.last_failed_connection
+  let last_rejected_connection s = s.last_rejected_connection
+  let greylisted ?(now = Time.now ()) s =
+    Time.compare now s.greylisting_end <= 0
+  let greylisted_until s = s.greylisting_end
+
+  let last_seen s =
+    Time.recent s.last_rejected_connection
+      (Time.recent s.last_established_connection s.last_disconnection)
+  let last_miss s =
+    match
+      s.last_failed_connection,
+      (Option.map ~f:(fun (_, time) -> time) @@
+       Time.recent s.last_rejected_connection s.last_disconnection) with
+    | (None, None) -> None
+    | (None, (Some _ as a))
+    | (Some _ as a, None) -> a
+    | (Some t1 as a1 , (Some t2 as a2)) ->
+        if Time.compare t1 t2 < 0 then a2 else a1
+
+  let log { events ; watchers ; _ } ?(timestamp = Time.now ()) kind =
+    let event = { Event.kind ; timestamp } in
+    Ring.add events event ;
+    Lwt_watcher.notify watchers event
+
+  let log_incoming_rejection ?timestamp point_info peer_id =
+    log point_info ?timestamp (Rejecting_request peer_id)
+
+end
+
+module Pool_event = struct
+
+  include Event
+
+  let fold { Pool_info.events ; _ } ~init ~f = Ring.fold events ~init ~f
+
+  let watch { Pool_info.watchers ; _ } = Lwt_watcher.create_stream watchers
+
+end
+
+module Pool_state = struct
+
+  type 'data t = 'data Pool_info.state =
+    | Requested of { cancel: Lwt_canceler.t }
+    | Accepted of { current_peer_id: peer_id ;
+                    cancel: Lwt_canceler.t }
+    | Running of { data: 'data ;
+                   current_peer_id: peer_id }
+    | Disconnected
+  type 'data state = 'data t
+
+  let pp ppf = function
+    | Requested _ ->
+        Format.fprintf ppf "requested"
+    | Accepted { current_peer_id ; _ } ->
+        Format.fprintf ppf "accepted %a" peer_id_pp current_peer_id
+    | Running { current_peer_id ; _ } ->
+        Format.fprintf ppf "running %a" peer_id_pp current_peer_id
+    | Disconnected ->
+        Format.fprintf ppf "disconnected"
+
+  let get { Pool_info.state ; _ } = state
+
+  let is_disconnected { Pool_info.state ; _ } =
+    match state with
+    | Disconnected -> true
+    | Requested _ | Accepted _ | Running _ -> false
+
+  let set_requested ?timestamp point_info cancel =
+    assert begin
+      match point_info.Pool_info.state with
+      | Requested _ -> true
+      | Accepted _ | Running _ -> false
+      | Disconnected -> true
+    end ;
+    point_info.state <- Requested { cancel } ;
+    Pool_info.log point_info ?timestamp Outgoing_request
+
+  let set_accepted
+      ?(timestamp = Time.now ())
+      point_info current_peer_id cancel =
+    (* log_notice "SET_ACCEPTED %a@." P2p_point.pp point_info.point ; *)
+    assert begin
+      match point_info.Pool_info.state with
+      | Accepted _ | Running _ -> false
+      | Requested _ | Disconnected -> true
+    end ;
+    point_info.state <- Accepted { current_peer_id ; cancel } ;
+    Pool_info.log point_info ~timestamp (Accepting_request current_peer_id)
+
+  let set_running
+      ?(timestamp = Time.now ())
+      point_info peer_id data =
+    assert begin
+      match point_info.Pool_info.state with
+      | Disconnected -> true (* request to unknown peer_id. *)
+      | Running _ -> false
+      | Accepted { current_peer_id ; _ } -> peer_id_equal peer_id current_peer_id
+      | Requested _ -> true
+    end ;
+    point_info.state <- Running { data ; current_peer_id = peer_id } ;
+    point_info.last_established_connection <- Some (peer_id, timestamp) ;
+    Pool_info.log point_info ~timestamp (Connection_established peer_id)
+
+  let set_greylisted timestamp point_info =
+    point_info.Pool_info.greylisting_end <-
+      Time.add
+        timestamp
+        (Int64.of_float point_info.Pool_info.greylisting_delay) ;
+    point_info.greylisting_delay <-
+      point_info.greylisting_delay *. point_info.greylisting.factor
+
+  let set_disconnected
+      ?(timestamp = Time.now ()) ?(requested = false) point_info =
+    let event : Event.kind =
+      match point_info.Pool_info.state with
+      | Requested _ ->
+          set_greylisted timestamp point_info ;
+          point_info.last_failed_connection <- Some timestamp ;
+          Request_rejected None
+      | Accepted { current_peer_id ; _ } ->
+          set_greylisted timestamp point_info ;
+          point_info.last_rejected_connection <-
+            Some (current_peer_id, timestamp) ;
+          Request_rejected (Some current_peer_id)
+      | Running { current_peer_id ; _ } ->
+          point_info.greylisting_delay <-
+            float_of_int point_info.greylisting.initial_delay ;
+          point_info.greylisting_end <-
+            Time.add timestamp
+              (Int64.of_int point_info.greylisting.disconnection_delay) ;
+          point_info.last_disconnection <- Some (current_peer_id, timestamp) ;
+          if requested
+          then Disconnection current_peer_id
+          else External_disconnection current_peer_id
+      | Disconnected ->
+          assert false
+    in
+    point_info.state <- Disconnected ;
+    Pool_info.log point_info ~timestamp event
+
+end

src/lib_base/p2p_point.mli

@@ -0,0 +1,207 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type peer_id = Crypto_box.Public_key_hash.t
+(* = P2p_peer.Id.t, but we should break cycles *)
+
+module Id : sig
+
+  type t = P2p_addr.t * P2p_addr.port
+  val compare : t -> t -> int
+
+  val pp : Format.formatter -> t -> unit
+  val pp_opt : Format.formatter -> t option -> unit
+
+  val of_string_exn : string -> t
+  val of_string : string -> (t, string) result
+  val to_string : t -> string
+  val encoding : t Data_encoding.t
+  val is_local : t -> bool
+  val is_global : t -> bool
+  val parse_addr_port : string -> string * string
+
+end
+
+module Map : Map.S with type key = Id.t
+module Set : Set.S with type elt = Id.t
+module Table : Hashtbl.S with type key = Id.t
+
+module State : sig
+
+  type t =
+    | Requested
+    | Accepted of peer_id
+    | Running of peer_id
+    | Disconnected
+
+  val pp_digram : Format.formatter -> t -> unit
+  val encoding : t Data_encoding.t
+
+  val of_peer_id : t -> peer_id option
+  val of_peerid_state : t -> peer_id option -> t
+
+end
+
+module Info : sig
+
+  type t = {
+    trusted : bool ;
+    greylisted_until : Time.t ;
+    state : State.t ;
+    last_failed_connection : Time.t option ;
+    last_rejected_connection : (peer_id * Time.t) option ;
+    last_established_connection : (peer_id * Time.t) option ;
+    last_disconnection : (peer_id * Time.t) option ;
+    last_seen : (peer_id * Time.t) option ;
+    last_miss : Time.t option ;
+  }
+
+  val encoding: t Data_encoding.t
+
+end
+
+module Pool_info : sig
+
+  type 'conn t
+  type 'conn point_info = 'conn t
+  (** Type of info associated to a point. *)
+
+  val compare : 'conn point_info -> 'conn point_info -> int
+
+  type greylisting_config = {
+    factor: float ;
+    initial_delay: int ;
+    disconnection_delay: int ;
+  }
+
+  val create :
+    ?trusted:bool ->
+    ?greylisting_config:greylisting_config ->
+    P2p_addr.t -> P2p_addr.port -> 'conn point_info
+  (** [create ~trusted addr port] is a freshly minted point_info. If
+      [trusted] is true, this point is considered trusted and will
+      be treated as such. *)
+
+  val trusted : 'conn point_info -> bool
+  (** [trusted pi] is [true] iff [pi] has is trusted,
+      i.e. "whitelisted". *)
+
+  val set_trusted : 'conn point_info -> unit
+  val unset_trusted : 'conn point_info -> unit
+
+  val last_failed_connection :
+    'conn point_info -> Time.t option
+  val last_rejected_connection :
+    'conn point_info -> (peer_id * Time.t) option
+  val last_established_connection :
+    'conn point_info -> (peer_id * Time.t) option
+  val last_disconnection :
+    'conn point_info -> (peer_id * Time.t) option
+
+  val last_seen :
+    'conn point_info -> (peer_id * Time.t) option
+  (** [last_seen pi] is the most recent of:
+
+      * last established connection
+      * last rejected connection
+      * last disconnection
+  *)
+
+  val last_miss :
+    'conn point_info -> Time.t option
+  (** [last_miss pi] is the most recent of:
+
+      * last failed connection
+      * last rejected connection
+      * last disconnection
+  *)
+
+  val greylisted :
+    ?now:Time.t -> 'conn point_info -> bool
+
+  val greylisted_until : 'conn point_info -> Time.t
+
+  val point : 'conn point_info -> Id.t
+
+  val log_incoming_rejection :
+    ?timestamp:Time.t -> 'conn point_info -> peer_id -> unit
+
+end
+
+module Pool_state : sig
+
+  type 'conn t =
+    | Requested of { cancel: Lwt_canceler.t }
+    (** We initiated a connection. *)
+    | Accepted of { current_peer_id: peer_id ;
+                    cancel: Lwt_canceler.t }
+    (** We accepted a incoming connection. *)
+    | Running of { data: 'conn ;
+                   current_peer_id: peer_id }
+    (** Successfully authentificated connection, normal business. *)
+    | Disconnected
+    (** No connection established currently. *)
+  type 'conn state = 'conn t
+
+  val pp : Format.formatter -> 'conn t -> unit
+
+  val get : 'conn Pool_info.t -> 'conn state
+
+  val is_disconnected : 'conn Pool_info.t -> bool
+
+  val set_requested :
+    ?timestamp:Time.t ->
+    'conn Pool_info.t -> Lwt_canceler.t -> unit
+
+  val set_accepted :
+    ?timestamp:Time.t ->
+    'conn Pool_info.t -> peer_id -> Lwt_canceler.t -> unit
+
+  val set_running :
+    ?timestamp:Time.t -> 'conn Pool_info.t -> peer_id -> 'conn -> unit
+
+  val set_disconnected :
+    ?timestamp:Time.t -> ?requested:bool -> 'conn Pool_info.t -> unit
+
+end
+
+module Pool_event : sig
+
+  type kind =
+    | Outgoing_request
+    (** We initiated a connection. *)
+    | Accepting_request of peer_id
+    (** We accepted a connection after authentifying the remote peer. *)
+    | Rejecting_request of peer_id
+    (** We rejected a connection after authentifying the remote peer. *)
+    | Request_rejected of peer_id option
+    (** The remote peer rejected our connection. *)
+    | Connection_established of peer_id
+    (** We succesfully established a authentified connection. *)
+    | Disconnection of peer_id
+    (** We decided to close the connection. *)
+    | External_disconnection of peer_id
+    (** The connection was closed for external reason. *)
+
+  type t = {
+    kind : kind ;
+    timestamp : Time.t ;
+  }
+
+  val encoding : t Data_encoding.t
+
+  val fold :
+    'conn Pool_info.t -> init:'a -> f:('a -> t -> 'a) -> 'a
+
+  val watch :
+    'conn Pool_info.t -> t Lwt_stream.t * Lwt_watcher.stopper
+
+end
+
+

src/lib_base/p2p_stat.ml

@@ -0,0 +1,64 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t = {
+  total_sent : int64 ;
+  total_recv : int64 ;
+  current_inflow : int ;
+  current_outflow : int ;
+}
+
+let empty = {
+  total_sent = 0L ;
+  total_recv = 0L ;
+  current_inflow = 0 ;
+  current_outflow = 0 ;
+}
+
+let print_size ppf sz =
+  let ratio n = (float_of_int sz /. float_of_int (1 lsl n)) in
+  if sz < 1 lsl 10 then
+    Format.fprintf ppf "%d B" sz
+  else if sz < 1 lsl 20 then
+    Format.fprintf ppf "%.2f kiB" (ratio 10)
+  else
+    Format.fprintf ppf "%.2f MiB" (ratio 20)
+
+let print_size64 ppf sz =
+  let open Int64 in
+  let ratio n = (to_float sz /. float_of_int (1 lsl n)) in
+  if sz < shift_left 1L 10 then
+    Format.fprintf ppf "%Ld B" sz
+  else if sz < shift_left 1L 20 then
+    Format.fprintf ppf "%.2f kiB" (ratio 10)
+  else if sz < shift_left 1L 30 then
+    Format.fprintf ppf "%.2f MiB" (ratio 20)
+  else if sz < shift_left 1L 40 then
+    Format.fprintf ppf "%.2f GiB" (ratio 30)
+  else
+    Format.fprintf ppf "%.2f TiB" (ratio 40)
+
+let pp ppf stat =
+  Format.fprintf ppf
+    "↗ %a (%a/s) ↘ %a (%a/s)"
+    print_size64 stat.total_sent print_size stat.current_outflow
+    print_size64 stat.total_recv print_size stat.current_inflow
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { total_sent ; total_recv ; current_inflow ; current_outflow } ->
+       (total_sent, total_recv, current_inflow, current_outflow))
+    (fun (total_sent, total_recv, current_inflow, current_outflow) ->
+       { total_sent ; total_recv ; current_inflow ; current_outflow })
+    (obj4
+       (req "total_sent" int64)
+       (req "total_recv" int64)
+       (req "current_inflow" int31)
+       (req "current_outflow" int31))

src/lib_base/p2p_stat.mli

@@ -0,0 +1,21 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Bandwidth usage statistics *)
+
+type t = {
+  total_sent : int64 ;
+  total_recv : int64 ;
+  current_inflow : int ;
+  current_outflow : int ;
+}
+
+val empty : t
+val pp : Format.formatter -> t -> unit
+val encoding : t Data_encoding.t

src/lib_base/p2p_version.ml

@@ -0,0 +1,40 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t = {
+  name : string ;
+  major : int ;
+  minor : int ;
+}
+
+let pp ppf { name ; major ; minor } =
+  Format.fprintf ppf "%s.%d.%d" name major minor
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { name; major; minor } -> (name, major, minor))
+    (fun (name, major, minor) -> { name; major; minor })
+    (obj3
+       (req "name" string)
+       (req "major" int8)
+       (req "minor" int8))
+
+(* the common version for a pair of peers, if any, is the maximum one,
+   in lexicographic order *)
+let common la lb =
+  let la = List.sort (fun l r -> compare r l) la in
+  let lb = List.sort (fun l r -> compare r l) lb in
+  let rec find = function
+    | [], _ | _, [] -> None
+    | ((a :: ta) as la), ((b :: tb) as lb) ->
+        if a = b then Some a
+        else if a < b then find (ta, lb)
+        else find (la, tb)
+  in find (la, lb)

src/lib_base/p2p_version.mli

@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Protocol version *)
+
+type t = {
+  name : string ;
+  major : int ;
+  minor : int ;
+}
+(** Type of a protocol version. *)
+
+val pp : Format.formatter -> t -> unit
+val encoding : t Data_encoding.t
+val common : t list -> t list -> t option
+

src/lib_base/time.ml

@@ -24,6 +24,14 @@ module T = struct
     let incr_sign = res >= a in
     if sign = incr_sign then res else invalid_arg "Time.add" ;;
 
+  let recent a1 a2 =
+    match a1, a2 with
+    | (None, None) -> None
+    | (None, (Some _ as a))
+    | (Some _ as a, None) -> a
+    | (Some (_, t1), Some (_, t2)) ->
+        if compare t1 t2 < 0 then a2 else a1
+
   let hash = to_int
   let (=) = equal
   let (<>) x y = compare x y <> 0

src/lib_base/time.mli

@@ -56,3 +56,6 @@ val timed_encoding : 'a Data_encoding.t -> 'a timed_data Data_encoding.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
+
+val recent :
+  ('a * t) option -> ('a * t) option -> ('a * t) option

src/lib_base/tzPervasives.ml

@@ -44,5 +44,13 @@ module Preapply_result = Preapply_result
 module Block_locator = Block_locator
 module Mempool = Mempool
 
+module P2p_addr = P2p_addr
+module P2p_identity = P2p_identity
+module P2p_peer = P2p_peer
+module P2p_point = P2p_point
+module P2p_connection = P2p_connection
+module P2p_stat = P2p_stat
+module P2p_version = P2p_version
+
 include Utils.Infix
 include Error_monad

src/lib_base/tzPervasives.mli

@@ -42,5 +42,13 @@ module Operation_list_list_hash = Operation_list_list_hash
 module Context_hash = Context_hash
 module Protocol_hash = Protocol_hash
 
+module P2p_addr = P2p_addr
+module P2p_identity = P2p_identity
+module P2p_peer = P2p_peer
+module P2p_point = P2p_point
+module P2p_connection = P2p_connection
+module P2p_stat = P2p_stat
+module P2p_version = P2p_version
+
 include (module type of (struct include Utils.Infix end))
 include (module type of (struct include Error_monad end))

src/lib_client_base/client_network.ml

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open P2p_types
-
 let group =
   { Cli_entries.name = "network" ;
     title = "Commands for monitoring and controlling network state" }
@@ -23,47 +21,47 @@ let commands () = [
     Client_node_rpcs.Network.peers cctxt >>=? fun peers ->
     Client_node_rpcs.Network.points cctxt >>=? fun points ->
     cctxt#message "GLOBAL STATS" >>= fun () ->
-    cctxt#message "  %a" Stat.pp stat >>= fun () ->
+    cctxt#message "  %a" P2p_stat.pp stat >>= fun () ->
     cctxt#message "CONNECTIONS" >>= fun () ->
     let incoming, outgoing =
-      List.partition (fun c -> c.Connection_info.incoming) conns in
+      List.partition (fun c -> c.P2p_connection.Info.incoming) conns in
     Lwt_list.iter_s begin fun conn ->
-      cctxt#message "  %a" Connection_info.pp conn
+      cctxt#message "  %a" P2p_connection.Info.pp conn
     end incoming >>= fun () ->
     Lwt_list.iter_s begin fun conn ->
-      cctxt#message "  %a" Connection_info.pp conn
+      cctxt#message "  %a" P2p_connection.Info.pp conn
     end outgoing >>= fun () ->
     cctxt#message "KNOWN PEERS" >>= fun () ->
     Lwt_list.iter_s begin fun (p, pi) ->
       cctxt#message "  %a  %.0f %a %a %s"
-        Peer_state.pp_digram pi.Peer_info.state
+        P2p_peer.State.pp_digram pi.P2p_peer.Info.state
         pi.score
-        Peer_id.pp p
+        P2p_peer.Id.pp p
-        Stat.pp pi.stat
+        P2p_stat.pp pi.stat
         (if pi.trusted then "★" else " ")
     end peers >>= fun () ->
     cctxt#message "KNOWN POINTS" >>= fun () ->
     Lwt_list.iter_s begin fun (p, pi) ->
-      match pi.Point_info.state with
+      match pi.P2p_point.Info.state with
       | Running peer_id ->
           cctxt#message "  %a  %a %a %s"
-            Point_state.pp_digram pi.state
+            P2p_point.State.pp_digram pi.state
-            Point.pp p
+            P2p_point.Id.pp p
-            Peer_id.pp peer_id
+            P2p_peer.Id.pp peer_id
             (if pi.trusted then "★" else " ")
       | _ ->
           match pi.last_seen with
           | Some (peer_id, ts) ->
               cctxt#message "  %a  %a (last seen: %a %a) %s"
-                Point_state.pp_digram pi.state
+                P2p_point.State.pp_digram pi.state
-                Point.pp p
+                P2p_point.Id.pp p
-                Peer_id.pp peer_id
+                P2p_peer.Id.pp peer_id
                 Time.pp_hum ts
                 (if pi.trusted then "★" else " ")
           | None ->
               cctxt#message "  %a  %a %s"
-                Point_state.pp_digram pi.state
+                P2p_point.State.pp_digram pi.state
-                Point.pp p
+                P2p_point.Id.pp p
                 (if pi.trusted then "★" else " ")
     end points >>= fun () ->
     return ()

src/lib_client_base/client_node_rpcs.mli

@@ -155,19 +155,17 @@ val bootstrapped:
 
 module Network : sig
 
-  open P2p_types
-
   val stat:
-    #Client_rpcs.ctxt -> Stat.t tzresult Lwt.t
+    #Client_rpcs.ctxt -> P2p_stat.t tzresult Lwt.t
 
   val connections:
-    #Client_rpcs.ctxt -> Connection_info.t list tzresult Lwt.t
+    #Client_rpcs.ctxt -> P2p_connection.Info.t list tzresult Lwt.t
 
   val peers:
-    #Client_rpcs.ctxt -> (Peer_id.t * P2p_types.Peer_info.t) list tzresult Lwt.t
+    #Client_rpcs.ctxt -> (P2p_peer.Id.t * P2p_peer.Info.t) list tzresult Lwt.t
 
   val points:
-    #Client_rpcs.ctxt -> (Point.t * P2p_types.Point_info.t) list tzresult Lwt.t
+    #Client_rpcs.ctxt -> (P2p_point.Id.t * P2p_point.Info.t) list tzresult Lwt.t
 
 end
 

src/lib_p2p/p2p.ml

@@ -7,17 +7,15 @@
 (*                                                                        *)
 (**************************************************************************)
 
-include P2p_types
-
 include Logging.Make(struct let name = "p2p" end)
 
-type 'meta meta_config = 'meta P2p_connection_pool.meta_config = {
+type 'meta meta_config = 'meta P2p_pool.meta_config = {
   encoding : 'meta Data_encoding.t;
   initial : 'meta;
   score : 'meta -> float
 }
 
-type 'msg app_message_encoding = 'msg P2p_connection_pool.encoding =
+type 'msg app_message_encoding = 'msg P2p_pool.encoding =
     Encoding : {
       tag: int ;
       encoding: 'a Data_encoding.t ;
@@ -26,18 +24,18 @@ type 'msg app_message_encoding = 'msg P2p_connection_pool.encoding =
       max_length: int option ;
     } -> 'msg app_message_encoding
 
-type 'msg message_config = 'msg P2p_connection_pool.message_config = {
+type 'msg message_config = 'msg P2p_pool.message_config = {
   encoding : 'msg app_message_encoding list ;
-  versions : Version.t list;
+  versions : P2p_version.t list;
 }
 
 type config = {
-  listening_port : port option;
+  listening_port : P2p_addr.port option;
-  listening_addr : addr option;
+  listening_addr : P2p_addr.t option;
-  trusted_points : Point.t list ;
+  trusted_points : P2p_point.Id.t list ;
   peers_file : string ;
   closed_network : bool ;
-  identity : Identity.t ;
+  identity : P2p_identity.t ;
   proof_of_work_target : Crypto_box.target ;
 }
 
@@ -87,7 +85,7 @@ let create_scheduler limits =
 
 let create_connection_pool config limits meta_cfg msg_cfg io_sched =
   let pool_cfg = {
-    P2p_connection_pool.identity = config.identity ;
+    P2p_pool.identity = config.identity ;
     proof_of_work_target = config.proof_of_work_target ;
     listening_port = config.listening_port ;
     trusted_points = config.trusted_points ;
@@ -109,7 +107,7 @@ let create_connection_pool config limits meta_cfg msg_cfg io_sched =
   }
   in
   let pool =
-    P2p_connection_pool.create pool_cfg meta_cfg msg_cfg io_sched in
+    P2p_pool.create pool_cfg meta_cfg msg_cfg io_sched in
   pool
 
 let bounds ~min ~expected ~max =
@@ -149,7 +147,7 @@ let may_create_welcome_worker config limits pool =
         port >>= fun w ->
       Lwt.return (Some w)
 
-type ('msg, 'meta) connection = ('msg, 'meta) P2p_connection_pool.connection
+type ('msg, 'meta) connection = ('msg, 'meta) P2p_pool.connection
 
 module Real = struct
 
@@ -157,7 +155,7 @@ module Real = struct
     config: config ;
     limits: limits ;
     io_sched: P2p_io_scheduler.t ;
-    pool: ('msg, 'meta) P2p_connection_pool.t ;
+    pool: ('msg, 'meta) P2p_pool.t ;
     discoverer: P2p_discovery.t option ;
     maintenance: 'meta P2p_maintenance.t ;
     welcome: P2p_welcome.t option ;
@@ -193,119 +191,119 @@ module Real = struct
     Lwt_utils.may ~f:P2p_welcome.shutdown net.welcome >>= fun () ->
     P2p_maintenance.shutdown net.maintenance >>= fun () ->
     Lwt_utils.may ~f:P2p_discovery.shutdown net.discoverer >>= fun () ->
-    P2p_connection_pool.destroy net.pool >>= fun () ->
+    P2p_pool.destroy net.pool >>= fun () ->
     P2p_io_scheduler.shutdown ~timeout:3.0 net.io_sched
 
   let connections { pool } () =
-    P2p_connection_pool.Connection.fold pool
+    P2p_pool.Connection.fold pool
       ~init:[] ~f:(fun _peer_id c acc -> c :: acc)
   let find_connection { pool } peer_id =
-    P2p_connection_pool.Connection.find_by_peer_id pool peer_id
+    P2p_pool.Connection.find_by_peer_id pool peer_id
   let disconnect ?wait conn =
-    P2p_connection_pool.disconnect ?wait conn
+    P2p_pool.disconnect ?wait conn
   let connection_info _net conn =
-    P2p_connection_pool.Connection.info conn
+    P2p_pool.Connection.info conn
   let connection_stat _net conn =
-    P2p_connection_pool.Connection.stat conn
+    P2p_pool.Connection.stat conn
   let global_stat { pool } () =
-    P2p_connection_pool.pool_stat pool
+    P2p_pool.pool_stat pool
   let set_metadata { pool } conn meta =
-    P2p_connection_pool.Peer_ids.set_metadata pool conn meta
+    P2p_pool.Peers.set_metadata pool conn meta
   let get_metadata { pool } conn =
-    P2p_connection_pool.Peer_ids.get_metadata pool conn
+    P2p_pool.Peers.get_metadata pool conn
 
   let recv _net conn =
-    P2p_connection_pool.read conn >>=? fun msg ->
+    P2p_pool.read conn >>=? fun msg ->
     lwt_debug "message read from %a"
-      Connection_info.pp
+      P2p_connection.Info.pp
-      (P2p_connection_pool.Connection.info conn) >>= fun () ->
+      (P2p_pool.Connection.info conn) >>= fun () ->
     return msg
 
   let rec recv_any net () =
     let pipes =
-      P2p_connection_pool.Connection.fold
+      P2p_pool.Connection.fold
         net.pool ~init:[]
         ~f:begin fun _peer_id conn acc ->
-          (P2p_connection_pool.is_readable conn >>= function
+          (P2p_pool.is_readable conn >>= function
             | Ok () -> Lwt.return (Some conn)
             | Error _ -> Lwt_utils.never_ending) :: acc
         end in
     Lwt.pick (
-      ( P2p_connection_pool.Pool_event.wait_new_connection net.pool >>= fun () ->
+      ( P2p_pool.Pool_event.wait_new_connection net.pool >>= fun () ->
         Lwt.return_none )::
       pipes) >>= function
     | None -> recv_any net ()
     | Some conn ->
-        P2p_connection_pool.read conn >>= function
+        P2p_pool.read conn >>= function
         | Ok msg ->
             lwt_debug "message read from %a"
-              Connection_info.pp
+              P2p_connection.Info.pp
-              (P2p_connection_pool.Connection.info conn) >>= fun () ->
+              (P2p_pool.Connection.info conn) >>= fun () ->
             Lwt.return (conn, msg)
         | Error _ ->
             lwt_debug "error reading message from %a"
-              Connection_info.pp
+              P2p_connection.Info.pp
-              (P2p_connection_pool.Connection.info conn) >>= fun () ->
+              (P2p_pool.Connection.info conn) >>= fun () ->
             Lwt_unix.yield () >>= fun () ->
             recv_any net ()
 
   let send _net conn m =
-    P2p_connection_pool.write conn m >>= function
+    P2p_pool.write conn m >>= function
     | Ok () ->
         lwt_debug "message sent to %a"
-          Connection_info.pp
+          P2p_connection.Info.pp
-          (P2p_connection_pool.Connection.info conn) >>= fun () ->
+          (P2p_pool.Connection.info conn) >>= fun () ->
         return ()
     | Error err ->
         lwt_debug "error sending message from %a: %a"
-          Connection_info.pp
+          P2p_connection.Info.pp
-          (P2p_connection_pool.Connection.info conn)
+          (P2p_pool.Connection.info conn)
           pp_print_error err >>= fun () ->
         Lwt.return (Error err)
 
   let try_send _net conn v =
-    match P2p_connection_pool.write_now conn v with
+    match P2p_pool.write_now conn v with
     | Ok v ->
         debug "message trysent to %a"
-          Connection_info.pp
+          P2p_connection.Info.pp
-          (P2p_connection_pool.Connection.info conn) ;
+          (P2p_pool.Connection.info conn) ;
         v
     | Error err ->
         debug "error trysending message to %a@ %a"
-          Connection_info.pp
+          P2p_connection.Info.pp
-          (P2p_connection_pool.Connection.info conn)
+          (P2p_pool.Connection.info conn)
           pp_print_error err ;
         false
 
   let broadcast { pool } msg =
-    P2p_connection_pool.write_all pool msg ;
+    P2p_pool.write_all pool msg ;
     debug "message broadcasted"
 
   let fold_connections { pool } ~init ~f =
-    P2p_connection_pool.Connection.fold pool ~init ~f
+    P2p_pool.Connection.fold pool ~init ~f
 
   let iter_connections { pool } f =
-    P2p_connection_pool.Connection.fold pool
+    P2p_pool.Connection.fold pool
       ~init:()
       ~f:(fun gid conn () -> f gid conn)
 
   let on_new_connection { pool } f =
-    P2p_connection_pool.on_new_connection pool f
+    P2p_pool.on_new_connection pool f
 
   let pool { pool } = pool
 end
 
 module Fake = struct
 
-  let id = Identity.generate (Crypto_box.make_target 0.)
+  let id = P2p_identity.generate (Crypto_box.make_target 0.)
   let empty_stat = {
-    Stat.total_sent = 0L ;
+    P2p_stat.total_sent = 0L ;
     total_recv = 0L ;
     current_inflow = 0 ;
     current_outflow = 0 ;
   }
   let connection_info = {
-    Connection_info.incoming = false ;
+    P2p_connection.Info.incoming = false ;
     peer_id = id.peer_id ;
     id_point = (Ipaddr.V6.unspecified, None) ;
     remote_socket_port = 0 ;
@@ -315,28 +313,28 @@ module Fake = struct
 end
 
 type ('msg, 'meta) t = {
-  peer_id : Peer_id.t ;
+  peer_id : P2p_peer.Id.t ;
   maintain : unit -> unit Lwt.t ;
   roll : unit -> unit Lwt.t ;
   shutdown : unit -> unit Lwt.t ;
   connections : unit -> ('msg, 'meta) connection list ;
-  find_connection : Peer_id.t -> ('msg, 'meta) connection option ;
+  find_connection : P2p_peer.Id.t -> ('msg, 'meta) connection option ;
   disconnect : ?wait:bool -> ('msg, 'meta) connection -> unit Lwt.t ;
-  connection_info : ('msg, 'meta) connection -> Connection_info.t ;
+  connection_info : ('msg, 'meta) connection -> P2p_connection.Info.t ;
-  connection_stat : ('msg, 'meta) connection -> Stat.t ;
+  connection_stat : ('msg, 'meta) connection -> P2p_stat.t ;
-  global_stat : unit -> Stat.t ;
+  global_stat : unit -> P2p_stat.t ;
-  get_metadata : Peer_id.t -> 'meta ;
+  get_metadata : P2p_peer.Id.t -> 'meta ;
-  set_metadata : Peer_id.t -> 'meta -> unit ;
+  set_metadata : P2p_peer.Id.t -> 'meta -> unit ;
   recv : ('msg, 'meta) connection -> 'msg tzresult Lwt.t ;
   recv_any : unit -> (('msg, 'meta) connection * 'msg) Lwt.t ;
   send : ('msg, 'meta) connection -> 'msg -> unit tzresult Lwt.t ;
   try_send : ('msg, 'meta) connection -> 'msg -> bool ;
   broadcast : 'msg -> unit ;
-  pool : ('msg, 'meta) P2p_connection_pool.t option ;
+  pool : ('msg, 'meta) P2p_pool.t option ;
   fold_connections :
-    'a. init:'a -> f:(Peer_id.t -> ('msg, 'meta) connection -> 'a -> 'a) -> 'a ;
+    'a. init:'a -> f:(P2p_peer.Id.t -> ('msg, 'meta) connection -> 'a -> 'a) -> 'a ;
-  iter_connections : (Peer_id.t -> ('msg, 'meta) connection -> unit) -> unit ;
+  iter_connections : (P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) -> unit ;
-  on_new_connection : (Peer_id.t -> ('msg, 'meta) connection -> unit) -> unit ;
+  on_new_connection : (P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) -> unit ;
 }
 type ('msg, 'meta) net = ('msg, 'meta) t
 
@@ -374,7 +372,7 @@ let check_limits =
     begin
       match c.binary_chunks_size with
       | None -> return ()
-      | Some size -> P2p_connection.check_binary_chunks_size size
+      | Some size -> P2p_socket.check_binary_chunks_size size
     end >>=? fun () ->
     return ()
 
@@ -420,7 +418,7 @@ let faked_network meta_config = {
   set_metadata = (fun _ _ -> ()) ;
   recv = (fun _ -> Lwt_utils.never_ending) ;
   recv_any = (fun () -> Lwt_utils.never_ending) ;
-  send = (fun _ _ -> fail P2p_connection_pool.Connection_closed) ;
+  send = (fun _ _ -> fail P2p_pool.Connection_closed) ;
   try_send = (fun _ _ -> false) ;
   fold_connections = (fun ~init ~f:_ -> init) ;
   iter_connections = (fun _f -> ()) ;
@@ -451,35 +449,33 @@ let iter_connections net = net.iter_connections
 let on_new_connection net = net.on_new_connection
 
 module Raw = struct
-  type 'a t = 'a P2p_connection_pool.Message.t =
+  type 'a t = 'a P2p_pool.Message.t =
     | Bootstrap
-    | Advertise of P2p_types.Point.t list
+    | Advertise of P2p_point.Id.t list
-    | Swap_request of Point.t * Peer_id.t
+    | Swap_request of P2p_point.Id.t * P2p_peer.Id.t
-    | Swap_ack of Point.t * Peer_id.t
+    | Swap_ack of P2p_point.Id.t * P2p_peer.Id.t
     | Message of 'a
     | Disconnect
-  let encoding = P2p_connection_pool.Message.encoding
+  let encoding = P2p_pool.Message.encoding
 end
 
 module RPC = struct
 
   let stat net =
     match net.pool with
-    | None -> Stat.empty
+    | None -> P2p_stat.empty
-    | Some pool -> P2p_connection_pool.pool_stat pool
+    | Some pool -> P2p_pool.pool_stat pool
-
-  module Event = P2p_connection_pool.Log_event
 
   let watch net =
     match net.pool with
     | None -> Lwt_watcher.create_fake_stream ()
-    | Some pool -> P2p_connection_pool.watch pool
+    | Some pool -> P2p_pool.watch pool
 
   let connect net point timeout =
     match net.pool with
     | None -> failwith "fake net"
     | Some pool ->
-        P2p_connection_pool.connect ~timeout pool point >>|? ignore
+        P2p_pool.connect ~timeout pool point >>|? ignore
 
   module Connection = struct
     let info net peer_id =
@@ -487,46 +483,45 @@ module RPC = struct
       | None -> None
       | Some pool ->
           Option.map
-            (P2p_connection_pool.Connection.find_by_peer_id pool peer_id)
+            (P2p_pool.Connection.find_by_peer_id pool peer_id)
-            ~f:P2p_connection_pool.Connection.info
+            ~f:P2p_pool.Connection.info
 
     let kick net peer_id wait =
       match net.pool with
       | None -> Lwt.return_unit
       | Some pool ->
-          match P2p_connection_pool.Connection.find_by_peer_id pool peer_id with
+          match P2p_pool.Connection.find_by_peer_id pool peer_id with
           | None -> Lwt.return_unit
-          | Some conn -> P2p_connection_pool.disconnect ~wait conn
+          | Some conn -> P2p_pool.disconnect ~wait conn
 
     let list net =
       match net.pool with
       | None -> []
       | Some pool ->
-          P2p_connection_pool.Connection.fold
+          P2p_pool.Connection.fold
             pool ~init:[]
             ~f:begin fun _peer_id c acc ->
-              P2p_connection_pool.Connection.info c :: acc
+              P2p_pool.Connection.info c :: acc
             end
 
     let count net =
       match net.pool with
       | None -> 0
-      | Some pool -> P2p_connection_pool.active_connections pool
+      | Some pool -> P2p_pool.active_connections pool
   end
 
   module Point = struct
 
-    open P2p_types.Point_info
+    open P2p_point.Info
-    open P2p_types.Point_state
+    open P2p_point.State
 
     let info_of_point_info i =
-      let open P2p_connection_pool_types in
+      let state = match P2p_point.Pool_state.get i with
-      let state = match Point_info.State.get i with
         | Requested _ -> Requested
         | Accepted { current_peer_id ; _ } -> Accepted current_peer_id
         | Running { current_peer_id ; _ } -> Running current_peer_id
         | Disconnected -> Disconnected in
-      Point_info.{
+      P2p_point.Pool_info.{
         trusted = trusted i ;
         state ;
         greylisted_until = greylisted_until i ;
@@ -543,21 +538,19 @@ module RPC = struct
       | None -> None
       | Some pool ->
           Option.map
-            (P2p_connection_pool.Points.info pool point)
+            (P2p_pool.Points.info pool point)
             ~f:info_of_point_info
 
-    module Event = P2p_connection_pool_types.Point_info.Event
-
     let events ?(max=max_int) ?(rev=false) net point =
       match net.pool with
       | None -> []
       | Some pool ->
           Option.unopt_map
-            (P2p_connection_pool.Points.info pool point)
+            (P2p_pool.Points.info pool point)
             ~default:[]
             ~f:begin fun pi ->
               let evts =
-                P2p_connection_pool_types.Point_info.fold_events
+                P2p_point.Pool_event.fold
                   pi ~init:[] ~f:(fun a e -> e :: a) in
               (if rev then List.rev_sub else List.sub) evts max
             end
@@ -566,15 +559,15 @@ module RPC = struct
       match net.pool with
       | None -> raise Not_found
       | Some pool ->
-          match P2p_connection_pool.Points.info pool point with
+          match P2p_pool.Points.info pool point with
           | None -> raise Not_found
-          | Some pi -> P2p_connection_pool_types.Point_info.watch pi
+          | Some pi -> P2p_point.Pool_event.watch pi
 
     let list ?(restrict=[]) net =
       match net.pool with
       | None -> []
       | Some pool ->
-          P2p_connection_pool.Points.fold_known
+          P2p_pool.Points.fold_known
             pool ~init:[]
             ~f:begin fun point i a ->
               let info = info_of_point_info i in
@@ -588,24 +581,22 @@ module RPC = struct
 
   module Peer_id = struct
 
-    open P2p_types.Peer_info
+    open P2p_peer.Info
-    open P2p_types.Peer_state
+    open P2p_peer.State
 
     let info_of_peer_info pool i =
-      let open P2p_connection_pool in
+      let state, id_point = match P2p_peer.Pool_state.get i with
-      let open P2p_connection_pool_types in
-      let state, id_point = match Peer_info.State.get i with
         | Accepted { current_point } -> Accepted, Some current_point
         | Running { current_point } -> Running, Some current_point
         | Disconnected -> Disconnected, None
       in
-      let peer_id = Peer_info.peer_id i in
+      let peer_id = P2p_peer.Pool_info.peer_id i in
-      let score = Peer_ids.get_score pool peer_id in
+      let score = P2p_pool.Peers.get_score pool peer_id in
       let stat =
-        match P2p_connection_pool.Connection.find_by_peer_id pool peer_id with
+        match P2p_pool.Connection.find_by_peer_id pool peer_id with
-        | None -> Stat.empty
+        | None -> P2p_stat.empty
-        | Some conn -> P2p_connection_pool.Connection.stat conn
+        | Some conn -> P2p_pool.Connection.stat conn
-      in Peer_info.{
+      in P2p_peer.Pool_info.{
           score ;
           trusted = trusted i ;
           state ;
@@ -623,7 +614,7 @@ module RPC = struct
       match net.pool with
       | None -> None
       | Some pool -> begin
-          match P2p_connection_pool.Peer_ids.info pool peer_id with
+          match P2p_pool.Peers.info pool peer_id with
           | Some info -> Some (info_of_peer_info pool info)
           | None -> None
         end
@@ -633,10 +624,10 @@ module RPC = struct
       | None -> []
       | Some pool ->
           Option.unopt_map
-            (P2p_connection_pool.Peer_ids.info pool peer_id)
+            (P2p_pool.Peers.info pool peer_id)
             ~default:[]
             ~f:begin fun gi ->
-              let evts = P2p_connection_pool_types.Peer_info.fold_events gi
+              let evts = P2p_peer.Pool_event.fold gi
                   ~init:[] ~f:(fun a e -> e :: a) in
               (if rev then List.rev_sub else List.sub) evts max
             end
@@ -645,15 +636,15 @@ module RPC = struct
       match net.pool with
       | None -> raise Not_found
       | Some pool ->
-          match P2p_connection_pool.Peer_ids.info pool peer_id with
+          match P2p_pool.Peers.info pool peer_id with
           | None -> raise Not_found
-          | Some gi -> P2p_connection_pool_types.Peer_info.watch gi
+          | Some gi -> P2p_peer.Pool_event.watch gi
 
     let list ?(restrict=[]) net =
       match net.pool with
       | None -> []
       | Some pool ->
-          P2p_connection_pool.Peer_ids.fold_known pool
+          P2p_pool.Peers.fold_known pool
             ~init:[]
             ~f:begin fun peer_id i a ->
               let info = info_of_peer_info pool i in

src/lib_p2p/p2p.mli

@@ -9,28 +9,6 @@
 
 (** Tezos Shell Net - Low level API for the Gossip network *)
 
-(** A peer connection address *)
-type addr = Ipaddr.V6.t
-
-(** A peer connection port *)
-type port = int
-
-(** A p2p protocol version *)
-module Version = P2p_types.Version
-
-(** A global identifier for a peer, a.k.a. an identity *)
-module Peer_id = P2p_types.Peer_id
-
-module Identity = P2p_types.Identity
-
-module Point = P2p_types.Point
-
-module Id_point = P2p_types.Id_point
-
-module Connection_info = P2p_types.Connection_info
-
-module Stat = P2p_types.Stat
-
 type 'meta meta_config = {
   encoding : 'meta Data_encoding.t;
   initial : 'meta;
@@ -47,21 +25,21 @@ type 'msg app_message_encoding = Encoding : {
 
 type 'msg message_config = {
   encoding : 'msg app_message_encoding list ;
-  versions : Version.t list;
+  versions : P2p_version.t list;
 }
 
 (** Network configuration *)
 type config = {
 
-  listening_port : port option;
+  listening_port : P2p_addr.port option;
   (** Tells if incoming connections accepted, precising the TCP port
       on which the peer can be reached *)
 
-  listening_addr : addr option;
+  listening_addr : P2p_addr.t option;
   (** When incoming connections are accepted, precising on which
       IP adddress the node listen (default: [[::]]). *)
 
-  trusted_points : Point.t list ;
+  trusted_points : P2p_point.Id.t list ;
   (** List of hard-coded known peers to bootstrap the network from. *)
 
   peers_file : string ;
@@ -72,7 +50,7 @@ type config = {
   (** If [true], the only accepted connections are from peers whose
       addresses are in [trusted_peers]. *)
 
-  identity : Identity.t ;
+  identity : P2p_identity.t ;
   (** Cryptographic identity of the peer. *)
 
   proof_of_work_target : Crypto_box.target ;
@@ -148,7 +126,7 @@ val create :
   'meta meta_config -> 'msg message_config ->  ('msg, 'meta) net tzresult Lwt.t
 
 (** Return one's peer_id *)
-val peer_id : ('msg, 'meta) net -> Peer_id.t
+val peer_id : ('msg, 'meta) net -> P2p_peer.Id.t
 
 (** A maintenance operation : try and reach the ideal number of peers *)
 val maintain : ('msg, 'meta) net -> unit Lwt.t
@@ -166,23 +144,23 @@ type ('msg, 'meta) connection
 val connections : ('msg, 'meta) net -> ('msg, 'meta) connection list
 
 (** Return the active peer with identity [peer_id] *)
-val find_connection : ('msg, 'meta) net -> Peer_id.t -> ('msg, 'meta) connection option
+val find_connection : ('msg, 'meta) net -> P2p_peer.Id.t -> ('msg, 'meta) connection option
 
 (** Access the info of an active peer, if available *)
 val connection_info :
-  ('msg, 'meta) net -> ('msg, 'meta) connection -> Connection_info.t
+  ('msg, 'meta) net -> ('msg, 'meta) connection -> P2p_connection.Info.t
 val connection_stat :
-  ('msg, 'meta) net -> ('msg, 'meta) connection -> Stat.t
+  ('msg, 'meta) net -> ('msg, 'meta) connection -> P2p_stat.t
 
 (** Cleanly closes a connection. *)
 val disconnect :
   ('msg, 'meta) net -> ?wait:bool -> ('msg, 'meta) connection -> unit Lwt.t
 
-val global_stat : ('msg, 'meta) net -> Stat.t
+val global_stat : ('msg, 'meta) net -> P2p_stat.t
 
 (** Accessors for meta information about a global identifier *)
-val get_metadata : ('msg, 'meta) net -> Peer_id.t -> 'meta
+val get_metadata : ('msg, 'meta) net -> P2p_peer.Id.t -> 'meta
-val set_metadata : ('msg, 'meta) net -> Peer_id.t -> 'meta -> unit
+val set_metadata : ('msg, 'meta) net -> P2p_peer.Id.t -> 'meta -> unit
 
 (** Wait for a message from a given connection. *)
 val recv :
@@ -207,56 +185,56 @@ val broadcast : ('msg, 'meta) net -> 'msg -> unit
 
 module RPC : sig
 
-  val stat : ('msg, 'meta) net -> Stat.t
+  val stat : ('msg, 'meta) net -> P2p_stat.t
 
   val watch :
     ('msg, 'meta) net ->
-    P2p_types.Connection_pool_log_event.t Lwt_stream.t * Lwt_watcher.stopper
+    P2p_connection.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper
-  val connect : ('msg, 'meta) net -> Point.t -> float -> unit tzresult Lwt.t
+  val connect : ('msg, 'meta) net -> P2p_point.Id.t -> float -> unit tzresult Lwt.t
 
   module Connection : sig
-    val info : ('msg, 'meta) net -> Peer_id.t -> Connection_info.t option
+    val info : ('msg, 'meta) net -> P2p_peer.Id.t -> P2p_connection.Info.t option
-    val kick : ('msg, 'meta) net -> Peer_id.t -> bool -> unit Lwt.t
+    val kick : ('msg, 'meta) net -> P2p_peer.Id.t -> bool -> unit Lwt.t
-    val list : ('msg, 'meta) net -> Connection_info.t list
+    val list : ('msg, 'meta) net -> P2p_connection.Info.t list
     val count : ('msg, 'meta) net -> int
   end
 
   module Point : sig
 
     val info :
-      ('msg, 'meta) net -> Point.t -> P2p_types.Point_info.t option
+      ('msg, 'meta) net -> P2p_point.Id.t -> P2p_point.Info.t option
 
     val list :
-      ?restrict: P2p_types.Point_state.t list ->
+      ?restrict: P2p_point.State.t list ->
-      ('msg, 'meta) net -> (Point.t * P2p_types.Point_info.t) list
+      ('msg, 'meta) net -> (P2p_point.Id.t * P2p_point.Info.t) list
 
     val events :
-      ?max:int -> ?rev:bool -> ('msg, 'meta) net -> Point.t ->
+      ?max:int -> ?rev:bool -> ('msg, 'meta) net -> P2p_point.Id.t ->
-      P2p_connection_pool_types.Point_info.Event.t list
+      P2p_point.Pool_event.t list
 
     val watch :
-      ('msg, 'meta) net -> Point.t ->
+      ('msg, 'meta) net -> P2p_point.Id.t ->
-      P2p_connection_pool_types.Point_info.Event.t Lwt_stream.t * Lwt_watcher.stopper
+      P2p_point.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper
 
   end
 
   module Peer_id : sig
 
     val info :
-      ('msg, 'meta) net -> Peer_id.t -> P2p_types.Peer_info.t option
+      ('msg, 'meta) net -> P2p_peer.Id.t -> P2p_peer.Info.t option
 
     val list :
-      ?restrict: P2p_types.Peer_state.t list ->
+      ?restrict: P2p_peer.State.t list ->
-      ('msg, 'meta) net -> (Peer_id.t * P2p_types.Peer_info.t) list
+      ('msg, 'meta) net -> (P2p_peer.Id.t * P2p_peer.Info.t) list
 
     val events :
       ?max: int -> ?rev: bool ->
-      ('msg, 'meta) net -> Peer_id.t ->
+      ('msg, 'meta) net -> P2p_peer.Id.t ->
-      P2p_connection_pool_types.Peer_info.Event.t list
+      P2p_peer.Pool_event.t list
 
     val watch :
-      ('msg, 'meta) net -> Peer_id.t ->
+      ('msg, 'meta) net -> P2p_peer.Id.t ->
-      P2p_connection_pool_types.Peer_info.Event.t Lwt_stream.t * Lwt_watcher.stopper
+      P2p_peer.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper
 
   end
 
@@ -264,24 +242,24 @@ end
 
 val fold_connections :
   ('msg, 'meta) net ->
-  init:'a -> f:(Peer_id.t -> ('msg, 'meta) connection -> 'a -> 'a) -> 'a
+  init:'a -> f:(P2p_peer.Id.t -> ('msg, 'meta) connection -> 'a -> 'a) -> 'a
 
 val iter_connections :
   ('msg, 'meta) net ->
-  (Peer_id.t -> ('msg, 'meta) connection -> unit) -> unit
+  (P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) -> unit
 
 val on_new_connection :
   ('msg, 'meta) net ->
-  (Peer_id.t -> ('msg, 'meta) connection -> unit) -> unit
+  (P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) -> unit
 
 (**/**)
 
 module Raw : sig
   type 'a t =
     | Bootstrap
-    | Advertise of P2p_types.Point.t list
+    | Advertise of P2p_point.Id.t list
-    | Swap_request of Point.t * Peer_id.t
+    | Swap_request of P2p_point.Id.t * P2p_peer.Id.t
-    | Swap_ack of Point.t * Peer_id.t
+    | Swap_ack of P2p_point.Id.t * P2p_peer.Id.t
     | Message of 'a
     | Disconnect
   val encoding: 'msg app_message_encoding list -> 'msg t Data_encoding.t

src/lib_p2p/p2p_discovery.ml

@@ -20,7 +20,7 @@ let inet_addr = Unix.inet_addr_of_string "ff0e::54:455a:3053"
 module Message = struct
 
   let encoding =
-    Data_encoding.(tup3 (Fixed.string 10) Peer_id.encoding int16)
+    Data_encoding.(tup3 (Fixed.string 10) P2p_peer.Id.encoding int16)
 
   let length = Data_encoding.Binary.fixed_length_exn encoding
 
@@ -40,7 +40,7 @@ let sender sock saddr my_peer_id inco_port cancelation restart =
          Lwt.return_unit)
         (fun exn ->
           lwt_debug "(%a) error broadcasting a discovery request: %a"
-            Peer_id.pp my_peer_id Error_monad.pp (Exn exn)) >>= fun () ->
+            P2p_peer.Id.pp my_peer_id Error_monad.pp (Exn exn)) >>= fun () ->
     Lwt.pick
       [ (Lwt_unix.sleep delay >>= fun () -> Lwt.return (Some (delay, n + 1))) ;
         (cancelation () >>= fun () -> Lwt.return_none) ;
@@ -100,7 +100,7 @@ module Answerer = struct
     Lwt.catch
       (fun () ->
          Lwt_utils.worker
-           (Format.asprintf "(%a) discovery answerer" Peer_id.pp my_peer_id)
+           (Format.asprintf "(%a) discovery answerer" P2p_peer.Id.pp my_peer_id)
            (fun () -> answerer fd my_peer_id cancelation callback)
            cancel)
       (fun exn ->
@@ -118,7 +118,7 @@ let discovery_sender =
              Discovery.sender fd
                saddr my_peer_id inco_port cancelation restart_discovery in
            Lwt_utils.worker
-             (Format.asprintf "(%a) discovery sender" Peer_id.pp my_peer_id)
+             (Format.asprintf "(%a) discovery sender" P2p_peer.Id.pp my_peer_id)
              sender cancel)
         (fun exn ->
            lwt_log_error "Discovery sender not started: %a"

src/lib_p2p/p2p_discovery.mli

@@ -8,6 +8,6 @@
 (**************************************************************************)
 
 type t
-val create : ('msg, 'meta) P2p_connection_pool.pool -> t
+val create : ('msg, 'meta) P2p_pool.t -> t
 val restart : t -> unit
 val shutdown : t -> unit Lwt.t

src/lib_p2p/p2p_io_scheduler.ml

@@ -17,7 +17,6 @@ let () =
   if Sys.os_type <> "Win32" then
     Sys.(set_signal sigpipe Signal_ignore)
 
-open P2p_types
 include Logging.Make (struct let name = "p2p.io-scheduler" end)
 
 module Inttbl = Hashtbl.Make(struct
@@ -457,7 +456,7 @@ let read_full conn ?pos ?len buf =
   loop pos len
 
 let convert ~ws ~rs =
-  { Stat.total_sent = ws.Moving_average.total ;
+  { P2p_stat.total_sent = ws.Moving_average.total ;
     total_recv = rs.Moving_average.total ;
     current_outflow = ws.average ;
     current_inflow = rs.average ;

src/lib_p2p/p2p_io_scheduler.mli

@@ -23,8 +23,6 @@
     num_connections).
 *)
 
-open P2p_types
-
 type connection
 (** Type of a connection. *)
 
@@ -71,11 +69,11 @@ val read_full:
   connection -> ?pos:int -> ?len:int -> MBytes.t -> unit tzresult Lwt.t
 (** Like [read], but blits exactly [len] bytes in [buf]. *)
 
-val stat: connection -> Stat.t
+val stat: connection -> P2p_stat.t
 (** [stat conn] is a snapshot of current bandwidth usage for
     [conn]. *)
 
-val global_stat: t -> Stat.t
+val global_stat: t -> P2p_stat.t
 (** [global_stat sched] is a snapshot of [sched]'s bandwidth usage
     (sum of [stat conn] for each [conn] in [sched]). *)
 

src/lib_p2p/p2p_maintenance.ml

@@ -7,9 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open P2p_types
-open P2p_connection_pool_types
-
 include Logging.Make (struct let name = "p2p.maintenance" end)
 
 type bounds = {
@@ -19,7 +16,7 @@ type bounds = {
   max_threshold: int ;
 }
 
-type 'meta pool = Pool : ('msg, 'meta) P2p_connection_pool.t -> 'meta pool
+type 'meta pool = Pool : ('msg, 'meta) P2p_pool.t -> 'meta pool
 
 type 'meta t = {
   canceler: Lwt_canceler.t ;
@@ -41,7 +38,7 @@ let connectable st start_time expected =
   let now = Time.now () in
   let module Bounded_point_info =
     List.Bounded(struct
-      type t = (Time.t option * Point.t)
+      type t = (Time.t option * P2p_point.Id.t)
       let compare (t1, _) (t2, _) =
         match t1, t2 with
         | None, None -> 0
@@ -50,13 +47,13 @@ let connectable st start_time expected =
         | Some t1, Some t2 -> Time.compare t2 t1
     end) in
   let acc = Bounded_point_info.create expected in
-  P2p_connection_pool.Points.fold_known pool ~init:()
+  P2p_pool.Points.fold_known pool ~init:()
     ~f:begin fun point pi () ->
-      match Point_info.State.get pi with
+      match P2p_point.Pool_state.get pi with
       | Disconnected -> begin
-          match Point_info.last_miss pi with
+          match P2p_point.Pool_info.last_miss pi with
           | Some last when Time.(start_time < last)
-                        || Point_info.greylisted ~now pi -> ()
+                        || P2p_point.Pool_info.greylisted ~now pi -> ()
           | last ->
               Bounded_point_info.insert (last, point) acc
         end
@@ -83,7 +80,7 @@ let rec try_to_contact
     else
       List.fold_left
         (fun acc point ->
-           P2p_connection_pool.connect
+           P2p_pool.connect
              ~timeout:st.connection_timeout pool point >>= function
            | Ok _ -> acc >|= succ
            | Error _ -> acc)
@@ -96,7 +93,7 @@ let rec try_to_contact
     of connections is between `min_threshold` and `max_threshold`. *)
 let rec maintain st =
   let Pool pool = st.pool in
-  let n_connected = P2p_connection_pool.active_connections pool in
+  let n_connected = P2p_pool.active_connections pool in
   if n_connected < st.bounds.min_threshold then
     too_few_connections st n_connected
   else if st.bounds.max_threshold < n_connected then
@@ -121,10 +118,10 @@ and too_few_connections st n_connected =
     (* not enough contacts, ask the pals of our pals,
        discover the local network and then wait *)
     Option.iter ~f:P2p_discovery.restart st.disco ;
-    P2p_connection_pool.broadcast_bootstrap_msg pool ;
+    P2p_pool.broadcast_bootstrap_msg pool ;
     Lwt_utils.protect ~canceler:st.canceler begin fun () ->
       Lwt.pick [
-        P2p_connection_pool.Pool_event.wait_new_peer pool ;
+        P2p_pool.Pool_event.wait_new_peer pool ;
         Lwt_unix.sleep 5.0 (* TODO exponential back-off ??
                                    or wait for the existence of a
                                    non grey-listed peer ?? *)
@@ -138,11 +135,11 @@ and too_many_connections st n_connected =
   (* too many connections, start the russian roulette *)
   let to_kill = n_connected - st.bounds.max_target in
   lwt_debug "Too many connections, will kill %d" to_kill >>= fun () ->
-  snd @@ P2p_connection_pool.Connection.fold pool
+  snd @@ P2p_pool.Connection.fold pool
     ~init:(to_kill, Lwt.return_unit)
     ~f:(fun _ conn (i, t) ->
         if i = 0 then (0, t)
-        else (i - 1, t >>= fun () -> P2p_connection_pool.disconnect conn))
+        else (i - 1, t >>= fun () -> P2p_pool.disconnect conn))
   >>= fun () ->
   maintain st
 
@@ -153,17 +150,17 @@ let rec worker_loop st =
       Lwt.pick [
         Lwt_unix.sleep 120. ; (* every two minutes *)
         Lwt_condition.wait st.please_maintain ; (* when asked *)
-        P2p_connection_pool.Pool_event.wait_too_few_connections pool ; (* limits *)
+        P2p_pool.Pool_event.wait_too_few_connections pool ; (* limits *)
-        P2p_connection_pool.Pool_event.wait_too_many_connections pool
+        P2p_pool.Pool_event.wait_too_many_connections pool
       ] >>= fun () ->
       return ()
     end >>=? fun () ->
-    let n_connected = P2p_connection_pool.active_connections pool in
+    let n_connected = P2p_pool.active_connections pool in
     if n_connected < st.bounds.min_threshold
     || st.bounds.max_threshold < n_connected then
       maintain st
     else begin
-      P2p_connection_pool.send_swap_request pool ;
+      P2p_pool.send_swap_request pool ;
       return ()
     end
   end >>= function

src/lib_p2p/p2p_maintenance.mli

@@ -36,7 +36,7 @@ type 'meta t
 val run:
   connection_timeout:float ->
   bounds ->
-  ('msg, 'meta) P2p_connection_pool.t ->
+  ('msg, 'meta) P2p_pool.t ->
   P2p_discovery.t option ->
   'meta t
 

src/lib_p2p/p2p_pool.ml

@@ -15,9 +15,6 @@
 
 (* TODO allow to track "requested peer_ids" when we reconnect to a point. *)
 
-open P2p_types
-open P2p_connection_pool_types
-
 include Logging.Make (struct let name = "p2p.connection-pool" end)
 
 type 'msg encoding = Encoding : {
@@ -32,9 +29,9 @@ module Message = struct
 
   type 'msg t =
     | Bootstrap
-    | Advertise of Point.t list
+    | Advertise of P2p_point.Id.t list
-    | Swap_request of Point.t * Peer_id.t
+    | Swap_request of P2p_point.Id.t * P2p_peer.Id.t
-    | Swap_ack of Point.t * Peer_id.t
+    | Swap_ack of P2p_point.Id.t * P2p_peer.Id.t
     | Message of 'msg
     | Disconnect
 
@@ -48,15 +45,15 @@ module Message = struct
          case (Tag 0x02) null
            (function Bootstrap -> Some () | _ -> None)
            (fun () -> Bootstrap);
-         case (Tag 0x03) (Variable.list Point.encoding)
+         case (Tag 0x03) (Variable.list P2p_point.Id.encoding)
            (function Advertise points -> Some points | _ -> None)
            (fun points -> Advertise points);
-         case (Tag 0x04) (tup2 Point.encoding Peer_id.encoding)
+         case (Tag 0x04) (tup2 P2p_point.Id.encoding P2p_peer.Id.encoding)
            (function
              | Swap_request (point, peer_id) -> Some (point, peer_id)
              | _ -> None)
            (fun (point, peer_id) -> Swap_request (point, peer_id)) ;
-         case (Tag 0x05) (tup2 Point.encoding Peer_id.encoding)
+         case (Tag 0x05) (tup2 P2p_point.Id.encoding P2p_peer.Id.encoding)
            (function
              | Swap_ack (point, peer_id) -> Some (point, peer_id)
              | _ -> None)
@@ -74,16 +71,16 @@ end
 module Answerer = struct
 
   type 'msg callback = {
-    bootstrap: unit -> Point.t list Lwt.t ;
+    bootstrap: unit -> P2p_point.Id.t list Lwt.t ;
-    advertise: Point.t list -> unit Lwt.t ;
+    advertise: P2p_point.Id.t list -> unit Lwt.t ;
     message: int -> 'msg -> unit Lwt.t ;
-    swap_request: Point.t -> Peer_id.t -> unit Lwt.t ;
+    swap_request: P2p_point.Id.t -> P2p_peer.Id.t -> unit Lwt.t ;
-    swap_ack: Point.t -> Peer_id.t -> unit Lwt.t ;
+    swap_ack: P2p_point.Id.t -> P2p_peer.Id.t -> unit Lwt.t ;
   }
 
   type 'msg t = {
     canceler: Lwt_canceler.t ;
-    conn: 'msg Message.t P2p_connection.t ;
+    conn: 'msg Message.t P2p_socket.t ;
     callback: 'msg callback ;
     mutable worker: unit Lwt.t ;
   }
@@ -91,14 +88,14 @@ module Answerer = struct
   let rec worker_loop st =
     Lwt_unix.yield () >>= fun () ->
     Lwt_utils.protect ~canceler:st.canceler begin fun () ->
-      P2p_connection.read st.conn
+      P2p_socket.read st.conn
     end >>= function
     | Ok (_, Bootstrap) -> begin
         st.callback.bootstrap () >>= function
         | [] ->
             worker_loop st
         | points ->
-            match P2p_connection.write_now st.conn (Advertise points) with
+            match P2p_socket.write_now st.conn (Advertise points) with
             | Ok _sent ->
                 (* if not sent then ?? TODO count dropped message ?? *)
                 worker_loop st
@@ -121,7 +118,7 @@ module Answerer = struct
     | Ok (_, Disconnect) | Error [P2p_io_scheduler.Connection_closed] ->
         Lwt_canceler.cancel st.canceler >>= fun () ->
         Lwt.return_unit
-    | Error [P2p_connection.Decoding_error] ->
+    | Error [P2p_socket.Decoding_error] ->
         (* TODO: Penalize peer... *)
         Lwt_canceler.cancel st.canceler >>= fun () ->
         Lwt.return_unit
@@ -150,18 +147,16 @@ module Answerer = struct
 
 end
 
-module Log_event = Connection_pool_log_event
-
 type config = {
 
-  identity : Identity.t ;
+  identity : P2p_identity.t ;
   proof_of_work_target : Crypto_box.target ;
 
-  trusted_points : Point.t list ;
+  trusted_points : P2p_point.Id.t list ;
   peers_file : string ;
   closed_network : bool ;
 
-  listening_port : port option ;
+  listening_port : P2p_addr.port option ;
   min_connections : int ;
   max_connections : int ;
   max_incoming_connections : int ;
@@ -189,27 +184,27 @@ type 'meta meta_config = {
 
 type 'msg message_config = {
   encoding : 'msg encoding list ;
-  versions : P2p_types.Version.t list;
+  versions : P2p_version.t list;
 }
 
 type ('msg, 'meta) t = {
   config : config ;
   meta_config : 'meta meta_config ;
   message_config : 'msg message_config ;
-  my_id_points : unit Point.Table.t ;
+  my_id_points : unit P2p_point.Table.t ;
   known_peer_ids :
-    (('msg, 'meta) connection, 'meta) Peer_info.t Peer_id.Table.t ;
+    (('msg, 'meta) connection, 'meta) P2p_peer.Pool_info.t P2p_peer.Table.t ;
   connected_peer_ids :
-    (('msg, 'meta) connection, 'meta) Peer_info.t Peer_id.Table.t ;
+    (('msg, 'meta) connection, 'meta) P2p_peer.Pool_info.t P2p_peer.Table.t ;
-  known_points : ('msg, 'meta) connection Point_info.t Point.Table.t ;
+  known_points : ('msg, 'meta) connection P2p_point.Pool_info.t P2p_point.Table.t ;
-  connected_points : ('msg, 'meta) connection Point_info.t Point.Table.t ;
+  connected_points : ('msg, 'meta) connection P2p_point.Pool_info.t P2p_point.Table.t ;
-  incoming : Lwt_canceler.t Point.Table.t ;
+  incoming : Lwt_canceler.t P2p_point.Table.t ;
   io_sched : P2p_io_scheduler.t ;
   encoding : 'msg Message.t Data_encoding.t ;
   events : events ;
-  watcher : Log_event.t Lwt_watcher.input ;
+  watcher : P2p_connection.Pool_event.t Lwt_watcher.input ;
   mutable new_connection_hook :
-    (Peer_id.t -> ('msg, 'meta) connection -> unit) list ;
+    (P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) list ;
   mutable latest_accepted_swap : Time.t ;
   mutable latest_succesfull_swap : Time.t  ;
 }
@@ -224,11 +219,11 @@ and events = {
 and ('msg, 'meta) connection = {
   canceler : Lwt_canceler.t ;
   messages : (int * 'msg) Lwt_pipe.t ;
-  conn : 'msg Message.t P2p_connection.t ;
+  conn : 'msg Message.t P2p_socket.t ;
-  peer_info : (('msg, 'meta) connection, 'meta) Peer_info.t ;
+  peer_info : (('msg, 'meta) connection, 'meta) P2p_peer.Pool_info.t ;
-  point_info : ('msg, 'meta) connection Point_info.t option ;
+  point_info : ('msg, 'meta) connection P2p_point.Pool_info.t option ;
   answerer : 'msg Answerer.t Lazy.t ;
-  mutable last_sent_swap_request : (Time.t * Peer_id.t) option ;
+  mutable last_sent_swap_request : (Time.t * P2p_peer.Id.t) option ;
   mutable wait_close : bool ;
 }
 
@@ -248,8 +243,8 @@ end
 let watch { watcher } = Lwt_watcher.create_stream watcher
 let log { watcher } event = Lwt_watcher.notify watcher event
 
-module GcPointSet = List.Bounded(struct
+module Gc_point_set = List.Bounded(struct
-    type t = Time.t * Point.t
+    type t = Time.t * P2p_point.Id.t
     let compare (x, _) (y, _) = - (Time.compare x y)
   end)
 
@@ -258,37 +253,37 @@ let gc_points ({ config = { max_known_points } ; known_points } as pool) =
   | None -> ()
   | Some (_, target) ->
       let now = Time.now () in (* TODO: maybe time of discovery? *)
-      let table = GcPointSet.create target in
+      let table = Gc_point_set.create target in
-      Point.Table.iter (fun p point_info ->
+      P2p_point.Table.iter (fun p point_info ->
-          if Point_info.State.is_disconnected point_info then
+          if P2p_point.Pool_state.is_disconnected point_info then
             let time =
-              match Point_info.last_miss point_info with
+              match P2p_point.Pool_info.last_miss point_info with
               | None -> now
               | Some t -> t in
-            GcPointSet.insert (time, p) table
+            Gc_point_set.insert (time, p) table
         ) known_points ;
-      let to_remove = GcPointSet.get table in
+      let to_remove = Gc_point_set.get table in
       ListLabels.iter to_remove ~f:begin fun (_, p) ->
-        Point.Table.remove known_points p
+        P2p_point.Table.remove known_points p
       end ;
       log pool Gc_points
 
 let register_point pool ?trusted _source_peer_id (addr, port as point) =
-  match Point.Table.find pool.known_points point with
+  match P2p_point.Table.find pool.known_points point with
   | exception Not_found ->
-      let point_info = Point_info.create ?trusted addr port in
+      let point_info = P2p_point.Pool_info.create ?trusted addr port in
       Option.iter pool.config.max_known_points ~f:begin fun (max, _) ->
-        if Point.Table.length pool.known_points >= max then gc_points pool
+        if P2p_point.Table.length pool.known_points >= max then gc_points pool
       end ;
-      Point.Table.add pool.known_points point point_info ;
+      P2p_point.Table.add pool.known_points point point_info ;
       log pool (New_point point) ;
       point_info
   | point_info -> point_info
 
 let may_register_my_id_point pool = function
-  | [P2p_connection.Myself (addr, Some port)] ->
+  | [P2p_socket.Myself (addr, Some port)] ->
-      Point.Table.add pool.my_id_points (addr, port) () ;
+      P2p_point.Table.add pool.my_id_points (addr, port) () ;
-      Point.Table.remove pool.known_points (addr, port)
+      P2p_point.Table.remove pool.known_points (addr, port)
   | _ -> ()
 
 
@@ -299,8 +294,8 @@ let may_register_my_id_point pool = function
    case of a flood attack, the newly added infos will probably belong
    to peer_ids with the same (low) score and removing the most recent ones
    ensure that older (and probably legit) peer_id infos are kept. *)
-module GcPeer_idSet = List.Bounded(struct
+module Gc_peer_set = List.Bounded(struct
-    type t = float * Time.t * Peer_id.t
+    type t = float * Time.t * P2p_peer.Id.t
     let compare (s, t, _) (s', t', _) =
       let score_cmp = Pervasives.compare s s' in
       if score_cmp = 0 then Time.compare t t' else - score_cmp
@@ -312,27 +307,27 @@ let gc_peer_ids ({ meta_config = { score } ;
   match max_known_peer_ids with
   | None -> ()
   | Some (_, target) ->
-      let table = GcPeer_idSet.create target in
+      let table = Gc_peer_set.create target in
-      Peer_id.Table.iter (fun peer_id peer_info ->
+      P2p_peer.Table.iter (fun peer_id peer_info ->
-          let created = Peer_info.created peer_info in
+          let created = P2p_peer.Pool_info.created peer_info in
-          let score = score @@ Peer_info.metadata peer_info in
+          let score = score @@ P2p_peer.Pool_info.metadata peer_info in
-          GcPeer_idSet.insert (score, created, peer_id) table
+          Gc_peer_set.insert (score, created, peer_id) table
         ) known_peer_ids ;
-      let to_remove = GcPeer_idSet.get table in
+      let to_remove = Gc_peer_set.get table in
       ListLabels.iter to_remove ~f:begin fun (_, _, peer_id) ->
-        Peer_id.Table.remove known_peer_ids peer_id
+        P2p_peer.Table.remove known_peer_ids peer_id
       end ;
       log pool Gc_peer_ids
 
 let register_peer pool peer_id =
-  match Peer_id.Table.find pool.known_peer_ids peer_id with
+  match P2p_peer.Table.find pool.known_peer_ids peer_id with
   | exception Not_found ->
       Lwt_condition.broadcast pool.events.new_peer () ;
-      let peer = Peer_info.create peer_id ~metadata:pool.meta_config.initial in
+      let peer = P2p_peer.Pool_info.create peer_id ~metadata:pool.meta_config.initial in
       Option.iter pool.config.max_known_peer_ids ~f:begin fun (max, _) ->
-        if Peer_id.Table.length pool.known_peer_ids >= max then gc_peer_ids pool
+        if P2p_peer.Table.length pool.known_peer_ids >= max then gc_peer_ids pool
       end ;
-      Peer_id.Table.add pool.known_peer_ids peer_id peer ;
+      P2p_peer.Table.add pool.known_peer_ids peer_id peer ;
       log pool (New_peer peer_id) ;
       peer
   | peer -> peer
@@ -344,7 +339,7 @@ let read { messages ; conn } =
   Lwt.catch
     (fun () -> Lwt_pipe.pop messages >>= fun (s, msg) ->
       lwt_debug "%d bytes message popped from queue %a\027[0m"
-        s Connection_info.pp (P2p_connection.info conn) >>= fun () ->
+        s P2p_connection.Info.pp (P2p_socket.info conn) >>= fun () ->
       return msg)
     (fun _ (* Closed *) -> fail P2p_io_scheduler.Connection_closed)
 
@@ -354,111 +349,111 @@ let is_readable { messages } =
     (fun _ (* Closed *) -> fail P2p_io_scheduler.Connection_closed)
 
 let write { conn } msg =
-  P2p_connection.write conn (Message msg)
+  P2p_socket.write conn (Message msg)
 
 let write_sync { conn } msg =
-  P2p_connection.write_sync conn (Message msg)
+  P2p_socket.write_sync conn (Message msg)
 
 let raw_write_sync { conn } buf =
-  P2p_connection.raw_write_sync conn buf
+  P2p_socket.raw_write_sync conn buf
 
 let write_now { conn } msg =
-  P2p_connection.write_now conn (Message msg)
+  P2p_socket.write_now conn (Message msg)
 
 let write_all pool msg =
-  Peer_id.Table.iter
+  P2p_peer.Table.iter
     (fun _peer_id peer_info ->
-       match Peer_info.State.get peer_info with
+       match P2p_peer.Pool_state.get peer_info with
        | Running { data = conn } ->
            ignore (write_now conn msg : bool tzresult )
        | _ -> ())
     pool.connected_peer_ids
 
 let broadcast_bootstrap_msg pool =
-  Peer_id.Table.iter
+  P2p_peer.Table.iter
     (fun _peer_id peer_info ->
-       match Peer_info.State.get peer_info with
+       match P2p_peer.Pool_state.get peer_info with
        | Running { data = { conn } } ->
-           ignore (P2p_connection.write_now conn Bootstrap : bool tzresult )
+           ignore (P2p_socket.write_now conn Bootstrap : bool tzresult )
        | _ -> ())
     pool.connected_peer_ids
 
 
 (***************************************************************************)
 
-module Peer_ids = struct
+module Peers = struct
 
-  type ('msg, 'meta) info = (('msg, 'meta) connection, 'meta) Peer_info.t
+  type ('msg, 'meta) info = (('msg, 'meta) connection, 'meta) P2p_peer.Pool_info.t
 
   let info { known_peer_ids } point =
-    try Some (Peer_id.Table.find known_peer_ids point)
+    try Some (P2p_peer.Table.find known_peer_ids point)
     with Not_found -> None
 
   let get_metadata pool peer_id =
-    try Peer_info.metadata (Peer_id.Table.find pool.known_peer_ids peer_id)
+    try P2p_peer.Pool_info.metadata (P2p_peer.Table.find pool.known_peer_ids peer_id)
     with Not_found -> pool.meta_config.initial
 
   let get_score pool peer_id =
     pool.meta_config.score (get_metadata pool peer_id)
 
   let set_metadata pool peer_id data =
-    Peer_info.set_metadata (register_peer pool peer_id) data
+    P2p_peer.Pool_info.set_metadata (register_peer pool peer_id) data
 
   let get_trusted pool peer_id =
-    try Peer_info.trusted (Peer_id.Table.find pool.known_peer_ids peer_id)
+    try P2p_peer.Pool_info.trusted (P2p_peer.Table.find pool.known_peer_ids peer_id)
     with Not_found -> false
 
   let set_trusted pool peer_id =
-    try Peer_info.set_trusted (register_peer pool peer_id)
+    try P2p_peer.Pool_info.set_trusted (register_peer pool peer_id)
     with Not_found -> ()
 
   let unset_trusted pool peer_id =
-    try Peer_info.unset_trusted (Peer_id.Table.find pool.known_peer_ids peer_id)
+    try P2p_peer.Pool_info.unset_trusted (P2p_peer.Table.find pool.known_peer_ids peer_id)
     with Not_found -> ()
 
   let fold_known pool ~init ~f =
-    Peer_id.Table.fold f pool.known_peer_ids init
+    P2p_peer.Table.fold f pool.known_peer_ids init
 
   let fold_connected pool ~init ~f =
-    Peer_id.Table.fold f pool.connected_peer_ids init
+    P2p_peer.Table.fold f pool.connected_peer_ids init
 
 end
 
 module Points = struct
 
-  type ('msg, 'meta) info = ('msg, 'meta) connection Point_info.t
+  type ('msg, 'meta) info = ('msg, 'meta) connection P2p_point.Pool_info.t
 
   let info { known_points } point =
-    try Some (Point.Table.find known_points point)
+    try Some (P2p_point.Table.find known_points point)
     with Not_found -> None
 
   let get_trusted pool point =
-    try Point_info.trusted (Point.Table.find pool.known_points point)
+    try P2p_point.Pool_info.trusted (P2p_point.Table.find pool.known_points point)
     with Not_found -> false
 
   let set_trusted pool point =
     try
-      Point_info.set_trusted
+      P2p_point.Pool_info.set_trusted
         (register_point pool pool.config.identity.peer_id point)
     with Not_found -> ()
 
   let unset_trusted pool peer_id =
-    try Point_info.unset_trusted (Point.Table.find pool.known_points peer_id)
+    try P2p_point.Pool_info.unset_trusted (P2p_point.Table.find pool.known_points peer_id)
     with Not_found -> ()
 
   let fold_known pool ~init ~f =
-    Point.Table.fold f pool.known_points init
+    P2p_point.Table.fold f pool.known_points init
 
   let fold_connected  pool ~init ~f =
-    Point.Table.fold f pool.connected_points init
+    P2p_point.Table.fold f pool.connected_points init
 
 end
 
 module Connection = struct
 
   let fold pool ~init ~f =
-    Peer_ids.fold_connected pool ~init ~f:begin fun peer_id peer_info acc ->
+    Peers.fold_connected pool ~init ~f:begin fun peer_id peer_info acc ->
-      match Peer_info.State.get peer_info with
+      match P2p_peer.Pool_state.get peer_info with
       | Running { data } -> f peer_id data acc
       | _ -> acc
     end
@@ -471,7 +466,7 @@ module Connection = struct
       fold pool ~init:[] ~f:begin fun _peer conn acc ->
         match different_than with
         | Some excluded_conn
-          when P2p_connection.equal conn.conn excluded_conn.conn -> acc
+          when P2p_socket.equal conn.conn excluded_conn.conn -> acc
         | Some _ | None -> conn :: acc
       end in
     match candidates with
@@ -484,9 +479,9 @@ module Connection = struct
       fold pool ~init:[] ~f:begin fun _peer conn acc ->
         match different_than with
         | Some excluded_conn
-          when P2p_connection.equal conn.conn excluded_conn.conn -> acc
+          when P2p_socket.equal conn.conn excluded_conn.conn -> acc
         | Some _ | None ->
-            let ci = P2p_connection.info conn.conn in
+            let ci = P2p_socket.info conn.conn in
             match ci.id_point with
             | _, None -> acc
             | addr, Some port -> ((addr, port), ci.peer_id, conn) :: acc
@@ -497,18 +492,18 @@ module Connection = struct
         Some (List.nth candidates (Random.int @@ List.length candidates))
 
   let stat { conn } =
-    P2p_connection.stat conn
+    P2p_socket.stat conn
 
   let score { meta_config = { score }} meta = score meta
 
   let info { conn } =
-    P2p_connection.info conn
+    P2p_socket.info conn
 
   let find_by_peer_id pool peer_id =
     Option.apply
-      (Peer_ids.info pool peer_id)
+      (Peers.info pool peer_id)
       ~f:(fun p ->
-          match Peer_info.State.get p with
+          match P2p_peer.Pool_state.get p with
           | Running { data } -> Some data
           | _ -> None)
 
@@ -516,7 +511,7 @@ module Connection = struct
     Option.apply
       (Points.info pool point)
       ~f:(fun p ->
-          match Point_info.State.get p with
+          match P2p_point.Pool_state.get p with
           | Running { data } -> Some data
           | _ -> None)
 
@@ -528,7 +523,7 @@ let pool_stat { io_sched } =
 
 (***************************************************************************)
 
-type error += Rejected of Peer_id.t
+type error += Rejected of P2p_peer.Id.t
 type error += Pending_connection
 type error += Connected
 type error += Connection_closed = P2p_io_scheduler.Connection_closed
@@ -537,13 +532,13 @@ type error += Closed_network
 type error += Too_many_connections
 
 let fail_unless_disconnected_point point_info =
-  match Point_info.State.get point_info with
+  match P2p_point.Pool_state.get point_info with
   | Disconnected -> return ()
   | Requested _ | Accepted _ -> fail Pending_connection
   | Running _ -> fail Connected
 
 let fail_unless_disconnected_peer_id peer_info =
-  match Peer_info.State.get peer_info with
+  match P2p_peer.Pool_state.get peer_info with
   | Disconnected -> return ()
   | Accepted _ -> fail Pending_connection
   | Running _ -> fail Connected
@@ -551,10 +546,10 @@ let fail_unless_disconnected_peer_id peer_info =
 let compare_known_point_info p1 p2 =
   (* The most-recently disconnected peers are greater. *)
   (* Then come long-standing connected peers. *)
-  let disconnected1 = Point_info.State.is_disconnected p1
+  let disconnected1 = P2p_point.Pool_state.is_disconnected p1
-  and disconnected2 = Point_info.State.is_disconnected p2 in
+  and disconnected2 = P2p_point.Pool_state.is_disconnected p2 in
   let compare_last_seen p1 p2 =
-    match Point_info.last_seen p1, Point_info.last_seen p2 with
+    match P2p_point.Pool_info.last_seen p1, P2p_point.Pool_info.last_seen p2 with
     | None, None -> Random.int 2 * 2 - 1 (* HACK... *)
     | Some _, None -> 1
     | None, Some _ -> -1
@@ -576,40 +571,40 @@ let rec connect ~timeout pool point =
   Lwt_utils.with_timeout ~canceler timeout begin fun canceler ->
     let point_info =
       register_point pool pool.config.identity.peer_id point in
-    let addr, port as point = Point_info.point point_info in
+    let addr, port as point = P2p_point.Pool_info.point point_info in
     fail_unless
-      (not pool.config.closed_network || Point_info.trusted point_info)
+      (not pool.config.closed_network || P2p_point.Pool_info.trusted point_info)
       Closed_network >>=? fun () ->
     fail_unless_disconnected_point point_info >>=? fun () ->
-    Point_info.State.set_requested point_info canceler ;
+    P2p_point.Pool_state.set_requested point_info canceler ;
     let fd = Lwt_unix.socket PF_INET6 SOCK_STREAM 0 in
     let uaddr =
       Lwt_unix.ADDR_INET (Ipaddr_unix.V6.to_inet_addr addr, port) in
-    lwt_debug "connect: %a" Point.pp point >>= fun () ->
+    lwt_debug "connect: %a" P2p_point.Id.pp point >>= fun () ->
     Lwt_utils.protect ~canceler begin fun () ->
       log pool (Outgoing_connection point) ;
       Lwt_unix.connect fd uaddr >>= fun () ->
       return ()
     end ~on_error: begin fun err ->
-      lwt_debug "connect: %a -> disconnect" Point.pp point >>= fun () ->
+      lwt_debug "connect: %a -> disconnect" P2p_point.Id.pp point >>= fun () ->
-      Point_info.State.set_disconnected point_info ;
+      P2p_point.Pool_state.set_disconnected point_info ;
       Lwt_utils.safe_close fd >>= fun () ->
       match err with
       | [Exn (Unix.Unix_error (Unix.ECONNREFUSED, _, _))] ->
           fail Connection_refused
       | err -> Lwt.return (Error err)
     end >>=? fun () ->
-    lwt_debug "connect: %a -> authenticate" Point.pp point >>= fun () ->
+    lwt_debug "connect: %a -> authenticate" P2p_point.Id.pp point >>= fun () ->
     authenticate pool ~point_info canceler fd point
   end
 
 and authenticate pool ?point_info canceler fd point =
   let incoming = point_info = None in
   lwt_debug "authenticate: %a%s"
-    Point.pp point
+    P2p_point.Id.pp point
     (if incoming then " incoming" else "") >>= fun () ->
   Lwt_utils.protect ~canceler begin fun () ->
-    P2p_connection.authenticate
+    P2p_socket.authenticate
       ~proof_of_work_target:pool.config.proof_of_work_target
       ~incoming (P2p_io_scheduler.register pool.io_sched fd) point
       ?listening_port:pool.config.listening_port
@@ -620,31 +615,31 @@ and authenticate pool ?point_info canceler fd point =
       | [ Lwt_utils.Canceled ] ->
           (* Currently only on time out *)
           lwt_debug "authenticate: %a%s -> canceled"
-            Point.pp point
+            P2p_point.Id.pp point
             (if incoming then " incoming" else "")
       | err ->
           (* Authentication incorrect! *)
           lwt_debug "@[authenticate: %a%s -> failed@ %a@]"
-            Point.pp point
+            P2p_point.Id.pp point
             (if incoming then " incoming" else "")
             pp_print_error err
     end >>= fun () ->
     may_register_my_id_point pool err ;
     log pool (Authentication_failed point) ;
     if incoming then
-      Point.Table.remove pool.incoming point
+      P2p_point.Table.remove pool.incoming point
     else
-      Option.iter ~f:Point_info.State.set_disconnected point_info ;
+      Option.iter ~f:P2p_point.Pool_state.set_disconnected point_info ;
     Lwt.return (Error err)
   end >>=? fun (info, auth_fd) ->
   (* Authentication correct! *)
   lwt_debug "authenticate: %a -> auth %a"
-    Point.pp point
+    P2p_point.Id.pp point
-    Connection_info.pp info >>= fun () ->
+    P2p_connection.Info.pp info >>= fun () ->
   let remote_point_info =
     match info.id_point with
     | addr, Some port
-      when not (Point.Table.mem pool.my_id_points (addr, port)) ->
+      when not (P2p_point.Table.mem pool.my_id_points (addr, port)) ->
         Some (register_point pool info.peer_id (addr, port))
     | _ -> None in
   let connection_point_info =
@@ -653,22 +648,22 @@ and authenticate pool ?point_info canceler fd point =
     | Some _ as point_info, _ | _, (Some _ as point_info) -> point_info in
   let peer_info = register_peer pool info.peer_id in
   let acceptable_versions =
-    Version.common info.versions pool.message_config.versions
+    P2p_version.common info.versions pool.message_config.versions
   in
   let acceptable_point =
     Option.unopt_map connection_point_info
       ~default:(not pool.config.closed_network)
       ~f:begin fun connection_point_info ->
-        match Point_info.State.get connection_point_info with
+        match P2p_point.Pool_state.get connection_point_info with
         | Requested _ -> not incoming
         | Disconnected ->
             not pool.config.closed_network
-            || Point_info.trusted connection_point_info
+            || P2p_point.Pool_info.trusted connection_point_info
         | Accepted _ | Running _ -> false
       end
   in
   let acceptable_peer_id =
-    match Peer_info.State.get peer_info with
+    match P2p_peer.Pool_state.get peer_info with
     | Accepted _ ->
         (* TODO: in some circumstances cancel and accept... *)
         false
@@ -676,41 +671,41 @@ and authenticate pool ?point_info canceler fd point =
     | Disconnected -> true
   in
   if incoming then
-    Point.Table.remove pool.incoming point ;
+    P2p_point.Table.remove pool.incoming point ;
   match acceptable_versions with
   | Some version when acceptable_peer_id && acceptable_point -> begin
       log pool (Accepting_request (point, info.id_point, info.peer_id)) ;
       Option.iter connection_point_info
         ~f:(fun point_info ->
-            Point_info.State.set_accepted point_info info.peer_id canceler) ;
+            P2p_point.Pool_state.set_accepted point_info info.peer_id canceler) ;
-      Peer_info.State.set_accepted peer_info info.id_point canceler ;
+      P2p_peer.Pool_state.set_accepted peer_info info.id_point canceler ;
       lwt_debug "authenticate: %a -> accept %a"
-        Point.pp point
+        P2p_point.Id.pp point
-        Connection_info.pp info >>= fun () ->
+        P2p_connection.Info.pp info >>= fun () ->
       Lwt_utils.protect ~canceler begin fun () ->
-        P2p_connection.accept
+        P2p_socket.accept
           ?incoming_message_queue_size:pool.config.incoming_message_queue_size
           ?outgoing_message_queue_size:pool.config.outgoing_message_queue_size
           ?binary_chunks_size:pool.config.binary_chunks_size
           auth_fd pool.encoding >>= fun conn ->
         lwt_debug "authenticate: %a -> Connected %a"
-          Point.pp point
+          P2p_point.Id.pp point
-          Connection_info.pp info >>= fun () ->
+          P2p_connection.Info.pp info >>= fun () ->
         Lwt.return conn
       end ~on_error: begin fun err ->
         if incoming then
           log pool
             (Request_rejected (point, Some (info.id_point, info.peer_id))) ;
         lwt_debug "authenticate: %a -> rejected %a"
-          Point.pp point
+          P2p_point.Id.pp point
-          Connection_info.pp info >>= fun () ->
+          P2p_connection.Info.pp info >>= fun () ->
         Option.iter connection_point_info
-          ~f:Point_info.State.set_disconnected ;
+          ~f:P2p_point.Pool_state.set_disconnected ;
-        Peer_info.State.set_disconnected peer_info ;
+        P2p_peer.Pool_state.set_disconnected peer_info ;
         Lwt.return (Error err)
       end >>=? fun conn ->
       let id_point =
-        match info.id_point, Option.map ~f:Point_info.point point_info with
+        match info.id_point, Option.map ~f:P2p_point.Pool_info.point point_info with
         | (addr, _), Some (_, port) -> addr, Some port
         | id_point, None ->  id_point in
       return
@@ -721,19 +716,19 @@ and authenticate pool ?point_info canceler fd point =
   | _ -> begin
       log pool (Rejecting_request (point, info.id_point, info.peer_id)) ;
       lwt_debug "authenticate: %a -> kick %a point: %B peer_id: %B"
-        Point.pp point
+        P2p_point.Id.pp point
-        Connection_info.pp info
+        P2p_connection.Info.pp info
         acceptable_point acceptable_peer_id >>= fun () ->
-      P2p_connection.kick auth_fd >>= fun () ->
+      P2p_socket.kick auth_fd >>= fun () ->
       if not incoming then begin
-        Option.iter ~f:Point_info.State.set_disconnected point_info ;
+        Option.iter ~f:P2p_point.Pool_state.set_disconnected point_info ;
-        (* FIXME Peer_info.State.set_disconnected ~requested:true peer_info ; *)
+        (* FIXME P2p_peer.Pool_state.set_disconnected ~requested:true peer_info ; *)
       end ;
       fail (Rejected info.peer_id)
     end
 
 and create_connection pool p2p_conn id_point point_info peer_info _version =
-  let peer_id = Peer_info.peer_id peer_info in
+  let peer_id = P2p_peer.Pool_info.peer_id peer_info in
   let canceler = Lwt_canceler.create () in
   let size =
     Option.map pool.config.incoming_app_message_queue_size
@@ -759,30 +754,30 @@ and create_connection pool p2p_conn id_point point_info peer_info _version =
       last_sent_swap_request = None } in
   ignore (Lazy.force answerer) ;
   Option.iter point_info ~f:begin fun point_info ->
-    let point = Point_info.point point_info in
+    let point = P2p_point.Pool_info.point point_info in
-    Point_info.State.set_running point_info peer_id conn ;
+    P2p_point.Pool_state.set_running point_info peer_id conn ;
-    Point.Table.add pool.connected_points point point_info ;
+    P2p_point.Table.add pool.connected_points point point_info ;
   end ;
   log pool (Connection_established (id_point, peer_id)) ;
-  Peer_info.State.set_running peer_info id_point conn ;
+  P2p_peer.Pool_state.set_running peer_info id_point conn ;
-  Peer_id.Table.add pool.connected_peer_ids peer_id peer_info ;
+  P2p_peer.Table.add pool.connected_peer_ids peer_id peer_info ;
   Lwt_condition.broadcast pool.events.new_connection () ;
   Lwt_canceler.on_cancel canceler begin fun () ->
     lwt_debug "Disconnect: %a (%a)"
-      Peer_id.pp peer_id Id_point.pp id_point >>= fun () ->
+      P2p_peer.Id.pp peer_id P2p_connection.Id.pp id_point >>= fun () ->
-    Option.iter ~f:Point_info.State.set_disconnected point_info ;
+    Option.iter ~f:P2p_point.Pool_state.set_disconnected point_info ;
     log pool (Disconnection peer_id) ;
-    Peer_info.State.set_disconnected peer_info ;
+    P2p_peer.Pool_state.set_disconnected peer_info ;
     Option.iter point_info ~f:begin fun point_info ->
-      Point.Table.remove pool.connected_points (Point_info.point point_info) ;
+      P2p_point.Table.remove pool.connected_points (P2p_point.Pool_info.point point_info) ;
     end ;
-    Peer_id.Table.remove pool.connected_peer_ids peer_id ;
+    P2p_peer.Table.remove pool.connected_peer_ids peer_id ;
     if pool.config.max_connections <= active_connections pool then begin
       Lwt_condition.broadcast pool.events.too_many_connections () ;
       log pool Too_many_connections ;
     end ;
     Lwt_pipe.close messages ;
-    P2p_connection.close ~wait:conn.wait_close conn.conn
+    P2p_socket.close ~wait:conn.wait_close conn.conn
   end ;
   List.iter (fun f -> f peer_id conn) pool.new_connection_hook ;
   if active_connections pool < pool.config.min_connections then begin
@@ -796,31 +791,31 @@ and disconnect ?(wait = false) conn =
   Answerer.shutdown (Lazy.force conn.answerer)
 
 and register_new_points pool conn =
-  let source_peer_id = Peer_info.peer_id conn.peer_info in
+  let source_peer_id = P2p_peer.Pool_info.peer_id conn.peer_info in
   fun points ->
     List.iter (register_new_point pool source_peer_id) points ;
     Lwt.return_unit
 
 and register_new_point pool _source_peer_id point =
-  if not (Point.Table.mem pool.my_id_points point) then
+  if not (P2p_point.Table.mem pool.my_id_points point) then
     ignore (register_point pool _source_peer_id point)
 
 and list_known_points pool _conn () =
   let knowns =
-    Point.Table.fold
+    P2p_point.Table.fold
       (fun _ point_info acc -> point_info :: acc)
       pool.known_points [] in
   let best_knowns =
     List.take_n ~compare:compare_known_point_info 50 knowns in
-  Lwt.return (List.map Point_info.point best_knowns)
+  Lwt.return (List.map P2p_point.Pool_info.point best_knowns)
 
-and active_connections pool = Peer_id.Table.length pool.connected_peer_ids
+and active_connections pool = P2p_peer.Table.length pool.connected_peer_ids
 
 and swap_request pool conn new_point _new_peer_id =
-  let source_peer_id = Peer_info.peer_id conn.peer_info in
+  let source_peer_id = P2p_peer.Pool_info.peer_id conn.peer_info in
   log pool (Swap_request_received { source = source_peer_id }) ;
   lwt_log_info
-    "Swap request received from %a" Peer_id.pp source_peer_id >>= fun () ->
+    "Swap request received from %a" P2p_peer.Id.pp source_peer_id >>= fun () ->
   (* Ignore if already connected to peer or already swapped less
      than <swap_linger> seconds ago. *)
   let now = Time.now () in
@@ -830,16 +825,16 @@ and swap_request pool conn new_point _new_peer_id =
       (Time.max pool.latest_succesfull_swap pool.latest_accepted_swap) in
   let new_point_info = register_point pool source_peer_id new_point in
   if span_since_last_swap < int_of_float pool.config.swap_linger
-  || not (Point_info.State.is_disconnected new_point_info) then begin
+  || not (P2p_point.Pool_state.is_disconnected new_point_info) then begin
     log pool (Swap_request_ignored { source = source_peer_id }) ;
-    lwt_log_info "Ignoring swap request from %a" Peer_id.pp source_peer_id
+    lwt_log_info "Ignoring swap request from %a" P2p_peer.Id.pp source_peer_id
   end else begin
     match Connection.random_lowid pool with
     | None ->
         lwt_log_info
-          "No swap candidate for %a" Peer_id.pp source_peer_id
+          "No swap candidate for %a" P2p_peer.Id.pp source_peer_id
     | Some (proposed_point, proposed_peer_id, _proposed_conn) ->
-        match P2p_connection.write_now
+        match P2p_socket.write_now
                 conn.conn (Swap_ack (proposed_point, proposed_peer_id)) with
         | Ok true ->
             log pool (Swap_ack_sent { source = source_peer_id }) ;
@@ -854,10 +849,10 @@ and swap_request pool conn new_point _new_peer_id =
   end
 
 and swap_ack pool conn new_point _new_peer_id =
-  let source_peer_id = Peer_info.peer_id conn.peer_info in
+  let source_peer_id = P2p_peer.Pool_info.peer_id conn.peer_info in
   log pool (Swap_ack_received { source = source_peer_id }) ;
   lwt_log_info
-    "Swap ack received from %a" Peer_id.pp source_peer_id >>= fun () ->
+    "Swap ack received from %a" P2p_peer.Id.pp source_peer_id >>= fun () ->
   match conn.last_sent_swap_request with
   | None -> Lwt.return_unit (* ignore *)
   | Some (_time, proposed_peer_id) ->
@@ -869,13 +864,13 @@ and swap_ack pool conn new_point _new_peer_id =
           Lwt.return_unit
 
 and swap pool conn current_peer_id new_point =
-  let source_peer_id = Peer_info.peer_id conn.peer_info in
+  let source_peer_id = P2p_peer.Pool_info.peer_id conn.peer_info in
   pool.latest_accepted_swap <- Time.now () ;
   connect ~timeout:10. pool new_point >>= function
   | Ok _new_conn -> begin
       pool.latest_succesfull_swap <- Time.now () ;
       log pool (Swap_success { source = source_peer_id }) ;
-      lwt_log_info "Swap to %a succeeded" Point.pp new_point >>= fun () ->
+      lwt_log_info "Swap to %a succeeded" P2p_point.Id.pp new_point >>= fun () ->
       match Connection.find_by_peer_id pool current_peer_id with
       | None -> Lwt.return_unit
       | Some conn ->
@@ -888,20 +883,20 @@ and swap pool conn current_peer_id new_point =
       match err with
       | [ Lwt_utils.Timeout ] ->
           lwt_debug "Swap to %a was interupted: %a"
-            Point.pp new_point pp_print_error err
+            P2p_point.Id.pp new_point pp_print_error err
       | _ ->
           lwt_log_error "Swap to %a failed: %a"
-            Point.pp new_point pp_print_error err
+            P2p_point.Id.pp new_point pp_print_error err
     end
 
 let accept pool fd point =
   log pool (Incoming_connection point) ;
-  if pool.config.max_incoming_connections <= Point.Table.length pool.incoming
+  if pool.config.max_incoming_connections <= P2p_point.Table.length pool.incoming
   || pool.config.max_connections <= active_connections pool then
     Lwt.async (fun () -> Lwt_utils.safe_close fd)
   else
     let canceler = Lwt_canceler.create () in
-    Point.Table.add pool.incoming point canceler ;
+    P2p_point.Table.add pool.incoming point canceler ;
     Lwt.async begin fun () ->
       Lwt_utils.with_timeout
         ~canceler pool.config.authentification_timeout
@@ -919,7 +914,7 @@ let send_swap_request pool =
           log pool (Swap_request_sent { source = recipient_peer_id }) ;
           recipient.last_sent_swap_request <-
             Some (Time.now (), proposed_peer_id) ;
-          ignore (P2p_connection.write_now recipient.conn
+          ignore (P2p_socket.write_now recipient.conn
                     (Swap_request (proposed_point, proposed_peer_id)))
 
 (***************************************************************************)
@@ -933,12 +928,12 @@ let create config meta_config message_config io_sched =
   } in
   let pool = {
     config ; meta_config ; message_config ;
-    my_id_points = Point.Table.create 7 ;
+    my_id_points = P2p_point.Table.create 7 ;
-    known_peer_ids = Peer_id.Table.create 53 ;
+    known_peer_ids = P2p_peer.Table.create 53 ;
-    connected_peer_ids = Peer_id.Table.create 53 ;
+    connected_peer_ids = P2p_peer.Table.create 53 ;
-    known_points = Point.Table.create 53 ;
+    known_points = P2p_point.Table.create 53 ;
-    connected_points = Point.Table.create 53 ;
+    connected_points = P2p_point.Table.create 53 ;
-    incoming = Point.Table.create 53 ;
+    incoming = P2p_point.Table.create 53 ;
     io_sched ;
     encoding = Message.encoding message_config.encoding ;
     events ;
@@ -948,12 +943,12 @@ let create config meta_config message_config io_sched =
     latest_succesfull_swap = Time.epoch ;
   } in
   List.iter (Points.set_trusted pool) config.trusted_points ;
-  Peer_info.File.load config.peers_file meta_config.encoding >>= function
+  P2p_peer.Pool_info.File.load config.peers_file meta_config.encoding >>= function
   | Ok peer_ids ->
       List.iter
         (fun peer_info ->
-           let peer_id = Peer_info.peer_id peer_info in
+           let peer_id = P2p_peer.Pool_info.peer_id peer_info in
-           Peer_id.Table.add pool.known_peer_ids peer_id peer_info)
+           P2p_peer.Table.add pool.known_peer_ids peer_id peer_info)
         peer_ids ;
       Lwt.return pool
   | Error err ->
@@ -962,23 +957,23 @@ let create config meta_config message_config io_sched =
       Lwt.return pool
 
 let destroy pool =
-  Point.Table.fold (fun _point point_info acc ->
+  P2p_point.Table.fold (fun _point point_info acc ->
-      match Point_info.State.get point_info with
+      match P2p_point.Pool_state.get point_info with
       | Requested { cancel } | Accepted { cancel } ->
           Lwt_canceler.cancel cancel >>= fun () -> acc
       | Running { data = conn } ->
           disconnect conn >>= fun () -> acc
       | Disconnected ->  acc)
     pool.known_points @@
-  Peer_id.Table.fold (fun _peer_id peer_info acc ->
+  P2p_peer.Table.fold (fun _peer_id peer_info acc ->
-      match Peer_info.State.get peer_info with
+      match P2p_peer.Pool_state.get peer_info with
       | Accepted { cancel } ->
           Lwt_canceler.cancel cancel >>= fun () -> acc
       | Running { data = conn } ->
           disconnect conn >>= fun () -> acc
       | Disconnected ->  acc)
     pool.known_peer_ids @@
-  Point.Table.fold (fun _point canceler acc ->
+  P2p_point.Table.fold (fun _point canceler acc ->
       Lwt_canceler.cancel canceler >>= fun () -> acc)
     pool.incoming Lwt.return_unit
 

src/lib_p2p/p2p_pool.mli

@@ -22,9 +22,6 @@
     worker and thus never propagated above.
 *)
 
-open P2p_types
-open P2p_connection_pool_types
-
 type 'msg encoding = Encoding : {
     tag: int ;
     encoding: 'a Data_encoding.t ;
@@ -43,13 +40,13 @@ type ('msg, 'meta) pool = ('msg, 'meta) t
 
 type config = {
 
-  identity : Identity.t ;
+  identity : P2p_identity.t ;
   (** Our identity. *)
 
   proof_of_work_target : Crypto_box.target ;
   (** The proof of work target we require from peers. *)
 
-  trusted_points : Point.t list ;
+  trusted_points : P2p_point.Id.t list ;
   (** List of hard-coded known peers to bootstrap the network from. *)
 
   peers_file : string ;
@@ -60,7 +57,7 @@ type config = {
   (** If [true], the only accepted connections are from peers whose
       addresses are in [trusted_peers]. *)
 
-  listening_port : port option ;
+  listening_port : P2p_addr.port option ;
   (** If provided, it will be passed to [P2p_connection.authenticate]
       when we authenticate against a new peer. *)
 
@@ -126,7 +123,7 @@ type 'meta meta_config = {
 
 type 'msg message_config = {
   encoding : 'msg encoding list ;
-  versions : P2p_types.Version.t list;
+  versions : P2p_version.t list;
 }
 
 val create:
@@ -146,7 +143,7 @@ val active_connections: ('msg, 'meta) pool -> int
 (** [active_connections pool] is the number of connections inside
     [pool]. *)
 
-val pool_stat: ('msg, 'meta) pool -> Stat.t
+val pool_stat: ('msg, 'meta) pool -> P2p_stat.t
 (** [pool_stat pool] is a snapshot of current bandwidth usage for the
     entire [pool]. *)
 
@@ -186,19 +183,19 @@ type ('msg, 'meta) connection
 type error += Pending_connection
 type error += Connected
 type error += Connection_refused
-type error += Rejected of Peer_id.t
+type error += Rejected of P2p_peer.Id.t
 type error += Too_many_connections
 type error += Closed_network
 
 val connect:
   timeout:float ->
-  ('msg, 'meta) pool -> Point.t ->
+  ('msg, 'meta) pool -> P2p_point.Id.t ->
   ('msg, 'meta) connection tzresult Lwt.t
 (** [connect ~timeout pool point] tries to add a
     connection to [point] in [pool] in less than [timeout] seconds. *)
 
 val accept:
-  ('msg, 'meta) pool -> Lwt_unix.file_descr -> Point.t -> unit
+  ('msg, 'meta) pool -> Lwt_unix.file_descr -> P2p_point.Id.t -> unit
 (** [accept pool fd point] instructs [pool] to start the process of
     accepting a connection from [fd]. Used by [P2p]. *)
 
@@ -209,32 +206,32 @@ val disconnect:
 
 module Connection : sig
 
-  val info: ('msg, 'meta) connection -> Connection_info.t
+  val info: ('msg, 'meta) connection -> P2p_connection.Info.t
 
-  val stat:  ('msg, 'meta) connection -> Stat.t
+  val stat:  ('msg, 'meta) connection -> P2p_stat.t
   (** [stat conn] is a snapshot of current bandwidth usage for
       [conn]. *)
 
   val fold:
     ('msg, 'meta) pool ->
     init:'a ->
-    f:(Peer_id.t ->  ('msg, 'meta) connection -> 'a -> 'a) ->
+    f:(P2p_peer.Id.t ->  ('msg, 'meta) connection -> 'a -> 'a) ->
     'a
 
   val list:
-    ('msg, 'meta) pool -> (Peer_id.t * ('msg, 'meta) connection) list
+    ('msg, 'meta) pool -> (P2p_peer.Id.t * ('msg, 'meta) connection) list
 
   val find_by_point:
-    ('msg, 'meta) pool -> Point.t ->  ('msg, 'meta) connection option
+    ('msg, 'meta) pool -> P2p_point.Id.t ->  ('msg, 'meta) connection option
 
   val find_by_peer_id:
-    ('msg, 'meta) pool -> Peer_id.t ->  ('msg, 'meta) connection option
+    ('msg, 'meta) pool -> P2p_peer.Id.t ->  ('msg, 'meta) connection option
 
 end
 
 val on_new_connection:
   ('msg, 'meta) pool ->
-  (Peer_id.t -> ('msg, 'meta) connection -> unit) -> unit
+  (P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) -> unit
 
 (** {1 I/O on connections} *)
 
@@ -277,31 +274,31 @@ val broadcast_bootstrap_msg:  ('msg, 'meta) pool -> unit
 
 (** {1 Functions on [Peer_id]} *)
 
-module Peer_ids : sig
+module Peers : sig
 
-  type ('msg, 'meta) info = (('msg, 'meta) connection, 'meta) Peer_info.t
+  type ('msg, 'meta) info = (('msg, 'meta) connection, 'meta) P2p_peer.Pool_info.t
 
   val info:
-    ('msg, 'meta) pool -> Peer_id.t -> ('msg, 'meta) info option
+    ('msg, 'meta) pool -> P2p_peer.Id.t -> ('msg, 'meta) info option
 
-  val get_metadata: ('msg, 'meta) pool -> Peer_id.t -> 'meta
+  val get_metadata: ('msg, 'meta) pool -> P2p_peer.Id.t -> 'meta
-  val set_metadata: ('msg, 'meta) pool -> Peer_id.t -> 'meta -> unit
+  val set_metadata: ('msg, 'meta) pool -> P2p_peer.Id.t -> 'meta -> unit
-  val get_score: ('msg, 'meta) pool -> Peer_id.t -> float
+  val get_score: ('msg, 'meta) pool -> P2p_peer.Id.t -> float
 
-  val get_trusted: ('msg, 'meta) pool -> Peer_id.t -> bool
+  val get_trusted: ('msg, 'meta) pool -> P2p_peer.Id.t -> bool
-  val set_trusted: ('msg, 'meta) pool -> Peer_id.t -> unit
+  val set_trusted: ('msg, 'meta) pool -> P2p_peer.Id.t -> unit
-  val unset_trusted: ('msg, 'meta) pool -> Peer_id.t -> unit
+  val unset_trusted: ('msg, 'meta) pool -> P2p_peer.Id.t -> unit
 
   val fold_known:
     ('msg, 'meta) pool ->
     init:'a ->
-    f:(Peer_id.t ->  ('msg, 'meta) info -> 'a -> 'a) ->
+    f:(P2p_peer.Id.t ->  ('msg, 'meta) info -> 'a -> 'a) ->
     'a
 
   val fold_connected:
     ('msg, 'meta) pool ->
     init:'a ->
-    f:(Peer_id.t ->  ('msg, 'meta) info -> 'a -> 'a) ->
+    f:(P2p_peer.Id.t ->  ('msg, 'meta) info -> 'a -> 'a) ->
     'a
 
 end
@@ -310,32 +307,30 @@ end
 
 module Points : sig
 
-  type ('msg, 'meta) info = ('msg, 'meta) connection Point_info.t
+  type ('msg, 'meta) info = ('msg, 'meta) connection P2p_point.Pool_info.t
 
   val info:
-    ('msg, 'meta) pool -> Point.t -> ('msg, 'meta) info option
+    ('msg, 'meta) pool -> P2p_point.Id.t -> ('msg, 'meta) info option
 
-  val get_trusted: ('msg, 'meta) pool -> Point.t -> bool
+  val get_trusted: ('msg, 'meta) pool -> P2p_point.Id.t -> bool
-  val set_trusted: ('msg, 'meta) pool -> Point.t -> unit
+  val set_trusted: ('msg, 'meta) pool -> P2p_point.Id.t -> unit
-  val unset_trusted: ('msg, 'meta) pool -> Point.t -> unit
+  val unset_trusted: ('msg, 'meta) pool -> P2p_point.Id.t -> unit
 
   val fold_known:
     ('msg, 'meta) pool ->
     init:'a ->
-    f:(Point.t -> ('msg, 'meta) info  -> 'a -> 'a) ->
+    f:(P2p_point.Id.t -> ('msg, 'meta) info  -> 'a -> 'a) ->
     'a
 
   val fold_connected:
     ('msg, 'meta) pool ->
     init:'a ->
-    f:(Point.t -> ('msg, 'meta) info  -> 'a -> 'a) ->
+    f:(P2p_point.Id.t -> ('msg, 'meta) info  -> 'a -> 'a) ->
     'a
 
 end
 
-module Log_event = Connection_pool_log_event
+val watch: ('msg, 'meta) pool -> P2p_connection.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper
-
-val watch: ('msg, 'meta) pool -> Log_event.t Lwt_stream.t * Lwt_watcher.stopper
 (** [watch pool] is a [stream, close] a [stream] of events and a
     [close] function for this stream. *)
 
@@ -345,9 +340,9 @@ module Message : sig
 
   type 'msg t =
     | Bootstrap
-    | Advertise of Point.t list
+    | Advertise of P2p_point.Id.t list
-    | Swap_request of Point.t * Peer_id.t
+    | Swap_request of P2p_point.Id.t * P2p_peer.Id.t
-    | Swap_ack of Point.t * Peer_id.t
+    | Swap_ack of P2p_point.Id.t * P2p_peer.Id.t
     | Message of 'msg
     | Disconnect
 

src/lib_p2p/p2p_socket.ml

@@ -19,8 +19,6 @@
         infinitly. This would avoid the real peer to talk with us. And
         this might also have an influence on its "score". *)
 
-open P2p_types
-
 include Logging.Make(struct let name = "p2p.connection" end)
 
 type error += Decipher_error
@@ -28,8 +26,8 @@ type error += Invalid_message_size
 type error += Encoding_error
 type error += Rejected
 type error += Decoding_error
-type error += Myself of Id_point.t
+type error += Myself of P2p_connection.Id.t
-type error += Not_enough_proof_of_work of Peer_id.t
+type error += Not_enough_proof_of_work of P2p_peer.Id.t
 type error += Invalid_auth
 type error += Invalid_chunks_size of { value: int ; min: int ; max: int }
 
@@ -94,7 +92,7 @@ module Connection_message = struct
 
   type t = {
     port : int option ;
-    versions : Version.t list ;
+    versions : P2p_version.t list ;
     public_key : Crypto_box.public_key ;
     proof_of_work_stamp : Crypto_box.nonce ;
     message_nonce : Crypto_box.nonce ;
@@ -118,7 +116,7 @@ module Connection_message = struct
          (req "pubkey" Crypto_box.public_key_encoding)
          (req "proof_of_work_stamp" Crypto_box.nonce_encoding)
          (req "message_nonce" Crypto_box.nonce_encoding)
-         (req "versions" (Variable.list Version.encoding)))
+         (req "versions" (Variable.list P2p_version.encoding)))
 
   let write fd message =
     let encoded_message_len =
@@ -172,7 +170,7 @@ module Ack = struct
 end
 
 type authenticated_fd =
-  P2p_io_scheduler.connection * Connection_info.t * Crypto.data
+  P2p_io_scheduler.connection * P2p_connection.Info.t * Crypto.data
 
 let kick (fd, _ , cryptobox_data) =
   Ack.write fd cryptobox_data Nack >>= fun _ ->
@@ -187,9 +185,9 @@ let authenticate
     ~incoming fd (remote_addr, remote_socket_port as point)
     ?listening_port identity supported_versions =
   let local_nonce = Crypto_box.random_nonce () in
-  lwt_debug "Sending authenfication to %a" Point.pp point >>= fun () ->
+  lwt_debug "Sending authenfication to %a" P2p_point.Id.pp point >>= fun () ->
   Connection_message.write fd
-    { public_key = identity.Identity.public_key ;
+    { public_key = identity.P2p_identity.public_key ;
       proof_of_work_stamp = identity.proof_of_work_stamp ;
       message_nonce = local_nonce ;
       port = listening_port ;
@@ -200,16 +198,16 @@ let authenticate
   let id_point = remote_addr, remote_listening_port in
   let remote_peer_id = Crypto_box.hash msg.public_key in
   fail_unless
-    (remote_peer_id <> identity.Identity.peer_id)
+    (remote_peer_id <> identity.P2p_identity.peer_id)
     (Myself id_point) >>=? fun () ->
   fail_unless
     (Crypto_box.check_proof_of_work
        msg.public_key msg.proof_of_work_stamp proof_of_work_target)
     (Not_enough_proof_of_work remote_peer_id) >>=? fun () ->
   let channel_key =
-    Crypto_box.precompute identity.Identity.secret_key msg.public_key in
+    Crypto_box.precompute identity.P2p_identity.secret_key msg.public_key in
   let info =
-    { Connection_info.peer_id = remote_peer_id ;
+    { P2p_connection.Info.peer_id = remote_peer_id ;
       versions = msg.versions ; incoming ;
       id_point ; remote_socket_port ;} in
   let cryptobox_data =
@@ -219,7 +217,7 @@ let authenticate
 
 type connection = {
   id : int ;
-  info : Connection_info.t ;
+  info : P2p_connection.Info.t ;
   fd : P2p_io_scheduler.connection ;
   cryptobox_data : Crypto.data ;
 }
@@ -254,7 +252,7 @@ module Reader = struct
           end >>=? fun buf ->
           lwt_debug
             "reading %d bytes from %a"
-            (MBytes.length buf) Connection_info.pp st.conn.info >>= fun () ->
+            (MBytes.length buf) P2p_connection.Info.pp st.conn.info >>= fun () ->
           loop (decode_next_buf buf) in
     loop
       (Data_encoding.Binary.read_stream_of_bytes ~init:init_mbytes st.encoding)
@@ -282,7 +280,7 @@ module Reader = struct
         Lwt.return_unit
     | Error [Lwt_utils.Canceled | Exn Lwt_pipe.Closed] ->
         lwt_debug "connection closed to %a"
-          Connection_info.pp st.conn.info >>= fun () ->
+          P2p_connection.Info.pp st.conn.info >>= fun () ->
         Lwt.return_unit
     | Error _ as err ->
         Lwt_pipe.safe_push_now st.messages err ;
@@ -335,7 +333,7 @@ module Writer = struct
             Crypto.write_chunk st.conn.fd st.conn.cryptobox_data buf
           end >>=? fun () ->
           lwt_debug "writing %d bytes to %a"
-            (MBytes.length buf) Connection_info.pp st.conn.info >>= fun () ->
+            (MBytes.length buf) P2p_connection.Info.pp st.conn.info >>= fun () ->
           loop l in
     loop buf
 
@@ -350,12 +348,12 @@ module Writer = struct
     end >>= function
     | Error [Lwt_utils.Canceled | Exn Lwt_pipe.Closed] ->
         lwt_debug "connection closed to %a"
-          Connection_info.pp st.conn.info >>= fun () ->
+          P2p_connection.Info.pp st.conn.info >>= fun () ->
         Lwt.return_unit
     | Error err ->
         lwt_log_error
           "@[<v 2>error writing to %a@ %a@]"
-          Connection_info.pp st.conn.info pp_print_error err >>= fun () ->
+          P2p_connection.Info.pp st.conn.info pp_print_error err >>= fun () ->
         Lwt_canceler.cancel st.canceler >>= fun () ->
         Lwt.return_unit
     | Ok (buf, wakener) ->
@@ -372,17 +370,17 @@ module Writer = struct
             match err with
             | [ Lwt_utils.Canceled | Exn Lwt_pipe.Closed ] ->
                 lwt_debug "connection closed to %a"
-                  Connection_info.pp st.conn.info >>= fun () ->
+                  P2p_connection.Info.pp st.conn.info >>= fun () ->
                 Lwt.return_unit
             | [ P2p_io_scheduler.Connection_closed ] ->
                 lwt_debug "connection closed to %a"
-                  Connection_info.pp st.conn.info >>= fun () ->
+                  P2p_connection.Info.pp st.conn.info >>= fun () ->
                 Lwt_canceler.cancel st.canceler >>= fun () ->
                 Lwt.return_unit
             | err ->
                 lwt_log_error
                   "@[<v 2>error writing to %a@ %a@]"
-                  Connection_info.pp st.conn.info
+                  P2p_connection.Info.pp st.conn.info
                   pp_print_error err >>= fun () ->
                 Lwt_canceler.cancel st.canceler >>= fun () ->
                 Lwt.return_unit
@@ -447,7 +445,7 @@ type 'msg t = {
 
 let equal { conn = { id = id1 } } { conn = { id = id2 } } = id1 = id2
 
-let pp ppf { conn } = Connection_info.pp ppf conn.info
+let pp ppf { conn } = P2p_connection.Info.pp ppf conn.info
 let info { conn } = conn.info
 
 let accept
@@ -497,7 +495,7 @@ let pp_json encoding ppf msg =
 let write { writer ; conn } msg =
   catch_closed_pipe begin fun () ->
     debug "Sending message to %a: %a"
-      P2p_types.Peer_id.pp_short conn.info.peer_id (pp_json writer.encoding) msg ;
+      P2p_peer.Id.pp_short conn.info.peer_id (pp_json writer.encoding) msg ;
     Lwt.return (Writer.encode_message writer msg) >>=? fun buf ->
     Lwt_pipe.push writer.messages (buf, None) >>= return
   end
@@ -506,7 +504,7 @@ let write_sync { writer ; conn } msg =
   catch_closed_pipe begin fun () ->
     let waiter, wakener = Lwt.wait () in
     debug "Sending message to %a: %a"
-      P2p_types.Peer_id.pp_short conn.info.peer_id (pp_json writer.encoding) msg ;
+      P2p_peer.Id.pp_short conn.info.peer_id (pp_json writer.encoding) msg ;
     Lwt.return (Writer.encode_message writer msg) >>=? fun buf ->
     Lwt_pipe.push writer.messages (buf, Some wakener) >>= fun () ->
     waiter
@@ -514,7 +512,7 @@ let write_sync { writer ; conn } msg =
 
 let write_now { writer ; conn } msg =
   debug "Try sending message to %a: %a"
-    P2p_types.Peer_id.pp_short conn.info.peer_id (pp_json writer.encoding) msg ;
+    P2p_peer.Id.pp_short conn.info.peer_id (pp_json writer.encoding) msg ;
   Writer.encode_message writer msg >>? fun buf ->
   try Ok (Lwt_pipe.push_now writer.messages (buf, None))
   with Lwt_pipe.Closed -> Error [P2p_io_scheduler.Connection_closed]

src/lib_p2p/p2p_socket.mli

@@ -15,8 +15,6 @@
     limited by providing corresponding arguments to [accept].
 *)
 
-open P2p_types
-
 (** {1 Types} *)
 
 type error += Decipher_error
@@ -24,8 +22,8 @@ type error += Invalid_message_size
 type error += Encoding_error
 type error += Decoding_error
 type error += Rejected
-type error += Myself of Id_point.t
+type error += Myself of P2p_connection.Id.t
-type error += Not_enough_proof_of_work of Peer_id.t
+type error += Not_enough_proof_of_work of P2p_peer.Id.t
 type error += Invalid_auth
 type error += Invalid_chunks_size of { value: int ; min: int ; max: int }
 
@@ -40,17 +38,17 @@ type 'msg t
 val equal: 'mst t -> 'msg t -> bool
 
 val pp: Format.formatter -> 'msg t -> unit
-val info: 'msg t -> Connection_info.t
+val info: 'msg t -> P2p_connection.Info.t
 
 (** {1 Low-level functions (do not use directly)} *)
 
 val authenticate:
   proof_of_work_target:Crypto_box.target ->
   incoming:bool ->
-  P2p_io_scheduler.connection -> Point.t ->
+  P2p_io_scheduler.connection -> P2p_point.Id.t ->
   ?listening_port: int ->
-  Identity.t -> Version.t list ->
+  P2p_identity.t -> P2p_version.t list ->
-  (Connection_info.t * authenticated_fd) tzresult Lwt.t
+  (P2p_connection.Info.t * authenticated_fd) tzresult Lwt.t
 (** (Low-level) (Cancelable) Authentication function of a remote
     peer. Used in [P2p_connection_pool], to promote a
     [P2P_io_scheduler.connection] into an [authenticated_fd] (auth
@@ -112,7 +110,7 @@ val read_now: 'msg t -> (int * 'msg) tzresult option
     is not empty, [None] if it is empty, or fails with a correponding
     error otherwise. *)
 
-val stat: 'msg t -> Stat.t
+val stat: 'msg t -> P2p_stat.t
 (** [stat conn] is a snapshot of current bandwidth usage for
     [conn]. *)
 

src/lib_p2p/p2p_welcome.ml

@@ -9,7 +9,7 @@
 
 include Logging.Make (struct let name = "p2p.welcome" end)
 
-type pool = Pool : ('msg, 'meta) P2p_connection_pool.t -> pool
+type pool = Pool : ('msg, 'meta) P2p_pool.t -> pool
 
 type t = {
   socket: Lwt_unix.file_descr ;
@@ -30,7 +30,7 @@ let rec worker_loop st =
         | Lwt_unix.ADDR_UNIX _ -> assert false
         | Lwt_unix.ADDR_INET (addr, port) ->
             (Ipaddr_unix.V6.of_inet_addr_exn addr, port) in
-      P2p_connection_pool.accept pool fd point ;
+      P2p_pool.accept pool fd point ;
       worker_loop st
   | Error [Lwt_utils.Canceled] ->
       Lwt.return_unit

src/lib_p2p/p2p_welcome.mli

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open P2p_types
-
 (** Welcome worker. Accept incoming connections and add them to its
     connection pool. *)
 
@@ -18,8 +16,8 @@ type t
 
 val run:
   backlog:int ->
-  ('msg, 'meta) P2p_connection_pool.t ->
+  ('msg, 'meta) P2p_pool.t ->
-  ?addr:addr -> port -> t Lwt.t
+  ?addr:P2p_addr.t -> P2p_addr.port -> t Lwt.t
 (** [run ~backlog ~addr pool port] returns a running welcome worker
     feeding [pool] listening at [(addr, port)]. [backlog] is the
     argument passed to [Lwt_unix.accept]. *)

src/lib_p2p_services/p2p_connection_pool_types.ml

@@ -1,526 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*    Copyright (c) 2014 - 2017.                                          *)
-(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
-(*                                                                        *)
-(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
-(*                                                                        *)
-(**************************************************************************)
-
-open P2p_types
-
-module Point_info = struct
-
-  type 'data state =
-    | Requested of { cancel: Lwt_canceler.t }
-    | Accepted of { current_peer_id: Peer_id.t ;
-                    cancel: Lwt_canceler.t }
-    | Running of { data: 'data ;
-                   current_peer_id: Peer_id.t }
-    | Disconnected
-
-  module Event = struct
-
-    type kind =
-      | Outgoing_request
-      | Accepting_request of Peer_id.t
-      | Rejecting_request of Peer_id.t
-      | Request_rejected of Peer_id.t option
-      | Connection_established of Peer_id.t
-      | Disconnection of Peer_id.t
-      | External_disconnection of Peer_id.t
-
-    let kind_encoding =
-      let open Data_encoding in
-      let branch_encoding name obj =
-        conv (fun x -> (), x) (fun ((), x) -> x)
-          (merge_objs
-             (obj1 (req "event_kind" (constant name))) obj) in
-      union ~tag_size:`Uint8 [
-        case (Tag 0) (branch_encoding "outgoing_request" empty)
-          (function Outgoing_request -> Some () | _ -> None)
-          (fun () -> Outgoing_request) ;
-        case (Tag 1) (branch_encoding "accepting_request"
-                        (obj1 (req "peer_id" Peer_id.encoding)))
-          (function Accepting_request peer_id -> Some peer_id | _ -> None)
-          (fun peer_id -> Accepting_request peer_id) ;
-        case (Tag 2) (branch_encoding "rejecting_request"
-                        (obj1 (req "peer_id" Peer_id.encoding)))
-          (function Rejecting_request peer_id -> Some peer_id | _ -> None)
-          (fun peer_id -> Rejecting_request peer_id) ;
-        case (Tag 3) (branch_encoding "request_rejected"
-                        (obj1 (opt "peer_id" Peer_id.encoding)))
-          (function Request_rejected peer_id -> Some peer_id | _ -> None)
-          (fun peer_id -> Request_rejected peer_id) ;
-        case (Tag 4) (branch_encoding "rejecting_request"
-                        (obj1 (req "peer_id" Peer_id.encoding)))
-          (function Connection_established peer_id -> Some peer_id | _ -> None)
-          (fun peer_id -> Connection_established peer_id) ;
-        case (Tag 5) (branch_encoding "rejecting_request"
-                        (obj1 (req "peer_id" Peer_id.encoding)))
-          (function Disconnection peer_id -> Some peer_id | _ -> None)
-          (fun peer_id -> Disconnection peer_id) ;
-        case (Tag 6) (branch_encoding "rejecting_request"
-                        (obj1 (req "peer_id" Peer_id.encoding)))
-          (function External_disconnection peer_id -> Some peer_id | _ -> None)
-          (fun peer_id -> External_disconnection peer_id) ;
-      ]
-
-    type t = {
-      kind : kind ;
-      timestamp : Time.t ;
-    }
-
-    let encoding =
-      let open Data_encoding in
-      conv
-        (fun { kind ; timestamp ; } -> (kind, timestamp))
-        (fun (kind, timestamp) -> { kind ; timestamp ; })
-        (obj2
-           (req "kind" kind_encoding)
-           (req "timestamp" Time.encoding))
-  end
-
-  type greylisting_config = {
-    factor: float ;
-    initial_delay: int ;
-    disconnection_delay: int ;
-  }
-
-  type 'data t = {
-    point : Point.t ;
-    mutable trusted : bool ;
-    mutable state : 'data state ;
-    mutable last_failed_connection : Time.t option ;
-    mutable last_rejected_connection : (Peer_id.t * Time.t) option ;
-    mutable last_established_connection : (Peer_id.t * Time.t) option ;
-    mutable last_disconnection : (Peer_id.t * Time.t) option ;
-    greylisting : greylisting_config ;
-    mutable greylisting_delay : float ;
-    mutable greylisting_end : Time.t ;
-    events : Event.t Ring.t ;
-    watchers : Event.t Lwt_watcher.input ;
-  }
-  type 'data point_info = 'data t
-
-  let compare pi1 pi2 = Point.compare pi1.point pi2.point
-
-  let log_size = 100
-
-  let default_greylisting_config = {
-    factor = 1.2 ;
-    initial_delay = 1 ;
-    disconnection_delay = 60 ;
-  }
-
-  let create
-      ?(trusted = false)
-      ?(greylisting_config = default_greylisting_config) addr  port = {
-    point = (addr, port) ;
-    trusted ;
-    state = Disconnected ;
-    last_failed_connection = None ;
-    last_rejected_connection = None ;
-    last_established_connection = None ;
-    last_disconnection = None ;
-    events = Ring.create log_size ;
-    greylisting = greylisting_config ;
-    greylisting_delay = 1. ;
-    greylisting_end = Time.epoch ;
-    watchers = Lwt_watcher.create_input () ;
-  }
-
-  let point s = s.point
-  let trusted s = s.trusted
-  let set_trusted gi = gi.trusted <- true
-  let unset_trusted gi = gi.trusted <- false
-  let last_established_connection s = s.last_established_connection
-  let last_disconnection s = s.last_disconnection
-  let last_failed_connection s = s.last_failed_connection
-  let last_rejected_connection s = s.last_rejected_connection
-  let greylisted ?(now = Time.now ()) s =
-    Time.compare now s.greylisting_end <= 0
-  let greylisted_until s = s.greylisting_end
-
-  let recent a1 a2 =
-    match a1, a2 with
-    | (None, None) -> None
-    | (None, (Some _ as a))
-    | (Some _ as a, None) -> a
-    | (Some (_, t1), Some (_, t2)) ->
-        if Time.compare t1 t2 < 0 then a2 else a1
-  let last_seen s =
-    recent s.last_rejected_connection
-      (recent s.last_established_connection s.last_disconnection)
-  let last_miss s =
-    match
-      s.last_failed_connection,
-      (Option.map ~f:(fun (_, time) -> time) @@
-       recent s.last_rejected_connection s.last_disconnection) with
-    | (None, None) -> None
-    | (None, (Some _ as a))
-    | (Some _ as a, None) -> a
-    | (Some t1 as a1 , (Some t2 as a2)) ->
-        if Time.compare t1 t2 < 0 then a2 else a1
-
-  let fold_events { events ; _ } ~init ~f = Ring.fold events ~init ~f
-
-  let watch { watchers ; _ } = Lwt_watcher.create_stream watchers
-
-  let log { events ; watchers ; _ } ?(timestamp = Time.now ()) kind =
-    let event = { Event.kind ; timestamp } in
-    Ring.add events event ;
-    Lwt_watcher.notify watchers event
-
-  let log_incoming_rejection ?timestamp point_info peer_id =
-    log point_info ?timestamp (Rejecting_request peer_id)
-
-  module State = struct
-
-    type 'data t = 'data state =
-      | Requested of { cancel: Lwt_canceler.t }
-      | Accepted of { current_peer_id: Peer_id.t ;
-                      cancel: Lwt_canceler.t }
-      | Running of { data: 'data ;
-                     current_peer_id: Peer_id.t }
-      | Disconnected
-    type 'data state = 'data t
-
-    let pp ppf = function
-      | Requested _ ->
-          Format.fprintf ppf "requested"
-      | Accepted { current_peer_id ; _ } ->
-          Format.fprintf ppf "accepted %a" Peer_id.pp current_peer_id
-      | Running { current_peer_id ; _ } ->
-          Format.fprintf ppf "running %a" Peer_id.pp current_peer_id
-      | Disconnected ->
-          Format.fprintf ppf "disconnected"
-
-    let get { state ; _ } = state
-
-    let is_disconnected { state ; _ } =
-      match state with
-      | Disconnected -> true
-      | Requested _ | Accepted _ | Running _ -> false
-
-    let set_requested ?timestamp point_info cancel =
-      assert begin
-        match point_info.state with
-        | Requested _ -> true
-        | Accepted _ | Running _ -> false
-        | Disconnected -> true
-      end ;
-      point_info.state <- Requested { cancel } ;
-      log point_info ?timestamp Outgoing_request
-
-    let set_accepted
-        ?(timestamp = Time.now ())
-        point_info current_peer_id cancel =
-      (* log_notice "SET_ACCEPTED %a@." Point.pp point_info.point ; *)
-      assert begin
-        match point_info.state with
-        | Accepted _ | Running _ -> false
-        | Requested _ | Disconnected -> true
-      end ;
-      point_info.state <- Accepted { current_peer_id ; cancel } ;
-      log point_info ~timestamp (Accepting_request current_peer_id)
-
-    let set_running
-        ?(timestamp = Time.now ())
-        point_info peer_id data =
-      assert begin
-        match point_info.state with
-        | Disconnected -> true (* request to unknown peer_id. *)
-        | Running _ -> false
-        | Accepted { current_peer_id ; _ } -> Peer_id.equal peer_id current_peer_id
-        | Requested _ -> true
-      end ;
-      point_info.state <- Running { data ; current_peer_id = peer_id } ;
-      point_info.last_established_connection <- Some (peer_id, timestamp) ;
-      log point_info ~timestamp (Connection_established peer_id)
-
-    let set_greylisted timestamp point_info =
-      point_info.greylisting_end <-
-        Time.add
-          timestamp
-          (Int64.of_float point_info.greylisting_delay) ;
-      point_info.greylisting_delay <-
-        point_info.greylisting_delay *. point_info.greylisting.factor
-
-    let set_disconnected
-        ?(timestamp = Time.now ()) ?(requested = false) point_info =
-      let event : Event.kind =
-        match point_info.state with
-        | Requested _ ->
-            set_greylisted timestamp point_info ;
-            point_info.last_failed_connection <- Some timestamp ;
-            Request_rejected None
-        | Accepted { current_peer_id ; _ } ->
-            set_greylisted timestamp point_info ;
-            point_info.last_rejected_connection <-
-              Some (current_peer_id, timestamp) ;
-            Request_rejected (Some current_peer_id)
-        | Running { current_peer_id ; _ } ->
-            point_info.greylisting_delay <-
-              float_of_int point_info.greylisting.initial_delay ;
-            point_info.greylisting_end <-
-              Time.add timestamp
-                (Int64.of_int point_info.greylisting.disconnection_delay) ;
-            point_info.last_disconnection <- Some (current_peer_id, timestamp) ;
-            if requested
-            then Disconnection current_peer_id
-            else External_disconnection current_peer_id
-        | Disconnected ->
-            assert false
-      in
-      point_info.state <- Disconnected ;
-      log point_info ~timestamp event
-
-  end
-
-end
-
-module Peer_info = struct
-
-  type 'data state =
-    | Accepted of { current_point: Id_point.t ;
-                    cancel: Lwt_canceler.t }
-    | Running of { data: 'data ;
-                   current_point: Id_point.t }
-    | Disconnected
-
-  module Event = struct
-
-    type kind =
-      | Accepting_request
-      | Rejecting_request
-      | Request_rejected
-      | Connection_established
-      | Disconnection
-      | External_disconnection
-
-    let kind_encoding =
-      Data_encoding.string_enum [
-        "incoming_request", Accepting_request ;
-        "rejecting_request", Rejecting_request ;
-        "request_rejected", Request_rejected ;
-        "connection_established", Connection_established ;
-        "disconnection", Disconnection ;
-        "external_disconnection", External_disconnection ;
-      ]
-
-    type t = {
-      kind : kind ;
-      timestamp : Time.t ;
-      point : Id_point.t ;
-    }
-
-    let encoding =
-      let open Data_encoding in
-      conv
-        (fun { kind ; timestamp ; point = (addr, port) } ->
-           (kind, timestamp, addr, port))
-        (fun (kind, timestamp, addr, port) ->
-           { kind ; timestamp ; point = (addr, port) })
-        (obj4
-           (req "kind" kind_encoding)
-           (req "timestamp" Time.encoding)
-           (req "addr" P2p_types.addr_encoding)
-           (opt "port" int16))
-
-  end
-
-  type ('conn, 'meta) t = {
-    peer_id : Peer_id.t ;
-    created : Time.t ;
-    mutable state : 'conn state ;
-    mutable metadata : 'meta ;
-    mutable trusted : bool ;
-    mutable last_failed_connection : (Id_point.t * Time.t) option ;
-    mutable last_rejected_connection : (Id_point.t * Time.t) option ;
-    mutable last_established_connection : (Id_point.t * Time.t) option ;
-    mutable last_disconnection : (Id_point.t * Time.t) option ;
-    events : Event.t Ring.t ;
-    watchers : Event.t Lwt_watcher.input ;
-  }
-  type ('conn, 'meta) peer_info = ('conn, 'meta) t
-
-  let compare gi1 gi2 = Peer_id.compare gi1.peer_id gi2.peer_id
-
-  let log_size = 100
-
-  let create ?(created = Time.now ()) ?(trusted = false) ~metadata peer_id =
-    { peer_id ;
-      created ;
-      state = Disconnected ;
-      metadata ;
-      trusted ;
-      last_failed_connection = None ;
-      last_rejected_connection = None ;
-      last_established_connection = None ;
-      last_disconnection = None ;
-      events = Ring.create log_size ;
-      watchers = Lwt_watcher.create_input () ;
-    }
-
-  let encoding metadata_encoding =
-    let open Data_encoding in
-    conv
-      (fun { peer_id ; trusted ; metadata ; events ; created ;
-             last_failed_connection ; last_rejected_connection ;
-             last_established_connection ; last_disconnection ; _ } ->
-        (peer_id, created, trusted, metadata, Ring.elements events,
-         last_failed_connection, last_rejected_connection,
-         last_established_connection, last_disconnection))
-      (fun (peer_id, created, trusted, metadata, event_list,
-            last_failed_connection, last_rejected_connection,
-            last_established_connection, last_disconnection) ->
-        let info = create ~trusted ~metadata peer_id in
-        let events = Ring.create log_size in
-        Ring.add_list info.events event_list ;
-        { state = Disconnected ;
-          trusted ; peer_id ; metadata ; created ;
-          last_failed_connection ;
-          last_rejected_connection ;
-          last_established_connection ;
-          last_disconnection ;
-          events ;
-          watchers = Lwt_watcher.create_input () ;
-        })
-      (obj9
-         (req "peer_id" Peer_id.encoding)
-         (req "created" Time.encoding)
-         (dft "trusted" bool false)
-         (req "metadata" metadata_encoding)
-         (dft "events" (list Event.encoding) [])
-         (opt "last_failed_connection"
-            (tup2 Id_point.encoding Time.encoding))
-         (opt "last_rejected_connection"
-            (tup2 Id_point.encoding Time.encoding))
-         (opt "last_established_connection"
-            (tup2 Id_point.encoding Time.encoding))
-         (opt "last_disconnection"
-            (tup2 Id_point.encoding Time.encoding)))
-
-  let peer_id { peer_id ; _ } = peer_id
-  let created { created ; _ } = created
-  let metadata { metadata ; _ } = metadata
-  let set_metadata gi metadata = gi.metadata <- metadata
-  let trusted { trusted ; _ } = trusted
-  let set_trusted gi = gi.trusted <- true
-  let unset_trusted gi = gi.trusted <- false
-  let fold_events { events ; _ } ~init ~f = Ring.fold events ~init ~f
-
-  let last_established_connection s = s.last_established_connection
-  let last_disconnection s = s.last_disconnection
-  let last_failed_connection s = s.last_failed_connection
-  let last_rejected_connection s = s.last_rejected_connection
-
-  let recent = Point_info.recent
-  let last_seen s =
-    recent
-      s.last_established_connection
-      (recent s.last_rejected_connection s.last_disconnection)
-  let last_miss s =
-    recent
-      s.last_failed_connection
-      (recent s.last_rejected_connection s.last_disconnection)
-
-  let log { events ; watchers ; _ } ?(timestamp = Time.now ()) point kind =
-    let event = { Event.kind ; timestamp ; point } in
-    Ring.add events event ;
-    Lwt_watcher.notify watchers event
-
-  let watch { watchers ; _ } = Lwt_watcher.create_stream watchers
-
-  let log_incoming_rejection ?timestamp peer_info point =
-    log peer_info ?timestamp point Rejecting_request
-
-  module State = struct
-
-    type 'data t = 'data state =
-      | Accepted of { current_point: Id_point.t ;
-                      cancel: Lwt_canceler.t }
-      | Running of { data: 'data ;
-                     current_point: Id_point.t }
-      | Disconnected
-    type 'data state = 'data t
-
-    let pp ppf = function
-      | Accepted { current_point ; _ } ->
-          Format.fprintf ppf "accepted %a" Id_point.pp current_point
-      | Running { current_point ; _ } ->
-          Format.fprintf ppf "running %a" Id_point.pp current_point
-      | Disconnected ->
-          Format.fprintf ppf "disconnected"
-
-    let get { state ; _ } = state
-
-    let is_disconnected { state ; _ } =
-      match state with
-      | Disconnected -> true
-      | Accepted _ | Running _ -> false
-
-    let set_accepted
-        ?(timestamp = Time.now ())
-        peer_info current_point cancel =
-      assert begin
-        match peer_info.state with
-        | Accepted _ | Running _ -> false
-        | Disconnected -> true
-      end ;
-      peer_info.state <- Accepted { current_point ; cancel } ;
-      log peer_info ~timestamp current_point Accepting_request
-
-    let set_running
-        ?(timestamp = Time.now ())
-        peer_info point data =
-      assert begin
-        match peer_info.state with
-        | Disconnected -> true (* request to unknown peer_id. *)
-        | Running _ -> false
-        | Accepted { current_point ; _ } ->
-            Id_point.equal point current_point
-      end ;
-      peer_info.state <- Running { data ; current_point = point } ;
-      peer_info.last_established_connection <- Some (point, timestamp) ;
-      log peer_info ~timestamp point Connection_established
-
-    let set_disconnected
-        ?(timestamp = Time.now ()) ?(requested = false) peer_info =
-      let current_point, (event : Event.kind) =
-        match peer_info.state with
-        | Accepted { current_point ; _ } ->
-            peer_info.last_rejected_connection <-
-              Some (current_point, timestamp) ;
-            current_point, Request_rejected
-        | Running { current_point ; _ } ->
-            peer_info.last_disconnection <-
-              Some (current_point, timestamp) ;
-            current_point,
-            if requested then Disconnection else External_disconnection
-        | Disconnected -> assert false
-      in
-      peer_info.state <- Disconnected ;
-      log peer_info ~timestamp current_point event
-
-  end
-
-  module File = struct
-
-    let load path metadata_encoding =
-      let enc = Data_encoding.list (encoding metadata_encoding) in
-      if path <> "/dev/null" && Sys.file_exists path then
-        Data_encoding_ezjsonm.read_file path >>=? fun json ->
-        return (Data_encoding.Json.destruct enc json)
-      else
-        return []
-
-    let save path metadata_encoding peers =
-      let open Data_encoding in
-      Data_encoding_ezjsonm.write_file path @@
-      Json.construct (list (encoding metadata_encoding)) peers
-
-  end
-
-end

src/lib_p2p_services/p2p_connection_pool_types.mli

@@ -1,284 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*    Copyright (c) 2014 - 2017.                                          *)
-(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
-(*                                                                        *)
-(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
-(*                                                                        *)
-(**************************************************************************)
-
-open P2p_types
-
-module Point_info : sig
-
-  type 'conn t
-  type 'conn point_info = 'conn t
-  (** Type of info associated to a point. *)
-
-  val compare : 'conn point_info -> 'conn point_info -> int
-
-  type greylisting_config = {
-    factor: float ;
-    initial_delay: int ;
-    disconnection_delay: int ;
-  }
-
-  val create :
-    ?trusted:bool ->
-    ?greylisting_config:greylisting_config ->
-    addr -> port -> 'conn point_info
-  (** [create ~trusted addr port] is a freshly minted point_info. If
-      [trusted] is true, this point is considered trusted and will
-      be treated as such. *)
-
-  val trusted : 'conn point_info -> bool
-  (** [trusted pi] is [true] iff [pi] has is trusted,
-      i.e. "whitelisted". *)
-
-  val set_trusted : 'conn point_info -> unit
-  val unset_trusted : 'conn point_info -> unit
-
-  val last_failed_connection :
-    'conn point_info -> Time.t option
-  val last_rejected_connection :
-    'conn point_info -> (Peer_id.t * Time.t) option
-  val last_established_connection :
-    'conn point_info -> (Peer_id.t * Time.t) option
-  val last_disconnection :
-    'conn point_info -> (Peer_id.t * Time.t) option
-
-  val last_seen :
-    'conn point_info -> (Peer_id.t * Time.t) option
-  (** [last_seen pi] is the most recent of:
-
-      * last established connection
-      * last rejected connection
-      * last disconnection
-  *)
-
-  val last_miss :
-    'conn point_info -> Time.t option
-  (** [last_miss pi] is the most recent of:
-
-      * last failed connection
-      * last rejected connection
-      * last disconnection
-  *)
-
-  val greylisted :
-    ?now:Time.t -> 'conn point_info -> bool
-
-  val greylisted_until : 'conn point_info -> Time.t
-
-  val point : 'conn point_info -> Point.t
-
-  module State : sig
-
-    type 'conn t =
-      | Requested of { cancel: Lwt_canceler.t }
-      (** We initiated a connection. *)
-      | Accepted of { current_peer_id: Peer_id.t ;
-                      cancel: Lwt_canceler.t }
-      (** We accepted a incoming connection. *)
-      | Running of { data: 'conn ;
-                     current_peer_id: Peer_id.t }
-      (** Successfully authentificated connection, normal business. *)
-      | Disconnected
-      (** No connection established currently. *)
-    type 'conn state = 'conn t
-
-    val pp : Format.formatter -> 'conn t -> unit
-
-    val get : 'conn point_info -> 'conn state
-
-    val is_disconnected : 'conn point_info -> bool
-
-    val set_requested :
-      ?timestamp:Time.t ->
-      'conn point_info -> Lwt_canceler.t -> unit
-
-    val set_accepted :
-      ?timestamp:Time.t ->
-      'conn point_info -> Peer_id.t -> Lwt_canceler.t -> unit
-
-    val set_running :
-      ?timestamp:Time.t -> 'conn point_info -> Peer_id.t -> 'conn -> unit
-
-    val set_disconnected :
-      ?timestamp:Time.t -> ?requested:bool -> 'conn point_info -> unit
-
-  end
-
-  module Event : sig
-
-    type kind =
-      | Outgoing_request
-      (** We initiated a connection. *)
-      | Accepting_request of Peer_id.t
-      (** We accepted a connection after authentifying the remote peer. *)
-      | Rejecting_request of Peer_id.t
-      (** We rejected a connection after authentifying the remote peer. *)
-      | Request_rejected of Peer_id.t option
-      (** The remote peer rejected our connection. *)
-      | Connection_established of Peer_id.t
-      (** We succesfully established a authentified connection. *)
-      | Disconnection of Peer_id.t
-      (** We decided to close the connection. *)
-      | External_disconnection of Peer_id.t
-      (** The connection was closed for external reason. *)
-
-    type t = {
-      kind : kind ;
-      timestamp : Time.t ;
-    }
-
-    val encoding : t Data_encoding.t
-
-  end
-
-  val fold_events :
-    'conn point_info -> init:'a -> f:('a -> Event.t -> 'a) -> 'a
-
-  val watch :
-    'conn point_info -> Event.t Lwt_stream.t * Lwt_watcher.stopper
-
-  val log_incoming_rejection :
-    ?timestamp:Time.t -> 'conn point_info -> Peer_id.t -> unit
-
-end
-
-
-(** Peer_id info: current and historical information about a peer_id *)
-
-module Peer_info : sig
-
-  type ('conn, 'meta) t
-  type ('conn, 'meta) peer_info = ('conn, 'meta) t
-
-  val compare : ('conn, 'meta) t -> ('conn, 'meta) t -> int
-
-  val create :
-    ?created:Time.t ->
-    ?trusted:bool ->
-    metadata:'meta ->
-    Peer_id.t -> ('conn, 'meta) peer_info
-  (** [create ~trusted ~meta peer_id] is a freshly minted peer_id info for
-      [peer_id]. *)
-
-  val peer_id : ('conn, 'meta) peer_info -> Peer_id.t
-
-  val created : ('conn, 'meta) peer_info -> Time.t
-  val metadata : ('conn, 'meta) peer_info -> 'meta
-  val set_metadata : ('conn, 'meta) peer_info -> 'meta -> unit
-
-  val trusted : ('conn, 'meta) peer_info -> bool
-  val set_trusted : ('conn, 'meta) peer_info -> unit
-  val unset_trusted : ('conn, 'meta) peer_info -> unit
-
-  val last_failed_connection :
-    ('conn, 'meta) peer_info -> (Id_point.t * Time.t) option
-  val last_rejected_connection :
-    ('conn, 'meta) peer_info -> (Id_point.t * Time.t) option
-  val last_established_connection :
-    ('conn, 'meta) peer_info -> (Id_point.t * Time.t) option
-  val last_disconnection :
-    ('conn, 'meta) peer_info -> (Id_point.t * Time.t) option
-
-  val last_seen :
-    ('conn, 'meta) peer_info -> (Id_point.t * Time.t) option
-  (** [last_seen gi] is the most recent of:
-
-      * last established connection
-      * last rejected connection
-      * last disconnection
-  *)
-
-  val last_miss :
-    ('conn, 'meta) peer_info -> (Id_point.t * Time.t) option
-  (** [last_miss gi] is the most recent of:
-
-      * last failed connection
-      * last rejected connection
-      * last disconnection
-  *)
-
-  module State : sig
-
-    type 'conn t =
-      | Accepted of { current_point: Id_point.t ;
-                      cancel: Lwt_canceler.t }
-      (** We accepted a incoming connection, we greeted back and
-          we are waiting for an acknowledgement. *)
-      | Running of { data: 'conn ;
-                     current_point: Id_point.t }
-      (** Successfully authentificated connection, normal business. *)
-      | Disconnected
-      (** No connection established currently. *)
-    type 'conn state = 'conn t
-
-    val pp : Format.formatter -> 'conn t -> unit
-
-    val get : ('conn, 'meta) peer_info -> 'conn state
-
-    val is_disconnected : ('conn, 'meta) peer_info -> bool
-
-    val set_accepted :
-      ?timestamp:Time.t ->
-      ('conn, 'meta) peer_info -> Id_point.t -> Lwt_canceler.t -> unit
-
-    val set_running :
-      ?timestamp:Time.t ->
-      ('conn, 'meta) peer_info -> Id_point.t -> 'conn -> unit
-
-    val set_disconnected :
-      ?timestamp:Time.t ->
-      ?requested:bool ->
-      ('conn, 'meta) peer_info -> unit
-
-  end
-
-  module Event : sig
-
-    type kind =
-      | Accepting_request
-      (** We accepted a connection after authentifying the remote peer. *)
-      | Rejecting_request
-      (** We rejected a connection after authentifying the remote peer. *)
-      | Request_rejected
-      (** The remote peer rejected our connection. *)
-      | Connection_established
-      (** We succesfully established a authentified connection. *)
-      | Disconnection
-      (** We decided to close the connection. *)
-      | External_disconnection
-      (** The connection was closed for external reason. *)
-
-    type t = {
-      kind : kind ;
-      timestamp : Time.t ;
-      point : Id_point.t ;
-    }
-
-    val encoding : t Data_encoding.t
-  end
-
-  val fold_events :
-    ('conn, 'meta) peer_info -> init:'a -> f:('a -> Event.t -> 'a) -> 'a
-
-  val watch :
-    ('conn, 'meta) peer_info -> Event.t Lwt_stream.t * Lwt_watcher.stopper
-
-  val log_incoming_rejection :
-    ?timestamp:Time.t ->
-    ('conn, 'meta) peer_info -> Id_point.t -> unit
-
-  module File : sig
-    val load :
-      string -> 'meta Data_encoding.t ->
-      ('conn, 'meta) peer_info list tzresult Lwt.t
-    val save :
-      string -> 'meta Data_encoding.t ->
-      ('conn, 'meta) peer_info list -> unit tzresult Lwt.t
-  end
-
-end

src/lib_p2p_services/p2p_services.ml

@@ -7,17 +7,15 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open P2p_types
+let (peer_id_arg : P2p_peer.Id.t RPC_arg.arg) =
-
-let (peer_id_arg : P2p_types.Peer_id.t RPC_arg.arg) =
   Crypto_box.Public_key_hash.rpc_arg
 
 let point_arg =
   RPC_arg.make
     ~name:"point"
     ~descr:"A network point (ipv4:port or [ipv6]:port)."
-    ~destruct:Point.of_string
+    ~destruct:P2p_point.Id.of_string
-    ~construct:Point.to_string
+    ~construct:P2p_point.Id.to_string
     ()
 
 let versions =
@@ -25,7 +23,7 @@ let versions =
     ~description:"Supported network layer versions."
     ~query: RPC_query.empty
     ~input: Data_encoding.empty
-    ~output: (Data_encoding.list P2p_types.Version.encoding)
+    ~output: (Data_encoding.list P2p_version.encoding)
     ~error: Data_encoding.empty
     RPC_path.(root / "network" / "versions")
 
@@ -34,7 +32,7 @@ let stat =
     ~description:"Global network bandwidth statistics in B/s."
     ~query: RPC_query.empty
     ~input: Data_encoding.empty
-    ~output: P2p_types.Stat.encoding
+    ~output: P2p_stat.encoding
     ~error: Data_encoding.empty
     RPC_path.(root / "network" / "stat")
 
@@ -43,7 +41,7 @@ let events =
     ~description:"Stream of all network events"
     ~query: RPC_query.empty
     ~input: Data_encoding.empty
-    ~output: P2p_types.Connection_pool_log_event.encoding
+    ~output: P2p_connection.Pool_event.encoding
     ~error: Data_encoding.empty
     RPC_path.(root / "network" / "log")
 
@@ -65,7 +63,7 @@ module Connection = struct
       ~description:"List the running P2P connection."
       ~query: RPC_query.empty
       ~input: Data_encoding.empty
-      ~output: (Data_encoding.list P2p_types.Connection_info.encoding)
+      ~output: (Data_encoding.list P2p_connection.Info.encoding)
       ~error: Data_encoding.empty
       RPC_path.(root / "network" / "connection")
 
@@ -73,7 +71,7 @@ module Connection = struct
     RPC_service.post_service
       ~query: RPC_query.empty
       ~input: Data_encoding.empty
-      ~output: (Data_encoding.option P2p_types.Connection_info.encoding)
+      ~output: (Data_encoding.option P2p_connection.Info.encoding)
       ~error: Data_encoding.empty
       ~description:"Details about the current P2P connection to the given peer."
       RPC_path.(root / "network" / "connection" /: peer_id_arg)
@@ -95,7 +93,7 @@ module Point = struct
     RPC_service.post_service
       ~query: RPC_query.empty
       ~input: Data_encoding.empty
-      ~output: (Data_encoding.option P2p_types.Point_info.encoding)
+      ~output: (Data_encoding.option P2p_point.Info.encoding)
       ~error: Data_encoding.empty
       ~description: "Details about a given `IP:addr`."
       RPC_path.(root / "network" / "point" /: point_arg)
@@ -105,7 +103,7 @@ module Point = struct
       ~query: RPC_query.empty
       ~input: monitor_encoding
       ~output: (Data_encoding.list
-                  P2p_connection_pool_types.Point_info.Event.encoding)
+                  P2p_point.Pool_event.encoding)
       ~error: Data_encoding.empty
       ~description: "Monitor network events related to an `IP:addr`."
       RPC_path.(root / "network" / "point" /: point_arg / "log")
@@ -113,14 +111,14 @@ module Point = struct
   let list =
     let filter =
       let open Data_encoding in
-      obj1 (dft "filter" (list P2p_types.Point_state.encoding) []) in
+      obj1 (dft "filter" (list P2p_point.State.encoding) []) in
     RPC_service.post_service
       ~query: RPC_query.empty
       ~input: filter
       ~output:
         Data_encoding.(list (tup2
-                               P2p_types.Point.encoding
+                               P2p_point.Id.encoding
-                               P2p_types.Point_info.encoding))
+                               P2p_point.Info.encoding))
       ~error: Data_encoding.empty
       ~description:"List the pool of known `IP:port` \
                     used for establishing P2P connections ."
@@ -134,7 +132,7 @@ module Peer_id = struct
     RPC_service.post_service
       ~query: RPC_query.empty
       ~input: Data_encoding.empty
-      ~output: (Data_encoding.option P2p_types.Peer_info.encoding)
+      ~output: (Data_encoding.option P2p_peer.Info.encoding)
       ~error: Data_encoding.empty
       ~description:"Details about a given peer."
       RPC_path.(root / "network" / "peer_id" /: peer_id_arg)
@@ -144,7 +142,7 @@ module Peer_id = struct
       ~query: RPC_query.empty
       ~input: monitor_encoding
       ~output: (Data_encoding.list
-                  P2p_connection_pool_types.Peer_info.Event.encoding)
+                  P2p_peer.Pool_event.encoding)
       ~error: Data_encoding.empty
       ~description:"Monitor network events related to a given peer."
       RPC_path.(root / "network" / "peer_id" /: peer_id_arg / "log")
@@ -152,14 +150,14 @@ module Peer_id = struct
   let list =
     let filter =
       let open Data_encoding in
-      obj1 (dft "filter" (list P2p_types.Peer_state.encoding) []) in
+      obj1 (dft "filter" (list P2p_peer.State.encoding) []) in
     RPC_service.post_service
       ~query: RPC_query.empty
       ~input: filter
       ~output:
         Data_encoding.(list (tup2
-                               P2p_types.Peer_id.encoding
+                               P2p_peer.Id.encoding
-                               P2p_types.Peer_info.encoding))
+                               P2p_peer.Info.encoding))
       ~error: Data_encoding.empty
       ~description:"List the peers the node ever met."
       RPC_path.(root / "network" / "peer_id")

src/lib_p2p_services/p2p_services.mli

@@ -7,26 +7,24 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open P2p_types
-
 val stat :
   ([ `POST ], unit,
    unit, unit, unit,
-   Stat.t, unit) RPC_service.t
+   P2p_stat.t, unit) RPC_service.t
 
 val versions :
   ([ `POST ], unit,
    unit, unit, unit,
-   Version.t list, unit) RPC_service.t
+   P2p_version.t list, unit) RPC_service.t
 
 val events :
   ([ `POST ], unit,
    unit, unit, unit,
-   Connection_pool_log_event.t, unit) RPC_service.t
+   P2p_connection.Pool_event.t, unit) RPC_service.t
 
 val connect :
   ([ `POST ], unit,
-   unit * Point.t, unit, float,
+   unit * P2p_point.Id.t, unit, float,
    unit tzresult, unit) RPC_service.t
 
 module Connection : sig
@@ -34,16 +32,16 @@ module Connection : sig
   val list :
     ([ `POST ], unit,
      unit, unit, unit,
-     Connection_info.t list, unit) RPC_service.t
+     P2p_connection.Info.t list, unit) RPC_service.t
 
   val info :
     ([ `POST ], unit,
-     unit * Peer_id.t, unit, unit,
+     unit * P2p_peer.Id.t, unit, unit,
-     Connection_info.t option, unit) RPC_service.t
+     P2p_connection.Info.t option, unit) RPC_service.t
 
   val kick :
     ([ `POST ], unit,
-     unit * Peer_id.t, unit, bool,
+     unit * P2p_peer.Id.t, unit, bool,
      unit, unit) RPC_service.t
 
 end
@@ -51,33 +49,33 @@ end
 module Point : sig
   val list :
     ([ `POST ], unit,
-     unit, unit, Point_state.t list,
+     unit, unit, P2p_point.State.t list,
-     (Point.t * Point_info.t) list, unit) RPC_service.t
+     (P2p_point.Id.t * P2p_point.Info.t) list, unit) RPC_service.t
   val info :
     ([ `POST ], unit,
-     unit * Point.t, unit, unit,
+     unit * P2p_point.Id.t, unit, unit,
-     Point_info.t option, unit) RPC_service.t
+     P2p_point.Info.t option, unit) RPC_service.t
   val events :
     ([ `POST ], unit,
-     unit * Point.t, unit, bool,
+     unit * P2p_point.Id.t, unit, bool,
-     P2p_connection_pool_types.Point_info.Event.t list, unit) RPC_service.t
+     P2p_point.Pool_event.t list, unit) RPC_service.t
 end
 
 module Peer_id : sig
 
   val list :
     ([ `POST ], unit,
-     unit, unit, Peer_state.t list,
+     unit, unit, P2p_peer.State.t list,
-     (Peer_id.t * Peer_info.t) list, unit) RPC_service.t
+     (P2p_peer.Id.t * P2p_peer.Info.t) list, unit) RPC_service.t
 
   val info :
     ([ `POST ], unit,
-     unit * Peer_id.t, unit, unit,
+     unit * P2p_peer.Id.t, unit, unit,
-     Peer_info.t option, unit) RPC_service.t
+     P2p_peer.Info.t option, unit) RPC_service.t
 
   val events :
     ([ `POST ], unit,
-     unit * Peer_id.t, unit, bool,
+     unit * P2p_peer.Id.t, unit, bool,
-     P2p_connection_pool_types.Peer_info.Event.t list, unit) RPC_service.t
+     P2p_peer.Pool_event.t list, unit) RPC_service.t
 
 end

src/lib_p2p_services/p2p_types.ml

@@ -1,717 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*    Copyright (c) 2014 - 2017.                                          *)
-(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
-(*                                                                        *)
-(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
-(*                                                                        *)
-(**************************************************************************)
-
-module Version = struct
-  type t = {
-    name : string ;
-    major : int ;
-    minor : int ;
-  }
-
-  let pp ppf { name ; major ; minor } =
-    Format.fprintf ppf "%s.%d.%d" name major minor
-
-  let encoding =
-    let open Data_encoding in
-    conv
-      (fun { name; major; minor } -> (name, major, minor))
-      (fun (name, major, minor) -> { name; major; minor })
-      (obj3
-         (req "name" string)
-         (req "major" int8)
-         (req "minor" int8))
-
-  (* the common version for a pair of peers, if any, is the maximum one,
-     in lexicographic order *)
-  let common la lb =
-    let la = List.sort (fun l r -> compare r l) la in
-    let lb = List.sort (fun l r -> compare r l) lb in
-    let rec find = function
-      | [], _ | _, [] -> None
-      | ((a :: ta) as la), ((b :: tb) as lb) ->
-          if a = b then Some a
-          else if a < b then find (ta, lb)
-          else find (la, tb)
-    in find (la, lb)
-end
-
-module Stat = struct
-
-  type t = {
-    total_sent : int64 ;
-    total_recv : int64 ;
-    current_inflow : int ;
-    current_outflow : int ;
-  }
-
-  let empty = {
-    total_sent = 0L ;
-    total_recv = 0L ;
-    current_inflow = 0 ;
-    current_outflow = 0 ;
-  }
-
-  let print_size ppf sz =
-    let ratio n = (float_of_int sz /. float_of_int (1 lsl n)) in
-    if sz < 1 lsl 10 then
-      Format.fprintf ppf "%d B" sz
-    else if sz < 1 lsl 20 then
-      Format.fprintf ppf "%.2f kiB" (ratio 10)
-    else
-      Format.fprintf ppf "%.2f MiB" (ratio 20)
-
-  let print_size64 ppf sz =
-    let open Int64 in
-    let ratio n = (to_float sz /. float_of_int (1 lsl n)) in
-    if sz < shift_left 1L 10 then
-      Format.fprintf ppf "%Ld B" sz
-    else if sz < shift_left 1L 20 then
-      Format.fprintf ppf "%.2f kiB" (ratio 10)
-    else if sz < shift_left 1L 30 then
-      Format.fprintf ppf "%.2f MiB" (ratio 20)
-    else if sz < shift_left 1L 40 then
-      Format.fprintf ppf "%.2f GiB" (ratio 30)
-    else
-      Format.fprintf ppf "%.2f TiB" (ratio 40)
-
-  let pp ppf stat =
-    Format.fprintf ppf
-      "↗ %a (%a/s) ↘ %a (%a/s)"
-      print_size64 stat.total_sent print_size stat.current_outflow
-      print_size64 stat.total_recv print_size stat.current_inflow
-
-  let encoding =
-    let open Data_encoding in
-    conv
-      (fun { total_sent ; total_recv ; current_inflow ; current_outflow } ->
-         (total_sent, total_recv, current_inflow, current_outflow))
-      (fun (total_sent, total_recv, current_inflow, current_outflow) ->
-         { total_sent ; total_recv ; current_inflow ; current_outflow })
-      (obj4
-         (req "total_sent" int64)
-         (req "total_recv" int64)
-         (req "current_inflow" int31)
-         (req "current_outflow" int31))
-end
-
-(* public types *)
-type addr = Ipaddr.V6.t
-
-let addr_encoding =
-  let open Data_encoding in
-  splitted
-    ~json:begin
-      conv
-        Ipaddr.V6.to_string
-        Ipaddr.V6.of_string_exn
-        string
-    end
-    ~binary:begin
-      conv
-        Ipaddr.V6.to_bytes
-        Ipaddr.V6.of_bytes_exn
-        string
-    end
-
-type port = int
-
-
-module Id_point = struct
-
-  module T = struct
-
-    (* A net point (address x port). *)
-    type t = addr * port option
-    let compare (a1, p1) (a2, p2) =
-      match Ipaddr.V6.compare a1 a2 with
-      | 0 -> Pervasives.compare p1 p2
-      | x -> x
-    let equal p1 p2 = compare p1 p2 = 0
-    let hash = Hashtbl.hash
-    let pp ppf (addr, port) =
-      match port with
-      | None ->
-          Format.fprintf ppf "[%a]:??" Ipaddr.V6.pp_hum addr
-      | Some port ->
-          Format.fprintf ppf "[%a]:%d" Ipaddr.V6.pp_hum addr port
-    let pp_opt ppf = function
-      | None -> Format.pp_print_string ppf "none"
-      | Some point -> pp ppf point
-    let to_string t = Format.asprintf "%a" pp t
-
-    let is_local (addr, _) = Ipaddr.V6.is_private addr
-    let is_global (addr, _) = not @@ Ipaddr.V6.is_private addr
-
-    let of_point (addr, port) = addr, Some port
-    let to_point = function
-      | _, None -> None
-      | addr, Some port -> Some (addr, port)
-    let to_point_exn = function
-      | _, None -> invalid_arg "to_point_exn"
-      | addr, Some port -> addr, port
-
-    let encoding =
-      let open Data_encoding in
-      (obj2
-         (req "addr" addr_encoding)
-         (opt "port" uint16))
-
-  end
-
-  include T
-
-  module Map = Map.Make (T)
-  module Set = Set.Make (T)
-  module Table = Hashtbl.Make (T)
-
-end
-
-module Peer_id = Crypto_box.Public_key_hash
-
-module Peer_state = struct
-
-  type t =
-    | Accepted
-    | Running
-    | Disconnected
-
-  let pp_digram ppf = function
-    | Accepted -> Format.fprintf ppf "⚎"
-    | Running -> Format.fprintf ppf "⚌"
-    | Disconnected -> Format.fprintf ppf "⚏"
-
-  let encoding =
-    let open Data_encoding in
-    string_enum [
-      "accepted", Accepted ;
-      "running", Running ;
-      "disconnected", Disconnected ;
-    ]
-
-end
-
-module Peer_info = struct
-
-  type t = {
-    score : float ;
-    trusted : bool ;
-    state : Peer_state.t ;
-    id_point : Id_point.t option ;
-    stat : Stat.t ;
-    last_failed_connection : (Id_point.t * Time.t) option ;
-    last_rejected_connection : (Id_point.t * Time.t) option ;
-    last_established_connection : (Id_point.t * Time.t) option ;
-    last_disconnection : (Id_point.t * Time.t) option ;
-    last_seen : (Id_point.t * Time.t) option ;
-    last_miss : (Id_point.t * Time.t) option ;
-  }
-
-  let encoding =
-    let open Data_encoding in
-    conv
-      (fun (
-         { score ; trusted ; state ; id_point ; stat ;
-           last_failed_connection ; last_rejected_connection ;
-           last_established_connection ; last_disconnection ;
-           last_seen ; last_miss }) ->
-         ((score, trusted, state, id_point, stat),
-          (last_failed_connection, last_rejected_connection,
-           last_established_connection, last_disconnection,
-           last_seen, last_miss)))
-      (fun ((score, trusted, state, id_point, stat),
-            (last_failed_connection, last_rejected_connection,
-             last_established_connection, last_disconnection,
-             last_seen, last_miss)) ->
-        { score ; trusted ; state ; id_point ; stat ;
-          last_failed_connection ; last_rejected_connection ;
-          last_established_connection ; last_disconnection ;
-          last_seen ; last_miss })
-      (merge_objs
-         (obj5
-            (req "score" float)
-            (req "trusted" bool)
-            (req "state" Peer_state.encoding)
-            (opt "reachable_at" Id_point.encoding)
-            (req "stat" Stat.encoding))
-         (obj6
-            (opt "last_failed_connection" (tup2 Id_point.encoding Time.encoding))
-            (opt "last_rejected_connection" (tup2 Id_point.encoding Time.encoding))
-            (opt "last_established_connection" (tup2 Id_point.encoding Time.encoding))
-            (opt "last_disconnection" (tup2 Id_point.encoding Time.encoding))
-            (opt "last_seen" (tup2 Id_point.encoding Time.encoding))
-            (opt "last_miss" (tup2 Id_point.encoding Time.encoding))))
-
-end
-
-module Point = struct
-
-  module T = struct
-
-    (* A net point (address x port). *)
-    type t = addr * port
-    let compare (a1, p1) (a2, p2) =
-      match Ipaddr.V6.compare a1 a2 with
-      | 0 -> p1 - p2
-      | x -> x
-    let equal p1 p2 = compare p1 p2 = 0
-    let hash = Hashtbl.hash
-    let pp ppf (addr, port) =
-      match Ipaddr.v4_of_v6 addr with
-      | Some addr ->
-          Format.fprintf ppf "%a:%d" Ipaddr.V4.pp_hum addr port
-      | None ->
-          Format.fprintf ppf "[%a]:%d" Ipaddr.V6.pp_hum addr port
-    let pp_opt ppf = function
-      | None -> Format.pp_print_string ppf "none"
-      | Some point -> pp ppf point
-
-    let is_local (addr, _) = Ipaddr.V6.is_private addr
-    let is_global (addr, _) = not @@ Ipaddr.V6.is_private addr
-
-    let check_port port =
-      if TzString.mem_char port '[' ||
-         TzString.mem_char port ']' ||
-         TzString.mem_char port ':' then
-        invalid_arg "Utils.parse_addr_port (invalid character in port)"
-
-    let parse_addr_port s =
-      let len = String.length s in
-      if len = 0 then
-        ("", "")
-      else if s.[0] = '[' then begin (* inline IPv6 *)
-        match String.rindex s ']' with
-        | exception Not_found ->
-            invalid_arg "Utils.parse_addr_port (missing ']')"
-        | pos ->
-            let addr = String.sub s 1 (pos - 1) in
-            let port =
-              if pos = len - 1 then
-                ""
-              else if s.[pos+1] <> ':' then
-                invalid_arg "Utils.parse_addr_port (unexpected char after ']')"
-              else
-                String.sub s (pos + 2) (len - pos - 2) in
-            check_port port ;
-            addr, port
-      end else begin
-        match String.rindex s ']' with
-        | _pos ->
-            invalid_arg "Utils.parse_addr_port (unexpected char ']')"
-        | exception Not_found ->
-            match String.index s ':' with
-            | exception _ -> s, ""
-            | pos ->
-                match String.index_from s (pos+1) ':'  with
-                | exception _ ->
-                    let addr = String.sub s 0 pos in
-                    let port = String.sub s (pos + 1) (len - pos - 1) in
-                    check_port port ;
-                    addr, port
-                | _pos ->
-                    invalid_arg "Utils.parse_addr_port: IPv6 addresses must be bracketed"
-      end
-
-    let of_string_exn str =
-      let addr, port = parse_addr_port str in
-      let port = int_of_string port in
-      if port < 0 && port > 1 lsl 16 - 1 then
-        invalid_arg "port must be between 0 and 65535" ;
-      match Ipaddr.of_string_exn addr with
-      | V4 addr -> Ipaddr.v6_of_v4 addr, port
-      | V6 addr -> addr, port
-
-    let of_string str =
-      try Ok (of_string_exn str) with
-      | Invalid_argument s -> Error s
-      | Failure s -> Error s
-      | _ -> Error "Point.of_string"
-
-    let to_string saddr = Format.asprintf "%a" pp saddr
-
-    let encoding =
-      Data_encoding.conv to_string of_string_exn Data_encoding.string
-
-  end
-
-  include T
-
-  module Map = Map.Make (T)
-  module Set = Set.Make (T)
-  module Table = Hashtbl.Make (T)
-
-end
-
-module Point_state = struct
-
-  type t =
-    | Requested
-    | Accepted of Peer_id.t
-    | Running of Peer_id.t
-    | Disconnected
-
-  let of_peer_id = function
-    | Requested -> None
-    | Accepted pi -> Some pi
-    | Running pi -> Some pi
-    | Disconnected -> None
-
-  let of_peerid_state state pi =
-    match state, pi with
-    | Requested, _ -> Requested
-    | Accepted _, Some pi -> Accepted pi
-    | Running _, Some pi -> Running pi
-    | Disconnected, _ -> Disconnected
-    | _ -> invalid_arg "state_of_state_peerid"
-
-  let pp_digram ppf = function
-    | Requested -> Format.fprintf ppf "⚎"
-    | Accepted _ -> Format.fprintf ppf "⚍"
-    | Running _ -> Format.fprintf ppf "⚌"
-    | Disconnected -> Format.fprintf ppf "⚏"
-
-  let encoding =
-    let open Data_encoding in
-    let branch_encoding name obj =
-      conv (fun x -> (), x) (fun ((), x) -> x)
-        (merge_objs
-           (obj1 (req "event_kind" (constant name))) obj) in
-    union ~tag_size:`Uint8 [
-      case (Tag 0) (branch_encoding "requested" empty)
-        (function Requested -> Some () | _ -> None)
-        (fun () -> Requested) ;
-      case (Tag 1) (branch_encoding "accepted"
-                      (obj1 (req "peer_id" Peer_id.encoding)))
-        (function Accepted peer_id -> Some peer_id | _ -> None)
-        (fun peer_id -> Accepted peer_id) ;
-      case (Tag 2) (branch_encoding "running"
-                      (obj1 (req "peer_id" Peer_id.encoding)))
-        (function Running peer_id -> Some peer_id | _ -> None)
-        (fun peer_id -> Running peer_id) ;
-      case (Tag 3) (branch_encoding "disconnected" empty)
-        (function Disconnected -> Some () | _ -> None)
-        (fun () -> Disconnected) ;
-    ]
-
-end
-
-module Point_info = struct
-
-  type t = {
-    trusted : bool ;
-    greylisted_until : Time.t ;
-    state : Point_state.t ;
-    last_failed_connection : Time.t option ;
-    last_rejected_connection : (Peer_id.t * Time.t) option ;
-    last_established_connection : (Peer_id.t * Time.t) option ;
-    last_disconnection : (Peer_id.t * Time.t) option ;
-    last_seen : (Peer_id.t * Time.t) option ;
-    last_miss : Time.t option ;
-  }
-
-  let encoding =
-    let open Data_encoding in
-    conv
-      (fun { trusted ; greylisted_until ; state ;
-             last_failed_connection ; last_rejected_connection ;
-             last_established_connection ; last_disconnection ;
-             last_seen ; last_miss } ->
-        let peer_id = Point_state.of_peer_id state in
-        (trusted, greylisted_until, state, peer_id,
-         last_failed_connection, last_rejected_connection,
-         last_established_connection, last_disconnection,
-         last_seen, last_miss))
-      (fun (trusted, greylisted_until, state, peer_id,
-            last_failed_connection, last_rejected_connection,
-            last_established_connection, last_disconnection,
-            last_seen, last_miss) ->
-        let state = Point_state.of_peerid_state state peer_id in
-        { trusted ; greylisted_until ; state ;
-          last_failed_connection ; last_rejected_connection ;
-          last_established_connection ; last_disconnection ;
-          last_seen ; last_miss })
-      (obj10
-         (req "trusted" bool)
-         (dft "greylisted_until" Time.encoding Time.epoch)
-         (req "state" Point_state.encoding)
-         (opt "peer_id" Peer_id.encoding)
-         (opt "last_failed_connection" Time.encoding)
-         (opt "last_rejected_connection" (tup2 Peer_id.encoding Time.encoding))
-         (opt "last_established_connection" (tup2 Peer_id.encoding Time.encoding))
-         (opt "last_disconnection" (tup2 Peer_id.encoding Time.encoding))
-         (opt "last_seen" (tup2 Peer_id.encoding Time.encoding))
-         (opt "last_miss" Time.encoding))
-
-end
-
-
-module Identity = struct
-
-  type t = {
-    peer_id : Peer_id.t ;
-    public_key : Crypto_box.public_key ;
-    secret_key : Crypto_box.secret_key ;
-    proof_of_work_stamp : Crypto_box.nonce ;
-  }
-
-  let encoding =
-    let open Data_encoding in
-    conv
-      (fun { public_key ; secret_key ; proof_of_work_stamp ; _ } ->
-         (public_key, secret_key, proof_of_work_stamp))
-      (fun (public_key, secret_key, proof_of_work_stamp) ->
-         let peer_id = Crypto_box.hash public_key in
-         { peer_id ; public_key ; secret_key ; proof_of_work_stamp })
-      (obj3
-         (req "public_key" Crypto_box.public_key_encoding)
-         (req "secret_key" Crypto_box.secret_key_encoding)
-         (req "proof_of_work_stamp" Crypto_box.nonce_encoding))
-
-  let generate ?max target =
-    let secret_key, public_key, peer_id = Crypto_box.random_keypair () in
-    let proof_of_work_stamp =
-      Crypto_box.generate_proof_of_work ?max public_key target in
-    { peer_id ; public_key ; secret_key ; proof_of_work_stamp }
-
-  let animation = [|
-    "|.....|" ;
-    "|o....|" ;
-    "|oo...|" ;
-    "|ooo..|" ;
-    "|.ooo.|" ;
-    "|..ooo|" ;
-    "|...oo|" ;
-    "|....o|" ;
-    "|.....|" ;
-    "|.....|" ;
-    "|.....|" ;
-    "|.....|" ;
-  |]
-
-  let init = String.make (String.length animation.(0)) '\ '
-  let clean = String.make (String.length animation.(0)) '\b'
-  let animation = Array.map (fun x -> clean ^ x) animation
-  let animation_size = Array.length animation
-  let duration = 1200 / animation_size
-
-  let generate_with_animation ppf target =
-    Format.fprintf ppf "%s%!" init ;
-    let count = ref 10000 in
-    let rec loop n =
-      let start = Mtime_clock.counter () in
-      Format.fprintf ppf "%s%!" animation.(n mod animation_size);
-      try generate ~max:!count target
-      with Not_found ->
-        let time = Mtime.Span.to_ms (Mtime_clock.count start) in
-        count :=
-          if time <= 0. then
-            !count * 10
-          else
-            !count * duration / int_of_float time ;
-        loop (n+1)
-    in
-    let id = loop 0 in
-    Format.fprintf ppf "%s%s\n%!" clean init ;
-    id
-
-  let generate target = generate target
-
-end
-
-module Connection_info = struct
-
-  type t = {
-    incoming : bool;
-    peer_id : Peer_id.t;
-    id_point : Id_point.t;
-    remote_socket_port : port;
-    versions : Version.t list ;
-  }
-
-  let encoding =
-    let open Data_encoding in
-    conv
-      (fun { incoming ; peer_id ; id_point ; remote_socket_port ; versions } ->
-         (incoming, peer_id, id_point, remote_socket_port, versions))
-      (fun (incoming, peer_id, id_point, remote_socket_port, versions) ->
-         { incoming ; peer_id ; id_point ; remote_socket_port ; versions })
-      (obj5
-         (req "incoming" bool)
-         (req "peer_id" Peer_id.encoding)
-         (req "id_point" Id_point.encoding)
-         (req "remote_socket_port" uint16)
-         (req "versions" (list Version.encoding)))
-
-  let pp ppf
-      { incoming ; id_point = (remote_addr, remote_port) ;
-        remote_socket_port ; peer_id ; versions } =
-    let version = List.hd versions in
-    let point = match remote_port with
-      | None -> remote_addr, remote_socket_port
-      | Some port -> remote_addr, port in
-    Format.fprintf ppf "%s %a %a (%a)"
-      (if incoming then "↘" else "↗")
-      Peer_id.pp peer_id
-      Point.pp point
-      Version.pp version
-end
-
-module Connection_pool_log_event = struct
-
-  type t =
-
-    | Too_few_connections
-    | Too_many_connections
-
-    | New_point of Point.t
-    | New_peer of Peer_id.t
-
-    | Gc_points
-    | Gc_peer_ids
-
-    | Incoming_connection of Point.t
-    | Outgoing_connection of Point.t
-    | Authentication_failed of Point.t
-    | Accepting_request of Point.t * Id_point.t * Peer_id.t
-    | Rejecting_request of Point.t * Id_point.t * Peer_id.t
-    | Request_rejected of Point.t * (Id_point.t * Peer_id.t) option
-    | Connection_established of Id_point.t * Peer_id.t
-
-    | Swap_request_received of { source : Peer_id.t }
-    | Swap_ack_received of { source : Peer_id.t }
-    | Swap_request_sent of { source : Peer_id.t }
-    | Swap_ack_sent of { source : Peer_id.t }
-    | Swap_request_ignored of { source : Peer_id.t }
-    | Swap_success of { source : Peer_id.t }
-    | Swap_failure of { source : Peer_id.t }
-
-    | Disconnection of Peer_id.t
-    | External_disconnection of Peer_id.t
-
-  let encoding =
-    let open Data_encoding in
-    let branch_encoding name obj =
-      conv (fun x -> (), x) (fun ((), x) -> x)
-        (merge_objs
-           (obj1 (req "event" (constant name))) obj) in
-    union ~tag_size:`Uint8 [
-      case (Tag 0) (branch_encoding "too_few_connections" empty)
-        (function Too_few_connections -> Some () | _ -> None)
-        (fun () -> Too_few_connections) ;
-      case (Tag 1) (branch_encoding "too_many_connections" empty)
-        (function Too_many_connections -> Some () | _ -> None)
-        (fun () -> Too_many_connections) ;
-      case (Tag 2) (branch_encoding "new_point"
-                      (obj1 (req "point" Point.encoding)))
-        (function New_point p -> Some p | _ -> None)
-        (fun p -> New_point p) ;
-      case (Tag 3) (branch_encoding "new_peer"
-                      (obj1 (req "peer_id" Peer_id.encoding)))
-        (function New_peer p -> Some p | _ -> None)
-        (fun p -> New_peer p) ;
-      case (Tag 4) (branch_encoding "incoming_connection"
-                      (obj1 (req "point" Point.encoding)))
-        (function Incoming_connection p -> Some p | _ -> None)
-        (fun p -> Incoming_connection p) ;
-      case (Tag 5) (branch_encoding "outgoing_connection"
-                      (obj1 (req "point" Point.encoding)))
-        (function Outgoing_connection p -> Some p | _ -> None)
-        (fun p -> Outgoing_connection p) ;
-      case (Tag 6) (branch_encoding "authentication_failed"
-                      (obj1 (req "point" Point.encoding)))
-        (function Authentication_failed p -> Some p | _ -> None)
-        (fun p -> Authentication_failed p) ;
-      case (Tag 7) (branch_encoding "accepting_request"
-                      (obj3
-                         (req "point" Point.encoding)
-                         (req "id_point" Id_point.encoding)
-                         (req "peer_id" Peer_id.encoding)))
-        (function Accepting_request (p, id_p, g) ->
-           Some (p, id_p, g) | _ -> None)
-        (fun (p, id_p, g) -> Accepting_request (p, id_p, g)) ;
-      case (Tag 8) (branch_encoding "rejecting_request"
-                      (obj3
-                         (req "point" Point.encoding)
-                         (req "id_point" Id_point.encoding)
-                         (req "peer_id" Peer_id.encoding)))
-        (function Rejecting_request (p, id_p, g) ->
-           Some (p, id_p, g) | _ -> None)
-        (fun (p, id_p, g) -> Rejecting_request (p, id_p, g)) ;
-      case (Tag 9) (branch_encoding "request_rejected"
-                      (obj2
-                         (req "point" Point.encoding)
-                         (opt "identity"
-                            (tup2 Id_point.encoding Peer_id.encoding))))
-        (function Request_rejected (p, id) -> Some (p, id) | _ -> None)
-        (fun (p, id) -> Request_rejected (p, id)) ;
-      case (Tag 10) (branch_encoding "connection_established"
-                       (obj2
-                          (req "id_point" Id_point.encoding)
-                          (req "peer_id" Peer_id.encoding)))
-        (function Connection_established (id_p, g) ->
-           Some (id_p, g) | _ -> None)
-        (fun (id_p, g) -> Connection_established (id_p, g)) ;
-      case (Tag 11) (branch_encoding "disconnection"
-                       (obj1 (req "peer_id" Peer_id.encoding)))
-        (function Disconnection g -> Some g | _ -> None)
-        (fun g -> Disconnection g) ;
-      case (Tag 12) (branch_encoding "external_disconnection"
-                       (obj1 (req "peer_id" Peer_id.encoding)))
-        (function External_disconnection g -> Some g | _ -> None)
-        (fun g -> External_disconnection g) ;
-      case (Tag 13) (branch_encoding "gc_points" empty)
-        (function Gc_points -> Some () | _ -> None)
-        (fun () -> Gc_points) ;
-      case (Tag 14) (branch_encoding "gc_peer_ids" empty)
-        (function Gc_peer_ids -> Some () | _ -> None)
-        (fun () -> Gc_peer_ids) ;
-      case (Tag 15) (branch_encoding "swap_request_received"
-                       (obj1 (req "source" Peer_id.encoding)))
-        (function
-          | Swap_request_received { source } -> Some source
-          | _ -> None)
-        (fun source -> Swap_request_received { source }) ;
-      case (Tag 16) (branch_encoding "swap_ack_received"
-                       (obj1 (req "source" Peer_id.encoding)))
-        (function
-          | Swap_ack_received { source } -> Some source
-          | _ -> None)
-        (fun source -> Swap_ack_received { source }) ;
-      case (Tag 17) (branch_encoding "swap_request_sent"
-                       (obj1 (req "source" Peer_id.encoding)))
-        (function
-          | Swap_request_sent { source } -> Some source
-          | _ -> None)
-        (fun source -> Swap_request_sent { source }) ;
-      case (Tag 18) (branch_encoding "swap_ack_sent"
-                       (obj1 (req "source" Peer_id.encoding)))
-        (function
-          | Swap_ack_sent { source } -> Some source
-          | _ -> None)
-        (fun source -> Swap_ack_sent { source }) ;
-      case (Tag 19) (branch_encoding "swap_request_ignored"
-                       (obj1 (req "source" Peer_id.encoding)))
-        (function
-          | Swap_request_ignored { source } -> Some source
-          | _ -> None)
-        (fun source -> Swap_request_ignored { source }) ;
-      case (Tag 20) (branch_encoding "swap_success"
-                       (obj1 (req "source" Peer_id.encoding)))
-        (function
-          | Swap_success { source } -> Some source
-          | _ -> None)
-        (fun source -> Swap_success { source }) ;
-      case (Tag 21) (branch_encoding "swap_failure"
-                       (obj1 (req "source" Peer_id.encoding)))
-        (function
-          | Swap_failure { source } -> Some source
-          | _ -> None)
-        (fun source -> Swap_failure { source }) ;
-    ]
-
-end

src/lib_p2p_services/p2p_types.mli

@@ -1,263 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*    Copyright (c) 2014 - 2017.                                          *)
-(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
-(*                                                                        *)
-(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
-(*                                                                        *)
-(**************************************************************************)
-
-(** Protocol version *)
-
-module Version : sig
-  type t = {
-    name : string ;
-    major : int ;
-    minor : int ;
-  }
-  (** Type of a protocol version. *)
-
-  val pp : Format.formatter -> t -> unit
-  val encoding : t Data_encoding.t
-  val common : t list -> t list -> t option
-end
-
-
-(** Peer_id, i.e. persistent peer identifier *)
-
-module Peer_id : Tezos_crypto.S.INTERNAL_HASH
-  with type t = Crypto_box.Public_key_hash.t
-
-type addr = Ipaddr.V6.t
-type port = int
-
-val addr_encoding : addr Data_encoding.t
-
-(** Point, i.e. socket address *)
-
-module Point : sig
-
-  type t = addr * port
-  val compare : t -> t -> int
-
-  val pp : Format.formatter -> t -> unit
-  val pp_opt : Format.formatter -> t option -> unit
-
-  val of_string_exn : string -> t
-  val of_string : string -> (t, string) result
-  val to_string : t -> string
-  val encoding : t Data_encoding.t
-  val is_local : t -> bool
-  val is_global : t -> bool
-  val parse_addr_port : string -> string * string
-
-  module Map : Map.S with type key = t
-  module Set : Set.S with type elt = t
-  module Table : Hashtbl.S with type key = t
-
-end
-
-(** Point representing a reachable socket address *)
-
-module Id_point : sig
-  type t = addr * port option
-  val compare : t -> t -> int
-  val equal : t -> t -> bool
-  val pp : Format.formatter -> t -> unit
-  val pp_opt : Format.formatter -> t option -> unit
-  val to_string : t -> string
-  val encoding : t Data_encoding.t
-  val is_local : t -> bool
-  val is_global : t -> bool
-  val of_point : Point.t -> t
-  val to_point : t -> Point.t option
-  val to_point_exn : t -> Point.t
-  module Map : Map.S with type key = t
-  module Set : Set.S with type elt = t
-  module Table : Hashtbl.S with type key = t
-end
-
-
-(** Identity *)
-
-module Identity : sig
-  type t = {
-    peer_id : Peer_id.t ;
-    public_key : Crypto_box.public_key ;
-    secret_key : Crypto_box.secret_key ;
-    proof_of_work_stamp : Crypto_box.nonce ;
-  }
-  (** Type of an identity, comprising a peer_id, a crypto keypair, and a
-      proof of work stamp with enough difficulty so that the network
-      accept this identity as genuine. *)
-
-  val encoding : t Data_encoding.t
-
-  val generate : Crypto_box.target -> t
-  (** [generate target] is a freshly minted identity whose proof of
-      work stamp difficulty is at least equal to [target]. *)
-
-  val generate_with_animation :
-    Format.formatter -> Crypto_box.target -> t
-    (** [generate_with_animation ppf target] is a freshly minted identity
-        whose proof of work stamp difficulty is at least equal to [target]. *)
-
-end
-
-
-(** Bandwidth usage statistics *)
-
-module Stat : sig
-
-  type t = {
-    total_sent : int64 ;
-    total_recv : int64 ;
-    current_inflow : int ;
-    current_outflow : int ;
-  }
-
-  val empty : t
-  val pp : Format.formatter -> t -> unit
-  val encoding : t Data_encoding.t
-end
-
-(** Information about a connection *)
-
-module Connection_info : sig
-
-  type t = {
-    incoming : bool;
-    peer_id : Peer_id.t;
-    id_point : Id_point.t;
-    remote_socket_port : port;
-    versions : Version.t list ;
-  }
-
-  val pp : Format.formatter -> t -> unit
-  val encoding : t Data_encoding.t
-
-end
-
-(** Pool-level events *)
-
-module Connection_pool_log_event : sig
-
-  type t =
-
-    | Too_few_connections
-    | Too_many_connections
-
-    | New_point of Point.t
-    | New_peer of Peer_id.t
-
-    | Gc_points
-    (** Garbage collection of known point table has been triggered. *)
-
-    | Gc_peer_ids
-    (** Garbage collection of known peer_ids table has been triggered. *)
-
-    (* Connection-level events *)
-
-    | Incoming_connection of Point.t
-    (** We accept(2)-ed an incoming connection *)
-    | Outgoing_connection of Point.t
-    (** We connect(2)-ed to a remote endpoint *)
-    | Authentication_failed of Point.t
-    (** Remote point failed authentication *)
-
-    | Accepting_request of Point.t * Id_point.t * Peer_id.t
-    (** We accepted a connection after authentifying the remote peer. *)
-    | Rejecting_request of Point.t * Id_point.t * Peer_id.t
-    (** We rejected a connection after authentifying the remote peer. *)
-    | Request_rejected of Point.t * (Id_point.t * Peer_id.t) option
-    (** The remote peer rejected our connection. *)
-
-    | Connection_established of Id_point.t * Peer_id.t
-    (** We succesfully established a authentified connection. *)
-
-    | Swap_request_received of { source : Peer_id.t }
-    (** A swap request has been received. *)
-    | Swap_ack_received of { source : Peer_id.t }
-    (** A swap ack has been received *)
-    | Swap_request_sent of { source : Peer_id.t }
-    (** A swap request has been sent *)
-    | Swap_ack_sent of { source : Peer_id.t }
-    (** A swap ack has been sent *)
-    | Swap_request_ignored of { source : Peer_id.t }
-    (** A swap request has been ignored *)
-    | Swap_success of { source : Peer_id.t }
-    (** A swap operation has succeeded *)
-    | Swap_failure of { source : Peer_id.t }
-    (** A swap operation has failed *)
-
-    | Disconnection of Peer_id.t
-    (** We decided to close the connection. *)
-    | External_disconnection of Peer_id.t
-    (** The connection was closed for external reason. *)
-
-  val encoding : t Data_encoding.t
-
-end
-
-module Point_state : sig
-
-  type t =
-    | Requested
-    | Accepted of Peer_id.t
-    | Running of Peer_id.t
-    | Disconnected
-
-  val pp_digram : Format.formatter -> t -> unit
-  val encoding : t Data_encoding.t
-
-end
-
-module Point_info : sig
-
-  type t = {
-    trusted : bool ;
-    greylisted_until : Time.t ;
-    state : Point_state.t ;
-    last_failed_connection : Time.t option ;
-    last_rejected_connection : (Peer_id.t * Time.t) option ;
-    last_established_connection : (Peer_id.t * Time.t) option ;
-    last_disconnection : (Peer_id.t * Time.t) option ;
-    last_seen : (Peer_id.t * Time.t) option ;
-    last_miss : Time.t option ;
-  }
-
-  val encoding : t Data_encoding.t
-
-end
-
-module Peer_state : sig
-
-  type t =
-    | Accepted
-    | Running
-    | Disconnected
-
-  val pp_digram : Format.formatter -> t -> unit
-  val encoding : t Data_encoding.t
-
-end
-
-module Peer_info : sig
-
-  type t = {
-    score : float ;
-    trusted : bool ;
-    state : Peer_state.t ;
-    id_point : Id_point.t option ;
-    stat : Stat.t ;
-    last_failed_connection : (Id_point.t * Time.t) option ;
-    last_rejected_connection : (Id_point.t * Time.t) option ;
-    last_established_connection : (Id_point.t * Time.t) option ;
-    last_disconnection : (Id_point.t * Time.t) option ;
-    last_seen : (Id_point.t * Time.t) option ;
-    last_miss : (Id_point.t * Time.t) option ;
-  }
-  val encoding : t Data_encoding.t
-
-end
-

src/lib_shell/block_validator.ml

@@ -40,7 +40,7 @@ module Request = struct
         net_db: Distributed_db.net_db ;
         notify_new_block: State.Block.t -> unit ;
         canceler: Lwt_canceler.t option ;
-        peer: P2p.Peer_id.t option ;
+        peer: P2p_peer.Id.t option ;
         hash: Block_hash.t ;
         header: Block_header.t ;
         operations: Operation.t list list ;

src/lib_shell/block_validator.mli

@@ -22,7 +22,7 @@ val create:
 val validate:
   t ->
   ?canceler:Lwt_canceler.t ->
-  ?peer:P2p.Peer_id.t ->
+  ?peer:P2p_peer.Id.t ->
   ?notify_new_block:(State.Block.t -> unit) ->
   Distributed_db.net_db ->
   Block_hash.t -> Block_header.t -> Operation.t list list ->
@@ -30,7 +30,7 @@ val validate:
 
 val fetch_and_compile_protocol:
   t ->
-  ?peer:P2p.Peer_id.t ->
+  ?peer:P2p_peer.Id.t ->
   ?timeout:float ->
   Protocol_hash.t -> State.Registred_protocol.t tzresult Lwt.t
 

src/lib_shell/bootstrap_pipeline.ml

@@ -9,7 +9,7 @@
 
 include Logging.Make(struct let name = "node.validator.bootstrap_pipeline" end)
 
-type error += Invalid_locator of P2p.Peer_id.t * Block_locator.t
+type error += Invalid_locator of P2p_peer.Id.t * Block_locator.t
 
 type t = {
   canceler: Lwt_canceler.t ;
@@ -18,7 +18,7 @@ type t = {
   mutable headers_fetch_worker: unit Lwt.t ;
   mutable operations_fetch_worker: unit Lwt.t ;
   mutable validation_worker: unit Lwt.t ;
-  peer_id: P2p.Peer_id.t ;
+  peer_id: P2p_peer.Id.t ;
   net_db: Distributed_db.net_db ;
   locator: Block_locator.t ;
   block_validator: Block_validator.t ;
@@ -37,24 +37,24 @@ let fetch_step pipeline (step : Block_locator_iterator.step)  =
     Block_hash.pp_short step.predecessor
     step.step
     (if step.strict_step then "" else " max")
-    P2p.Peer_id.pp_short pipeline.peer_id >>= fun () ->
+    P2p_peer.Id.pp_short pipeline.peer_id >>= fun () ->
   let rec fetch_loop acc hash cpt =
     Lwt_unix.yield () >>= fun () ->
     if cpt < 0 then
       lwt_log_info "invalid step from peer %a (too long)."
-        P2p.Peer_id.pp_short pipeline.peer_id >>= fun () ->
+        P2p_peer.Id.pp_short pipeline.peer_id >>= fun () ->
       fail (Invalid_locator (pipeline.peer_id, pipeline.locator))
     else if Block_hash.equal hash step.predecessor then
       if step.strict_step && cpt <> 0 then
         lwt_log_info "invalid step from peer %a (too short)."
-          P2p.Peer_id.pp_short pipeline.peer_id >>= fun () ->
+          P2p_peer.Id.pp_short pipeline.peer_id >>= fun () ->
         fail (Invalid_locator (pipeline.peer_id, pipeline.locator))
       else
         return acc
     else
       lwt_debug "fetching block header %a from peer %a."
         Block_hash.pp_short hash
-        P2p.Peer_id.pp_short pipeline.peer_id >>= fun () ->
+        P2p_peer.Id.pp_short pipeline.peer_id >>= fun () ->
       Lwt_utils.protect ~canceler:pipeline.canceler begin fun () ->
         Distributed_db.Block_header.fetch
           ~timeout:pipeline.block_header_timeout
@@ -63,7 +63,7 @@ let fetch_step pipeline (step : Block_locator_iterator.step)  =
       end >>=? fun header ->
       lwt_debug "fetched block header %a from peer %a."
         Block_hash.pp_short hash
-        P2p.Peer_id.pp_short pipeline.peer_id >>= fun () ->
+        P2p_peer.Id.pp_short pipeline.peer_id >>= fun () ->
       fetch_loop ((hash, header) :: acc) header.shell.predecessor (cpt - 1)
   in
   fetch_loop [] step.block step.step >>=? fun headers ->
@@ -84,7 +84,7 @@ let headers_fetch_worker_loop pipeline =
   end >>= function
   | Ok () ->
       lwt_log_info "fetched all step from peer %a."
-        P2p.Peer_id.pp_short pipeline.peer_id >>= fun () ->
+        P2p_peer.Id.pp_short pipeline.peer_id >>= fun () ->
       Lwt_pipe.close pipeline.fetched_headers ;
       Lwt.return_unit
   | Error [Exn Lwt.Canceled | Lwt_utils.Canceled | Exn Lwt_pipe.Closed] ->
@@ -92,7 +92,7 @@ let headers_fetch_worker_loop pipeline =
   | Error [ Distributed_db.Block_header.Timeout bh ] ->
       lwt_log_info "request for header %a from peer %a timed out."
         Block_hash.pp_short bh
-        P2p.Peer_id.pp_short pipeline.peer_id >>= fun () ->
+        P2p_peer.Id.pp_short pipeline.peer_id >>= fun () ->
       Lwt_canceler.cancel pipeline.canceler >>= fun () ->
       Lwt.return_unit
   | Error err ->
@@ -110,7 +110,7 @@ let rec operations_fetch_worker_loop pipeline =
     end >>=? fun (hash, header) ->
     lwt_log_info "fetching operations of block %a from peer %a."
       Block_hash.pp_short hash
-      P2p.Peer_id.pp_short pipeline.peer_id >>= fun () ->
+      P2p_peer.Id.pp_short pipeline.peer_id >>= fun () ->
     map_p
       (fun i ->
          Lwt_utils.protect ~canceler:pipeline.canceler begin fun () ->
@@ -122,7 +122,7 @@ let rec operations_fetch_worker_loop pipeline =
       (0 -- (header.shell.validation_passes - 1)) >>=? fun operations ->
     lwt_log_info "fetched operations of block %a from peer %a."
       Block_hash.pp_short hash
-      P2p.Peer_id.pp_short pipeline.peer_id >>= fun () ->
+      P2p_peer.Id.pp_short pipeline.peer_id >>= fun () ->
     Lwt_utils.protect ~canceler:pipeline.canceler begin fun () ->
       Lwt_pipe.push pipeline.fetched_blocks
         (hash, header, operations) >>= return
@@ -136,7 +136,7 @@ let rec operations_fetch_worker_loop pipeline =
   | Error [ Distributed_db.Operations.Timeout (bh, n) ] ->
       lwt_log_info "request for operations %a:%d from peer %a timed out."
         Block_hash.pp_short bh n
-        P2p.Peer_id.pp_short pipeline.peer_id >>= fun () ->
+        P2p_peer.Id.pp_short pipeline.peer_id >>= fun () ->
       Lwt_canceler.cancel pipeline.canceler >>= fun () ->
       Lwt.return_unit
   | Error err ->
@@ -154,7 +154,7 @@ let rec validation_worker_loop pipeline =
     end >>=? fun (hash, header, operations) ->
     lwt_log_info "requesting validation for block %a from peer %a."
       Block_hash.pp_short hash
-      P2p.Peer_id.pp_short pipeline.peer_id >>= fun () ->
+      P2p_peer.Id.pp_short pipeline.peer_id >>= fun () ->
     Lwt_utils.protect ~canceler:pipeline.canceler begin fun () ->
       Block_validator.validate
         ~canceler:pipeline.canceler
@@ -164,7 +164,7 @@ let rec validation_worker_loop pipeline =
     end >>=? fun _block ->
     lwt_log_info "validated block %a from peer %a."
       Block_hash.pp_short hash
-      P2p.Peer_id.pp_short pipeline.peer_id >>= fun () ->
+      P2p_peer.Id.pp_short pipeline.peer_id >>= fun () ->
     return ()
   end >>= function
   | Ok () -> validation_worker_loop pipeline
@@ -214,19 +214,19 @@ let create
   pipeline.headers_fetch_worker <-
     Lwt_utils.worker
       (Format.asprintf "bootstrap_pipeline-headers_fetch.%a.%a"
-         P2p.Peer_id.pp_short peer_id Block_hash.pp_short hash)
+         P2p_peer.Id.pp_short peer_id Block_hash.pp_short hash)
       ~run:(fun () -> headers_fetch_worker_loop pipeline)
       ~cancel:(fun () -> Lwt_canceler.cancel pipeline.canceler) ;
   pipeline.operations_fetch_worker <-
     Lwt_utils.worker
       (Format.asprintf "bootstrap_pipeline-operations_fetch.%a.%a"
-         P2p.Peer_id.pp_short peer_id Block_hash.pp_short hash)
+         P2p_peer.Id.pp_short peer_id Block_hash.pp_short hash)
       ~run:(fun () -> operations_fetch_worker_loop pipeline)
       ~cancel:(fun () -> Lwt_canceler.cancel pipeline.canceler) ;
   pipeline.validation_worker <-
     Lwt_utils.worker
       (Format.asprintf "bootstrap_pipeline-validation.%a.%a"
-         P2p.Peer_id.pp_short peer_id Block_hash.pp_short hash)
+         P2p_peer.Id.pp_short peer_id Block_hash.pp_short hash)
       ~run:(fun () -> validation_worker_loop pipeline)
       ~cancel:(fun () -> Lwt_canceler.cancel pipeline.canceler) ;
   pipeline

src/lib_shell/bootstrap_pipeline.mli

@@ -9,14 +9,14 @@
 
 type t
 
-type error += Invalid_locator of P2p.Peer_id.t * Block_locator.t
+type error += Invalid_locator of P2p_peer.Id.t * Block_locator.t
 
 val create:
   ?notify_new_block: (State.Block.t -> unit) ->
   block_header_timeout:float ->
   block_operations_timeout: float ->
   Block_validator.t ->
-  P2p.Peer_id.t -> Distributed_db.net_db ->
+  P2p_peer.Id.t -> Distributed_db.net_db ->
   Block_locator.t -> t
 
 val wait: t -> unit tzresult Lwt.t

src/lib_shell/distributed_db.ml

@@ -15,8 +15,8 @@ type connection = (Message.t, Metadata.t) P2p.connection
 
 type 'a request_param = {
   data: 'a ;
-  active: unit -> P2p.Peer_id.Set.t ;
+  active: unit -> P2p_peer.Set.t ;
-  send: P2p.Peer_id.t -> Message.t -> unit ;
+  send: P2p_peer.Id.t -> Message.t -> unit ;
 }
 
 module Make_raw
@@ -292,15 +292,15 @@ module Raw_protocol =
 
 type callback = {
   notify_branch:
-    P2p.Peer_id.t -> Block_locator.t -> unit ;
+    P2p_peer.Id.t -> Block_locator.t -> unit ;
   notify_head:
-    P2p.Peer_id.t -> Block_header.t -> Mempool.t -> unit ;
+    P2p_peer.Id.t -> Block_header.t -> Mempool.t -> unit ;
-  disconnection: P2p.Peer_id.t -> unit ;
+  disconnection: P2p_peer.Id.t -> unit ;
 }
 
 type db = {
   p2p: p2p ;
-  p2p_readers: p2p_reader P2p.Peer_id.Table.t ;
+  p2p_readers: p2p_reader P2p_peer.Table.t ;
   disk: State.t ;
   active_nets: net_db Net_id.Table.t ;
   protocol_db: Raw_protocol.t ;
@@ -316,12 +316,12 @@ and net_db = {
   operation_hashes_db: Raw_operation_hashes.t ;
   operations_db: Raw_operations.t ;
   mutable callback: callback ;
-  active_peers: P2p.Peer_id.Set.t ref ;
+  active_peers: P2p_peer.Set.t ref ;
-  active_connections: p2p_reader P2p.Peer_id.Table.t ;
+  active_connections: p2p_reader P2p_peer.Table.t ;
 }
 
 and p2p_reader = {
-  gid: P2p.Peer_id.t ;
+  gid: P2p_peer.Id.t ;
   conn: connection ;
   peer_active_nets: net_db Net_id.Table.t ;
   canceler: Lwt_canceler.t ;
@@ -418,8 +418,8 @@ module P2p_reader = struct
         match Net_id.Table.find global_db.active_nets net_id with
         | net_db ->
             net_db.active_peers :=
-              P2p.Peer_id.Set.add state.gid !(net_db.active_peers) ;
+              P2p_peer.Set.add state.gid !(net_db.active_peers) ;
-            P2p.Peer_id.Table.add net_db.active_connections
+            P2p_peer.Table.add net_db.active_connections
               state.gid state ;
             Net_id.Table.add state.peer_active_nets net_id net_db ;
             f net_db
@@ -430,8 +430,8 @@ module P2p_reader = struct
   let deactivate state net_db =
     net_db.callback.disconnection state.gid ;
     net_db.active_peers :=
-      P2p.Peer_id.Set.remove state.gid !(net_db.active_peers) ;
+      P2p_peer.Set.remove state.gid !(net_db.active_peers) ;
-    P2p.Peer_id.Table.remove net_db.active_connections state.gid
+    P2p_peer.Table.remove net_db.active_connections state.gid
 
   let may_handle state net_id f =
     match Net_id.Table.find state.peer_active_nets net_id with
@@ -456,7 +456,7 @@ module P2p_reader = struct
     let open Logging in
 
     lwt_debug "Read message from %a: %a"
-      P2p.Peer_id.pp_short state.gid Message.pp_json msg >>= fun () ->
+      P2p_peer.Id.pp_short state.gid Message.pp_json msg >>= fun () ->
 
     match msg with
 
@@ -639,7 +639,7 @@ module P2p_reader = struct
         Net_id.Table.iter
           (fun _ -> deactivate state)
           state.peer_active_nets ;
-        P2p.Peer_id.Table.remove global_db.p2p_readers state.gid ;
+        P2p_peer.Table.remove global_db.p2p_readers state.gid ;
         Lwt.return_unit
 
   let run db gid conn =
@@ -657,10 +657,10 @@ module P2p_reader = struct
     state.worker <-
       Lwt_utils.worker
         (Format.asprintf "db_network_reader.%a"
-           P2p.Peer_id.pp_short gid)
+           P2p_peer.Id.pp_short gid)
         ~run:(fun () -> worker_loop db state)
         ~cancel:(fun () -> Lwt_canceler.cancel canceler) ;
-    P2p.Peer_id.Table.add db.p2p_readers gid state
+    P2p_peer.Table.add db.p2p_readers gid state
 
   let shutdown s =
     Lwt_canceler.cancel s.canceler >>= fun () ->
@@ -671,9 +671,9 @@ end
 let active_peer_ids p2p () =
   List.fold_left
     (fun acc conn ->
-       let { P2p.Connection_info.peer_id } = P2p.connection_info p2p conn in
+       let { P2p_connection.Info.peer_id } = P2p.connection_info p2p conn in
-       P2p.Peer_id.Set.add peer_id acc)
+       P2p_peer.Set.add peer_id acc)
-    P2p.Peer_id.Set.empty
+    P2p_peer.Set.empty
     (P2p.connections p2p)
 
 let raw_try_send p2p peer_id msg =
@@ -689,7 +689,7 @@ let create disk p2p =
     } in
   let protocol_db = Raw_protocol.create global_request disk in
   let active_nets = Net_id.Table.create 17 in
-  let p2p_readers = P2p.Peer_id.Table.create 17 in
+  let p2p_readers = P2p_peer.Table.create 17 in
   let block_input = Lwt_watcher.create_input () in
   let operation_input = Lwt_watcher.create_input () in
   let db =
@@ -704,7 +704,7 @@ let activate ({ p2p ; active_nets } as global_db) net_state =
   let net_id = State.Net.id net_state in
   match Net_id.Table.find active_nets net_id with
   | exception Not_found ->
-      let active_peers = ref P2p.Peer_id.Set.empty in
+      let active_peers = ref P2p_peer.Set.empty in
       let p2p_request =
         { data = () ;
           active = (fun () -> !active_peers) ;
@@ -724,7 +724,7 @@ let activate ({ p2p ; active_nets } as global_db) net_state =
         global_db ; operation_db ; block_header_db ;
         operation_hashes_db ; operations_db ;
         net_state ; callback = noop_callback ; active_peers ;
-        active_connections = P2p.Peer_id.Table.create 53 ;
+        active_connections = P2p_peer.Table.create 53 ;
       } in
       P2p.iter_connections p2p (fun _peer_id conn ->
           Lwt.async begin fun () ->
@@ -742,7 +742,7 @@ let deactivate net_db =
   let { active_nets ; p2p } = net_db.global_db in
   let net_id = State.Net.id net_db.net_state in
   Net_id.Table.remove active_nets net_id ;
-  P2p.Peer_id.Table.iter
+  P2p_peer.Table.iter
     (fun _peer_id reader ->
        P2p_reader.deactivate reader net_db  ;
        Lwt.async begin fun () ->
@@ -764,7 +764,7 @@ let disconnect { global_db = { p2p } } peer_id =
   | Some conn -> P2p.disconnect p2p conn
 
 let shutdown { p2p ; p2p_readers ; active_nets } =
-  P2p.Peer_id.Table.fold
+  P2p_peer.Table.fold
     (fun _peer_id reader acc ->
        P2p_reader.shutdown reader >>= fun () -> acc)
     p2p_readers
@@ -829,12 +829,12 @@ module type DISTRIBUTED_DB = sig
   type error += Timeout of key
   val fetch:
     t ->
-    ?peer:P2p.Peer_id.t ->
+    ?peer:P2p_peer.Id.t ->
     ?timeout:float ->
     key -> param -> value tzresult Lwt.t
   val prefetch:
     t ->
-    ?peer:P2p.Peer_id.t ->
+    ?peer:P2p_peer.Id.t ->
     ?timeout:float ->
     key -> param -> unit
   type error += Canceled of key
@@ -913,14 +913,14 @@ end
 
 
 let broadcast net_db msg =
-  P2p.Peer_id.Table.iter
+  P2p_peer.Table.iter
     (fun _peer_id state ->
        ignore (P2p.try_send net_db.global_db.p2p state.conn msg))
     net_db.active_connections
 
 let try_send net_db peer_id msg =
   try
-    let conn = P2p.Peer_id.Table.find net_db.active_connections peer_id in
+    let conn = P2p_peer.Table.find net_db.active_connections peer_id in
     ignore (P2p.try_send net_db.global_db.p2p conn.conn msg : bool)
   with Not_found -> ()
 

src/lib_shell/distributed_db.mli

@@ -40,9 +40,9 @@ val get_net: t -> Net_id.t -> net_db option
 val deactivate: net_db -> unit Lwt.t
 
 type callback = {
-  notify_branch: P2p.Peer_id.t -> Block_locator.t -> unit ;
+  notify_branch: P2p_peer.Id.t -> Block_locator.t -> unit ;
-  notify_head: P2p.Peer_id.t -> Block_header.t -> Mempool.t -> unit ;
+  notify_head: P2p_peer.Id.t -> Block_header.t -> Mempool.t -> unit ;
-  disconnection: P2p.Peer_id.t -> unit ;
+  disconnection: P2p_peer.Id.t -> unit ;
 }
 
 (** Register all the possible callback from the distributed DB to the
@@ -50,7 +50,7 @@ type callback = {
 val set_callback: net_db -> callback -> unit
 
 (** Kick a given peer. *)
-val disconnect: net_db -> P2p.Peer_id.t -> unit Lwt.t
+val disconnect: net_db -> P2p_peer.Id.t -> unit Lwt.t
 
 (** Various accessors. *)
 val net_state: net_db -> State.Net.t
@@ -63,12 +63,12 @@ module Request : sig
   (** Send to a given peer, or to all known active peers for the
       network, a friendly request "Hey, what's your current branch
       ?". The expected answer is a `Block_locator.t.`. *)
-  val current_branch: net_db -> ?peer:P2p.Peer_id.t -> unit -> unit
+  val current_branch: net_db -> ?peer:P2p_peer.Id.t -> unit -> unit
 
   (** Send to a given peer, or to all known active peers for the
       given network, a friendly request "Hey, what's your current
       branch ?". The expected answer is a `Block_locator.t.`. *)
-  val current_head: net_db -> ?peer:P2p.Peer_id.t -> unit -> unit
+  val current_head: net_db -> ?peer:P2p_peer.Id.t -> unit -> unit
 
 end
 
@@ -77,13 +77,13 @@ module Advertise : sig
   (** Notify a given peer, or all known active peers for the
       network, of a new head and possibly of new operations. *)
   val current_head:
-    net_db -> ?peer:P2p.Peer_id.t ->
+    net_db -> ?peer:P2p_peer.Id.t ->
     ?mempool:Mempool.t -> State.Block.t -> unit
 
   (** Notify a given peer, or all known active peers for the
       network, of a new head and its sparse history. *)
   val current_branch:
-    net_db -> ?peer:P2p.Peer_id.t ->
+    net_db -> ?peer:P2p_peer.Id.t ->
     Block_locator.t -> unit Lwt.t
 
 end
@@ -145,7 +145,7 @@ module type DISTRIBUTED_DB = sig
       peer (at each retry). *)
   val fetch:
     t ->
-    ?peer:P2p.Peer_id.t ->
+    ?peer:P2p_peer.Id.t ->
     ?timeout:float ->
     key -> param -> value tzresult Lwt.t
 
@@ -153,7 +153,7 @@ module type DISTRIBUTED_DB = sig
       stored in the local index when received. *)
   val prefetch:
     t ->
-    ?peer:P2p.Peer_id.t ->
+    ?peer:P2p_peer.Id.t ->
     ?timeout:float ->
     key -> param -> unit
 
@@ -257,6 +257,6 @@ val commit_protocol:
 
 module Raw : sig
   val encoding: Message.t P2p.Raw.t Data_encoding.t
-  val supported_versions: P2p_types.Version.t list
+  val supported_versions: P2p_version.t list
 end
 

src/lib_shell/distributed_db_functors.ml

@@ -26,13 +26,13 @@ module type DISTRIBUTED_DB = sig
 
   val prefetch:
     t ->
-    ?peer:P2p.Peer_id.t ->
+    ?peer:P2p_peer.Id.t ->
     ?timeout:float ->
     key -> param -> unit
 
   val fetch:
     t ->
-    ?peer:P2p.Peer_id.t ->
+    ?peer:P2p_peer.Id.t ->
     ?timeout:float ->
     key -> param -> value tzresult Lwt.t
 
@@ -68,12 +68,12 @@ end
 module type SCHEDULER_EVENTS = sig
   type t
   type key
-  val request: t -> P2p.Peer_id.t option -> key -> unit
+  val request: t -> P2p_peer.Id.t option -> key -> unit
-  val notify: t -> P2p.Peer_id.t -> key -> unit
+  val notify: t -> P2p_peer.Id.t -> key -> unit
   val notify_cancelation: t -> key -> unit
-  val notify_unrequested: t -> P2p.Peer_id.t -> key -> unit
+  val notify_unrequested: t -> P2p_peer.Id.t -> key -> unit
-  val notify_duplicate: t -> P2p.Peer_id.t -> key -> unit
+  val notify_duplicate: t -> P2p_peer.Id.t -> key -> unit
-  val notify_invalid: t -> P2p.Peer_id.t -> key -> unit
+  val notify_invalid: t -> P2p_peer.Id.t -> key -> unit
 end
 
 module type PRECHECK = sig
@@ -103,7 +103,7 @@ module Make_table
   val create:
     ?global_input:(key * value) Lwt_watcher.input ->
     Scheduler.t -> Disk_table.store -> t
-  val notify: t -> P2p.Peer_id.t -> key -> Precheck.notified_value -> unit Lwt.t
+  val notify: t -> P2p_peer.Id.t -> key -> Precheck.notified_value -> unit Lwt.t
 
 end = struct
 
@@ -306,8 +306,8 @@ end
 module type REQUEST = sig
   type key
   type param
-  val active : param -> P2p.Peer_id.Set.t
+  val active : param -> P2p_peer.Set.t
-  val send : param -> P2p.Peer_id.t -> key list -> unit
+  val send : param -> P2p_peer.Id.t -> key list -> unit
 end
 
 module Make_request_scheduler
@@ -343,24 +343,24 @@ end = struct
   }
 
   and status = {
-    peers: P2p.Peer_id.Set.t ;
+    peers: P2p_peer.Set.t ;
     next_request: float ;
     delay: float ;
   }
 
   and event =
-    | Request of P2p.Peer_id.t option * key
+    | Request of P2p_peer.Id.t option * key
-    | Notify of P2p.Peer_id.t * key
+    | Notify of P2p_peer.Id.t * key
     | Notify_cancelation of key
-    | Notify_invalid of P2p.Peer_id.t * key
+    | Notify_invalid of P2p_peer.Id.t * key
-    | Notify_duplicate of P2p.Peer_id.t * key
+    | Notify_duplicate of P2p_peer.Id.t * key
-    | Notify_unrequested of P2p.Peer_id.t * key
+    | Notify_unrequested of P2p_peer.Id.t * key
 
   let request t p k =
     assert (Lwt_pipe.push_now t.queue (Request (p, k)))
   let notify t p k =
     debug "push received %a from %a"
-      Hash.pp k P2p.Peer_id.pp_short p ;
+      Hash.pp k P2p_peer.Id.pp_short p ;
     assert (Lwt_pipe.push_now t.queue (Notify (p, k)))
   let notify_cancelation t k =
     debug "push cancelation %a"
@@ -368,15 +368,15 @@ end = struct
     assert (Lwt_pipe.push_now t.queue (Notify_cancelation k))
   let notify_invalid t p k =
     debug "push received invalid %a from %a"
-      Hash.pp k P2p.Peer_id.pp_short p ;
+      Hash.pp k P2p_peer.Id.pp_short p ;
     assert (Lwt_pipe.push_now t.queue (Notify_invalid (p, k)))
   let notify_duplicate t p k =
     debug "push received duplicate %a from %a"
-      Hash.pp k P2p.Peer_id.pp_short p ;
+      Hash.pp k P2p_peer.Id.pp_short p ;
     assert (Lwt_pipe.push_now t.queue (Notify_duplicate (p, k)))
   let notify_unrequested t p k =
     debug "push received unrequested %a from %a"
-      Hash.pp k P2p.Peer_id.pp_short p ;
+      Hash.pp k P2p_peer.Id.pp_short p ;
     assert (Lwt_pipe.push_now t.queue (Notify_unrequested (p, k)))
 
   let compute_timeout state =
@@ -399,7 +399,7 @@ end = struct
 
   let may_pp_peer ppf = function
     | None -> ()
-    | Some peer -> P2p.Peer_id.pp_short ppf peer
+    | Some peer -> P2p_peer.Id.pp_short ppf peer
 
   (* TODO should depend on the ressource kind... *)
   let initial_delay = 0.1
@@ -413,7 +413,7 @@ end = struct
           let peers =
             match peer with
             | None -> data.peers
-            | Some peer -> P2p.Peer_id.Set.add peer data.peers in
+            | Some peer -> P2p_peer.Set.add peer data.peers in
           Table.replace state.pending key {
             delay = initial_delay ;
             next_request = min data.next_request (now +. initial_delay) ;
@@ -425,8 +425,8 @@ end = struct
         with Not_found ->
           let peers =
             match peer with
-            | None -> P2p.Peer_id.Set.empty
+            | None -> P2p_peer.Set.empty
-            | Some peer -> P2p.Peer_id.Set.singleton peer in
+            | Some peer -> P2p_peer.Set.singleton peer in
           Table.add state.pending key {
             peers ;
             next_request = now ;
@@ -439,7 +439,7 @@ end = struct
     | Notify (peer, key) ->
         Table.remove state.pending key ;
         lwt_debug "received %a from %a"
-          Hash.pp key P2p.Peer_id.pp_short peer >>= fun () ->
+          Hash.pp key P2p_peer.Id.pp_short peer >>= fun () ->
         Lwt.return_unit
     | Notify_cancelation key ->
         Table.remove state.pending key ;
@@ -448,17 +448,17 @@ end = struct
         Lwt.return_unit
     | Notify_invalid (peer, key) ->
         lwt_debug "received invalid %a from %a"
-          Hash.pp key P2p.Peer_id.pp_short peer >>= fun () ->
+          Hash.pp key P2p_peer.Id.pp_short peer >>= fun () ->
         (* TODO *)
         Lwt.return_unit
     | Notify_unrequested (peer, key) ->
         lwt_debug "received unrequested %a from %a"
-          Hash.pp key P2p.Peer_id.pp_short peer >>= fun () ->
+          Hash.pp key P2p_peer.Id.pp_short peer >>= fun () ->
         (* TODO *)
         Lwt.return_unit
     | Notify_duplicate (peer, key) ->
         lwt_debug "received duplicate %a from %a"
-          Hash.pp key P2p.Peer_id.pp_short peer >>= fun () ->
+          Hash.pp key P2p_peer.Id.pp_short peer >>= fun () ->
         (* TODO *)
         Lwt.return_unit
 
@@ -487,14 +487,14 @@ end = struct
                acc
              else
                let remaining_peers =
-                 P2p.Peer_id.Set.inter peers active_peers in
+                 P2p_peer.Set.inter peers active_peers in
-               if P2p.Peer_id.Set.is_empty remaining_peers &&
+               if P2p_peer.Set.is_empty remaining_peers &&
-                  not (P2p.Peer_id.Set.is_empty peers) then
+                  not (P2p_peer.Set.is_empty peers) then
                  ( Table.remove state.pending key ; acc )
                else
                  let requested_peer =
-                   P2p.Peer_id.random_set_elt
+                   P2p_peer.Id.random_set_elt
-                     (if P2p.Peer_id.Set.is_empty remaining_peers
+                     (if P2p_peer.Set.is_empty remaining_peers
                       then active_peers
                       else remaining_peers) in
                  let next = { peers = remaining_peers ;
@@ -502,16 +502,16 @@ end = struct
                               delay = delay *. 1.2 } in
                  Table.replace state.pending key next ;
                  let requests =
-                   try key :: P2p_types.Peer_id.Map.find requested_peer acc
+                   try key :: P2p_peer.Map.find requested_peer acc
                    with Not_found -> [key] in
-                 P2p_types.Peer_id.Map.add requested_peer requests acc)
+                 P2p_peer.Map.add requested_peer requests acc)
-          state.pending P2p_types.Peer_id.Map.empty in
+          state.pending P2p_peer.Map.empty in
-      P2p_types.Peer_id.Map.iter (Request.send state.param) requests ;
+      P2p_peer.Map.iter (Request.send state.param) requests ;
-      P2p_types.Peer_id.Map.fold begin fun peer request acc ->
+      P2p_peer.Map.fold begin fun peer request acc ->
         acc >>= fun () ->
         Lwt_list.iter_s (fun key ->
             lwt_debug "requested %a from %a"
-              Hash.pp key P2p.Peer_id.pp_short peer)
+              Hash.pp key P2p_peer.Id.pp_short peer)
           request
       end requests Lwt.return_unit >>= fun () ->
       worker_loop state

src/lib_shell/distributed_db_functors.mli

@@ -29,13 +29,13 @@ module type DISTRIBUTED_DB = sig
 
   val prefetch:
     t ->
-    ?peer:P2p.Peer_id.t ->
+    ?peer:P2p_peer.Id.t ->
     ?timeout:float ->
     key -> param -> unit
 
   val fetch:
     t ->
-    ?peer:P2p.Peer_id.t ->
+    ?peer:P2p_peer.Id.t ->
     ?timeout:float ->
     key -> param -> value tzresult Lwt.t
 
@@ -72,12 +72,12 @@ end
 module type SCHEDULER_EVENTS = sig
   type t
   type key
-  val request: t -> P2p.Peer_id.t option -> key -> unit
+  val request: t -> P2p_peer.Id.t option -> key -> unit
-  val notify: t -> P2p.Peer_id.t -> key -> unit
+  val notify: t -> P2p_peer.Id.t -> key -> unit
   val notify_cancelation: t -> key -> unit
-  val notify_unrequested: t -> P2p.Peer_id.t -> key -> unit
+  val notify_unrequested: t -> P2p_peer.Id.t -> key -> unit
-  val notify_duplicate: t -> P2p.Peer_id.t -> key -> unit
+  val notify_duplicate: t -> P2p_peer.Id.t -> key -> unit
-  val notify_invalid: t -> P2p.Peer_id.t -> key -> unit
+  val notify_invalid: t -> P2p_peer.Id.t -> key -> unit
 end
 
 module type PRECHECK = sig
@@ -107,15 +107,15 @@ module Make_table
   val create:
     ?global_input:(key * value) Lwt_watcher.input ->
     Scheduler.t -> Disk_table.store -> t
-  val notify: t -> P2p.Peer_id.t -> key -> Precheck.notified_value -> unit Lwt.t
+  val notify: t -> P2p_peer.Id.t -> key -> Precheck.notified_value -> unit Lwt.t
 
 end
 
 module type REQUEST = sig
   type key
   type param
-  val active : param -> P2p.Peer_id.Set.t
+  val active : param -> P2p_peer.Set.t
-  val send : param -> P2p.Peer_id.t -> key list -> unit
+  val send : param -> P2p_peer.Id.t -> key list -> unit
 end
 
 module Make_request_scheduler

src/lib_shell/distributed_db_message.ml

@@ -169,7 +169,7 @@ let encoding =
   ]
 
 let versions =
-  let open P2p.Version in
+  let open P2p_version in
   [ { name = "TEZOS" ;
       major = 0 ;
       minor = 27 ;

src/lib_shell/net_validator.ml

@@ -57,17 +57,17 @@ module Types = struct
     mutable child:
       (state * (unit -> unit Lwt.t (* shutdown *))) option ;
     prevalidator: Prevalidator.t ;
-    active_peers: Peer_validator.t Lwt.t P2p.Peer_id.Table.t ;
+    active_peers: Peer_validator.t Lwt.t P2p_peer.Table.t ;
-    bootstrapped_peers: unit P2p.Peer_id.Table.t ;
+    bootstrapped_peers: unit P2p_peer.Table.t ;
   }
 
   let view (state : state) _ : view =
     let { bootstrapped ; active_peers ; bootstrapped_peers } = state in
     { bootstrapped ;
       active_peers =
-        P2p.Peer_id.Table.fold (fun id _ l -> id :: l) active_peers [] ;
+        P2p_peer.Table.fold (fun id _ l -> id :: l) active_peers [] ;
       bootstrapped_peers =
-        P2p.Peer_id.Table.fold (fun id _ l -> id :: l) bootstrapped_peers [] }
+        P2p_peer.Table.fold (fun id _ l -> id :: l) bootstrapped_peers [] }
 end
 
 module Worker = Worker.Make (Name) (Event) (Request) (Types)
@@ -99,7 +99,7 @@ let notify_new_block w block =
 let may_toggle_bootstrapped_network w =
   let nv = Worker.state w in
   if not nv.bootstrapped &&
-     P2p.Peer_id.Table.length nv.bootstrapped_peers >= nv.parameters.limits.bootstrap_threshold
+     P2p_peer.Table.length nv.bootstrapped_peers >= nv.parameters.limits.bootstrap_threshold
   then begin
     nv.bootstrapped <- true ;
     Lwt.wakeup_later nv.bootstrapped_wakener () ;
@@ -107,24 +107,24 @@ let may_toggle_bootstrapped_network w =
 
 let may_activate_peer_validator w peer_id =
   let nv = Worker.state w in
-  try P2p.Peer_id.Table.find nv.active_peers peer_id
+  try P2p_peer.Table.find nv.active_peers peer_id
   with Not_found ->
     let pv =
       Peer_validator.create
         ~notify_new_block:(notify_new_block w)
         ~notify_bootstrapped: begin fun () ->
-          P2p.Peer_id.Table.add nv.bootstrapped_peers peer_id () ;
+          P2p_peer.Table.add nv.bootstrapped_peers peer_id () ;
           may_toggle_bootstrapped_network w
         end
         ~notify_termination: begin fun _pv ->
-          P2p.Peer_id.Table.remove nv.active_peers peer_id ;
+          P2p_peer.Table.remove nv.active_peers peer_id ;
-          P2p.Peer_id.Table.remove nv.bootstrapped_peers peer_id ;
+          P2p_peer.Table.remove nv.bootstrapped_peers peer_id ;
         end
         nv.parameters.peer_validator_limits
         nv.parameters.block_validator
         nv.parameters.net_db
         peer_id in
-    P2p.Peer_id.Table.add nv.active_peers peer_id pv ;
+    P2p_peer.Table.add nv.active_peers peer_id pv ;
     pv
 
 let may_switch_test_network w spawn_child block =
@@ -260,7 +260,7 @@ let on_close w =
   Lwt.join
     (Prevalidator.shutdown nv.prevalidator ::
      Lwt_utils.may ~f:(fun (_, shutdown) -> shutdown ()) nv.child ::
-     P2p.Peer_id.Table.fold
+     P2p_peer.Table.fold
        (fun _ pv acc -> (pv >>= Peer_validator.shutdown) :: acc)
        nv.active_peers []) >>= fun () ->
   Lwt.return_unit
@@ -280,9 +280,9 @@ let on_launch w _ parameters =
       bootstrapped_waiter ;
       bootstrapped = (parameters.limits.bootstrap_threshold <= 0) ;
       active_peers =
-        P2p.Peer_id.Table.create 50 ; (* TODO use `2 * max_connection` *)
+        P2p_peer.Table.create 50 ; (* TODO use `2 * max_connection` *)
       bootstrapped_peers =
-        P2p.Peer_id.Table.create 50 ; (* TODO use `2 * max_connection` *)
+        P2p_peer.Table.create 50 ; (* TODO use `2 * max_connection` *)
       child = None ;
       prevalidator } in
   if nv.bootstrapped then Lwt.wakeup_later bootstrapped_wakener () ;

src/lib_shell/node.mli

@@ -129,58 +129,56 @@ module RPC : sig
 
   module Network : sig
 
-    open P2p_types
+    val stat : t -> P2p_stat.t
-
-    val stat : t -> Stat.t
 
     val watch :
       t ->
-      P2p_types.Connection_pool_log_event.t Lwt_stream.t * Lwt_watcher.stopper
+      P2p_connection.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper
-    val connect : t -> Point.t -> float -> unit tzresult Lwt.t
+    val connect : t -> P2p_point.Id.t -> float -> unit tzresult Lwt.t
 
     module Connection : sig
-      val info : t -> Peer_id.t -> Connection_info.t option
+      val info : t -> P2p_peer.Id.t -> P2p_connection.Info.t option
-      val kick : t -> Peer_id.t -> bool -> unit Lwt.t
+      val kick : t -> P2p_peer.Id.t -> bool -> unit Lwt.t
-      val list : t -> Connection_info.t list
+      val list : t -> P2p_connection.Info.t list
       val count : t -> int
     end
 
     module Point : sig
 
       val info :
-        t -> Point.t -> P2p_types.Point_info.t option
+        t -> P2p_point.Id.t -> P2p_point.Info.t option
 
       val list :
-        ?restrict: P2p_types.Point_state.t list ->
+        ?restrict: P2p_point.State.t list ->
-        t -> (Point.t * P2p_types.Point_info.t) list
+        t -> (P2p_point.Id.t * P2p_point.Info.t) list
 
       val events :
-        ?max:int -> ?rev:bool -> t -> Point.t ->
+        ?max:int -> ?rev:bool -> t -> P2p_point.Id.t ->
-        P2p_connection_pool_types.Point_info.Event.t list
+        P2p_point.Pool_event.t list
 
       val watch :
-        t -> Point.t ->
+        t -> P2p_point.Id.t ->
-        P2p_connection_pool_types.Point_info.Event.t Lwt_stream.t * Lwt_watcher.stopper
+        P2p_point.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper
 
     end
 
     module Peer_id : sig
 
       val info :
-        t -> Peer_id.t -> P2p_types.Peer_info.t option
+        t -> P2p_peer.Id.t -> P2p_peer.Info.t option
 
       val list :
-        ?restrict: P2p_types.Peer_state.t list ->
+        ?restrict: P2p_peer.State.t list ->
-        t -> (Peer_id.t * P2p_types.Peer_info.t) list
+        t -> (P2p_peer.Id.t * P2p_peer.Info.t) list
 
       val events :
         ?max: int -> ?rev: bool ->
-        t -> Peer_id.t ->
+        t -> P2p_peer.Id.t ->
-        P2p_connection_pool_types.Peer_info.Event.t list
+        P2p_peer.Pool_event.t list
 
       val watch :
-        t -> Peer_id.t ->
+        t -> P2p_peer.Id.t ->
-        P2p_connection_pool_types.Peer_info.Event.t Lwt_stream.t * Lwt_watcher.stopper
+        P2p_peer.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper
 
     end
 

src/lib_shell/peer_validator.ml

@@ -12,13 +12,13 @@
 open Peer_validator_worker_state
 
 module Name = struct
-  type t = Net_id.t * P2p.Peer_id.t
+  type t = Net_id.t * P2p_peer.Id.t
   let encoding =
-    Data_encoding.tup2 Net_id.encoding P2p.Peer_id.encoding
+    Data_encoding.tup2 Net_id.encoding P2p_peer.Id.encoding
   let base = [ "peer_validator" ]
   let pp ppf (net, peer) =
     Format.fprintf ppf "%a:%a"
-      Net_id.pp_short net P2p.Peer_id.pp_short peer
+      Net_id.pp_short net P2p_peer.Id.pp_short peer
 end
 
 module Request = struct
@@ -57,7 +57,7 @@ module Types = struct
   }
 
   type state = {
-    peer_id: P2p.Peer_id.t ;
+    peer_id: P2p_peer.Id.t ;
     parameters : parameters ;
     mutable bootstrapped: bool ;
     mutable last_validated_head: Block_header.t ;
@@ -96,7 +96,7 @@ let bootstrap_new_branch w _ancestor _head unknown_prefix =
   let len = Block_locator_iterator.estimated_length unknown_prefix in
   debug w
     "validating new branch from peer %a (approx. %d blocks)"
-    P2p.Peer_id.pp_short pv.peer_id len ;
+    P2p_peer.Id.pp_short pv.peer_id len ;
   let pipeline =
     Bootstrap_pipeline.create
       ~notify_new_block:pv.parameters.notify_new_block
@@ -116,7 +116,7 @@ let bootstrap_new_branch w _ancestor _head unknown_prefix =
   set_bootstrapped pv ;
   debug w
     "done validating new branch from peer %a."
-    P2p.Peer_id.pp_short pv.peer_id ;
+    P2p_peer.Id.pp_short pv.peer_id ;
   return ()
 
 let validate_new_head w hash (header : Block_header.t) =
@@ -127,14 +127,14 @@ let validate_new_head w hash (header : Block_header.t) =
       debug w
         "missing predecessor for new head %a from peer %a"
         Block_hash.pp_short hash
-        P2p.Peer_id.pp_short pv.peer_id ;
+        P2p_peer.Id.pp_short pv.peer_id ;
       Distributed_db.Request.current_branch pv.parameters.net_db ~peer:pv.peer_id () ;
       return ()
   | true ->
       debug w
         "fetching operations for new head %a from peer %a"
         Block_hash.pp_short hash
-        P2p.Peer_id.pp_short pv.peer_id ;
+        P2p_peer.Id.pp_short pv.peer_id ;
       map_p
         (fun i ->
            Worker.protect w begin fun () ->
@@ -147,7 +147,7 @@ let validate_new_head w hash (header : Block_header.t) =
       debug w
         "requesting validation for new head %a from peer %a"
         Block_hash.pp_short hash
-        P2p.Peer_id.pp_short pv.peer_id ;
+        P2p_peer.Id.pp_short pv.peer_id ;
       Block_validator.validate
         ~notify_new_block:pv.parameters.notify_new_block
         pv.parameters.block_validator pv.parameters.net_db
@@ -155,7 +155,7 @@ let validate_new_head w hash (header : Block_header.t) =
       debug w
         "end of validation for new head %a from peer %a"
         Block_hash.pp_short hash
-        P2p.Peer_id.pp_short pv.peer_id ;
+        P2p_peer.Id.pp_short pv.peer_id ;
       set_bootstrapped pv ;
       return ()
 
@@ -170,7 +170,7 @@ let only_if_fitness_increases w distant_header cont =
     debug w
       "ignoring head %a with non increasing fitness from peer: %a."
       Block_hash.pp_short (Block_header.hash distant_header)
-      P2p.Peer_id.pp_short pv.peer_id ;
+      P2p_peer.Id.pp_short pv.peer_id ;
     (* Don't download a branch that cannot beat the current head. *)
     return ()
   end else cont ()
@@ -185,7 +185,7 @@ let may_validate_new_head w hash header =
           debug w
             "ignoring previously validated block %a from peer %a"
             Block_hash.pp_short hash
-            P2p.Peer_id.pp_short pv.peer_id ;
+            P2p_peer.Id.pp_short pv.peer_id ;
           set_bootstrapped pv ;
           pv.last_validated_head <- header ;
           return ()
@@ -193,7 +193,7 @@ let may_validate_new_head w hash header =
           debug w
             "ignoring known invalid block %a from peer %a"
             Block_hash.pp_short hash
-            P2p.Peer_id.pp_short pv.peer_id ;
+            P2p_peer.Id.pp_short pv.peer_id ;
           fail Known_invalid
     end
   | false ->
@@ -210,7 +210,7 @@ let may_validate_new_branch w distant_hash locator =
       debug w
         "ignoring branch %a without common ancestor from peer: %a."
         Block_hash.pp_short distant_hash
-        P2p.Peer_id.pp_short pv.peer_id ;
+        P2p_peer.Id.pp_short pv.peer_id ;
       fail Unknown_ancestor
   | Some (ancestor, unknown_prefix) ->
       bootstrap_new_branch w ancestor distant_header unknown_prefix
@@ -218,7 +218,7 @@ let may_validate_new_branch w distant_hash locator =
 let on_no_request w =
   let pv = Worker.state w in
   debug w "no new head from peer %a for %g seconds."
-    P2p.Peer_id.pp_short pv.peer_id
+    P2p_peer.Id.pp_short pv.peer_id
     pv.parameters.limits.new_head_request_timeout ;
   Distributed_db.Request.current_head pv.parameters.net_db ~peer:pv.peer_id () ;
   return ()
@@ -230,13 +230,13 @@ let on_request (type a) w (req : a Request.t) : a tzresult Lwt.t =
       debug w
         "processing new head %a from peer %a."
         Block_hash.pp_short hash
-        P2p.Peer_id.pp_short pv.peer_id ;
+        P2p_peer.Id.pp_short pv.peer_id ;
       may_validate_new_head w hash header
   | Request.New_branch (hash, locator) ->
       (* TODO penalize empty locator... ?? *)
       debug w "processing new branch %a from peer %a."
         Block_hash.pp_short hash
-        P2p.Peer_id.pp_short pv.peer_id ;
+        P2p_peer.Id.pp_short pv.peer_id ;
       may_validate_new_branch w hash locator
 
 let on_completion w r _ st =
@@ -252,7 +252,7 @@ let on_error w r st errs =
       (* TODO ban the peer_id... *)
       debug w
         "Terminating the validation worker for peer %a (kickban)."
-        P2p.Peer_id.pp_short pv.peer_id ;
+        P2p_peer.Id.pp_short pv.peer_id ;
       debug w "%a" Error_monad.pp_print_error errors ;
       Worker.trigger_shutdown w ;
       Worker.record_event w (Event.Request (r, st, Some errs)) ;
@@ -269,7 +269,7 @@ let on_error w r st errs =
           debug w
             "Terminating the validation worker for peer %a \
              (missing protocol %a)."
-            P2p.Peer_id.pp_short pv.peer_id
+            P2p_peer.Id.pp_short pv.peer_id
             Protocol_hash.pp_short protocol ;
           Worker.record_event w (Event.Request (r, st, Some errs)) ;
           Lwt.return (Error errs)

src/lib_shell/peer_validator.mli

@@ -17,7 +17,7 @@ type limits = {
   worker_limits: Worker_types.limits
 }
 
-val peer_id: t -> P2p.Peer_id.t
+val peer_id: t -> P2p_peer.Id.t
 val bootstrapped: t -> bool
 val current_head: t -> Block_header.t
 
@@ -27,13 +27,13 @@ val create:
   ?notify_termination: (unit -> unit) ->
   limits ->
   Block_validator.t ->
-  Distributed_db.net_db -> P2p.Peer_id.t -> t Lwt.t
+  Distributed_db.net_db -> P2p_peer.Id.t -> t Lwt.t
 val shutdown: t -> unit Lwt.t
 
 val notify_branch: t -> Block_locator.t -> unit
 val notify_head: t -> Block_header.t -> unit
 
-val running_workers: unit -> ((Net_id.t * P2p.Peer_id.t) * t) list
+val running_workers: unit -> ((Net_id.t * P2p_peer.Id.t) * t) list
 val status: t -> Worker_types.worker_status
 
 val current_request : t -> (Time.t * Time.t * Peer_validator_worker_state.Request.view) option

src/lib_shell/prevalidator.mli

@@ -40,7 +40,7 @@ type error += Closed of Net_id.t
 
 val create: limits -> Distributed_db.net_db -> t Lwt.t
 val shutdown: t -> unit Lwt.t
-val notify_operations: t -> P2p.Peer_id.t -> Mempool.t -> unit
+val notify_operations: t -> P2p_peer.Id.t -> Mempool.t -> unit
 val inject_operation: t -> Operation.t -> unit tzresult Lwt.t
 val flush: t -> Block_hash.t -> unit tzresult Lwt.t
 val timestamp: t -> Time.t

src/lib_shell/protocol_validator.mli

@@ -28,19 +28,19 @@ val shutdown: t -> unit Lwt.t
 
 val fetch_and_compile_protocol:
   t ->
-  ?peer:P2p.Peer_id.t ->
+  ?peer:P2p_peer.Id.t ->
   ?timeout:float ->
   Protocol_hash.t -> State.Registred_protocol.t tzresult Lwt.t
 
 val fetch_and_compile_protocols:
   t ->
-  ?peer:P2p.Peer_id.t ->
+  ?peer:P2p_peer.Id.t ->
   ?timeout:float ->
   State.Block.t -> unit tzresult Lwt.t
 
 val prefetch_and_compile_protocols:
   t ->
-  ?peer:P2p.Peer_id.t ->
+  ?peer:P2p_peer.Id.t ->
   ?timeout:float ->
   State.Block.t -> unit
 

src/lib_shell_services/block_validator_worker_state.ml

@@ -11,7 +11,7 @@ module Request = struct
   type view = {
     net_id : Net_id.t ;
     block : Block_hash.t ;
-    peer : P2p_types.Peer_id.t option ;
+    peer : P2p_peer.Id.t option ;
   }
   let encoding =
     let open Data_encoding in
@@ -21,7 +21,7 @@ module Request = struct
       (obj3
          (req "block" Block_hash.encoding)
          (req "net_id" Net_id.encoding)
-         (opt "peer" P2p_types.Peer_id.encoding))
+         (opt "peer" P2p_peer.Id.encoding))
 
   let pp ppf { net_id ; block ; peer } =
     Format.fprintf ppf "Validation of %a (net: %a)"
@@ -31,7 +31,7 @@ module Request = struct
     | None -> ()
     | Some peer ->
         Format.fprintf ppf "from peer %a"
-          P2p_types.Peer_id.pp_short peer
+          P2p_peer.Id.pp_short peer
 end
 
 module Event = struct

src/lib_shell_services/block_validator_worker_state.mli

@@ -11,7 +11,7 @@ module Request : sig
   type view = {
     net_id : Net_id.t ;
     block : Block_hash.t ;
-    peer: P2p_types.Peer_id.t option ;
+    peer: P2p_peer.Id.t option ;
   }
   val encoding : view Data_encoding.encoding
   val pp : Format.formatter -> view -> unit

src/lib_shell_services/net_validator_worker_state.ml

@@ -89,8 +89,8 @@ end
 
 module Worker_state = struct
   type view =
-    { active_peers : P2p_types.Peer_id.t list ;
+    { active_peers : P2p_peer.Id.t list ;
-      bootstrapped_peers : P2p_types.Peer_id.t list ;
+      bootstrapped_peers : P2p_peer.Id.t list ;
       bootstrapped : bool }
   let encoding =
     let open Data_encoding in
@@ -101,8 +101,8 @@ module Worker_state = struct
          { bootstrapped ; bootstrapped_peers ; active_peers })
       (obj3
          (req "bootstrapped" bool)
-         (req "bootstrapped_peers" (list P2p_types.Peer_id.encoding))
+         (req "bootstrapped_peers" (list P2p_peer.Id.encoding))
-         (req "active_peers" (list P2p_types.Peer_id.encoding)))
+         (req "active_peers" (list P2p_peer.Id.encoding)))
 
   let pp ppf { bootstrapped ; bootstrapped_peers ; active_peers } =
     Format.fprintf ppf
@@ -110,8 +110,8 @@ module Worker_state = struct
        @[<v 2>Active peers:%a@]@,\
        @[<v 2>Bootstrapped peers:%a@]@]"
       (if bootstrapped then "" else " not yet")
-      (fun ppf -> List.iter (Format.fprintf ppf "@,- %a" P2p_types.Peer_id.pp))
+      (fun ppf -> List.iter (Format.fprintf ppf "@,- %a" P2p_peer.Id.pp))
       active_peers
-      (fun ppf -> List.iter (Format.fprintf ppf "@,- %a" P2p_types.Peer_id.pp))
+      (fun ppf -> List.iter (Format.fprintf ppf "@,- %a" P2p_peer.Id.pp))
       bootstrapped_peers
 end

src/lib_shell_services/net_validator_worker_state.mli

@@ -32,8 +32,8 @@ end
 
 module Worker_state : sig
   type view =
-    { active_peers : P2p_types.Peer_id.t list ;
+    { active_peers : P2p_peer.Id.t list ;
-      bootstrapped_peers : P2p_types.Peer_id.t list ;
+      bootstrapped_peers : P2p_peer.Id.t list ;
       bootstrapped : bool }
   val encoding : view Data_encoding.encoding
   val pp : Format.formatter -> view -> unit

src/lib_shell_services/prevalidator_worker_state.ml

@@ -10,7 +10,7 @@
 module Request = struct
   type 'a t =
     | Flush : Block_hash.t -> unit t
-    | Notify : P2p_types.Peer_id.t * Mempool.t -> unit t
+    | Notify : P2p_peer.Id.t * Mempool.t -> unit t
     | Inject : Operation.t -> unit tzresult t
     | Arrived : Operation_hash.t * Operation.t -> unit t
     | Advertise : unit t
@@ -30,7 +30,7 @@ module Request = struct
         case (Tag 1)
           (obj3
              (req "request" (constant "notify"))
-             (req "peer" P2p_types.Peer_id.encoding)
+             (req "peer" P2p_peer.Id.encoding)
              (req "mempool" Mempool.encoding))
           (function View (Notify (peer, mempool)) -> Some ((), peer, mempool) | _ -> None)
           (fun ((), peer, mempool) -> View (Notify (peer, mempool))) ;
@@ -58,7 +58,7 @@ module Request = struct
           Block_hash.pp hash
     | Notify (id, { Mempool.known_valid ; pending }) ->
         Format.fprintf ppf "@[<v 2>notified by %a of operations"
-          P2p_types.Peer_id.pp id ;
+          P2p_peer.Id.pp id ;
         List.iter
           (fun oph ->
              Format.fprintf ppf "@,%a (applied)"

src/lib_shell_services/prevalidator_worker_state.mli

@@ -10,7 +10,7 @@
 module Request : sig
   type 'a t =
     | Flush : Block_hash.t -> unit t
-    | Notify : P2p_types.Peer_id.t * Mempool.t -> unit t
+    | Notify : P2p_peer.Id.t * Mempool.t -> unit t
     | Inject : Operation.t -> unit tzresult t
     | Arrived : Operation_hash.t * Operation.t -> unit t
     | Advertise : unit t

src/lib_shell_services/shell_services.ml

@@ -558,14 +558,14 @@ module Workers = struct
         ~construct:Net_id.to_b58check
         ()
 
-    let (peer_id_arg : P2p_types.Peer_id.t RPC_arg.t) =
+    let (peer_id_arg : P2p_peer.Id.t RPC_arg.t) =
       RPC_arg.make
         ~name:"peer_id"
         ~descr:"The peer identifier of whom the prevalidator is responsible."
         ~destruct:(fun s -> try
-                      Ok (P2p_types.Peer_id.of_b58check_exn s)
+                      Ok (P2p_peer.Id.of_b58check_exn s)
                     with Failure msg -> Error msg)
-        ~construct:P2p_types.Peer_id.to_b58check
+        ~construct:P2p_peer.Id.to_b58check
         ()
 
     let list =
@@ -577,7 +577,7 @@ module Workers = struct
         ~output:
           (list
              (obj2
-                (req "peer_id" P2p_types.Peer_id.encoding)
+                (req "peer_id" P2p_peer.Id.encoding)
                 (req "status" (Worker_types.worker_status_encoding RPC_error.encoding))))
         RPC_path.(root / "workers" / "peer_validators" /: net_id_arg)
 

src/lib_shell_services/shell_services.mli

@@ -201,11 +201,11 @@ module Workers : sig
     val list :
       ([ `POST ],  unit,
        unit * Net_id.t, unit, unit,
-       (P2p_types.Peer_id.t * Worker_types.worker_status) list, unit) RPC_service.t
+       (P2p_peer.Id.t * Worker_types.worker_status) list, unit) RPC_service.t
 
     val state :
       ([ `POST ], unit,
-       (unit * Net_id.t) * P2p_types.Peer_id.t, unit, unit,
+       (unit * Net_id.t) * P2p_peer.Id.t, unit, unit,
        (Request.view, Event.t) Worker_types.full_status, unit)
         RPC_service.t
 

test/p2p/jbuild

@@ -1,8 +1,8 @@
 (jbuild_version 1)
 
 (executables
- ((names (test_p2p_connection
+ ((names (test_p2p_socket
-          test_p2p_connection_pool
+          test_p2p_pool
           test_p2p_io_scheduler))
   (libraries (tezos-base
               tezos-p2p-services
@@ -18,17 +18,17 @@
 
 (alias
  ((name buildtest)
-  (deps (test_p2p_connection.exe
+  (deps (test_p2p_socket.exe
-         test_p2p_connection_pool.exe
+         test_p2p_pool.exe
          test_p2p_io_scheduler.exe))))
 
 (alias
- ((name runtest_p2p_connection)
+ ((name runtest_p2p_socket)
-  (action (run ${exe:test_p2p_connection.exe} -v))))
+  (action (run ${exe:test_p2p_socket.exe} -v))))
 
 (alias
- ((name runtest_p2p_connection_pool)
+ ((name runtest_p2p_pool)
-  (action (run ${exe:test_p2p_connection_pool.exe} --clients 10 --repeat 5 -v))))
+  (action (run ${exe:test_p2p_pool.exe} --clients 10 --repeat 5 -v))))
 
 (alias
  ((name runtest_p2p_io_scheduler)
@@ -40,8 +40,8 @@
 
 (alias
  ((name runtest)
-  (deps ((alias runtest_p2p_connection)
+  (deps ((alias runtest_p2p_socket)
-         (alias runtest_p2p_connection_pool)
+         (alias runtest_p2p_pool)
          (alias runtest_p2p_io_scheduler)))))
 
 (alias

test/p2p/test_p2p_io_scheduler.ml

@@ -7,7 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open P2p_types
 include Logging.Make (struct let name = "test-p2p-io-scheduler" end)
 
 exception Error of error list
@@ -89,18 +88,18 @@ let server
       ~read_buffer_size
       () in
   Moving_average.on_update begin fun () ->
-    log_notice "Stat: %a" Stat.pp (P2p_io_scheduler.global_stat sched) ;
+    log_notice "Stat: %a" P2p_stat.pp (P2p_io_scheduler.global_stat sched) ;
     if display_client_stat then
       P2p_io_scheduler.iter_connection sched
         (fun id conn ->
-           log_notice " client(%d) %a" id Stat.pp (P2p_io_scheduler.stat conn)) ;
+           log_notice " client(%d) %a" id P2p_stat.pp (P2p_io_scheduler.stat conn)) ;
   end ;
   (* Accept and read message until the connection is closed. *)
   accept_n main_socket n >>=? fun conns ->
   let conns = List.map (P2p_io_scheduler.register sched) conns in
   Lwt.join (List.map receive conns) >>= fun () ->
   iter_p P2p_io_scheduler.close conns >>=? fun () ->
-  log_notice "OK %a" Stat.pp (P2p_io_scheduler.global_stat sched) ;
+  log_notice "OK %a" P2p_stat.pp (P2p_io_scheduler.global_stat sched) ;
   return ()
 
 let max_size ?max_upload_speed () =
@@ -131,7 +130,7 @@ let client ?max_upload_speed ?write_queue_size addr port time _n =
              Lwt_unix.sleep time >>= return ] >>=? fun () ->
   P2p_io_scheduler.close conn >>=? fun () ->
   let stat = P2p_io_scheduler.stat conn in
-  lwt_log_notice "Client OK %a" Stat.pp stat >>= fun () ->
+  lwt_log_notice "Client OK %a" P2p_stat.pp stat >>= fun () ->
   return ()
 
 let run

test/p2p/test_p2p_pool.ml

@@ -7,16 +7,15 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open P2p_types
 include Logging.Make (struct let name = "test.p2p.connection-pool" end)
 
 type message =
   | Ping
 
 
-let msg_config : message P2p_connection_pool.message_config = {
+let msg_config : message P2p_pool.message_config = {
   encoding = [
-    P2p_connection_pool.Encoding {
+    P2p_pool.Encoding {
       tag = 0x10 ;
       encoding = Data_encoding.empty ;
       wrap = (function () -> Ping) ;
@@ -24,12 +23,12 @@ let msg_config : message P2p_connection_pool.message_config = {
       max_length = None ;
     } ;
   ] ;
-  versions =  Version.[ { name = "TEST" ; major = 0 ; minor = 0 } ] ;
+  versions =  P2p_version.[ { name = "TEST" ; major = 0 ; minor = 0 } ] ;
 }
 
 type metadata = unit
 
-let meta_config : metadata P2p_connection_pool.meta_config = {
+let meta_config : metadata P2p_pool.meta_config = {
   encoding = Data_encoding.empty ;
   initial = () ;
   score = fun () -> 0. ;
@@ -59,9 +58,9 @@ let sync_nodes nodes =
 let detach_node f points n =
   let (addr, port), points = List.select n points in
   let proof_of_work_target = Crypto_box.make_target 0. in
-  let identity = Identity.generate proof_of_work_target in
+  let identity = P2p_identity.generate proof_of_work_target in
   let nb_points = List.length points in
-  let config = P2p_connection_pool.{
+  let config = P2p_pool.{
       identity ;
       proof_of_work_target ;
       trusted_points = points ;
@@ -83,10 +82,10 @@ let detach_node f points n =
       binary_chunks_size = None
     } in
   Process.detach
-    ~prefix:(Format.asprintf "%a: " Peer_id.pp_short identity.peer_id)
+    ~prefix:(Format.asprintf "%a: " P2p_peer.Id.pp_short identity.peer_id)
     begin fun channel ->
       let sched = P2p_io_scheduler.create ~read_buffer_size:(1 lsl 12) () in
-      P2p_connection_pool.create
+      P2p_pool.create
         config meta_config msg_config sched >>= fun pool ->
       P2p_welcome.run ~backlog:10 pool ~addr port >>= fun welcome ->
       lwt_log_info "Node ready (port: %d)" port >>= fun () ->
@@ -94,7 +93,7 @@ let detach_node f points n =
       f channel pool points >>=? fun () ->
       lwt_log_info "Shutting down..." >>= fun () ->
       P2p_welcome.shutdown welcome >>= fun () ->
-      P2p_connection_pool.destroy pool >>= fun () ->
+      P2p_pool.destroy pool >>= fun () ->
       P2p_io_scheduler.shutdown sched >>= fun () ->
       lwt_log_info "Bye." >>= fun () ->
       return ()
@@ -112,34 +111,34 @@ type error += Connect | Write | Read
 module Simple = struct
 
   let rec connect ~timeout pool point =
-    lwt_log_info "Connect to %a" Point.pp point >>= fun () ->
+    lwt_log_info "Connect to %a" P2p_point.Id.pp point >>= fun () ->
-    P2p_connection_pool.connect pool point ~timeout >>= function
+    P2p_pool.connect pool point ~timeout >>= function
-    | Error [P2p_connection_pool.Connected] -> begin
+    | Error [P2p_pool.Connected] -> begin
-        match P2p_connection_pool.Connection.find_by_point pool point with
+        match P2p_pool.Connection.find_by_point pool point with
         | Some conn -> return conn
         | None -> failwith "Woops..."
       end
-    | Error ([ P2p_connection_pool.Connection_refused
+    | Error ([ P2p_pool.Connection_refused
-             | P2p_connection_pool.Pending_connection
+             | P2p_pool.Pending_connection
-             | P2p_connection.Rejected
+             | P2p_socket.Rejected
              | Lwt_utils.Canceled
              | Lwt_utils.Timeout
-             | P2p_connection_pool.Rejected _ as err ]) ->
+             | P2p_pool.Rejected _ as err ]) ->
         lwt_log_info "Connection to %a failed (%a)"
-          Point.pp point
+          P2p_point.Id.pp point
           (fun ppf err -> match err with
-             | P2p_connection_pool.Connection_refused ->
+             | P2p_pool.Connection_refused ->
                  Format.fprintf ppf "connection refused"
-             | P2p_connection_pool.Pending_connection ->
+             | P2p_pool.Pending_connection ->
                  Format.fprintf ppf "pending connection"
-             | P2p_connection.Rejected ->
+             | P2p_socket.Rejected ->
                  Format.fprintf ppf "rejected"
              | Lwt_utils.Canceled ->
                  Format.fprintf ppf "canceled"
              | Lwt_utils.Timeout ->
                  Format.fprintf ppf "timeout"
-             | P2p_connection_pool.Rejected peer ->
+             | P2p_pool.Rejected peer ->
-                 Format.fprintf ppf "rejected (%a)" Peer_id.pp peer
+                 Format.fprintf ppf "rejected (%a)" P2p_peer.Id.pp peer
              | _ -> assert false) err >>= fun () ->
         Lwt_unix.sleep (0.5 +. Random.float 2.) >>= fun () ->
         connect ~timeout pool point
@@ -151,18 +150,18 @@ module Simple = struct
   let write_all conns msg  =
     iter_p
       (fun conn ->
-         trace Write @@ P2p_connection_pool.write_sync conn msg)
+         trace Write @@ P2p_pool.write_sync conn msg)
       conns
 
   let read_all conns =
     iter_p
       (fun conn ->
-         trace Read @@ P2p_connection_pool.read conn >>=? fun Ping ->
+         trace Read @@ P2p_pool.read conn >>=? fun Ping ->
          return ())
       conns
 
   let close_all conns =
-    Lwt_list.iter_p P2p_connection_pool.disconnect conns
+    Lwt_list.iter_p P2p_pool.disconnect conns
 
   let node channel pool points =
     connect_all ~timeout:2. pool points >>=? fun conns ->
@@ -187,10 +186,10 @@ module Random_connections = struct
   let rec connect_random pool total rem point n =
     Lwt_unix.sleep (0.2 +. Random.float 1.0) >>= fun () ->
     (trace Connect @@ Simple.connect ~timeout:2. pool point) >>=? fun conn ->
-    (trace Write @@ P2p_connection_pool.write conn Ping) >>= fun _ ->
+    (trace Write @@ P2p_pool.write conn Ping) >>= fun _ ->
-    (trace Read @@ P2p_connection_pool.read conn) >>=? fun Ping ->
+    (trace Read @@ P2p_pool.read conn) >>=? fun Ping ->
     Lwt_unix.sleep (0.2 +. Random.float 1.0) >>= fun () ->
-    P2p_connection_pool.disconnect conn >>= fun () ->
+    P2p_pool.disconnect conn >>= fun () ->
     begin
       decr rem ;
       if !rem mod total = 0 then
@@ -231,7 +230,7 @@ module Garbled = struct
     let bad_msg = MBytes.of_string (String.make 16 '\000') in
     iter_p
       (fun conn ->
-         trace Write @@ P2p_connection_pool.raw_write_sync conn bad_msg)
+         trace Write @@ P2p_pool.raw_write_sync conn bad_msg)
       conns
 
   let node ch pool points =

test/p2p/test_p2p_socket.ml

@@ -10,20 +10,19 @@
 (* TODO Use Kaputt on the client side and remove `assert` from the
         server. *)
 
-open P2p_types
 include Logging.Make (struct let name = "test.p2p.connection" end)
 
 let default_addr = Ipaddr.V6.localhost
 
 let proof_of_work_target = Crypto_box.make_target 16.
-let id1 = Identity.generate proof_of_work_target
+let id1 = P2p_identity.generate proof_of_work_target
-let id2 = Identity.generate proof_of_work_target
+let id2 = P2p_identity.generate proof_of_work_target
 
 let id0 =
   (* Luckilly, this will be an insuficient proof of work! *)
-  Identity.generate (Crypto_box.make_target 0.)
+  P2p_identity.generate (Crypto_box.make_target 0.)
 
-let versions = Version.[{ name = "TEST" ; minor = 0 ; major = 0 }]
+let versions = P2p_version.[{ name = "TEST" ; minor = 0 ; major = 0 }]
 
 let random_bytes len =
   let msg = MBytes.create len in
@@ -104,7 +103,7 @@ let raw_accept sched main_socket =
 
 let accept sched main_socket =
   raw_accept sched main_socket >>= fun (fd, point) ->
-  P2p_connection.authenticate
+  P2p_socket.authenticate
     ~proof_of_work_target
     ~incoming:true fd point id1 versions
 
@@ -118,11 +117,11 @@ let raw_connect sched addr port =
 
 let connect sched addr port id =
   raw_connect sched addr port >>= fun fd ->
-  P2p_connection.authenticate
+  P2p_socket.authenticate
     ~proof_of_work_target
     ~incoming:false fd (addr, port) id versions >>=? fun (info, auth_fd) ->
   _assert (not info.incoming) __LOC__ "" >>=? fun () ->
-  _assert (Peer_id.compare info.peer_id id1.peer_id = 0)
+  _assert (P2p_peer.Id.compare info.peer_id id1.peer_id = 0)
     __LOC__ "" >>=? fun () ->
   return auth_fd
 
@@ -134,7 +133,7 @@ let is_connection_closed = function
       false
 
 let is_decoding_error = function
-  | Error [P2p_connection.Decoding_error] -> true
+  | Error [P2p_socket.Decoding_error] -> true
   | Ok _ -> false
   | Error err ->
       log_notice "Error: %a" pp_print_error err ;
@@ -167,7 +166,7 @@ module Kick = struct
   let encoding = Data_encoding.bytes
 
   let is_rejected = function
-    | Error [P2p_connection.Rejected] -> true
+    | Error [P2p_socket.Rejected] -> true
     | Ok _ -> false
     | Error err ->
         log_notice "Error: %a" pp_print_error err ;
@@ -176,14 +175,14 @@ module Kick = struct
   let server _ch sched socket =
     accept sched socket >>=? fun (info, auth_fd) ->
     _assert (info.incoming) __LOC__ "" >>=? fun () ->
-    _assert (Peer_id.compare info.peer_id id2.peer_id = 0)
+    _assert (P2p_peer.Id.compare info.peer_id id2.peer_id = 0)
       __LOC__ "" >>=? fun () ->
-    P2p_connection.kick auth_fd >>= fun () ->
+    P2p_socket.kick auth_fd >>= fun () ->
     return ()
 
   let client _ch sched addr port =
     connect sched addr port id2 >>=? fun auth_fd ->
-    P2p_connection.accept auth_fd encoding >>= fun conn ->
+    P2p_socket.accept auth_fd encoding >>= fun conn ->
     _assert (is_rejected conn) __LOC__ "" >>=? fun () ->
     return ()
 
@@ -197,13 +196,13 @@ module Kicked = struct
 
   let server _ch sched socket =
     accept sched socket >>=? fun (_info, auth_fd) ->
-    P2p_connection.accept auth_fd encoding >>= fun conn ->
+    P2p_socket.accept auth_fd encoding >>= fun conn ->
     _assert (Kick.is_rejected conn) __LOC__ "" >>=? fun () ->
     return ()
 
   let client _ch sched addr port =
     connect sched addr port id2 >>=? fun auth_fd ->
-    P2p_connection.kick auth_fd >>= fun () ->
+    P2p_socket.kick auth_fd >>= fun () ->
     return ()
 
   let run _dir = run_nodes client server
@@ -219,22 +218,22 @@ module Simple_message = struct
 
   let server ch sched socket =
     accept sched socket >>=? fun (_info, auth_fd) ->
-    P2p_connection.accept auth_fd encoding >>=? fun conn ->
+    P2p_socket.accept auth_fd encoding >>=? fun conn ->
-    P2p_connection.write_sync conn simple_msg >>=? fun () ->
+    P2p_socket.write_sync conn simple_msg >>=? fun () ->
-    P2p_connection.read conn >>=? fun (_msg_size, msg) ->
+    P2p_socket.read conn >>=? fun (_msg_size, msg) ->
     _assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () ->
     sync ch >>=? fun () ->
-    P2p_connection.close conn >>= fun _stat ->
+    P2p_socket.close conn >>= fun _stat ->
     return ()
 
   let client ch sched addr port =
     connect sched addr port id2 >>=? fun auth_fd ->
-    P2p_connection.accept auth_fd encoding >>=? fun conn ->
+    P2p_socket.accept auth_fd encoding >>=? fun conn ->
-    P2p_connection.write_sync conn simple_msg2 >>=? fun () ->
+    P2p_socket.write_sync conn simple_msg2 >>=? fun () ->
-    P2p_connection.read conn >>=? fun (_msg_size, msg) ->
+    P2p_socket.read conn >>=? fun (_msg_size, msg) ->
     _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () ->
     sync ch >>=? fun () ->
-    P2p_connection.close conn >>= fun _stat ->
+    P2p_socket.close conn >>= fun _stat ->
     return ()
 
   let run _dir = run_nodes client server
@@ -250,24 +249,24 @@ module Chunked_message = struct
 
   let server ch sched socket =
     accept sched socket >>=? fun (_info, auth_fd) ->
-    P2p_connection.accept
+    P2p_socket.accept
       ~binary_chunks_size:21 auth_fd encoding >>=? fun conn ->
-    P2p_connection.write_sync conn simple_msg >>=? fun () ->
+    P2p_socket.write_sync conn simple_msg >>=? fun () ->
-    P2p_connection.read conn >>=? fun (_msg_size, msg) ->
+    P2p_socket.read conn >>=? fun (_msg_size, msg) ->
     _assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () ->
     sync ch >>=? fun () ->
-    P2p_connection.close conn >>= fun _stat ->
+    P2p_socket.close conn >>= fun _stat ->
     return ()
 
   let client ch sched addr port =
     connect sched addr port id2 >>=? fun auth_fd ->
-    P2p_connection.accept
+    P2p_socket.accept
       ~binary_chunks_size:21 auth_fd encoding >>=? fun conn ->
-    P2p_connection.write_sync conn simple_msg2 >>=? fun () ->
+    P2p_socket.write_sync conn simple_msg2 >>=? fun () ->
-    P2p_connection.read conn >>=? fun (_msg_size, msg) ->
+    P2p_socket.read conn >>=? fun (_msg_size, msg) ->
     _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () ->
     sync ch >>=? fun () ->
-    P2p_connection.close conn >>= fun _stat ->
+    P2p_socket.close conn >>= fun _stat ->
     return ()
 
   let run _dir = run_nodes client server
@@ -283,22 +282,22 @@ module Oversized_message = struct
 
   let server ch sched socket =
     accept sched socket >>=? fun (_info, auth_fd) ->
-    P2p_connection.accept auth_fd encoding >>=? fun conn ->
+    P2p_socket.accept auth_fd encoding >>=? fun conn ->
-    P2p_connection.write_sync conn simple_msg >>=? fun () ->
+    P2p_socket.write_sync conn simple_msg >>=? fun () ->
-    P2p_connection.read conn >>=? fun (_msg_size, msg) ->
+    P2p_socket.read conn >>=? fun (_msg_size, msg) ->
     _assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () ->
     sync ch >>=? fun () ->
-    P2p_connection.close conn >>= fun _stat ->
+    P2p_socket.close conn >>= fun _stat ->
     return ()
 
   let client ch sched addr port =
     connect sched addr port id2 >>=? fun auth_fd ->
-    P2p_connection.accept auth_fd encoding >>=? fun conn ->
+    P2p_socket.accept auth_fd encoding >>=? fun conn ->
-    P2p_connection.write_sync conn simple_msg2 >>=? fun () ->
+    P2p_socket.write_sync conn simple_msg2 >>=? fun () ->
-    P2p_connection.read conn >>=? fun (_msg_size, msg) ->
+    P2p_socket.read conn >>=? fun (_msg_size, msg) ->
     _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () ->
     sync ch >>=? fun () ->
-    P2p_connection.close conn >>= fun _stat ->
+    P2p_socket.close conn >>= fun _stat ->
     return ()
 
   let run _dir = run_nodes client server
@@ -313,18 +312,18 @@ module Close_on_read = struct
 
   let server ch sched socket =
     accept sched socket >>=? fun (_info, auth_fd) ->
-    P2p_connection.accept auth_fd encoding >>=? fun conn ->
+    P2p_socket.accept auth_fd encoding >>=? fun conn ->
     sync ch >>=? fun () ->
-    P2p_connection.close conn >>= fun _stat ->
+    P2p_socket.close conn >>= fun _stat ->
     return ()
 
   let client ch sched addr port =
     connect sched addr port id2 >>=? fun auth_fd ->
-    P2p_connection.accept auth_fd encoding >>=? fun conn ->
+    P2p_socket.accept auth_fd encoding >>=? fun conn ->
     sync ch >>=? fun () ->
-    P2p_connection.read conn >>= fun err ->
+    P2p_socket.read conn >>= fun err ->
     _assert (is_connection_closed err) __LOC__ "" >>=? fun () ->
-    P2p_connection.close conn >>= fun _stat ->
+    P2p_socket.close conn >>= fun _stat ->
     return ()
 
   let run _dir = run_nodes client server
@@ -339,19 +338,19 @@ module Close_on_write = struct
 
   let server ch sched socket =
     accept sched socket >>=? fun (_info, auth_fd) ->
-    P2p_connection.accept auth_fd encoding >>=? fun conn ->
+    P2p_socket.accept auth_fd encoding >>=? fun conn ->
-    P2p_connection.close conn >>= fun _stat ->
+    P2p_socket.close conn >>= fun _stat ->
     sync ch >>=? fun ()->
     return ()
 
   let client ch sched addr port =
     connect sched addr port id2 >>=? fun auth_fd ->
-    P2p_connection.accept auth_fd encoding >>=? fun conn ->
+    P2p_socket.accept auth_fd encoding >>=? fun conn ->
     sync ch >>=? fun ()->
     Lwt_unix.sleep 0.1 >>= fun () ->
-    P2p_connection.write_sync conn simple_msg >>= fun err ->
+    P2p_socket.write_sync conn simple_msg >>= fun err ->
     _assert (is_connection_closed err) __LOC__ "" >>=? fun () ->
-    P2p_connection.close conn >>= fun _stat ->
+    P2p_socket.close conn >>= fun _stat ->
     return ()
 
   let run _dir = run_nodes client server
@@ -376,19 +375,19 @@ module Garbled_data = struct
 
   let server _ch sched socket =
     accept sched socket >>=? fun (_info, auth_fd) ->
-    P2p_connection.accept auth_fd encoding >>=? fun conn ->
+    P2p_socket.accept auth_fd encoding >>=? fun conn ->
-    P2p_connection.raw_write_sync conn garbled_msg >>=? fun () ->
+    P2p_socket.raw_write_sync conn garbled_msg >>=? fun () ->
-    P2p_connection.read conn >>= fun err ->
+    P2p_socket.read conn >>= fun err ->
     _assert (is_connection_closed err) __LOC__ "" >>=? fun () ->
-    P2p_connection.close conn >>= fun _stat ->
+    P2p_socket.close conn >>= fun _stat ->
     return ()
 
   let client _ch sched addr port =
     connect sched addr port id2 >>=? fun auth_fd ->
-    P2p_connection.accept auth_fd encoding >>=? fun conn ->
+    P2p_socket.accept auth_fd encoding >>=? fun conn ->
-    P2p_connection.read conn >>= fun err ->
+    P2p_socket.read conn >>= fun err ->
     _assert (is_decoding_error err) __LOC__ "" >>=? fun () ->
-    P2p_connection.close conn >>= fun _stat ->
+    P2p_socket.close conn >>= fun _stat ->
     return ()
 
   let run _dir = run_nodes client server