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

Shell/P2p: minor renaming.

Browse Source
This commit is contained in:
Grégoire Henry 2016-11-15 01:52:39 +01:00
parent cbfab86f25
commit 6afcc1ecdd
4 changed files with 110 additions and 163 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

190
src/node/net/p2p.ml
View File

@ -7,6 +7,12 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
module LU = Lwt_unix
module LC = Lwt_condition
open Lwt
open Lwt_utils
open Logging.Net
(* public types *) (* public types *)
type addr = Ipaddr.t type addr = Ipaddr.t
type port = int type port = int
@ -47,110 +53,12 @@ type gid = string
let gid_length = 16 let gid_length = 16
type 'msg msg_encoding = Encoding : { let pp_gid ppf gid =
tag: int ;
encoding: 'a Data_encoding.t ;
wrap: 'a -> 'msg ;
unwrap: 'msg -> 'a option ;
max_length: int option ;
} -> 'msg msg_encoding
module type NET_PARAMS = sig
type meta (** Type of metadata associated to an identity *)
type msg (** Type of message used by higher layers *)
val msg_encodings : msg msg_encoding list
val init_meta : meta
val score_enc : meta Data_encoding.t
val score: meta -> float
(** High level protocol(s) talked by the peer. When two peers
initiate a connection, they exchange their list of supported
versions. The chosen one, if any, is the maximum common one (in
lexicographic order) *)
val supported_versions : version list
end
module type S = sig
include NET_PARAMS
type net
(** A faked p2p layer, which do not initiate any connection
nor open any listening socket. *)
val faked_network : net
(** Main network initialisation function *)
val bootstrap : config:config -> limits:limits -> net Lwt.t
(** A maintenance operation : try and reach the ideal number of peers *)
val maintain : net -> unit Lwt.t
(** Voluntarily drop some peers and replace them by new buddies *)
val roll : net -> unit Lwt.t
(** Close all connections properly *)
val shutdown : net -> unit Lwt.t
(** A connection to a peer *)
type peer
(** Access the domain of active peers *)
val peers : net -> peer list
(** Return the active peer with identity [gid] *)
val find_peer : net -> gid -> peer option
type peer_info = {
gid : gid;
addr : addr;
port : port;
version : version;
}
(** Access the info of an active peer, if available *)
val peer_info : net -> peer -> peer_info
(** Accessors for meta information about a peer *)
val get_meta : net -> gid -> meta option
val set_meta : net -> gid -> meta -> unit
(** Wait for a payload from any peer in the network *)
val recv : net -> (peer * msg) Lwt.t
(** Send a payload to a peer and wait for it to be in the tube *)
val send : net -> peer -> msg -> unit Lwt.t
(** Send a payload to a peer without waiting for the result. Return
[true] if the message can be enqueued in the peer's output queue
or [false] otherwise. *)
val try_send : net -> peer -> msg -> bool
(** Send a payload to all peers *)
val broadcast : net -> msg -> unit
(** Shutdown the connection to all peers at this address and stop the
communications with this machine for [duration] seconds *)
val blacklist : net -> gid -> unit
(** Keep a connection to this pair as often as possible *)
val whitelist : net -> gid -> unit
end
module Make (P: NET_PARAMS) = struct
module LU = Lwt_unix
module LC = Lwt_condition
open Lwt
open Lwt_utils
open Logging.Net
let pp_gid ppf gid =
Format.pp_print_string ppf (Hex_encode.hex_encode gid) Format.pp_print_string ppf (Hex_encode.hex_encode gid)
(* the common version for a pair of peers, if any, is the maximum one, (* the common version for a pair of peers, if any, is the maximum one,
in lexicographic order *) in lexicographic order *)
let common_version la lb = let common_version la lb =
let la = List.sort (fun l r -> compare r l) la in 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 lb = List.sort (fun l r -> compare r l) lb in
let rec find = function let rec find = function
@ -161,10 +69,10 @@ module Make (P: NET_PARAMS) = struct
else find (la, tb) else find (la, tb)
in find (la, lb) in find (la, lb)
(* A net point (address x port). *) (* A net point (address x port). *)
type point = addr * port type point = addr * port
let point_encoding = let point_encoding =
let open Data_encoding in let open Data_encoding in
let open Ipaddr in let open Ipaddr in
conv conv
@ -181,6 +89,38 @@ module Make (P: NET_PARAMS) = struct
(req "addr" string) (req "addr" string)
(req "port" int16)) (req "port" int16))
type 'msg encoding = Encoding : {
tag: int ;
encoding: 'a Data_encoding.t ;
wrap: 'a -> 'msg ;
unwrap: 'msg -> 'a option ;
max_length: int option ;
} -> 'msg encoding
module type PARAMS = sig
(** Type of message used by higher layers *)
type msg
val encodings : msg encoding list
(** Type of metadata associated to an identity *)
type metadata
val initial_metadata : metadata
val metadata_encoding : metadata Data_encoding.t
val score : metadata -> float
(** High level protocol(s) talked by the peer. When two peers
initiate a connection, they exchange their list of supported
versions. The chosen one, if any, is the maximum common one (in
lexicographic order) *)
val supported_versions : version list
end
module Make (P: PARAMS) = struct
(* Low-level network protocol packets (internal). The protocol is (* Low-level network protocol packets (internal). The protocol is
completely symmetrical and asynchronous. First both peers must completely symmetrical and asynchronous. First both peers must
present their credentials with a [Connect] packet, then any present their credentials with a [Connect] packet, then any
@ -236,7 +176,7 @@ module Make (P: NET_PARAMS) = struct
(function Bootstrap -> Some () | _ -> None) (function Bootstrap -> Some () | _ -> None)
(fun () -> Bootstrap); (fun () -> Bootstrap);
] @ ] @
ListLabels.map P.msg_encodings ~f:begin function Encoding { tag; encoding; wrap; unwrap } -> ListLabels.map P.encodings ~f:begin function Encoding { tag; encoding; wrap; unwrap } ->
case ~tag encoding case ~tag encoding
(function Message msg -> unwrap msg | _ -> None) (function Message msg -> unwrap msg | _ -> None)
(fun msg -> Message (wrap msg)) (fun msg -> Message (wrap msg))
@ -250,7 +190,7 @@ module Make (P: NET_PARAMS) = struct
| 3 -> Some 0 | 3 -> Some 0
| 4 -> Some (1 + 1000 * 17) (* tag + 1000 * max (point size) *) | 4 -> Some (1 + 1000 * 17) (* tag + 1000 * max (point size) *)
| 5 -> Some 0 | 5 -> Some 0
| n -> ListLabels.fold_left P.msg_encodings ~init:None ~f:begin fun a -> function | n -> ListLabels.fold_left P.encodings ~init:None ~f:begin fun a -> function
Encoding { tag; max_length } -> if tag = n then max_length else a Encoding { tag; max_length } -> if tag = n then max_length else a
end end
@ -359,8 +299,8 @@ module Make (P: NET_PARAMS) = struct
peers : unit -> peer list ; peers : unit -> peer list ;
find_peer : gid -> peer option ; find_peer : gid -> peer option ;
peer_info : peer -> peer_info ; peer_info : peer -> peer_info ;
set_meta : gid -> P.meta -> unit ; set_metadata : gid -> P.metadata -> unit ;
get_meta : gid -> P.meta option ; get_metadata : gid -> P.metadata option ;
} }
(* The (internal) type of network events, those dispatched from peer (* The (internal) type of network events, those dispatched from peer
@ -639,7 +579,7 @@ module Make (P: NET_PARAMS) = struct
unreachable_since : float option; unreachable_since : float option;
connections : (int * float) option ; connections : (int * float) option ;
white_listed : bool ; white_listed : bool ;
meta : P.meta ; meta : P.metadata ;
} }
(* Ad hoc comparison on sources such as good source < bad source *) (* Ad hoc comparison on sources such as good source < bad source *)
@ -789,7 +729,7 @@ module Make (P: NET_PARAMS) = struct
let source = { unreachable_since = None ; let source = { unreachable_since = None ;
connections = None ; connections = None ;
white_listed = true ; white_listed = true ;
meta = P.init_meta ; meta = P.initial_metadata ;
} }
in in
List.fold_left List.fold_left
@ -821,14 +761,14 @@ module Make (P: NET_PARAMS) = struct
{ unreachable_since = None ; { unreachable_since = None ;
connections = None ; connections = None ;
white_listed = true ; white_listed = true ;
meta = P.init_meta ; } in meta = P.initial_metadata ; } in
PeerMap.update (addr, port) source r PeerMap.update (addr, port) source r
| Some (c, t, gid) -> | Some (c, t, gid) ->
let source = let source =
{ unreachable_since = None ; { unreachable_since = None ;
connections = Some (c, t) ; connections = Some (c, t) ;
white_listed = PointSet.mem (addr, port) white_list ; white_listed = PointSet.mem (addr, port) white_list ;
meta = P.init_meta ; } in meta = P.initial_metadata ; } in
PeerMap.update (addr, port) ~gid source r) PeerMap.update (addr, port) ~gid source r)
PeerMap.empty k in PeerMap.empty k in
let black_list = let black_list =
@ -1066,17 +1006,17 @@ module Make (P: NET_PARAMS) = struct
{ connections = Some (1, Unix.gettimeofday ()) ; { connections = Some (1, Unix.gettimeofday ()) ;
unreachable_since = None ; unreachable_since = None ;
white_listed ; white_listed ;
meta = P.init_meta } meta = P.initial_metadata }
| { connections = Some (n, _) ; white_listed } -> | { connections = Some (n, _) ; white_listed } ->
{ connections = Some (n + 1, Unix.gettimeofday ()) ; { connections = Some (n + 1, Unix.gettimeofday ()) ;
unreachable_since = None ; unreachable_since = None ;
white_listed ; white_listed ;
meta = P.init_meta } meta = P.initial_metadata }
with Not_found -> with Not_found ->
{ connections = Some (1, Unix.gettimeofday ()) ; { connections = Some (1, Unix.gettimeofday ()) ;
unreachable_since = None ; unreachable_since = None ;
white_listed = white_listed point ; white_listed = white_listed point ;
meta = P.init_meta } meta = P.initial_metadata }
in in
(* if it's me, it's probably not me *) (* if it's me, it's probably not me *)
if my_gid = peer.gid then begin if my_gid = peer.gid then begin
@ -1136,7 +1076,7 @@ module Make (P: NET_PARAMS) = struct
{ unreachable_since = None ; { unreachable_since = None ;
connections = None ; connections = None ;
white_listed = false ; white_listed = false ;
meta = P.init_meta } in meta = P.initial_metadata } in
known_peers := PeerMap.update point source !known_peers ; known_peers := PeerMap.update point source !known_peers ;
LC.broadcast new_contact point) LC.broadcast new_contact point)
peers ; peers ;
@ -1276,7 +1216,7 @@ module Make (P: NET_PARAMS) = struct
{ unreachable_since = None ; { unreachable_since = None ;
connections = None ; connections = None ;
white_listed = true ; white_listed = true ;
meta = P.init_meta }, meta = P.initial_metadata },
None in None in
known_peers := PeerMap.update point ?gid source !known_peers known_peers := PeerMap.update point ?gid source !known_peers
and whitelist peer = and whitelist peer =
@ -1292,11 +1232,11 @@ module Make (P: NET_PARAMS) = struct
LC.broadcast please_maintain () ; LC.broadcast please_maintain () ;
waiter waiter
and roll () = Pervasives.failwith "roll" and roll () = Pervasives.failwith "roll"
and get_meta _gid = None (* TODO: implement *) and get_metadata _gid = None (* TODO: implement *)
and set_meta _gid _meta = () (* TODO: implement *) and set_metadata _gid _meta = () (* TODO: implement *)
in in
let net = { shutdown ; peers ; find_peer ; recv_from ; send_to ; try_send ; broadcast ; let net = { shutdown ; peers ; find_peer ; recv_from ; send_to ; try_send ; broadcast ;
blacklist ; whitelist ; maintain ; roll ; peer_info ; get_meta ; set_meta } in blacklist ; whitelist ; maintain ; roll ; peer_info ; get_metadata ; set_metadata } in
(* main thread, returns after first successful maintenance *) (* main thread, returns after first successful maintenance *)
maintain () >>= fun () -> maintain () >>= fun () ->
debug "(%a) network succesfully bootstrapped" pp_gid my_gid ; debug "(%a) network succesfully bootstrapped" pp_gid my_gid ;
@ -1318,10 +1258,10 @@ module Make (P: NET_PARAMS) = struct
let maintain () = Lwt.return_unit in let maintain () = Lwt.return_unit in
let roll () = Lwt.return_unit in let roll () = Lwt.return_unit in
let peer_info _ = assert false in let peer_info _ = assert false in
let get_meta _ = None in let get_metadata _ = None in
let set_meta _ _ = () in let set_metadata _ _ = () in
{ shutdown ; peers ; find_peer ; recv_from ; send_to ; try_send ; broadcast ; { shutdown ; peers ; find_peer ; recv_from ; send_to ; try_send ; broadcast ;
blacklist ; whitelist ; maintain ; roll ; peer_info ; get_meta ; set_meta } blacklist ; whitelist ; maintain ; roll ; peer_info ; get_metadata ; set_metadata }
(* Plug toplevel functions to callback calls. *) (* Plug toplevel functions to callback calls. *)
@ -1337,7 +1277,7 @@ module Make (P: NET_PARAMS) = struct
let roll net = net.roll () let roll net = net.roll ()
let blacklist _net _gid = () let blacklist _net _gid = ()
let whitelist _net _gid = () let whitelist _net _gid = ()
let get_meta net gid = net.get_meta gid let get_metadata net gid = net.get_metadata gid
let set_meta net gid meta = net.set_meta gid meta let set_metadata net gid meta = net.set_metadata gid meta
end end

43
src/node/net/p2p.mli
View File

@ -56,36 +56,42 @@ type limits = {
(** A global identifier for a peer, a.k.a. an identity *) (** A global identifier for a peer, a.k.a. an identity *)
type gid type gid
type 'msg msg_encoding = Encoding : { type 'msg encoding = Encoding : {
tag: int ; tag: int ;
encoding: 'a Data_encoding.t ; encoding: 'a Data_encoding.t ;
wrap: 'a -> 'msg ; wrap: 'a -> 'msg ;
unwrap: 'msg -> 'a option ; unwrap: 'msg -> 'a option ;
max_length: int option ; max_length: int option ;
} -> 'msg msg_encoding } -> 'msg encoding
module type NET_PARAMS = sig module type PARAMS = sig
type meta (** Type of metadata associated to an identity *)
type msg (** Type of message used by higher layers *)
val msg_encodings : msg msg_encoding list (** Type of message used by higher layers *)
type msg
val init_meta : meta val encodings : msg encoding list
val score_enc : meta Data_encoding.t
val score: meta -> float (** Type of metadata associated to an identity *)
type metadata
val initial_metadata : metadata
val metadata_encoding : metadata Data_encoding.t
val score : metadata -> float
(** High level protocol(s) talked by the peer. When two peers (** High level protocol(s) talked by the peer. When two peers
initiate a connection, they exchange their list of supported initiate a connection, they exchange their list of supported
versions. The chosen one, if any, is the maximum common one (in versions. The chosen one, if any, is the maximum common one (in
lexicographic order) *) lexicographic order) *)
val supported_versions : version list val supported_versions : version list
end end
module Make (P : NET_PARAMS) : sig module Make (P : PARAMS) : sig
type net type net
(** A faked p2p layer, which do not initiate any connection (** A faked p2p layer, which do not initiate any connection
nor open any listening socket. *) nor open any listening socket *)
val faked_network : net val faked_network : net
(** Main network initialisation function *) (** Main network initialisation function *)
@ -110,18 +116,18 @@ module Make (P : NET_PARAMS) : sig
val find_peer : net -> gid -> peer option val find_peer : net -> gid -> peer option
type peer_info = { type peer_info = {
gid : gid; gid : gid ;
addr : addr; addr : addr ;
port : port; port : port ;
version : version; version : version ;
} }
(** Access the info of an active peer, if available *) (** Access the info of an active peer, if available *)
val peer_info : net -> peer -> peer_info val peer_info : net -> peer -> peer_info
(** Accessors for meta information about a peer *) (** Accessors for meta information about a global identifier *)
val get_meta : net -> gid -> P.meta option val get_metadata : net -> gid -> P.metadata option
val set_meta : net -> gid -> P.meta -> unit val set_metadata : net -> gid -> P.metadata -> unit
(** Wait for a payload from any peer in the network *) (** Wait for a payload from any peer in the network *)
val recv : net -> (peer * P.msg) Lwt.t val recv : net -> (peer * P.msg) Lwt.t
@ -143,4 +149,5 @@ module Make (P : NET_PARAMS) : sig
(** Keep a connection to this pair as often as possible *) (** Keep a connection to this pair as often as possible *)
val whitelist : net -> gid -> unit val whitelist : net -> gid -> unit
end end

8
src/node/shell/tezos_p2p.ml
View File

@ -20,7 +20,7 @@ module Param = struct
| Get_protocols of Protocol_hash.t list | Get_protocols of Protocol_hash.t list
| Protocol of MBytes.t | Protocol of MBytes.t
let msg_encodings = let encodings =
let open Data_encoding in let open Data_encoding in
let case ?max_length ~tag encoding unwrap wrap = let case ?max_length ~tag encoding unwrap wrap =
P2p.Encoding { tag; encoding; wrap; unwrap; max_length } in P2p.Encoding { tag; encoding; wrap; unwrap; max_length } in
@ -71,9 +71,9 @@ module Param = struct
(fun proto -> Protocol proto); (fun proto -> Protocol proto);
] ]
type meta = unit type metadata = unit
let init_meta = () let initial_metadata = ()
let score_enc = Data_encoding.empty let metadata_encoding = Data_encoding.empty
let score () = 0. let score () = 0.
let supported_versions = let supported_versions =

6
src/node/shell/tezos_p2p.mli
View File

@ -40,10 +40,10 @@ val peer_info : net -> peer -> peer_info
(** Accessors for meta information about a global identifier *) (** Accessors for meta information about a global identifier *)
type meta = unit type metadata = unit
val get_meta : net -> gid -> meta option val get_metadata : net -> gid -> metadata option
val set_meta : net -> gid -> meta -> unit val set_metadata : net -> gid -> metadata -> unit
type net_id = Store.net_id type net_id = Store.net_id