Merge remote-tracking branch 'refs/remotes/gitlab/master'

.gitlab-ci.yml

@@ -89,6 +89,11 @@ build:
   dependencies:
     - build
 
+test:opam:
+  <<: *test_definition
+  script:
+    - ./scripts/check_opam_test.sh "$CI_PROJECT_DIR/$CI_CONFIG_PATH"
+
 test:ocp-indent:
   <<: *test_definition
   script:
@@ -109,15 +114,15 @@ test:p2p:io-scheduler:
   script:
     - jbuilder build @test/p2p/runtest_p2p_io_scheduler
 
-test:p2p:connection:
+test:p2p:socket:
   <<: *test_definition
   script:
-    - jbuilder build @test/p2p/runtest_p2p_connection
+    - jbuilder build @test/p2p/runtest_p2p_socket
 
-test:p2p:connection-pool:
+test:p2p:pool:
   <<: *test_definition
   script:
-    - jbuilder build @test/p2p/runtest_p2p_connection_pool
+    - jbuilder build @test/p2p/runtest_p2p_pool
 
 test:proto_alpha:transaction:
   <<: *test_definition
@@ -176,181 +181,190 @@ test:proto:sandbox:
   tags:
     - gitlab-org
 
+##BEGIN_OPAM##
+opam:00:tezos-stdlib:
+  <<: *opam_definition
+  variables:
+    package: tezos-stdlib
+
 opam:01:ocplib-resto:
   <<: *opam_definition
   variables:
     package: ocplib-resto
 
-opam:02:ocplib-resto-directory:
+opam:02:tezos-data-encoding:
-  <<: *opam_definition
-  variables:
-    package: ocplib-resto-directory
-
-opam:03:ocplib-resto-cohttp:
-  <<: *opam_definition
-  variables:
-    package: ocplib-resto-cohttp
-
-opam:04:ocplib-resto-json:
-  <<: *opam_definition
-  variables:
-    package: ocplib-resto-json
-
-opam:05:ocplib-ezresto:
-  <<: *opam_definition
-  variables:
-    package: ocplib-ezresto
-
-opam:06:ocplib-ezresto-directory:
-  <<: *opam_definition
-  variables:
-    package: ocplib-ezresto-directory
-
-opam:07:tezos-stdlib:
-  <<: *opam_definition
-  variables:
-    package: tezos-stdlib
-
-opam:08:tezos-data-encoding:
   <<: *opam_definition
   variables:
     package: tezos-data-encoding
 
-opam:09:tezos-error-monad:
+opam:03:ocplib-resto-directory:
+  <<: *opam_definition
+  variables:
+    package: ocplib-resto-directory
+
+opam:04:tezos-error-monad:
   <<: *opam_definition
   variables:
     package: tezos-error-monad
 
-opam:10:tezos-stdlib-lwt:
+opam:05:tezos-rpc:
+  <<: *opam_definition
+  variables:
+    package: tezos-rpc
+
+opam:06:tezos-stdlib-lwt:
   <<: *opam_definition
   variables:
     package: tezos-stdlib-lwt
 
-opam:11:tezos-crypto:
+opam:07:tezos-crypto:
   <<: *opam_definition
   variables:
     package: tezos-crypto
 
-opam:12:tezos-base:
+opam:08:tezos-base:
   <<: *opam_definition
   variables:
     package: tezos-base
 
-opam:13:tezos-node-p2p-base:
+opam:09:tezos-protocol-environment-sigs:
-  <<: *opam_definition
-  variables:
-    package: tezos-node-p2p-base
-
-opam:14:tezos-node-services:
-  <<: *opam_definition
-  variables:
-    package: tezos-node-services
-
-opam:15:tezos-protocol-environment-sigs:
   <<: *opam_definition
   variables:
     package: tezos-protocol-environment-sigs
 
-opam:16:irmin-leveldb:
+opam:10:irmin-leveldb:
   <<: *opam_definition
   variables:
     package: irmin-leveldb
 
-opam:17:tezos-micheline:
+opam:11:tezos-micheline:
   <<: *opam_definition
   variables:
     package: tezos-micheline
 
-opam:18:tezos-rpc-http:
+opam:12:tezos-protocol-compiler:
-  <<: *opam_definition
-  variables:
-    package: tezos-rpc-http
-
-opam:19:tezos-protocol-compiler:
   <<: *opam_definition
   variables:
     package: tezos-protocol-compiler
 
-opam:20:tezos-storage:
+opam:13:tezos-storage:
   <<: *opam_definition
   variables:
     package: tezos-storage
 
-opam:21:tezos-node-p2p:
+opam:14:ocplib-resto-cohttp:
   <<: *opam_definition
   variables:
-    package: tezos-node-p2p
+    package: ocplib-resto-cohttp
 
-opam:22:tezos-node-updater:
+opam:15:tezos-p2p:
   <<: *opam_definition
   variables:
-    package: tezos-node-updater
+    package: tezos-p2p
 
-opam:23:tezos-node-shell:
+opam:16:tezos-protocol-updater:
   <<: *opam_definition
   variables:
-    package: tezos-node-shell
+    package: tezos-protocol-updater
 
-opam:24:tezos-embedded-protocol-alpha:
+opam:17:tezos-rpc-http:
+  <<: *opam_definition
+  variables:
+    package: tezos-rpc-http
+
+opam:18:tezos-shell-services:
+  <<: *opam_definition
+  variables:
+    package: tezos-shell-services
+
+opam:19:tezos-shell:
+  <<: *opam_definition
+  variables:
+    package: tezos-shell
+
+opam:20:tezos-embedded-protocol-alpha:
   <<: *opam_definition
   variables:
     package: tezos-embedded-protocol-alpha
 
-opam:25:tezos-embedded-protocol-demo:
+opam:21:tezos-embedded-protocol-demo:
   <<: *opam_definition
   variables:
     package: tezos-embedded-protocol-demo
 
-opam:26:tezos-embedded-protocol-genesis:
+opam:22:tezos-embedded-protocol-genesis:
   <<: *opam_definition
   variables:
     package: tezos-embedded-protocol-genesis
 
-opam:27:tezos-client-base:
+opam:23:tezos-client-base:
   <<: *opam_definition
   variables:
     package: tezos-client-base
 
-opam:28:tezos-embedded-client-alpha:
+opam:24:tezos-client-alpha:
   <<: *opam_definition
   variables:
-    package: tezos-embedded-client-alpha
+    package: tezos-client-alpha
 
-opam:29:tezos-embedded-client-genesis:
+opam:25:tezos-protocol-environment-client:
   <<: *opam_definition
   variables:
-    package: tezos-embedded-client-genesis
+    package: tezos-protocol-environment-client
 
-opam:30:tezos-protocol-demo:
+opam:26:tezos-protocol-genesis:
-  <<: *opam_definition
-  variables:
-    package: tezos-protocol-demo
-
-opam:31:tezos-client:
-  <<: *opam_definition
-  variables:
-    package: tezos-client
-
-opam:32:tezos-node:
-  <<: *opam_definition
-  variables:
-    package: tezos-node
-
-opam:33:tezos-protocol-alpha:
-  <<: *opam_definition
-  variables:
-    package: tezos-protocol-alpha
-
-opam:34:tezos-protocol-genesis:
   <<: *opam_definition
   variables:
     package: tezos-protocol-genesis
 
-opam:35:tezos-test:
+opam:27:ocplib-resto-json:
+  <<: *opam_definition
+  variables:
+    package: ocplib-resto-json
+
+opam:28:tezos-client-genesis:
+  <<: *opam_definition
+  variables:
+    package: tezos-client-genesis
+
+opam:29:ocplib-ezresto:
+  <<: *opam_definition
+  variables:
+    package: ocplib-ezresto
+
+opam:30:tezos-client:
+  <<: *opam_definition
+  variables:
+    package: tezos-client
+
+opam:31:tezos-node:
+  <<: *opam_definition
+  variables:
+    package: tezos-node
+
+opam:32:ocplib-ezresto-directory:
+  <<: *opam_definition
+  variables:
+    package: ocplib-ezresto-directory
+
+opam:33:tezos-test:
   <<: *opam_definition
   variables:
     package: tezos-test
 
+opam:34:tezos-protocol-demo:
+  <<: *opam_definition
+  variables:
+    package: tezos-protocol-demo
+
+opam:35:tezos-protocol-alpha:
+  <<: *opam_definition
+  variables:
+    package: tezos-protocol-alpha
+
+
+##END_OPAM##
+
 ## Publishing (small) docker images with tezos binaries
 
 publish:docker:minimal:

Makefile

@@ -12,6 +12,10 @@ all:
 	@cp _build/default/src/bin_client/admin_main.exe tezos-admin-client
 	@cp _build/default/src/lib_protocol_compiler/main.exe tezos-protocol-compiler
 
+%.pkg:
+	@jbuilder build --dev $(patsubst %.opam,%.install, \
+				   $(shell find -name tezos-$*.opam))
+
 doc-html:
 	@jbuilder build @doc ${DEV}
 	@mkdir -p $$(pwd)/docs/_build/api/odoc
@@ -24,6 +28,7 @@ build-test:
 
 test:
 	@jbuilder runtest ${DEV}
+	@./scripts/check_opam_test.sh
 
 test-indent:
 	@jbuilder build @runtest_indent ${DEV}
@@ -40,3 +45,4 @@ clean:
 	@-make -C docs clean
 
 .PHONY: all test build-deps docker-image clean
+

scripts/alphanet.sh

@@ -300,7 +300,7 @@ check_endorser() {
 }
 
 assert_endorser() {
-    if ! check_baker; then
+    if ! check_endorser; then
         echo -e "\033[31mEndorser is not running!\033[0m"
         exit 0
     fi

scripts/alphanet_constants.patch

@@ -1,7 +1,7 @@
-diff --git a/src/lib_embedded_protocol_alpha/src/constants_repr.ml b/src/lib_embedded_protocol_alpha/src/constants_repr.ml
+diff --git a/src/proto_alpha/lib_protocol_alpha/src/constants_repr.ml b/src/proto_alpha/lib_protocol_alpha/src/constants_repr.ml
 index 61e79c8a..f91ce282 100644
---- a/src/lib_embedded_protocol_alpha/src/constants_repr.ml
+--- a/src/proto_alpha/lib_protocol_alpha/src/constants_repr.ml
-+++ b/src/lib_embedded_protocol_alpha/src/constants_repr.ml
++++ b/src/proto_alpha/lib_protocol_alpha/src/constants_repr.ml
 @@ -49,15 +49,14 @@ let read_public_key s =
    Ed25519.Public_key.of_bytes (Bytes.of_string (Hex_encode.hex_decode s))
  

scripts/check_opam_test.sh

@@ -0,0 +1,36 @@
+#! /bin/sh
+
+set -e
+
+script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
+src_dir="$(dirname "$script_dir")"
+
+opams=$(find "$src_dir" -name \*.opam -print)
+
+yml="${1:-$src_dir/.gitlab-ci.yml}"
+
+missing=
+for opam in $opams; do
+    file=$(basename $opam)
+    package=${file%.opam}
+    if ! grep -qe "opam:..:$package:\$" "$yml"; then
+        missing=yes
+        echo "Missing test for package '$package'."
+    fi
+done
+
+tested=$(grep -e '^opam:..:tezos-.*:$' "$yml" | cut -d: -f3)
+for package in $tested; do
+    found=$(find "$src_dir" -name $package.opam | wc -l 2>&1)
+    if [ $found != 1 ] ; then
+        missing=yes
+        echo "Test for unknown package '$package'."
+    fi
+done
+
+if ! [ -z "$missing" ]; then
+    echo
+    echo "You should update .gitlab-ci.yml by running: ./scripts/update_opam_test.sh"
+    echo
+    exit 1
+fi

scripts/update_opam_test.sh

@@ -0,0 +1,30 @@
+#! /bin/sh
+
+set -e
+
+script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
+src_dir="$(dirname "$script_dir")"
+
+. "$script_dir/opam-pin.sh"
+
+tmp=$(mktemp)
+
+sed -z 's/^\(.*##BEGIN_OPAM##\n\).*\(\n##END_OPAM##.*\)$/\1/' "$src_dir/.gitlab-ci.yml" > $tmp
+
+cpt=0
+for package in $packages; do
+    num=$(printf "%02d" $cpt)
+    cpt=$((cpt+1))
+    cat >> $tmp <<EOF
+opam:$num:$package:
+  <<: *opam_definition
+  variables:
+    package: $package
+
+EOF
+done
+
+sed -z 's/^\(.*##BEGIN_OPAM##\n\).*\(\n##END_OPAM##.*\)$/\2/' "$src_dir/.gitlab-ci.yml" >> $tmp
+
+mv $tmp "$src_dir/.gitlab-ci.yml"
+

src/bin_attacker/attacker_minimal.ml

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

src/bin_client/jbuild

@@ -6,8 +6,8 @@
   (libraries (tezos-base
               tezos-rpc-http
               tezos-client-base
-              tezos-embedded-client-genesis
+              tezos-client-genesis
-              tezos-embedded-client-alpha))
+              tezos-client-alpha))
   (flags (:standard -w -9+27-30-32-40@8
                     -safe-string
                     -open Tezos_base__TzPervasives

src/bin_client/tezos-client.opam

@@ -10,9 +10,9 @@ depends: [
   "ocamlfind" { build }
   "jbuilder" { build & >= "1.0+beta15" }
   "tezos-base"
-  "tezos-embedded-client-genesis"
-  "tezos-embedded-client-alpha"
   "tezos-client-base"
+  "tezos-client-genesis"
+  "tezos-client-alpha"
 ]
 build: [
   [ "jbuilder" "build" "-p" name "-j" jobs ]

src/bin_node/jbuild

@@ -4,12 +4,11 @@
  ((name main)
   (public_name tezos-node)
   (libraries (tezos-base
+              tezos-shell-services
               tezos-rpc-http
-              tezos-node-updater
+              tezos-p2p
-              tezos-node-p2p-base
+              tezos-shell
-              tezos-node-p2p
+              tezos-protocol-updater
-              tezos-node-shell-base
-              tezos-node-shell
               tezos-embedded-protocol-genesis
               tezos-embedded-protocol-demo
               tezos-embedded-protocol-alpha
@@ -18,12 +17,11 @@
   (flags (:standard -w -9+27-30-32-40@8
                     -safe-string
                     -open Tezos_base__TzPervasives
+                    -open Tezos_shell_services
                     -open Tezos_rpc_http
-                    -open Tezos_node_updater
+                    -open Tezos_p2p
-                    -open Tezos_node_p2p_base
+                    -open Tezos_shell
-                    -open Tezos_node_p2p
+                    -open Tezos_protocol_updater
-                    -open Tezos_node_shell_base
-                    -open Tezos_node_shell
                     -linkall))))
 
 (install

src/bin_node/node_config_file.ml

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

src/bin_node/node_config_file.mli

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

src/bin_node/node_identity_command.ml

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

src/bin_node/node_identity_file.ml

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

src/bin_node/node_identity_file.mli

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

src/bin_node/node_run_command.ml

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

src/bin_node/tezos-node.opam

@@ -10,6 +10,10 @@ depends: [
   "ocamlfind" { build }
   "jbuilder" { build & >= "1.0+beta15" }
   "tezos-base"
+  "tezos-rpc-http"
+  "tezos-p2p"
+  "tezos-shell"
+  "tezos-protocol-updater"
   "tezos-embedded-protocol-genesis"
   "tezos-embedded-protocol-demo"
   "tezos-embedded-protocol-alpha"

src/lib_base/block_hash.mli

@@ -7,4 +7,4 @@
 (*                                                                        *)
 (**************************************************************************)
 
-include S.INTERNAL_HASH
+include Tezos_crypto.S.INTERNAL_HASH

src/lib_base/block_locator.ml

@@ -7,6 +7,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Lwt.Infix
+
 type t = raw
 
 (** Non private version of Block_store_locator.t for coercions *)
@@ -21,37 +23,24 @@ let encoding =
      (req "current_head" (dynamic_size Block_header.encoding))
      (req "history" (dynamic_size (list Block_hash.encoding))))
 
-let predecessor (store : Store.Block.store) (b: Block_hash.t) =
+let compute ~pred (h: Block_hash.t) (bh: Block_header.t) sz =
-  Store.Block.Contents.read_exn (store, b) >>= fun contents ->
-  let predecessor = contents.header.shell.predecessor in
-  if Block_hash.equal b predecessor then
-    Lwt.return_none
-  else
-    Lwt.return_some predecessor
-
-let compute (store : Store.Block.store) (b: Block_hash.t) sz =
   let rec loop acc ~sz step cpt b =
     if sz = 0 then
       Lwt.return (List.rev acc)
     else
-      predecessor store b >>= function
+      pred b step >>= function
       | None ->
           Lwt.return (List.rev (b :: acc))
       | Some predecessor ->
           if cpt = 0 then
-            loop (b :: acc) ~sz:(sz - 1)
+            loop (b :: acc) ~sz:(sz - 1) (step * 2) 10 predecessor
-              (step * 2) (step * 20 - 1) predecessor
-          else if cpt mod step = 0 then
-            loop (b :: acc) ~sz:(sz - 1)
-              step (cpt - 1) predecessor
           else
-            loop acc ~sz step (cpt - 1) predecessor in
+            loop (b :: acc) ~sz:(sz - 1) step (cpt - 1) predecessor in
-  Store.Block.Contents.read_exn (store, b) >>= fun { header } ->
+  pred h 1 >>= function
-  predecessor store b >>= function
+  | None -> Lwt.return (bh, [])
-  | None -> Lwt.return (header, [])
   | Some p ->
       loop [] ~sz 1 9 p >>= fun hist ->
-      Lwt.return (header, hist)
+      Lwt.return (bh, hist)
 
 type validity =
   | Unknown

src/lib_base/block_locator.mli

@@ -17,9 +17,10 @@ val raw: t -> raw
 
 val encoding: t Data_encoding.t
 
-val compute: Store.Block.store -> Block_hash.t -> int -> t Lwt.t
+val compute:
-(** [compute block max_length] compute the sparse block locator for
+  pred:(Block_hash.t -> int -> Block_hash.t option Lwt.t) ->
-    the [block]. The locator contains at most [max_length] elements. *)
+  Block_hash.t -> Block_header.t -> int ->
+  t Lwt.t
 
 type validity =
   | Unknown

src/lib_base/context_hash.mli

@@ -7,4 +7,4 @@
 (*                                                                        *)
 (**************************************************************************)
 
-include S.INTERNAL_HASH
+include Tezos_crypto.S.INTERNAL_HASH

src/lib_base/jbuild

@@ -8,14 +8,16 @@
                     -open Tezos_crypto
                     -open Tezos_data_encoding
                     -open Tezos_error_monad
-                    -open Tezos_rpc_base
+                    -open Tezos_rpc
+                    -open Tezos_micheline
                     -safe-string))
   (libraries (tezos-stdlib
               tezos-stdlib-lwt
               tezos-crypto
               tezos-data-encoding
               tezos-error-monad
-              tezos-rpc-base
+              tezos-rpc
+              tezos-micheline
               calendar
               ezjsonm
               mtime.clock.os))))

src/lib_base/net_id.ml

@@ -7,6 +7,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Error_monad
+
 type t = string
 
 let name = "Net_id"

src/lib_base/net_id.mli

@@ -7,5 +7,5 @@
 (*                                                                        *)
 (**************************************************************************)
 
-include S.INTERNAL_HASH
+include Tezos_crypto.S.INTERNAL_HASH
 val of_block_hash: Block_hash.t -> t

src/lib_base/operation_hash.mli

@@ -7,4 +7,4 @@
 (*                                                                        *)
 (**************************************************************************)
 
-include S.INTERNAL_HASH
+include Tezos_crypto.S.INTERNAL_HASH

src/lib_base/operation_list_hash.mli

@@ -0,0 +1,11 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include Tezos_crypto.S.INTERNAL_MERKLE_TREE with type elt = Operation_hash.t
+

src/lib_base/operation_list_list_hash.mli

@@ -7,4 +7,4 @@
 (*                                                                        *)
 (**************************************************************************)
 
-include S.INTERNAL_MERKLE_TREE with type elt = Operation_list_hash.t
+include Tezos_crypto.S.INTERNAL_MERKLE_TREE with type elt = Operation_list_hash.t

src/lib_base/p2p_addr.ml

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

src/lib_base/p2p_addr.mli

@@ -7,5 +7,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-include S.INTERNAL_MERKLE_TREE with type elt = Operation_hash.t
+type t = Ipaddr.V6.t
+type port = int
 
+val encoding : t Data_encoding.t

src/lib_base/p2p_connection.ml

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

src/lib_base/p2p_connection.mli

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

src/lib_base/p2p_connection_id.mli

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

src/lib_base/p2p_identity.ml

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

src/lib_base/p2p_identity.mli

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

src/lib_base/p2p_peer.ml

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

src/lib_base/p2p_peer.mli

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

src/lib_base/p2p_point.ml

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

src/lib_base/p2p_point.mli

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

src/lib_base/p2p_stat.ml

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

src/lib_base/p2p_stat.mli

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

src/lib_base/p2p_version.ml

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

src/lib_base/p2p_version.mli

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

src/lib_base/protocol_environment.ml

@@ -7,6 +7,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Error_monad
+
 module Make(Param : sig val name: string end)() = struct
 
   include Pervasives
@@ -40,52 +42,33 @@ module Make(Param : sig val name: string end)() = struct
   module Data_encoding = Data_encoding
   module Time = Time
   module Ed25519 = Ed25519
-  module Hash = struct
+  module S = struct
-    include Tezos_crypto
     include Tezos_crypto.S
-    module Make_minimal_Blake2B = Blake2B.Make_minimal
+    include S
-    module Make_Blake2B = Blake2B.Make
   end
+  module Block_hash = Block_hash
+  module Operation_hash = Operation_hash
+  module Operation_list_hash = Operation_list_hash
+  module Operation_list_list_hash = Operation_list_list_hash
+  module Context_hash = Context_hash
+  module Protocol_hash = Protocol_hash
   module Blake2B = Blake2B
-  module Tezos_data = struct
-    module type DATA = Tezos_base.S.T
-    module type HASHABLE_DATA = Tezos_base.S.HASHABLE
   module Fitness = Fitness
   module Operation = Operation
   module Block_header = Block_header
   module Protocol = Protocol
-  end
   module RPC_arg = RPC_arg
   module RPC_path = RPC_path
   module RPC_query = RPC_query
   module RPC_service = RPC_service
   module RPC_answer = RPC_answer
   module RPC_directory = RPC_directory
-  module Micheline = Tezos_micheline.Micheline
-  module Fitness = Fitness
   module Error_monad = struct
     type error_category = [ `Branch | `Temporary | `Permanent ]
     include Error_monad.Make()
   end
-  module Updater = struct
+  module Micheline = Micheline
-    include Updater
-    module type PROTOCOL =
-      RAW_PROTOCOL with type error := Error_monad.error
-                    and type 'a tzresult := 'a Error_monad.tzresult
-  end
   module Logging = Logging.Make(Param)
-  module Base58 = struct
-    include Base58
-    let simple_encode enc s = simple_encode enc s
-    let simple_decode enc s = simple_decode enc s
-    include Make(struct type context = Context.t end)
-    let decode s = decode s
-  end
-  module Context = struct
-    include Context
-    let register_resolver = Base58.register_resolver
-    let complete ctxt s = Base58.complete ctxt s
-  end
 
   type error += Ecoproto_error of Error_monad.error list
 

src/lib_base/protocol_hash.mli

@@ -7,4 +7,4 @@
 (*                                                                        *)
 (**************************************************************************)
 
-include S.INTERNAL_HASH
+include Tezos_crypto.S.INTERNAL_HASH

src/lib_base/tezos-base.opam

@@ -14,6 +14,8 @@ depends: [
   "tezos-crypto"
   "tezos-data-encoding"
   "tezos-error-monad"
+  "tezos-micheline"
+  "tezos-rpc"
   "ezjsonm" { >= "0.5.0" }
   "calendar"
   "mtime" { >= "1.0.0" }

src/lib_base/time.ml

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

src/lib_base/time.mli

@@ -56,3 +56,6 @@ val timed_encoding : 'a Data_encoding.t -> 'a timed_data Data_encoding.t
 module Set : Set.S with type elt = t
 module Map : Map.S with type key = t
 module Table : Hashtbl.S with type key = t
+
+val recent :
+  ('a * t) option -> ('a * t) option -> ('a * t) option

src/lib_base/tzPervasives.ml

@@ -9,10 +9,11 @@
 
 include Tezos_stdlib
 include Tezos_stdlib_lwt
-include Tezos_crypto
 include Tezos_data_encoding
 include Tezos_error_monad
-include Tezos_rpc_base
+include Tezos_rpc
+include Tezos_crypto
+include Tezos_micheline
 
 module List = struct
   include List
@@ -30,8 +31,27 @@ module Block_header = Block_header
 module Operation = Operation
 module Protocol = Protocol
 
+module Net_id = Net_id
+module Block_hash = Block_hash
+module Operation_hash = Operation_hash
+module Operation_list_hash = Operation_list_hash
+module Operation_list_list_hash = Operation_list_list_hash
+module Context_hash = Context_hash
+module Protocol_hash = Protocol_hash
+
 module Test_network_status = Test_network_status
 module Preapply_result = Preapply_result
 
+module Block_locator = Block_locator
+module Mempool = Mempool
+
+module P2p_addr = P2p_addr
+module P2p_identity = P2p_identity
+module P2p_peer = P2p_peer
+module P2p_point = P2p_point
+module P2p_connection = P2p_connection
+module P2p_stat = P2p_stat
+module P2p_version = P2p_version
+
 include Utils.Infix
 include Error_monad

src/lib_base/tzPervasives.mli

@@ -10,9 +10,9 @@
 include (module type of (struct include Tezos_stdlib end))
 include (module type of (struct include Tezos_data_encoding end))
 include (module type of (struct include Tezos_stdlib_lwt end))
-include (module type of (struct include Tezos_crypto end))
 include (module type of (struct include Tezos_error_monad end))
-include (module type of (struct include Tezos_rpc_base end))
+include (module type of (struct include Tezos_rpc end))
+include (module type of (struct include Tezos_crypto end))
 
 module List : sig
   include (module type of (struct include List end))
@@ -31,6 +31,24 @@ module Operation = Operation
 module Protocol = Protocol
 module Test_network_status = Test_network_status
 module Preapply_result = Preapply_result
+module Block_locator = Block_locator
+module Mempool = Mempool
+
+module Net_id = Net_id
+module Block_hash = Block_hash
+module Operation_hash = Operation_hash
+module Operation_list_hash = Operation_list_hash
+module Operation_list_list_hash = Operation_list_list_hash
+module Context_hash = Context_hash
+module Protocol_hash = Protocol_hash
+
+module P2p_addr = P2p_addr
+module P2p_identity = P2p_identity
+module P2p_peer = P2p_peer
+module P2p_point = P2p_point
+module P2p_connection = P2p_connection
+module P2p_stat = P2p_stat
+module P2p_version = P2p_version
 
 include (module type of (struct include Utils.Infix end))
 include (module type of (struct include Error_monad end))

src/lib_client_base/client_admin.ml

@@ -18,6 +18,6 @@ let commands () =
        @@ Block_hash.param ~name:"block" ~desc:"block to remove from invalid list"
        @@ stop)
       (fun () block (cctxt : Client_commands.full_context) ->
-         Client_rpcs.call_err_service0 cctxt Node_rpc_services.Blocks.unmark_invalid block >>=? fun () ->
+         Client_rpcs.call_err_service0 cctxt Block_services.unmark_invalid block >>=? fun () ->
          cctxt#message "Block %a no longer marked invalid" Block_hash.pp block >>= return) ;
   ]

src/lib_client_base/client_commands.ml

@@ -44,7 +44,7 @@ class type wallet = object
 end
 
 class type block = object
-  method block : Node_rpc_services.Blocks.block
+  method block : Block_services.block
 end
 
 class type logging_wallet = object

src/lib_client_base/client_commands.mli

@@ -28,7 +28,7 @@ class type wallet = object
 end
 
 class type block = object
-  method block : Node_rpc_services.Blocks.block
+  method block : Block_services.block
 end
 
 class type logging_wallet = object
@@ -56,7 +56,7 @@ end
 
 val make_context :
   ?base_dir:string ->
-  ?block:Node_rpc_services.Blocks.block ->
+  ?block:Block_services.block ->
   ?rpc_config:Client_rpcs.config ->
   (string -> string -> unit Lwt.t) -> full_context
 (** [make_context ?config log_fun] builds a context whose logging
@@ -81,4 +81,4 @@ val get_versions: unit -> (Protocol_hash.t * (command list)) list
 val force_switch : (bool, full_context) Cli_entries.arg
 
 val default_base_dir : string
-val default_block : Node_rpc_services.Blocks.block
+val default_block : Block_services.block

src/lib_client_base/client_config.ml

@@ -103,7 +103,7 @@ module Cfg_file = struct
 end
 
 type cli_args = {
-  block: Node_rpc_services.Blocks.block ;
+  block: Block_services.block ;
   protocol: Protocol_hash.t option ;
   print_timings: bool ;
   log_requests: bool ;
@@ -124,7 +124,7 @@ let string_parameter : (string, Client_commands.full_context) parameter =
 
 let block_parameter =
   parameter
-    (fun _ block -> match Node_rpc_services.Blocks.parse_block block with
+    (fun _ block -> match Block_services.parse_block block with
        | Error _ -> fail (Invalid_block_argument block)
        | Ok block -> return block)
 
@@ -161,7 +161,7 @@ let block_arg =
   default_arg
     ~parameter:"-block"
     ~doc:"The block on which to apply contextual commands."
-    ~default:(Node_rpc_services.Blocks.to_string default_cli_args.block)
+    ~default:(Block_services.to_string default_cli_args.block)
     block_parameter
 let protocol_arg =
   arg

src/lib_client_base/client_debug.ml

@@ -10,7 +10,7 @@
 (* Commands used to debug the node/alphanet *)
 
 let pp_block ppf
-    { Node_rpc_services.Blocks.hash ; net_id ; level ;
+    { Block_services.hash ; net_id ; level ;
       proto_level ; predecessor ; timestamp ;
       operations_hash ; fitness ; data ;
       operations ; protocol ; test_network } =
@@ -62,7 +62,7 @@ let registered_protocols ppf =
     (Client_commands.get_versions ())
 
 let print_heads ppf cctxt =
-  Client_rpcs.call_service0 cctxt Node_rpc_services.Blocks.list
+  Client_rpcs.call_service0 cctxt Block_services.list
     { include_ops = true ;
       length = Some 1 ;
       heads = None ;
@@ -82,7 +82,7 @@ let print_heads ppf cctxt =
 
 let print_rejected ppf cctxt =
   Client_rpcs.call_service0 cctxt
-    Node_rpc_services.Blocks.list_invalid () >>=? fun invalid ->
+    Block_services.list_invalid () >>=? fun invalid ->
   return @@
   Format.pp_print_list
     (fun ppf (hash, level, errors) ->

src/lib_client_base/client_network.ml

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

src/lib_client_base/client_node_rpcs.ml

@@ -10,48 +10,47 @@
 (* Tezos Command line interface - RPC Calls *)
 
 open Client_rpcs
-module Services = Node_rpc_services
 
 let errors (rpc : #Client_rpcs.ctxt) =
-  call_service0 rpc Services.Error.service ()
+  call_service0 rpc RPC_error.service ()
 
 let forge_block_header rpc header =
-  call_service0 rpc Services.forge_block_header header
+  call_service0 rpc Shell_services.forge_block_header header
 
 let inject_block cctxt
     ?(async = false) ?(force = false) ?net_id
     raw operations =
-  call_err_service0 cctxt Services.inject_block
+  call_err_service0 cctxt Shell_services.inject_block
     { raw ; blocking = not async ; force ; net_id ; operations }
 
 let inject_operation cctxt ?(async = false) ?net_id operation =
-  call_err_service0 cctxt Services.inject_operation
+  call_err_service0 cctxt Shell_services.inject_operation
     (operation, not async, net_id)
 
 let inject_protocol cctxt ?(async = false) ?force protocol =
-  call_err_service0 cctxt Services.inject_protocol
+  call_err_service0 cctxt Shell_services.inject_protocol
     (protocol, not async, force)
 
 let bootstrapped cctxt =
-  call_streamed_service0 cctxt Services.bootstrapped ()
+  call_streamed_service0 cctxt Shell_services.bootstrapped ()
 
 let complete cctxt ?block prefix =
   match block with
   | None ->
-      call_service1 cctxt Services.complete prefix ()
+      call_service1 cctxt Shell_services.complete prefix ()
   | Some block ->
-      call_service2 cctxt Services.Blocks.complete block prefix ()
+      call_service2 cctxt Block_services.complete block prefix ()
 
 let describe cctxt ?(recurse = true) path =
   Client_rpcs.call_service cctxt
-    Node_rpc_services.describe
+    Shell_services.describe
     ((), path) { recurse } ()
 
 module Blocks = struct
 
-  type block = Services.Blocks.block
+  type block = Block_services.block
 
-  type block_info = Services.Blocks.block_info = {
+  type block_info = Block_services.block_info = {
     hash: Block_hash.t ;
     net_id: Net_id.t ;
     level: Int32.t ;
@@ -67,57 +66,57 @@ module Blocks = struct
     protocol: Protocol_hash.t ;
     test_network: Test_network_status.t;
   }
-  type preapply_param = Services.Blocks.preapply_param = {
+  type preapply_param = Block_services.preapply_param = {
     timestamp: Time.t ;
     proto_header: MBytes.t ;
     operations: Operation.t list list ;
     sort_operations: bool ;
   }
-  type preapply_result = Services.Blocks.preapply_result = {
+  type preapply_result = Block_services.preapply_result = {
     shell_header: Block_header.shell_header ;
     operations: error Preapply_result.t list ;
   }
   let net_id cctxt h =
-    call_service1 cctxt Services.Blocks.net_id h ()
+    call_service1 cctxt Block_services.net_id h ()
   let level cctxt h =
-    call_service1 cctxt Services.Blocks.level h ()
+    call_service1 cctxt Block_services.level h ()
   let predecessor cctxt h =
-    call_service1 cctxt Services.Blocks.predecessor h ()
+    call_service1 cctxt Block_services.predecessor h ()
   let predecessors cctxt h l =
-    call_service1 cctxt Services.Blocks.predecessors h l
+    call_service1 cctxt Block_services.predecessors h l
   let hash cctxt h =
-    call_service1 cctxt Services.Blocks.hash h ()
+    call_service1 cctxt Block_services.hash h ()
   let timestamp cctxt h =
-    call_service1 cctxt Services.Blocks.timestamp h ()
+    call_service1 cctxt Block_services.timestamp h ()
   let fitness cctxt h =
-    call_service1 cctxt Services.Blocks.fitness h ()
+    call_service1 cctxt Block_services.fitness h ()
   let operations cctxt ?(contents = false) h =
-    call_service1 cctxt Services.Blocks.operations h
+    call_service1 cctxt Block_services.operations h
       { contents ; monitor = false }
   let protocol cctxt h =
-    call_service1 cctxt Services.Blocks.protocol h ()
+    call_service1 cctxt Block_services.protocol h ()
   let test_network cctxt h =
-    call_service1 cctxt Services.Blocks.test_network h ()
+    call_service1 cctxt Block_services.test_network h ()
 
   let preapply cctxt h
       ?(timestamp = Time.now ()) ?(sort = false) ~proto_header operations =
     call_err_service1
-      cctxt Services.Blocks.preapply h
+      cctxt Block_services.preapply h
       { timestamp ; proto_header ; sort_operations = sort ; operations }
   let pending_operations cctxt block =
-    call_service1 cctxt Services.Blocks.pending_operations block ()
+    call_service1 cctxt Block_services.pending_operations block ()
   let info cctxt ?(include_ops = true) h =
-    call_service1 cctxt Services.Blocks.info h include_ops
+    call_service1 cctxt Block_services.info h include_ops
   let complete cctxt block prefix =
-    call_service2 cctxt Services.Blocks.complete block prefix ()
+    call_service2 cctxt Block_services.complete block prefix ()
   let list cctxt ?(include_ops = false)
       ?length ?heads ?delay ?min_date ?min_heads () =
-    call_service0 cctxt Services.Blocks.list
+    call_service0 cctxt Block_services.list
       { include_ops ; length ; heads ; monitor = Some false ; delay ;
         min_date ; min_heads }
   let monitor cctxt ?(include_ops = false)
       ?length ?heads ?delay ?min_date ?min_heads () =
-    call_streamed_service0 cctxt Services.Blocks.list
+    call_streamed_service0 cctxt Block_services.list
       { include_ops ; length ; heads ; monitor = Some true ; delay ;
         min_date ; min_heads }
 
@@ -126,7 +125,7 @@ end
 module Operations = struct
 
   let monitor cctxt ?(contents = false) () =
-    call_streamed_service1 cctxt Services.Blocks.operations
+    call_streamed_service1 cctxt Block_services.operations
       `Prevalidation
       { contents ; monitor = true }
 
@@ -135,11 +134,11 @@ end
 module Protocols = struct
 
   let contents cctxt hash =
-    call_service1 cctxt Services.Protocols.contents hash ()
+    call_service1 cctxt Protocol_services.contents hash ()
 
   let list cctxt ?contents () =
     call_service0
-      cctxt Services.Protocols.list
+      cctxt Protocol_services.list
       { contents; monitor = Some false }
 
 end
@@ -147,15 +146,15 @@ end
 module Network = struct
 
   let stat cctxt =
-    call_service0 cctxt Services.Network.stat ()
+    call_service0 cctxt P2p_services.stat ()
 
   let connections cctxt =
-    call_service0 cctxt Services.Network.Connection.list ()
+    call_service0 cctxt P2p_services.Connection.list ()
 
   let peers cctxt =
-    call_service0 cctxt Services.Network.Peer_id.list []
+    call_service0 cctxt P2p_services.Peer_id.list []
 
   let points cctxt =
-    call_service0 cctxt Services.Network.Point.list []
+    call_service0 cctxt P2p_services.Point.list []
 
 end

src/lib_client_base/client_node_rpcs.mli

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

src/lib_client_base/client_rpcs.ml

@@ -130,7 +130,7 @@ let call_err_service1 ctxt service a1 body =
 let call_err_service2 ctxt service a1 a2 body =
   call_err_service ctxt service (((), a1), a2) () body
 
-type block = Node_rpc_services.Blocks.block
+type block = Block_services.block
 
 let last_baked_block = function
   | `Prevalidation -> `Head 0

src/lib_client_base/client_rpcs.mli

@@ -106,7 +106,7 @@ val call_err_service2:
    'o tzresult, 'e) RPC_service.t ->
   'a -> 'b -> 'i -> 'o tzresult Lwt.t
 
-type block = Node_rpc_services.Blocks.block
+type block = Block_services.block
 
 val last_baked_block:
   block -> [>

src/lib_client_base/jbuild

@@ -4,21 +4,13 @@
  ((name tezos_client_base)
   (public_name tezos-client-base)
   (libraries (tezos-base
-              tezos-storage
+              tezos-shell-services
-              tezos-rpc-http
+              tezos-rpc-http))
-              tezos-node-p2p-base
-              tezos-node-shell-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_rpc_http
-                    -open Tezos_node_p2p_base
+                    -open Tezos_shell_services))))
-                    -open Tezos_node_services
-                    -open Tezos_node_updater))))
 
 (alias
  ((name runtest_indent)

src/lib_client_base/tezos-client-base.opam

@@ -10,15 +10,9 @@ depends: [
   "ocamlfind" { build }
   "jbuilder" { build & >= "1.0+beta15" }
   "tezos-base"
+  "tezos-shell-services"
   "tezos-storage"
   "tezos-rpc-http"
-  "tezos-node-p2p-base"
-  "tezos-node-services"
-  "tezos-node-updater"
-  "tezos-protocol-compiler"
-  "tezos-embedded-protocol-genesis"
-  "tezos-embedded-protocol-demo"
-  "tezos-embedded-protocol-alpha"
   "cmdliner"
 ]
 build: [

src/lib_crypto/blake2B.ml

@@ -20,7 +20,18 @@ let () =
 
 (*-- Type specific Hash builder ---------------------------------------------*)
 
-module Make_minimal (K : S.Name) = struct
+module type Name = sig
+  val name : string
+  val title : string
+  val size : int option
+end
+
+module type PrefixedName = sig
+  include Name
+  val b58check_prefix : string
+end
+
+module Make_minimal (K : Name) = struct
 
   type t = Sodium.Generichash.hash
 
@@ -133,7 +144,7 @@ module Make (R : sig
       of_raw: (string -> 'a option) ->
       wrap: ('a -> Base58.data) ->
       'a Base58.encoding
-  end) (K : S.PrefixedName) = struct
+  end) (K : PrefixedName) = struct
 
   include Make_minimal(K)
 
@@ -353,7 +364,7 @@ module Make_merkle_tree
          wrap: ('a -> Base58.data) ->
          'a Base58.encoding
      end)
-    (K : S.PrefixedName)
+    (K : PrefixedName)
     (Contents: sig
        type t
        val to_bytes: t -> MBytes.t

src/lib_crypto/blake2B.mli

@@ -13,8 +13,25 @@
 
 include S.INTERNAL_MINIMAL_HASH
 
+(** {2 Building Hashes} *******************************************************)
+
+(** The parameters for creating a new Hash type using
+    {!Make_Blake2B}. Both {!name} and {!title} are only informative,
+    used in error messages and serializers. *)
+
+module type Name = sig
+  val name : string
+  val title : string
+  val size : int option
+end
+
+module type PrefixedName = sig
+  include Name
+  val b58check_prefix : string
+end
+
 (** Builds a new Hash type using Blake2B. *)
-module Make_minimal (Name : S.Name) : S.INTERNAL_MINIMAL_HASH
+module Make_minimal (Name : Name) : S.INTERNAL_MINIMAL_HASH
 module Make
     (Register : sig
        val register_encoding:
@@ -25,7 +42,7 @@ module Make
          wrap: ('a -> Base58.data) ->
          'a Base58.encoding
      end)
-    (Name : S.PrefixedName) : S.INTERNAL_HASH
+    (Name : PrefixedName) : S.INTERNAL_HASH
 
 (**/**)
 
@@ -39,7 +56,7 @@ module Make_merkle_tree
          wrap: ('a -> Base58.data) ->
          'a Base58.encoding
      end)
-    (K : S.PrefixedName)
+    (K : PrefixedName)
     (Contents: sig
        type t
        val to_bytes: t -> MBytes.t

src/lib_crypto/jbuild

@@ -6,14 +6,14 @@
   (flags (:standard -open Tezos_stdlib
                     -open Tezos_data_encoding
                     -open Tezos_stdlib_lwt
-                    -open Tezos_rpc_base
+                    -open Tezos_rpc
                     -open Tezos_error_monad__Error_monad
                     -safe-string))
   (libraries (tezos-stdlib
               tezos-stdlib-lwt
               tezos-data-encoding
               tezos-error-monad
-              tezos-rpc-base
+              tezos-rpc
               nocrypto
               sodium
               zarith))))

src/lib_crypto/s.ml

@@ -126,20 +126,3 @@ module type MERKLE_TREE = sig
   val check_path: path -> elt -> t * int
   val path_encoding: path Data_encoding.t
 end
-
-(** {2 Building Hashes} *******************************************************)
-
-(** The parameters for creating a new Hash type using
-    {!Make_Blake2B}. Both {!name} and {!title} are only informative,
-    used in error messages and serializers. *)
-
-module type Name = sig
-  val name : string
-  val title : string
-  val size : int option
-end
-
-module type PrefixedName = sig
-  include Name
-  val b58check_prefix : string
-end

src/lib_crypto/tezos-crypto.opam

@@ -13,7 +13,7 @@ depends: [
   "tezos-stdlib-lwt"
   "tezos-data-encoding"
   "tezos-error-monad"
-  "tezos-rpc-base"
+  "tezos-rpc"
   "nocrypto"
   "sodium"
   "zarith"

src/lib_embedded_client_alpha/jbuild

@@ -1,24 +0,0 @@
-(jbuild_version 1)
-
-(library
- ((name tezos_embedded_client_alpha)
-  (public_name tezos-embedded-client-alpha)
-  (libraries (tezos-base
-              tezos-embedded-protocol-alpha
-              tezos-embedded-protocol-alpha.raw
-              tezos-node-services
-              tezos-client-base))
-  (library_flags (:standard -linkall))
-  (flags (:standard -w -9+27-30-32-40@8
-                    -safe-string
-                    -open Tezos_base__TzPervasives
-                    -open Tezos_embedded_protocol_environment_alpha
-                    -open Tezos_embedded_raw_protocol_alpha
-                    -open Tezos_node_services
-                    -open Tezos_client_base
-                    -open Tezos_context))))
-
-(alias
- ((name runtest_indent)
-  (deps ((glob_files *.ml) (glob_files *.mli)))
-  (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^}))))

src/lib_embedded_client_genesis/jbuild

@@ -1,25 +0,0 @@
-(jbuild_version 1)
-
-(library
- ((name tezos_embedded_client_genesis)
-  (public_name tezos-embedded-client-genesis)
-  (libraries (tezos-base
-              tezos-embedded-protocol-genesis
-              tezos-embedded-protocol-genesis.raw
-              tezos-embedded-protocol-alpha.environment
-              tezos-embedded-protocol-alpha.raw
-              tezos-node-services
-              tezos-client-base))
-  (library_flags (:standard -linkall))
-  (flags (:standard -w -9+27-30-32-40@8
-                    -safe-string
-                    -open Tezos_base__TzPervasives
-                    -open Tezos_embedded_protocol_environment_genesis
-                    -open Tezos_embedded_raw_protocol_genesis
-                    -open Tezos_node_services
-                    -open Tezos_client_base))))
-
-(alias
- ((name runtest_indent)
-  (deps ((glob_files *.ml) (glob_files *.mli)))
-  (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^}))))

src/lib_embedded_protocol_alpha/jbuild

@@ -1 +0,0 @@
-../lib_protocol_compiler/jbuild_protocol_template

src/lib_embedded_protocol_alpha/src/jbuild

@@ -1 +0,0 @@
-../../lib_protocol_compiler/jbuild_embedded_protocol_template

src/lib_embedded_protocol_demo/jbuild

@@ -1 +0,0 @@
-../lib_protocol_compiler/jbuild_protocol_template

src/lib_embedded_protocol_demo/src/jbuild

@@ -1 +0,0 @@
-../../lib_protocol_compiler/jbuild_embedded_protocol_template

src/lib_embedded_protocol_genesis/jbuild

@@ -1 +0,0 @@
-../lib_protocol_compiler/jbuild_protocol_template

src/lib_embedded_protocol_genesis/src/jbuild

@@ -1 +0,0 @@
-../../lib_protocol_compiler/jbuild_embedded_protocol_template

src/lib_micheline/jbuild

@@ -8,11 +8,13 @@
     ;; External
     uutf
     ;; Internal
-    tezos-base
+    tezos-error-monad
+    tezos-data-encoding
     ))
   (flags (:standard -w -9+27-30-32-40@8
                     -safe-string
-                    -open Tezos_base__TzPervasives))))
+                    -open Tezos_error_monad
+                    -open Tezos_data_encoding))))
 
 (alias
  ((name runtest_indent)

src/lib_micheline/micheline_parser.ml

@@ -7,6 +7,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Error_monad
 open Micheline
 
 type 'a parsing_result = 'a * error list

src/lib_micheline/tezos-micheline.opam

@@ -9,7 +9,8 @@ license: "unreleased"
 depends: [
   "ocamlfind" { build }
   "jbuilder" { build & >= "1.0+beta15" }
-  "tezos-base"
+  "tezos-data-encoding"
+  "tezos-error-monad"
   "uutf"
 ]
 build: [

src/lib_node_p2p_base/p2p_connection_pool_types.ml

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

src/lib_node_p2p_base/p2p_connection_pool_types.mli

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

src/lib_node_p2p_base/p2p_types.ml

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

src/lib_node_p2p_base/p2p_types.mli

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

src/lib_node_services/jbuild

@@ -1,18 +0,0 @@
-(jbuild_version 1)
-
-(library
- ((name tezos_node_services)
-  (public_name tezos-node-services)
-  (libraries (tezos-base
-              tezos-node-p2p-base
-              tezos-node-shell-base))
-  (flags (:standard -w -9+27-30-32-40@8
-                    -safe-string
-                    -open Tezos_base__TzPervasives
-                    -open Tezos_node_p2p_base
-                    -open Tezos_node_shell_base))))
-
-(alias
- ((name runtest_indent)
-  (deps ((glob_files *.ml) (glob_files *.mli)))
-  (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^}))))

src/lib_node_services/node_rpc_services.ml

@@ -1,995 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*    Copyright (c) 2014 - 2017.                                          *)
-(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
-(*                                                                        *)
-(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
-(*                                                                        *)
-(**************************************************************************)
-
-open Data_encoding
-
-module Error = struct
-
-  let service =
-    RPC_service.post_service
-      ~description: "Schema for all the RPC errors from the shell"
-      ~query: RPC_query.empty
-      ~input: Data_encoding.empty
-      ~output: Data_encoding.json_schema
-      ~error: Data_encoding.empty
-      RPC_path.(root / "errors")
-
-  let encoding =
-    let { RPC_service.meth ; uri ; _ } =
-      RPC_service.forge_request service () () in
-    describe
-      ~description:
-        (Printf.sprintf
-           "The full list of error is available with \
-            the global RPC `%s %s`"
-           (RPC_service.string_of_meth meth) (Uri.path_and_query uri))
-      (conv
-         ~schema:Json_schema.any
-         (fun exn -> `A (List.map json_of_error exn))
-         (function `A exns -> List.map error_of_json exns | _ -> [])
-         json)
-
-  let wrap param_encoding =
-    union [
-      case (Tag 0)
-        (obj1 (req "ok" param_encoding))
-        (function Ok x -> Some x | _ -> None)
-        (fun x -> Ok x) ;
-      case (Tag 1)
-        (obj1 (req "error" encoding))
-        (function Error x -> Some x | _ -> None)
-        (fun x -> Error x) ;
-    ]
-
-end
-
-module Blocks = struct
-
-  type block = [
-    | `Genesis
-    | `Head of int | `Prevalidation
-    | `Test_head of int | `Test_prevalidation
-    | `Hash of Block_hash.t
-  ]
-
-  type block_info = {
-    hash: Block_hash.t ;
-    net_id: Net_id.t ;
-    level: Int32.t ;
-    proto_level: int ; (* uint8 *)
-    predecessor: Block_hash.t ;
-    timestamp: Time.t ;
-    validation_passes: int ; (* uint8 *)
-    operations_hash: Operation_list_list_hash.t ;
-    fitness: MBytes.t list ;
-    context: Context_hash.t ;
-    data: MBytes.t ;
-    operations: (Operation_hash.t * Operation.t) list list option ;
-    protocol: Protocol_hash.t ;
-    test_network: Test_network_status.t ;
-  }
-
-  let block_info_encoding =
-    let operation_encoding =
-      merge_objs
-        (obj1 (req "hash" Operation_hash.encoding))
-        Operation.encoding in
-    conv
-      (fun { hash ; net_id ; level ; proto_level ; predecessor ;
-             fitness ; timestamp ; protocol ;
-             validation_passes ; operations_hash ; context ; data ;
-             operations ; test_network } ->
-        ((hash, net_id, operations, protocol, test_network),
-         { Block_header.shell =
-             { level ; proto_level ; predecessor ;
-               timestamp ; validation_passes ; operations_hash ; fitness ;
-               context } ;
-           proto = data }))
-      (fun ((hash, net_id, operations, protocol, test_network),
-            { Block_header.shell =
-                { level ; proto_level ; predecessor ;
-                  timestamp ; validation_passes ; operations_hash ; fitness ;
-                  context } ;
-              proto = data }) ->
-        { hash ; net_id ; level ; proto_level ; predecessor ;
-          fitness ; timestamp ; protocol ;
-          validation_passes ; operations_hash ; context ; data ;
-          operations ; test_network })
-      (dynamic_size
-         (merge_objs
-            (obj5
-               (req "hash" Block_hash.encoding)
-               (req "net_id" Net_id.encoding)
-               (opt "operations" (dynamic_size (list (dynamic_size (list (dynamic_size operation_encoding))))))
-               (req "protocol" Protocol_hash.encoding)
-               (dft "test_network"
-                  Test_network_status.encoding Not_running))
-            Block_header.encoding))
-
-  let parse_block s =
-    try
-      match String.split '~' s with
-      | ["genesis"] -> Ok `Genesis
-      | ["head"] -> Ok (`Head 0)
-      | ["prevalidation"] -> Ok `Prevalidation
-      | ["test_head"] -> Ok (`Test_head 0)
-      | ["test_prevalidation"] -> Ok `Test_prevalidation
-      | ["head"; n] -> Ok (`Head (int_of_string n))
-      | ["test_head"; n] -> Ok (`Test_head (int_of_string n))
-      | [h] -> Ok (`Hash (Block_hash.of_b58check_exn h))
-      | _ -> raise Exit
-    with _ -> Error "Cannot parse block identifier."
-
-  let to_string = function
-    | `Genesis -> "genesis"
-    | `Head 0 -> "head"
-    | `Head n -> Printf.sprintf "head~%d" n
-    | `Prevalidation -> "prevalidation"
-    | `Test_head 0 -> "test_head"
-    | `Test_head n -> Printf.sprintf "test_head~%d" n
-    | `Test_prevalidation -> "test_prevalidation"
-    | `Hash h -> Block_hash.to_b58check h
-
-  let blocks_arg =
-    let name = "block_id" in
-    let descr =
-      "A block identifier. This is either a block hash in hexadecimal \
-       notation or a one the predefined aliases: \
-       'genesis', 'head', 'prevalidation', \
-       'test_head' or 'test_prevalidation'. One might alse use 'head~N'
-       to 'test_head~N', where N is an integer to denotes the Nth predecessors
-       of 'head' or 'test_head'." in
-    let construct = to_string in
-    let destruct = parse_block in
-    RPC_arg.make ~name ~descr ~construct ~destruct ()
-
-  let block_path : (unit, unit * block) RPC_path.path =
-    RPC_path.(root / "blocks" /: blocks_arg )
-
-  let info =
-    RPC_service.post_service
-      ~description:"All the information about a block."
-      ~query: RPC_query.empty
-      ~input: (obj1 (dft "operations" bool true))
-      ~output: block_info_encoding
-      ~error: Data_encoding.empty
-      block_path
-
-  let net_id =
-    RPC_service.post_service
-      ~description:"Returns the net of the chain in which the block belongs."
-      ~query: RPC_query.empty
-      ~input: empty
-      ~output: (obj1 (req "net_id" Net_id.encoding))
-      ~error: Data_encoding.empty
-      RPC_path.(block_path / "net_id")
-
-  let level =
-    RPC_service.post_service
-      ~description:"Returns the block's level."
-      ~query: RPC_query.empty
-      ~input: empty
-      ~output: (obj1 (req "level" int32))
-      ~error: Data_encoding.empty
-      RPC_path.(block_path / "level")
-
-  let predecessor =
-    RPC_service.post_service
-      ~description:"Returns the previous block's id."
-      ~query: RPC_query.empty
-      ~input: empty
-      ~output: (obj1 (req "predecessor" Block_hash.encoding))
-      ~error: Data_encoding.empty
-      RPC_path.(block_path / "predecessor")
-
-  let predecessors =
-    RPC_service.post_service
-      ~description:
-        "...."
-      ~query: RPC_query.empty
-      ~input: (obj1 (req "length" Data_encoding.uint16))
-      ~output: (obj1
-                  (req "blocks" (Data_encoding.list Block_hash.encoding)))
-      ~error: Data_encoding.empty
-      RPC_path.(block_path / "predecessors")
-
-  let hash =
-    RPC_service.post_service
-      ~description:"Returns the block's id."
-      ~query: RPC_query.empty
-      ~input: empty
-      ~output: (obj1 (req "hash" Block_hash.encoding))
-      ~error: Data_encoding.empty
-      RPC_path.(block_path / "hash")
-
-  let fitness =
-    RPC_service.post_service
-      ~description:"Returns the block's fitness."
-      ~query: RPC_query.empty
-      ~input: empty
-      ~output: (obj1 (req "fitness" Fitness.encoding))
-      ~error: Data_encoding.empty
-      RPC_path.(block_path / "fitness")
-
-  let context =
-    RPC_service.post_service
-      ~description:"Returns the hash of the resulting context."
-      ~query: RPC_query.empty
-      ~input: empty
-      ~output: (obj1 (req "context" Context_hash.encoding))
-      ~error: Data_encoding.empty
-      RPC_path.(block_path / "context")
-
-  let timestamp =
-    RPC_service.post_service
-      ~description:"Returns the block's timestamp."
-      ~query: RPC_query.empty
-      ~input: empty
-      ~output: (obj1 (req "timestamp" Time.encoding))
-      ~error: Data_encoding.empty
-      RPC_path.(block_path / "timestamp")
-
-  type operations_param = {
-    contents: bool ;
-    monitor: bool ;
-  }
-
-  let operations_param_encoding =
-    let open Data_encoding in
-    conv
-      (fun { contents ; monitor } -> (contents, monitor))
-      (fun (contents, monitor) -> { contents ; monitor })
-      (obj2
-         (dft "contents" bool false)
-         (dft "monitor" bool false))
-
-  let operations =
-    RPC_service.post_service
-      ~description:"List the block operations."
-      ~query: RPC_query.empty
-      ~input: operations_param_encoding
-      ~output: (obj1
-                  (req "operations"
-                     (list (list
-                              (obj2
-                                 (req "hash" Operation_hash.encoding)
-                                 (opt "contents"
-                                    (dynamic_size Operation.encoding)))))))
-      ~error: Data_encoding.empty
-      RPC_path.(block_path / "operations")
-
-  let protocol =
-    RPC_service.post_service
-      ~description:"List the block protocol."
-      ~query: RPC_query.empty
-      ~input: empty
-      ~output: (obj1 (req "protocol" Protocol_hash.encoding))
-      ~error: Data_encoding.empty
-      RPC_path.(block_path / "protocol")
-
-  let test_network =
-    RPC_service.post_service
-      ~description:"Returns the status of the associated test network."
-      ~query: RPC_query.empty
-      ~input: empty
-      ~output: Test_network_status.encoding
-      ~error: Data_encoding.empty
-      RPC_path.(block_path / "test_network")
-
-  let pending_operations =
-    let operation_encoding =
-      merge_objs
-        (obj1 (req "hash" Operation_hash.encoding))
-        Operation.encoding in
-    (* TODO: branch_delayed/... *)
-    RPC_service.post_service
-      ~description:
-        "List the not-yet-prevalidated operations."
-      ~query: RPC_query.empty
-      ~input: empty
-      ~output:
-        (conv
-           (fun (preapplied, unprocessed) ->
-              ({ preapplied with
-                 Preapply_result.refused = Operation_hash.Map.empty },
-               Operation_hash.Map.bindings unprocessed))
-           (fun (preapplied, unprocessed) ->
-              (preapplied,
-               List.fold_right
-                 (fun (h, op) m -> Operation_hash.Map.add h op m)
-                 unprocessed Operation_hash.Map.empty))
-           (merge_objs
-              (dynamic_size
-                 (Preapply_result.encoding Error.encoding))
-              (obj1 (req "unprocessed" (list (dynamic_size operation_encoding))))))
-      ~error: Data_encoding.empty
-      RPC_path.(block_path / "pending_operations")
-
-  let proto_path =
-    RPC_path.(block_path / "proto")
-
-  type preapply_param = {
-    timestamp: Time.t ;
-    proto_header: MBytes.t ;
-    operations: Operation.t list list ;
-    sort_operations: bool ;
-  }
-
-  let preapply_param_encoding =
-    (conv
-       (fun { timestamp ; proto_header ; operations ; sort_operations } ->
-          (timestamp, proto_header, operations, sort_operations))
-       (fun (timestamp, proto_header, operations, sort_operations) ->
-          { timestamp ; proto_header ; operations ; sort_operations })
-       (obj4
-          (req "timestamp" Time.encoding)
-          (req "proto_header" bytes)
-          (req "operations" (list (dynamic_size (list (dynamic_size Operation.encoding)))))
-          (dft "sort_operations" bool false)))
-
-  type preapply_result = {
-    shell_header: Block_header.shell_header ;
-    operations: error Preapply_result.t list ;
-  }
-
-  let preapply_result_encoding =
-    (conv
-       (fun { shell_header ; operations } ->
-          (shell_header, operations))
-       (fun (shell_header, operations) ->
-          { shell_header ; operations })
-       (obj2
-          (req "shell_header" Block_header.shell_header_encoding)
-          (req "operations"
-             (list (Preapply_result.encoding Error.encoding)))))
-
-  let preapply =
-    RPC_service.post_service
-      ~description:
-        "Simulate the validation of a block that would contain \
-         the given operations and return the resulting fitness."
-      ~query: RPC_query.empty
-      ~input: preapply_param_encoding
-      ~output: (Error.wrap preapply_result_encoding)
-      ~error: Data_encoding.empty
-      RPC_path.(block_path / "preapply")
-
-  let complete =
-    let prefix_arg =
-      let destruct s = Ok s
-      and construct s = s in
-      RPC_arg.make ~name:"prefix" ~destruct ~construct () in
-    RPC_service.post_service
-      ~description: "Try to complete a prefix of a Base58Check-encoded data. \
-                     This RPC is actually able to complete hashes of \
-                     block, operations, public_keys and contracts."
-      ~query: RPC_query.empty
-      ~input: empty
-      ~output: (list string)
-      ~error: Data_encoding.empty
-      RPC_path.(block_path / "complete" /: prefix_arg )
-
-  type list_param = {
-    include_ops: bool ;
-    length: int option ;
-    heads: Block_hash.t list option ;
-    monitor: bool option ;
-    delay: int option ;
-    min_date: Time.t option;
-    min_heads: int option;
-  }
-  let list_param_encoding =
-    conv
-      (fun { include_ops ; length ; heads ; monitor ;
-             delay ; min_date ; min_heads } ->
-        (include_ops, length, heads, monitor, delay, min_date, min_heads))
-      (fun (include_ops, length, heads, monitor,
-            delay, min_date, min_heads) ->
-        { include_ops ; length ; heads ; monitor ;
-          delay ; min_date ; min_heads })
-      (obj7
-         (dft "include_ops"
-            (Data_encoding.describe
-               ~description:
-                 "Whether the resulting block informations should include the \
-                  list of operations' hashes. Default false."
-               bool) false)
-         (opt "length"
-            (Data_encoding.describe
-               ~description:
-                 "The requested number of predecessors to returns (per \
-                  requested head)."
-               int31))
-         (opt "heads"
-            (Data_encoding.describe
-               ~description:
-                 "An empty argument requests blocks from the current heads. \
-                  A non empty list allow to request specific fragment \
-                  of the chain."
-               (list Block_hash.encoding)))
-         (opt "monitor"
-            (Data_encoding.describe
-               ~description:
-                 "When true, the socket is \"kept alive\" after the first \
-                  answer and new heads are streamed when discovered."
-               bool))
-         (opt "delay"
-            (Data_encoding.describe
-               ~description:
-                 "By default only the blocks that were validated by the node \
-                  are considered. \
-                  When this optional argument is 0, only blocks with a \
-                  timestamp in the past are considered. Other values allows to \
-                  adjust the current time."
-               int31))
-         (opt "min_date"
-            (Data_encoding.describe
-               ~description: "When `min_date` is provided, heads with a \
-                              timestamp before `min_date` are filtered ouf"
-               Time.encoding))
-         (opt "min_heads"
-            (Data_encoding.describe
-               ~description:"When `min_date` is provided, returns at least \
-                             `min_heads` even when their timestamp is before \
-                             `min_date`."
-               int31)))
-
-  let list =
-    RPC_service.post_service
-      ~description:
-        "Lists known heads of the blockchain sorted with decreasing fitness. \
-         Optional arguments allows to returns the list of predecessors for \
-         known heads or the list of predecessors for a given list of blocks."
-      ~query: RPC_query.empty
-      ~input: list_param_encoding
-      ~output: (obj1 (req "blocks" (list (list block_info_encoding))))
-      ~error: Data_encoding.empty
-      RPC_path.(root / "blocks")
-
-  let list_invalid =
-    RPC_service.post_service
-      ~description:
-        "Lists blocks that have been declared invalid along with the errors\
-         that led to them being declared invalid"
-      ~query: RPC_query.empty
-      ~input:empty
-      ~output:(Data_encoding.list
-                 (obj3
-                    (req "block" Block_hash.encoding)
-                    (req "level" int32)
-                    (req "errors" Error.encoding)))
-      ~error: Data_encoding.empty
-      RPC_path.(root / "invalid_blocks")
-
-  let unmark_invalid =
-    RPC_service.post_service
-      ~description:
-        "Unmark an invalid block"
-      ~query: RPC_query.empty
-      ~input:Data_encoding.(obj1 (req "block" Block_hash.encoding))
-      ~output:(Error.wrap Data_encoding.empty)
-      ~error: Data_encoding.empty
-      RPC_path.(root / "unmark_invalid")
-
-end
-
-module Protocols = struct
-
-  let protocols_arg = Protocol_hash.rpc_arg
-
-  let contents =
-    RPC_service.post_service
-      ~query: RPC_query.empty
-      ~input: empty
-      ~output:
-        (obj1 (req "data"
-                 (describe ~title: "Tezos protocol"
-                    (Protocol.encoding))))
-      ~error: Data_encoding.empty
-      RPC_path.(root / "protocols" /: protocols_arg)
-
-  type list_param = {
-    contents: bool option ;
-    monitor: bool option ;
-  }
-
-  let list_param_encoding =
-    conv
-      (fun {contents; monitor} -> (contents, monitor))
-      (fun (contents, monitor) -> {contents; monitor})
-      (obj2
-         (opt "contents" bool)
-         (opt "monitor" bool))
-
-  let list =
-    RPC_service.post_service
-      ~query: RPC_query.empty
-      ~input: list_param_encoding
-      ~output:
-        (obj1
-           (req "protocols"
-              (list
-                 (obj2
-                    (req "hash" Protocol_hash.encoding)
-                    (opt "contents"
-                       (dynamic_size Protocol.encoding)))
-              )))
-      ~error: Data_encoding.empty
-      RPC_path.(root / "protocols")
-
-end
-
-module Workers = struct
-
-  module Prevalidators = struct
-
-    let (net_id_arg : Net_id.t RPC_arg.t) =
-      RPC_arg.make
-        ~name:"net_id"
-        ~descr:"The network identifier of whom the prevalidator is responsible."
-        ~destruct:(fun s -> try
-                      Ok (Net_id.of_b58check_exn s)
-                    with Failure msg -> Error msg)
-        ~construct:Net_id.to_b58check
-        ()
-
-    let list =
-      RPC_service.post_service
-        ~description:"Lists the Prevalidator workers and their status."
-        ~query: RPC_query.empty
-        ~error: Data_encoding.empty
-        ~input: empty
-        ~output:
-          (list
-             (obj2
-                (req "net_id" Net_id.encoding)
-                (req "status" (Worker_types.worker_status_encoding Error.encoding))))
-        RPC_path.(root / "workers" / "prevalidators")
-
-    let state =
-      let open Data_encoding in
-      RPC_service.post_service
-        ~description:"Introspect the state of a prevalidator worker."
-        ~query: RPC_query.empty
-        ~error: Data_encoding.empty
-        ~input: empty
-        ~output:
-          (Worker_types.full_status_encoding
-             Prevalidator_worker_state.Request.encoding
-             (Prevalidator_worker_state.Event.encoding Error.encoding)
-             Error.encoding)
-        RPC_path.(root / "workers" / "prevalidators" /: net_id_arg )
-
-  end
-
-  module Block_validator = struct
-
-    let state =
-      let open Data_encoding in
-      RPC_service.post_service
-        ~description:"Introspect the state of the block_validator worker."
-        ~query: RPC_query.empty
-        ~error: Data_encoding.empty
-        ~input: empty
-        ~output:
-          (Worker_types.full_status_encoding
-             Block_validator_worker_state.Request.encoding
-             (Block_validator_worker_state.Event.encoding Error.encoding)
-             Error.encoding)
-        RPC_path.(root / "workers" / "block_validator")
-
-  end
-
-  module Peer_validators = struct
-
-    let (net_id_arg : Net_id.t RPC_arg.t) =
-      RPC_arg.make
-        ~name:"net_id"
-        ~descr:"The network identifier the peer validator is associated to."
-        ~destruct:(fun s -> try
-                      Ok (Net_id.of_b58check_exn s)
-                    with Failure msg -> Error msg)
-        ~construct:Net_id.to_b58check
-        ()
-
-    let (peer_id_arg : P2p_types.Peer_id.t RPC_arg.t) =
-      RPC_arg.make
-        ~name:"peer_id"
-        ~descr:"The peer identifier of whom the prevalidator is responsible."
-        ~destruct:(fun s -> try
-                      Ok (P2p_types.Peer_id.of_b58check_exn s)
-                    with Failure msg -> Error msg)
-        ~construct:P2p_types.Peer_id.to_b58check
-        ()
-
-    let list =
-      RPC_service.post_service
-        ~description:"Lists the peer validator workers and their status."
-        ~query: RPC_query.empty
-        ~error: Data_encoding.empty
-        ~input: empty
-        ~output:
-          (list
-             (obj2
-                (req "peer_id" P2p_types.Peer_id.encoding)
-                (req "status" (Worker_types.worker_status_encoding Error.encoding))))
-        RPC_path.(root / "workers" / "peer_validators" /: net_id_arg)
-
-    let state =
-      let open Data_encoding in
-      RPC_service.post_service
-        ~description:"Introspect the state of a peer validator worker."
-        ~query: RPC_query.empty
-        ~error: Data_encoding.empty
-        ~input: empty
-        ~output:
-          (Worker_types.full_status_encoding
-             Peer_validator_worker_state.Request.encoding
-             (Peer_validator_worker_state.Event.encoding Error.encoding)
-             Error.encoding)
-        RPC_path.(root / "workers" / "peer_validators" /: net_id_arg /: peer_id_arg)
-
-  end
-
-  module Net_validators = struct
-
-    let (net_id_arg : Net_id.t RPC_arg.t) =
-      RPC_arg.make
-        ~name:"net_id"
-        ~descr:"The network identifier of whom the net validator is responsible."
-        ~destruct:(fun s -> try
-                      Ok (Net_id.of_b58check_exn s)
-                    with Failure msg -> Error msg)
-        ~construct:Net_id.to_b58check
-        ()
-
-    let list =
-      RPC_service.post_service
-        ~description:"Lists the net validator workers and their status."
-        ~query: RPC_query.empty
-        ~error: Data_encoding.empty
-        ~input: empty
-        ~output:
-          (list
-             (obj2
-                (req "net_id" Net_id.encoding)
-                (req "status" (Worker_types.worker_status_encoding Error.encoding))))
-        RPC_path.(root / "workers" / "net_validators")
-
-    let state =
-      let open Data_encoding in
-      RPC_service.post_service
-        ~description:"Introspect the state of a net validator worker."
-        ~query: RPC_query.empty
-        ~error: Data_encoding.empty
-        ~input: empty
-        ~output:
-          (Worker_types.full_status_encoding
-             Net_validator_worker_state.Request.encoding
-             (Net_validator_worker_state.Event.encoding Error.encoding)
-             Error.encoding)
-        RPC_path.(root / "workers" / "net_validators" /: net_id_arg )
-
-  end
-
-end
-
-
-module Network = struct
-
-  open P2p_types
-
-  let (peer_id_arg : P2p_types.Peer_id.t RPC_arg.arg) =
-    Crypto_box.Public_key_hash.rpc_arg
-
-  let point_arg =
-    RPC_arg.make
-      ~name:"point"
-      ~descr:"A network point (ipv4:port or [ipv6]:port)."
-      ~destruct:Point.of_string
-      ~construct:Point.to_string
-      ()
-
-  let versions =
-    RPC_service.post_service
-      ~description:"Supported network layer versions."
-      ~query: RPC_query.empty
-      ~input: empty
-      ~output: (list P2p_types.Version.encoding)
-      ~error: Data_encoding.empty
-      RPC_path.(root / "network" / "versions")
-
-  let stat =
-    RPC_service.post_service
-      ~description:"Global network bandwidth statistics in B/s."
-      ~query: RPC_query.empty
-      ~input: empty
-      ~output: P2p_types.Stat.encoding
-      ~error: Data_encoding.empty
-      RPC_path.(root / "network" / "stat")
-
-  let events =
-    RPC_service.post_service
-      ~description:"Stream of all network events"
-      ~query: RPC_query.empty
-      ~input: empty
-      ~output: P2p_types.Connection_pool_log_event.encoding
-      ~error: Data_encoding.empty
-      RPC_path.(root / "network" / "log")
-
-  let connect =
-    RPC_service.post_service
-      ~description:"Connect to a peer"
-      ~query: RPC_query.empty
-      ~input: (obj1 (dft "timeout" float 5.))
-      ~output: (Error.wrap @@ empty)
-      ~error: Data_encoding.empty
-      RPC_path.(root / "network" / "connect" /: point_arg)
-
-  let monitor_encoding = obj1 (dft "monitor" bool false)
-
-  module Connection = struct
-
-    let list =
-      RPC_service.post_service
-        ~description:"List the running P2P connection."
-        ~query: RPC_query.empty
-        ~input: empty
-        ~output: (list P2p_types.Connection_info.encoding)
-        ~error: Data_encoding.empty
-        RPC_path.(root / "network" / "connection")
-
-    let info =
-      RPC_service.post_service
-        ~query: RPC_query.empty
-        ~input: empty
-        ~output: (option P2p_types.Connection_info.encoding)
-        ~error: Data_encoding.empty
-        ~description:"Details about the current P2P connection to the given peer."
-        RPC_path.(root / "network" / "connection" /: peer_id_arg)
-
-    let kick =
-      RPC_service.post_service
-        ~query: RPC_query.empty
-        ~input: (obj1 (req "wait" bool))
-        ~output: empty
-        ~error: Data_encoding.empty
-        ~description:"Forced close of the current P2P connection to the given peer."
-        RPC_path.(root / "network" / "connection" /: peer_id_arg / "kick")
-
-  end
-
-  module Point = struct
-
-    let info =
-      RPC_service.post_service
-        ~query: RPC_query.empty
-        ~input: empty
-        ~output: (option P2p_types.Point_info.encoding)
-        ~error: Data_encoding.empty
-        ~description: "Details about a given `IP:addr`."
-        RPC_path.(root / "network" / "point" /: point_arg)
-
-    let events =
-      RPC_service.post_service
-        ~query: RPC_query.empty
-        ~input: monitor_encoding
-        ~output: (list P2p_connection_pool_types.Point_info.Event.encoding)
-        ~error: Data_encoding.empty
-        ~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_types.Point_state.encoding) []) in
-      RPC_service.post_service
-        ~query: RPC_query.empty
-        ~input: filter
-        ~output:
-          (list (tup2
-                   P2p_types.Point.encoding
-                   P2p_types.Point_info.encoding))
-        ~error: Data_encoding.empty
-        ~description:"List the pool of known `IP:port` \
-                      used for establishing P2P connections ."
-        RPC_path.(root / "network" / "point")
-
-  end
-
-  module Peer_id = struct
-
-    let info =
-      RPC_service.post_service
-        ~query: RPC_query.empty
-        ~input: empty
-        ~output: (option P2p_types.Peer_info.encoding)
-        ~error: Data_encoding.empty
-        ~description:"Details about a given peer."
-        RPC_path.(root / "network" / "peer_id" /: peer_id_arg)
-
-    let events =
-      RPC_service.post_service
-        ~query: RPC_query.empty
-        ~input: monitor_encoding
-        ~output: (list P2p_connection_pool_types.Peer_info.Event.encoding)
-        ~error: Data_encoding.empty
-        ~description:"Monitor network events related to a given peer."
-        RPC_path.(root / "network" / "peer_id" /: peer_id_arg / "log")
-
-    let list =
-      let filter =
-        obj1 (dft "filter" (list P2p_types.Peer_state.encoding) []) in
-      RPC_service.post_service
-        ~query: RPC_query.empty
-        ~input: filter
-        ~output:
-          (list (tup2
-                   P2p_types.Peer_id.encoding
-                   P2p_types.Peer_info.encoding))
-        ~error: Data_encoding.empty
-        ~description:"List the peers the node ever met."
-        RPC_path.(root / "network" / "peer_id")
-
-  end
-
-end
-
-let forge_block_header =
-  RPC_service.post_service
-    ~description: "Forge a block header"
-    ~query: RPC_query.empty
-    ~input: Block_header.encoding
-    ~output: (obj1 (req "block" bytes))
-    ~error: Data_encoding.empty
-    RPC_path.(root / "forge_block_header")
-
-type inject_block_param = {
-  raw: MBytes.t ;
-  blocking: bool ;
-  force: bool ;
-  net_id: Net_id.t option ;
-  operations: Operation.t list list ;
-}
-
-let inject_block_param =
-  conv
-    (fun { raw ; blocking ; force ; net_id ; operations } ->
-       (raw, blocking, force, net_id, operations))
-    (fun (raw, blocking, force, net_id, operations) ->
-       { raw ; blocking ; force ; net_id ; operations })
-    (obj5
-       (req "data" bytes)
-       (dft "blocking"
-          (describe
-             ~description:
-               "Should the RPC wait for the block to be \
-                validated before answering. (default: true)"
-             bool)
-          true)
-       (dft "force"
-          (describe
-             ~description:
-               "Should we inject the block when its fitness is below \
-                the current head. (default: false)"
-             bool)
-          false)
-       (opt "net_id" Net_id.encoding)
-       (req "operations"
-          (describe
-             ~description:"..."
-             (list (list (dynamic_size Operation.encoding))))))
-
-let inject_block =
-  RPC_service.post_service
-    ~description:
-      "Inject a block in the node and broadcast it. The `operations` \
-       embedded in `blockHeader` might be pre-validated using a \
-       contextual RPCs from the latest block \
-       (e.g. '/blocks/head/context/preapply'). Returns the ID of the \
-       block. By default, the RPC will wait for the block to be \
-       validated before answering."
-    ~query: RPC_query.empty
-    ~input: inject_block_param
-    ~output:
-      (Error.wrap @@
-       (obj1 (req "block_hash" Block_hash.encoding)))
-    ~error: Data_encoding.empty
-    RPC_path.(root / "inject_block")
-
-let inject_operation =
-  RPC_service.post_service
-    ~description:
-      "Inject an operation in node and broadcast it. Returns the \
-       ID of the operation. The `signedOperationContents` should be \
-       constructed using a contextual RPCs from the latest block \
-       and signed by the client. By default, the RPC will wait for \
-       the operation to be (pre-)validated before answering. See \
-       RPCs under /blocks/prevalidation for more details on the \
-       prevalidation context."
-    ~query: RPC_query.empty
-    ~input:
-      (obj3
-         (req "signedOperationContents"
-            (describe ~title: "Tezos signed operation (hex encoded)"
-               bytes))
-         (dft "blocking"
-            (describe
-               ~description:
-                 "Should the RPC wait for the operation to be \
-                  (pre-)validated before answering. (default: true)"
-               bool)
-            true)
-         (opt "net_id" Net_id.encoding))
-    ~output:
-      (Error.wrap @@
-       describe
-         ~title: "Hash of the injected operation" @@
-       (obj1 (req "injectedOperation" Operation_hash.encoding)))
-    ~error: Data_encoding.empty
-    RPC_path.(root / "inject_operation")
-
-let inject_protocol =
-  RPC_service.post_service
-    ~description:
-      "Inject a protocol in node. Returns the ID of the protocol."
-    ~query: RPC_query.empty
-    ~input:
-      (obj3
-         (req "protocol"
-            (describe ~title: "Tezos protocol" Protocol.encoding))
-         (dft "blocking"
-            (describe
-               ~description:
-                 "Should the RPC wait for the protocol to be \
-                  validated before answering. (default: true)"
-               bool)
-            true)
-         (opt "force"
-            (describe
-               ~description:
-                 "Should we inject protocol that is invalid. (default: false)"
-               bool)))
-    ~output:
-      (Error.wrap @@
-       describe
-         ~title: "Hash of the injected protocol" @@
-       (obj1 (req "injectedProtocol" Protocol_hash.encoding)))
-    ~error: Data_encoding.empty
-    RPC_path.(root / "inject_protocol")
-
-let bootstrapped =
-  RPC_service.post_service
-    ~description:""
-    ~query: RPC_query.empty
-    ~input: empty
-    ~output: (obj2
-                (req "block" Block_hash.encoding)
-                (req "timestamp" Time.encoding))
-    ~error: Data_encoding.empty
-    RPC_path.(root / "bootstrapped")
-
-let complete =
-  let prefix_arg =
-    let destruct s = Ok s
-    and construct s = s in
-    RPC_arg.make ~name:"prefix" ~destruct ~construct () in
-  RPC_service.post_service
-    ~description: "Try to complete a prefix of a Base58Check-encoded data. \
-                   This RPC is actually able to complete hashes of \
-                   block and hashes of operations."
-    ~query: RPC_query.empty
-    ~input: empty
-    ~output: (list string)
-    ~error: Data_encoding.empty
-    RPC_path.(root / "complete" /: prefix_arg )
-
-let describe =
-  RPC_service.description_service
-    ~description: "RPCs documentation and input/output schema"
-    RPC_path.(root / "describe")

src/lib_node_services/node_rpc_services.mli

@@ -1,355 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*    Copyright (c) 2014 - 2017.                                          *)
-(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
-(*                                                                        *)
-(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
-(*                                                                        *)
-(**************************************************************************)
-
-module Error : sig
-  val service:
-    ([ `POST ], unit, unit, unit, unit, Json_schema.schema, unit) RPC_service.t
-  val encoding: error list Data_encoding.t
-  val wrap: 'a Data_encoding.t -> 'a tzresult Data_encoding.encoding
-end
-
-module Blocks : sig
-
-  type block = [
-    | `Genesis
-    | `Head of int | `Prevalidation
-    | `Test_head of int | `Test_prevalidation
-    | `Hash of Block_hash.t
-  ]
-  val blocks_arg : block RPC_arg.arg
-
-  val parse_block: string -> (block, string) result
-  val to_string: block -> string
-
-  type block_info = {
-    hash: Block_hash.t ;
-    net_id: Net_id.t ;
-    level: Int32.t ;
-    proto_level: int ; (* uint8 *)
-    predecessor: Block_hash.t ;
-    timestamp: Time.t ;
-    validation_passes: int ; (* uint8 *)
-    operations_hash: Operation_list_list_hash.t ;
-    fitness: MBytes.t list ;
-    context: Context_hash.t ;
-    data: MBytes.t ;
-    operations: (Operation_hash.t * Operation.t) list list option ;
-    protocol: Protocol_hash.t ;
-    test_network: Test_network_status.t ;
-  }
-
-  val info:
-    ([ `POST ], unit,
-     unit * block, unit, bool,
-     block_info, unit) RPC_service.t
-  val net_id:
-    ([ `POST ], unit,
-     unit * block, unit, unit,
-     Net_id.t, unit) RPC_service.t
-  val level:
-    ([ `POST ], unit,
-     unit * block, unit, unit,
-     Int32.t, unit) RPC_service.t
-  val predecessor:
-    ([ `POST ], unit,
-     unit * block, unit, unit,
-     Block_hash.t, unit) RPC_service.t
-  val predecessors:
-    ([ `POST ], unit,
-     unit * block , unit, int,
-     Block_hash.t list, unit) RPC_service.t
-  val hash:
-    ([ `POST ], unit,
-     unit * block, unit, unit,
-     Block_hash.t, unit) RPC_service.t
-  val timestamp:
-    ([ `POST ], unit,
-     unit * block, unit, unit,
-     Time.t, unit) RPC_service.t
-  val fitness:
-    ([ `POST ], unit,
-     unit * block, unit, unit,
-     MBytes.t list, unit) RPC_service.t
-  val context:
-    ([ `POST ], unit,
-     unit * block, unit, unit,
-     Context_hash.t, unit) RPC_service.t
-
-  type operations_param = {
-    contents: bool ;
-    monitor: bool ;
-  }
-  val operations:
-    ([ `POST ], unit,
-     unit * block, unit, operations_param,
-     (Operation_hash.t * Operation.t option) list list, unit) RPC_service.t
-
-  val protocol:
-    ([ `POST ], unit,
-     unit * block, unit, unit,
-     Protocol_hash.t, unit) RPC_service.t
-  val test_network:
-    ([ `POST ], unit,
-     unit * block, unit, unit,
-     Test_network_status.t, unit) RPC_service.t
-  val pending_operations:
-    ([ `POST ], unit,
-     unit * block, unit, unit,
-     error Preapply_result.t * Operation.t Operation_hash.Map.t, unit) RPC_service.t
-
-  type list_param = {
-    include_ops: bool ;
-    length: int option ;
-    heads: Block_hash.t list option ;
-    monitor: bool option ;
-    delay: int option ;
-    min_date: Time.t option;
-    min_heads: int option;
-  }
-  val list:
-    ([ `POST ], unit,
-     unit, unit, list_param,
-     block_info list list, unit) RPC_service.t
-
-  val list_invalid:
-    ([ `POST ], unit,
-     unit, unit, unit,
-     (Block_hash.t * int32 * error list) list, unit) RPC_service.t
-
-  val unmark_invalid:
-    ([ `POST ], unit, unit, unit, Block_hash.t, unit tzresult, unit) RPC_service.t
-
-  type preapply_param = {
-    timestamp: Time.t ;
-    proto_header: MBytes.t ;
-    operations: Operation.t list list ;
-    sort_operations: bool ;
-  }
-
-  type preapply_result = {
-    shell_header: Block_header.shell_header ;
-    operations: error Preapply_result.t list ;
-  }
-  val preapply:
-    ([ `POST ], unit,
-     unit * block, unit, preapply_param,
-     preapply_result tzresult, unit) RPC_service.t
-
-  val complete:
-    ([ `POST ], unit,
-     (unit * block) * string, unit, unit,
-     string list, unit) RPC_service.t
-
-  val proto_path: (unit, unit * block) RPC_path.path
-
-
-end
-
-module Protocols : sig
-
-  val contents:
-    ([ `POST ], unit,
-     unit * Protocol_hash.t, unit, unit,
-     Protocol.t, unit) RPC_service.t
-
-  type list_param = {
-    contents: bool option ;
-    monitor: bool option ;
-  }
-
-  val list:
-    ([ `POST ], unit,
-     unit, unit, list_param,
-     (Protocol_hash.t * Protocol.t option) list, unit) RPC_service.t
-
-end
-
-module Workers : sig
-
-  module Prevalidators : sig
-
-    open Prevalidator_worker_state
-
-    val list :
-      ([ `POST ],  unit,
-       unit, unit, unit,
-       (Net_id.t * Worker_types.worker_status) list, unit) RPC_service.t
-
-    val state :
-      ([ `POST ], unit,
-       unit * Net_id.t, unit, unit,
-       (Request.view, Event.t) Worker_types.full_status, unit)
-        RPC_service.t
-
-  end
-
-  module Block_validator : sig
-
-    open Block_validator_worker_state
-
-    val state :
-      ([ `POST ], unit,
-       unit, unit, unit,
-       (Request.view, Event.t) Worker_types.full_status, unit)
-        RPC_service.t
-
-  end
-
-  module Peer_validators : sig
-
-    open Peer_validator_worker_state
-
-    val list :
-      ([ `POST ],  unit,
-       unit * Net_id.t, unit, unit,
-       (P2p_types.Peer_id.t * Worker_types.worker_status) list, unit) RPC_service.t
-
-    val state :
-      ([ `POST ], unit,
-       (unit * Net_id.t) * P2p_types.Peer_id.t, unit, unit,
-       (Request.view, Event.t) Worker_types.full_status, unit)
-        RPC_service.t
-
-  end
-
-  module Net_validators : sig
-
-    open Net_validator_worker_state
-
-    val list :
-      ([ `POST ],  unit,
-       unit, unit, unit,
-       (Net_id.t * Worker_types.worker_status) list, unit) RPC_service.t
-
-    val state :
-      ([ `POST ], unit,
-       unit * Net_id.t, unit, unit,
-       (Request.view, Event.t) Worker_types.full_status, unit)
-        RPC_service.t
-
-  end
-
-end
-
-module Network : sig
-
-  val stat :
-    ([ `POST ], unit,
-     unit, unit, unit,
-     P2p_types.Stat.t, unit) RPC_service.t
-
-  val versions :
-    ([ `POST ], unit,
-     unit, unit, unit,
-     P2p_types.Version.t list, unit) RPC_service.t
-
-  val events :
-    ([ `POST ], unit,
-     unit, unit, unit,
-     P2p_types.Connection_pool_log_event.t, unit) RPC_service.t
-
-  val connect :
-    ([ `POST ], unit,
-     unit * P2p_types.Point.t, unit, float,
-     unit tzresult, unit) RPC_service.t
-
-  module Connection : sig
-
-    val list :
-      ([ `POST ], unit,
-       unit, unit, unit,
-       P2p_types.Connection_info.t list, unit) RPC_service.t
-
-    val info :
-      ([ `POST ], unit,
-       unit * P2p_types.Peer_id.t, unit, unit,
-       P2p_types.Connection_info.t option, unit) RPC_service.t
-
-    val kick :
-      ([ `POST ], unit,
-       unit * P2p_types.Peer_id.t, unit, bool,
-       unit, unit) RPC_service.t
-
-  end
-
-  module Point : sig
-    val list :
-      ([ `POST ], unit,
-       unit, unit, P2p_types.Point_state.t list,
-       (P2p_types.Point.t * P2p_types.Point_info.t) list, unit) RPC_service.t
-    val info :
-      ([ `POST ], unit,
-       unit * P2p_types.Point.t, unit, unit,
-       P2p_types.Point_info.t option, unit) RPC_service.t
-    val events :
-      ([ `POST ], unit,
-       unit * P2p_types.Point.t, unit, bool,
-       P2p_connection_pool_types.Point_info.Event.t list, unit) RPC_service.t
-  end
-
-  module Peer_id : sig
-
-    val list :
-      ([ `POST ], unit,
-       unit, unit, P2p_types.Peer_state.t list,
-       (P2p_types.Peer_id.t * P2p_types.Peer_info.t) list, unit) RPC_service.t
-
-    val info :
-      ([ `POST ], unit,
-       unit * P2p_types.Peer_id.t, unit, unit,
-       P2p_types.Peer_info.t option, unit) RPC_service.t
-
-    val events :
-      ([ `POST ], unit,
-       unit * P2p_types.Peer_id.t, unit, bool,
-       P2p_connection_pool_types.Peer_info.Event.t list, unit) RPC_service.t
-
-  end
-
-end
-
-val forge_block_header:
-  ([ `POST ], unit,
-   unit, unit, Block_header.t,
-   MBytes.t, unit) RPC_service.t
-
-type inject_block_param = {
-  raw: MBytes.t ;
-  blocking: bool ;
-  force: bool ;
-  net_id: Net_id.t option ;
-  operations: Operation.t list list ;
-}
-
-val inject_block:
-  ([ `POST ], unit,
-   unit, unit, inject_block_param,
-   Block_hash.t tzresult, unit) RPC_service.t
-
-val inject_operation:
-  ([ `POST ], unit,
-   unit, unit, (MBytes.t * bool * Net_id.t option),
-   Operation_hash.t tzresult, unit) RPC_service.t
-
-val inject_protocol:
-  ([ `POST ], unit,
-   unit, unit, (Protocol.t * bool * bool option),
-   Protocol_hash.t tzresult, unit) RPC_service.t
-
-val bootstrapped:
-  ([ `POST ], unit,
-   unit, unit, unit,
-   Block_hash.t * Time.t, unit) RPC_service.t
-
-val complete:
-  ([ `POST ], unit,
-   unit * string, unit, unit,
-   string list, unit) RPC_service.t
-
-val describe: (unit, unit) RPC_service.description_service

src/lib_node_shell/tezos-node-shell.opam

@@ -1,24 +0,0 @@
-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" }
-  "tezos-base"
-  "tezos-storage"
-  "tezos-node-services"
-  "tezos-node-p2p-base"
-  "tezos-node-p2p"
-  "tezos-node-updater"
-]
-build: [
-  [ "jbuilder" "build" "-p" name "-j" jobs ]
-]
-build-test: [
-  [ "jbuilder" "runtest" "-p" name "-j" jobs ]
-]

src/lib_node_shell_base/jbuild

@@ -1,14 +0,0 @@
-(jbuild_version 1)
-
-(library
- ((name tezos_node_shell_base)
-  (public_name tezos-node-shell-base)
-  (libraries (tezos-base
-              tezos-node-p2p-base))
-  (flags (:standard -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} ${^}))))

src/lib_p2p/jbuild

@@ -1,13 +1,12 @@
 (jbuild_version 1)
 
 (library
- ((name tezos_rpc_base)
+ ((name tezos_p2p)
-  (public_name tezos-rpc-base)
+  (public_name tezos-p2p)
-  (libraries (tezos-data-encoding
+  (libraries (tezos-base))
-              ocplib-resto))
   (flags (:standard -w -9+27-30-32-40@8
                     -safe-string
-                    -open Tezos_data_encoding))))
+                    -open Tezos_base__TzPervasives))))
 
 (alias
  ((name runtest_indent)