2016-09-08 21:13:10 +04:00
|
|
|
(**************************************************************************)
|
|
|
|
(* *)
|
2017-11-14 03:36:14 +04:00
|
|
|
(* Copyright (c) 2014 - 2017. *)
|
2016-09-08 21:13:10 +04:00
|
|
|
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
|
|
(* *)
|
|
|
|
(* All rights reserved. No warranty, explicit or implicit, provided. *)
|
|
|
|
(* *)
|
|
|
|
(**************************************************************************)
|
|
|
|
|
|
|
|
(** A peer connection address *)
|
2017-01-14 16:14:17 +04:00
|
|
|
type addr = Ipaddr.V6.t
|
2016-09-08 21:13:10 +04:00
|
|
|
|
|
|
|
(** A peer connection port *)
|
|
|
|
type port = int
|
|
|
|
|
2016-11-07 17:32:10 +04:00
|
|
|
(** A p2p protocol version *)
|
2017-01-14 16:14:17 +04:00
|
|
|
module Version = P2p_types.Version
|
|
|
|
|
|
|
|
(** A global identifier for a peer, a.k.a. an identity *)
|
2017-02-24 06:50:33 +04:00
|
|
|
module Peer_id = P2p_types.Peer_id
|
2017-01-14 16:14:17 +04:00
|
|
|
|
|
|
|
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
|
2016-09-08 21:13:10 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
type 'meta meta_config = {
|
|
|
|
encoding : 'meta Data_encoding.t;
|
|
|
|
initial : 'meta;
|
2017-01-24 17:36:42 +04:00
|
|
|
score : 'meta -> float
|
2017-01-16 21:38:40 +04:00
|
|
|
}
|
|
|
|
|
|
|
|
type 'msg app_message_encoding = Encoding : {
|
|
|
|
tag: int ;
|
|
|
|
encoding: 'a Data_encoding.t ;
|
|
|
|
wrap: 'a -> 'msg ;
|
|
|
|
unwrap: 'msg -> 'a option ;
|
|
|
|
max_length: int option ;
|
|
|
|
} -> 'msg app_message_encoding
|
|
|
|
|
|
|
|
type 'msg message_config = {
|
|
|
|
encoding : 'msg app_message_encoding list ;
|
|
|
|
versions : Version.t list;
|
|
|
|
}
|
|
|
|
|
2016-09-08 21:13:10 +04:00
|
|
|
(** Network configuration *)
|
|
|
|
type config = {
|
2017-01-14 16:14:17 +04:00
|
|
|
|
|
|
|
listening_port : port option;
|
2016-09-08 21:13:10 +04:00
|
|
|
(** Tells if incoming connections accepted, precising the TCP port
|
2016-11-07 17:32:10 +04:00
|
|
|
on which the peer can be reached *)
|
2017-01-14 16:14:17 +04:00
|
|
|
|
|
|
|
listening_addr : addr option;
|
|
|
|
(** When incoming connections are accepted, precising on which
|
|
|
|
IP adddress the node listen (default: [[::]]). *)
|
|
|
|
|
|
|
|
trusted_points : Point.t list ;
|
|
|
|
(** List of hard-coded known peers to bootstrap the network from. *)
|
|
|
|
|
2016-09-08 21:13:10 +04:00
|
|
|
peers_file : string ;
|
2017-01-14 16:14:17 +04:00
|
|
|
(** The path to the JSON file where the metadata associated to
|
2017-02-24 06:50:33 +04:00
|
|
|
peer_ids are loaded / stored. *)
|
2017-01-14 16:14:17 +04:00
|
|
|
|
2016-09-08 21:13:10 +04:00
|
|
|
closed_network : bool ;
|
2017-01-14 16:14:17 +04:00
|
|
|
(** If [true], the only accepted connections are from peers whose
|
|
|
|
addresses are in [trusted_peers]. *)
|
|
|
|
|
|
|
|
identity : Identity.t ;
|
|
|
|
(** Cryptographic identity of the peer. *)
|
|
|
|
|
|
|
|
proof_of_work_target : Crypto_box.target ;
|
|
|
|
(** Expected level of proof of work of peers' identity. *)
|
|
|
|
|
2016-09-08 21:13:10 +04:00
|
|
|
}
|
|
|
|
|
|
|
|
(** Network capacities *)
|
|
|
|
type limits = {
|
2017-01-14 16:14:17 +04:00
|
|
|
|
|
|
|
authentification_timeout : float ;
|
|
|
|
(** Delay granted to a peer to perform authentication, in seconds. *)
|
|
|
|
|
2016-09-08 21:13:10 +04:00
|
|
|
min_connections : int ;
|
2017-01-14 16:14:17 +04:00
|
|
|
(** Strict minimum number of connections (triggers an urgent maintenance) *)
|
|
|
|
|
|
|
|
expected_connections : int ;
|
2017-01-30 22:10:16 +04:00
|
|
|
(** Targeted number of connections to reach when bootstraping / maintaining *)
|
2017-01-14 16:14:17 +04:00
|
|
|
|
2016-09-08 21:13:10 +04:00
|
|
|
max_connections : int ;
|
2017-01-14 16:14:17 +04:00
|
|
|
(** Maximum number of connections (exceeding peers are disconnected) *)
|
2016-09-08 21:13:10 +04:00
|
|
|
|
2017-01-14 16:14:17 +04:00
|
|
|
backlog : int ;
|
|
|
|
(** Argument of [Lwt_unix.accept].*)
|
|
|
|
|
|
|
|
max_incoming_connections : int ;
|
2017-01-30 22:10:16 +04:00
|
|
|
(** Maximum not-yet-authenticated incoming connections. *)
|
2016-11-15 04:33:12 +04:00
|
|
|
|
2017-01-14 16:14:17 +04:00
|
|
|
max_download_speed : int option ;
|
|
|
|
(** Hard-limit in the number of bytes received per second. *)
|
2016-11-07 17:32:10 +04:00
|
|
|
|
2017-01-14 16:14:17 +04:00
|
|
|
max_upload_speed : int option ;
|
|
|
|
(** Hard-limit in the number of bytes sent per second. *)
|
2016-11-07 17:32:10 +04:00
|
|
|
|
2017-01-14 16:14:17 +04:00
|
|
|
read_buffer_size : int ;
|
|
|
|
(** Size in bytes of the buffer passed to [Lwt_unix.read]. *)
|
2016-11-07 17:32:10 +04:00
|
|
|
|
2017-01-14 16:14:17 +04:00
|
|
|
read_queue_size : int option ;
|
|
|
|
write_queue_size : int option ;
|
|
|
|
incoming_app_message_queue_size : int option ;
|
|
|
|
incoming_message_queue_size : int option ;
|
|
|
|
outgoing_message_queue_size : int option ;
|
|
|
|
(** Various bounds for internal queues. *)
|
2016-11-15 04:52:39 +04:00
|
|
|
|
2017-02-24 06:50:33 +04:00
|
|
|
known_peer_ids_history_size : int ;
|
2017-01-24 17:36:42 +04:00
|
|
|
known_points_history_size : int ;
|
|
|
|
(** Size of circular log buffers, in number of events recorded. *)
|
|
|
|
|
2017-02-24 06:50:33 +04:00
|
|
|
max_known_peer_ids : (int * int) option ;
|
2017-01-24 17:36:42 +04:00
|
|
|
max_known_points : (int * int) option ;
|
|
|
|
(** Optional limitation of internal hashtables (max, target) *)
|
2017-03-14 13:51:44 +04:00
|
|
|
|
|
|
|
swap_linger : float ;
|
|
|
|
(** Peer swapping does not occur more than once during a timespan of
|
|
|
|
[swap_linger] seconds. *)
|
|
|
|
|
2017-04-18 20:32:31 +04:00
|
|
|
binary_chunks_size : int option ;
|
|
|
|
(** Size (in bytes) of binary blocks that are sent to other
|
|
|
|
peers. Default value is 64 kB. Max value is 64kB. *)
|
|
|
|
|
2017-01-14 16:14:17 +04:00
|
|
|
}
|
2016-11-15 04:52:39 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
type ('msg, 'meta) t
|
|
|
|
type ('msg, 'meta) net = ('msg, 'meta) t
|
2016-11-07 17:32:10 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
(** A faked p2p layer, which do not initiate any connection
|
|
|
|
nor open any listening socket *)
|
2017-03-14 13:51:44 +04:00
|
|
|
val faked_network : 'meta meta_config -> ('msg, 'meta) net
|
2016-11-15 04:52:39 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
(** Main network initialisation function *)
|
2017-01-23 14:10:02 +04:00
|
|
|
val create :
|
2017-01-16 21:38:40 +04:00
|
|
|
config:config -> limits:limits ->
|
2017-04-18 20:13:46 +04:00
|
|
|
'meta meta_config -> 'msg message_config -> ('msg, 'meta) net tzresult Lwt.t
|
2016-11-07 17:32:10 +04:00
|
|
|
|
2017-02-24 06:50:33 +04:00
|
|
|
(** Return one's peer_id *)
|
|
|
|
val peer_id : ('msg, 'meta) net -> Peer_id.t
|
2016-11-15 04:52:39 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
(** A maintenance operation : try and reach the ideal number of peers *)
|
|
|
|
val maintain : ('msg, 'meta) net -> unit Lwt.t
|
2016-11-07 17:32:10 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
(** Voluntarily drop some peers and replace them by new buddies *)
|
|
|
|
val roll : ('msg, 'meta) net -> unit Lwt.t
|
2016-11-07 17:32:10 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
(** Close all connections properly *)
|
|
|
|
val shutdown : ('msg, 'meta) net -> unit Lwt.t
|
2016-11-07 17:32:10 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
(** A connection to a peer *)
|
|
|
|
type ('msg, 'meta) connection
|
2016-11-29 02:01:37 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
(** Access the domain of active peers *)
|
|
|
|
val connections : ('msg, 'meta) net -> ('msg, 'meta) connection list
|
2016-11-07 17:32:10 +04:00
|
|
|
|
2017-02-24 06:50:33 +04:00
|
|
|
(** Return the active peer with identity [peer_id] *)
|
|
|
|
val find_connection : ('msg, 'meta) net -> Peer_id.t -> ('msg, 'meta) connection option
|
2016-11-07 17:32:10 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
(** Access the info of an active peer, if available *)
|
|
|
|
val connection_info :
|
|
|
|
('msg, 'meta) net -> ('msg, 'meta) connection -> Connection_info.t
|
|
|
|
val connection_stat :
|
|
|
|
('msg, 'meta) net -> ('msg, 'meta) connection -> Stat.t
|
2017-09-29 20:43:13 +04:00
|
|
|
|
|
|
|
(** Cleanly closes a connection. *)
|
|
|
|
val disconnect :
|
|
|
|
('msg, 'meta) net -> ?wait:bool -> ('msg, 'meta) connection -> unit Lwt.t
|
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
val global_stat : ('msg, 'meta) net -> Stat.t
|
2016-11-07 17:32:10 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
(** Accessors for meta information about a global identifier *)
|
2017-03-14 13:51:44 +04:00
|
|
|
val get_metadata : ('msg, 'meta) net -> Peer_id.t -> 'meta
|
2017-02-24 06:50:33 +04:00
|
|
|
val set_metadata : ('msg, 'meta) net -> Peer_id.t -> 'meta -> unit
|
2016-09-08 21:13:10 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
(** Wait for a message from a given connection. *)
|
|
|
|
val recv :
|
|
|
|
('msg, 'meta) net -> ('msg, 'meta) connection -> 'msg tzresult Lwt.t
|
2016-09-08 21:13:10 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
(** Wait for a message from any active connections. *)
|
|
|
|
val recv_any :
|
|
|
|
('msg, 'meta) net -> (('msg, 'meta) connection * 'msg) Lwt.t
|
2016-09-08 21:13:10 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
(** [send net peer msg] is a thread that returns when [msg] has been
|
|
|
|
successfully enqueued in the send queue. *)
|
|
|
|
val send :
|
2017-02-24 20:17:53 +04:00
|
|
|
('msg, 'meta) net -> ('msg, 'meta) connection -> 'msg -> unit tzresult Lwt.t
|
2016-09-08 21:13:10 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
(** [try_send net peer msg] is [true] if [msg] has been added to the
|
|
|
|
send queue for [peer], [false] otherwise *)
|
|
|
|
val try_send :
|
|
|
|
('msg, 'meta) net -> ('msg, 'meta) connection -> 'msg -> bool
|
2016-09-08 21:13:10 +04:00
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
(** Send a message to all peers *)
|
|
|
|
val broadcast : ('msg, 'meta) net -> 'msg -> unit
|
2016-11-15 04:52:39 +04:00
|
|
|
|
2017-02-17 22:12:06 +04:00
|
|
|
module RPC : sig
|
|
|
|
|
|
|
|
val stat : ('msg, 'meta) net -> Stat.t
|
|
|
|
|
2017-03-14 13:51:44 +04:00
|
|
|
module Event = P2p_connection_pool.Log_event
|
2017-02-17 22:12:06 +04:00
|
|
|
|
|
|
|
val watch : ('msg, 'meta) net -> Event.t Lwt_stream.t * Watcher.stopper
|
|
|
|
val connect : ('msg, 'meta) net -> Point.t -> float -> unit tzresult Lwt.t
|
|
|
|
|
|
|
|
module Connection : sig
|
2017-02-24 06:50:33 +04:00
|
|
|
val info : ('msg, 'meta) net -> Peer_id.t -> Connection_info.t option
|
|
|
|
val kick : ('msg, 'meta) net -> Peer_id.t -> bool -> unit Lwt.t
|
2017-02-17 22:12:06 +04:00
|
|
|
val list : ('msg, 'meta) net -> Connection_info.t list
|
|
|
|
val count : ('msg, 'meta) net -> int
|
|
|
|
end
|
|
|
|
|
|
|
|
module Point : sig
|
2017-03-02 18:39:36 +04:00
|
|
|
include module type of Point
|
2017-02-17 22:12:06 +04:00
|
|
|
|
|
|
|
type state =
|
|
|
|
| Requested
|
2017-03-02 18:39:36 +04:00
|
|
|
| Accepted of Peer_id.t
|
|
|
|
| Running of Peer_id.t
|
2017-02-17 22:12:06 +04:00
|
|
|
| Disconnected
|
|
|
|
|
2017-03-02 18:39:36 +04:00
|
|
|
val pp_state_digram : Format.formatter -> state -> unit
|
2017-02-17 22:12:06 +04:00
|
|
|
val state_encoding : state Data_encoding.t
|
|
|
|
|
|
|
|
type info = {
|
|
|
|
trusted : bool ;
|
2017-02-24 19:20:10 +04:00
|
|
|
greylisted_until : Time.t ;
|
2017-02-17 22:12:06 +04:00
|
|
|
state : state ;
|
|
|
|
last_failed_connection : Time.t option ;
|
2017-02-24 06:50:33 +04:00
|
|
|
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 ;
|
2017-02-17 22:12:06 +04:00
|
|
|
last_miss : Time.t option ;
|
|
|
|
}
|
|
|
|
|
|
|
|
val info_encoding : info Data_encoding.t
|
|
|
|
|
|
|
|
module Event = P2p_connection_pool_types.Point_info.Event
|
|
|
|
|
|
|
|
val info :
|
|
|
|
('msg, 'meta) net -> Point.t -> info option
|
2017-03-02 18:39:36 +04:00
|
|
|
val list :
|
2017-02-17 22:12:06 +04:00
|
|
|
?restrict:state list -> ('msg, 'meta) net -> (Point.t * info) list
|
|
|
|
val events :
|
|
|
|
?max:int -> ?rev:bool -> ('msg, 'meta) net -> Point.t -> Event.t list
|
|
|
|
val watch :
|
|
|
|
('msg, 'meta) net -> Point.t -> Event.t Lwt_stream.t * Watcher.stopper
|
|
|
|
end
|
|
|
|
|
2017-02-24 06:50:33 +04:00
|
|
|
module Peer_id : sig
|
2017-03-02 18:39:36 +04:00
|
|
|
include module type of Peer_id
|
2017-02-17 22:12:06 +04:00
|
|
|
|
|
|
|
type state =
|
|
|
|
| Accepted
|
|
|
|
| Running
|
|
|
|
| Disconnected
|
|
|
|
|
2017-03-02 18:39:36 +04:00
|
|
|
val pp_state_digram : Format.formatter -> state -> unit
|
2017-02-17 22:12:06 +04:00
|
|
|
val state_encoding : state Data_encoding.t
|
|
|
|
|
|
|
|
type info = {
|
|
|
|
score : float ;
|
|
|
|
trusted : bool ;
|
|
|
|
state : state ;
|
|
|
|
id_point : Id_point.t option ;
|
|
|
|
stat : Stat.t ;
|
|
|
|
last_failed_connection : (Id_point.t * Time.t) option ;
|
|
|
|
last_rejected_connection : (Id_point.t * Time.t) option ;
|
|
|
|
last_established_connection : (Id_point.t * Time.t) option ;
|
|
|
|
last_disconnection : (Id_point.t * Time.t) option ;
|
|
|
|
last_seen : (Id_point.t * Time.t) option ;
|
|
|
|
last_miss : (Id_point.t * Time.t) option ;
|
|
|
|
}
|
|
|
|
val info_encoding : info Data_encoding.t
|
|
|
|
|
2017-02-24 06:50:33 +04:00
|
|
|
module Event = P2p_connection_pool_types.Peer_info.Event
|
2017-02-17 22:12:06 +04:00
|
|
|
|
2017-02-24 06:50:33 +04:00
|
|
|
val info :
|
|
|
|
('msg, 'meta) net -> Peer_id.t -> info option
|
2017-03-02 18:39:36 +04:00
|
|
|
val list :
|
2017-02-24 06:50:33 +04:00
|
|
|
?restrict:state list -> ('msg, 'meta) net -> (Peer_id.t * info) list
|
|
|
|
val events :
|
|
|
|
?max:int -> ?rev:bool -> ('msg, 'meta) net -> Peer_id.t -> Event.t list
|
|
|
|
val watch :
|
|
|
|
('msg, 'meta) net -> Peer_id.t -> Event.t Lwt_stream.t * Watcher.stopper
|
2017-02-17 22:12:06 +04:00
|
|
|
|
|
|
|
end
|
|
|
|
|
|
|
|
end
|
|
|
|
|
2017-02-24 20:17:53 +04:00
|
|
|
val fold_connections :
|
|
|
|
('msg, 'meta) net ->
|
|
|
|
init:'a -> f:(Peer_id.t -> ('msg, 'meta) connection -> 'a -> 'a) -> 'a
|
|
|
|
|
|
|
|
val iter_connections :
|
|
|
|
('msg, 'meta) net ->
|
|
|
|
(Peer_id.t -> ('msg, 'meta) connection -> unit) -> unit
|
|
|
|
|
|
|
|
val on_new_connection :
|
|
|
|
('msg, 'meta) net ->
|
|
|
|
(Peer_id.t -> ('msg, 'meta) connection -> unit) -> unit
|
|
|
|
|
2017-01-16 21:38:40 +04:00
|
|
|
(**/**)
|
|
|
|
module Raw : sig
|
|
|
|
type 'a t =
|
|
|
|
| Bootstrap
|
|
|
|
| Advertise of P2p_types.Point.t list
|
2017-03-14 13:51:44 +04:00
|
|
|
| Swap_request of Point.t * Peer_id.t
|
|
|
|
| Swap_ack of Point.t * Peer_id.t
|
2017-01-16 21:38:40 +04:00
|
|
|
| Message of 'a
|
|
|
|
| Disconnect
|
|
|
|
val encoding: 'msg app_message_encoding list -> 'msg t Data_encoding.t
|
2016-11-07 17:32:10 +04:00
|
|
|
end
|
2017-01-16 21:38:40 +04:00
|
|
|
|