Jbuilder: split lib_node_net

- `lib_node_p2p_base`: Base datatypes for the P2P layers - `lib_node_services`: RPC service definitions (depends on `node_p2p_base`) - `lib_node_http`: RPC http server - `lib_node_p2p`: the P2P workers
2017-11-27 06:13:12 +01:00 · 2017-11-27 06:13:12 +01:00 · 82857dcb94
commit 82857dcb94
parent 3f354e7d78
69 changed files with 1603 additions and 1323 deletions
--- a/bin_node/jbuild
+++ b/bin_node/jbuild
@ -5,7 +5,9 @@
  (public_name tezos-node)
  (libraries (tezos-base
              tezos-node-updater
-              tezos-node-net
+              tezos-node-p2p-base
+              tezos-node-p2p
+              tezos-node-http
              tezos-node-shell
              tezos-embedded-protocol-genesis
              tezos-embedded-protocol-demo
@ -15,7 +17,9 @@
                    -safe-string
                    -open Tezos_base__TzPervasives
                    -open Tezos_node_updater
-                    -open Tezos_node_net
+                    -open Tezos_node_p2p_base
+                    -open Tezos_node_p2p
+                    -open Tezos_node_http
                    -open Tezos_node_shell
                    -linkall))))

--- a/lib_base/jbuild
+++ b/lib_base/jbuild
@ -13,8 +13,9 @@
              tezos-crypto
              tezos-data-encoding
              tezos-error-monad
+              calendar
              ezjsonm
-              calendar))))
+              mtime.clock.os))))

 (alias
 ((name runtest_indent)
--- a/lib_base/preapply_result.ml
+++ b/lib_base/preapply_result.ml
@ -0,0 +1,76 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type 'error t = {
+  applied: (Operation_hash.t * Operation.t) list;
+  refused: (Operation.t * 'error list) Operation_hash.Map.t;
+  branch_refused: (Operation.t * 'error list) Operation_hash.Map.t;
+  branch_delayed: (Operation.t * 'error list) Operation_hash.Map.t;
+}
+
+let empty = {
+  applied = [] ;
+  refused = Operation_hash.Map.empty ;
+  branch_refused = Operation_hash.Map.empty ;
+  branch_delayed = Operation_hash.Map.empty ;
+}
+
+let map f r = {
+  applied = r.applied;
+  refused = Operation_hash.Map.map f r.refused ;
+  branch_refused = Operation_hash.Map.map f r.branch_refused ;
+  branch_delayed = Operation_hash.Map.map f r.branch_delayed ;
+}
+
+let encoding error_encoding =
+  let open Data_encoding in
+  let operation_encoding =
+    merge_objs
+      (obj1 (req "hash" Operation_hash.encoding))
+      (dynamic_size Operation.encoding) in
+  let refused_encoding =
+    merge_objs
+      (obj1 (req "hash" Operation_hash.encoding))
+      (merge_objs
+         (dynamic_size Operation.encoding)
+         (obj1 (req "error" error_encoding))) in
+  let build_list map = Operation_hash.Map.bindings map in
+  let build_map list =
+    List.fold_right
+      (fun (k, e) m -> Operation_hash.Map.add k e m)
+      list Operation_hash.Map.empty in
+  conv
+    (fun { applied ; refused ; branch_refused ; branch_delayed } ->
+       (applied, build_list refused,
+        build_list branch_refused, build_list branch_delayed))
+    (fun (applied, refused, branch_refused, branch_delayed) ->
+       let refused = build_map refused in
+       let branch_refused = build_map branch_refused in
+       let branch_delayed = build_map branch_delayed in
+       { applied ; refused ; branch_refused ; branch_delayed })
+    (obj4
+       (req "applied" (list operation_encoding))
+       (req "refused" (list refused_encoding))
+       (req "branch_refused" (list refused_encoding))
+       (req "branch_delayed" (list refused_encoding)))
+
+let operations t =
+  let ops =
+    List.fold_left
+      (fun acc (h, op) -> Operation_hash.Map.add h op acc)
+      Operation_hash.Map.empty t.applied in
+  let ops =
+    Operation_hash.Map.fold
+      (fun h (op, _err) acc -> Operation_hash.Map.add h op acc)
+      t.branch_delayed ops in
+  let ops =
+    Operation_hash.Map.fold
+      (fun h (op, _err) acc -> Operation_hash.Map.add h op acc)
+      t.branch_refused ops in
+  ops
--- a/lib_base/preapply_result.mli
+++ b/lib_base/preapply_result.mli
@ -0,0 +1,30 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type 'error t = {
+  applied: (Operation_hash.t * Operation.t) list;
+  refused: (Operation.t * 'error list) Operation_hash.Map.t;
+  (* e.g. invalid signature *)
+  branch_refused: (Operation.t * 'error list) Operation_hash.Map.t;
+  (* e.g. insufficent balance *)
+  branch_delayed: (Operation.t * 'error list) Operation_hash.Map.t;
+  (* e.g. timestamp in the future *)
+}
+
+val empty : 'error t
+
+val map :
+  (Operation.t * 'a list -> Operation.t * 'b list) -> 'a t -> 'b t
+
+val operations :
+  'error t -> Operation.t Operation_hash.Map.t
+
+val encoding :
+  'error list Data_encoding.t ->
+  'error t Data_encoding.t
--- a/lib_base/test_network_status.ml
+++ b/lib_base/test_network_status.ml
@ -0,0 +1,74 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t =
+  | Not_running
+  | Forking of {
+      protocol: Protocol_hash.t ;
+      expiration: Time.t ;
+    }
+  | Running of {
+      net_id: Net_id.t ;
+      genesis: Block_hash.t ;
+      protocol: Protocol_hash.t ;
+      expiration: Time.t ;
+    }
+
+let encoding =
+  let open Data_encoding in
+  union [
+    case ~tag:0
+      (obj1 (req "status" (constant "not_running")))
+      (function Not_running -> Some () | _ -> None)
+      (fun () -> Not_running) ;
+    case ~tag:1
+      (obj3
+         (req "status" (constant "forking"))
+         (req "protocol" Protocol_hash.encoding)
+         (req "expiration" Time.encoding))
+      (function
+        | Forking { protocol ; expiration } ->
+            Some ((), protocol, expiration)
+        | _ -> None)
+      (fun ((), protocol, expiration) ->
+         Forking { protocol ; expiration }) ;
+    case ~tag:2
+      (obj5
+         (req "status" (constant "running"))
+         (req "net_id" Net_id.encoding)
+         (req "genesis" Block_hash.encoding)
+         (req "protocol" Protocol_hash.encoding)
+         (req "expiration" Time.encoding))
+      (function
+        | Running { net_id ; genesis ; protocol ; expiration } ->
+            Some ((), net_id, genesis, protocol, expiration)
+        | _ -> None)
+      (fun ((), net_id, genesis, protocol, expiration) ->
+         Running { net_id ; genesis ; protocol ; expiration }) ;
+  ]
+
+let pp ppf = function
+  | Not_running -> Format.fprintf ppf "@[<v 2>Not running@]"
+  | Forking { protocol ; expiration } ->
+      Format.fprintf ppf
+        "@[<v 2>Forking %a (expires %a)@]"
+        Protocol_hash.pp
+        protocol
+        Time.pp_hum
+        expiration
+  | Running { net_id ; genesis ; protocol ; expiration } ->
+      Format.fprintf ppf
+        "@[<v 2>Running %a\
+         @ Genesis: %a\
+         @ Net id: %a\
+         @ Expiration: %a@]"
+        Protocol_hash.pp protocol
+        Block_hash.pp genesis
+        Net_id.pp net_id
+        Time.pp_hum expiration
--- a/lib_base/test_network_status.mli
+++ b/lib_base/test_network_status.mli
@ -0,0 +1,25 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t =
+  | Not_running
+  | Forking of {
+      protocol: Protocol_hash.t ;
+      expiration: Time.t ;
+    }
+  | Running of {
+      net_id: Net_id.t ;
+      genesis: Block_hash.t ;
+      protocol: Protocol_hash.t ;
+      expiration: Time.t ;
+    }
+
+val encoding: t Data_encoding.t
+
+val pp : Format.formatter -> t -> unit
--- a/lib_base/tzPervasives.ml
+++ b/lib_base/tzPervasives.ml
@ -29,5 +29,8 @@ module Block_header = Block_header
 module Operation = Operation
 module Protocol = Protocol

+module Test_network_status = Test_network_status
+module Preapply_result = Preapply_result
+
 include Utils.Infix
 include Error_monad
--- a/lib_base/tzPervasives.mli
+++ b/lib_base/tzPervasives.mli
@ -28,6 +28,8 @@ module Fitness = Fitness
 module Block_header = Block_header
 module Operation = Operation
 module Protocol = Protocol
+module Test_network_status = Test_network_status
+module Preapply_result = Preapply_result

 include (module type of (struct include Utils.Infix end))
 include (module type of (struct include Error_monad end))
--- a/lib_client_base/client_debug.ml
+++ b/lib_client_base/client_debug.ml
@ -28,7 +28,7 @@ let pp_block ppf
     @ Operations: @[<v>%a@]\
     @ Data (hex encoded): \"%s\"@]"
    Block_hash.pp hash
-    Context.pp_test_network test_network
+    Test_network_status.pp test_network
    level
    proto_level
    Block_hash.pp predecessor
--- a/lib_client_base/client_debug.mli
+++ b/lib_client_base/client_debug.mli
--- a/lib_client_base/client_network.ml
+++ b/lib_client_base/client_network.ml
@ -8,6 +8,7 @@
 (**************************************************************************)

 open Client_commands
+open P2p_types

 let group =
  { Cli_entries.name = "network" ;
@ -23,32 +24,31 @@ let commands () = [
    Client_node_rpcs.Network.peers cctxt.rpc_config >>=? fun peers ->
    Client_node_rpcs.Network.points cctxt.rpc_config >>=? fun points ->
    cctxt.message "GLOBAL STATS" >>= fun () ->
-    cctxt.message "  %a" P2p_types.Stat.pp stat >>= fun () ->
+    cctxt.message "  %a" Stat.pp stat >>= fun () ->
    cctxt.message "CONNECTIONS" >>= fun () ->
    let incoming, outgoing =
-      List.partition (fun c -> c.P2p_types.Connection_info.incoming) conns in
+      List.partition (fun c -> c.Connection_info.incoming) conns in
    Lwt_list.iter_s begin fun conn ->
-      cctxt.message "  %a" P2p_types.Connection_info.pp conn
+      cctxt.message "  %a" Connection_info.pp conn
    end incoming >>= fun () ->
    Lwt_list.iter_s begin fun conn ->
-      cctxt.message "  %a" P2p_types.Connection_info.pp conn
+      cctxt.message "  %a" Connection_info.pp conn
    end outgoing >>= fun () ->
    cctxt.message "KNOWN PEERS" >>= fun () ->
    Lwt_list.iter_s begin fun (p, pi) ->
-      let open P2p.RPC.Peer_id in
      cctxt.message "  %a  %.0f %a %a %s"
-        pp_state_digram pi.state
+        Peer_state.pp_digram pi.Peer_info.state
        pi.score
-        pp p P2p_types.Stat.pp pi.stat
+        Peer_id.pp p
+        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) ->
-      let open P2p.RPC in
-      match pi.Point.state with
+      match pi.Point_info.state with
      | Running peer_id ->
          cctxt.message "  %a  %a %a %s"
-            Point.pp_state_digram pi.state
+            Point_state.pp_digram pi.state
            Point.pp p
            Peer_id.pp peer_id
            (if pi.trusted then "★" else " ")
@ -56,14 +56,14 @@ let commands () = [
          match pi.last_seen with
          | Some (peer_id, ts) ->
              cctxt.message "  %a  %a (last seen: %a %a) %s"
-                Point.pp_state_digram pi.state
+                Point_state.pp_digram pi.state
                Point.pp p
                Peer_id.pp peer_id
                Time.pp_hum ts
                (if pi.trusted then "★" else " ")
          | None ->
              cctxt.message "  %a  %a %s"
-                Point.pp_state_digram pi.state
+                Point_state.pp_digram pi.state
                Point.pp p
                (if pi.trusted then "★" else " ")
    end points >>= fun () ->
--- a/lib_client_base/client_node_rpcs.ml
+++ b/lib_client_base/client_node_rpcs.ml
@ -71,7 +71,7 @@ module Blocks = struct
    data: MBytes.t ;
    operations: (Operation_hash.t * Operation.t) list list option ;
    protocol: Protocol_hash.t ;
-    test_network: Context.test_network;
+    test_network: Test_network_status.t;
  }
  type preapply_param = Services.Blocks.preapply_param = {
    timestamp: Time.t ;
@ -81,7 +81,7 @@ module Blocks = struct
  }
  type preapply_result = Services.Blocks.preapply_result = {
    shell_header: Block_header.shell_header ;
-    operations: error Prevalidation.preapply_result ;
+    operations: error Preapply_result.t ;
  }
  let net_id cctxt h =
    call_service1 cctxt Services.Blocks.net_id h ()
--- a/lib_client_base/client_node_rpcs.mli
+++ b/lib_client_base/client_node_rpcs.mli
@ -74,12 +74,12 @@ module Blocks : sig
    block -> Protocol_hash.t tzresult Lwt.t
  val test_network:
    config ->
-    block -> Context.test_network tzresult Lwt.t
+    block -> Test_network_status.t tzresult Lwt.t

  val pending_operations:
    config ->
    block ->
-    (error Prevalidation.preapply_result * Operation.t Operation_hash.Map.t) tzresult Lwt.t
+    (error Preapply_result.t * Operation.t Operation_hash.Map.t) tzresult Lwt.t

  type block_info = {
    hash: Block_hash.t ;
@ -94,7 +94,7 @@ module Blocks : sig
    data: MBytes.t ;
    operations: (Operation_hash.t * Operation.t) list list option ;
    protocol: Protocol_hash.t ;
-    test_network: Context.test_network;
+    test_network: Test_network_status.t ;
  }

  val info:
@ -115,7 +115,7 @@ module Blocks : sig

  type preapply_result = {
    shell_header: Block_header.shell_header ;
-    operations: error Prevalidation.preapply_result ;
+    operations: error Preapply_result.t ;
  }

  val preapply:
@ -156,17 +156,19 @@ val bootstrapped:

 module Network : sig

+  open P2p_types
+
  val stat:
-    config -> P2p_types.Stat.t tzresult Lwt.t
+    config -> Stat.t tzresult Lwt.t

  val connections:
-    config -> P2p_types.Connection_info.t list tzresult Lwt.t
+    config -> Connection_info.t list tzresult Lwt.t

  val peers:
-    config -> (P2p.Peer_id.t * P2p.RPC.Peer_id.info) list tzresult Lwt.t
+    config -> (Peer_id.t * P2p_types.Peer_info.t) list tzresult Lwt.t

  val points:
-    config -> (P2p.Point.t * P2p.RPC.Point.info) list tzresult Lwt.t
+    config -> (Point.t * P2p_types.Point_info.t) list tzresult Lwt.t

 end

--- a/lib_client_base/jbuild
+++ b/lib_client_base/jbuild
@ -5,17 +5,17 @@
  (public_name tezos-client-base)
  (libraries (tezos-base
              tezos-storage
-              tezos-node-shell
-              tezos-node-net
+              tezos-node-p2p-base
+              tezos-node-services
              tezos-node-updater
              tezos-protocol-compiler))
  (flags (:standard -w -9+27-30-32-40@8
                    -safe-string
                    -open Tezos_base__TzPervasives
                    -open Tezos_storage
-                    -open Tezos_node_net
-                    -open Tezos_node_updater
-                    -open Tezos_node_shell))))
+                    -open Tezos_node_p2p_base
+                    -open Tezos_node_services
+                    -open Tezos_node_updater))))

 (alias
 ((name runtest_indent)
--- a/lib_embedded_client_alpha/client_baking_forge.ml
+++ b/lib_embedded_client_alpha/client_baking_forge.ml
@ -110,7 +110,7 @@ let forge_block cctxt block
          Operation_hash.Map.bindings @@
          Operation_hash.Map.fold
            Operation_hash.Map.add
-            (Prevalidation.preapply_result_operations ops)
+            (Preapply_result.operations ops)
            pendings in
        return ops
    | Some operations -> return operations
@ -465,7 +465,7 @@ let bake cctxt state =
         List.map snd @@
         Operation_hash.Map.bindings @@
         Operation_hash.Map.(fold add)
-           ops (Prevalidation.preapply_result_operations res) in
+           ops (Preapply_result.operations res) in
       let request = List.length operations in
       let proto_header =
         forge_faked_proto_header ~priority ~seed_nonce_hash in
--- a/lib_embedded_client_alpha/jbuild
+++ b/lib_embedded_client_alpha/jbuild
@ -6,7 +6,7 @@
  (libraries (tezos-base
              tezos-embedded-protocol-alpha
              tezos-embedded-protocol-alpha.raw
-              tezos-node-shell
+              tezos-node-services
              tezos-client-base))
  (library_flags (:standard -linkall))
  (flags (:standard -w -9+27-30-32-40@8
@ -14,7 +14,7 @@
                    -open Tezos_base__TzPervasives
                    -open Tezos_embedded_protocol_environment_alpha
                    -open Tezos_embedded_raw_protocol_alpha
-                    -open Tezos_node_shell
+                    -open Tezos_node_services
                    -open Tezos_client_base
                    -open Tezos_context))))

--- a/lib_embedded_client_genesis/jbuild
+++ b/lib_embedded_client_genesis/jbuild
@ -8,7 +8,7 @@
              tezos-embedded-protocol-genesis.raw
              tezos-embedded-protocol-alpha.environment
              tezos-embedded-protocol-alpha.raw
-              tezos-node-shell
+              tezos-node-services
              tezos-client-base))
  (library_flags (:standard -linkall))
  (flags (:standard -w -9+27-30-32-40@8
@ -16,7 +16,7 @@
                    -open Tezos_base__TzPervasives
                    -open Tezos_embedded_protocol_environment_genesis
                    -open Tezos_embedded_raw_protocol_genesis
-                    -open Tezos_node_shell
+                    -open Tezos_node_services
                    -open Tezos_client_base))))

 (alias
--- a/lib_node_http/RPC_server.ml
+++ b/lib_node_http/RPC_server.ml
@ -12,6 +12,9 @@ type cors = RestoCohttp.cors = {
  allowed_origins : string list ;
 }

+include RestoDirectory
+module Directory = RestoDirectory.MakeDirectory(RPC.Data)
+
 include RestoCohttp.Make(RPC.Data)(Logging.RPC)

 let json  = {
@ -44,3 +47,21 @@ let octet_stream = {
    | Some data -> Ok data
  end ;
 }
+
+(* Compatibility layer, to be removed ASAP. *)
+
+type 'a directory = 'a Directory.t
+
+let empty = Directory.empty
+let register d s f = Directory.register d s (fun p () i -> f p i)
+
+open Directory.Curry
+let register0 root s f = register root s (curry Z f)
+let register1 root s f = register root s (curry (S Z) f)
+let register2 root s f = register root s (curry (S (S Z)) f)
+(* let register3 root s f = register root s (curry (S (S (S Z))) f) *)
+(* let register4 root s f = register root s (curry (S (S (S (S Z)))) f) *)
+(* let register5 root s f = register root s (curry (S (S (S (S (S Z))))) f) *)
+
+let register_dynamic_directory1 =
+  Directory.register_dynamic_directory1
--- a/lib_node_http/RPC_server.mli
+++ b/lib_node_http/RPC_server.mli
@ -7,6 +7,11 @@
 (*                                                                        *)
 (**************************************************************************)

+
+module Directory :
+  (module type of struct include RestoDirectory.MakeDirectory(RPC.Data) end)
+include (module type of struct include RestoDirectory end)
+
 (** Typed RPC services: server implementation. *)

 type cors = {
@ -32,8 +37,45 @@ val launch :
  ?cors:cors ->
  media_types:media_type list ->
  Conduit_lwt_unix.server ->
-  unit RPC.Directory.t ->
+  unit Directory.t ->
  server Lwt.t

 (** Kill an RPC server. *)
 val shutdown : server -> unit Lwt.t
+
+
+(** Compatibility layer, to be removed ASAP. *)
+
+type 'a directory = 'a Directory.t
+val empty: 'a directory
+val register:
+  'prefix directory ->
+  ('prefix, 'params, 'input, 'output) RPC.service ->
+  ('params -> 'input -> [< ('output, unit) RestoDirectory.Answer.t ] Lwt.t) ->
+  'prefix directory
+
+val register0:
+  unit directory ->
+  (unit, unit, 'i, 'o) RPC.service ->
+  ('i -> [< ('o, unit) Answer.t ] Lwt.t) ->
+  unit directory
+
+val register1:
+  'prefix directory ->
+  ('prefix, unit * 'a, 'i, 'o) RPC.service ->
+  ('a -> 'i -> [< ('o, unit) Answer.t ] Lwt.t) ->
+  'prefix directory
+
+val register2:
+  'prefix directory ->
+  ('prefix, (unit * 'a) * 'b, 'i, 'o) RPC.service ->
+  ('a -> 'b -> 'i -> [< ('o, unit) Answer.t ] Lwt.t) ->
+  'prefix directory
+
+val register_dynamic_directory1:
+  ?descr:string ->
+  'prefix directory ->
+  ('prefix, unit * 'a) RPC.Path.path ->
+  ('a -> (unit * 'a) directory Lwt.t) ->
+  'prefix directory
+
--- a/lib_node_http/jbuild
+++ b/lib_node_http/jbuild
@ -0,0 +1,18 @@
+(jbuild_version 1)
+
+(library
+ ((name tezos_node_http)
+  (public_name tezos-node-http)
+  (libraries (tezos-base
+              tezos-node-services
+              ocplib-resto-directory
+              ocplib-resto-cohttp))
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
+                    -open Tezos_base__TzPervasives
+                    -open Tezos_node_services))))
+
+(alias
+ ((name runtest_indent)
+  (deps ((glob_files *.ml) (glob_files *.mli)))
+  (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${<}))))
--- a/lib_node_http/tezos-node-http.opam
+++ b/lib_node_http/tezos-node-http.opam
--- a/lib_node_net/p2p_types.ml
+++ b/lib_node_net/p2p_types.ml
@ -1,384 +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
-
-module Peer_id = Crypto_box.Public_key_hash
-
-(* 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 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 String.mem_char port '[' ||
-         String.mem_char port ']' ||
-         String.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 Id_point = struct
-
-  module T = struct
-
-    (* A net point (address x port). *)
-    type t = addr * port option
-    let empty = Ipaddr.V6.unspecified, None
-    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 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
--- a/lib_node_p2p/jbuild
+++ b/lib_node_p2p/jbuild
@ -1,14 +1,14 @@
 (jbuild_version 1)

 (library
- ((name tezos_node_net)
-  (public_name tezos-node-net)
+ ((name tezos_node_p2p)
+  (public_name tezos-node-p2p)
  (libraries (tezos-base
-              mtime.clock.os
-              ocplib-resto-cohttp))
+              tezos-node-p2p-base))
  (flags (:standard -w -9+27-30-32-40@8
                    -safe-string
-                    -open Tezos_base__TzPervasives))))
+                    -open Tezos_base__TzPervasives
+                    -open Tezos_node_p2p_base))))

 (alias
 ((name runtest_indent)
--- a/lib_node_p2p/moving_average.ml
+++ b/lib_node_p2p/moving_average.ml
--- a/lib_node_p2p/moving_average.mli
+++ b/lib_node_p2p/moving_average.mli
--- a/lib_node_p2p/p2p.ml
+++ b/lib_node_p2p/p2p.ml
@ -515,107 +515,16 @@ module RPC = struct
  end

  module Point = struct
-    include Point

-    type state =
-      | Requested
-      | Accepted of Peer_id.t
-      | Running of Peer_id.t
-      | Disconnected
-
-    let peer_id_of_state = function
-      | Requested -> None
-      | Accepted pi -> Some pi
-      | Running pi -> Some pi
-      | Disconnected -> None
-
-    let state_of_state_peerid 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_state_digram ppf = function
-      | Requested -> Format.fprintf ppf "⚎"
-      | Accepted _ -> Format.fprintf ppf "⚍"
-      | Running _ -> Format.fprintf ppf "⚌"
-      | Disconnected -> Format.fprintf ppf "⚏"
-
-    let state_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) ;
-      ]
-
-    type info = {
-      trusted : bool ;
-      greylisted_until : Time.t ;
-      state : state ;
-      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 info_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 = peer_id_of_state 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_state_peerid 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))
+    open P2p_types.Point_info
+    open P2p_types.Point_state

    let info_of_point_info i =
      let open P2p_connection_pool_types in
      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
+        | Accepted { current_peer_id ; _ } -> Accepted current_peer_id
+        | Running { current_peer_id ; _ } -> Running current_peer_id
        | Disconnected -> Disconnected in
      Point_info.{
        trusted = trusted i ;
@ -677,74 +586,9 @@ module RPC = struct
  end

  module Peer_id = struct
-    include Peer_id

-    type state =
-      | Accepted
-      | Running
-      | Disconnected
-
-    let pp_state_digram ppf = function
-      | Accepted -> Format.fprintf ppf "⚎"
-      | Running -> Format.fprintf ppf "⚌"
-      | Disconnected -> Format.fprintf ppf "⚏"
-
-    let state_encoding =
-      let open Data_encoding in
-      string_enum [
-        "accepted", Accepted ;
-        "running", Running ;
-        "disconnected", Disconnected ;
-      ]
-
-    type info = {
-      score : float ;
-      trusted : bool ;
-      state : state ;
-      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 info_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" 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))))
+    open P2p_types.Peer_info
+    open P2p_types.Peer_state

    let info_of_peer_info pool i =
      let open P2p_connection_pool in
@ -783,8 +627,6 @@ module RPC = struct
          | None -> None
        end

-    module Event = P2p_connection_pool_types.Peer_info.Event
-
    let events ?(max=max_int) ?(rev=false) net peer_id =
      match net.pool with
      | None -> []
--- a/lib_node_p2p/p2p.mli
+++ b/lib_node_p2p/p2p.mli
@ -209,9 +209,9 @@ module RPC : sig

  val stat : ('msg, 'meta) net -> Stat.t

-  module Event = P2p_connection_pool.Log_event
-
-  val watch : ('msg, 'meta) net -> Event.t Lwt_stream.t * Lwt_watcher.stopper
+  val watch :
+    ('msg, 'meta) net ->
+    P2p_types.Connection_pool_log_event.t Lwt_stream.t * Lwt_watcher.stopper
  val connect : ('msg, 'meta) net -> Point.t -> float -> unit tzresult Lwt.t

  module Connection : sig
@ -222,79 +222,41 @@ module RPC : sig
  end

  module Point : sig
-    include module type of Point
-
-    type state =
-      | Requested
-      | Accepted of Peer_id.t
-      | Running of Peer_id.t
-      | Disconnected
-
-    val pp_state_digram : Format.formatter -> state -> unit
-    val state_encoding : state Data_encoding.t
-
-    type info = {
-      trusted : bool ;
-      greylisted_until : Time.t ;
-      state : state ;
-      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 info_encoding : info Data_encoding.t
-
-    module Event = P2p_connection_pool_types.Point_info.Event

    val info :
-      ('msg, 'meta) net -> Point.t -> info option
+      ('msg, 'meta) net -> Point.t -> P2p_types.Point_info.t option
+
    val list :
-      ?restrict:state list -> ('msg, 'meta) net -> (Point.t * info) list
+      ?restrict: P2p_types.Point_state.t list ->
+      ('msg, 'meta) net -> (Point.t * P2p_types.Point_info.t) list
+
    val events :
-      ?max:int -> ?rev:bool -> ('msg, 'meta) net -> Point.t -> Event.t list
+      ?max:int -> ?rev:bool -> ('msg, 'meta) net -> Point.t ->
+      P2p_connection_pool_types.Point_info.Event.t list
+
    val watch :
-      ('msg, 'meta) net -> Point.t -> Event.t Lwt_stream.t * Lwt_watcher.stopper
+      ('msg, 'meta) net -> Point.t ->
+      P2p_connection_pool_types.Point_info.Event.t Lwt_stream.t * Lwt_watcher.stopper
+
  end

  module Peer_id : sig
-    include module type of Peer_id
-
-    type state =
-      | Accepted
-      | Running
-      | Disconnected
-
-    val pp_state_digram : Format.formatter -> state -> unit
-    val state_encoding : state Data_encoding.t
-
-    type info = {
-      score : float ;
-      trusted : bool ;
-      state : state ;
-      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 info_encoding : info Data_encoding.t
-
-    module Event = P2p_connection_pool_types.Peer_info.Event

    val info :
-      ('msg, 'meta) net -> Peer_id.t -> info option
+      ('msg, 'meta) net -> Peer_id.t -> P2p_types.Peer_info.t option
+
    val list :
-      ?restrict:state list -> ('msg, 'meta) net -> (Peer_id.t * info) list
+      ?restrict: P2p_types.Peer_state.t list ->
+      ('msg, 'meta) net -> (Peer_id.t * P2p_types.Peer_info.t) list
+
    val events :
-      ?max:int -> ?rev:bool -> ('msg, 'meta) net -> Peer_id.t -> Event.t list
+      ?max: int -> ?rev: bool ->
+      ('msg, 'meta) net -> Peer_id.t ->
+      P2p_connection_pool_types.Peer_info.Event.t list
+
    val watch :
-      ('msg, 'meta) net -> Peer_id.t -> Event.t Lwt_stream.t * Lwt_watcher.stopper
+      ('msg, 'meta) net -> Peer_id.t ->
+      P2p_connection_pool_types.Peer_info.Event.t Lwt_stream.t * Lwt_watcher.stopper

  end

@ -313,6 +275,7 @@ val on_new_connection :
  (Peer_id.t -> ('msg, 'meta) connection -> unit) -> unit

 (**/**)
+
 module Raw : sig
  type 'a t =
    | Bootstrap
--- a/lib_node_p2p/p2p_connection.ml
+++ b/lib_node_p2p/p2p_connection.ml
--- a/lib_node_p2p/p2p_connection.mli
+++ b/lib_node_p2p/p2p_connection.mli
--- a/lib_node_p2p/p2p_connection_pool.ml
+++ b/lib_node_p2p/p2p_connection_pool.ml
@ -150,160 +150,7 @@ module Answerer = struct

 end

-module 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
+module Log_event = Connection_pool_log_event

 type config = {

--- a/lib_node_p2p/p2p_connection_pool.mli
+++ b/lib_node_p2p/p2p_connection_pool.mli
@ -333,66 +333,7 @@ module Points : sig

 end

-module Log_event : sig
-
-  type t =
-
-    (* Pool-level events *)
-
-    | 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 Log_event = Connection_pool_log_event

 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
--- a/lib_node_p2p/p2p_discovery.ml
+++ b/lib_node_p2p/p2p_discovery.ml
--- a/lib_node_p2p/p2p_discovery.mli
+++ b/lib_node_p2p/p2p_discovery.mli
--- a/lib_node_p2p/p2p_io_scheduler.ml
+++ b/lib_node_p2p/p2p_io_scheduler.ml
--- a/lib_node_p2p/p2p_io_scheduler.mli
+++ b/lib_node_p2p/p2p_io_scheduler.mli
--- a/lib_node_p2p/p2p_maintenance.ml
+++ b/lib_node_p2p/p2p_maintenance.ml
--- a/lib_node_p2p/p2p_maintenance.mli
+++ b/lib_node_p2p/p2p_maintenance.mli
--- a/lib_node_p2p/p2p_welcome.ml
+++ b/lib_node_p2p/p2p_welcome.ml
--- a/lib_node_p2p/p2p_welcome.mli
+++ b/lib_node_p2p/p2p_welcome.mli
--- a/lib_node_p2p/tezos-node-p2p.opam
+++ b/lib_node_p2p/tezos-node-p2p.opam
@ -0,0 +1,21 @@
+opam-version: "1.2"
+version: "dev"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "https://gitlab.com/tezos/tezos.git"
+license: "unreleased"
+depends: [
+  "ocamlfind" { build }
+  "jbuilder" { build & >= "1.0+beta15" }
+  "base-bigarray"
+  "mtime.clock.os"
+  "ocplib-resto-cohttp"
+]
+build: [
+  [ "jbuilder" "build" "-p" name "-j" jobs ]
+]
+build-test: [
+  [ "jbuilder" "runtest" "-p" name "-j" jobs ]
+]
--- a/lib_node_p2p_base/jbuild
+++ b/lib_node_p2p_base/jbuild
@ -0,0 +1,12 @@
+(jbuild_version 1)
+
+(library
+ ((name tezos_node_p2p_base)
+  (public_name tezos-node-p2p-base)
+  (libraries (tezos-base))
+  (flags (:standard -open Tezos_base__TzPervasives))))
+
+(alias
+ ((name runtest_indent)
+  (deps ((glob_files *.ml) (glob_files *.mli)))
+  (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${<}))))
--- a/lib_node_p2p_base/p2p_connection_pool_types.ml
+++ b/lib_node_p2p_base/p2p_connection_pool_types.ml
@ -163,11 +163,11 @@ module Point_info = struct
    | (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 fold_events { events ; _ } ~init ~f = Ring.fold events ~init ~f

-  let watch { watchers } = Lwt_watcher.create_stream watchers
+  let watch { watchers ; _ } = Lwt_watcher.create_stream watchers

-  let log { events ; watchers } ?(timestamp = Time.now ()) kind =
+  let log { events ; watchers ; _ } ?(timestamp = Time.now ()) kind =
    let event = { Event.kind ; timestamp } in
    Ring.add events event ;
    Lwt_watcher.notify watchers event
@ -189,16 +189,16 @@ module Point_info = struct
    let pp ppf = function
      | Requested _ ->
          Format.fprintf ppf "requested"
-      | Accepted { current_peer_id } ->
+      | Accepted { current_peer_id ; _ } ->
          Format.fprintf ppf "accepted %a" Peer_id.pp current_peer_id
-      | Running { 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 get { state ; _ } = state

-    let is_disconnected { state } =
+    let is_disconnected { state ; _ } =
      match state with
      | Disconnected -> true
      | Requested _ | Accepted _ | Running _ -> false
@ -232,7 +232,7 @@ module Point_info = struct
        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
+        | 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 } ;
@ -255,12 +255,12 @@ module Point_info = struct
            set_greylisted timestamp point_info ;
            point_info.last_failed_connection <- Some timestamp ;
            Request_rejected None
-        | Accepted { current_peer_id } ->
+        | 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 } ->
+        | Running { current_peer_id ; _ } ->
            point_info.greylisting_delay <-
              float_of_int point_info.greylisting.initial_delay ;
            point_info.greylisting_end <-
@ -368,7 +368,7 @@ module Peer_info = struct
    conv
      (fun { peer_id ; trusted ; metadata ; events ; created ;
             last_failed_connection ; last_rejected_connection ;
-             last_established_connection ; last_disconnection } ->
+             last_established_connection ; last_disconnection ; _ } ->
        (peer_id, created, trusted, metadata, Ring.elements events,
         last_failed_connection, last_rejected_connection,
         last_established_connection, last_disconnection))
@ -402,14 +402,14 @@ module Peer_info = struct
         (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 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 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 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
@ -426,12 +426,12 @@ module Peer_info = struct
      s.last_failed_connection
      (recent s.last_rejected_connection s.last_disconnection)

-  let log { events ; watchers } ?(timestamp = Time.now ()) point kind =
+  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 watch { watchers ; _ } = Lwt_watcher.create_stream watchers

  let log_incoming_rejection ?timestamp peer_info point =
    log peer_info ?timestamp point Rejecting_request
@ -447,16 +447,16 @@ module Peer_info = struct
    type 'data state = 'data t

    let pp ppf = function
-      | Accepted { current_point } ->
+      | Accepted { current_point ; _ } ->
          Format.fprintf ppf "accepted %a" Id_point.pp current_point
-      | Running { 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 get { state ; _ } = state

-    let is_disconnected { state } =
+    let is_disconnected { state ; _ } =
      match state with
      | Disconnected -> true
      | Accepted _ | Running _ -> false
@ -479,7 +479,7 @@ module Peer_info = struct
        match peer_info.state with
        | Disconnected -> true (* request to unknown peer_id. *)
        | Running _ -> false
-        | Accepted { current_point } ->
+        | Accepted { current_point ; _ } ->
            Id_point.equal point current_point
      end ;
      peer_info.state <- Running { data ; current_point = point } ;
@ -490,11 +490,11 @@ module Peer_info = struct
        ?(timestamp = Time.now ()) ?(requested = false) peer_info =
      let current_point, (event : Event.kind) =
        match peer_info.state with
-        | Accepted { current_point } ->
+        | Accepted { current_point ; _ } ->
            peer_info.last_rejected_connection <-
              Some (current_point, timestamp) ;
            current_point, Request_rejected
-        | Running { current_point } ->
+        | Running { current_point ; _ } ->
            peer_info.last_disconnection <-
              Some (current_point, timestamp) ;
            current_point,
--- a/lib_node_p2p_base/p2p_connection_pool_types.mli
+++ b/lib_node_p2p_base/p2p_connection_pool_types.mli
--- a/lib_node_p2p_base/p2p_types.ml
+++ b/lib_node_p2p_base/p2p_types.ml
@ -0,0 +1,717 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    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
--- a/lib_node_p2p_base/p2p_types.mli
+++ b/lib_node_p2p_base/p2p_types.mli
@ -19,7 +19,7 @@ module Version : sig

  val pp : Format.formatter -> t -> unit
  val encoding : t Data_encoding.t
-  val common: t list -> t list -> t option
+  val common : t list -> t list -> t option
 end


@ -36,10 +36,13 @@ 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
@ -47,9 +50,11 @@ module Point : sig
  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 *)
@ -112,7 +117,7 @@ module Stat : sig
  }

  val empty : t
-  val pp: Format.formatter -> t -> unit
+  val pp : Format.formatter -> t -> unit
  val encoding : t Data_encoding.t
 end

@ -128,7 +133,131 @@ module Connection_info : sig
    versions : Version.t list ;
  }

-  val pp: Format.formatter -> t -> unit
+  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
+
--- a/lib_node_p2p_base/tezos-node-p2p-base.opam
+++ b/lib_node_p2p_base/tezos-node-p2p-base.opam
@ -0,0 +1,21 @@
+opam-version: "1.2"
+version: "dev"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "https://gitlab.com/tezos/tezos.git"
+license: "unreleased"
+depends: [
+  "ocamlfind" { build }
+  "jbuilder" { build & >= "1.0+beta15" }
+  "base-bigarray"
+  "mtime.clock.os"
+  "ocplib-resto-cohttp"
+]
+build: [
+  [ "jbuilder" "build" "-p" name "-j" jobs ]
+]
+build-test: [
+  [ "jbuilder" "runtest" "-p" name "-j" jobs ]
+]
--- a/lib_node_services/RPC.ml
+++ b/lib_node_services/RPC.ml
@ -135,14 +135,10 @@ module Data = struct
 end

 include Resto
-include RestoDirectory
-module Directory = RestoDirectory.MakeDirectory(Data)
-module Service = Directory.Service
-
+module Service = Resto.MakeService(Data)

 (* Compatibility layer, to be removed ASAP. *)

-type 'a directory = 'a Directory.t
 type ('prefix, 'params, 'input, 'output) service =
  ([ `POST ], 'prefix, 'params, unit, 'input, 'output, unit) Service.t

@ -157,20 +153,6 @@ let service ?description ~input ~output path =

 type directory_descr = Data_encoding.json_schema Description.directory

-let empty = Directory.empty
-let register d s f = Directory.register d s (fun p () i -> f p i)
-
-open Directory.Curry
-let register0 root s f = register root s (curry Z f)
-let register1 root s f = register root s (curry (S Z) f)
-let register2 root s f = register root s (curry (S (S Z)) f)
-(* let register3 root s f = register root s (curry (S (S (S Z))) f) *)
-(* let register4 root s f = register root s (curry (S (S (S (S Z)))) f) *)
-(* let register5 root s f = register root s (curry (S (S (S (S (S Z))))) f) *)
-
-let register_dynamic_directory1 =
-  Directory.register_dynamic_directory1
-
 let forge_request (type i) (service: (_,_,_,_,i,_,_) Service.t) params body =
  let { Service.meth ; path } =
    Service.forge_request service params () in
--- a/lib_node_services/RPC.mli
+++ b/lib_node_services/RPC.mli
@ -13,13 +13,10 @@ module Data : Resto.ENCODING with type 'a t = 'a Data_encoding.t
                              and type schema = Data_encoding.json_schema

 include (module type of struct include Resto end)
-include (module type of struct include RestoDirectory end)
-module Directory : (module type of struct include RestoDirectory.MakeDirectory(Data) end)
-module Service : (module type of struct include Directory.Service end)
+module Service : (module type of struct include Resto.MakeService(Data) end)

 (** Compatibility layer, to be removed ASAP. *)

-type 'a directory = 'a Directory.t
 type ('prefix, 'params, 'input, 'output) service =
  ([ `POST ], 'prefix, 'params, unit, 'input, 'output, unit) Service.t

@ -32,38 +29,6 @@ val service:

 type directory_descr = Data_encoding.json_schema Description.directory

-val empty: 'a directory
-val register:
-  'prefix directory ->
-  ('prefix, 'params, 'input, 'output) service ->
-  ('params -> 'input -> [< ('output, unit) RestoDirectory.Answer.t ] Lwt.t) ->
-  'prefix directory
-
-val register0:
-  unit directory ->
-  (unit, unit, 'i, 'o) service ->
-  ('i -> [< ('o, unit) Answer.t ] Lwt.t) ->
-  unit directory
-
-val register1:
-  'prefix directory ->
-  ('prefix, unit * 'a, 'i, 'o) service ->
-  ('a -> 'i -> [< ('o, unit) Answer.t ] Lwt.t) ->
-  'prefix directory
-
-val register2:
-  'prefix directory ->
-  ('prefix, (unit * 'a) * 'b, 'i, 'o) service ->
-  ('a -> 'b -> 'i -> [< ('o, unit) Answer.t ] Lwt.t) ->
-  'prefix directory
-
-val register_dynamic_directory1:
-  ?descr:string ->
-  'prefix directory ->
-  ('prefix, unit * 'a) Path.path ->
-  ('a -> (unit * 'a) directory Lwt.t) ->
-  'prefix directory
-
 val forge_request:
  (unit, 'params, 'input, _) service ->
  'params -> 'input -> MethMap.key * string list * Data_encoding.json
--- a/lib_node_services/jbuild
+++ b/lib_node_services/jbuild
@ -0,0 +1,17 @@
+(jbuild_version 1)
+
+(library
+ ((name tezos_node_services)
+  (public_name tezos-node-services)
+  (libraries (tezos-base
+              tezos-node-p2p-base
+              ocplib-resto))
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
+                    -open Tezos_base__TzPervasives
+                    -open Tezos_node_p2p_base))))
+
+(alias
+ ((name runtest_indent)
+  (deps ((glob_files *.ml) (glob_files *.mli)))
+  (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${<}))))
--- a/lib_node_services/node_rpc_services.ml
+++ b/lib_node_services/node_rpc_services.ml
@ -69,7 +69,7 @@ module Blocks = struct
    data: MBytes.t ;
    operations: (Operation_hash.t * Operation.t) list list option ;
    protocol: Protocol_hash.t ;
-    test_network: Context.test_network;
+    test_network: Test_network_status.t ;
  }

  let block_info_encoding =
@ -104,7 +104,7 @@ module Blocks = struct
               (opt "operations" (dynamic_size (list (dynamic_size (list (dynamic_size operation_encoding))))))
               (req "protocol" Protocol_hash.encoding)
               (dft "test_network"
-                  Context.test_network_encoding Context.Not_running))
+                  Test_network_status.encoding Not_running))
            Block_header.encoding))

  let parse_block s =
@ -243,7 +243,7 @@ module Blocks = struct
    RPC.service
      ~description:"Returns the status of the associated test network."
      ~input: empty
-      ~output: Context.test_network_encoding
+      ~output: Test_network_status.encoding
      RPC.Path.(block_path / "test_network")

  let pending_operations =
@ -259,7 +259,8 @@ module Blocks = struct
      ~output:
        (conv
           (fun (preapplied, unprocessed) ->
-              ({ preapplied with Prevalidation.refused = Operation_hash.Map.empty },
+              ({ preapplied with
+                 Preapply_result.refused = Operation_hash.Map.empty },
               Operation_hash.Map.bindings unprocessed))
           (fun (preapplied, unprocessed) ->
              (preapplied,
@ -268,7 +269,7 @@ module Blocks = struct
                 unprocessed Operation_hash.Map.empty))
           (merge_objs
              (dynamic_size
-                 (Prevalidation.preapply_result_encoding Error.encoding))
+                 (Preapply_result.encoding Error.encoding))
              (obj1 (req "unprocessed" (list (dynamic_size operation_encoding))))))
      RPC.Path.(block_path / "pending_operations")

@ -296,7 +297,7 @@ module Blocks = struct

  type preapply_result = {
    shell_header: Block_header.shell_header ;
-    operations: error Prevalidation.preapply_result ;
+    operations: error Preapply_result.t ;
  }

  let preapply_result_encoding =
@ -308,7 +309,7 @@ module Blocks = struct
       (obj2
          (req "shell_header" Block_header.shell_header_encoding)
          (req "operations"
-             (Prevalidation.preapply_result_encoding Error.encoding))))
+             (Preapply_result.encoding Error.encoding))))

  let preapply =
    RPC.service
@ -498,21 +499,21 @@ module Network = struct
    RPC.service
      ~description:"Supported network layer versions."
      ~input: empty
-      ~output: (list P2p.Version.encoding)
+      ~output: (list P2p_types.Version.encoding)
      RPC.Path.(root / "network" / "versions")

  let stat =
    RPC.service
      ~description:"Global network bandwidth statistics in B/s."
      ~input: empty
-      ~output: P2p.Stat.encoding
+      ~output: P2p_types.Stat.encoding
      RPC.Path.(root / "network" / "stat")

  let events =
    RPC.service
      ~description:"Stream of all network events"
      ~input: empty
-      ~output: P2p.RPC.Event.encoding
+      ~output: P2p_types.Connection_pool_log_event.encoding
      RPC.Path.(root / "network" / "log")

  let connect =
@ -530,13 +531,13 @@ module Network = struct
      RPC.service
        ~description:"List the running P2P connection."
        ~input: empty
-        ~output: (list P2p.Connection_info.encoding)
+        ~output: (list P2p_types.Connection_info.encoding)
        RPC.Path.(root / "network" / "connection")

    let info =
      RPC.service
        ~input: empty
-        ~output: (option P2p.Connection_info.encoding)
+        ~output: (option P2p_types.Connection_info.encoding)
        ~description:"Details about the current P2P connection to the given peer."
        RPC.Path.(root / "network" / "connection" /: peer_id_arg)

@ -554,23 +555,26 @@ module Network = struct
    let info =
      RPC.service
        ~input: empty
-        ~output: (option P2p.RPC.Point.info_encoding)
+        ~output: (option P2p_types.Point_info.encoding)
        ~description: "Details about a given `IP:addr`."
        RPC.Path.(root / "network" / "point" /: point_arg)

    let events =
      RPC.service
        ~input: monitor_encoding
-        ~output: (list P2p.RPC.Point.Event.encoding)
+        ~output: (list P2p_connection_pool_types.Point_info.Event.encoding)
        ~description: "Monitor network events related to an `IP:addr`."
        RPC.Path.(root / "network" / "point" /: point_arg / "log")

    let list =
      let filter =
-        obj1 (dft "filter" (list P2p.RPC.Point.state_encoding) []) in
+        obj1 (dft "filter" (list P2p_types.Point_state.encoding) []) in
      RPC.service
        ~input: filter
-        ~output: (list (tup2 P2p.Point.encoding P2p.RPC.Point.info_encoding))
+        ~output:
+          (list (tup2
+                   P2p_types.Point.encoding
+                   P2p_types.Point_info.encoding))
        ~description:"List the pool of known `IP:port` \
                      used for establishing P2P connections ."
        RPC.Path.(root / "network" / "point")
@ -582,23 +586,26 @@ module Network = struct
    let info =
      RPC.service
        ~input: empty
-        ~output: (option P2p.RPC.Peer_id.info_encoding)
+        ~output: (option P2p_types.Peer_info.encoding)
        ~description:"Details about a given peer."
        RPC.Path.(root / "network" / "peer_id" /: peer_id_arg)

    let events =
      RPC.service
        ~input: monitor_encoding
-        ~output: (list P2p.RPC.Peer_id.Event.encoding)
+        ~output: (list P2p_connection_pool_types.Peer_info.Event.encoding)
        ~description:"Monitor network events related to a given peer."
        RPC.Path.(root / "network" / "peer_id" /: peer_id_arg / "log")

    let list =
      let filter =
-        obj1 (dft "filter" (list P2p.RPC.Peer_id.state_encoding) []) in
+        obj1 (dft "filter" (list P2p_types.Peer_state.encoding) []) in
      RPC.service
        ~input: filter
-        ~output: (list (tup2 P2p.Peer_id.encoding P2p.RPC.Peer_id.info_encoding))
+        ~output:
+          (list (tup2
+                   P2p_types.Peer_id.encoding
+                   P2p_types.Peer_info.encoding))
        ~description:"List the peers the node ever met."
        RPC.Path.(root / "network" / "peer_id")

--- a/lib_node_services/node_rpc_services.mli
+++ b/lib_node_services/node_rpc_services.mli
@ -39,7 +39,7 @@ module Blocks : sig
    data: MBytes.t ;
    operations: (Operation_hash.t * Operation.t) list list option ;
    protocol: Protocol_hash.t ;
-    test_network: Context.test_network;
+    test_network: Test_network_status.t ;
  }

  val info:
@ -70,10 +70,10 @@ module Blocks : sig
  val protocol:
    (unit, unit * block, unit, Protocol_hash.t) RPC.service
  val test_network:
-    (unit, unit * block, unit, Context.test_network) RPC.service
+    (unit, unit * block, unit, Test_network_status.t) RPC.service
  val pending_operations:
    (unit, unit * block, unit,
-     error Prevalidation.preapply_result * Operation.t Operation_hash.Map.t) RPC.service
+     error Preapply_result.t * Operation.t Operation_hash.Map.t) RPC.service

  type list_param = {
    include_ops: bool ;
@ -99,7 +99,7 @@ module Blocks : sig

  type preapply_result = {
    shell_header: Block_header.shell_header ;
-    operations: error Prevalidation.preapply_result ;
+    operations: error Preapply_result.t ;
  }
  val preapply:
    (unit, unit * block, preapply_param, preapply_result tzresult) RPC.service
@ -131,44 +131,56 @@ end
 module Network : sig

  val stat :
-    (unit, unit, unit, P2p.Stat.t) RPC.service
+    (unit, unit, unit, P2p_types.Stat.t) RPC.service

  val versions :
-    (unit, unit, unit, P2p.Version.t list) RPC.service
+    (unit, unit, unit, P2p_types.Version.t list) RPC.service

  val events :
-    (unit, unit, unit, P2p.RPC.Event.t) RPC.service
+    (unit, unit, unit, P2p_types.Connection_pool_log_event.t) RPC.service

  val connect :
-    (unit, unit * P2p.Point.t, float, unit tzresult) RPC.service
+    (unit, unit * P2p_types.Point.t, float, unit tzresult) RPC.service

  module Connection : sig
+
    val list :
-      (unit, unit, unit, P2p.Connection_info.t list) RPC.service
+      (unit, unit, unit, P2p_types.Connection_info.t list) RPC.service
+
    val info :
-      (unit, unit * P2p.Peer_id.t, unit, P2p.Connection_info.t option) RPC.service
+      (unit, unit * P2p_types.Peer_id.t, unit,
+       P2p_types.Connection_info.t option) RPC.service
+
    val kick :
-      (unit, unit * P2p.Peer_id.t, bool, unit) RPC.service
+      (unit, unit * P2p_types.Peer_id.t, bool, unit) RPC.service
+
  end

  module Point : sig
    val list :
-      (unit, unit, P2p.RPC.Point.state list,
-       (P2p.Point.t * P2p.RPC.Point.info) list) RPC.service
+      (unit, unit, P2p_types.Point_state.t list,
+       (P2p_types.Point.t * P2p_types.Point_info.t) list) RPC.service
    val info :
-      (unit, unit * P2p.Point.t, unit, P2p.RPC.Point.info option) RPC.service
+      (unit, unit * P2p_types.Point.t, unit, P2p_types.Point_info.t option) RPC.service
    val events :
-      (unit, unit * P2p.Point.t, bool, P2p.RPC.Point.Event.t list) RPC.service
+      (unit, unit * P2p_types.Point.t, bool,
+       P2p_connection_pool_types.Point_info.Event.t list) RPC.service
  end

  module Peer_id : sig
+
    val list :
-      (unit, unit, P2p.RPC.Peer_id.state list,
-       (P2p.Peer_id.t * P2p.RPC.Peer_id.info) list) RPC.service
+      (unit, unit, P2p_types.Peer_state.t list,
+       (P2p_types.Peer_id.t * P2p_types.Peer_info.t) list) RPC.service
+
    val info :
-      (unit, unit * P2p.Peer_id.t, unit, P2p.RPC.Peer_id.info option) RPC.service
+      (unit, unit * P2p_types.Peer_id.t, unit,
+       P2p_types.Peer_info.t option) RPC.service
+
    val events :
-      (unit, unit * P2p.Peer_id.t, bool, P2p.RPC.Peer_id.Event.t list) RPC.service
+      (unit, unit * P2p_types.Peer_id.t, bool,
+       P2p_connection_pool_types.Peer_info.Event.t list) RPC.service
+
  end

 end
--- a/lib_node_services/tezos-node-services.opam
+++ b/lib_node_services/tezos-node-services.opam
@ -0,0 +1,21 @@
+opam-version: "1.2"
+version: "dev"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "https://gitlab.com/tezos/tezos.git"
+license: "unreleased"
+depends: [
+  "ocamlfind" { build }
+  "jbuilder" { build & >= "1.0+beta15" }
+  "base-bigarray"
+  "mtime.clock.os"
+  "ocplib-resto-cohttp"
+]
+build: [
+  [ "jbuilder" "build" "-p" name "-j" jobs ]
+]
+build-test: [
+  [ "jbuilder" "runtest" "-p" name "-j" jobs ]
+]
--- a/lib_node_shell/jbuild
+++ b/lib_node_shell/jbuild
@ -5,13 +5,18 @@
  (public_name tezos-node-shell)
  (libraries (tezos-base
              tezos-storage
-              tezos-node-net
+              tezos-node-services
+              tezos-node-p2p-base
+              tezos-node-p2p
              tezos-node-updater))
  (flags (:standard -w -9+27-30-32-40@8
                    -safe-string
                    -open Tezos_base__TzPervasives
                    -open Tezos_storage
-                    -open Tezos_node_net
+                    -open Tezos_node_services
+                    -open Tezos_node_http
+                    -open Tezos_node_p2p_base
+                    -open Tezos_node_p2p
                    -open Tezos_node_updater))))

 (alias
--- a/lib_node_shell/node.ml
+++ b/lib_node_shell/node.ml
@ -152,7 +152,7 @@ module RPC = struct
    data: MBytes.t ;
    operations: (Operation_hash.t * Operation.t) list list option ;
    protocol: Protocol_hash.t ;
-    test_network: Context.test_network;
+    test_network: Test_network_status.t ;
  }

  let convert (block: State.Block.t) =
@ -377,7 +377,7 @@ module RPC = struct
    | (`Prevalidation | `Test_prevalidation) as block ->
        let validator = get_validator node block in
        let pv = Net_validator.prevalidator validator in
-        let { Prevalidation.applied }, _ = Prevalidator.operations pv in
+        let { Preapply_result.applied }, _ = Prevalidator.operations pv in
        Lwt.return [List.map fst applied]
    | `Hash hash ->
        read_valid_block node hash >>= function
@ -398,7 +398,7 @@ module RPC = struct
    | (`Prevalidation | `Test_prevalidation) as block ->
        let validator = get_validator node block in
        let pv = Net_validator.prevalidator validator in
-        let { Prevalidation.applied }, _ = Prevalidator.operations pv in
+        let { Preapply_result.applied }, _ = Prevalidator.operations pv in
        Lwt.return [List.map snd applied]
    | `Hash hash ->
        read_valid_block node hash >>= function
@ -421,24 +421,24 @@ module RPC = struct
        Chain.head net_state >>= fun head ->
        predecessor net_db n head >>= fun b ->
        Prevalidator.pending ~block:b prevalidator >|= fun ops ->
-        Prevalidation.empty_result, ops
+        Preapply_result.empty, ops
    | `Genesis ->
        let net_state = Net_validator.net_state node.mainnet_validator in
        let prevalidator =
          Net_validator.prevalidator node.mainnet_validator in
        Chain.genesis net_state >>= fun b ->
        Prevalidator.pending ~block:b prevalidator >|= fun ops ->
-        Prevalidation.empty_result, ops
+        Preapply_result.empty, ops
    | `Hash h -> begin
        get_validator_per_hash node h >>= function
        | None ->
-            Lwt.return (Prevalidation.empty_result, Operation_hash.Map.empty)
+            Lwt.return (Preapply_result.empty, Operation_hash.Map.empty)
        | Some validator ->
            let net_state = Net_validator.net_state validator in
            let prevalidator = Net_validator.prevalidator validator in
            State.Block.read_exn net_state h >>= fun block ->
            Prevalidator.pending ~block prevalidator >|= fun ops ->
-            Prevalidation.empty_result, ops
+            Preapply_result.empty, ops
      end

  let protocols { state } =
@ -522,8 +522,8 @@ module RPC = struct
    | Some rpc_context ->
        Context.get_protocol rpc_context.context >>= fun protocol_hash ->
        let (module Proto) = State.Registred_protocol.get_exn protocol_hash in
-        let dir = RPC.Directory.map (fun () -> rpc_context) Proto.rpc_services in
-        Lwt.return (Some (RPC.Directory.map (fun _ -> ()) dir))
+        let dir = RPC_server.Directory.map (fun () -> rpc_context) Proto.rpc_services in
+        Lwt.return (Some (RPC_server.Directory.map (fun _ -> ()) dir))

  let heads node =
    let net_state = Net_validator.net_state node.mainnet_validator in
@ -627,7 +627,7 @@ module RPC = struct
        ]
      end in
    let shutdown () = Lwt_watcher.shutdown stopper in
-    RPC.Answer.{ next ; shutdown }
+    RPC_server.Answer.{ next ; shutdown }

  module Network = struct

@ -661,11 +661,11 @@ module RPC = struct
      let info (node : t) =
        P2p.RPC.Point.info node.p2p

-      let list (node : t) restrict =
-        P2p.RPC.Point.list ~restrict node.p2p
+      let list ?restrict (node : t) =
+        P2p.RPC.Point.list ?restrict node.p2p

-      let events (node : t) =
-        P2p.RPC.Point.events node.p2p
+      let events ?max ?rev (node : t) =
+        P2p.RPC.Point.events node.p2p ?max ?rev

      let watch (node : t) =
        P2p.RPC.Point.watch node.p2p
@ -677,11 +677,11 @@ module RPC = struct
      let info (node : t) =
        P2p.RPC.Peer_id.info node.p2p

-      let list (node : t) restrict =
-        P2p.RPC.Peer_id.list ~restrict node.p2p
+      let list ?restrict (node : t) =
+        P2p.RPC.Peer_id.list ?restrict node.p2p

-      let events (node : t) =
-        P2p.RPC.Peer_id.events node.p2p
+      let events ?max ?rev (node : t) =
+        P2p.RPC.Peer_id.events node.p2p ?max ?rev

      let watch (node : t) =
        P2p.RPC.Peer_id.watch node.p2p
--- a/lib_node_shell/node.mli
+++ b/lib_node_shell/node.mli
@ -78,7 +78,8 @@ module RPC : sig
    t -> (Operation_hash.t * Operation.t) Lwt_stream.t * Lwt_watcher.stopper

  val pending_operations:
-    t -> block -> (error Prevalidation.preapply_result * Operation.t Operation_hash.Map.t) Lwt.t
+    t -> block ->
+    (error Preapply_result.t * Operation.t Operation_hash.Map.t) Lwt.t

  val protocols:
    t -> Protocol_hash.t list Lwt.t
@ -88,52 +89,78 @@ module RPC : sig
    t -> (Protocol_hash.t * Protocol.t) Lwt_stream.t * Lwt_watcher.stopper

  val context_dir:
-    t -> block -> 'a RPC.directory option Lwt.t
+    t -> block -> 'a RPC_server.directory option Lwt.t

  val preapply:
    t -> block ->
    timestamp:Time.t -> proto_header:MBytes.t ->
    sort_operations:bool -> Operation.t list ->
-    (Block_header.shell_header * error Prevalidation.preapply_result) tzresult Lwt.t
+    (Block_header.shell_header * error Preapply_result.t) tzresult Lwt.t

  val context_dir:
-    t -> block -> 'a RPC.directory option Lwt.t
+    t -> block -> 'a RPC_server.directory option Lwt.t

  val complete:
    t -> ?block:block -> string -> string list Lwt.t

  val bootstrapped:
-    t -> (Block_hash.t * Time.t) RPC.Answer.stream
+    t -> (Block_hash.t * Time.t) RPC_server.Answer.stream

  module Network : sig

-    val stat : t -> P2p.Stat.t
-    val watch : t -> P2p.RPC.Event.t Lwt_stream.t * Lwt_watcher.stopper
-    val connect : t -> P2p.Point.t -> float -> unit tzresult Lwt.t
+    open P2p_types
+
+    val stat : t -> Stat.t
+
+    val watch :
+      t ->
+      P2p_types.Connection_pool_log_event.t Lwt_stream.t * Lwt_watcher.stopper
+    val connect : t -> Point.t -> float -> unit tzresult Lwt.t

    module Connection : sig
-      val info : t -> P2p.Peer_id.t -> P2p.Connection_info.t option
-      val kick : t -> P2p.Peer_id.t -> bool -> unit Lwt.t
-      val list : t -> P2p.Connection_info.t list
+      val info : t -> Peer_id.t -> Connection_info.t option
+      val kick : t -> Peer_id.t -> bool -> unit Lwt.t
+      val list : t -> Connection_info.t list
      val count : t -> int
    end

-    module Peer_id : sig
-      val list : t ->
-        P2p.RPC.Peer_id.state list -> (P2p.Peer_id.t * P2p.RPC.Peer_id.info) list
-      val info : t -> P2p.Peer_id.t -> P2p.RPC.Peer_id.info option
-      val events : t -> P2p.Peer_id.t -> P2p.RPC.Peer_id.Event.t list
-      val watch : t -> P2p.Peer_id.t ->
-        P2p.RPC.Peer_id.Event.t Lwt_stream.t * Lwt_watcher.stopper
+    module Point : sig
+
+      val info :
+        t -> Point.t -> P2p_types.Point_info.t option
+
+      val list :
+        ?restrict: P2p_types.Point_state.t list ->
+        t -> (Point.t * P2p_types.Point_info.t) list
+
+      val events :
+        ?max:int -> ?rev:bool -> t -> Point.t ->
+        P2p_connection_pool_types.Point_info.Event.t list
+
+      val watch :
+        t -> Point.t ->
+        P2p_connection_pool_types.Point_info.Event.t Lwt_stream.t * Lwt_watcher.stopper
+
    end

-    module Point : sig
-      val list : t ->
-        P2p.RPC.Point.state list -> (P2p.Point.t * P2p.RPC.Point.info) list
-      val info : t -> P2p.Point.t -> P2p.RPC.Point.info option
-      val events : t -> P2p.Point.t -> P2p.RPC.Point.Event.t list
-      val watch : t -> P2p.Point.t ->
-        P2p.RPC.Point.Event.t Lwt_stream.t * Lwt_watcher.stopper
+    module Peer_id : sig
+
+      val info :
+        t -> Peer_id.t -> P2p_types.Peer_info.t option
+
+      val list :
+        ?restrict: P2p_types.Peer_state.t list ->
+        t -> (Peer_id.t * P2p_types.Peer_info.t) list
+
+      val events :
+        ?max: int -> ?rev: bool ->
+        t -> Peer_id.t ->
+        P2p_connection_pool_types.Peer_info.Event.t list
+
+      val watch :
+        t -> Peer_id.t ->
+        P2p_connection_pool_types.Peer_info.Event.t Lwt_stream.t * Lwt_watcher.stopper
+
    end

  end
--- a/lib_node_shell/node_rpc.ml
+++ b/lib_node_shell/node_rpc.ml
@ -36,70 +36,70 @@ let monitor_operations node contents =
        Lwt.return_some @@
        List.map (List.map (fun h -> h, None)) hashes
    end in
-  RPC.Answer.return_stream { next ; shutdown }
+  RPC_server.Answer.return_stream { next ; shutdown }

 let register_bi_dir node dir =
  let dir =
    let implementation b include_ops =
      Node.RPC.block_info node b >>= fun bi ->
-      RPC.Answer.return (filter_bi include_ops bi) in
-    RPC.register1 dir
+      RPC_server.Answer.return (filter_bi include_ops bi) in
+    RPC_server.register1 dir
      Services.Blocks.info implementation in
  let dir =
    let implementation b () =
      Node.RPC.block_info node b >>= fun bi ->
-      RPC.Answer.return bi.hash in
-    RPC.register1 dir
+      RPC_server.Answer.return bi.hash in
+    RPC_server.register1 dir
      Services.Blocks.hash
      implementation in
  let dir =
    let implementation b () =
      Node.RPC.block_info node b >>= fun bi ->
-      RPC.Answer.return bi.net_id in
-    RPC.register1 dir
+      RPC_server.Answer.return bi.net_id in
+    RPC_server.register1 dir
      Services.Blocks.net_id implementation in
  let dir =
    let implementation b () =
      Node.RPC.block_info node b >>= fun bi ->
-      RPC.Answer.return bi.level in
-    RPC.register1 dir
+      RPC_server.Answer.return bi.level in
+    RPC_server.register1 dir
      Services.Blocks.level implementation in
  let dir =
    let implementation b () =
      Node.RPC.block_info node b >>= fun bi ->
-      RPC.Answer.return bi.predecessor in
-    RPC.register1 dir
+      RPC_server.Answer.return bi.predecessor in
+    RPC_server.register1 dir
      Services.Blocks.predecessor implementation in
  let dir =
    let implementation b len =
      Node.RPC.block_info node b >>= fun bi ->
      Node.RPC.predecessors node len bi.hash >>= fun hashes ->
-      RPC.Answer.return hashes in
-    RPC.register1 dir
+      RPC_server.Answer.return hashes in
+    RPC_server.register1 dir
      Services.Blocks.predecessors implementation in
  let dir =
    let implementation b () =
      Node.RPC.block_info node b >>= fun bi ->
-      RPC.Answer.return bi.fitness in
-    RPC.register1 dir
+      RPC_server.Answer.return bi.fitness in
+    RPC_server.register1 dir
      Services.Blocks.fitness implementation in
  let dir =
    let implementation b () =
      Node.RPC.block_info node b >>= fun bi ->
-      RPC.Answer.return bi.timestamp in
-    RPC.register1 dir
+      RPC_server.Answer.return bi.timestamp in
+    RPC_server.register1 dir
      Services.Blocks.timestamp implementation in
  let dir =
    let implementation b () =
      Node.RPC.block_info node b >>= fun bi ->
-      RPC.Answer.return bi.protocol in
-    RPC.register1 dir
+      RPC_server.Answer.return bi.protocol in
+    RPC_server.register1 dir
      Services.Blocks.protocol implementation in
  let dir =
    let implementation b () =
      Node.RPC.block_info node b >>= fun bi ->
-      RPC.Answer.return bi.test_network in
-    RPC.register1 dir
+      RPC_server.Answer.return bi.test_network in
+    RPC_server.register1 dir
      Services.Blocks.test_network implementation in
  let dir =
    let implementation b { Node_rpc_services.Blocks.contents ; monitor } =
@ -110,19 +110,19 @@ let register_bi_dir node dir =
          Node.RPC.operation_hashes node b >>= fun hashes ->
          if contents then
            Node.RPC.operations node b >>= fun ops ->
-            RPC.Answer.return @@
+            RPC_server.Answer.return @@
            List.map2 (List.map2 (fun h op -> h, Some op)) hashes ops
          else
-            RPC.Answer.return @@
+            RPC_server.Answer.return @@
            List.map (List.map (fun h -> h, None)) hashes
    in
-    RPC.register1 dir
+    RPC_server.register1 dir
      Services.Blocks.operations implementation in
  let dir =
    let implementation b () =
      Node.RPC.pending_operations node b >>= fun res ->
-      RPC.Answer.return res in
-    RPC.register1 dir
+      RPC_server.Answer.return res in
+    RPC_server.register1 dir
      Services.Blocks.pending_operations
      implementation in
  let dir =
@ -132,15 +132,15 @@ let register_bi_dir node dir =
      Node.RPC.preapply node b
        ~timestamp ~proto_header ~sort_operations operations >>= function
      | Ok (shell_header, operations) ->
-          RPC.Answer.return
+          RPC_server.Answer.return
            (Ok { Services.Blocks.shell_header ; operations })
-      | Error _ as err -> RPC.Answer.return err in
-    RPC.register1 dir
+      | Error _ as err -> RPC_server.Answer.return err in
+    RPC_server.register1 dir
      Services.Blocks.preapply implementation in
  dir

 let ops_dir _node =
-  let ops_dir = RPC.empty in
+  let ops_dir = RPC_server.empty in
  ops_dir

 let rec insert_future_block (bi: Services.Blocks.block_info) = function
@ -303,7 +303,7 @@ let list_blocks
      List.map
        (List.map (filter_bi include_ops))
        requested_blocks in
-    RPC.Answer.return infos
+    RPC_server.Answer.return infos
  else begin
    let (bi_stream, stopper) = Node.RPC.block_watcher node in
    let stream =
@ -325,12 +325,12 @@ let list_blocks
          List.map (List.map (filter_bi include_ops)) requested_blocks in
        Lwt.return (Some infos)
      end in
-    RPC.Answer.return_stream { next ; shutdown }
+    RPC_server.Answer.return_stream { next ; shutdown }
  end

 let list_invalid node () =
  Node.RPC.list_invalid node >>= fun l ->
-  RPC.Answer.return l
+  RPC_server.Answer.return l

 let list_protocols node {Services.Protocols.monitor; contents} =
  let monitor = match monitor with None -> false | Some x -> x in
@ -346,7 +346,7 @@ let list_protocols node {Services.Protocols.monitor; contents} =
         Lwt.return (hash, None))
    protocols >>= fun protocols ->
  if not monitor then
-    RPC.Answer.return protocols
+    RPC_server.Answer.return protocols
  else
    let stream, stopper = Node.RPC.protocol_watcher node in
    let shutdown () = Lwt_watcher.shutdown stopper in
@ -361,19 +361,19 @@ let list_protocols node {Services.Protocols.monitor; contents} =
        first_request := false ;
        Lwt.return (Some protocols)
      end in
-    RPC.Answer.return_stream { next ; shutdown }
+    RPC_server.Answer.return_stream { next ; shutdown }

 let get_protocols node hash () =
  Node.RPC.protocol_content node hash >>= function
-  | Ok bytes -> RPC.Answer.return bytes
+  | Ok bytes -> RPC_server.Answer.return bytes
  | Error _ -> raise Not_found

 let build_rpc_directory node =
-  let dir = RPC.empty in
+  let dir = RPC_server.empty in
  let dir =
-    RPC.register0 dir Services.Blocks.list (list_blocks node) in
+    RPC_server.register0 dir Services.Blocks.list (list_blocks node) in
  let dir =
-    RPC.register0 dir Services.Blocks.list_invalid (list_invalid node) in
+    RPC_server.register0 dir Services.Blocks.list_invalid (list_invalid node) in
  let dir = register_bi_dir node dir in
  let dir =
    let implementation block =
@ -381,21 +381,21 @@ let build_rpc_directory node =
          Node.RPC.context_dir node block >>= function
          | None -> Lwt.fail Not_found
          | Some context_dir -> Lwt.return context_dir)
-        (fun _ -> Lwt.return RPC.empty) in
-    RPC.register_dynamic_directory1
+        (fun _ -> Lwt.return RPC_server.empty) in
+    RPC_server.register_dynamic_directory1
      ~descr:
        "All the RPCs which are specific to the protocol version."
      dir Services.Blocks.proto_path implementation in
  let dir =
-    RPC.register0 dir Services.Protocols.list (list_protocols node) in
+    RPC_server.register0 dir Services.Protocols.list (list_protocols node) in
  let dir =
-    RPC.register1 dir Services.Protocols.contents (get_protocols node) in
+    RPC_server.register1 dir Services.Protocols.contents (get_protocols node) in
  let dir =
    let implementation header =
      let res =
        Data_encoding.Binary.to_bytes Block_header.encoding header in
-      RPC.Answer.return res in
-    RPC.register0 dir Services.forge_block_header implementation in
+      RPC_server.Answer.return res in
+    RPC_server.register0 dir Services.forge_block_header implementation in
  let dir =
    let implementation
        { Node_rpc_services.raw ; blocking ; force ; operations } =
@ -404,88 +404,88 @@ let build_rpc_directory node =
          node ~force
          raw operations >>=? fun (hash, wait) ->
        (if blocking then wait else return ()) >>=? fun () -> return hash
-      end >>= RPC.Answer.return in
-    RPC.register0 dir Services.inject_block implementation in
+      end >>= RPC_server.Answer.return in
+    RPC_server.register0 dir Services.inject_block implementation in
  let dir =
    let implementation (contents, blocking, net_id, force) =
      Node.RPC.inject_operation
        node ?force ?net_id contents >>= fun (hash, wait) ->
      begin
        (if blocking then wait else return ()) >>=? fun () -> return hash
-      end >>= RPC.Answer.return in
-    RPC.register0 dir Services.inject_operation implementation in
+      end >>= RPC_server.Answer.return in
+    RPC_server.register0 dir Services.inject_operation implementation in
  let dir =
    let implementation (proto, blocking, force) =
      Node.RPC.inject_protocol ?force node proto >>= fun (hash, wait) ->
      begin
        (if blocking then wait else return ()) >>=? fun () -> return hash
-      end >>= RPC.Answer.return in
-    RPC.register0 dir Services.inject_protocol implementation in
+      end >>= RPC_server.Answer.return in
+    RPC_server.register0 dir Services.inject_protocol implementation in
  let dir =
    let implementation () =
-      RPC.Answer.return_stream (Node.RPC.bootstrapped node) in
-    RPC.register0 dir Services.bootstrapped implementation in
+      RPC_server.Answer.return_stream (Node.RPC.bootstrapped node) in
+    RPC_server.register0 dir Services.bootstrapped implementation in
  let dir =
    let implementation () =
-      RPC.Answer.return
+      RPC_server.Answer.return
        Data_encoding.Json.(schema Error_monad.error_encoding) in
-    RPC.register0 dir Services.Error.service implementation in
+    RPC_server.register0 dir Services.Error.service implementation in
  let dir =
-    RPC.register1 dir Services.complete
+    RPC_server.register1 dir Services.complete
      (fun s () ->
-         Node.RPC.complete node s >>= RPC.Answer.return) in
+         Node.RPC.complete node s >>= RPC_server.Answer.return) in
  let dir =
-    RPC.register2 dir Services.Blocks.complete
+    RPC_server.register2 dir Services.Blocks.complete
      (fun block s () ->
-         Node.RPC.complete node ~block s >>= RPC.Answer.return) in
+         Node.RPC.complete node ~block s >>= RPC_server.Answer.return) in

  (* Network : Global *)

  let dir =
    let implementation () =
-      Node.RPC.Network.stat node |> RPC.Answer.return in
-    RPC.register0 dir Services.Network.stat implementation in
+      Node.RPC.Network.stat node |> RPC_server.Answer.return in
+    RPC_server.register0 dir Services.Network.stat implementation in
  let dir =
    let implementation () =
-      RPC.Answer.return Distributed_db.Raw.supported_versions in
-    RPC.register0 dir Services.Network.versions implementation in
+      RPC_server.Answer.return Distributed_db.Raw.supported_versions in
+    RPC_server.register0 dir Services.Network.versions implementation in
  let dir =
    let implementation () =
      let stream, stopper = Node.RPC.Network.watch node in
      let shutdown () = Lwt_watcher.shutdown stopper in
      let next () = Lwt_stream.get stream in
-      RPC.Answer.return_stream { next ; shutdown } in
-    RPC.register0 dir Services.Network.events implementation in
+      RPC_server.Answer.return_stream { next ; shutdown } in
+    RPC_server.register0 dir Services.Network.events implementation in
  let dir =
    let implementation point timeout =
-      Node.RPC.Network.connect node point timeout >>= RPC.Answer.return in
-    RPC.register1 dir Services.Network.connect implementation in
+      Node.RPC.Network.connect node point timeout >>= RPC_server.Answer.return in
+    RPC_server.register1 dir Services.Network.connect implementation in

  (* Network : Connection *)

  let dir =
    let implementation peer_id () =
-      Node.RPC.Network.Connection.info node peer_id |> RPC.Answer.return in
-    RPC.register1 dir Services.Network.Connection.info implementation in
+      Node.RPC.Network.Connection.info node peer_id |> RPC_server.Answer.return in
+    RPC_server.register1 dir Services.Network.Connection.info implementation in
  let dir =
    let implementation peer_id wait =
-      Node.RPC.Network.Connection.kick node peer_id wait >>= RPC.Answer.return in
-    RPC.register1 dir Services.Network.Connection.kick implementation in
+      Node.RPC.Network.Connection.kick node peer_id wait >>= RPC_server.Answer.return in
+    RPC_server.register1 dir Services.Network.Connection.kick implementation in
  let dir =
    let implementation () =
-      Node.RPC.Network.Connection.list node |> RPC.Answer.return in
-    RPC.register0 dir Services.Network.Connection.list implementation in
+      Node.RPC.Network.Connection.list node |> RPC_server.Answer.return in
+    RPC_server.register0 dir Services.Network.Connection.list implementation in

  (* Network : Peer_id *)

  let dir =
    let implementation state =
-      Node.RPC.Network.Peer_id.list node state |> RPC.Answer.return in
-    RPC.register0 dir Services.Network.Peer_id.list implementation in
+      Node.RPC.Network.Peer_id.list node ~restrict:state |> RPC_server.Answer.return in
+    RPC_server.register0 dir Services.Network.Peer_id.list implementation in
  let dir =
    let implementation peer_id () =
-      Node.RPC.Network.Peer_id.info node peer_id |> RPC.Answer.return in
-    RPC.register1 dir Services.Network.Peer_id.info implementation in
+      Node.RPC.Network.Peer_id.info node peer_id |> RPC_server.Answer.return in
+    RPC_server.register1 dir Services.Network.Peer_id.info implementation in
  let dir =
    let implementation peer_id monitor =
      if monitor then
@ -499,21 +499,21 @@ let build_rpc_directory node =
            first_request := false ;
            Lwt.return_some @@ Node.RPC.Network.Peer_id.events node peer_id
          end in
-        RPC.Answer.return_stream { next ; shutdown }
+        RPC_server.Answer.return_stream { next ; shutdown }
      else
-        Node.RPC.Network.Peer_id.events node peer_id |> RPC.Answer.return in
-    RPC.register1 dir Services.Network.Peer_id.events implementation in
+        Node.RPC.Network.Peer_id.events node peer_id |> RPC_server.Answer.return in
+    RPC_server.register1 dir Services.Network.Peer_id.events implementation in

  (* Network : Point *)

  let dir =
    let implementation state =
-      Node.RPC.Network.Point.list node state |> RPC.Answer.return in
-    RPC.register0 dir Services.Network.Point.list implementation in
+      Node.RPC.Network.Point.list node ~restrict:state |> RPC_server.Answer.return in
+    RPC_server.register0 dir Services.Network.Point.list implementation in
  let dir =
    let implementation point () =
-      Node.RPC.Network.Point.info node point |> RPC.Answer.return in
-    RPC.register1 dir Services.Network.Point.info implementation in
+      Node.RPC.Network.Point.info node point |> RPC_server.Answer.return in
+    RPC_server.register1 dir Services.Network.Point.info implementation in
  let dir =
    let implementation point monitor =
      if monitor then
@ -527,10 +527,10 @@ let build_rpc_directory node =
            first_request := false ;
            Lwt.return_some @@ Node.RPC.Network.Point.events node point
          end in
-        RPC.Answer.return_stream { next ; shutdown }
+        RPC_server.Answer.return_stream { next ; shutdown }
      else
-        Node.RPC.Network.Point.events node point |> RPC.Answer.return in
-    RPC.register1 dir Services.Network.Point.events implementation in
+        Node.RPC.Network.Point.events node point |> RPC_server.Answer.return in
+    RPC_server.register1 dir Services.Network.Point.events implementation in
  let dir =
-    RPC.Directory.register_describe_directory_service dir Services.describe in
+    RPC_server.Directory.register_describe_directory_service dir Services.describe in
  dir
--- a/lib_node_shell/node_rpc.mli
+++ b/lib_node_shell/node_rpc.mli
@ -7,4 +7,4 @@
 (*                                                                        *)
 (**************************************************************************)

-val build_rpc_directory: Node.t -> unit RPC.directory
+val build_rpc_directory: Node.t -> unit RPC_server.directory
--- a/lib_node_shell/prevalidation.ml
+++ b/lib_node_shell/prevalidation.ml
@ -7,80 +7,7 @@
 (*                                                                        *)
 (**************************************************************************)

-
-type 'error preapply_result = {
-  applied: (Operation_hash.t * Operation.t) list;
-  refused: (Operation.t * 'error list) Operation_hash.Map.t;
-  branch_refused: (Operation.t * 'error list) Operation_hash.Map.t;
-  branch_delayed: (Operation.t * 'error list) Operation_hash.Map.t;
-}
-
-let empty_result = {
-  applied = [] ;
-  refused = Operation_hash.Map.empty ;
-  branch_refused = Operation_hash.Map.empty ;
-  branch_delayed = Operation_hash.Map.empty ;
-}
-
-let map_result f r = {
-  applied = r.applied;
-  refused = Operation_hash.Map.map f r.refused ;
-  branch_refused = Operation_hash.Map.map f r.branch_refused ;
-  branch_delayed = Operation_hash.Map.map f r.branch_delayed ;
-}
-
-let preapply_result_encoding error_encoding =
-  let open Data_encoding in
-  let operation_encoding =
-    merge_objs
-      (obj1 (req "hash" Operation_hash.encoding))
-      (dynamic_size Operation.encoding) in
-  let refused_encoding =
-    merge_objs
-      (obj1 (req "hash" Operation_hash.encoding))
-      (merge_objs
-         (dynamic_size Operation.encoding)
-         (obj1 (req "error" error_encoding))) in
-  let build_list map = Operation_hash.Map.bindings map in
-  let build_map list =
-    List.fold_right
-      (fun (k, e) m -> Operation_hash.Map.add k e m)
-      list Operation_hash.Map.empty in
-  conv
-    (fun { applied ; refused ; branch_refused ; branch_delayed } ->
-       (applied, build_list refused,
-        build_list branch_refused, build_list branch_delayed))
-    (fun (applied, refused, branch_refused, branch_delayed) ->
-       let refused = build_map refused in
-       let branch_refused = build_map branch_refused in
-       let branch_delayed = build_map branch_delayed in
-       { applied ; refused ; branch_refused ; branch_delayed })
-    (obj4
-       (req "applied" (list operation_encoding))
-       (req "refused" (list refused_encoding))
-       (req "branch_refused" (list refused_encoding))
-       (req "branch_delayed" (list refused_encoding)))
-
-let preapply_result_operations t =
-  let ops =
-    List.fold_left
-      (fun acc (h, op) -> Operation_hash.Map.add h op acc)
-      Operation_hash.Map.empty t.applied in
-  let ops =
-    Operation_hash.Map.fold
-      (fun h (op, _err) acc -> Operation_hash.Map.add h op acc)
-      t.branch_delayed ops in
-  let ops =
-    Operation_hash.Map.fold
-      (fun h (op, _err) acc -> Operation_hash.Map.add h op acc)
-      t.branch_refused ops in
-  ops
-
-let empty_result =
-  { applied = [] ;
-    refused = Operation_hash.Map.empty ;
-    branch_refused = Operation_hash.Map.empty ;
-    branch_delayed = Operation_hash.Map.empty }
+open Preapply_result

 let rec apply_operations apply_operation state r max_ops ~sort ops =
  Lwt_list.fold_left_s
@ -235,7 +162,7 @@ let prevalidate
      Proto.apply_operation state parse_op in
  apply_operations
    apply_operation
-    state empty_result max_number_of_operations
+    state Preapply_result.empty max_number_of_operations
    ~sort sorted_ops >>= fun (state, max_number_of_operations, r) ->
  let r =
    { r with
--- a/lib_node_shell/prevalidation.mli
+++ b/lib_node_shell/prevalidation.mli
@ -7,25 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)

-type 'error preapply_result = {
-  applied: (Operation_hash.t * Operation.t) list;
-  refused: (Operation.t * 'error list) Operation_hash.Map.t;
-  (* e.g. invalid signature *)
-  branch_refused: (Operation.t * 'error list) Operation_hash.Map.t;
-  (* e.g. insufficent balance *)
-  branch_delayed: (Operation.t * 'error list) Operation_hash.Map.t;
-  (* e.g. timestamp in the future *)
-}
-
-val empty_result : 'error preapply_result
-
-val preapply_result_operations :
-  'error preapply_result -> Operation.t Operation_hash.Map.t
-
-val preapply_result_encoding :
-  'error list Data_encoding.t ->
-  'error preapply_result Data_encoding.t
-
 type prevalidation_state

 val start_prevalidation :
@ -38,7 +19,7 @@ val start_prevalidation :
 val prevalidate :
  prevalidation_state -> sort:bool ->
  (Operation_hash.t * Operation.t) list ->
-  (prevalidation_state * error preapply_result) Lwt.t
+  (prevalidation_state * error Preapply_result.t) Lwt.t

 val end_prevalidation :
  prevalidation_state -> Updater.validation_result tzresult Lwt.t
--- a/lib_node_shell/prevalidator.ml
+++ b/lib_node_shell/prevalidator.ml
@ -8,6 +8,7 @@
 (**************************************************************************)

 open Logging.Node.Prevalidator
+open Preapply_result

 let list_pendings ?maintain_net_db  ~from_block ~to_block old_mempool =
  let rec pop_blocks ancestor block mempool =
@ -59,8 +60,8 @@ type t = {
  notify_operations: P2p.Peer_id.t -> Mempool.t -> unit ;
  prevalidate_operations:
    bool -> Operation.t list ->
-    (Operation_hash.t list * error preapply_result) tzresult Lwt.t ;
-  operations: unit -> error preapply_result * Operation.t Operation_hash.Map.t ;
+    (Operation_hash.t list * error Preapply_result.t) tzresult Lwt.t ;
+  operations: unit -> error Preapply_result.t * Operation.t Operation_hash.Map.t ;
  pending: ?block:State.Block.t -> unit -> Operation.t Operation_hash.Map.t Lwt.t ;
  timestamp: unit -> Time.t ;
  context: unit -> Updater.validation_result tzresult Lwt.t ;
@ -95,7 +96,7 @@ let create
  let pending = Operation_hash.Table.create 53 in
  let head = ref head in
  let mempool = ref Mempool.empty in
-  let operations = ref empty_result in
+  let operations = ref Preapply_result.empty in
  let operation_count = ref 0 in (* unprocessed + operations/mempool *)
  Chain_traversal.live_blocks
    !head
@ -171,7 +172,7 @@ let create
              Lwt.return (Ok state, r)
          | Error err ->
              let r =
-                { empty_result with
+                { Preapply_result.empty with
                  branch_delayed =
                    List.fold_left
                      (fun m (h, op) -> Operation_hash.Map.add h (op, err) m)
@ -354,7 +355,7 @@ let create
                  list_pendings
                    ~maintain_net_db:net_db
                    ~from_block:!head ~to_block:new_head
-                    (preapply_result_operations !operations) >>= fun new_mempool ->
+                    (Preapply_result.operations !operations) >>= fun new_mempool ->
                  Chain_traversal.live_blocks
                    new_head
                    (State.Block.max_operations_ttl new_head)
@ -365,7 +366,7 @@ let create
                  (* Reset the pre-validation context *)
                  head := new_head ;
                  mempool := Mempool.empty ;
-                  operations := empty_result ;
+                  operations := Preapply_result.empty ;
                  broadcast_unprocessed := false ;
                  unprocessed := new_mempool ;
                  operation_count := Operation_hash.Map.cardinal new_mempool ;
@ -410,7 +411,7 @@ let create
    cancel () >>= fun () ->
    prevalidation_worker in
  let pending ?block () =
-    let ops = preapply_result_operations !operations in
+    let ops = Preapply_result.operations !operations in
    match block with
    | None -> Lwt.return ops
    | Some to_block -> list_pendings ~from_block:!head ~to_block ops in
--- a/lib_node_shell/prevalidator.mli
+++ b/lib_node_shell/prevalidator.mli
@ -47,7 +47,7 @@ val inject_operation: t -> ?force:bool -> Operation.t -> unit tzresult Lwt.t

 val flush: t -> State.Block.t -> unit
 val timestamp: t -> Time.t
-val operations: t -> error Prevalidation.preapply_result * Operation.t Operation_hash.Map.t
+val operations: t -> error Preapply_result.t * Operation.t Operation_hash.Map.t
 val context: t -> Updater.validation_result tzresult Lwt.t

 val pending: ?block:State.Block.t -> t -> Operation.t Operation_hash.Map.t Lwt.t
--- a/lib_node_shell/state.mli
+++ b/lib_node_shell/state.mli
@ -139,7 +139,7 @@ module Block : sig

  val context: t -> Context.t Lwt.t
  val protocol_hash: t -> Protocol_hash.t Lwt.t
-  val test_network: t -> Context.test_network Lwt.t
+  val test_network: t -> Test_network_status.t Lwt.t

  val operation_hashes:
    t -> int ->
--- a/lib_node_updater/jbuild
+++ b/lib_node_updater/jbuild
@ -7,7 +7,9 @@
              tezos-micheline
              tezos-protocol-compiler
              tezos-storage
-              tezos-node-net
+              tezos-node-services
+              tezos-node-p2p-base
+              tezos-node-http
              dynlink))
  (flags (:standard -w -9+27-30-32-40@8
                    -safe-string
@ -15,7 +17,9 @@
                    -open Tezos_micheline
                    -open Tezos_protocol_compiler
                    -open Tezos_storage
-                    -open Tezos_node_net))))
+                    -open Tezos_node_services
+                    -open Tezos_node_http
+                    -open Tezos_node_p2p_base))))

 (alias
 ((name runtest_indent)
--- a/lib_node_updater/tezos_protocol_environment.ml
+++ b/lib_node_updater/tezos_protocol_environment.ml
@ -56,7 +56,10 @@ module Make(Param : sig val name: string end)() = struct
    module Block_header = Block_header
    module Protocol = Protocol
  end
-  module RPC = RPC
+  module RPC = struct
+    include RPC
+    include RPC_server
+  end
  module Micheline = Tezos_micheline.Micheline
  module Fitness = Fitness
  module Error_monad = struct
--- a/lib_node_updater/updater.ml
+++ b/lib_node_updater/updater.ml
@ -137,7 +137,7 @@ module Node_protocol_environment_sigs = struct
       and type Tezos_data.Operation.t = Operation.t
       and type Tezos_data.Block_header.shell_header = Block_header.shell_header
       and type Tezos_data.Block_header.t = Block_header.t
-       and type 'a RPC.Directory.t = 'a RPC.Directory.t
+       and type 'a RPC.Directory.t = 'a RPC_server.Directory.t
       and type Updater.validation_result = validation_result
       and type Updater.rpc_context = rpc_context

@ -182,7 +182,7 @@ module type RAW_PROTOCOL = sig
    validation_state -> operation -> validation_state tzresult Lwt.t
  val finalize_block:
    validation_state -> validation_result tzresult Lwt.t
-  val rpc_services: rpc_context RPC.directory
+  val rpc_services: rpc_context RPC_server.directory
  val configure_sandbox:
    Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t
 end
--- a/lib_node_updater/updater.mli
+++ b/lib_node_updater/updater.mli
@ -68,7 +68,7 @@ module type RAW_PROTOCOL = sig
    validation_state -> operation -> validation_state tzresult Lwt.t
  val finalize_block:
    validation_state -> validation_result tzresult Lwt.t
-  val rpc_services: rpc_context RPC.directory
+  val rpc_services: rpc_context RPC_server.directory
  val configure_sandbox:
    Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t
 end
@ -99,7 +99,7 @@ module Node_protocol_environment_sigs : sig
       and type Tezos_data.Operation.t = Operation.t
       and type Tezos_data.Block_header.shell_header = Block_header.shell_header
       and type Tezos_data.Block_header.t = Block_header.t
-       and type 'a RPC.Directory.t = 'a RPC.Directory.t
+       and type 'a RPC.Directory.t = 'a RPC_server.Directory.t
       and type Updater.validation_result = validation_result
       and type Updater.rpc_context = rpc_context

--- a/lib_storage/context.ml
+++ b/lib_storage/context.ml
@ -177,83 +177,17 @@ let get_protocol v =
 let set_protocol v key =
  raw_set v current_protocol_key (Protocol_hash.to_bytes key)

-type test_network =
-  | Not_running
-  | Forking of {
-      protocol: Protocol_hash.t ;
-      expiration: Time.t ;
-    }
-  | Running of {
-      net_id: Net_id.t ;
-      genesis: Block_hash.t ;
-      protocol: Protocol_hash.t ;
-      expiration: Time.t ;
-    }
-
-let pp_test_network ppf = function
-  | Not_running -> Format.fprintf ppf "@[<v 2>Not running@]"
-  | Forking { protocol ; expiration } ->
-      Format.fprintf ppf
-        "@[<v 2>Forking %a (expires %a)@]"
-        Protocol_hash.pp
-        protocol
-        Time.pp_hum
-        expiration
-  | Running { net_id ; genesis ; protocol ; expiration } ->
-      Format.fprintf ppf
-        "@[<v 2>Running %a\
-         @ Genesis: %a\
-         @ Net id: %a\
-         @ Expiration: %a@]"
-        Protocol_hash.pp protocol
-        Block_hash.pp genesis
-        Net_id.pp net_id
-        Time.pp_hum expiration
-
-let test_network_encoding =
-  let open Data_encoding in
-  union [
-    case ~tag:0
-      (obj1 (req "status" (constant "not_running")))
-      (function Not_running -> Some () | _ -> None)
-      (fun () -> Not_running) ;
-    case ~tag:1
-      (obj3
-         (req "status" (constant "forking"))
-         (req "protocol" Protocol_hash.encoding)
-         (req "expiration" Time.encoding))
-      (function
-        | Forking { protocol ; expiration } ->
-            Some ((), protocol, expiration)
-        | _ -> None)
-      (fun ((), protocol, expiration) ->
-         Forking { protocol ; expiration }) ;
-    case ~tag:2
-      (obj5
-         (req "status" (constant "running"))
-         (req "net_id" Net_id.encoding)
-         (req "genesis" Block_hash.encoding)
-         (req "protocol" Protocol_hash.encoding)
-         (req "expiration" Time.encoding))
-      (function
-        | Running { net_id ; genesis ; protocol ; expiration } ->
-            Some ((), net_id, genesis, protocol, expiration)
-        | _ -> None)
-      (fun ((), net_id, genesis, protocol, expiration) ->
-         Running { net_id ; genesis ; protocol ; expiration }) ;
-  ]
-
 let get_test_network v =
  raw_get v current_test_network_key >>= function
  | None -> Lwt.fail (Failure "Unexpected error (Context.get_test_network)")
  | Some data ->
-      match Data_encoding.Binary.of_bytes test_network_encoding data with
+      match Data_encoding.Binary.of_bytes Test_network_status.encoding data with
      | None -> Lwt.fail (Failure "Unexpected error (Context.get_test_network)")
      | Some r -> Lwt.return r

 let set_test_network v id =
  raw_set v current_test_network_key
-    (Data_encoding.Binary.to_bytes test_network_encoding id)
+    (Data_encoding.Binary.to_bytes Test_network_status.encoding id)
 let del_test_network v  = raw_del v current_test_network_key

 let fork_test_network v ~protocol ~expiration =
--- a/lib_storage/context.mli
+++ b/lib_storage/context.mli
@ -77,25 +77,9 @@ val set_master: index -> commit -> unit Lwt.t
 val get_protocol: context -> Protocol_hash.t Lwt.t
 val set_protocol: context -> Protocol_hash.t -> context Lwt.t

-type test_network =
-  | Not_running
-  | Forking of {
-      protocol: Protocol_hash.t ;
-      expiration: Time.t ;
-    }
-  | Running of {
-      net_id: Net_id.t ;
-      genesis: Block_hash.t ;
-      protocol: Protocol_hash.t ;
-      expiration: Time.t ;
-    }
+val get_test_network: context -> Test_network_status.t Lwt.t
+val set_test_network: context -> Test_network_status.t -> context Lwt.t

-val pp_test_network : Format.formatter -> test_network -> unit
-
-val test_network_encoding: test_network Data_encoding.t
-
-val get_test_network: context -> test_network Lwt.t
-val set_test_network: context -> test_network -> context Lwt.t
 val del_test_network: context -> context Lwt.t

 val reset_test_network: context -> Block_hash.t -> Time.t -> context Lwt.t
--- a/test/p2p/jbuild
+++ b/test/p2p/jbuild
@ -5,13 +5,16 @@
          test_p2p_connection_pool
          test_p2p_io_scheduler))
  (libraries (tezos-base
-              tezos-node-net
+              tezos-node-p2p-base
+              tezos-node-p2p
+              lwt.unix
              test_lib))
  (flags (:standard -w -9-32
                    -linkall
                    -safe-string
                    -open Tezos_base__TzPervasives
-                    -open Tezos_node_net))))
+                    -open Tezos_node_p2p_base
+                    -open Tezos_node_p2p))))

 (alias
 ((name buildtest)