From 7277c9889bac8f0eba8261ade1c6730ece3eb1ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Wed, 24 Jan 2018 12:48:25 +0100 Subject: [PATCH] Refactor: Move/split `P2p_types` into `lib_base` --- .gitlab-ci.yml | 8 +- src/bin_attacker/attacker_minimal.ml | 2 +- src/bin_node/node_config_file.ml | 2 +- src/bin_node/node_config_file.mli | 6 +- src/bin_node/node_identity_command.ml | 8 +- src/bin_node/node_identity_file.ml | 4 +- src/bin_node/node_identity_file.mli | 4 +- src/bin_node/node_run_command.ml | 10 +- src/lib_base/p2p_addr.ml | 28 + src/lib_base/p2p_addr.mli | 13 + src/lib_base/p2p_connection.ml | 252 ++++++ src/lib_base/p2p_connection.mli | 107 +++ src/lib_base/p2p_connection_id.ml | 9 + src/lib_base/p2p_connection_id.mli | 11 + src/lib_base/p2p_id_point.ml | 0 src/lib_base/p2p_id_point.mli | 9 + src/lib_base/p2p_identity.ml | 77 ++ src/lib_base/p2p_identity.mli | 29 + src/lib_base/p2p_peer.ml | 339 +++++++++ src/lib_base/p2p_peer.mli | 184 +++++ src/lib_base/p2p_point.ml | 477 ++++++++++++ src/lib_base/p2p_point.mli | 207 +++++ src/lib_base/p2p_stat.ml | 64 ++ src/lib_base/p2p_stat.mli | 21 + src/lib_base/p2p_version.ml | 40 + src/lib_base/p2p_version.mli | 22 + src/lib_base/time.ml | 8 + src/lib_base/time.mli | 3 + src/lib_base/tzPervasives.ml | 8 + src/lib_base/tzPervasives.mli | 8 + src/lib_client_base/client_network.ml | 34 +- src/lib_client_base/client_node_rpcs.mli | 10 +- src/lib_p2p/p2p.ml | 215 +++--- src/lib_p2p/p2p.mli | 98 +-- src/lib_p2p/p2p_discovery.ml | 8 +- src/lib_p2p/p2p_discovery.mli | 2 +- src/lib_p2p/p2p_io_scheduler.ml | 3 +- src/lib_p2p/p2p_io_scheduler.mli | 6 +- src/lib_p2p/p2p_maintenance.ml | 35 +- src/lib_p2p/p2p_maintenance.mli | 2 +- .../{p2p_connection_pool.ml => p2p_pool.ml} | 377 +++++---- .../{p2p_connection_pool.mli => p2p_pool.mli} | 79 +- .../{p2p_connection.ml => p2p_socket.ml} | 48 +- .../{p2p_connection.mli => p2p_socket.mli} | 16 +- src/lib_p2p/p2p_welcome.ml | 4 +- src/lib_p2p/p2p_welcome.mli | 6 +- .../p2p_connection_pool_types.ml | 526 ------------- .../p2p_connection_pool_types.mli | 284 ------- src/lib_p2p_services/p2p_services.ml | 38 +- src/lib_p2p_services/p2p_services.mli | 42 +- src/lib_p2p_services/p2p_types.ml | 717 ------------------ src/lib_p2p_services/p2p_types.mli | 263 ------- src/lib_shell/block_validator.ml | 2 +- src/lib_shell/block_validator.mli | 4 +- src/lib_shell/bootstrap_pipeline.ml | 34 +- src/lib_shell/bootstrap_pipeline.mli | 4 +- src/lib_shell/distributed_db.ml | 58 +- src/lib_shell/distributed_db.mli | 22 +- src/lib_shell/distributed_db_functors.ml | 78 +- src/lib_shell/distributed_db_functors.mli | 20 +- src/lib_shell/distributed_db_message.ml | 2 +- src/lib_shell/net_validator.ml | 26 +- src/lib_shell/node.mli | 42 +- src/lib_shell/peer_validator.ml | 38 +- src/lib_shell/peer_validator.mli | 6 +- src/lib_shell/prevalidator.mli | 2 +- src/lib_shell/protocol_validator.mli | 6 +- .../block_validator_worker_state.ml | 6 +- .../block_validator_worker_state.mli | 2 +- .../net_validator_worker_state.ml | 12 +- .../net_validator_worker_state.mli | 4 +- .../prevalidator_worker_state.ml | 6 +- .../prevalidator_worker_state.mli | 2 +- src/lib_shell_services/shell_services.ml | 8 +- src/lib_shell_services/shell_services.mli | 4 +- test/p2p/jbuild | 20 +- test/p2p/test_p2p_io_scheduler.ml | 9 +- ...2p_connection_pool.ml => test_p2p_pool.ml} | 61 +- ...t_p2p_connection.ml => test_p2p_socket.ml} | 111 ++- 79 files changed, 2711 insertions(+), 2651 deletions(-) create mode 100644 src/lib_base/p2p_addr.ml create mode 100644 src/lib_base/p2p_addr.mli create mode 100644 src/lib_base/p2p_connection.ml create mode 100644 src/lib_base/p2p_connection.mli create mode 100644 src/lib_base/p2p_connection_id.ml create mode 100644 src/lib_base/p2p_connection_id.mli create mode 100644 src/lib_base/p2p_id_point.ml create mode 100644 src/lib_base/p2p_id_point.mli create mode 100644 src/lib_base/p2p_identity.ml create mode 100644 src/lib_base/p2p_identity.mli create mode 100644 src/lib_base/p2p_peer.ml create mode 100644 src/lib_base/p2p_peer.mli create mode 100644 src/lib_base/p2p_point.ml create mode 100644 src/lib_base/p2p_point.mli create mode 100644 src/lib_base/p2p_stat.ml create mode 100644 src/lib_base/p2p_stat.mli create mode 100644 src/lib_base/p2p_version.ml create mode 100644 src/lib_base/p2p_version.mli rename src/lib_p2p/{p2p_connection_pool.ml => p2p_pool.ml} (71%) rename src/lib_p2p/{p2p_connection_pool.mli => p2p_pool.mli} (81%) rename src/lib_p2p/{p2p_connection.ml => p2p_socket.ml} (92%) rename src/lib_p2p/{p2p_connection.mli => p2p_socket.mli} (93%) delete mode 100644 src/lib_p2p_services/p2p_connection_pool_types.ml delete mode 100644 src/lib_p2p_services/p2p_connection_pool_types.mli delete mode 100644 src/lib_p2p_services/p2p_types.ml delete mode 100644 src/lib_p2p_services/p2p_types.mli rename test/p2p/{test_p2p_connection_pool.ml => test_p2p_pool.ml} (82%) rename test/p2p/{test_p2p_connection.ml => test_p2p_socket.ml} (78%) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index d36efdd07..3c12e6983 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -111,15 +111,15 @@ test:p2p:io-scheduler: script: - jbuilder build @test/p2p/runtest_p2p_io_scheduler -test:p2p:connection: +test:p2p:socket: <<: *test_definition script: - - jbuilder build @test/p2p/runtest_p2p_connection + - jbuilder build @test/p2p/runtest_p2p_socket -test:p2p:connection-pool: +test:p2p:pool: <<: *test_definition script: - - jbuilder build @test/p2p/runtest_p2p_connection_pool + - jbuilder build @test/p2p/runtest_p2p_pool test:proto_alpha:transaction: <<: *test_definition diff --git a/src/bin_attacker/attacker_minimal.ml b/src/bin_attacker/attacker_minimal.ml index 5d90afa91..8aef25f9a 100644 --- a/src/bin_attacker/attacker_minimal.ml +++ b/src/bin_attacker/attacker_minimal.ml @@ -103,7 +103,7 @@ let ballot_forged period prop vote = operations = [ballot] }) in forge { net_id = network } op -let identity = P2p_types.Identity.generate Crypto_box.default_target +let identity = P2p_identity.generate Crypto_box.default_target (* connect to the network, run an action and then disconnect *) let try_action addr port action = diff --git a/src/bin_node/node_config_file.ml b/src/bin_node/node_config_file.ml index 40278de4c..ec0538999 100644 --- a/src/bin_node/node_config_file.ml +++ b/src/bin_node/node_config_file.ml @@ -529,7 +529,7 @@ let update return { data_dir ; net ; rpc ; log ; shell } let resolve_addr ?default_port ?(passive = false) peer = - let addr, port = P2p.Point.parse_addr_port peer in + let addr, port = P2p_point.Id.parse_addr_port peer in let node = if addr = "" || addr = "_" then "::" else addr and service = match port, default_port with diff --git a/src/bin_node/node_config_file.mli b/src/bin_node/node_config_file.mli index 287656c0e..b6e2b52ef 100644 --- a/src/bin_node/node_config_file.mli +++ b/src/bin_node/node_config_file.mli @@ -80,8 +80,8 @@ val to_string: t -> string val read: string -> t tzresult Lwt.t val write: string -> t -> unit tzresult Lwt.t -val resolve_listening_addrs: string -> (P2p_types.addr * int) list Lwt.t -val resolve_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 diff --git a/src/bin_node/node_identity_command.ml b/src/bin_node/node_identity_command.ml index b5f0ffbe9..60e40f7dd 100644 --- a/src/bin_node/node_identity_command.ml +++ b/src/bin_node/node_identity_command.ml @@ -15,7 +15,7 @@ let identity_file data_dir = data_dir // Node_data_version.default_identity_file let show { Node_config_file.data_dir } = Node_identity_file.read (identity_file data_dir) >>=? fun id -> - Format.printf "Peer_id: %a.@." P2p_types.Peer_id.pp id.peer_id ; + Format.printf "Peer_id: %a.@." P2p_peer.Id.pp id.peer_id ; return () let generate { Node_config_file.data_dir ; net } = @@ -26,11 +26,11 @@ let generate { Node_config_file.data_dir ; net } = let target = Crypto_box.make_target net.expected_pow in Format.eprintf "Generating a new identity... (level: %.2f) " net.expected_pow ; let id = - P2p.Identity.generate_with_animation Format.err_formatter target in + P2p_identity.generate_with_animation Format.err_formatter target in Node_identity_file.write identity_file id >>=? fun () -> Format.eprintf "Stored the new identity (%a) into '%s'.@." - P2p.Peer_id.pp id.peer_id identity_file ; + P2p_peer.Id.pp id.peer_id identity_file ; return () let check { Node_config_file.data_dir ; net = { expected_pow } } = @@ -38,7 +38,7 @@ let check { Node_config_file.data_dir ; net = { expected_pow } } = ~expected_pow (identity_file data_dir) >>=? fun id -> Format.printf "Peer_id: %a. Proof of work is higher than %.2f.@." - P2p_types.Peer_id.pp id.peer_id expected_pow ; + P2p_peer.Id.pp id.peer_id expected_pow ; return () (** Main *) diff --git a/src/bin_node/node_identity_file.ml b/src/bin_node/node_identity_file.ml index 1294bd460..932f68034 100644 --- a/src/bin_node/node_identity_file.ml +++ b/src/bin_node/node_identity_file.ml @@ -47,7 +47,7 @@ let read ?expected_pow file = fail (No_identity_file file) | true -> Data_encoding_ezjsonm.read_file file >>=? fun json -> - let id = Data_encoding.Json.destruct P2p.Identity.encoding json in + let id = Data_encoding.Json.destruct P2p_identity.encoding json in match expected_pow with | None -> return id | Some expected -> @@ -81,4 +81,4 @@ let write file identity = else Node_data_version.ensure_data_dir (Filename.dirname file) >>=? fun () -> Data_encoding_ezjsonm.write_file file - (Data_encoding.Json.construct P2p.Identity.encoding identity) + (Data_encoding.Json.construct P2p_identity.encoding identity) diff --git a/src/bin_node/node_identity_file.mli b/src/bin_node/node_identity_file.mli index 7b770af08..62056b042 100644 --- a/src/bin_node/node_identity_file.mli +++ b/src/bin_node/node_identity_file.mli @@ -12,8 +12,8 @@ type error += Insufficient_proof_of_work of { expected: float } val read: ?expected_pow:float -> - string -> P2p.Identity.t tzresult Lwt.t + string -> P2p_identity.t tzresult Lwt.t type error += Existent_identity_file of string -val write: string -> P2p.Identity.t -> unit tzresult Lwt.t +val write: string -> P2p_identity.t -> unit tzresult Lwt.t diff --git a/src/bin_node/node_run_command.ml b/src/bin_node/node_run_command.ml index 4bd6d2c4d..6ee07e473 100644 --- a/src/bin_node/node_run_command.ml +++ b/src/bin_node/node_run_command.ml @@ -20,8 +20,8 @@ let genesis : State.Net.genesis = { "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im" ; } -type error += Non_private_sandbox of P2p_types.addr -type error += 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 ; diff --git a/src/lib_base/p2p_addr.ml b/src/lib_base/p2p_addr.ml new file mode 100644 index 000000000..880a29617 --- /dev/null +++ b/src/lib_base/p2p_addr.ml @@ -0,0 +1,28 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/lib_base/p2p_addr.mli b/src/lib_base/p2p_addr.mli new file mode 100644 index 000000000..a3f996ad1 --- /dev/null +++ b/src/lib_base/p2p_addr.mli @@ -0,0 +1,13 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +type t = Ipaddr.V6.t +type port = int + +val encoding : t Data_encoding.t diff --git a/src/lib_base/p2p_connection.ml b/src/lib_base/p2p_connection.ml new file mode 100644 index 000000000..f2bfad895 --- /dev/null +++ b/src/lib_base/p2p_connection.ml @@ -0,0 +1,252 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/lib_base/p2p_connection.mli b/src/lib_base/p2p_connection.mli new file mode 100644 index 000000000..772917cb8 --- /dev/null +++ b/src/lib_base/p2p_connection.mli @@ -0,0 +1,107 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/lib_base/p2p_connection_id.ml b/src/lib_base/p2p_connection_id.ml new file mode 100644 index 000000000..769771c1b --- /dev/null +++ b/src/lib_base/p2p_connection_id.ml @@ -0,0 +1,9 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + diff --git a/src/lib_base/p2p_connection_id.mli b/src/lib_base/p2p_connection_id.mli new file mode 100644 index 000000000..cbaa05fe5 --- /dev/null +++ b/src/lib_base/p2p_connection_id.mli @@ -0,0 +1,11 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +(** P2p_point representing a reachable socket address *) + diff --git a/src/lib_base/p2p_id_point.ml b/src/lib_base/p2p_id_point.ml new file mode 100644 index 000000000..e69de29bb diff --git a/src/lib_base/p2p_id_point.mli b/src/lib_base/p2p_id_point.mli new file mode 100644 index 000000000..769771c1b --- /dev/null +++ b/src/lib_base/p2p_id_point.mli @@ -0,0 +1,9 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + diff --git a/src/lib_base/p2p_identity.ml b/src/lib_base/p2p_identity.ml new file mode 100644 index 000000000..d036ca669 --- /dev/null +++ b/src/lib_base/p2p_identity.ml @@ -0,0 +1,77 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/lib_base/p2p_identity.mli b/src/lib_base/p2p_identity.mli new file mode 100644 index 000000000..9535ed84d --- /dev/null +++ b/src/lib_base/p2p_identity.mli @@ -0,0 +1,29 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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]. *) diff --git a/src/lib_base/p2p_peer.ml b/src/lib_base/p2p_peer.ml new file mode 100644 index 000000000..3b23ad8c5 --- /dev/null +++ b/src/lib_base/p2p_peer.ml @@ -0,0 +1,339 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/lib_base/p2p_peer.mli b/src/lib_base/p2p_peer.mli new file mode 100644 index 000000000..c072f4012 --- /dev/null +++ b/src/lib_base/p2p_peer.mli @@ -0,0 +1,184 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/lib_base/p2p_point.ml b/src/lib_base/p2p_point.ml new file mode 100644 index 000000000..d63969313 --- /dev/null +++ b/src/lib_base/p2p_point.ml @@ -0,0 +1,477 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/lib_base/p2p_point.mli b/src/lib_base/p2p_point.mli new file mode 100644 index 000000000..3187a1251 --- /dev/null +++ b/src/lib_base/p2p_point.mli @@ -0,0 +1,207 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 + + diff --git a/src/lib_base/p2p_stat.ml b/src/lib_base/p2p_stat.ml new file mode 100644 index 000000000..576eaca25 --- /dev/null +++ b/src/lib_base/p2p_stat.ml @@ -0,0 +1,64 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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)) diff --git a/src/lib_base/p2p_stat.mli b/src/lib_base/p2p_stat.mli new file mode 100644 index 000000000..e4cfa3a96 --- /dev/null +++ b/src/lib_base/p2p_stat.mli @@ -0,0 +1,21 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/lib_base/p2p_version.ml b/src/lib_base/p2p_version.ml new file mode 100644 index 000000000..e026e93fc --- /dev/null +++ b/src/lib_base/p2p_version.ml @@ -0,0 +1,40 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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) diff --git a/src/lib_base/p2p_version.mli b/src/lib_base/p2p_version.mli new file mode 100644 index 000000000..b6be2eaf8 --- /dev/null +++ b/src/lib_base/p2p_version.mli @@ -0,0 +1,22 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 + diff --git a/src/lib_base/time.ml b/src/lib_base/time.ml index e4fcb01d3..f977e8982 100644 --- a/src/lib_base/time.ml +++ b/src/lib_base/time.ml @@ -24,6 +24,14 @@ module T = struct let incr_sign = res >= a in if sign = incr_sign then res else invalid_arg "Time.add" ;; + let recent a1 a2 = + match a1, a2 with + | (None, None) -> None + | (None, (Some _ as a)) + | (Some _ as a, None) -> a + | (Some (_, t1), Some (_, t2)) -> + if compare t1 t2 < 0 then a2 else a1 + let hash = to_int let (=) = equal let (<>) x y = compare x y <> 0 diff --git a/src/lib_base/time.mli b/src/lib_base/time.mli index faab7adfe..a87cec611 100644 --- a/src/lib_base/time.mli +++ b/src/lib_base/time.mli @@ -56,3 +56,6 @@ val timed_encoding : 'a Data_encoding.t -> 'a timed_data Data_encoding.t module Set : Set.S with type elt = t module Map : Map.S with type key = t module Table : Hashtbl.S with type key = t + +val recent : + ('a * t) option -> ('a * t) option -> ('a * t) option diff --git a/src/lib_base/tzPervasives.ml b/src/lib_base/tzPervasives.ml index efdda403b..dd5469a2d 100644 --- a/src/lib_base/tzPervasives.ml +++ b/src/lib_base/tzPervasives.ml @@ -44,5 +44,13 @@ module Preapply_result = Preapply_result module Block_locator = Block_locator module Mempool = Mempool +module P2p_addr = P2p_addr +module P2p_identity = P2p_identity +module P2p_peer = P2p_peer +module P2p_point = P2p_point +module P2p_connection = P2p_connection +module P2p_stat = P2p_stat +module P2p_version = P2p_version + include Utils.Infix include Error_monad diff --git a/src/lib_base/tzPervasives.mli b/src/lib_base/tzPervasives.mli index 64e023a39..60ea6f4dc 100644 --- a/src/lib_base/tzPervasives.mli +++ b/src/lib_base/tzPervasives.mli @@ -42,5 +42,13 @@ module Operation_list_list_hash = Operation_list_list_hash module Context_hash = Context_hash module Protocol_hash = Protocol_hash +module P2p_addr = P2p_addr +module P2p_identity = P2p_identity +module P2p_peer = P2p_peer +module P2p_point = P2p_point +module P2p_connection = P2p_connection +module P2p_stat = P2p_stat +module P2p_version = P2p_version + include (module type of (struct include Utils.Infix end)) include (module type of (struct include Error_monad end)) diff --git a/src/lib_client_base/client_network.ml b/src/lib_client_base/client_network.ml index bb4e04fdd..954176075 100644 --- a/src/lib_client_base/client_network.ml +++ b/src/lib_client_base/client_network.ml @@ -7,8 +7,6 @@ (* *) (**************************************************************************) -open P2p_types - let group = { Cli_entries.name = "network" ; title = "Commands for monitoring and controlling network state" } @@ -23,47 +21,47 @@ let commands () = [ Client_node_rpcs.Network.peers cctxt >>=? fun peers -> Client_node_rpcs.Network.points cctxt >>=? fun points -> cctxt#message "GLOBAL STATS" >>= fun () -> - cctxt#message " %a" Stat.pp stat >>= fun () -> + cctxt#message " %a" P2p_stat.pp stat >>= fun () -> cctxt#message "CONNECTIONS" >>= fun () -> let incoming, outgoing = - List.partition (fun c -> c.Connection_info.incoming) conns in + List.partition (fun c -> c.P2p_connection.Info.incoming) conns in Lwt_list.iter_s begin fun conn -> - cctxt#message " %a" Connection_info.pp conn + cctxt#message " %a" P2p_connection.Info.pp conn end incoming >>= fun () -> Lwt_list.iter_s begin fun conn -> - cctxt#message " %a" Connection_info.pp conn + cctxt#message " %a" P2p_connection.Info.pp conn end outgoing >>= fun () -> cctxt#message "KNOWN PEERS" >>= fun () -> Lwt_list.iter_s begin fun (p, pi) -> cctxt#message " %a %.0f %a %a %s" - Peer_state.pp_digram pi.Peer_info.state + P2p_peer.State.pp_digram pi.P2p_peer.Info.state pi.score - Peer_id.pp p - 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 () diff --git a/src/lib_client_base/client_node_rpcs.mli b/src/lib_client_base/client_node_rpcs.mli index 994c77a3b..c9699fce6 100644 --- a/src/lib_client_base/client_node_rpcs.mli +++ b/src/lib_client_base/client_node_rpcs.mli @@ -155,19 +155,17 @@ val bootstrapped: module Network : sig - open P2p_types - val stat: - #Client_rpcs.ctxt -> Stat.t tzresult Lwt.t + #Client_rpcs.ctxt -> P2p_stat.t tzresult Lwt.t val connections: - #Client_rpcs.ctxt -> Connection_info.t list tzresult Lwt.t + #Client_rpcs.ctxt -> P2p_connection.Info.t list tzresult Lwt.t val peers: - #Client_rpcs.ctxt -> (Peer_id.t * P2p_types.Peer_info.t) list tzresult Lwt.t + #Client_rpcs.ctxt -> (P2p_peer.Id.t * P2p_peer.Info.t) list tzresult Lwt.t val points: - #Client_rpcs.ctxt -> (Point.t * P2p_types.Point_info.t) list tzresult Lwt.t + #Client_rpcs.ctxt -> (P2p_point.Id.t * P2p_point.Info.t) list tzresult Lwt.t end diff --git a/src/lib_p2p/p2p.ml b/src/lib_p2p/p2p.ml index 7a06d6c92..1c4c23484 100644 --- a/src/lib_p2p/p2p.ml +++ b/src/lib_p2p/p2p.ml @@ -7,17 +7,15 @@ (* *) (**************************************************************************) -include P2p_types - include Logging.Make(struct let name = "p2p" end) -type 'meta meta_config = 'meta P2p_connection_pool.meta_config = { +type 'meta meta_config = 'meta P2p_pool.meta_config = { encoding : 'meta Data_encoding.t; initial : 'meta; score : 'meta -> float } -type 'msg app_message_encoding = 'msg P2p_connection_pool.encoding = +type 'msg app_message_encoding = 'msg P2p_pool.encoding = Encoding : { tag: int ; encoding: 'a Data_encoding.t ; @@ -26,18 +24,18 @@ type 'msg app_message_encoding = 'msg P2p_connection_pool.encoding = max_length: int option ; } -> 'msg app_message_encoding -type 'msg message_config = 'msg P2p_connection_pool.message_config = { +type 'msg message_config = 'msg P2p_pool.message_config = { encoding : 'msg app_message_encoding list ; - versions : Version.t list; + versions : P2p_version.t list; } type config = { - listening_port : port option; - listening_addr : addr option; - trusted_points : Point.t list ; + listening_port : P2p_addr.port option; + listening_addr : P2p_addr.t option; + trusted_points : P2p_point.Id.t list ; peers_file : string ; closed_network : bool ; - identity : Identity.t ; + identity : P2p_identity.t ; proof_of_work_target : Crypto_box.target ; } @@ -87,7 +85,7 @@ let create_scheduler limits = let create_connection_pool config limits meta_cfg msg_cfg io_sched = let pool_cfg = { - P2p_connection_pool.identity = config.identity ; + P2p_pool.identity = config.identity ; proof_of_work_target = config.proof_of_work_target ; listening_port = config.listening_port ; trusted_points = config.trusted_points ; @@ -109,7 +107,7 @@ let create_connection_pool config limits meta_cfg msg_cfg io_sched = } in let pool = - P2p_connection_pool.create pool_cfg meta_cfg msg_cfg io_sched in + P2p_pool.create pool_cfg meta_cfg msg_cfg io_sched in pool let bounds ~min ~expected ~max = @@ -149,7 +147,7 @@ let may_create_welcome_worker config limits pool = port >>= fun w -> Lwt.return (Some w) -type ('msg, 'meta) connection = ('msg, 'meta) P2p_connection_pool.connection +type ('msg, 'meta) connection = ('msg, 'meta) P2p_pool.connection module Real = struct @@ -157,7 +155,7 @@ module Real = struct config: config ; limits: limits ; io_sched: P2p_io_scheduler.t ; - pool: ('msg, 'meta) P2p_connection_pool.t ; + pool: ('msg, 'meta) P2p_pool.t ; discoverer: P2p_discovery.t option ; maintenance: 'meta P2p_maintenance.t ; welcome: P2p_welcome.t option ; @@ -193,119 +191,119 @@ module Real = struct Lwt_utils.may ~f:P2p_welcome.shutdown net.welcome >>= fun () -> P2p_maintenance.shutdown net.maintenance >>= fun () -> Lwt_utils.may ~f:P2p_discovery.shutdown net.discoverer >>= fun () -> - P2p_connection_pool.destroy net.pool >>= fun () -> + P2p_pool.destroy net.pool >>= fun () -> P2p_io_scheduler.shutdown ~timeout:3.0 net.io_sched let connections { pool } () = - P2p_connection_pool.Connection.fold pool + P2p_pool.Connection.fold pool ~init:[] ~f:(fun _peer_id c acc -> c :: acc) let find_connection { pool } peer_id = - P2p_connection_pool.Connection.find_by_peer_id pool peer_id + P2p_pool.Connection.find_by_peer_id pool peer_id let disconnect ?wait conn = - P2p_connection_pool.disconnect ?wait conn + P2p_pool.disconnect ?wait conn let connection_info _net conn = - P2p_connection_pool.Connection.info conn + P2p_pool.Connection.info conn let connection_stat _net conn = - P2p_connection_pool.Connection.stat conn + P2p_pool.Connection.stat conn let global_stat { pool } () = - P2p_connection_pool.pool_stat pool + P2p_pool.pool_stat pool let set_metadata { pool } conn meta = - P2p_connection_pool.Peer_ids.set_metadata pool conn meta + P2p_pool.Peers.set_metadata pool conn meta let get_metadata { pool } conn = - P2p_connection_pool.Peer_ids.get_metadata pool conn + P2p_pool.Peers.get_metadata pool conn let recv _net conn = - P2p_connection_pool.read conn >>=? fun msg -> + P2p_pool.read conn >>=? fun msg -> lwt_debug "message read from %a" - Connection_info.pp - (P2p_connection_pool.Connection.info conn) >>= fun () -> + P2p_connection.Info.pp + (P2p_pool.Connection.info conn) >>= fun () -> return msg let rec recv_any net () = let pipes = - P2p_connection_pool.Connection.fold + P2p_pool.Connection.fold net.pool ~init:[] ~f:begin fun _peer_id conn acc -> - (P2p_connection_pool.is_readable conn >>= function + (P2p_pool.is_readable conn >>= function | Ok () -> Lwt.return (Some conn) | Error _ -> Lwt_utils.never_ending) :: acc end in Lwt.pick ( - ( P2p_connection_pool.Pool_event.wait_new_connection net.pool >>= fun () -> + ( P2p_pool.Pool_event.wait_new_connection net.pool >>= fun () -> Lwt.return_none ):: pipes) >>= function | None -> recv_any net () | Some conn -> - P2p_connection_pool.read conn >>= function + P2p_pool.read conn >>= function | Ok msg -> lwt_debug "message read from %a" - Connection_info.pp - (P2p_connection_pool.Connection.info conn) >>= fun () -> + P2p_connection.Info.pp + (P2p_pool.Connection.info conn) >>= fun () -> Lwt.return (conn, msg) | Error _ -> lwt_debug "error reading message from %a" - Connection_info.pp - (P2p_connection_pool.Connection.info conn) >>= fun () -> + P2p_connection.Info.pp + (P2p_pool.Connection.info conn) >>= fun () -> Lwt_unix.yield () >>= fun () -> recv_any net () let send _net conn m = - P2p_connection_pool.write conn m >>= function + P2p_pool.write conn m >>= function | Ok () -> lwt_debug "message sent to %a" - Connection_info.pp - (P2p_connection_pool.Connection.info conn) >>= fun () -> + P2p_connection.Info.pp + (P2p_pool.Connection.info conn) >>= fun () -> return () | Error err -> lwt_debug "error sending message from %a: %a" - Connection_info.pp - (P2p_connection_pool.Connection.info conn) + P2p_connection.Info.pp + (P2p_pool.Connection.info conn) pp_print_error err >>= fun () -> Lwt.return (Error err) let try_send _net conn v = - match P2p_connection_pool.write_now conn v with + match P2p_pool.write_now conn v with | Ok v -> debug "message trysent to %a" - Connection_info.pp - (P2p_connection_pool.Connection.info conn) ; + P2p_connection.Info.pp + (P2p_pool.Connection.info conn) ; v | Error err -> debug "error trysending message to %a@ %a" - Connection_info.pp - (P2p_connection_pool.Connection.info conn) + P2p_connection.Info.pp + (P2p_pool.Connection.info conn) pp_print_error err ; false let broadcast { pool } msg = - P2p_connection_pool.write_all pool msg ; + P2p_pool.write_all pool msg ; debug "message broadcasted" let fold_connections { pool } ~init ~f = - P2p_connection_pool.Connection.fold pool ~init ~f + P2p_pool.Connection.fold pool ~init ~f let iter_connections { pool } f = - P2p_connection_pool.Connection.fold pool + P2p_pool.Connection.fold pool ~init:() ~f:(fun gid conn () -> f gid conn) let on_new_connection { pool } f = - P2p_connection_pool.on_new_connection pool f + P2p_pool.on_new_connection pool f let pool { pool } = pool end module Fake = struct - let id = Identity.generate (Crypto_box.make_target 0.) + let id = P2p_identity.generate (Crypto_box.make_target 0.) let empty_stat = { - Stat.total_sent = 0L ; + P2p_stat.total_sent = 0L ; total_recv = 0L ; current_inflow = 0 ; current_outflow = 0 ; } let connection_info = { - Connection_info.incoming = false ; + P2p_connection.Info.incoming = false ; peer_id = id.peer_id ; id_point = (Ipaddr.V6.unspecified, None) ; remote_socket_port = 0 ; @@ -315,28 +313,28 @@ module Fake = struct end type ('msg, 'meta) t = { - peer_id : Peer_id.t ; + peer_id : P2p_peer.Id.t ; maintain : unit -> unit Lwt.t ; roll : unit -> unit Lwt.t ; shutdown : unit -> unit Lwt.t ; connections : unit -> ('msg, 'meta) connection list ; - find_connection : Peer_id.t -> ('msg, 'meta) connection option ; + find_connection : P2p_peer.Id.t -> ('msg, 'meta) connection option ; disconnect : ?wait:bool -> ('msg, 'meta) connection -> unit Lwt.t ; - connection_info : ('msg, 'meta) connection -> Connection_info.t ; - connection_stat : ('msg, 'meta) connection -> Stat.t ; - global_stat : unit -> Stat.t ; - get_metadata : Peer_id.t -> 'meta ; - set_metadata : Peer_id.t -> 'meta -> unit ; + connection_info : ('msg, 'meta) connection -> P2p_connection.Info.t ; + connection_stat : ('msg, 'meta) connection -> P2p_stat.t ; + global_stat : unit -> P2p_stat.t ; + get_metadata : P2p_peer.Id.t -> 'meta ; + set_metadata : P2p_peer.Id.t -> 'meta -> unit ; recv : ('msg, 'meta) connection -> 'msg tzresult Lwt.t ; recv_any : unit -> (('msg, 'meta) connection * 'msg) Lwt.t ; send : ('msg, 'meta) connection -> 'msg -> unit tzresult Lwt.t ; try_send : ('msg, 'meta) connection -> 'msg -> bool ; broadcast : 'msg -> unit ; - pool : ('msg, 'meta) P2p_connection_pool.t option ; + pool : ('msg, 'meta) P2p_pool.t option ; fold_connections : - 'a. init:'a -> f:(Peer_id.t -> ('msg, 'meta) connection -> 'a -> 'a) -> 'a ; - iter_connections : (Peer_id.t -> ('msg, 'meta) connection -> unit) -> unit ; - on_new_connection : (Peer_id.t -> ('msg, 'meta) connection -> unit) -> unit ; + 'a. init:'a -> f:(P2p_peer.Id.t -> ('msg, 'meta) connection -> 'a -> 'a) -> 'a ; + iter_connections : (P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) -> unit ; + on_new_connection : (P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) -> unit ; } type ('msg, 'meta) net = ('msg, 'meta) t @@ -374,7 +372,7 @@ let check_limits = begin match c.binary_chunks_size with | None -> return () - | Some size -> P2p_connection.check_binary_chunks_size size + | Some size -> P2p_socket.check_binary_chunks_size size end >>=? fun () -> return () @@ -420,7 +418,7 @@ let faked_network meta_config = { set_metadata = (fun _ _ -> ()) ; recv = (fun _ -> Lwt_utils.never_ending) ; recv_any = (fun () -> Lwt_utils.never_ending) ; - send = (fun _ _ -> fail P2p_connection_pool.Connection_closed) ; + send = (fun _ _ -> fail P2p_pool.Connection_closed) ; try_send = (fun _ _ -> false) ; fold_connections = (fun ~init ~f:_ -> init) ; iter_connections = (fun _f -> ()) ; @@ -451,35 +449,33 @@ let iter_connections net = net.iter_connections let on_new_connection net = net.on_new_connection module Raw = struct - type 'a t = 'a P2p_connection_pool.Message.t = + type 'a t = 'a P2p_pool.Message.t = | Bootstrap - | Advertise of P2p_types.Point.t list - | Swap_request of Point.t * Peer_id.t - | Swap_ack of Point.t * Peer_id.t + | Advertise of P2p_point.Id.t list + | Swap_request of P2p_point.Id.t * P2p_peer.Id.t + | Swap_ack of P2p_point.Id.t * P2p_peer.Id.t | Message of 'a | Disconnect - let encoding = P2p_connection_pool.Message.encoding + let encoding = P2p_pool.Message.encoding end module RPC = struct let stat net = match net.pool with - | None -> Stat.empty - | Some pool -> P2p_connection_pool.pool_stat pool - - module Event = P2p_connection_pool.Log_event + | None -> P2p_stat.empty + | Some pool -> P2p_pool.pool_stat pool let watch net = match net.pool with | None -> Lwt_watcher.create_fake_stream () - | Some pool -> P2p_connection_pool.watch pool + | Some pool -> P2p_pool.watch pool let connect net point timeout = match net.pool with | None -> failwith "fake net" | Some pool -> - P2p_connection_pool.connect ~timeout pool point >>|? ignore + P2p_pool.connect ~timeout pool point >>|? ignore module Connection = struct let info net peer_id = @@ -487,46 +483,45 @@ module RPC = struct | None -> None | Some pool -> Option.map - (P2p_connection_pool.Connection.find_by_peer_id pool peer_id) - ~f:P2p_connection_pool.Connection.info + (P2p_pool.Connection.find_by_peer_id pool peer_id) + ~f:P2p_pool.Connection.info let kick net peer_id wait = match net.pool with | None -> Lwt.return_unit | Some pool -> - match P2p_connection_pool.Connection.find_by_peer_id pool peer_id with + match P2p_pool.Connection.find_by_peer_id pool peer_id with | None -> Lwt.return_unit - | Some conn -> P2p_connection_pool.disconnect ~wait conn + | Some conn -> P2p_pool.disconnect ~wait conn let list net = match net.pool with | None -> [] | Some pool -> - P2p_connection_pool.Connection.fold + P2p_pool.Connection.fold pool ~init:[] ~f:begin fun _peer_id c acc -> - P2p_connection_pool.Connection.info c :: acc + P2p_pool.Connection.info c :: acc end let count net = match net.pool with | None -> 0 - | Some pool -> P2p_connection_pool.active_connections pool + | Some pool -> P2p_pool.active_connections pool end module Point = struct - open P2p_types.Point_info - open P2p_types.Point_state + open P2p_point.Info + open P2p_point.State let info_of_point_info i = - let open P2p_connection_pool_types in - let state = match Point_info.State.get i with + let state = match P2p_point.Pool_state.get i with | Requested _ -> Requested | Accepted { current_peer_id ; _ } -> Accepted current_peer_id | Running { current_peer_id ; _ } -> Running current_peer_id | Disconnected -> Disconnected in - Point_info.{ + P2p_point.Pool_info.{ trusted = trusted i ; state ; greylisted_until = greylisted_until i ; @@ -543,21 +538,19 @@ module RPC = struct | None -> None | Some pool -> Option.map - (P2p_connection_pool.Points.info pool point) + (P2p_pool.Points.info pool point) ~f:info_of_point_info - module Event = P2p_connection_pool_types.Point_info.Event - let events ?(max=max_int) ?(rev=false) net point = match net.pool with | None -> [] | Some pool -> Option.unopt_map - (P2p_connection_pool.Points.info pool point) + (P2p_pool.Points.info pool point) ~default:[] ~f:begin fun pi -> let evts = - P2p_connection_pool_types.Point_info.fold_events + P2p_point.Pool_event.fold pi ~init:[] ~f:(fun a e -> e :: a) in (if rev then List.rev_sub else List.sub) evts max end @@ -566,15 +559,15 @@ module RPC = struct match net.pool with | None -> raise Not_found | Some pool -> - match P2p_connection_pool.Points.info pool point with + match P2p_pool.Points.info pool point with | None -> raise Not_found - | Some pi -> P2p_connection_pool_types.Point_info.watch pi + | Some pi -> P2p_point.Pool_event.watch pi let list ?(restrict=[]) net = match net.pool with | None -> [] | Some pool -> - P2p_connection_pool.Points.fold_known + P2p_pool.Points.fold_known pool ~init:[] ~f:begin fun point i a -> let info = info_of_point_info i in @@ -588,24 +581,22 @@ module RPC = struct module Peer_id = struct - open P2p_types.Peer_info - open P2p_types.Peer_state + open P2p_peer.Info + open P2p_peer.State let info_of_peer_info pool i = - let open P2p_connection_pool in - let open P2p_connection_pool_types in - let state, id_point = match Peer_info.State.get i with + let state, id_point = match P2p_peer.Pool_state.get i with | Accepted { current_point } -> Accepted, Some current_point | Running { current_point } -> Running, Some current_point | Disconnected -> Disconnected, None in - let peer_id = Peer_info.peer_id i in - let score = Peer_ids.get_score pool peer_id in + let peer_id = P2p_peer.Pool_info.peer_id i in + let score = P2p_pool.Peers.get_score pool peer_id in let stat = - match P2p_connection_pool.Connection.find_by_peer_id pool peer_id with - | None -> Stat.empty - | Some conn -> P2p_connection_pool.Connection.stat conn - in Peer_info.{ + match P2p_pool.Connection.find_by_peer_id pool peer_id with + | None -> P2p_stat.empty + | Some conn -> P2p_pool.Connection.stat conn + in P2p_peer.Pool_info.{ score ; trusted = trusted i ; state ; @@ -623,7 +614,7 @@ module RPC = struct match net.pool with | None -> None | Some pool -> begin - match P2p_connection_pool.Peer_ids.info pool peer_id with + match P2p_pool.Peers.info pool peer_id with | Some info -> Some (info_of_peer_info pool info) | None -> None end @@ -633,10 +624,10 @@ module RPC = struct | None -> [] | Some pool -> Option.unopt_map - (P2p_connection_pool.Peer_ids.info pool peer_id) + (P2p_pool.Peers.info pool peer_id) ~default:[] ~f:begin fun gi -> - let evts = P2p_connection_pool_types.Peer_info.fold_events gi + let evts = P2p_peer.Pool_event.fold gi ~init:[] ~f:(fun a e -> e :: a) in (if rev then List.rev_sub else List.sub) evts max end @@ -645,15 +636,15 @@ module RPC = struct match net.pool with | None -> raise Not_found | Some pool -> - match P2p_connection_pool.Peer_ids.info pool peer_id with + match P2p_pool.Peers.info pool peer_id with | None -> raise Not_found - | Some gi -> P2p_connection_pool_types.Peer_info.watch gi + | Some gi -> P2p_peer.Pool_event.watch gi let list ?(restrict=[]) net = match net.pool with | None -> [] | Some pool -> - P2p_connection_pool.Peer_ids.fold_known pool + P2p_pool.Peers.fold_known pool ~init:[] ~f:begin fun peer_id i a -> let info = info_of_peer_info pool i in diff --git a/src/lib_p2p/p2p.mli b/src/lib_p2p/p2p.mli index 4fa640700..12cc2c9f5 100644 --- a/src/lib_p2p/p2p.mli +++ b/src/lib_p2p/p2p.mli @@ -9,28 +9,6 @@ (** Tezos Shell Net - Low level API for the Gossip network *) -(** A peer connection address *) -type addr = Ipaddr.V6.t - -(** A peer connection port *) -type port = int - -(** A p2p protocol version *) -module Version = P2p_types.Version - -(** A global identifier for a peer, a.k.a. an identity *) -module Peer_id = P2p_types.Peer_id - -module Identity = P2p_types.Identity - -module Point = P2p_types.Point - -module Id_point = P2p_types.Id_point - -module Connection_info = P2p_types.Connection_info - -module Stat = P2p_types.Stat - type 'meta meta_config = { encoding : 'meta Data_encoding.t; initial : 'meta; @@ -47,21 +25,21 @@ type 'msg app_message_encoding = Encoding : { type 'msg message_config = { encoding : 'msg app_message_encoding list ; - versions : Version.t list; + versions : P2p_version.t list; } (** Network configuration *) type config = { - listening_port : port option; + listening_port : P2p_addr.port option; (** Tells if incoming connections accepted, precising the TCP port on which the peer can be reached *) - listening_addr : addr option; + listening_addr : P2p_addr.t option; (** When incoming connections are accepted, precising on which IP adddress the node listen (default: [[::]]). *) - trusted_points : Point.t list ; + trusted_points : P2p_point.Id.t list ; (** List of hard-coded known peers to bootstrap the network from. *) peers_file : string ; @@ -72,7 +50,7 @@ type config = { (** If [true], the only accepted connections are from peers whose addresses are in [trusted_peers]. *) - identity : Identity.t ; + identity : P2p_identity.t ; (** Cryptographic identity of the peer. *) proof_of_work_target : Crypto_box.target ; @@ -148,7 +126,7 @@ val create : 'meta meta_config -> 'msg message_config -> ('msg, 'meta) net tzresult Lwt.t (** Return one's peer_id *) -val peer_id : ('msg, 'meta) net -> Peer_id.t +val peer_id : ('msg, 'meta) net -> P2p_peer.Id.t (** A maintenance operation : try and reach the ideal number of peers *) val maintain : ('msg, 'meta) net -> unit Lwt.t @@ -166,23 +144,23 @@ type ('msg, 'meta) connection val connections : ('msg, 'meta) net -> ('msg, 'meta) connection list (** Return the active peer with identity [peer_id] *) -val find_connection : ('msg, 'meta) net -> Peer_id.t -> ('msg, 'meta) connection option +val find_connection : ('msg, 'meta) net -> P2p_peer.Id.t -> ('msg, 'meta) connection option (** Access the info of an active peer, if available *) val connection_info : - ('msg, 'meta) net -> ('msg, 'meta) connection -> Connection_info.t + ('msg, 'meta) net -> ('msg, 'meta) connection -> P2p_connection.Info.t val connection_stat : - ('msg, 'meta) net -> ('msg, 'meta) connection -> Stat.t + ('msg, 'meta) net -> ('msg, 'meta) connection -> P2p_stat.t (** Cleanly closes a connection. *) val disconnect : ('msg, 'meta) net -> ?wait:bool -> ('msg, 'meta) connection -> unit Lwt.t -val global_stat : ('msg, 'meta) net -> Stat.t +val global_stat : ('msg, 'meta) net -> P2p_stat.t (** Accessors for meta information about a global identifier *) -val get_metadata : ('msg, 'meta) net -> Peer_id.t -> 'meta -val set_metadata : ('msg, 'meta) net -> Peer_id.t -> 'meta -> unit +val get_metadata : ('msg, 'meta) net -> P2p_peer.Id.t -> 'meta +val set_metadata : ('msg, 'meta) net -> P2p_peer.Id.t -> 'meta -> unit (** Wait for a message from a given connection. *) val recv : @@ -207,56 +185,56 @@ val broadcast : ('msg, 'meta) net -> 'msg -> unit module RPC : sig - val stat : ('msg, 'meta) net -> Stat.t + val stat : ('msg, 'meta) net -> P2p_stat.t val watch : ('msg, 'meta) net -> - P2p_types.Connection_pool_log_event.t Lwt_stream.t * Lwt_watcher.stopper - val connect : ('msg, 'meta) net -> Point.t -> float -> unit tzresult Lwt.t + P2p_connection.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper + val connect : ('msg, 'meta) net -> P2p_point.Id.t -> float -> unit tzresult Lwt.t module Connection : sig - val info : ('msg, 'meta) net -> Peer_id.t -> Connection_info.t option - val kick : ('msg, 'meta) net -> Peer_id.t -> bool -> unit Lwt.t - val list : ('msg, 'meta) net -> Connection_info.t list + val info : ('msg, 'meta) net -> P2p_peer.Id.t -> P2p_connection.Info.t option + val kick : ('msg, 'meta) net -> P2p_peer.Id.t -> bool -> unit Lwt.t + val list : ('msg, 'meta) net -> P2p_connection.Info.t list val count : ('msg, 'meta) net -> int end module Point : sig val info : - ('msg, 'meta) net -> Point.t -> P2p_types.Point_info.t option + ('msg, 'meta) net -> P2p_point.Id.t -> P2p_point.Info.t option val list : - ?restrict: P2p_types.Point_state.t list -> - ('msg, 'meta) net -> (Point.t * P2p_types.Point_info.t) list + ?restrict: P2p_point.State.t list -> + ('msg, 'meta) net -> (P2p_point.Id.t * P2p_point.Info.t) list val events : - ?max:int -> ?rev:bool -> ('msg, 'meta) net -> Point.t -> - P2p_connection_pool_types.Point_info.Event.t list + ?max:int -> ?rev:bool -> ('msg, 'meta) net -> P2p_point.Id.t -> + P2p_point.Pool_event.t list val watch : - ('msg, 'meta) net -> Point.t -> - P2p_connection_pool_types.Point_info.Event.t Lwt_stream.t * Lwt_watcher.stopper + ('msg, 'meta) net -> P2p_point.Id.t -> + P2p_point.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper end module Peer_id : sig val info : - ('msg, 'meta) net -> Peer_id.t -> P2p_types.Peer_info.t option + ('msg, 'meta) net -> P2p_peer.Id.t -> P2p_peer.Info.t option val list : - ?restrict: P2p_types.Peer_state.t list -> - ('msg, 'meta) net -> (Peer_id.t * P2p_types.Peer_info.t) list + ?restrict: P2p_peer.State.t list -> + ('msg, 'meta) net -> (P2p_peer.Id.t * P2p_peer.Info.t) list val events : ?max: int -> ?rev: bool -> - ('msg, 'meta) net -> Peer_id.t -> - P2p_connection_pool_types.Peer_info.Event.t list + ('msg, 'meta) net -> P2p_peer.Id.t -> + P2p_peer.Pool_event.t list val watch : - ('msg, 'meta) net -> Peer_id.t -> - P2p_connection_pool_types.Peer_info.Event.t Lwt_stream.t * Lwt_watcher.stopper + ('msg, 'meta) net -> P2p_peer.Id.t -> + P2p_peer.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper end @@ -264,24 +242,24 @@ end val fold_connections : ('msg, 'meta) net -> - init:'a -> f:(Peer_id.t -> ('msg, 'meta) connection -> 'a -> 'a) -> 'a + init:'a -> f:(P2p_peer.Id.t -> ('msg, 'meta) connection -> 'a -> 'a) -> 'a val iter_connections : ('msg, 'meta) net -> - (Peer_id.t -> ('msg, 'meta) connection -> unit) -> unit + (P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) -> unit val on_new_connection : ('msg, 'meta) net -> - (Peer_id.t -> ('msg, 'meta) connection -> unit) -> unit + (P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) -> unit (**/**) module Raw : sig type 'a t = | Bootstrap - | Advertise of P2p_types.Point.t list - | Swap_request of Point.t * Peer_id.t - | Swap_ack of Point.t * Peer_id.t + | Advertise of P2p_point.Id.t list + | Swap_request of P2p_point.Id.t * P2p_peer.Id.t + | Swap_ack of P2p_point.Id.t * P2p_peer.Id.t | Message of 'a | Disconnect val encoding: 'msg app_message_encoding list -> 'msg t Data_encoding.t diff --git a/src/lib_p2p/p2p_discovery.ml b/src/lib_p2p/p2p_discovery.ml index e25ab53ab..190e5341b 100644 --- a/src/lib_p2p/p2p_discovery.ml +++ b/src/lib_p2p/p2p_discovery.ml @@ -20,7 +20,7 @@ let inet_addr = Unix.inet_addr_of_string "ff0e::54:455a:3053" module Message = struct let encoding = - Data_encoding.(tup3 (Fixed.string 10) Peer_id.encoding int16) + Data_encoding.(tup3 (Fixed.string 10) P2p_peer.Id.encoding int16) let length = Data_encoding.Binary.fixed_length_exn encoding @@ -40,7 +40,7 @@ let sender sock saddr my_peer_id inco_port cancelation restart = Lwt.return_unit) (fun exn -> lwt_debug "(%a) error broadcasting a discovery request: %a" - Peer_id.pp my_peer_id Error_monad.pp (Exn exn)) >>= fun () -> + P2p_peer.Id.pp my_peer_id Error_monad.pp (Exn exn)) >>= fun () -> Lwt.pick [ (Lwt_unix.sleep delay >>= fun () -> Lwt.return (Some (delay, n + 1))) ; (cancelation () >>= fun () -> Lwt.return_none) ; @@ -100,7 +100,7 @@ module Answerer = struct Lwt.catch (fun () -> Lwt_utils.worker - (Format.asprintf "(%a) discovery answerer" Peer_id.pp my_peer_id) + (Format.asprintf "(%a) discovery answerer" P2p_peer.Id.pp my_peer_id) (fun () -> answerer fd my_peer_id cancelation callback) cancel) (fun exn -> @@ -118,7 +118,7 @@ let discovery_sender = Discovery.sender fd saddr my_peer_id inco_port cancelation restart_discovery in Lwt_utils.worker - (Format.asprintf "(%a) discovery sender" Peer_id.pp my_peer_id) + (Format.asprintf "(%a) discovery sender" P2p_peer.Id.pp my_peer_id) sender cancel) (fun exn -> lwt_log_error "Discovery sender not started: %a" diff --git a/src/lib_p2p/p2p_discovery.mli b/src/lib_p2p/p2p_discovery.mli index 05b7d5f9f..6c3c9193c 100644 --- a/src/lib_p2p/p2p_discovery.mli +++ b/src/lib_p2p/p2p_discovery.mli @@ -8,6 +8,6 @@ (**************************************************************************) type t -val create : ('msg, 'meta) P2p_connection_pool.pool -> t +val create : ('msg, 'meta) P2p_pool.t -> t val restart : t -> unit val shutdown : t -> unit Lwt.t diff --git a/src/lib_p2p/p2p_io_scheduler.ml b/src/lib_p2p/p2p_io_scheduler.ml index 8b08312bc..48980ccb9 100644 --- a/src/lib_p2p/p2p_io_scheduler.ml +++ b/src/lib_p2p/p2p_io_scheduler.ml @@ -17,7 +17,6 @@ let () = if Sys.os_type <> "Win32" then Sys.(set_signal sigpipe Signal_ignore) -open P2p_types include Logging.Make (struct let name = "p2p.io-scheduler" end) module Inttbl = Hashtbl.Make(struct @@ -457,7 +456,7 @@ let read_full conn ?pos ?len buf = loop pos len let convert ~ws ~rs = - { Stat.total_sent = ws.Moving_average.total ; + { P2p_stat.total_sent = ws.Moving_average.total ; total_recv = rs.Moving_average.total ; current_outflow = ws.average ; current_inflow = rs.average ; diff --git a/src/lib_p2p/p2p_io_scheduler.mli b/src/lib_p2p/p2p_io_scheduler.mli index c590d6d61..f45c0f1c1 100644 --- a/src/lib_p2p/p2p_io_scheduler.mli +++ b/src/lib_p2p/p2p_io_scheduler.mli @@ -23,8 +23,6 @@ num_connections). *) -open P2p_types - type connection (** Type of a connection. *) @@ -71,11 +69,11 @@ val read_full: connection -> ?pos:int -> ?len:int -> MBytes.t -> unit tzresult Lwt.t (** Like [read], but blits exactly [len] bytes in [buf]. *) -val stat: connection -> Stat.t +val stat: connection -> P2p_stat.t (** [stat conn] is a snapshot of current bandwidth usage for [conn]. *) -val global_stat: t -> Stat.t +val global_stat: t -> P2p_stat.t (** [global_stat sched] is a snapshot of [sched]'s bandwidth usage (sum of [stat conn] for each [conn] in [sched]). *) diff --git a/src/lib_p2p/p2p_maintenance.ml b/src/lib_p2p/p2p_maintenance.ml index 088f835ad..2541e8dcf 100644 --- a/src/lib_p2p/p2p_maintenance.ml +++ b/src/lib_p2p/p2p_maintenance.ml @@ -7,9 +7,6 @@ (* *) (**************************************************************************) -open P2p_types -open P2p_connection_pool_types - include Logging.Make (struct let name = "p2p.maintenance" end) type bounds = { @@ -19,7 +16,7 @@ type bounds = { max_threshold: int ; } -type 'meta pool = Pool : ('msg, 'meta) P2p_connection_pool.t -> 'meta pool +type 'meta pool = Pool : ('msg, 'meta) P2p_pool.t -> 'meta pool type 'meta t = { canceler: Lwt_canceler.t ; @@ -41,7 +38,7 @@ let connectable st start_time expected = let now = Time.now () in let module Bounded_point_info = List.Bounded(struct - type t = (Time.t option * Point.t) + type t = (Time.t option * P2p_point.Id.t) let compare (t1, _) (t2, _) = match t1, t2 with | None, None -> 0 @@ -50,13 +47,13 @@ let connectable st start_time expected = | Some t1, Some t2 -> Time.compare t2 t1 end) in let acc = Bounded_point_info.create expected in - P2p_connection_pool.Points.fold_known pool ~init:() + P2p_pool.Points.fold_known pool ~init:() ~f:begin fun point pi () -> - match Point_info.State.get pi with + match P2p_point.Pool_state.get pi with | Disconnected -> begin - match Point_info.last_miss pi with + match P2p_point.Pool_info.last_miss pi with | Some last when Time.(start_time < last) - || Point_info.greylisted ~now pi -> () + || P2p_point.Pool_info.greylisted ~now pi -> () | last -> Bounded_point_info.insert (last, point) acc end @@ -83,7 +80,7 @@ let rec try_to_contact else List.fold_left (fun acc point -> - P2p_connection_pool.connect + P2p_pool.connect ~timeout:st.connection_timeout pool point >>= function | Ok _ -> acc >|= succ | Error _ -> acc) @@ -96,7 +93,7 @@ let rec try_to_contact of connections is between `min_threshold` and `max_threshold`. *) let rec maintain st = let Pool pool = st.pool in - let n_connected = P2p_connection_pool.active_connections pool in + let n_connected = P2p_pool.active_connections pool in if n_connected < st.bounds.min_threshold then too_few_connections st n_connected else if st.bounds.max_threshold < n_connected then @@ -121,10 +118,10 @@ and too_few_connections st n_connected = (* not enough contacts, ask the pals of our pals, discover the local network and then wait *) Option.iter ~f:P2p_discovery.restart st.disco ; - P2p_connection_pool.broadcast_bootstrap_msg pool ; + P2p_pool.broadcast_bootstrap_msg pool ; Lwt_utils.protect ~canceler:st.canceler begin fun () -> Lwt.pick [ - P2p_connection_pool.Pool_event.wait_new_peer pool ; + P2p_pool.Pool_event.wait_new_peer pool ; Lwt_unix.sleep 5.0 (* TODO exponential back-off ?? or wait for the existence of a non grey-listed peer ?? *) @@ -138,11 +135,11 @@ and too_many_connections st n_connected = (* too many connections, start the russian roulette *) let to_kill = n_connected - st.bounds.max_target in lwt_debug "Too many connections, will kill %d" to_kill >>= fun () -> - snd @@ P2p_connection_pool.Connection.fold pool + snd @@ P2p_pool.Connection.fold pool ~init:(to_kill, Lwt.return_unit) ~f:(fun _ conn (i, t) -> if i = 0 then (0, t) - else (i - 1, t >>= fun () -> P2p_connection_pool.disconnect conn)) + else (i - 1, t >>= fun () -> P2p_pool.disconnect conn)) >>= fun () -> maintain st @@ -153,17 +150,17 @@ let rec worker_loop st = Lwt.pick [ Lwt_unix.sleep 120. ; (* every two minutes *) Lwt_condition.wait st.please_maintain ; (* when asked *) - P2p_connection_pool.Pool_event.wait_too_few_connections pool ; (* limits *) - P2p_connection_pool.Pool_event.wait_too_many_connections pool + P2p_pool.Pool_event.wait_too_few_connections pool ; (* limits *) + P2p_pool.Pool_event.wait_too_many_connections pool ] >>= fun () -> return () end >>=? fun () -> - let n_connected = P2p_connection_pool.active_connections pool in + let n_connected = P2p_pool.active_connections pool in if n_connected < st.bounds.min_threshold || st.bounds.max_threshold < n_connected then maintain st else begin - P2p_connection_pool.send_swap_request pool ; + P2p_pool.send_swap_request pool ; return () end end >>= function diff --git a/src/lib_p2p/p2p_maintenance.mli b/src/lib_p2p/p2p_maintenance.mli index 35b7b2289..300d85929 100644 --- a/src/lib_p2p/p2p_maintenance.mli +++ b/src/lib_p2p/p2p_maintenance.mli @@ -36,7 +36,7 @@ type 'meta t val run: connection_timeout:float -> bounds -> - ('msg, 'meta) P2p_connection_pool.t -> + ('msg, 'meta) P2p_pool.t -> P2p_discovery.t option -> 'meta t diff --git a/src/lib_p2p/p2p_connection_pool.ml b/src/lib_p2p/p2p_pool.ml similarity index 71% rename from src/lib_p2p/p2p_connection_pool.ml rename to src/lib_p2p/p2p_pool.ml index c4c769b20..04a417b1c 100644 --- a/src/lib_p2p/p2p_connection_pool.ml +++ b/src/lib_p2p/p2p_pool.ml @@ -15,9 +15,6 @@ (* TODO allow to track "requested peer_ids" when we reconnect to a point. *) -open P2p_types -open P2p_connection_pool_types - include Logging.Make (struct let name = "p2p.connection-pool" end) type 'msg encoding = Encoding : { @@ -32,9 +29,9 @@ module Message = struct type 'msg t = | Bootstrap - | Advertise of Point.t list - | Swap_request of Point.t * Peer_id.t - | Swap_ack of Point.t * Peer_id.t + | Advertise of P2p_point.Id.t list + | Swap_request of P2p_point.Id.t * P2p_peer.Id.t + | Swap_ack of P2p_point.Id.t * P2p_peer.Id.t | Message of 'msg | Disconnect @@ -48,15 +45,15 @@ module Message = struct case (Tag 0x02) null (function Bootstrap -> Some () | _ -> None) (fun () -> Bootstrap); - case (Tag 0x03) (Variable.list Point.encoding) + case (Tag 0x03) (Variable.list P2p_point.Id.encoding) (function Advertise points -> Some points | _ -> None) (fun points -> Advertise points); - case (Tag 0x04) (tup2 Point.encoding Peer_id.encoding) + case (Tag 0x04) (tup2 P2p_point.Id.encoding P2p_peer.Id.encoding) (function | Swap_request (point, peer_id) -> Some (point, peer_id) | _ -> None) (fun (point, peer_id) -> Swap_request (point, peer_id)) ; - case (Tag 0x05) (tup2 Point.encoding Peer_id.encoding) + case (Tag 0x05) (tup2 P2p_point.Id.encoding P2p_peer.Id.encoding) (function | Swap_ack (point, peer_id) -> Some (point, peer_id) | _ -> None) @@ -74,16 +71,16 @@ end module Answerer = struct type 'msg callback = { - bootstrap: unit -> Point.t list Lwt.t ; - advertise: Point.t list -> unit Lwt.t ; + bootstrap: unit -> P2p_point.Id.t list Lwt.t ; + advertise: P2p_point.Id.t list -> unit Lwt.t ; message: int -> 'msg -> unit Lwt.t ; - swap_request: Point.t -> Peer_id.t -> unit Lwt.t ; - swap_ack: Point.t -> Peer_id.t -> unit Lwt.t ; + swap_request: P2p_point.Id.t -> P2p_peer.Id.t -> unit Lwt.t ; + swap_ack: P2p_point.Id.t -> P2p_peer.Id.t -> unit Lwt.t ; } type 'msg t = { canceler: Lwt_canceler.t ; - conn: 'msg Message.t P2p_connection.t ; + conn: 'msg Message.t P2p_socket.t ; callback: 'msg callback ; mutable worker: unit Lwt.t ; } @@ -91,14 +88,14 @@ module Answerer = struct let rec worker_loop st = Lwt_unix.yield () >>= fun () -> Lwt_utils.protect ~canceler:st.canceler begin fun () -> - P2p_connection.read st.conn + P2p_socket.read st.conn end >>= function | Ok (_, Bootstrap) -> begin st.callback.bootstrap () >>= function | [] -> worker_loop st | points -> - match P2p_connection.write_now st.conn (Advertise points) with + match P2p_socket.write_now st.conn (Advertise points) with | Ok _sent -> (* if not sent then ?? TODO count dropped message ?? *) worker_loop st @@ -121,7 +118,7 @@ module Answerer = struct | Ok (_, Disconnect) | Error [P2p_io_scheduler.Connection_closed] -> Lwt_canceler.cancel st.canceler >>= fun () -> Lwt.return_unit - | Error [P2p_connection.Decoding_error] -> + | Error [P2p_socket.Decoding_error] -> (* TODO: Penalize peer... *) Lwt_canceler.cancel st.canceler >>= fun () -> Lwt.return_unit @@ -150,18 +147,16 @@ module Answerer = struct end -module Log_event = Connection_pool_log_event - type config = { - identity : Identity.t ; + identity : P2p_identity.t ; proof_of_work_target : Crypto_box.target ; - trusted_points : Point.t list ; + trusted_points : P2p_point.Id.t list ; peers_file : string ; closed_network : bool ; - listening_port : port option ; + listening_port : P2p_addr.port option ; min_connections : int ; max_connections : int ; max_incoming_connections : int ; @@ -189,27 +184,27 @@ type 'meta meta_config = { type 'msg message_config = { encoding : 'msg encoding list ; - versions : P2p_types.Version.t list; + versions : P2p_version.t list; } type ('msg, 'meta) t = { config : config ; meta_config : 'meta meta_config ; message_config : 'msg message_config ; - my_id_points : unit Point.Table.t ; + my_id_points : unit P2p_point.Table.t ; known_peer_ids : - (('msg, 'meta) connection, 'meta) Peer_info.t Peer_id.Table.t ; + (('msg, 'meta) connection, 'meta) P2p_peer.Pool_info.t P2p_peer.Table.t ; connected_peer_ids : - (('msg, 'meta) connection, 'meta) Peer_info.t Peer_id.Table.t ; - known_points : ('msg, 'meta) connection Point_info.t Point.Table.t ; - connected_points : ('msg, 'meta) connection Point_info.t Point.Table.t ; - incoming : Lwt_canceler.t Point.Table.t ; + (('msg, 'meta) connection, 'meta) P2p_peer.Pool_info.t P2p_peer.Table.t ; + known_points : ('msg, 'meta) connection P2p_point.Pool_info.t P2p_point.Table.t ; + connected_points : ('msg, 'meta) connection P2p_point.Pool_info.t P2p_point.Table.t ; + incoming : Lwt_canceler.t P2p_point.Table.t ; io_sched : P2p_io_scheduler.t ; encoding : 'msg Message.t Data_encoding.t ; events : events ; - watcher : Log_event.t Lwt_watcher.input ; + watcher : P2p_connection.Pool_event.t Lwt_watcher.input ; mutable new_connection_hook : - (Peer_id.t -> ('msg, 'meta) connection -> unit) list ; + (P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) list ; mutable latest_accepted_swap : Time.t ; mutable latest_succesfull_swap : Time.t ; } @@ -224,11 +219,11 @@ and events = { and ('msg, 'meta) connection = { canceler : Lwt_canceler.t ; messages : (int * 'msg) Lwt_pipe.t ; - conn : 'msg Message.t P2p_connection.t ; - peer_info : (('msg, 'meta) connection, 'meta) Peer_info.t ; - point_info : ('msg, 'meta) connection Point_info.t option ; + conn : 'msg Message.t P2p_socket.t ; + peer_info : (('msg, 'meta) connection, 'meta) P2p_peer.Pool_info.t ; + point_info : ('msg, 'meta) connection P2p_point.Pool_info.t option ; answerer : 'msg Answerer.t Lazy.t ; - mutable last_sent_swap_request : (Time.t * Peer_id.t) option ; + mutable last_sent_swap_request : (Time.t * P2p_peer.Id.t) option ; mutable wait_close : bool ; } @@ -248,8 +243,8 @@ end let watch { watcher } = Lwt_watcher.create_stream watcher let log { watcher } event = Lwt_watcher.notify watcher event -module GcPointSet = List.Bounded(struct - type t = Time.t * Point.t +module Gc_point_set = List.Bounded(struct + type t = Time.t * P2p_point.Id.t let compare (x, _) (y, _) = - (Time.compare x y) end) @@ -258,37 +253,37 @@ let gc_points ({ config = { max_known_points } ; known_points } as pool) = | None -> () | Some (_, target) -> let now = Time.now () in (* TODO: maybe time of discovery? *) - let table = GcPointSet.create target in - Point.Table.iter (fun p point_info -> - if Point_info.State.is_disconnected point_info then + let table = Gc_point_set.create target in + P2p_point.Table.iter (fun p point_info -> + if P2p_point.Pool_state.is_disconnected point_info then let time = - match Point_info.last_miss point_info with + match P2p_point.Pool_info.last_miss point_info with | None -> now | Some t -> t in - GcPointSet.insert (time, p) table + Gc_point_set.insert (time, p) table ) known_points ; - let to_remove = GcPointSet.get table in + let to_remove = Gc_point_set.get table in ListLabels.iter to_remove ~f:begin fun (_, p) -> - Point.Table.remove known_points p + P2p_point.Table.remove known_points p end ; log pool Gc_points let register_point pool ?trusted _source_peer_id (addr, port as point) = - match Point.Table.find pool.known_points point with + match P2p_point.Table.find pool.known_points point with | exception Not_found -> - let point_info = Point_info.create ?trusted addr port in + let point_info = P2p_point.Pool_info.create ?trusted addr port in Option.iter pool.config.max_known_points ~f:begin fun (max, _) -> - if Point.Table.length pool.known_points >= max then gc_points pool + if P2p_point.Table.length pool.known_points >= max then gc_points pool end ; - Point.Table.add pool.known_points point point_info ; + P2p_point.Table.add pool.known_points point point_info ; log pool (New_point point) ; point_info | point_info -> point_info let may_register_my_id_point pool = function - | [P2p_connection.Myself (addr, Some port)] -> - Point.Table.add pool.my_id_points (addr, port) () ; - Point.Table.remove pool.known_points (addr, port) + | [P2p_socket.Myself (addr, Some port)] -> + P2p_point.Table.add pool.my_id_points (addr, port) () ; + P2p_point.Table.remove pool.known_points (addr, port) | _ -> () @@ -299,8 +294,8 @@ let may_register_my_id_point pool = function case of a flood attack, the newly added infos will probably belong to peer_ids with the same (low) score and removing the most recent ones ensure that older (and probably legit) peer_id infos are kept. *) -module GcPeer_idSet = List.Bounded(struct - type t = float * Time.t * Peer_id.t +module Gc_peer_set = List.Bounded(struct + type t = float * Time.t * P2p_peer.Id.t let compare (s, t, _) (s', t', _) = let score_cmp = Pervasives.compare s s' in if score_cmp = 0 then Time.compare t t' else - score_cmp @@ -312,27 +307,27 @@ let gc_peer_ids ({ meta_config = { score } ; match max_known_peer_ids with | None -> () | Some (_, target) -> - let table = GcPeer_idSet.create target in - Peer_id.Table.iter (fun peer_id peer_info -> - let created = Peer_info.created peer_info in - let score = score @@ Peer_info.metadata peer_info in - GcPeer_idSet.insert (score, created, peer_id) table + let table = Gc_peer_set.create target in + P2p_peer.Table.iter (fun peer_id peer_info -> + let created = P2p_peer.Pool_info.created peer_info in + let score = score @@ P2p_peer.Pool_info.metadata peer_info in + Gc_peer_set.insert (score, created, peer_id) table ) known_peer_ids ; - let to_remove = GcPeer_idSet.get table in + let to_remove = Gc_peer_set.get table in ListLabels.iter to_remove ~f:begin fun (_, _, peer_id) -> - Peer_id.Table.remove known_peer_ids peer_id + P2p_peer.Table.remove known_peer_ids peer_id end ; log pool Gc_peer_ids let register_peer pool peer_id = - match Peer_id.Table.find pool.known_peer_ids peer_id with + match P2p_peer.Table.find pool.known_peer_ids peer_id with | exception Not_found -> Lwt_condition.broadcast pool.events.new_peer () ; - let peer = Peer_info.create peer_id ~metadata:pool.meta_config.initial in + let peer = P2p_peer.Pool_info.create peer_id ~metadata:pool.meta_config.initial in Option.iter pool.config.max_known_peer_ids ~f:begin fun (max, _) -> - if Peer_id.Table.length pool.known_peer_ids >= max then gc_peer_ids pool + if P2p_peer.Table.length pool.known_peer_ids >= max then gc_peer_ids pool end ; - Peer_id.Table.add pool.known_peer_ids peer_id peer ; + P2p_peer.Table.add pool.known_peer_ids peer_id peer ; log pool (New_peer peer_id) ; peer | peer -> peer @@ -344,7 +339,7 @@ let read { messages ; conn } = Lwt.catch (fun () -> Lwt_pipe.pop messages >>= fun (s, msg) -> lwt_debug "%d bytes message popped from queue %a\027[0m" - s Connection_info.pp (P2p_connection.info conn) >>= fun () -> + s P2p_connection.Info.pp (P2p_socket.info conn) >>= fun () -> return msg) (fun _ (* Closed *) -> fail P2p_io_scheduler.Connection_closed) @@ -354,111 +349,111 @@ let is_readable { messages } = (fun _ (* Closed *) -> fail P2p_io_scheduler.Connection_closed) let write { conn } msg = - P2p_connection.write conn (Message msg) + P2p_socket.write conn (Message msg) let write_sync { conn } msg = - P2p_connection.write_sync conn (Message msg) + P2p_socket.write_sync conn (Message msg) let raw_write_sync { conn } buf = - P2p_connection.raw_write_sync conn buf + P2p_socket.raw_write_sync conn buf let write_now { conn } msg = - P2p_connection.write_now conn (Message msg) + P2p_socket.write_now conn (Message msg) let write_all pool msg = - Peer_id.Table.iter + P2p_peer.Table.iter (fun _peer_id peer_info -> - match Peer_info.State.get peer_info with + match P2p_peer.Pool_state.get peer_info with | Running { data = conn } -> ignore (write_now conn msg : bool tzresult ) | _ -> ()) pool.connected_peer_ids let broadcast_bootstrap_msg pool = - Peer_id.Table.iter + P2p_peer.Table.iter (fun _peer_id peer_info -> - match Peer_info.State.get peer_info with + match P2p_peer.Pool_state.get peer_info with | Running { data = { conn } } -> - ignore (P2p_connection.write_now conn Bootstrap : bool tzresult ) + ignore (P2p_socket.write_now conn Bootstrap : bool tzresult ) | _ -> ()) pool.connected_peer_ids (***************************************************************************) -module Peer_ids = struct +module Peers = struct - type ('msg, 'meta) info = (('msg, 'meta) connection, 'meta) Peer_info.t + type ('msg, 'meta) info = (('msg, 'meta) connection, 'meta) P2p_peer.Pool_info.t let info { known_peer_ids } point = - try Some (Peer_id.Table.find known_peer_ids point) + try Some (P2p_peer.Table.find known_peer_ids point) with Not_found -> None let get_metadata pool peer_id = - try Peer_info.metadata (Peer_id.Table.find pool.known_peer_ids peer_id) + try P2p_peer.Pool_info.metadata (P2p_peer.Table.find pool.known_peer_ids peer_id) with Not_found -> pool.meta_config.initial let get_score pool peer_id = pool.meta_config.score (get_metadata pool peer_id) let set_metadata pool peer_id data = - Peer_info.set_metadata (register_peer pool peer_id) data + P2p_peer.Pool_info.set_metadata (register_peer pool peer_id) data let get_trusted pool peer_id = - try Peer_info.trusted (Peer_id.Table.find pool.known_peer_ids peer_id) + try P2p_peer.Pool_info.trusted (P2p_peer.Table.find pool.known_peer_ids peer_id) with Not_found -> false let set_trusted pool peer_id = - try Peer_info.set_trusted (register_peer pool peer_id) + try P2p_peer.Pool_info.set_trusted (register_peer pool peer_id) with Not_found -> () let unset_trusted pool peer_id = - try Peer_info.unset_trusted (Peer_id.Table.find pool.known_peer_ids peer_id) + try P2p_peer.Pool_info.unset_trusted (P2p_peer.Table.find pool.known_peer_ids peer_id) with Not_found -> () let fold_known pool ~init ~f = - Peer_id.Table.fold f pool.known_peer_ids init + P2p_peer.Table.fold f pool.known_peer_ids init let fold_connected pool ~init ~f = - Peer_id.Table.fold f pool.connected_peer_ids init + P2p_peer.Table.fold f pool.connected_peer_ids init end module Points = struct - type ('msg, 'meta) info = ('msg, 'meta) connection Point_info.t + type ('msg, 'meta) info = ('msg, 'meta) connection P2p_point.Pool_info.t let info { known_points } point = - try Some (Point.Table.find known_points point) + try Some (P2p_point.Table.find known_points point) with Not_found -> None let get_trusted pool point = - try Point_info.trusted (Point.Table.find pool.known_points point) + try P2p_point.Pool_info.trusted (P2p_point.Table.find pool.known_points point) with Not_found -> false let set_trusted pool point = try - Point_info.set_trusted + P2p_point.Pool_info.set_trusted (register_point pool pool.config.identity.peer_id point) with Not_found -> () let unset_trusted pool peer_id = - try Point_info.unset_trusted (Point.Table.find pool.known_points peer_id) + try P2p_point.Pool_info.unset_trusted (P2p_point.Table.find pool.known_points peer_id) with Not_found -> () let fold_known pool ~init ~f = - Point.Table.fold f pool.known_points init + P2p_point.Table.fold f pool.known_points init let fold_connected pool ~init ~f = - Point.Table.fold f pool.connected_points init + P2p_point.Table.fold f pool.connected_points init end module Connection = struct let fold pool ~init ~f = - Peer_ids.fold_connected pool ~init ~f:begin fun peer_id peer_info acc -> - match Peer_info.State.get peer_info with + Peers.fold_connected pool ~init ~f:begin fun peer_id peer_info acc -> + match P2p_peer.Pool_state.get peer_info with | Running { data } -> f peer_id data acc | _ -> acc end @@ -471,7 +466,7 @@ module Connection = struct fold pool ~init:[] ~f:begin fun _peer conn acc -> match different_than with | Some excluded_conn - when P2p_connection.equal conn.conn excluded_conn.conn -> acc + when P2p_socket.equal conn.conn excluded_conn.conn -> acc | Some _ | None -> conn :: acc end in match candidates with @@ -484,9 +479,9 @@ module Connection = struct fold pool ~init:[] ~f:begin fun _peer conn acc -> match different_than with | Some excluded_conn - when P2p_connection.equal conn.conn excluded_conn.conn -> acc + when P2p_socket.equal conn.conn excluded_conn.conn -> acc | Some _ | None -> - let ci = P2p_connection.info conn.conn in + let ci = P2p_socket.info conn.conn in match ci.id_point with | _, None -> acc | addr, Some port -> ((addr, port), ci.peer_id, conn) :: acc @@ -497,18 +492,18 @@ module Connection = struct Some (List.nth candidates (Random.int @@ List.length candidates)) let stat { conn } = - P2p_connection.stat conn + P2p_socket.stat conn let score { meta_config = { score }} meta = score meta let info { conn } = - P2p_connection.info conn + P2p_socket.info conn let find_by_peer_id pool peer_id = Option.apply - (Peer_ids.info pool peer_id) + (Peers.info pool peer_id) ~f:(fun p -> - match Peer_info.State.get p with + match P2p_peer.Pool_state.get p with | Running { data } -> Some data | _ -> None) @@ -516,7 +511,7 @@ module Connection = struct Option.apply (Points.info pool point) ~f:(fun p -> - match Point_info.State.get p with + match P2p_point.Pool_state.get p with | Running { data } -> Some data | _ -> None) @@ -528,7 +523,7 @@ let pool_stat { io_sched } = (***************************************************************************) -type error += Rejected of Peer_id.t +type error += Rejected of P2p_peer.Id.t type error += Pending_connection type error += Connected type error += Connection_closed = P2p_io_scheduler.Connection_closed @@ -537,13 +532,13 @@ type error += Closed_network type error += Too_many_connections let fail_unless_disconnected_point point_info = - match Point_info.State.get point_info with + match P2p_point.Pool_state.get point_info with | Disconnected -> return () | Requested _ | Accepted _ -> fail Pending_connection | Running _ -> fail Connected let fail_unless_disconnected_peer_id peer_info = - match Peer_info.State.get peer_info with + match P2p_peer.Pool_state.get peer_info with | Disconnected -> return () | Accepted _ -> fail Pending_connection | Running _ -> fail Connected @@ -551,10 +546,10 @@ let fail_unless_disconnected_peer_id peer_info = let compare_known_point_info p1 p2 = (* The most-recently disconnected peers are greater. *) (* Then come long-standing connected peers. *) - let disconnected1 = Point_info.State.is_disconnected p1 - and disconnected2 = Point_info.State.is_disconnected p2 in + let disconnected1 = P2p_point.Pool_state.is_disconnected p1 + and disconnected2 = P2p_point.Pool_state.is_disconnected p2 in let compare_last_seen p1 p2 = - match Point_info.last_seen p1, Point_info.last_seen p2 with + match P2p_point.Pool_info.last_seen p1, P2p_point.Pool_info.last_seen p2 with | None, None -> Random.int 2 * 2 - 1 (* HACK... *) | Some _, None -> 1 | None, Some _ -> -1 @@ -576,40 +571,40 @@ let rec connect ~timeout pool point = Lwt_utils.with_timeout ~canceler timeout begin fun canceler -> let point_info = register_point pool pool.config.identity.peer_id point in - let addr, port as point = Point_info.point point_info in + let addr, port as point = P2p_point.Pool_info.point point_info in fail_unless - (not pool.config.closed_network || Point_info.trusted point_info) + (not pool.config.closed_network || P2p_point.Pool_info.trusted point_info) Closed_network >>=? fun () -> fail_unless_disconnected_point point_info >>=? fun () -> - Point_info.State.set_requested point_info canceler ; + P2p_point.Pool_state.set_requested point_info canceler ; let fd = Lwt_unix.socket PF_INET6 SOCK_STREAM 0 in let uaddr = Lwt_unix.ADDR_INET (Ipaddr_unix.V6.to_inet_addr addr, port) in - lwt_debug "connect: %a" Point.pp point >>= fun () -> + lwt_debug "connect: %a" P2p_point.Id.pp point >>= fun () -> Lwt_utils.protect ~canceler begin fun () -> log pool (Outgoing_connection point) ; Lwt_unix.connect fd uaddr >>= fun () -> return () end ~on_error: begin fun err -> - lwt_debug "connect: %a -> disconnect" Point.pp point >>= fun () -> - Point_info.State.set_disconnected point_info ; + lwt_debug "connect: %a -> disconnect" P2p_point.Id.pp point >>= fun () -> + P2p_point.Pool_state.set_disconnected point_info ; Lwt_utils.safe_close fd >>= fun () -> match err with | [Exn (Unix.Unix_error (Unix.ECONNREFUSED, _, _))] -> fail Connection_refused | err -> Lwt.return (Error err) end >>=? fun () -> - lwt_debug "connect: %a -> authenticate" Point.pp point >>= fun () -> + lwt_debug "connect: %a -> authenticate" P2p_point.Id.pp point >>= fun () -> authenticate pool ~point_info canceler fd point end and authenticate pool ?point_info canceler fd point = let incoming = point_info = None in lwt_debug "authenticate: %a%s" - Point.pp point + P2p_point.Id.pp point (if incoming then " incoming" else "") >>= fun () -> Lwt_utils.protect ~canceler begin fun () -> - P2p_connection.authenticate + P2p_socket.authenticate ~proof_of_work_target:pool.config.proof_of_work_target ~incoming (P2p_io_scheduler.register pool.io_sched fd) point ?listening_port:pool.config.listening_port @@ -620,31 +615,31 @@ and authenticate pool ?point_info canceler fd point = | [ Lwt_utils.Canceled ] -> (* Currently only on time out *) lwt_debug "authenticate: %a%s -> canceled" - Point.pp point + P2p_point.Id.pp point (if incoming then " incoming" else "") | err -> (* Authentication incorrect! *) lwt_debug "@[authenticate: %a%s -> failed@ %a@]" - Point.pp point + P2p_point.Id.pp point (if incoming then " incoming" else "") pp_print_error err end >>= fun () -> may_register_my_id_point pool err ; log pool (Authentication_failed point) ; if incoming then - Point.Table.remove pool.incoming point + P2p_point.Table.remove pool.incoming point else - Option.iter ~f:Point_info.State.set_disconnected point_info ; + Option.iter ~f:P2p_point.Pool_state.set_disconnected point_info ; Lwt.return (Error err) end >>=? fun (info, auth_fd) -> (* Authentication correct! *) lwt_debug "authenticate: %a -> auth %a" - Point.pp point - Connection_info.pp info >>= fun () -> + P2p_point.Id.pp point + P2p_connection.Info.pp info >>= fun () -> let remote_point_info = match info.id_point with | addr, Some port - when not (Point.Table.mem pool.my_id_points (addr, port)) -> + when not (P2p_point.Table.mem pool.my_id_points (addr, port)) -> Some (register_point pool info.peer_id (addr, port)) | _ -> None in let connection_point_info = @@ -653,22 +648,22 @@ and authenticate pool ?point_info canceler fd point = | Some _ as point_info, _ | _, (Some _ as point_info) -> point_info in let peer_info = register_peer pool info.peer_id in let acceptable_versions = - Version.common info.versions pool.message_config.versions + P2p_version.common info.versions pool.message_config.versions in let acceptable_point = Option.unopt_map connection_point_info ~default:(not pool.config.closed_network) ~f:begin fun connection_point_info -> - match Point_info.State.get connection_point_info with + match P2p_point.Pool_state.get connection_point_info with | Requested _ -> not incoming | Disconnected -> not pool.config.closed_network - || Point_info.trusted connection_point_info + || P2p_point.Pool_info.trusted connection_point_info | Accepted _ | Running _ -> false end in let acceptable_peer_id = - match Peer_info.State.get peer_info with + match P2p_peer.Pool_state.get peer_info with | Accepted _ -> (* TODO: in some circumstances cancel and accept... *) false @@ -676,41 +671,41 @@ and authenticate pool ?point_info canceler fd point = | Disconnected -> true in if incoming then - Point.Table.remove pool.incoming point ; + P2p_point.Table.remove pool.incoming point ; match acceptable_versions with | Some version when acceptable_peer_id && acceptable_point -> begin log pool (Accepting_request (point, info.id_point, info.peer_id)) ; Option.iter connection_point_info ~f:(fun point_info -> - Point_info.State.set_accepted point_info info.peer_id canceler) ; - Peer_info.State.set_accepted peer_info info.id_point canceler ; + P2p_point.Pool_state.set_accepted point_info info.peer_id canceler) ; + P2p_peer.Pool_state.set_accepted peer_info info.id_point canceler ; lwt_debug "authenticate: %a -> accept %a" - Point.pp point - Connection_info.pp info >>= fun () -> + P2p_point.Id.pp point + P2p_connection.Info.pp info >>= fun () -> Lwt_utils.protect ~canceler begin fun () -> - P2p_connection.accept + P2p_socket.accept ?incoming_message_queue_size:pool.config.incoming_message_queue_size ?outgoing_message_queue_size:pool.config.outgoing_message_queue_size ?binary_chunks_size:pool.config.binary_chunks_size auth_fd pool.encoding >>= fun conn -> lwt_debug "authenticate: %a -> Connected %a" - Point.pp point - Connection_info.pp info >>= fun () -> + P2p_point.Id.pp point + P2p_connection.Info.pp info >>= fun () -> Lwt.return conn end ~on_error: begin fun err -> if incoming then log pool (Request_rejected (point, Some (info.id_point, info.peer_id))) ; lwt_debug "authenticate: %a -> rejected %a" - Point.pp point - Connection_info.pp info >>= fun () -> + P2p_point.Id.pp point + P2p_connection.Info.pp info >>= fun () -> Option.iter connection_point_info - ~f:Point_info.State.set_disconnected ; - Peer_info.State.set_disconnected peer_info ; + ~f:P2p_point.Pool_state.set_disconnected ; + P2p_peer.Pool_state.set_disconnected peer_info ; Lwt.return (Error err) end >>=? fun conn -> let id_point = - match info.id_point, Option.map ~f:Point_info.point point_info with + match info.id_point, Option.map ~f:P2p_point.Pool_info.point point_info with | (addr, _), Some (_, port) -> addr, Some port | id_point, None -> id_point in return @@ -721,19 +716,19 @@ and authenticate pool ?point_info canceler fd point = | _ -> begin log pool (Rejecting_request (point, info.id_point, info.peer_id)) ; lwt_debug "authenticate: %a -> kick %a point: %B peer_id: %B" - Point.pp point - Connection_info.pp info + P2p_point.Id.pp point + P2p_connection.Info.pp info acceptable_point acceptable_peer_id >>= fun () -> - P2p_connection.kick auth_fd >>= fun () -> + P2p_socket.kick auth_fd >>= fun () -> if not incoming then begin - Option.iter ~f:Point_info.State.set_disconnected point_info ; - (* FIXME Peer_info.State.set_disconnected ~requested:true peer_info ; *) + Option.iter ~f:P2p_point.Pool_state.set_disconnected point_info ; + (* FIXME P2p_peer.Pool_state.set_disconnected ~requested:true peer_info ; *) end ; fail (Rejected info.peer_id) end and create_connection pool p2p_conn id_point point_info peer_info _version = - let peer_id = Peer_info.peer_id peer_info in + let peer_id = P2p_peer.Pool_info.peer_id peer_info in let canceler = Lwt_canceler.create () in let size = Option.map pool.config.incoming_app_message_queue_size @@ -759,30 +754,30 @@ and create_connection pool p2p_conn id_point point_info peer_info _version = last_sent_swap_request = None } in ignore (Lazy.force answerer) ; Option.iter point_info ~f:begin fun point_info -> - let point = Point_info.point point_info in - Point_info.State.set_running point_info peer_id conn ; - Point.Table.add pool.connected_points point point_info ; + let point = P2p_point.Pool_info.point point_info in + P2p_point.Pool_state.set_running point_info peer_id conn ; + P2p_point.Table.add pool.connected_points point point_info ; end ; log pool (Connection_established (id_point, peer_id)) ; - Peer_info.State.set_running peer_info id_point conn ; - Peer_id.Table.add pool.connected_peer_ids peer_id peer_info ; + P2p_peer.Pool_state.set_running peer_info id_point conn ; + P2p_peer.Table.add pool.connected_peer_ids peer_id peer_info ; Lwt_condition.broadcast pool.events.new_connection () ; Lwt_canceler.on_cancel canceler begin fun () -> lwt_debug "Disconnect: %a (%a)" - Peer_id.pp peer_id Id_point.pp id_point >>= fun () -> - Option.iter ~f:Point_info.State.set_disconnected point_info ; + P2p_peer.Id.pp peer_id P2p_connection.Id.pp id_point >>= fun () -> + Option.iter ~f:P2p_point.Pool_state.set_disconnected point_info ; log pool (Disconnection peer_id) ; - Peer_info.State.set_disconnected peer_info ; + P2p_peer.Pool_state.set_disconnected peer_info ; Option.iter point_info ~f:begin fun point_info -> - Point.Table.remove pool.connected_points (Point_info.point point_info) ; + P2p_point.Table.remove pool.connected_points (P2p_point.Pool_info.point point_info) ; end ; - Peer_id.Table.remove pool.connected_peer_ids peer_id ; + P2p_peer.Table.remove pool.connected_peer_ids peer_id ; if pool.config.max_connections <= active_connections pool then begin Lwt_condition.broadcast pool.events.too_many_connections () ; log pool Too_many_connections ; end ; Lwt_pipe.close messages ; - P2p_connection.close ~wait:conn.wait_close conn.conn + P2p_socket.close ~wait:conn.wait_close conn.conn end ; List.iter (fun f -> f peer_id conn) pool.new_connection_hook ; if active_connections pool < pool.config.min_connections then begin @@ -796,31 +791,31 @@ and disconnect ?(wait = false) conn = Answerer.shutdown (Lazy.force conn.answerer) and register_new_points pool conn = - let source_peer_id = Peer_info.peer_id conn.peer_info in + let source_peer_id = P2p_peer.Pool_info.peer_id conn.peer_info in fun points -> List.iter (register_new_point pool source_peer_id) points ; Lwt.return_unit and register_new_point pool _source_peer_id point = - if not (Point.Table.mem pool.my_id_points point) then + if not (P2p_point.Table.mem pool.my_id_points point) then ignore (register_point pool _source_peer_id point) and list_known_points pool _conn () = let knowns = - Point.Table.fold + P2p_point.Table.fold (fun _ point_info acc -> point_info :: acc) pool.known_points [] in let best_knowns = List.take_n ~compare:compare_known_point_info 50 knowns in - Lwt.return (List.map Point_info.point best_knowns) + Lwt.return (List.map P2p_point.Pool_info.point best_knowns) -and active_connections pool = Peer_id.Table.length pool.connected_peer_ids +and active_connections pool = P2p_peer.Table.length pool.connected_peer_ids and swap_request pool conn new_point _new_peer_id = - let source_peer_id = Peer_info.peer_id conn.peer_info in + let source_peer_id = P2p_peer.Pool_info.peer_id conn.peer_info in log pool (Swap_request_received { source = source_peer_id }) ; lwt_log_info - "Swap request received from %a" Peer_id.pp source_peer_id >>= fun () -> + "Swap request received from %a" P2p_peer.Id.pp source_peer_id >>= fun () -> (* Ignore if already connected to peer or already swapped less than seconds ago. *) let now = Time.now () in @@ -830,16 +825,16 @@ and swap_request pool conn new_point _new_peer_id = (Time.max pool.latest_succesfull_swap pool.latest_accepted_swap) in let new_point_info = register_point pool source_peer_id new_point in if span_since_last_swap < int_of_float pool.config.swap_linger - || not (Point_info.State.is_disconnected new_point_info) then begin + || not (P2p_point.Pool_state.is_disconnected new_point_info) then begin log pool (Swap_request_ignored { source = source_peer_id }) ; - lwt_log_info "Ignoring swap request from %a" Peer_id.pp source_peer_id + lwt_log_info "Ignoring swap request from %a" P2p_peer.Id.pp source_peer_id end else begin match Connection.random_lowid pool with | None -> lwt_log_info - "No swap candidate for %a" Peer_id.pp source_peer_id + "No swap candidate for %a" P2p_peer.Id.pp source_peer_id | Some (proposed_point, proposed_peer_id, _proposed_conn) -> - match P2p_connection.write_now + match P2p_socket.write_now conn.conn (Swap_ack (proposed_point, proposed_peer_id)) with | Ok true -> log pool (Swap_ack_sent { source = source_peer_id }) ; @@ -854,10 +849,10 @@ and swap_request pool conn new_point _new_peer_id = end and swap_ack pool conn new_point _new_peer_id = - let source_peer_id = Peer_info.peer_id conn.peer_info in + let source_peer_id = P2p_peer.Pool_info.peer_id conn.peer_info in log pool (Swap_ack_received { source = source_peer_id }) ; lwt_log_info - "Swap ack received from %a" Peer_id.pp source_peer_id >>= fun () -> + "Swap ack received from %a" P2p_peer.Id.pp source_peer_id >>= fun () -> match conn.last_sent_swap_request with | None -> Lwt.return_unit (* ignore *) | Some (_time, proposed_peer_id) -> @@ -869,13 +864,13 @@ and swap_ack pool conn new_point _new_peer_id = Lwt.return_unit and swap pool conn current_peer_id new_point = - let source_peer_id = Peer_info.peer_id conn.peer_info in + let source_peer_id = P2p_peer.Pool_info.peer_id conn.peer_info in pool.latest_accepted_swap <- Time.now () ; connect ~timeout:10. pool new_point >>= function | Ok _new_conn -> begin pool.latest_succesfull_swap <- Time.now () ; log pool (Swap_success { source = source_peer_id }) ; - lwt_log_info "Swap to %a succeeded" Point.pp new_point >>= fun () -> + lwt_log_info "Swap to %a succeeded" P2p_point.Id.pp new_point >>= fun () -> match Connection.find_by_peer_id pool current_peer_id with | None -> Lwt.return_unit | Some conn -> @@ -888,20 +883,20 @@ and swap pool conn current_peer_id new_point = match err with | [ Lwt_utils.Timeout ] -> lwt_debug "Swap to %a was interupted: %a" - Point.pp new_point pp_print_error err + P2p_point.Id.pp new_point pp_print_error err | _ -> lwt_log_error "Swap to %a failed: %a" - Point.pp new_point pp_print_error err + P2p_point.Id.pp new_point pp_print_error err end let accept pool fd point = log pool (Incoming_connection point) ; - if pool.config.max_incoming_connections <= Point.Table.length pool.incoming + if pool.config.max_incoming_connections <= P2p_point.Table.length pool.incoming || pool.config.max_connections <= active_connections pool then Lwt.async (fun () -> Lwt_utils.safe_close fd) else let canceler = Lwt_canceler.create () in - Point.Table.add pool.incoming point canceler ; + P2p_point.Table.add pool.incoming point canceler ; Lwt.async begin fun () -> Lwt_utils.with_timeout ~canceler pool.config.authentification_timeout @@ -919,7 +914,7 @@ let send_swap_request pool = log pool (Swap_request_sent { source = recipient_peer_id }) ; recipient.last_sent_swap_request <- Some (Time.now (), proposed_peer_id) ; - ignore (P2p_connection.write_now recipient.conn + ignore (P2p_socket.write_now recipient.conn (Swap_request (proposed_point, proposed_peer_id))) (***************************************************************************) @@ -933,12 +928,12 @@ let create config meta_config message_config io_sched = } in let pool = { config ; meta_config ; message_config ; - my_id_points = Point.Table.create 7 ; - known_peer_ids = Peer_id.Table.create 53 ; - connected_peer_ids = Peer_id.Table.create 53 ; - known_points = Point.Table.create 53 ; - connected_points = Point.Table.create 53 ; - incoming = Point.Table.create 53 ; + my_id_points = P2p_point.Table.create 7 ; + known_peer_ids = P2p_peer.Table.create 53 ; + connected_peer_ids = P2p_peer.Table.create 53 ; + known_points = P2p_point.Table.create 53 ; + connected_points = P2p_point.Table.create 53 ; + incoming = P2p_point.Table.create 53 ; io_sched ; encoding = Message.encoding message_config.encoding ; events ; @@ -948,12 +943,12 @@ let create config meta_config message_config io_sched = latest_succesfull_swap = Time.epoch ; } in List.iter (Points.set_trusted pool) config.trusted_points ; - Peer_info.File.load config.peers_file meta_config.encoding >>= function + P2p_peer.Pool_info.File.load config.peers_file meta_config.encoding >>= function | Ok peer_ids -> List.iter (fun peer_info -> - let peer_id = Peer_info.peer_id peer_info in - Peer_id.Table.add pool.known_peer_ids peer_id peer_info) + let peer_id = P2p_peer.Pool_info.peer_id peer_info in + P2p_peer.Table.add pool.known_peer_ids peer_id peer_info) peer_ids ; Lwt.return pool | Error err -> @@ -962,23 +957,23 @@ let create config meta_config message_config io_sched = Lwt.return pool let destroy pool = - Point.Table.fold (fun _point point_info acc -> - match Point_info.State.get point_info with + P2p_point.Table.fold (fun _point point_info acc -> + match P2p_point.Pool_state.get point_info with | Requested { cancel } | Accepted { cancel } -> Lwt_canceler.cancel cancel >>= fun () -> acc | Running { data = conn } -> disconnect conn >>= fun () -> acc | Disconnected -> acc) pool.known_points @@ - Peer_id.Table.fold (fun _peer_id peer_info acc -> - match Peer_info.State.get peer_info with + P2p_peer.Table.fold (fun _peer_id peer_info acc -> + match P2p_peer.Pool_state.get peer_info with | Accepted { cancel } -> Lwt_canceler.cancel cancel >>= fun () -> acc | Running { data = conn } -> disconnect conn >>= fun () -> acc | Disconnected -> acc) pool.known_peer_ids @@ - Point.Table.fold (fun _point canceler acc -> + P2p_point.Table.fold (fun _point canceler acc -> Lwt_canceler.cancel canceler >>= fun () -> acc) pool.incoming Lwt.return_unit diff --git a/src/lib_p2p/p2p_connection_pool.mli b/src/lib_p2p/p2p_pool.mli similarity index 81% rename from src/lib_p2p/p2p_connection_pool.mli rename to src/lib_p2p/p2p_pool.mli index e24084763..2f33715e5 100644 --- a/src/lib_p2p/p2p_connection_pool.mli +++ b/src/lib_p2p/p2p_pool.mli @@ -22,9 +22,6 @@ worker and thus never propagated above. *) -open P2p_types -open P2p_connection_pool_types - type 'msg encoding = Encoding : { tag: int ; encoding: 'a Data_encoding.t ; @@ -43,13 +40,13 @@ type ('msg, 'meta) pool = ('msg, 'meta) t type config = { - identity : Identity.t ; + identity : P2p_identity.t ; (** Our identity. *) proof_of_work_target : Crypto_box.target ; (** The proof of work target we require from peers. *) - trusted_points : Point.t list ; + trusted_points : P2p_point.Id.t list ; (** List of hard-coded known peers to bootstrap the network from. *) peers_file : string ; @@ -60,7 +57,7 @@ type config = { (** If [true], the only accepted connections are from peers whose addresses are in [trusted_peers]. *) - listening_port : port option ; + listening_port : P2p_addr.port option ; (** If provided, it will be passed to [P2p_connection.authenticate] when we authenticate against a new peer. *) @@ -126,7 +123,7 @@ type 'meta meta_config = { type 'msg message_config = { encoding : 'msg encoding list ; - versions : P2p_types.Version.t list; + versions : P2p_version.t list; } val create: @@ -146,7 +143,7 @@ val active_connections: ('msg, 'meta) pool -> int (** [active_connections pool] is the number of connections inside [pool]. *) -val pool_stat: ('msg, 'meta) pool -> Stat.t +val pool_stat: ('msg, 'meta) pool -> P2p_stat.t (** [pool_stat pool] is a snapshot of current bandwidth usage for the entire [pool]. *) @@ -186,19 +183,19 @@ type ('msg, 'meta) connection type error += Pending_connection type error += Connected type error += Connection_refused -type error += Rejected of Peer_id.t +type error += Rejected of P2p_peer.Id.t type error += Too_many_connections type error += Closed_network val connect: timeout:float -> - ('msg, 'meta) pool -> Point.t -> + ('msg, 'meta) pool -> P2p_point.Id.t -> ('msg, 'meta) connection tzresult Lwt.t (** [connect ~timeout pool point] tries to add a connection to [point] in [pool] in less than [timeout] seconds. *) val accept: - ('msg, 'meta) pool -> Lwt_unix.file_descr -> Point.t -> unit + ('msg, 'meta) pool -> Lwt_unix.file_descr -> P2p_point.Id.t -> unit (** [accept pool fd point] instructs [pool] to start the process of accepting a connection from [fd]. Used by [P2p]. *) @@ -209,32 +206,32 @@ val disconnect: module Connection : sig - val info: ('msg, 'meta) connection -> Connection_info.t + val info: ('msg, 'meta) connection -> P2p_connection.Info.t - val stat: ('msg, 'meta) connection -> Stat.t + val stat: ('msg, 'meta) connection -> P2p_stat.t (** [stat conn] is a snapshot of current bandwidth usage for [conn]. *) val fold: ('msg, 'meta) pool -> init:'a -> - f:(Peer_id.t -> ('msg, 'meta) connection -> 'a -> 'a) -> + f:(P2p_peer.Id.t -> ('msg, 'meta) connection -> 'a -> 'a) -> 'a val list: - ('msg, 'meta) pool -> (Peer_id.t * ('msg, 'meta) connection) list + ('msg, 'meta) pool -> (P2p_peer.Id.t * ('msg, 'meta) connection) list val find_by_point: - ('msg, 'meta) pool -> Point.t -> ('msg, 'meta) connection option + ('msg, 'meta) pool -> P2p_point.Id.t -> ('msg, 'meta) connection option val find_by_peer_id: - ('msg, 'meta) pool -> Peer_id.t -> ('msg, 'meta) connection option + ('msg, 'meta) pool -> P2p_peer.Id.t -> ('msg, 'meta) connection option end val on_new_connection: ('msg, 'meta) pool -> - (Peer_id.t -> ('msg, 'meta) connection -> unit) -> unit + (P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) -> unit (** {1 I/O on connections} *) @@ -277,31 +274,31 @@ val broadcast_bootstrap_msg: ('msg, 'meta) pool -> unit (** {1 Functions on [Peer_id]} *) -module Peer_ids : sig +module Peers : sig - type ('msg, 'meta) info = (('msg, 'meta) connection, 'meta) Peer_info.t + type ('msg, 'meta) info = (('msg, 'meta) connection, 'meta) P2p_peer.Pool_info.t val info: - ('msg, 'meta) pool -> Peer_id.t -> ('msg, 'meta) info option + ('msg, 'meta) pool -> P2p_peer.Id.t -> ('msg, 'meta) info option - val get_metadata: ('msg, 'meta) pool -> Peer_id.t -> 'meta - val set_metadata: ('msg, 'meta) pool -> Peer_id.t -> 'meta -> unit - val get_score: ('msg, 'meta) pool -> Peer_id.t -> float + val get_metadata: ('msg, 'meta) pool -> P2p_peer.Id.t -> 'meta + val set_metadata: ('msg, 'meta) pool -> P2p_peer.Id.t -> 'meta -> unit + val get_score: ('msg, 'meta) pool -> P2p_peer.Id.t -> float - val get_trusted: ('msg, 'meta) pool -> Peer_id.t -> bool - val set_trusted: ('msg, 'meta) pool -> Peer_id.t -> unit - val unset_trusted: ('msg, 'meta) pool -> Peer_id.t -> unit + val get_trusted: ('msg, 'meta) pool -> P2p_peer.Id.t -> bool + val set_trusted: ('msg, 'meta) pool -> P2p_peer.Id.t -> unit + val unset_trusted: ('msg, 'meta) pool -> P2p_peer.Id.t -> unit val fold_known: ('msg, 'meta) pool -> init:'a -> - f:(Peer_id.t -> ('msg, 'meta) info -> 'a -> 'a) -> + f:(P2p_peer.Id.t -> ('msg, 'meta) info -> 'a -> 'a) -> 'a val fold_connected: ('msg, 'meta) pool -> init:'a -> - f:(Peer_id.t -> ('msg, 'meta) info -> 'a -> 'a) -> + f:(P2p_peer.Id.t -> ('msg, 'meta) info -> 'a -> 'a) -> 'a end @@ -310,32 +307,30 @@ end module Points : sig - type ('msg, 'meta) info = ('msg, 'meta) connection Point_info.t + type ('msg, 'meta) info = ('msg, 'meta) connection P2p_point.Pool_info.t val info: - ('msg, 'meta) pool -> Point.t -> ('msg, 'meta) info option + ('msg, 'meta) pool -> P2p_point.Id.t -> ('msg, 'meta) info option - val get_trusted: ('msg, 'meta) pool -> Point.t -> bool - val set_trusted: ('msg, 'meta) pool -> Point.t -> unit - val unset_trusted: ('msg, 'meta) pool -> Point.t -> unit + val get_trusted: ('msg, 'meta) pool -> P2p_point.Id.t -> bool + val set_trusted: ('msg, 'meta) pool -> P2p_point.Id.t -> unit + val unset_trusted: ('msg, 'meta) pool -> P2p_point.Id.t -> unit val fold_known: ('msg, 'meta) pool -> init:'a -> - f:(Point.t -> ('msg, 'meta) info -> 'a -> 'a) -> + f:(P2p_point.Id.t -> ('msg, 'meta) info -> 'a -> 'a) -> 'a val fold_connected: ('msg, 'meta) pool -> init:'a -> - f:(Point.t -> ('msg, 'meta) info -> 'a -> 'a) -> + f:(P2p_point.Id.t -> ('msg, 'meta) info -> 'a -> 'a) -> 'a end -module Log_event = Connection_pool_log_event - -val watch: ('msg, 'meta) pool -> Log_event.t Lwt_stream.t * Lwt_watcher.stopper +val watch: ('msg, 'meta) pool -> P2p_connection.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper (** [watch pool] is a [stream, close] a [stream] of events and a [close] function for this stream. *) @@ -345,9 +340,9 @@ module Message : sig type 'msg t = | Bootstrap - | Advertise of Point.t list - | Swap_request of Point.t * Peer_id.t - | Swap_ack of Point.t * Peer_id.t + | Advertise of P2p_point.Id.t list + | Swap_request of P2p_point.Id.t * P2p_peer.Id.t + | Swap_ack of P2p_point.Id.t * P2p_peer.Id.t | Message of 'msg | Disconnect diff --git a/src/lib_p2p/p2p_connection.ml b/src/lib_p2p/p2p_socket.ml similarity index 92% rename from src/lib_p2p/p2p_connection.ml rename to src/lib_p2p/p2p_socket.ml index 08b315ecb..202d94739 100644 --- a/src/lib_p2p/p2p_connection.ml +++ b/src/lib_p2p/p2p_socket.ml @@ -19,8 +19,6 @@ infinitly. This would avoid the real peer to talk with us. And this might also have an influence on its "score". *) -open P2p_types - include Logging.Make(struct let name = "p2p.connection" end) type error += Decipher_error @@ -28,8 +26,8 @@ type error += Invalid_message_size type error += Encoding_error type error += Rejected type error += Decoding_error -type error += Myself of Id_point.t -type error += Not_enough_proof_of_work of Peer_id.t +type error += Myself of P2p_connection.Id.t +type error += Not_enough_proof_of_work of P2p_peer.Id.t type error += Invalid_auth type error += Invalid_chunks_size of { value: int ; min: int ; max: int } @@ -94,7 +92,7 @@ module Connection_message = struct type t = { port : int option ; - versions : Version.t list ; + versions : P2p_version.t list ; public_key : Crypto_box.public_key ; proof_of_work_stamp : Crypto_box.nonce ; message_nonce : Crypto_box.nonce ; @@ -118,7 +116,7 @@ module Connection_message = struct (req "pubkey" Crypto_box.public_key_encoding) (req "proof_of_work_stamp" Crypto_box.nonce_encoding) (req "message_nonce" Crypto_box.nonce_encoding) - (req "versions" (Variable.list Version.encoding))) + (req "versions" (Variable.list P2p_version.encoding))) let write fd message = let encoded_message_len = @@ -172,7 +170,7 @@ module Ack = struct end type authenticated_fd = - P2p_io_scheduler.connection * Connection_info.t * Crypto.data + P2p_io_scheduler.connection * P2p_connection.Info.t * Crypto.data let kick (fd, _ , cryptobox_data) = Ack.write fd cryptobox_data Nack >>= fun _ -> @@ -187,9 +185,9 @@ let authenticate ~incoming fd (remote_addr, remote_socket_port as point) ?listening_port identity supported_versions = let local_nonce = Crypto_box.random_nonce () in - lwt_debug "Sending authenfication to %a" Point.pp point >>= fun () -> + lwt_debug "Sending authenfication to %a" P2p_point.Id.pp point >>= fun () -> Connection_message.write fd - { public_key = identity.Identity.public_key ; + { public_key = identity.P2p_identity.public_key ; proof_of_work_stamp = identity.proof_of_work_stamp ; message_nonce = local_nonce ; port = listening_port ; @@ -200,16 +198,16 @@ let authenticate let id_point = remote_addr, remote_listening_port in let remote_peer_id = Crypto_box.hash msg.public_key in fail_unless - (remote_peer_id <> identity.Identity.peer_id) + (remote_peer_id <> identity.P2p_identity.peer_id) (Myself id_point) >>=? fun () -> fail_unless (Crypto_box.check_proof_of_work msg.public_key msg.proof_of_work_stamp proof_of_work_target) (Not_enough_proof_of_work remote_peer_id) >>=? fun () -> let channel_key = - Crypto_box.precompute identity.Identity.secret_key msg.public_key in + Crypto_box.precompute identity.P2p_identity.secret_key msg.public_key in let info = - { Connection_info.peer_id = remote_peer_id ; + { P2p_connection.Info.peer_id = remote_peer_id ; versions = msg.versions ; incoming ; id_point ; remote_socket_port ;} in let cryptobox_data = @@ -219,7 +217,7 @@ let authenticate type connection = { id : int ; - info : Connection_info.t ; + info : P2p_connection.Info.t ; fd : P2p_io_scheduler.connection ; cryptobox_data : Crypto.data ; } @@ -254,7 +252,7 @@ module Reader = struct end >>=? fun buf -> lwt_debug "reading %d bytes from %a" - (MBytes.length buf) Connection_info.pp st.conn.info >>= fun () -> + (MBytes.length buf) P2p_connection.Info.pp st.conn.info >>= fun () -> loop (decode_next_buf buf) in loop (Data_encoding.Binary.read_stream_of_bytes ~init:init_mbytes st.encoding) @@ -282,7 +280,7 @@ module Reader = struct Lwt.return_unit | Error [Lwt_utils.Canceled | Exn Lwt_pipe.Closed] -> lwt_debug "connection closed to %a" - Connection_info.pp st.conn.info >>= fun () -> + P2p_connection.Info.pp st.conn.info >>= fun () -> Lwt.return_unit | Error _ as err -> Lwt_pipe.safe_push_now st.messages err ; @@ -335,7 +333,7 @@ module Writer = struct Crypto.write_chunk st.conn.fd st.conn.cryptobox_data buf end >>=? fun () -> lwt_debug "writing %d bytes to %a" - (MBytes.length buf) Connection_info.pp st.conn.info >>= fun () -> + (MBytes.length buf) P2p_connection.Info.pp st.conn.info >>= fun () -> loop l in loop buf @@ -350,12 +348,12 @@ module Writer = struct end >>= function | Error [Lwt_utils.Canceled | Exn Lwt_pipe.Closed] -> lwt_debug "connection closed to %a" - Connection_info.pp st.conn.info >>= fun () -> + P2p_connection.Info.pp st.conn.info >>= fun () -> Lwt.return_unit | Error err -> lwt_log_error "@[error writing to %a@ %a@]" - Connection_info.pp st.conn.info pp_print_error err >>= fun () -> + P2p_connection.Info.pp st.conn.info pp_print_error err >>= fun () -> Lwt_canceler.cancel st.canceler >>= fun () -> Lwt.return_unit | Ok (buf, wakener) -> @@ -372,17 +370,17 @@ module Writer = struct match err with | [ Lwt_utils.Canceled | Exn Lwt_pipe.Closed ] -> lwt_debug "connection closed to %a" - Connection_info.pp st.conn.info >>= fun () -> + P2p_connection.Info.pp st.conn.info >>= fun () -> Lwt.return_unit | [ P2p_io_scheduler.Connection_closed ] -> lwt_debug "connection closed to %a" - Connection_info.pp st.conn.info >>= fun () -> + P2p_connection.Info.pp st.conn.info >>= fun () -> Lwt_canceler.cancel st.canceler >>= fun () -> Lwt.return_unit | err -> lwt_log_error "@[error writing to %a@ %a@]" - Connection_info.pp st.conn.info + P2p_connection.Info.pp st.conn.info pp_print_error err >>= fun () -> Lwt_canceler.cancel st.canceler >>= fun () -> Lwt.return_unit @@ -447,7 +445,7 @@ type 'msg t = { let equal { conn = { id = id1 } } { conn = { id = id2 } } = id1 = id2 -let pp ppf { conn } = Connection_info.pp ppf conn.info +let pp ppf { conn } = P2p_connection.Info.pp ppf conn.info let info { conn } = conn.info let accept @@ -497,7 +495,7 @@ let pp_json encoding ppf msg = let write { writer ; conn } msg = catch_closed_pipe begin fun () -> debug "Sending message to %a: %a" - P2p_types.Peer_id.pp_short conn.info.peer_id (pp_json writer.encoding) msg ; + P2p_peer.Id.pp_short conn.info.peer_id (pp_json writer.encoding) msg ; Lwt.return (Writer.encode_message writer msg) >>=? fun buf -> Lwt_pipe.push writer.messages (buf, None) >>= return end @@ -506,7 +504,7 @@ let write_sync { writer ; conn } msg = catch_closed_pipe begin fun () -> let waiter, wakener = Lwt.wait () in debug "Sending message to %a: %a" - P2p_types.Peer_id.pp_short conn.info.peer_id (pp_json writer.encoding) msg ; + P2p_peer.Id.pp_short conn.info.peer_id (pp_json writer.encoding) msg ; Lwt.return (Writer.encode_message writer msg) >>=? fun buf -> Lwt_pipe.push writer.messages (buf, Some wakener) >>= fun () -> waiter @@ -514,7 +512,7 @@ let write_sync { writer ; conn } msg = let write_now { writer ; conn } msg = debug "Try sending message to %a: %a" - P2p_types.Peer_id.pp_short conn.info.peer_id (pp_json writer.encoding) msg ; + P2p_peer.Id.pp_short conn.info.peer_id (pp_json writer.encoding) msg ; Writer.encode_message writer msg >>? fun buf -> try Ok (Lwt_pipe.push_now writer.messages (buf, None)) with Lwt_pipe.Closed -> Error [P2p_io_scheduler.Connection_closed] diff --git a/src/lib_p2p/p2p_connection.mli b/src/lib_p2p/p2p_socket.mli similarity index 93% rename from src/lib_p2p/p2p_connection.mli rename to src/lib_p2p/p2p_socket.mli index ffa9379de..37b297831 100644 --- a/src/lib_p2p/p2p_connection.mli +++ b/src/lib_p2p/p2p_socket.mli @@ -15,8 +15,6 @@ limited by providing corresponding arguments to [accept]. *) -open P2p_types - (** {1 Types} *) type error += Decipher_error @@ -24,8 +22,8 @@ type error += Invalid_message_size type error += Encoding_error type error += Decoding_error type error += Rejected -type error += Myself of Id_point.t -type error += Not_enough_proof_of_work of Peer_id.t +type error += Myself of P2p_connection.Id.t +type error += Not_enough_proof_of_work of P2p_peer.Id.t type error += Invalid_auth type error += Invalid_chunks_size of { value: int ; min: int ; max: int } @@ -40,17 +38,17 @@ type 'msg t val equal: 'mst t -> 'msg t -> bool val pp: Format.formatter -> 'msg t -> unit -val info: 'msg t -> Connection_info.t +val info: 'msg t -> P2p_connection.Info.t (** {1 Low-level functions (do not use directly)} *) val authenticate: proof_of_work_target:Crypto_box.target -> incoming:bool -> - P2p_io_scheduler.connection -> Point.t -> + P2p_io_scheduler.connection -> P2p_point.Id.t -> ?listening_port: int -> - Identity.t -> Version.t list -> - (Connection_info.t * authenticated_fd) tzresult Lwt.t + P2p_identity.t -> P2p_version.t list -> + (P2p_connection.Info.t * authenticated_fd) tzresult Lwt.t (** (Low-level) (Cancelable) Authentication function of a remote peer. Used in [P2p_connection_pool], to promote a [P2P_io_scheduler.connection] into an [authenticated_fd] (auth @@ -112,7 +110,7 @@ val read_now: 'msg t -> (int * 'msg) tzresult option is not empty, [None] if it is empty, or fails with a correponding error otherwise. *) -val stat: 'msg t -> Stat.t +val stat: 'msg t -> P2p_stat.t (** [stat conn] is a snapshot of current bandwidth usage for [conn]. *) diff --git a/src/lib_p2p/p2p_welcome.ml b/src/lib_p2p/p2p_welcome.ml index 8a3c311d6..fefe210ad 100644 --- a/src/lib_p2p/p2p_welcome.ml +++ b/src/lib_p2p/p2p_welcome.ml @@ -9,7 +9,7 @@ include Logging.Make (struct let name = "p2p.welcome" end) -type pool = Pool : ('msg, 'meta) P2p_connection_pool.t -> pool +type pool = Pool : ('msg, 'meta) P2p_pool.t -> pool type t = { socket: Lwt_unix.file_descr ; @@ -30,7 +30,7 @@ let rec worker_loop st = | Lwt_unix.ADDR_UNIX _ -> assert false | Lwt_unix.ADDR_INET (addr, port) -> (Ipaddr_unix.V6.of_inet_addr_exn addr, port) in - P2p_connection_pool.accept pool fd point ; + P2p_pool.accept pool fd point ; worker_loop st | Error [Lwt_utils.Canceled] -> Lwt.return_unit diff --git a/src/lib_p2p/p2p_welcome.mli b/src/lib_p2p/p2p_welcome.mli index e325046a7..1a0403b3a 100644 --- a/src/lib_p2p/p2p_welcome.mli +++ b/src/lib_p2p/p2p_welcome.mli @@ -7,8 +7,6 @@ (* *) (**************************************************************************) -open P2p_types - (** Welcome worker. Accept incoming connections and add them to its connection pool. *) @@ -18,8 +16,8 @@ type t val run: backlog:int -> - ('msg, 'meta) P2p_connection_pool.t -> - ?addr:addr -> port -> t Lwt.t + ('msg, 'meta) P2p_pool.t -> + ?addr:P2p_addr.t -> P2p_addr.port -> t Lwt.t (** [run ~backlog ~addr pool port] returns a running welcome worker feeding [pool] listening at [(addr, port)]. [backlog] is the argument passed to [Lwt_unix.accept]. *) diff --git a/src/lib_p2p_services/p2p_connection_pool_types.ml b/src/lib_p2p_services/p2p_connection_pool_types.ml deleted file mode 100644 index 929513e99..000000000 --- a/src/lib_p2p_services/p2p_connection_pool_types.ml +++ /dev/null @@ -1,526 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2017. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* 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 diff --git a/src/lib_p2p_services/p2p_connection_pool_types.mli b/src/lib_p2p_services/p2p_connection_pool_types.mli deleted file mode 100644 index 489bc69de..000000000 --- a/src/lib_p2p_services/p2p_connection_pool_types.mli +++ /dev/null @@ -1,284 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2017. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* 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 diff --git a/src/lib_p2p_services/p2p_services.ml b/src/lib_p2p_services/p2p_services.ml index 08907c4df..d3b1e943c 100644 --- a/src/lib_p2p_services/p2p_services.ml +++ b/src/lib_p2p_services/p2p_services.ml @@ -7,17 +7,15 @@ (* *) (**************************************************************************) -open P2p_types - -let (peer_id_arg : P2p_types.Peer_id.t RPC_arg.arg) = +let (peer_id_arg : P2p_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 + ~destruct:P2p_point.Id.of_string + ~construct:P2p_point.Id.to_string () let versions = @@ -25,7 +23,7 @@ let versions = ~description:"Supported network layer versions." ~query: RPC_query.empty ~input: Data_encoding.empty - ~output: (Data_encoding.list P2p_types.Version.encoding) + ~output: (Data_encoding.list P2p_version.encoding) ~error: Data_encoding.empty RPC_path.(root / "network" / "versions") @@ -34,7 +32,7 @@ let stat = ~description:"Global network bandwidth statistics in B/s." ~query: RPC_query.empty ~input: Data_encoding.empty - ~output: P2p_types.Stat.encoding + ~output: P2p_stat.encoding ~error: Data_encoding.empty RPC_path.(root / "network" / "stat") @@ -43,7 +41,7 @@ let events = ~description:"Stream of all network events" ~query: RPC_query.empty ~input: Data_encoding.empty - ~output: P2p_types.Connection_pool_log_event.encoding + ~output: P2p_connection.Pool_event.encoding ~error: Data_encoding.empty RPC_path.(root / "network" / "log") @@ -65,7 +63,7 @@ module Connection = struct ~description:"List the running P2P connection." ~query: RPC_query.empty ~input: Data_encoding.empty - ~output: (Data_encoding.list P2p_types.Connection_info.encoding) + ~output: (Data_encoding.list P2p_connection.Info.encoding) ~error: Data_encoding.empty RPC_path.(root / "network" / "connection") @@ -73,7 +71,7 @@ module Connection = struct RPC_service.post_service ~query: RPC_query.empty ~input: Data_encoding.empty - ~output: (Data_encoding.option P2p_types.Connection_info.encoding) + ~output: (Data_encoding.option P2p_connection.Info.encoding) ~error: Data_encoding.empty ~description:"Details about the current P2P connection to the given peer." RPC_path.(root / "network" / "connection" /: peer_id_arg) @@ -95,7 +93,7 @@ module Point = struct RPC_service.post_service ~query: RPC_query.empty ~input: Data_encoding.empty - ~output: (Data_encoding.option P2p_types.Point_info.encoding) + ~output: (Data_encoding.option P2p_point.Info.encoding) ~error: Data_encoding.empty ~description: "Details about a given `IP:addr`." RPC_path.(root / "network" / "point" /: point_arg) @@ -105,7 +103,7 @@ module Point = struct ~query: RPC_query.empty ~input: monitor_encoding ~output: (Data_encoding.list - P2p_connection_pool_types.Point_info.Event.encoding) + P2p_point.Pool_event.encoding) ~error: Data_encoding.empty ~description: "Monitor network events related to an `IP:addr`." RPC_path.(root / "network" / "point" /: point_arg / "log") @@ -113,14 +111,14 @@ module Point = struct let list = let filter = let open Data_encoding in - obj1 (dft "filter" (list P2p_types.Point_state.encoding) []) in + obj1 (dft "filter" (list P2p_point.State.encoding) []) in RPC_service.post_service ~query: RPC_query.empty ~input: filter ~output: Data_encoding.(list (tup2 - P2p_types.Point.encoding - P2p_types.Point_info.encoding)) + P2p_point.Id.encoding + P2p_point.Info.encoding)) ~error: Data_encoding.empty ~description:"List the pool of known `IP:port` \ used for establishing P2P connections ." @@ -134,7 +132,7 @@ module Peer_id = struct RPC_service.post_service ~query: RPC_query.empty ~input: Data_encoding.empty - ~output: (Data_encoding.option P2p_types.Peer_info.encoding) + ~output: (Data_encoding.option P2p_peer.Info.encoding) ~error: Data_encoding.empty ~description:"Details about a given peer." RPC_path.(root / "network" / "peer_id" /: peer_id_arg) @@ -144,7 +142,7 @@ module Peer_id = struct ~query: RPC_query.empty ~input: monitor_encoding ~output: (Data_encoding.list - P2p_connection_pool_types.Peer_info.Event.encoding) + P2p_peer.Pool_event.encoding) ~error: Data_encoding.empty ~description:"Monitor network events related to a given peer." RPC_path.(root / "network" / "peer_id" /: peer_id_arg / "log") @@ -152,14 +150,14 @@ module Peer_id = struct let list = let filter = let open Data_encoding in - obj1 (dft "filter" (list P2p_types.Peer_state.encoding) []) in + obj1 (dft "filter" (list P2p_peer.State.encoding) []) in RPC_service.post_service ~query: RPC_query.empty ~input: filter ~output: Data_encoding.(list (tup2 - P2p_types.Peer_id.encoding - P2p_types.Peer_info.encoding)) + P2p_peer.Id.encoding + P2p_peer.Info.encoding)) ~error: Data_encoding.empty ~description:"List the peers the node ever met." RPC_path.(root / "network" / "peer_id") diff --git a/src/lib_p2p_services/p2p_services.mli b/src/lib_p2p_services/p2p_services.mli index 719640c47..63d3a8cea 100644 --- a/src/lib_p2p_services/p2p_services.mli +++ b/src/lib_p2p_services/p2p_services.mli @@ -7,26 +7,24 @@ (* *) (**************************************************************************) -open P2p_types - val stat : ([ `POST ], unit, unit, unit, unit, - Stat.t, unit) RPC_service.t + P2p_stat.t, unit) RPC_service.t val versions : ([ `POST ], unit, unit, unit, unit, - Version.t list, unit) RPC_service.t + P2p_version.t list, unit) RPC_service.t val events : ([ `POST ], unit, unit, unit, unit, - Connection_pool_log_event.t, unit) RPC_service.t + P2p_connection.Pool_event.t, unit) RPC_service.t val connect : ([ `POST ], unit, - unit * Point.t, unit, float, + unit * P2p_point.Id.t, unit, float, unit tzresult, unit) RPC_service.t module Connection : sig @@ -34,16 +32,16 @@ module Connection : sig val list : ([ `POST ], unit, unit, unit, unit, - Connection_info.t list, unit) RPC_service.t + P2p_connection.Info.t list, unit) RPC_service.t val info : ([ `POST ], unit, - unit * Peer_id.t, unit, unit, - Connection_info.t option, unit) RPC_service.t + unit * P2p_peer.Id.t, unit, unit, + P2p_connection.Info.t option, unit) RPC_service.t val kick : ([ `POST ], unit, - unit * Peer_id.t, unit, bool, + unit * P2p_peer.Id.t, unit, bool, unit, unit) RPC_service.t end @@ -51,33 +49,33 @@ end module Point : sig val list : ([ `POST ], unit, - unit, unit, Point_state.t list, - (Point.t * Point_info.t) list, unit) RPC_service.t + unit, unit, P2p_point.State.t list, + (P2p_point.Id.t * P2p_point.Info.t) list, unit) RPC_service.t val info : ([ `POST ], unit, - unit * Point.t, unit, unit, - Point_info.t option, unit) RPC_service.t + unit * P2p_point.Id.t, unit, unit, + P2p_point.Info.t option, unit) RPC_service.t val events : ([ `POST ], unit, - unit * Point.t, unit, bool, - P2p_connection_pool_types.Point_info.Event.t list, unit) RPC_service.t + unit * P2p_point.Id.t, unit, bool, + P2p_point.Pool_event.t list, unit) RPC_service.t end module Peer_id : sig val list : ([ `POST ], unit, - unit, unit, Peer_state.t list, - (Peer_id.t * Peer_info.t) list, unit) RPC_service.t + unit, unit, P2p_peer.State.t list, + (P2p_peer.Id.t * P2p_peer.Info.t) list, unit) RPC_service.t val info : ([ `POST ], unit, - unit * Peer_id.t, unit, unit, - Peer_info.t option, unit) RPC_service.t + unit * P2p_peer.Id.t, unit, unit, + P2p_peer.Info.t option, unit) RPC_service.t val events : ([ `POST ], unit, - unit * Peer_id.t, unit, bool, - P2p_connection_pool_types.Peer_info.Event.t list, unit) RPC_service.t + unit * P2p_peer.Id.t, unit, bool, + P2p_peer.Pool_event.t list, unit) RPC_service.t end diff --git a/src/lib_p2p_services/p2p_types.ml b/src/lib_p2p_services/p2p_types.ml deleted file mode 100644 index a39f9a6f8..000000000 --- a/src/lib_p2p_services/p2p_types.ml +++ /dev/null @@ -1,717 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2017. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* 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 diff --git a/src/lib_p2p_services/p2p_types.mli b/src/lib_p2p_services/p2p_types.mli deleted file mode 100644 index a529c598c..000000000 --- a/src/lib_p2p_services/p2p_types.mli +++ /dev/null @@ -1,263 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2017. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* 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 - diff --git a/src/lib_shell/block_validator.ml b/src/lib_shell/block_validator.ml index c448b608d..f8f1a4792 100644 --- a/src/lib_shell/block_validator.ml +++ b/src/lib_shell/block_validator.ml @@ -40,7 +40,7 @@ module Request = struct net_db: Distributed_db.net_db ; notify_new_block: State.Block.t -> unit ; canceler: Lwt_canceler.t option ; - peer: P2p.Peer_id.t option ; + peer: P2p_peer.Id.t option ; hash: Block_hash.t ; header: Block_header.t ; operations: Operation.t list list ; diff --git a/src/lib_shell/block_validator.mli b/src/lib_shell/block_validator.mli index 484039f87..399ef110c 100644 --- a/src/lib_shell/block_validator.mli +++ b/src/lib_shell/block_validator.mli @@ -22,7 +22,7 @@ val create: val validate: t -> ?canceler:Lwt_canceler.t -> - ?peer:P2p.Peer_id.t -> + ?peer:P2p_peer.Id.t -> ?notify_new_block:(State.Block.t -> unit) -> Distributed_db.net_db -> Block_hash.t -> Block_header.t -> Operation.t list list -> @@ -30,7 +30,7 @@ val validate: val fetch_and_compile_protocol: t -> - ?peer:P2p.Peer_id.t -> + ?peer:P2p_peer.Id.t -> ?timeout:float -> Protocol_hash.t -> State.Registred_protocol.t tzresult Lwt.t diff --git a/src/lib_shell/bootstrap_pipeline.ml b/src/lib_shell/bootstrap_pipeline.ml index 80effe5c9..5db7edc82 100644 --- a/src/lib_shell/bootstrap_pipeline.ml +++ b/src/lib_shell/bootstrap_pipeline.ml @@ -9,7 +9,7 @@ include Logging.Make(struct let name = "node.validator.bootstrap_pipeline" end) -type error += Invalid_locator of P2p.Peer_id.t * Block_locator.t +type error += Invalid_locator of P2p_peer.Id.t * Block_locator.t type t = { canceler: Lwt_canceler.t ; @@ -18,7 +18,7 @@ type t = { mutable headers_fetch_worker: unit Lwt.t ; mutable operations_fetch_worker: unit Lwt.t ; mutable validation_worker: unit Lwt.t ; - peer_id: P2p.Peer_id.t ; + peer_id: P2p_peer.Id.t ; net_db: Distributed_db.net_db ; locator: Block_locator.t ; block_validator: Block_validator.t ; @@ -37,24 +37,24 @@ let fetch_step pipeline (step : Block_locator_iterator.step) = Block_hash.pp_short step.predecessor step.step (if step.strict_step then "" else " max") - P2p.Peer_id.pp_short pipeline.peer_id >>= fun () -> + P2p_peer.Id.pp_short pipeline.peer_id >>= fun () -> let rec fetch_loop acc hash cpt = Lwt_unix.yield () >>= fun () -> if cpt < 0 then lwt_log_info "invalid step from peer %a (too long)." - P2p.Peer_id.pp_short pipeline.peer_id >>= fun () -> + P2p_peer.Id.pp_short pipeline.peer_id >>= fun () -> fail (Invalid_locator (pipeline.peer_id, pipeline.locator)) else if Block_hash.equal hash step.predecessor then if step.strict_step && cpt <> 0 then lwt_log_info "invalid step from peer %a (too short)." - P2p.Peer_id.pp_short pipeline.peer_id >>= fun () -> + P2p_peer.Id.pp_short pipeline.peer_id >>= fun () -> fail (Invalid_locator (pipeline.peer_id, pipeline.locator)) else return acc else lwt_debug "fetching block header %a from peer %a." Block_hash.pp_short hash - P2p.Peer_id.pp_short pipeline.peer_id >>= fun () -> + P2p_peer.Id.pp_short pipeline.peer_id >>= fun () -> Lwt_utils.protect ~canceler:pipeline.canceler begin fun () -> Distributed_db.Block_header.fetch ~timeout:pipeline.block_header_timeout @@ -63,7 +63,7 @@ let fetch_step pipeline (step : Block_locator_iterator.step) = end >>=? fun header -> lwt_debug "fetched block header %a from peer %a." Block_hash.pp_short hash - P2p.Peer_id.pp_short pipeline.peer_id >>= fun () -> + P2p_peer.Id.pp_short pipeline.peer_id >>= fun () -> fetch_loop ((hash, header) :: acc) header.shell.predecessor (cpt - 1) in fetch_loop [] step.block step.step >>=? fun headers -> @@ -84,7 +84,7 @@ let headers_fetch_worker_loop pipeline = end >>= function | Ok () -> lwt_log_info "fetched all step from peer %a." - P2p.Peer_id.pp_short pipeline.peer_id >>= fun () -> + P2p_peer.Id.pp_short pipeline.peer_id >>= fun () -> Lwt_pipe.close pipeline.fetched_headers ; Lwt.return_unit | Error [Exn Lwt.Canceled | Lwt_utils.Canceled | Exn Lwt_pipe.Closed] -> @@ -92,7 +92,7 @@ let headers_fetch_worker_loop pipeline = | Error [ Distributed_db.Block_header.Timeout bh ] -> lwt_log_info "request for header %a from peer %a timed out." Block_hash.pp_short bh - P2p.Peer_id.pp_short pipeline.peer_id >>= fun () -> + P2p_peer.Id.pp_short pipeline.peer_id >>= fun () -> Lwt_canceler.cancel pipeline.canceler >>= fun () -> Lwt.return_unit | Error err -> @@ -110,7 +110,7 @@ let rec operations_fetch_worker_loop pipeline = end >>=? fun (hash, header) -> lwt_log_info "fetching operations of block %a from peer %a." Block_hash.pp_short hash - P2p.Peer_id.pp_short pipeline.peer_id >>= fun () -> + P2p_peer.Id.pp_short pipeline.peer_id >>= fun () -> map_p (fun i -> Lwt_utils.protect ~canceler:pipeline.canceler begin fun () -> @@ -122,7 +122,7 @@ let rec operations_fetch_worker_loop pipeline = (0 -- (header.shell.validation_passes - 1)) >>=? fun operations -> lwt_log_info "fetched operations of block %a from peer %a." Block_hash.pp_short hash - P2p.Peer_id.pp_short pipeline.peer_id >>= fun () -> + P2p_peer.Id.pp_short pipeline.peer_id >>= fun () -> Lwt_utils.protect ~canceler:pipeline.canceler begin fun () -> Lwt_pipe.push pipeline.fetched_blocks (hash, header, operations) >>= return @@ -136,7 +136,7 @@ let rec operations_fetch_worker_loop pipeline = | Error [ Distributed_db.Operations.Timeout (bh, n) ] -> lwt_log_info "request for operations %a:%d from peer %a timed out." Block_hash.pp_short bh n - P2p.Peer_id.pp_short pipeline.peer_id >>= fun () -> + P2p_peer.Id.pp_short pipeline.peer_id >>= fun () -> Lwt_canceler.cancel pipeline.canceler >>= fun () -> Lwt.return_unit | Error err -> @@ -154,7 +154,7 @@ let rec validation_worker_loop pipeline = end >>=? fun (hash, header, operations) -> lwt_log_info "requesting validation for block %a from peer %a." Block_hash.pp_short hash - P2p.Peer_id.pp_short pipeline.peer_id >>= fun () -> + P2p_peer.Id.pp_short pipeline.peer_id >>= fun () -> Lwt_utils.protect ~canceler:pipeline.canceler begin fun () -> Block_validator.validate ~canceler:pipeline.canceler @@ -164,7 +164,7 @@ let rec validation_worker_loop pipeline = end >>=? fun _block -> lwt_log_info "validated block %a from peer %a." Block_hash.pp_short hash - P2p.Peer_id.pp_short pipeline.peer_id >>= fun () -> + P2p_peer.Id.pp_short pipeline.peer_id >>= fun () -> return () end >>= function | Ok () -> validation_worker_loop pipeline @@ -214,19 +214,19 @@ let create pipeline.headers_fetch_worker <- Lwt_utils.worker (Format.asprintf "bootstrap_pipeline-headers_fetch.%a.%a" - P2p.Peer_id.pp_short peer_id Block_hash.pp_short hash) + P2p_peer.Id.pp_short peer_id Block_hash.pp_short hash) ~run:(fun () -> headers_fetch_worker_loop pipeline) ~cancel:(fun () -> Lwt_canceler.cancel pipeline.canceler) ; pipeline.operations_fetch_worker <- Lwt_utils.worker (Format.asprintf "bootstrap_pipeline-operations_fetch.%a.%a" - P2p.Peer_id.pp_short peer_id Block_hash.pp_short hash) + P2p_peer.Id.pp_short peer_id Block_hash.pp_short hash) ~run:(fun () -> operations_fetch_worker_loop pipeline) ~cancel:(fun () -> Lwt_canceler.cancel pipeline.canceler) ; pipeline.validation_worker <- Lwt_utils.worker (Format.asprintf "bootstrap_pipeline-validation.%a.%a" - P2p.Peer_id.pp_short peer_id Block_hash.pp_short hash) + P2p_peer.Id.pp_short peer_id Block_hash.pp_short hash) ~run:(fun () -> validation_worker_loop pipeline) ~cancel:(fun () -> Lwt_canceler.cancel pipeline.canceler) ; pipeline diff --git a/src/lib_shell/bootstrap_pipeline.mli b/src/lib_shell/bootstrap_pipeline.mli index c6877e173..c9bb0c27e 100644 --- a/src/lib_shell/bootstrap_pipeline.mli +++ b/src/lib_shell/bootstrap_pipeline.mli @@ -9,14 +9,14 @@ type t -type error += Invalid_locator of P2p.Peer_id.t * Block_locator.t +type error += Invalid_locator of P2p_peer.Id.t * Block_locator.t val create: ?notify_new_block: (State.Block.t -> unit) -> block_header_timeout:float -> block_operations_timeout: float -> Block_validator.t -> - P2p.Peer_id.t -> Distributed_db.net_db -> + P2p_peer.Id.t -> Distributed_db.net_db -> Block_locator.t -> t val wait: t -> unit tzresult Lwt.t diff --git a/src/lib_shell/distributed_db.ml b/src/lib_shell/distributed_db.ml index cb8c1db76..58ece1e64 100644 --- a/src/lib_shell/distributed_db.ml +++ b/src/lib_shell/distributed_db.ml @@ -15,8 +15,8 @@ type connection = (Message.t, Metadata.t) P2p.connection type 'a request_param = { data: 'a ; - active: unit -> P2p.Peer_id.Set.t ; - send: P2p.Peer_id.t -> Message.t -> unit ; + active: unit -> P2p_peer.Set.t ; + send: P2p_peer.Id.t -> Message.t -> unit ; } module Make_raw @@ -292,15 +292,15 @@ module Raw_protocol = type callback = { notify_branch: - P2p.Peer_id.t -> Block_locator.t -> unit ; + P2p_peer.Id.t -> Block_locator.t -> unit ; notify_head: - P2p.Peer_id.t -> Block_header.t -> Mempool.t -> unit ; - disconnection: P2p.Peer_id.t -> unit ; + P2p_peer.Id.t -> Block_header.t -> Mempool.t -> unit ; + disconnection: P2p_peer.Id.t -> unit ; } type db = { p2p: p2p ; - p2p_readers: p2p_reader P2p.Peer_id.Table.t ; + p2p_readers: p2p_reader P2p_peer.Table.t ; disk: State.t ; active_nets: net_db Net_id.Table.t ; protocol_db: Raw_protocol.t ; @@ -316,12 +316,12 @@ and net_db = { operation_hashes_db: Raw_operation_hashes.t ; operations_db: Raw_operations.t ; mutable callback: callback ; - active_peers: P2p.Peer_id.Set.t ref ; - active_connections: p2p_reader P2p.Peer_id.Table.t ; + active_peers: P2p_peer.Set.t ref ; + active_connections: p2p_reader P2p_peer.Table.t ; } and p2p_reader = { - gid: P2p.Peer_id.t ; + gid: P2p_peer.Id.t ; conn: connection ; peer_active_nets: net_db Net_id.Table.t ; canceler: Lwt_canceler.t ; @@ -418,8 +418,8 @@ module P2p_reader = struct match Net_id.Table.find global_db.active_nets net_id with | net_db -> net_db.active_peers := - P2p.Peer_id.Set.add state.gid !(net_db.active_peers) ; - P2p.Peer_id.Table.add net_db.active_connections + P2p_peer.Set.add state.gid !(net_db.active_peers) ; + P2p_peer.Table.add net_db.active_connections state.gid state ; Net_id.Table.add state.peer_active_nets net_id net_db ; f net_db @@ -430,8 +430,8 @@ module P2p_reader = struct let deactivate state net_db = net_db.callback.disconnection state.gid ; net_db.active_peers := - P2p.Peer_id.Set.remove state.gid !(net_db.active_peers) ; - P2p.Peer_id.Table.remove net_db.active_connections state.gid + P2p_peer.Set.remove state.gid !(net_db.active_peers) ; + P2p_peer.Table.remove net_db.active_connections state.gid let may_handle state net_id f = match Net_id.Table.find state.peer_active_nets net_id with @@ -456,7 +456,7 @@ module P2p_reader = struct let open Logging in lwt_debug "Read message from %a: %a" - P2p.Peer_id.pp_short state.gid Message.pp_json msg >>= fun () -> + P2p_peer.Id.pp_short state.gid Message.pp_json msg >>= fun () -> match msg with @@ -639,7 +639,7 @@ module P2p_reader = struct Net_id.Table.iter (fun _ -> deactivate state) state.peer_active_nets ; - P2p.Peer_id.Table.remove global_db.p2p_readers state.gid ; + P2p_peer.Table.remove global_db.p2p_readers state.gid ; Lwt.return_unit let run db gid conn = @@ -657,10 +657,10 @@ module P2p_reader = struct state.worker <- Lwt_utils.worker (Format.asprintf "db_network_reader.%a" - P2p.Peer_id.pp_short gid) + P2p_peer.Id.pp_short gid) ~run:(fun () -> worker_loop db state) ~cancel:(fun () -> Lwt_canceler.cancel canceler) ; - P2p.Peer_id.Table.add db.p2p_readers gid state + P2p_peer.Table.add db.p2p_readers gid state let shutdown s = Lwt_canceler.cancel s.canceler >>= fun () -> @@ -671,9 +671,9 @@ end let active_peer_ids p2p () = List.fold_left (fun acc conn -> - let { P2p.Connection_info.peer_id } = P2p.connection_info p2p conn in - P2p.Peer_id.Set.add peer_id acc) - P2p.Peer_id.Set.empty + let { P2p_connection.Info.peer_id } = P2p.connection_info p2p conn in + P2p_peer.Set.add peer_id acc) + P2p_peer.Set.empty (P2p.connections p2p) let raw_try_send p2p peer_id msg = @@ -689,7 +689,7 @@ let create disk p2p = } in let protocol_db = Raw_protocol.create global_request disk in let active_nets = Net_id.Table.create 17 in - let p2p_readers = P2p.Peer_id.Table.create 17 in + let p2p_readers = P2p_peer.Table.create 17 in let block_input = Lwt_watcher.create_input () in let operation_input = Lwt_watcher.create_input () in let db = @@ -704,7 +704,7 @@ let activate ({ p2p ; active_nets } as global_db) net_state = let net_id = State.Net.id net_state in match Net_id.Table.find active_nets net_id with | exception Not_found -> - let active_peers = ref P2p.Peer_id.Set.empty in + let active_peers = ref P2p_peer.Set.empty in let p2p_request = { data = () ; active = (fun () -> !active_peers) ; @@ -724,7 +724,7 @@ let activate ({ p2p ; active_nets } as global_db) net_state = global_db ; operation_db ; block_header_db ; operation_hashes_db ; operations_db ; net_state ; callback = noop_callback ; active_peers ; - active_connections = P2p.Peer_id.Table.create 53 ; + active_connections = P2p_peer.Table.create 53 ; } in P2p.iter_connections p2p (fun _peer_id conn -> Lwt.async begin fun () -> @@ -742,7 +742,7 @@ let deactivate net_db = let { active_nets ; p2p } = net_db.global_db in let net_id = State.Net.id net_db.net_state in Net_id.Table.remove active_nets net_id ; - P2p.Peer_id.Table.iter + P2p_peer.Table.iter (fun _peer_id reader -> P2p_reader.deactivate reader net_db ; Lwt.async begin fun () -> @@ -764,7 +764,7 @@ let disconnect { global_db = { p2p } } peer_id = | Some conn -> P2p.disconnect p2p conn let shutdown { p2p ; p2p_readers ; active_nets } = - P2p.Peer_id.Table.fold + P2p_peer.Table.fold (fun _peer_id reader acc -> P2p_reader.shutdown reader >>= fun () -> acc) p2p_readers @@ -829,12 +829,12 @@ module type DISTRIBUTED_DB = sig type error += Timeout of key val fetch: t -> - ?peer:P2p.Peer_id.t -> + ?peer:P2p_peer.Id.t -> ?timeout:float -> key -> param -> value tzresult Lwt.t val prefetch: t -> - ?peer:P2p.Peer_id.t -> + ?peer:P2p_peer.Id.t -> ?timeout:float -> key -> param -> unit type error += Canceled of key @@ -913,14 +913,14 @@ end let broadcast net_db msg = - P2p.Peer_id.Table.iter + P2p_peer.Table.iter (fun _peer_id state -> ignore (P2p.try_send net_db.global_db.p2p state.conn msg)) net_db.active_connections let try_send net_db peer_id msg = try - let conn = P2p.Peer_id.Table.find net_db.active_connections peer_id in + let conn = P2p_peer.Table.find net_db.active_connections peer_id in ignore (P2p.try_send net_db.global_db.p2p conn.conn msg : bool) with Not_found -> () diff --git a/src/lib_shell/distributed_db.mli b/src/lib_shell/distributed_db.mli index 1f99b701d..dc21a8ee4 100644 --- a/src/lib_shell/distributed_db.mli +++ b/src/lib_shell/distributed_db.mli @@ -40,9 +40,9 @@ val get_net: t -> Net_id.t -> net_db option val deactivate: net_db -> unit Lwt.t type callback = { - notify_branch: P2p.Peer_id.t -> Block_locator.t -> unit ; - notify_head: P2p.Peer_id.t -> Block_header.t -> Mempool.t -> unit ; - disconnection: P2p.Peer_id.t -> unit ; + notify_branch: P2p_peer.Id.t -> Block_locator.t -> unit ; + notify_head: P2p_peer.Id.t -> Block_header.t -> Mempool.t -> unit ; + disconnection: P2p_peer.Id.t -> unit ; } (** Register all the possible callback from the distributed DB to the @@ -50,7 +50,7 @@ type callback = { val set_callback: net_db -> callback -> unit (** Kick a given peer. *) -val disconnect: net_db -> P2p.Peer_id.t -> unit Lwt.t +val disconnect: net_db -> P2p_peer.Id.t -> unit Lwt.t (** Various accessors. *) val net_state: net_db -> State.Net.t @@ -63,12 +63,12 @@ module Request : sig (** Send to a given peer, or to all known active peers for the network, a friendly request "Hey, what's your current branch ?". The expected answer is a `Block_locator.t.`. *) - val current_branch: net_db -> ?peer:P2p.Peer_id.t -> unit -> unit + val current_branch: net_db -> ?peer:P2p_peer.Id.t -> unit -> unit (** Send to a given peer, or to all known active peers for the given network, a friendly request "Hey, what's your current branch ?". The expected answer is a `Block_locator.t.`. *) - val current_head: net_db -> ?peer:P2p.Peer_id.t -> unit -> unit + val current_head: net_db -> ?peer:P2p_peer.Id.t -> unit -> unit end @@ -77,13 +77,13 @@ module Advertise : sig (** Notify a given peer, or all known active peers for the network, of a new head and possibly of new operations. *) val current_head: - net_db -> ?peer:P2p.Peer_id.t -> + net_db -> ?peer:P2p_peer.Id.t -> ?mempool:Mempool.t -> State.Block.t -> unit (** Notify a given peer, or all known active peers for the network, of a new head and its sparse history. *) val current_branch: - net_db -> ?peer:P2p.Peer_id.t -> + net_db -> ?peer:P2p_peer.Id.t -> Block_locator.t -> unit Lwt.t end @@ -145,7 +145,7 @@ module type DISTRIBUTED_DB = sig peer (at each retry). *) val fetch: t -> - ?peer:P2p.Peer_id.t -> + ?peer:P2p_peer.Id.t -> ?timeout:float -> key -> param -> value tzresult Lwt.t @@ -153,7 +153,7 @@ module type DISTRIBUTED_DB = sig stored in the local index when received. *) val prefetch: t -> - ?peer:P2p.Peer_id.t -> + ?peer:P2p_peer.Id.t -> ?timeout:float -> key -> param -> unit @@ -257,6 +257,6 @@ val commit_protocol: module Raw : sig val encoding: Message.t P2p.Raw.t Data_encoding.t - val supported_versions: P2p_types.Version.t list + val supported_versions: P2p_version.t list end diff --git a/src/lib_shell/distributed_db_functors.ml b/src/lib_shell/distributed_db_functors.ml index e4e752e7c..f7050a1cf 100644 --- a/src/lib_shell/distributed_db_functors.ml +++ b/src/lib_shell/distributed_db_functors.ml @@ -26,13 +26,13 @@ module type DISTRIBUTED_DB = sig val prefetch: t -> - ?peer:P2p.Peer_id.t -> + ?peer:P2p_peer.Id.t -> ?timeout:float -> key -> param -> unit val fetch: t -> - ?peer:P2p.Peer_id.t -> + ?peer:P2p_peer.Id.t -> ?timeout:float -> key -> param -> value tzresult Lwt.t @@ -68,12 +68,12 @@ end module type SCHEDULER_EVENTS = sig type t type key - val request: t -> P2p.Peer_id.t option -> key -> unit - val notify: t -> P2p.Peer_id.t -> key -> unit + val request: t -> P2p_peer.Id.t option -> key -> unit + val notify: t -> P2p_peer.Id.t -> key -> unit val notify_cancelation: t -> key -> unit - val notify_unrequested: t -> P2p.Peer_id.t -> key -> unit - val notify_duplicate: t -> P2p.Peer_id.t -> key -> unit - val notify_invalid: t -> P2p.Peer_id.t -> key -> unit + val notify_unrequested: t -> P2p_peer.Id.t -> key -> unit + val notify_duplicate: t -> P2p_peer.Id.t -> key -> unit + val notify_invalid: t -> P2p_peer.Id.t -> key -> unit end module type PRECHECK = sig @@ -103,7 +103,7 @@ module Make_table val create: ?global_input:(key * value) Lwt_watcher.input -> Scheduler.t -> Disk_table.store -> t - val notify: t -> P2p.Peer_id.t -> key -> Precheck.notified_value -> unit Lwt.t + val notify: t -> P2p_peer.Id.t -> key -> Precheck.notified_value -> unit Lwt.t end = struct @@ -306,8 +306,8 @@ end module type REQUEST = sig type key type param - val active : param -> P2p.Peer_id.Set.t - val send : param -> P2p.Peer_id.t -> key list -> unit + val active : param -> P2p_peer.Set.t + val send : param -> P2p_peer.Id.t -> key list -> unit end module Make_request_scheduler @@ -343,24 +343,24 @@ end = struct } and status = { - peers: P2p.Peer_id.Set.t ; + peers: P2p_peer.Set.t ; next_request: float ; delay: float ; } and event = - | Request of P2p.Peer_id.t option * key - | Notify of P2p.Peer_id.t * key + | Request of P2p_peer.Id.t option * key + | Notify of P2p_peer.Id.t * key | Notify_cancelation of key - | Notify_invalid of P2p.Peer_id.t * key - | Notify_duplicate of P2p.Peer_id.t * key - | Notify_unrequested of P2p.Peer_id.t * key + | Notify_invalid of P2p_peer.Id.t * key + | Notify_duplicate of P2p_peer.Id.t * key + | Notify_unrequested of P2p_peer.Id.t * key let request t p k = assert (Lwt_pipe.push_now t.queue (Request (p, k))) let notify t p k = debug "push received %a from %a" - Hash.pp k P2p.Peer_id.pp_short p ; + Hash.pp k P2p_peer.Id.pp_short p ; assert (Lwt_pipe.push_now t.queue (Notify (p, k))) let notify_cancelation t k = debug "push cancelation %a" @@ -368,15 +368,15 @@ end = struct assert (Lwt_pipe.push_now t.queue (Notify_cancelation k)) let notify_invalid t p k = debug "push received invalid %a from %a" - Hash.pp k P2p.Peer_id.pp_short p ; + Hash.pp k P2p_peer.Id.pp_short p ; assert (Lwt_pipe.push_now t.queue (Notify_invalid (p, k))) let notify_duplicate t p k = debug "push received duplicate %a from %a" - Hash.pp k P2p.Peer_id.pp_short p ; + Hash.pp k P2p_peer.Id.pp_short p ; assert (Lwt_pipe.push_now t.queue (Notify_duplicate (p, k))) let notify_unrequested t p k = debug "push received unrequested %a from %a" - Hash.pp k P2p.Peer_id.pp_short p ; + Hash.pp k P2p_peer.Id.pp_short p ; assert (Lwt_pipe.push_now t.queue (Notify_unrequested (p, k))) let compute_timeout state = @@ -399,7 +399,7 @@ end = struct let may_pp_peer ppf = function | None -> () - | Some peer -> P2p.Peer_id.pp_short ppf peer + | Some peer -> P2p_peer.Id.pp_short ppf peer (* TODO should depend on the ressource kind... *) let initial_delay = 0.1 @@ -413,7 +413,7 @@ end = struct let peers = match peer with | None -> data.peers - | Some peer -> P2p.Peer_id.Set.add peer data.peers in + | Some peer -> P2p_peer.Set.add peer data.peers in Table.replace state.pending key { delay = initial_delay ; next_request = min data.next_request (now +. initial_delay) ; @@ -425,8 +425,8 @@ end = struct with Not_found -> let peers = match peer with - | None -> P2p.Peer_id.Set.empty - | Some peer -> P2p.Peer_id.Set.singleton peer in + | None -> P2p_peer.Set.empty + | Some peer -> P2p_peer.Set.singleton peer in Table.add state.pending key { peers ; next_request = now ; @@ -439,7 +439,7 @@ end = struct | Notify (peer, key) -> Table.remove state.pending key ; lwt_debug "received %a from %a" - Hash.pp key P2p.Peer_id.pp_short peer >>= fun () -> + Hash.pp key P2p_peer.Id.pp_short peer >>= fun () -> Lwt.return_unit | Notify_cancelation key -> Table.remove state.pending key ; @@ -448,17 +448,17 @@ end = struct Lwt.return_unit | Notify_invalid (peer, key) -> lwt_debug "received invalid %a from %a" - Hash.pp key P2p.Peer_id.pp_short peer >>= fun () -> + Hash.pp key P2p_peer.Id.pp_short peer >>= fun () -> (* TODO *) Lwt.return_unit | Notify_unrequested (peer, key) -> lwt_debug "received unrequested %a from %a" - Hash.pp key P2p.Peer_id.pp_short peer >>= fun () -> + Hash.pp key P2p_peer.Id.pp_short peer >>= fun () -> (* TODO *) Lwt.return_unit | Notify_duplicate (peer, key) -> lwt_debug "received duplicate %a from %a" - Hash.pp key P2p.Peer_id.pp_short peer >>= fun () -> + Hash.pp key P2p_peer.Id.pp_short peer >>= fun () -> (* TODO *) Lwt.return_unit @@ -487,14 +487,14 @@ end = struct acc else let remaining_peers = - P2p.Peer_id.Set.inter peers active_peers in - if P2p.Peer_id.Set.is_empty remaining_peers && - not (P2p.Peer_id.Set.is_empty peers) then + P2p_peer.Set.inter peers active_peers in + if P2p_peer.Set.is_empty remaining_peers && + not (P2p_peer.Set.is_empty peers) then ( Table.remove state.pending key ; acc ) else let requested_peer = - P2p.Peer_id.random_set_elt - (if P2p.Peer_id.Set.is_empty remaining_peers + P2p_peer.Id.random_set_elt + (if P2p_peer.Set.is_empty remaining_peers then active_peers else remaining_peers) in let next = { peers = remaining_peers ; @@ -502,16 +502,16 @@ end = struct delay = delay *. 1.2 } in Table.replace state.pending key next ; let requests = - try key :: P2p_types.Peer_id.Map.find requested_peer acc + try key :: P2p_peer.Map.find requested_peer acc with Not_found -> [key] in - P2p_types.Peer_id.Map.add requested_peer requests acc) - state.pending P2p_types.Peer_id.Map.empty in - P2p_types.Peer_id.Map.iter (Request.send state.param) requests ; - P2p_types.Peer_id.Map.fold begin fun peer request acc -> + P2p_peer.Map.add requested_peer requests acc) + state.pending P2p_peer.Map.empty in + P2p_peer.Map.iter (Request.send state.param) requests ; + P2p_peer.Map.fold begin fun peer request acc -> acc >>= fun () -> Lwt_list.iter_s (fun key -> lwt_debug "requested %a from %a" - Hash.pp key P2p.Peer_id.pp_short peer) + Hash.pp key P2p_peer.Id.pp_short peer) request end requests Lwt.return_unit >>= fun () -> worker_loop state diff --git a/src/lib_shell/distributed_db_functors.mli b/src/lib_shell/distributed_db_functors.mli index ed05dcd24..8e273ce55 100644 --- a/src/lib_shell/distributed_db_functors.mli +++ b/src/lib_shell/distributed_db_functors.mli @@ -29,13 +29,13 @@ module type DISTRIBUTED_DB = sig val prefetch: t -> - ?peer:P2p.Peer_id.t -> + ?peer:P2p_peer.Id.t -> ?timeout:float -> key -> param -> unit val fetch: t -> - ?peer:P2p.Peer_id.t -> + ?peer:P2p_peer.Id.t -> ?timeout:float -> key -> param -> value tzresult Lwt.t @@ -72,12 +72,12 @@ end module type SCHEDULER_EVENTS = sig type t type key - val request: t -> P2p.Peer_id.t option -> key -> unit - val notify: t -> P2p.Peer_id.t -> key -> unit + val request: t -> P2p_peer.Id.t option -> key -> unit + val notify: t -> P2p_peer.Id.t -> key -> unit val notify_cancelation: t -> key -> unit - val notify_unrequested: t -> P2p.Peer_id.t -> key -> unit - val notify_duplicate: t -> P2p.Peer_id.t -> key -> unit - val notify_invalid: t -> P2p.Peer_id.t -> key -> unit + val notify_unrequested: t -> P2p_peer.Id.t -> key -> unit + val notify_duplicate: t -> P2p_peer.Id.t -> key -> unit + val notify_invalid: t -> P2p_peer.Id.t -> key -> unit end module type PRECHECK = sig @@ -107,15 +107,15 @@ module Make_table val create: ?global_input:(key * value) Lwt_watcher.input -> Scheduler.t -> Disk_table.store -> t - val notify: t -> P2p.Peer_id.t -> key -> Precheck.notified_value -> unit Lwt.t + val notify: t -> P2p_peer.Id.t -> key -> Precheck.notified_value -> unit Lwt.t end module type REQUEST = sig type key type param - val active : param -> P2p.Peer_id.Set.t - val send : param -> P2p.Peer_id.t -> key list -> unit + val active : param -> P2p_peer.Set.t + val send : param -> P2p_peer.Id.t -> key list -> unit end module Make_request_scheduler diff --git a/src/lib_shell/distributed_db_message.ml b/src/lib_shell/distributed_db_message.ml index fd729f4f8..2a463eedb 100644 --- a/src/lib_shell/distributed_db_message.ml +++ b/src/lib_shell/distributed_db_message.ml @@ -169,7 +169,7 @@ let encoding = ] let versions = - let open P2p.Version in + let open P2p_version in [ { name = "TEZOS" ; major = 0 ; minor = 27 ; diff --git a/src/lib_shell/net_validator.ml b/src/lib_shell/net_validator.ml index 61e300ba8..e6a408cad 100644 --- a/src/lib_shell/net_validator.ml +++ b/src/lib_shell/net_validator.ml @@ -57,17 +57,17 @@ module Types = struct mutable child: (state * (unit -> unit Lwt.t (* shutdown *))) option ; prevalidator: Prevalidator.t ; - active_peers: Peer_validator.t Lwt.t P2p.Peer_id.Table.t ; - bootstrapped_peers: unit P2p.Peer_id.Table.t ; + active_peers: Peer_validator.t Lwt.t P2p_peer.Table.t ; + bootstrapped_peers: unit P2p_peer.Table.t ; } let view (state : state) _ : view = let { bootstrapped ; active_peers ; bootstrapped_peers } = state in { bootstrapped ; active_peers = - P2p.Peer_id.Table.fold (fun id _ l -> id :: l) active_peers [] ; + P2p_peer.Table.fold (fun id _ l -> id :: l) active_peers [] ; bootstrapped_peers = - P2p.Peer_id.Table.fold (fun id _ l -> id :: l) bootstrapped_peers [] } + P2p_peer.Table.fold (fun id _ l -> id :: l) bootstrapped_peers [] } end module Worker = Worker.Make (Name) (Event) (Request) (Types) @@ -99,7 +99,7 @@ let notify_new_block w block = let may_toggle_bootstrapped_network w = let nv = Worker.state w in if not nv.bootstrapped && - P2p.Peer_id.Table.length nv.bootstrapped_peers >= nv.parameters.limits.bootstrap_threshold + P2p_peer.Table.length nv.bootstrapped_peers >= nv.parameters.limits.bootstrap_threshold then begin nv.bootstrapped <- true ; Lwt.wakeup_later nv.bootstrapped_wakener () ; @@ -107,24 +107,24 @@ let may_toggle_bootstrapped_network w = let may_activate_peer_validator w peer_id = let nv = Worker.state w in - try P2p.Peer_id.Table.find nv.active_peers peer_id + try P2p_peer.Table.find nv.active_peers peer_id with Not_found -> let pv = Peer_validator.create ~notify_new_block:(notify_new_block w) ~notify_bootstrapped: begin fun () -> - P2p.Peer_id.Table.add nv.bootstrapped_peers peer_id () ; + P2p_peer.Table.add nv.bootstrapped_peers peer_id () ; may_toggle_bootstrapped_network w end ~notify_termination: begin fun _pv -> - P2p.Peer_id.Table.remove nv.active_peers peer_id ; - P2p.Peer_id.Table.remove nv.bootstrapped_peers peer_id ; + P2p_peer.Table.remove nv.active_peers peer_id ; + P2p_peer.Table.remove nv.bootstrapped_peers peer_id ; end nv.parameters.peer_validator_limits nv.parameters.block_validator nv.parameters.net_db peer_id in - P2p.Peer_id.Table.add nv.active_peers peer_id pv ; + P2p_peer.Table.add nv.active_peers peer_id pv ; pv let may_switch_test_network w spawn_child block = @@ -260,7 +260,7 @@ let on_close w = Lwt.join (Prevalidator.shutdown nv.prevalidator :: Lwt_utils.may ~f:(fun (_, shutdown) -> shutdown ()) nv.child :: - P2p.Peer_id.Table.fold + P2p_peer.Table.fold (fun _ pv acc -> (pv >>= Peer_validator.shutdown) :: acc) nv.active_peers []) >>= fun () -> Lwt.return_unit @@ -280,9 +280,9 @@ let on_launch w _ parameters = bootstrapped_waiter ; bootstrapped = (parameters.limits.bootstrap_threshold <= 0) ; active_peers = - P2p.Peer_id.Table.create 50 ; (* TODO use `2 * max_connection` *) + P2p_peer.Table.create 50 ; (* TODO use `2 * max_connection` *) bootstrapped_peers = - P2p.Peer_id.Table.create 50 ; (* TODO use `2 * max_connection` *) + P2p_peer.Table.create 50 ; (* TODO use `2 * max_connection` *) child = None ; prevalidator } in if nv.bootstrapped then Lwt.wakeup_later bootstrapped_wakener () ; diff --git a/src/lib_shell/node.mli b/src/lib_shell/node.mli index 60e253587..c7f170ed0 100644 --- a/src/lib_shell/node.mli +++ b/src/lib_shell/node.mli @@ -129,58 +129,56 @@ module RPC : sig module Network : sig - open P2p_types - - val stat : t -> Stat.t + val stat : t -> P2p_stat.t val watch : t -> - P2p_types.Connection_pool_log_event.t Lwt_stream.t * Lwt_watcher.stopper - val connect : t -> Point.t -> float -> unit tzresult Lwt.t + P2p_connection.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper + val connect : t -> P2p_point.Id.t -> float -> unit tzresult Lwt.t module Connection : sig - val info : t -> Peer_id.t -> Connection_info.t option - val kick : t -> Peer_id.t -> bool -> unit Lwt.t - val list : t -> Connection_info.t list + val info : t -> P2p_peer.Id.t -> P2p_connection.Info.t option + val kick : t -> P2p_peer.Id.t -> bool -> unit Lwt.t + val list : t -> P2p_connection.Info.t list val count : t -> int end module Point : sig val info : - t -> Point.t -> P2p_types.Point_info.t option + t -> P2p_point.Id.t -> P2p_point.Info.t option val list : - ?restrict: P2p_types.Point_state.t list -> - t -> (Point.t * P2p_types.Point_info.t) list + ?restrict: P2p_point.State.t list -> + t -> (P2p_point.Id.t * P2p_point.Info.t) list val events : - ?max:int -> ?rev:bool -> t -> Point.t -> - P2p_connection_pool_types.Point_info.Event.t list + ?max:int -> ?rev:bool -> t -> P2p_point.Id.t -> + P2p_point.Pool_event.t list val watch : - t -> Point.t -> - P2p_connection_pool_types.Point_info.Event.t Lwt_stream.t * Lwt_watcher.stopper + t -> P2p_point.Id.t -> + P2p_point.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper end module Peer_id : sig val info : - t -> Peer_id.t -> P2p_types.Peer_info.t option + t -> P2p_peer.Id.t -> P2p_peer.Info.t option val list : - ?restrict: P2p_types.Peer_state.t list -> - t -> (Peer_id.t * P2p_types.Peer_info.t) list + ?restrict: P2p_peer.State.t list -> + t -> (P2p_peer.Id.t * P2p_peer.Info.t) list val events : ?max: int -> ?rev: bool -> - t -> Peer_id.t -> - P2p_connection_pool_types.Peer_info.Event.t list + t -> P2p_peer.Id.t -> + P2p_peer.Pool_event.t list val watch : - t -> Peer_id.t -> - P2p_connection_pool_types.Peer_info.Event.t Lwt_stream.t * Lwt_watcher.stopper + t -> P2p_peer.Id.t -> + P2p_peer.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper end diff --git a/src/lib_shell/peer_validator.ml b/src/lib_shell/peer_validator.ml index 49ea64c02..b490e3735 100644 --- a/src/lib_shell/peer_validator.ml +++ b/src/lib_shell/peer_validator.ml @@ -12,13 +12,13 @@ open Peer_validator_worker_state module Name = struct - type t = Net_id.t * P2p.Peer_id.t + type t = Net_id.t * P2p_peer.Id.t let encoding = - Data_encoding.tup2 Net_id.encoding P2p.Peer_id.encoding + Data_encoding.tup2 Net_id.encoding P2p_peer.Id.encoding let base = [ "peer_validator" ] let pp ppf (net, peer) = Format.fprintf ppf "%a:%a" - Net_id.pp_short net P2p.Peer_id.pp_short peer + Net_id.pp_short net P2p_peer.Id.pp_short peer end module Request = struct @@ -57,7 +57,7 @@ module Types = struct } type state = { - peer_id: P2p.Peer_id.t ; + peer_id: P2p_peer.Id.t ; parameters : parameters ; mutable bootstrapped: bool ; mutable last_validated_head: Block_header.t ; @@ -96,7 +96,7 @@ let bootstrap_new_branch w _ancestor _head unknown_prefix = let len = Block_locator_iterator.estimated_length unknown_prefix in debug w "validating new branch from peer %a (approx. %d blocks)" - P2p.Peer_id.pp_short pv.peer_id len ; + P2p_peer.Id.pp_short pv.peer_id len ; let pipeline = Bootstrap_pipeline.create ~notify_new_block:pv.parameters.notify_new_block @@ -116,7 +116,7 @@ let bootstrap_new_branch w _ancestor _head unknown_prefix = set_bootstrapped pv ; debug w "done validating new branch from peer %a." - P2p.Peer_id.pp_short pv.peer_id ; + P2p_peer.Id.pp_short pv.peer_id ; return () let validate_new_head w hash (header : Block_header.t) = @@ -127,14 +127,14 @@ let validate_new_head w hash (header : Block_header.t) = debug w "missing predecessor for new head %a from peer %a" Block_hash.pp_short hash - P2p.Peer_id.pp_short pv.peer_id ; + P2p_peer.Id.pp_short pv.peer_id ; Distributed_db.Request.current_branch pv.parameters.net_db ~peer:pv.peer_id () ; return () | true -> debug w "fetching operations for new head %a from peer %a" Block_hash.pp_short hash - P2p.Peer_id.pp_short pv.peer_id ; + P2p_peer.Id.pp_short pv.peer_id ; map_p (fun i -> Worker.protect w begin fun () -> @@ -147,7 +147,7 @@ let validate_new_head w hash (header : Block_header.t) = debug w "requesting validation for new head %a from peer %a" Block_hash.pp_short hash - P2p.Peer_id.pp_short pv.peer_id ; + P2p_peer.Id.pp_short pv.peer_id ; Block_validator.validate ~notify_new_block:pv.parameters.notify_new_block pv.parameters.block_validator pv.parameters.net_db @@ -155,7 +155,7 @@ let validate_new_head w hash (header : Block_header.t) = debug w "end of validation for new head %a from peer %a" Block_hash.pp_short hash - P2p.Peer_id.pp_short pv.peer_id ; + P2p_peer.Id.pp_short pv.peer_id ; set_bootstrapped pv ; return () @@ -170,7 +170,7 @@ let only_if_fitness_increases w distant_header cont = debug w "ignoring head %a with non increasing fitness from peer: %a." Block_hash.pp_short (Block_header.hash distant_header) - P2p.Peer_id.pp_short pv.peer_id ; + P2p_peer.Id.pp_short pv.peer_id ; (* Don't download a branch that cannot beat the current head. *) return () end else cont () @@ -185,7 +185,7 @@ let may_validate_new_head w hash header = debug w "ignoring previously validated block %a from peer %a" Block_hash.pp_short hash - P2p.Peer_id.pp_short pv.peer_id ; + P2p_peer.Id.pp_short pv.peer_id ; set_bootstrapped pv ; pv.last_validated_head <- header ; return () @@ -193,7 +193,7 @@ let may_validate_new_head w hash header = debug w "ignoring known invalid block %a from peer %a" Block_hash.pp_short hash - P2p.Peer_id.pp_short pv.peer_id ; + P2p_peer.Id.pp_short pv.peer_id ; fail Known_invalid end | false -> @@ -210,7 +210,7 @@ let may_validate_new_branch w distant_hash locator = debug w "ignoring branch %a without common ancestor from peer: %a." Block_hash.pp_short distant_hash - P2p.Peer_id.pp_short pv.peer_id ; + P2p_peer.Id.pp_short pv.peer_id ; fail Unknown_ancestor | Some (ancestor, unknown_prefix) -> bootstrap_new_branch w ancestor distant_header unknown_prefix @@ -218,7 +218,7 @@ let may_validate_new_branch w distant_hash locator = let on_no_request w = let pv = Worker.state w in debug w "no new head from peer %a for %g seconds." - P2p.Peer_id.pp_short pv.peer_id + P2p_peer.Id.pp_short pv.peer_id pv.parameters.limits.new_head_request_timeout ; Distributed_db.Request.current_head pv.parameters.net_db ~peer:pv.peer_id () ; return () @@ -230,13 +230,13 @@ let on_request (type a) w (req : a Request.t) : a tzresult Lwt.t = debug w "processing new head %a from peer %a." Block_hash.pp_short hash - P2p.Peer_id.pp_short pv.peer_id ; + P2p_peer.Id.pp_short pv.peer_id ; may_validate_new_head w hash header | Request.New_branch (hash, locator) -> (* TODO penalize empty locator... ?? *) debug w "processing new branch %a from peer %a." Block_hash.pp_short hash - P2p.Peer_id.pp_short pv.peer_id ; + P2p_peer.Id.pp_short pv.peer_id ; may_validate_new_branch w hash locator let on_completion w r _ st = @@ -252,7 +252,7 @@ let on_error w r st errs = (* TODO ban the peer_id... *) debug w "Terminating the validation worker for peer %a (kickban)." - P2p.Peer_id.pp_short pv.peer_id ; + P2p_peer.Id.pp_short pv.peer_id ; debug w "%a" Error_monad.pp_print_error errors ; Worker.trigger_shutdown w ; Worker.record_event w (Event.Request (r, st, Some errs)) ; @@ -269,7 +269,7 @@ let on_error w r st errs = debug w "Terminating the validation worker for peer %a \ (missing protocol %a)." - P2p.Peer_id.pp_short pv.peer_id + P2p_peer.Id.pp_short pv.peer_id Protocol_hash.pp_short protocol ; Worker.record_event w (Event.Request (r, st, Some errs)) ; Lwt.return (Error errs) diff --git a/src/lib_shell/peer_validator.mli b/src/lib_shell/peer_validator.mli index 3fdfb9cd5..9048e75ed 100644 --- a/src/lib_shell/peer_validator.mli +++ b/src/lib_shell/peer_validator.mli @@ -17,7 +17,7 @@ type limits = { worker_limits: Worker_types.limits } -val peer_id: t -> P2p.Peer_id.t +val peer_id: t -> P2p_peer.Id.t val bootstrapped: t -> bool val current_head: t -> Block_header.t @@ -27,13 +27,13 @@ val create: ?notify_termination: (unit -> unit) -> limits -> Block_validator.t -> - Distributed_db.net_db -> P2p.Peer_id.t -> t Lwt.t + Distributed_db.net_db -> P2p_peer.Id.t -> t Lwt.t val shutdown: t -> unit Lwt.t val notify_branch: t -> Block_locator.t -> unit val notify_head: t -> Block_header.t -> unit -val running_workers: unit -> ((Net_id.t * P2p.Peer_id.t) * t) list +val running_workers: unit -> ((Net_id.t * P2p_peer.Id.t) * t) list val status: t -> Worker_types.worker_status val current_request : t -> (Time.t * Time.t * Peer_validator_worker_state.Request.view) option diff --git a/src/lib_shell/prevalidator.mli b/src/lib_shell/prevalidator.mli index a9dd5a465..beb0f00c5 100644 --- a/src/lib_shell/prevalidator.mli +++ b/src/lib_shell/prevalidator.mli @@ -40,7 +40,7 @@ type error += Closed of Net_id.t val create: limits -> Distributed_db.net_db -> t Lwt.t val shutdown: t -> unit Lwt.t -val notify_operations: t -> P2p.Peer_id.t -> Mempool.t -> unit +val notify_operations: t -> P2p_peer.Id.t -> Mempool.t -> unit val inject_operation: t -> Operation.t -> unit tzresult Lwt.t val flush: t -> Block_hash.t -> unit tzresult Lwt.t val timestamp: t -> Time.t diff --git a/src/lib_shell/protocol_validator.mli b/src/lib_shell/protocol_validator.mli index f0f9ac8b9..03135ebc2 100644 --- a/src/lib_shell/protocol_validator.mli +++ b/src/lib_shell/protocol_validator.mli @@ -28,19 +28,19 @@ val shutdown: t -> unit Lwt.t val fetch_and_compile_protocol: t -> - ?peer:P2p.Peer_id.t -> + ?peer:P2p_peer.Id.t -> ?timeout:float -> Protocol_hash.t -> State.Registred_protocol.t tzresult Lwt.t val fetch_and_compile_protocols: t -> - ?peer:P2p.Peer_id.t -> + ?peer:P2p_peer.Id.t -> ?timeout:float -> State.Block.t -> unit tzresult Lwt.t val prefetch_and_compile_protocols: t -> - ?peer:P2p.Peer_id.t -> + ?peer:P2p_peer.Id.t -> ?timeout:float -> State.Block.t -> unit diff --git a/src/lib_shell_services/block_validator_worker_state.ml b/src/lib_shell_services/block_validator_worker_state.ml index 6bcb79e1a..43cf8f34c 100644 --- a/src/lib_shell_services/block_validator_worker_state.ml +++ b/src/lib_shell_services/block_validator_worker_state.ml @@ -11,7 +11,7 @@ module Request = struct type view = { net_id : Net_id.t ; block : Block_hash.t ; - peer : P2p_types.Peer_id.t option ; + peer : P2p_peer.Id.t option ; } let encoding = let open Data_encoding in @@ -21,7 +21,7 @@ module Request = struct (obj3 (req "block" Block_hash.encoding) (req "net_id" Net_id.encoding) - (opt "peer" P2p_types.Peer_id.encoding)) + (opt "peer" P2p_peer.Id.encoding)) let pp ppf { net_id ; block ; peer } = Format.fprintf ppf "Validation of %a (net: %a)" @@ -31,7 +31,7 @@ module Request = struct | None -> () | Some peer -> Format.fprintf ppf "from peer %a" - P2p_types.Peer_id.pp_short peer + P2p_peer.Id.pp_short peer end module Event = struct diff --git a/src/lib_shell_services/block_validator_worker_state.mli b/src/lib_shell_services/block_validator_worker_state.mli index e297cce04..20e7a727c 100644 --- a/src/lib_shell_services/block_validator_worker_state.mli +++ b/src/lib_shell_services/block_validator_worker_state.mli @@ -11,7 +11,7 @@ module Request : sig type view = { net_id : Net_id.t ; block : Block_hash.t ; - peer: P2p_types.Peer_id.t option ; + peer: P2p_peer.Id.t option ; } val encoding : view Data_encoding.encoding val pp : Format.formatter -> view -> unit diff --git a/src/lib_shell_services/net_validator_worker_state.ml b/src/lib_shell_services/net_validator_worker_state.ml index de9eca1dd..27ba18691 100644 --- a/src/lib_shell_services/net_validator_worker_state.ml +++ b/src/lib_shell_services/net_validator_worker_state.ml @@ -89,8 +89,8 @@ end module Worker_state = struct type view = - { active_peers : P2p_types.Peer_id.t list ; - bootstrapped_peers : P2p_types.Peer_id.t list ; + { active_peers : P2p_peer.Id.t list ; + bootstrapped_peers : P2p_peer.Id.t list ; bootstrapped : bool } let encoding = let open Data_encoding in @@ -101,8 +101,8 @@ module Worker_state = struct { bootstrapped ; bootstrapped_peers ; active_peers }) (obj3 (req "bootstrapped" bool) - (req "bootstrapped_peers" (list P2p_types.Peer_id.encoding)) - (req "active_peers" (list P2p_types.Peer_id.encoding))) + (req "bootstrapped_peers" (list P2p_peer.Id.encoding)) + (req "active_peers" (list P2p_peer.Id.encoding))) let pp ppf { bootstrapped ; bootstrapped_peers ; active_peers } = Format.fprintf ppf @@ -110,8 +110,8 @@ module Worker_state = struct @[Active peers:%a@]@,\ @[Bootstrapped peers:%a@]@]" (if bootstrapped then "" else " not yet") - (fun ppf -> List.iter (Format.fprintf ppf "@,- %a" P2p_types.Peer_id.pp)) + (fun ppf -> List.iter (Format.fprintf ppf "@,- %a" P2p_peer.Id.pp)) active_peers - (fun ppf -> List.iter (Format.fprintf ppf "@,- %a" P2p_types.Peer_id.pp)) + (fun ppf -> List.iter (Format.fprintf ppf "@,- %a" P2p_peer.Id.pp)) bootstrapped_peers end diff --git a/src/lib_shell_services/net_validator_worker_state.mli b/src/lib_shell_services/net_validator_worker_state.mli index f3c58b9f7..995c0a522 100644 --- a/src/lib_shell_services/net_validator_worker_state.mli +++ b/src/lib_shell_services/net_validator_worker_state.mli @@ -32,8 +32,8 @@ end module Worker_state : sig type view = - { active_peers : P2p_types.Peer_id.t list ; - bootstrapped_peers : P2p_types.Peer_id.t list ; + { active_peers : P2p_peer.Id.t list ; + bootstrapped_peers : P2p_peer.Id.t list ; bootstrapped : bool } val encoding : view Data_encoding.encoding val pp : Format.formatter -> view -> unit diff --git a/src/lib_shell_services/prevalidator_worker_state.ml b/src/lib_shell_services/prevalidator_worker_state.ml index acaacf1a5..e2ddb748e 100644 --- a/src/lib_shell_services/prevalidator_worker_state.ml +++ b/src/lib_shell_services/prevalidator_worker_state.ml @@ -10,7 +10,7 @@ module Request = struct type 'a t = | Flush : Block_hash.t -> unit t - | Notify : P2p_types.Peer_id.t * Mempool.t -> unit t + | Notify : P2p_peer.Id.t * Mempool.t -> unit t | Inject : Operation.t -> unit tzresult t | Arrived : Operation_hash.t * Operation.t -> unit t | Advertise : unit t @@ -30,7 +30,7 @@ module Request = struct case (Tag 1) (obj3 (req "request" (constant "notify")) - (req "peer" P2p_types.Peer_id.encoding) + (req "peer" P2p_peer.Id.encoding) (req "mempool" Mempool.encoding)) (function View (Notify (peer, mempool)) -> Some ((), peer, mempool) | _ -> None) (fun ((), peer, mempool) -> View (Notify (peer, mempool))) ; @@ -58,7 +58,7 @@ module Request = struct Block_hash.pp hash | Notify (id, { Mempool.known_valid ; pending }) -> Format.fprintf ppf "@[notified by %a of operations" - P2p_types.Peer_id.pp id ; + P2p_peer.Id.pp id ; List.iter (fun oph -> Format.fprintf ppf "@,%a (applied)" diff --git a/src/lib_shell_services/prevalidator_worker_state.mli b/src/lib_shell_services/prevalidator_worker_state.mli index 1365baea8..274033527 100644 --- a/src/lib_shell_services/prevalidator_worker_state.mli +++ b/src/lib_shell_services/prevalidator_worker_state.mli @@ -10,7 +10,7 @@ module Request : sig type 'a t = | Flush : Block_hash.t -> unit t - | Notify : P2p_types.Peer_id.t * Mempool.t -> unit t + | Notify : P2p_peer.Id.t * Mempool.t -> unit t | Inject : Operation.t -> unit tzresult t | Arrived : Operation_hash.t * Operation.t -> unit t | Advertise : unit t diff --git a/src/lib_shell_services/shell_services.ml b/src/lib_shell_services/shell_services.ml index 100a9346a..a613feb5c 100644 --- a/src/lib_shell_services/shell_services.ml +++ b/src/lib_shell_services/shell_services.ml @@ -558,14 +558,14 @@ module Workers = struct ~construct:Net_id.to_b58check () - let (peer_id_arg : P2p_types.Peer_id.t RPC_arg.t) = + let (peer_id_arg : P2p_peer.Id.t RPC_arg.t) = RPC_arg.make ~name:"peer_id" ~descr:"The peer identifier of whom the prevalidator is responsible." ~destruct:(fun s -> try - Ok (P2p_types.Peer_id.of_b58check_exn s) + Ok (P2p_peer.Id.of_b58check_exn s) with Failure msg -> Error msg) - ~construct:P2p_types.Peer_id.to_b58check + ~construct:P2p_peer.Id.to_b58check () let list = @@ -577,7 +577,7 @@ module Workers = struct ~output: (list (obj2 - (req "peer_id" P2p_types.Peer_id.encoding) + (req "peer_id" P2p_peer.Id.encoding) (req "status" (Worker_types.worker_status_encoding RPC_error.encoding)))) RPC_path.(root / "workers" / "peer_validators" /: net_id_arg) diff --git a/src/lib_shell_services/shell_services.mli b/src/lib_shell_services/shell_services.mli index 1b553f194..6c4fd6c4d 100644 --- a/src/lib_shell_services/shell_services.mli +++ b/src/lib_shell_services/shell_services.mli @@ -201,11 +201,11 @@ module Workers : sig val list : ([ `POST ], unit, unit * Net_id.t, unit, unit, - (P2p_types.Peer_id.t * Worker_types.worker_status) list, unit) RPC_service.t + (P2p_peer.Id.t * Worker_types.worker_status) list, unit) RPC_service.t val state : ([ `POST ], unit, - (unit * Net_id.t) * P2p_types.Peer_id.t, unit, unit, + (unit * Net_id.t) * P2p_peer.Id.t, unit, unit, (Request.view, Event.t) Worker_types.full_status, unit) RPC_service.t diff --git a/test/p2p/jbuild b/test/p2p/jbuild index 8eadbb74d..4bb45b8cf 100644 --- a/test/p2p/jbuild +++ b/test/p2p/jbuild @@ -1,8 +1,8 @@ (jbuild_version 1) (executables - ((names (test_p2p_connection - test_p2p_connection_pool + ((names (test_p2p_socket + test_p2p_pool test_p2p_io_scheduler)) (libraries (tezos-base tezos-p2p-services @@ -18,17 +18,17 @@ (alias ((name buildtest) - (deps (test_p2p_connection.exe - test_p2p_connection_pool.exe + (deps (test_p2p_socket.exe + test_p2p_pool.exe test_p2p_io_scheduler.exe)))) (alias - ((name runtest_p2p_connection) - (action (run ${exe:test_p2p_connection.exe} -v)))) + ((name runtest_p2p_socket) + (action (run ${exe:test_p2p_socket.exe} -v)))) (alias - ((name runtest_p2p_connection_pool) - (action (run ${exe:test_p2p_connection_pool.exe} --clients 10 --repeat 5 -v)))) + ((name runtest_p2p_pool) + (action (run ${exe:test_p2p_pool.exe} --clients 10 --repeat 5 -v)))) (alias ((name runtest_p2p_io_scheduler) @@ -40,8 +40,8 @@ (alias ((name runtest) - (deps ((alias runtest_p2p_connection) - (alias runtest_p2p_connection_pool) + (deps ((alias runtest_p2p_socket) + (alias runtest_p2p_pool) (alias runtest_p2p_io_scheduler))))) (alias diff --git a/test/p2p/test_p2p_io_scheduler.ml b/test/p2p/test_p2p_io_scheduler.ml index 42173c753..7c8a8928f 100644 --- a/test/p2p/test_p2p_io_scheduler.ml +++ b/test/p2p/test_p2p_io_scheduler.ml @@ -7,7 +7,6 @@ (* *) (**************************************************************************) -open P2p_types include Logging.Make (struct let name = "test-p2p-io-scheduler" end) exception Error of error list @@ -89,18 +88,18 @@ let server ~read_buffer_size () in Moving_average.on_update begin fun () -> - log_notice "Stat: %a" Stat.pp (P2p_io_scheduler.global_stat sched) ; + log_notice "Stat: %a" P2p_stat.pp (P2p_io_scheduler.global_stat sched) ; if display_client_stat then P2p_io_scheduler.iter_connection sched (fun id conn -> - log_notice " client(%d) %a" id Stat.pp (P2p_io_scheduler.stat conn)) ; + log_notice " client(%d) %a" id P2p_stat.pp (P2p_io_scheduler.stat conn)) ; end ; (* Accept and read message until the connection is closed. *) accept_n main_socket n >>=? fun conns -> let conns = List.map (P2p_io_scheduler.register sched) conns in Lwt.join (List.map receive conns) >>= fun () -> iter_p P2p_io_scheduler.close conns >>=? fun () -> - log_notice "OK %a" Stat.pp (P2p_io_scheduler.global_stat sched) ; + log_notice "OK %a" P2p_stat.pp (P2p_io_scheduler.global_stat sched) ; return () let max_size ?max_upload_speed () = @@ -131,7 +130,7 @@ let client ?max_upload_speed ?write_queue_size addr port time _n = Lwt_unix.sleep time >>= return ] >>=? fun () -> P2p_io_scheduler.close conn >>=? fun () -> let stat = P2p_io_scheduler.stat conn in - lwt_log_notice "Client OK %a" Stat.pp stat >>= fun () -> + lwt_log_notice "Client OK %a" P2p_stat.pp stat >>= fun () -> return () let run diff --git a/test/p2p/test_p2p_connection_pool.ml b/test/p2p/test_p2p_pool.ml similarity index 82% rename from test/p2p/test_p2p_connection_pool.ml rename to test/p2p/test_p2p_pool.ml index 3b1dbc8ea..d078c8309 100644 --- a/test/p2p/test_p2p_connection_pool.ml +++ b/test/p2p/test_p2p_pool.ml @@ -7,16 +7,15 @@ (* *) (**************************************************************************) -open P2p_types include Logging.Make (struct let name = "test.p2p.connection-pool" end) type message = | Ping -let msg_config : message P2p_connection_pool.message_config = { +let msg_config : message P2p_pool.message_config = { encoding = [ - P2p_connection_pool.Encoding { + P2p_pool.Encoding { tag = 0x10 ; encoding = Data_encoding.empty ; wrap = (function () -> Ping) ; @@ -24,12 +23,12 @@ let msg_config : message P2p_connection_pool.message_config = { max_length = None ; } ; ] ; - versions = Version.[ { name = "TEST" ; major = 0 ; minor = 0 } ] ; + versions = P2p_version.[ { name = "TEST" ; major = 0 ; minor = 0 } ] ; } type metadata = unit -let meta_config : metadata P2p_connection_pool.meta_config = { +let meta_config : metadata P2p_pool.meta_config = { encoding = Data_encoding.empty ; initial = () ; score = fun () -> 0. ; @@ -59,9 +58,9 @@ let sync_nodes nodes = let detach_node f points n = let (addr, port), points = List.select n points in let proof_of_work_target = Crypto_box.make_target 0. in - let identity = Identity.generate proof_of_work_target in + let identity = P2p_identity.generate proof_of_work_target in let nb_points = List.length points in - let config = P2p_connection_pool.{ + let config = P2p_pool.{ identity ; proof_of_work_target ; trusted_points = points ; @@ -83,10 +82,10 @@ let detach_node f points n = binary_chunks_size = None } in Process.detach - ~prefix:(Format.asprintf "%a: " Peer_id.pp_short identity.peer_id) + ~prefix:(Format.asprintf "%a: " P2p_peer.Id.pp_short identity.peer_id) begin fun channel -> let sched = P2p_io_scheduler.create ~read_buffer_size:(1 lsl 12) () in - P2p_connection_pool.create + P2p_pool.create config meta_config msg_config sched >>= fun pool -> P2p_welcome.run ~backlog:10 pool ~addr port >>= fun welcome -> lwt_log_info "Node ready (port: %d)" port >>= fun () -> @@ -94,7 +93,7 @@ let detach_node f points n = f channel pool points >>=? fun () -> lwt_log_info "Shutting down..." >>= fun () -> P2p_welcome.shutdown welcome >>= fun () -> - P2p_connection_pool.destroy pool >>= fun () -> + P2p_pool.destroy pool >>= fun () -> P2p_io_scheduler.shutdown sched >>= fun () -> lwt_log_info "Bye." >>= fun () -> return () @@ -112,34 +111,34 @@ type error += Connect | Write | Read module Simple = struct let rec connect ~timeout pool point = - lwt_log_info "Connect to %a" Point.pp point >>= fun () -> - P2p_connection_pool.connect pool point ~timeout >>= function - | Error [P2p_connection_pool.Connected] -> begin - match P2p_connection_pool.Connection.find_by_point pool point with + lwt_log_info "Connect to %a" P2p_point.Id.pp point >>= fun () -> + P2p_pool.connect pool point ~timeout >>= function + | Error [P2p_pool.Connected] -> begin + match P2p_pool.Connection.find_by_point pool point with | Some conn -> return conn | None -> failwith "Woops..." end - | Error ([ P2p_connection_pool.Connection_refused - | P2p_connection_pool.Pending_connection - | P2p_connection.Rejected + | Error ([ P2p_pool.Connection_refused + | P2p_pool.Pending_connection + | P2p_socket.Rejected | Lwt_utils.Canceled | Lwt_utils.Timeout - | P2p_connection_pool.Rejected _ as err ]) -> + | P2p_pool.Rejected _ as err ]) -> lwt_log_info "Connection to %a failed (%a)" - Point.pp point + P2p_point.Id.pp point (fun ppf err -> match err with - | P2p_connection_pool.Connection_refused -> + | P2p_pool.Connection_refused -> Format.fprintf ppf "connection refused" - | P2p_connection_pool.Pending_connection -> + | P2p_pool.Pending_connection -> Format.fprintf ppf "pending connection" - | P2p_connection.Rejected -> + | P2p_socket.Rejected -> Format.fprintf ppf "rejected" | Lwt_utils.Canceled -> Format.fprintf ppf "canceled" | Lwt_utils.Timeout -> Format.fprintf ppf "timeout" - | P2p_connection_pool.Rejected peer -> - Format.fprintf ppf "rejected (%a)" Peer_id.pp peer + | P2p_pool.Rejected peer -> + Format.fprintf ppf "rejected (%a)" P2p_peer.Id.pp peer | _ -> assert false) err >>= fun () -> Lwt_unix.sleep (0.5 +. Random.float 2.) >>= fun () -> connect ~timeout pool point @@ -151,18 +150,18 @@ module Simple = struct let write_all conns msg = iter_p (fun conn -> - trace Write @@ P2p_connection_pool.write_sync conn msg) + trace Write @@ P2p_pool.write_sync conn msg) conns let read_all conns = iter_p (fun conn -> - trace Read @@ P2p_connection_pool.read conn >>=? fun Ping -> + trace Read @@ P2p_pool.read conn >>=? fun Ping -> return ()) conns let close_all conns = - Lwt_list.iter_p P2p_connection_pool.disconnect conns + Lwt_list.iter_p P2p_pool.disconnect conns let node channel pool points = connect_all ~timeout:2. pool points >>=? fun conns -> @@ -187,10 +186,10 @@ module Random_connections = struct let rec connect_random pool total rem point n = Lwt_unix.sleep (0.2 +. Random.float 1.0) >>= fun () -> (trace Connect @@ Simple.connect ~timeout:2. pool point) >>=? fun conn -> - (trace Write @@ P2p_connection_pool.write conn Ping) >>= fun _ -> - (trace Read @@ P2p_connection_pool.read conn) >>=? fun Ping -> + (trace Write @@ P2p_pool.write conn Ping) >>= fun _ -> + (trace Read @@ P2p_pool.read conn) >>=? fun Ping -> Lwt_unix.sleep (0.2 +. Random.float 1.0) >>= fun () -> - P2p_connection_pool.disconnect conn >>= fun () -> + P2p_pool.disconnect conn >>= fun () -> begin decr rem ; if !rem mod total = 0 then @@ -231,7 +230,7 @@ module Garbled = struct let bad_msg = MBytes.of_string (String.make 16 '\000') in iter_p (fun conn -> - trace Write @@ P2p_connection_pool.raw_write_sync conn bad_msg) + trace Write @@ P2p_pool.raw_write_sync conn bad_msg) conns let node ch pool points = diff --git a/test/p2p/test_p2p_connection.ml b/test/p2p/test_p2p_socket.ml similarity index 78% rename from test/p2p/test_p2p_connection.ml rename to test/p2p/test_p2p_socket.ml index f2f802462..d7323d805 100644 --- a/test/p2p/test_p2p_connection.ml +++ b/test/p2p/test_p2p_socket.ml @@ -10,20 +10,19 @@ (* TODO Use Kaputt on the client side and remove `assert` from the server. *) -open P2p_types include Logging.Make (struct let name = "test.p2p.connection" end) let default_addr = Ipaddr.V6.localhost let proof_of_work_target = Crypto_box.make_target 16. -let id1 = Identity.generate proof_of_work_target -let id2 = Identity.generate proof_of_work_target +let id1 = P2p_identity.generate proof_of_work_target +let id2 = P2p_identity.generate proof_of_work_target let id0 = (* Luckilly, this will be an insuficient proof of work! *) - Identity.generate (Crypto_box.make_target 0.) + P2p_identity.generate (Crypto_box.make_target 0.) -let versions = Version.[{ name = "TEST" ; minor = 0 ; major = 0 }] +let versions = P2p_version.[{ name = "TEST" ; minor = 0 ; major = 0 }] let random_bytes len = let msg = MBytes.create len in @@ -104,7 +103,7 @@ let raw_accept sched main_socket = let accept sched main_socket = raw_accept sched main_socket >>= fun (fd, point) -> - P2p_connection.authenticate + P2p_socket.authenticate ~proof_of_work_target ~incoming:true fd point id1 versions @@ -118,11 +117,11 @@ let raw_connect sched addr port = let connect sched addr port id = raw_connect sched addr port >>= fun fd -> - P2p_connection.authenticate + P2p_socket.authenticate ~proof_of_work_target ~incoming:false fd (addr, port) id versions >>=? fun (info, auth_fd) -> _assert (not info.incoming) __LOC__ "" >>=? fun () -> - _assert (Peer_id.compare info.peer_id id1.peer_id = 0) + _assert (P2p_peer.Id.compare info.peer_id id1.peer_id = 0) __LOC__ "" >>=? fun () -> return auth_fd @@ -134,7 +133,7 @@ let is_connection_closed = function false let is_decoding_error = function - | Error [P2p_connection.Decoding_error] -> true + | Error [P2p_socket.Decoding_error] -> true | Ok _ -> false | Error err -> log_notice "Error: %a" pp_print_error err ; @@ -167,7 +166,7 @@ module Kick = struct let encoding = Data_encoding.bytes let is_rejected = function - | Error [P2p_connection.Rejected] -> true + | Error [P2p_socket.Rejected] -> true | Ok _ -> false | Error err -> log_notice "Error: %a" pp_print_error err ; @@ -176,14 +175,14 @@ module Kick = struct let server _ch sched socket = accept sched socket >>=? fun (info, auth_fd) -> _assert (info.incoming) __LOC__ "" >>=? fun () -> - _assert (Peer_id.compare info.peer_id id2.peer_id = 0) + _assert (P2p_peer.Id.compare info.peer_id id2.peer_id = 0) __LOC__ "" >>=? fun () -> - P2p_connection.kick auth_fd >>= fun () -> + P2p_socket.kick auth_fd >>= fun () -> return () let client _ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> - P2p_connection.accept auth_fd encoding >>= fun conn -> + P2p_socket.accept auth_fd encoding >>= fun conn -> _assert (is_rejected conn) __LOC__ "" >>=? fun () -> return () @@ -197,13 +196,13 @@ module Kicked = struct let server _ch sched socket = accept sched socket >>=? fun (_info, auth_fd) -> - P2p_connection.accept auth_fd encoding >>= fun conn -> + P2p_socket.accept auth_fd encoding >>= fun conn -> _assert (Kick.is_rejected conn) __LOC__ "" >>=? fun () -> return () let client _ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> - P2p_connection.kick auth_fd >>= fun () -> + P2p_socket.kick auth_fd >>= fun () -> return () let run _dir = run_nodes client server @@ -219,22 +218,22 @@ module Simple_message = struct let server ch sched socket = accept sched socket >>=? fun (_info, auth_fd) -> - P2p_connection.accept auth_fd encoding >>=? fun conn -> - P2p_connection.write_sync conn simple_msg >>=? fun () -> - P2p_connection.read conn >>=? fun (_msg_size, msg) -> + P2p_socket.accept auth_fd encoding >>=? fun conn -> + P2p_socket.write_sync conn simple_msg >>=? fun () -> + P2p_socket.read conn >>=? fun (_msg_size, msg) -> _assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () -> sync ch >>=? fun () -> - P2p_connection.close conn >>= fun _stat -> + P2p_socket.close conn >>= fun _stat -> return () let client ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> - P2p_connection.accept auth_fd encoding >>=? fun conn -> - P2p_connection.write_sync conn simple_msg2 >>=? fun () -> - P2p_connection.read conn >>=? fun (_msg_size, msg) -> + P2p_socket.accept auth_fd encoding >>=? fun conn -> + P2p_socket.write_sync conn simple_msg2 >>=? fun () -> + P2p_socket.read conn >>=? fun (_msg_size, msg) -> _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () -> sync ch >>=? fun () -> - P2p_connection.close conn >>= fun _stat -> + P2p_socket.close conn >>= fun _stat -> return () let run _dir = run_nodes client server @@ -250,24 +249,24 @@ module Chunked_message = struct let server ch sched socket = accept sched socket >>=? fun (_info, auth_fd) -> - P2p_connection.accept + P2p_socket.accept ~binary_chunks_size:21 auth_fd encoding >>=? fun conn -> - P2p_connection.write_sync conn simple_msg >>=? fun () -> - P2p_connection.read conn >>=? fun (_msg_size, msg) -> + P2p_socket.write_sync conn simple_msg >>=? fun () -> + P2p_socket.read conn >>=? fun (_msg_size, msg) -> _assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () -> sync ch >>=? fun () -> - P2p_connection.close conn >>= fun _stat -> + P2p_socket.close conn >>= fun _stat -> return () let client ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> - P2p_connection.accept + P2p_socket.accept ~binary_chunks_size:21 auth_fd encoding >>=? fun conn -> - P2p_connection.write_sync conn simple_msg2 >>=? fun () -> - P2p_connection.read conn >>=? fun (_msg_size, msg) -> + P2p_socket.write_sync conn simple_msg2 >>=? fun () -> + P2p_socket.read conn >>=? fun (_msg_size, msg) -> _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () -> sync ch >>=? fun () -> - P2p_connection.close conn >>= fun _stat -> + P2p_socket.close conn >>= fun _stat -> return () let run _dir = run_nodes client server @@ -283,22 +282,22 @@ module Oversized_message = struct let server ch sched socket = accept sched socket >>=? fun (_info, auth_fd) -> - P2p_connection.accept auth_fd encoding >>=? fun conn -> - P2p_connection.write_sync conn simple_msg >>=? fun () -> - P2p_connection.read conn >>=? fun (_msg_size, msg) -> + P2p_socket.accept auth_fd encoding >>=? fun conn -> + P2p_socket.write_sync conn simple_msg >>=? fun () -> + P2p_socket.read conn >>=? fun (_msg_size, msg) -> _assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () -> sync ch >>=? fun () -> - P2p_connection.close conn >>= fun _stat -> + P2p_socket.close conn >>= fun _stat -> return () let client ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> - P2p_connection.accept auth_fd encoding >>=? fun conn -> - P2p_connection.write_sync conn simple_msg2 >>=? fun () -> - P2p_connection.read conn >>=? fun (_msg_size, msg) -> + P2p_socket.accept auth_fd encoding >>=? fun conn -> + P2p_socket.write_sync conn simple_msg2 >>=? fun () -> + P2p_socket.read conn >>=? fun (_msg_size, msg) -> _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () -> sync ch >>=? fun () -> - P2p_connection.close conn >>= fun _stat -> + P2p_socket.close conn >>= fun _stat -> return () let run _dir = run_nodes client server @@ -313,18 +312,18 @@ module Close_on_read = struct let server ch sched socket = accept sched socket >>=? fun (_info, auth_fd) -> - P2p_connection.accept auth_fd encoding >>=? fun conn -> + P2p_socket.accept auth_fd encoding >>=? fun conn -> sync ch >>=? fun () -> - P2p_connection.close conn >>= fun _stat -> + P2p_socket.close conn >>= fun _stat -> return () let client ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> - P2p_connection.accept auth_fd encoding >>=? fun conn -> + P2p_socket.accept auth_fd encoding >>=? fun conn -> sync ch >>=? fun () -> - P2p_connection.read conn >>= fun err -> + P2p_socket.read conn >>= fun err -> _assert (is_connection_closed err) __LOC__ "" >>=? fun () -> - P2p_connection.close conn >>= fun _stat -> + P2p_socket.close conn >>= fun _stat -> return () let run _dir = run_nodes client server @@ -339,19 +338,19 @@ module Close_on_write = struct let server ch sched socket = accept sched socket >>=? fun (_info, auth_fd) -> - P2p_connection.accept auth_fd encoding >>=? fun conn -> - P2p_connection.close conn >>= fun _stat -> + P2p_socket.accept auth_fd encoding >>=? fun conn -> + P2p_socket.close conn >>= fun _stat -> sync ch >>=? fun ()-> return () let client ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> - P2p_connection.accept auth_fd encoding >>=? fun conn -> + P2p_socket.accept auth_fd encoding >>=? fun conn -> sync ch >>=? fun ()-> Lwt_unix.sleep 0.1 >>= fun () -> - P2p_connection.write_sync conn simple_msg >>= fun err -> + P2p_socket.write_sync conn simple_msg >>= fun err -> _assert (is_connection_closed err) __LOC__ "" >>=? fun () -> - P2p_connection.close conn >>= fun _stat -> + P2p_socket.close conn >>= fun _stat -> return () let run _dir = run_nodes client server @@ -376,19 +375,19 @@ module Garbled_data = struct let server _ch sched socket = accept sched socket >>=? fun (_info, auth_fd) -> - P2p_connection.accept auth_fd encoding >>=? fun conn -> - P2p_connection.raw_write_sync conn garbled_msg >>=? fun () -> - P2p_connection.read conn >>= fun err -> + P2p_socket.accept auth_fd encoding >>=? fun conn -> + P2p_socket.raw_write_sync conn garbled_msg >>=? fun () -> + P2p_socket.read conn >>= fun err -> _assert (is_connection_closed err) __LOC__ "" >>=? fun () -> - P2p_connection.close conn >>= fun _stat -> + P2p_socket.close conn >>= fun _stat -> return () let client _ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> - P2p_connection.accept auth_fd encoding >>=? fun conn -> - P2p_connection.read conn >>= fun err -> + P2p_socket.accept auth_fd encoding >>=? fun conn -> + P2p_socket.read conn >>= fun err -> _assert (is_decoding_error err) __LOC__ "" >>=? fun () -> - P2p_connection.close conn >>= fun _stat -> + P2p_socket.close conn >>= fun _stat -> return () let run _dir = run_nodes client server