balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

Browse Source
This commit is contained in:
Grégoire Henry 2018-01-31 08:39:45 +01:00
commit 18c483eaae
414 changed files with 5251 additions and 4749 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

204
.gitlab-ci.yml
View File

@ -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_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:02: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_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:09: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_definition
variables:
package: tezos-rpc-http
opam:19:tezos-protocol-compiler:
opam:12: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_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:26: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:

6
Makefile
View File

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

2
scripts/alphanet.sh
View File

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

6
scripts/alphanet_constants.patch
View File

@ -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
+++ b/src/lib_embedded_protocol_alpha/src/constants_repr.ml
--- a/src/proto_alpha/lib_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))

36
scripts/check_opam_test.sh Executable file
View File

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

30
scripts/update_opam_test.sh Executable file
View File

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

2
src/bin_attacker/attacker_minimal.ml
View File

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

4
src/bin_client/jbuild
View File

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

4
src/bin_client/tezos-client.opam
View File

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

18
src/bin_node/jbuild
View File

@ -4,12 +4,11 @@
((name main)
(public_name tezos-node)
(libraries (tezos-base
tezos-shell-services
tezos-rpc-http
tezos-node-updater
tezos-node-p2p-base
tezos-node-p2p
tezos-node-shell-base
tezos-node-shell
tezos-p2p
tezos-shell
tezos-protocol-updater
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_node_p2p_base
-open Tezos_node_p2p
-open Tezos_node_shell_base
-open Tezos_node_shell
-open Tezos_p2p
-open Tezos_shell
-open Tezos_protocol_updater
-linkall))))
(install

2
src/bin_node/node_config_file.ml
View File

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

6
src/bin_node/node_config_file.mli
View File

@ -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_rpc_listening_addrs: string -> (P2p_types.addr * int) list Lwt.t
val resolve_bootstrap_addrs: string list -> (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_addr.t * int) list Lwt.t
val resolve_bootstrap_addrs: string list -> (P2p_addr.t * int) list Lwt.t
val check: t -> unit Lwt.t

8
src/bin_node/node_identity_command.ml
View File

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

4
src/bin_node/node_identity_file.ml
View File

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

4
src/bin_node/node_identity_file.mli
View File

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

10
src/bin_node/node_run_command.ml
View File

@ -20,8 +20,8 @@ let genesis : State.Net.genesis = {
"ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im" ;
}
type error += Non_private_sandbox of P2p_types.addr
type error += RPC_Port_already_in_use of P2p_types.addr
type error += Non_private_sandbox of P2p_addr.t
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 ;

4
src/bin_node/tezos-node.opam
View File

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

0
src/lib_crypto/block_hash.ml → src/lib_base/block_hash.ml
View File

2
src/lib_crypto/block_hash.mli → src/lib_base/block_hash.mli
View File

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

29
src/lib_node_shell/block_locator.ml → src/lib_base/block_locator.ml
View File

@ -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) =
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 compute ~pred (h: Block_hash.t) (bh: Block_header.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)
(step * 2) (step * 20 - 1) predecessor
else if cpt mod step = 0 then
loop (b :: acc) ~sz:(sz - 1)
step (cpt - 1) predecessor
loop (b :: acc) ~sz:(sz - 1) (step * 2) 10 predecessor
else
loop acc ~sz step (cpt - 1) predecessor in
Store.Block.Contents.read_exn (store, b) >>= fun { header } ->
predecessor store b >>= function
| None -> Lwt.return (header, [])
loop (b :: acc) ~sz:(sz - 1) step (cpt - 1) predecessor in
pred h 1 >>= function
| None -> Lwt.return (bh, [])
| Some p ->
loop [] ~sz 1 9 p >>= fun hist ->
Lwt.return (header, hist)
Lwt.return (bh, hist)
type validity =
| Unknown

7
src/lib_node_shell/block_locator.mli → src/lib_base/block_locator.mli
View File

@ -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
(** [compute block max_length] compute the sparse block locator for
the [block]. The locator contains at most [max_length] elements. *)
val compute:
pred:(Block_hash.t -> int -> Block_hash.t option Lwt.t) ->
Block_hash.t -> Block_header.t -> int ->
t Lwt.t
type validity =
| Unknown

0
src/lib_crypto/context_hash.ml → src/lib_base/context_hash.ml
View File

2
src/lib_crypto/context_hash.mli → src/lib_base/context_hash.mli
View File

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

6
src/lib_base/jbuild
View File

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

0
src/lib_node_shell_base/mempool.ml → src/lib_base/mempool.ml
View File

0
src/lib_node_shell_base/mempool.mli → src/lib_base/mempool.mli
View File

2
src/lib_crypto/net_id.ml → src/lib_base/net_id.ml
View File

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

2
src/lib_crypto/net_id.mli → src/lib_base/net_id.mli
View File

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

0
src/lib_crypto/operation_hash.ml → src/lib_base/operation_hash.ml
View File

2
src/lib_crypto/operation_hash.mli → src/lib_base/operation_hash.mli
View File

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

0
src/lib_crypto/operation_list_hash.ml → src/lib_base/operation_list_hash.ml
View File

11
src/lib_base/operation_list_hash.mli Normal file
View File

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

0
src/lib_crypto/operation_list_list_hash.ml → src/lib_base/operation_list_list_hash.ml
View File

2
src/lib_crypto/operation_list_list_hash.mli → src/lib_base/operation_list_list_hash.mli
View File

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

28
src/lib_base/p2p_addr.ml Normal file
View File

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

4
src/lib_crypto/operation_list_hash.mli → src/lib_base/p2p_addr.mli
View File

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

252
src/lib_base/p2p_connection.ml Normal file
View File

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

107
src/lib_base/p2p_connection.mli Normal file
View File

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

0
src/lib_embedded_client_demo/client_proto_main.mli → src/lib_base/p2p_connection_id.ml
View File

11
src/lib_base/p2p_connection_id.mli Normal file
View File

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

0
src/lib_base/p2p_id_point.ml Normal file
View File

0
src/lib_node_updater/register.mli → src/lib_base/p2p_id_point.mli
View File

77
src/lib_base/p2p_identity.ml Normal file
View File

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

29
src/lib_base/p2p_identity.mli Normal file
View File

@ -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]. *)

339
src/lib_base/p2p_peer.ml Normal file
View File

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

184
src/lib_base/p2p_peer.mli Normal file
View File

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

477
src/lib_base/p2p_point.ml Normal file
View File

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

207
src/lib_base/p2p_point.mli Normal file
View File

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

64
src/lib_base/p2p_stat.ml Normal file
View File

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

21
src/lib_base/p2p_stat.mli Normal file
View File

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

40
src/lib_base/p2p_version.ml Normal file
View File

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

22
src/lib_base/p2p_version.mli Normal file
View File

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

47
src/lib_node_updater/tezos_protocol_environment.ml → src/lib_base/protocol_environment.ml
View File

@ -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
include Tezos_crypto
module S = struct
include Tezos_crypto.S
module Make_minimal_Blake2B = Blake2B.Make_minimal
module Make_Blake2B = Blake2B.Make
include S
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 Fitness = Fitness
module Operation = Operation
module Block_header = Block_header
module Protocol = Protocol
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
include Updater
module type PROTOCOL =
RAW_PROTOCOL with type error := Error_monad.error
and type 'a tzresult := 'a Error_monad.tzresult
end
module Micheline = Micheline
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

0
src/lib_crypto/protocol_hash.ml → src/lib_base/protocol_hash.ml
View File

2
src/lib_crypto/protocol_hash.mli → src/lib_base/protocol_hash.mli
View File

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

2
src/lib_base/tezos-base.opam
View File

@ -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" }

8
src/lib_base/time.ml
View File

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

3
src/lib_base/time.mli
View File

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

24
src/lib_base/tzPervasives.ml
View File

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

22
src/lib_base/tzPervasives.mli
View File

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

2
src/lib_client_base/client_admin.ml
View File

@ -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) ;
]

2
src/lib_client_base/client_commands.ml
View File

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

6
src/lib_client_base/client_commands.mli
View File

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

6
src/lib_client_base/client_config.ml
View File

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

6
src/lib_client_base/client_debug.ml
View File

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

34
src/lib_client_base/client_network.ml
View File

@ -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
Stat.pp pi.stat
P2p_peer.Id.pp p
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
Point.pp p
Peer_id.pp peer_id
P2p_point.State.pp_digram pi.state
P2p_point.Id.pp p
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
Point.pp p
Peer_id.pp peer_id
P2p_point.State.pp_digram pi.state
P2p_point.Id.pp p
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
Point.pp p
P2p_point.State.pp_digram pi.state
P2p_point.Id.pp p
(if pi.trusted then "★" else " ")
end points >>= fun () ->
return ()

73
src/lib_client_base/client_node_rpcs.ml
View File

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

12
src/lib_client_base/client_node_rpcs.mli
View File

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

2
src/lib_client_base/client_rpcs.ml
View File

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

2
src/lib_client_base/client_rpcs.mli
View File

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

14
src/lib_client_base/jbuild
View File

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

8
src/lib_client_base/tezos-client-base.opam
View File

@ -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: [

17
src/lib_crypto/blake2B.ml
View File

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

23
src/lib_crypto/blake2B.mli
View File

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

4
src/lib_crypto/jbuild
View File

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

17
src/lib_crypto/s.ml
View File

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

2
src/lib_crypto/tezos-crypto.opam
View File

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

24
src/lib_embedded_client_alpha/jbuild
View File

@ -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} ${^}))))

25
src/lib_embedded_client_genesis/jbuild
View File

@ -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} ${^}))))

1
src/lib_embedded_protocol_alpha/jbuild
View File

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

1
src/lib_embedded_protocol_alpha/src/jbuild
View File

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

1
src/lib_embedded_protocol_demo/jbuild
View File

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

1
src/lib_embedded_protocol_demo/src/jbuild
View File

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

1
src/lib_embedded_protocol_genesis/jbuild
View File

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

1
src/lib_embedded_protocol_genesis/src/jbuild
View File

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

6
src/lib_micheline/jbuild
View File

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

1
src/lib_micheline/micheline_parser.ml
View File

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

3
src/lib_micheline/tezos-micheline.opam
View File

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

526
src/lib_node_p2p_base/p2p_connection_pool_types.ml
View File

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

284
src/lib_node_p2p_base/p2p_connection_pool_types.mli
View File

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

717
src/lib_node_p2p_base/p2p_types.ml
View File

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

263
src/lib_node_p2p_base/p2p_types.mli
View File

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

18
src/lib_node_services/jbuild
View File

@ -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} ${^}))))

995
src/lib_node_services/node_rpc_services.ml
View File

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

355
src/lib_node_services/node_rpc_services.mli
View File

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

24
src/lib_node_shell/tezos-node-shell.opam
View File

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

14
src/lib_node_shell_base/jbuild
View File

@ -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} ${^}))))

9
src/lib_rpc_base/jbuild → src/lib_p2p/jbuild
View File

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

0
src/lib_node_p2p/moving_average.ml → src/lib_p2p/moving_average.ml
View File

0
src/lib_node_p2p/moving_average.mli → src/lib_p2p/moving_average.mli
View File

Some files were not shown because too many files have changed in this diff Show More