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

P2p: refactor the mli

Browse Source
This commit is contained in:
Vincent Bernardoff 2016-11-07 14:32:10 +01:00 committed by Grégoire Henry
parent cbca39d4ea
commit ff1c08f876
14 changed files with 1452 additions and 1222 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Makefile
View File

@ -231,7 +231,6 @@ NODE_LIB_INTFS := \
node/shell/prevalidator.mli \
node/shell/validator.mli \
\
node/shell/messages.mli \
node/shell/discoverer.mli \
node/shell/node_rpc_services.mli \
node/shell/node.mli \
@ -257,9 +256,10 @@ NODE_LIB_IMPLS := \
node/updater/proto_environment.ml \
node/updater/register.ml \
\
node/shell/messages.ml \
node/shell/netparams.ml \
node/shell/state.ml \
\
node/shell/messages.ml \
node/shell/prevalidator.ml \
node/shell/validator.ml \
\

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

File diff suppressed because it is too large Load Diff

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

@ -7,35 +7,27 @@
(* *)
(**************************************************************************)
(** A P2P network *)
type net
(** A faked p2p layer, which do not initiate any connection
nor open any listening socket. *)
val faked_network : net
(** A peer connection address *)
type addr = Ipaddr.t
(** A peer connection port *)
type port = int
(** A protocol version tag: (name, major, minor) *)
type version = string * int * int
(** A p2p protocol version *)
type version = {
name : string ;
major : int ;
minor : int ;
}
(** Network configuration *)
type config = {
(** Tells if incoming connections accepted, precising the TCP port
on which the peer can be reached *)
on which the peer can be reached *)
incoming_port : port option ;
(** Tells if peers should be discovered automatically on the local
network, precising the UDP port to use *)
network, precising the UDP port to use *)
discovery_port : port option ;
(** 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) *)
supported_versions : version list ;
(** List of hard-coded known peers to bootstrap the network from *)
known_peers : (addr * port) list ;
(** The path to the JSON file where the peer cache is loaded / stored *)
@ -47,7 +39,7 @@ type config = {
(** Network capacities *)
type limits = {
(** Maximum length in bytes of network frames *)
(** Maximum length in bytes of network messages' payload *)
max_packet_size : int ;
(** Delay after which a non responding peer is considered dead *)
peer_answer_timeout : float ;
@ -61,42 +53,94 @@ type limits = {
blacklist_time : float ;
}
(** Main network initialisation function *)
val bootstrap : config -> limits -> net Lwt.t
type 'msg msg_encoding = Encoding : {
tag: int ;
encoding: 'a Data_encoding.t ;
wrap: 'a -> 'msg ;
unwrap: 'msg -> 'a option ;
max_length: int option ;
} -> 'msg msg_encoding
(** A maintenance operation : try and reach the ideal number of peers *)
val maintain : net -> unit Lwt.t
module type NET_PARAMS = sig
type meta (** Type of metadata associated to an identity *)
type msg (** Type of message used by higher layers *)
(** Voluntarily drop some peers and replace them by new buddies *)
val roll : net -> unit Lwt.t
val msg_encodings : msg msg_encoding list
(** Close all connections properly *)
val shutdown : net -> unit Lwt.t
val init_meta : meta
val score_enc : meta Data_encoding.t
val score: meta -> float
(** A connection to a peer *)
type peer
(** 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
(** Access the domain of active peers *)
val peers : net -> peer list
module Make (P : NET_PARAMS) : sig
type net
(** Access the info of an active peer, if available *)
val peer_info : peer -> net -> addr * port * version
(** A faked p2p layer, which do not initiate any connection
nor open any listening socket. *)
val faked_network : net
(** Wait for a Netbits.frame from any peer in the network *)
val recv : net -> (peer * Netbits.frame) Lwt.t
(** Main network initialisation function *)
val bootstrap : config:config -> limits:limits -> net Lwt.t
(** Send a Netbits.frame to a peer and wait for it to be in the tube *)
val send : peer * Netbits.frame -> net -> unit Lwt.t
(** A maintenance operation : try and reach the ideal number of peers *)
val maintain : net -> unit Lwt.t
(** Send a Netbits.frame to a peer asynchronously *)
val push : peer * Netbits.frame -> net -> unit
(** Voluntarily drop some peers and replace them by new buddies *)
val roll : net -> unit Lwt.t
(** Send a Netbits.frame to all peers *)
val broadcast : Netbits.frame -> net -> unit
(** Close all connections properly *)
val shutdown : net -> unit Lwt.t
(** Shutdown the connection to all peers at this address and stop the
communications with this machine for [duration] seconds *)
val blacklist : ?duration:float -> addr -> net -> unit
(** A connection to a peer *)
type peer
(** Keep a connection to this pair as often as possible *)
val whitelist : peer -> net -> unit
(** A global identifier for a peer, a.k.a. an identity *)
type gid
(** 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 -> P.meta option
val set_meta : net -> gid -> P.meta -> unit
(** Wait for a payload from any peer in the network *)
val recv : net -> (peer * P.msg) Lwt.t
(** Send a payload to a peer and wait for it to be in the tube *)
val send : net -> peer -> P.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 -> P.msg -> bool
(** Send a payload to all peers *)
val broadcast : net -> P.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

4
src/node/shell/discoverer.ml
View File

@ -7,6 +7,8 @@
(* *)
(**************************************************************************)
module P2p = Netparams
type worker = {
shutdown: unit -> unit Lwt.t;
}
@ -15,7 +17,7 @@ let create_worker p2p state =
let cancelation, cancel, _on_cancel = Lwt_utils.canceler () in
let broadcast m = P2p.broadcast (Messages.to_frame m) p2p in
let broadcast m = P2p.broadcast p2p m in
let discovery_worker =
let rec worker_loop () =

2
src/node/shell/discoverer.mli
View File

@ -9,6 +9,6 @@
type worker
val create_worker: P2p.net -> State.t -> worker
val create_worker: Netparams.net -> State.t -> worker
val shutdown: worker -> unit Lwt.t

108
src/node/shell/messages.ml
View File

@ -7,11 +7,9 @@
(* *)
(**************************************************************************)
open Netbits
type net_id = Store.net_id
type message =
type t =
| Discover_blocks of net_id * Block_hash.t list (* Block locator *)
| Block_inventory of net_id * Block_hash.t list
@ -28,65 +26,53 @@ type message =
| Get_protocols of Protocol_hash.t list
| Protocol of MBytes.t
let encoding =
let open Data_encoding in
let case ?max_length ~tag encoding unwrap wrap =
P2p.Encoding { tag; encoding; wrap; unwrap; max_length }
in [
case ~tag:0x10 (tup2 Block_hash.encoding (list Block_hash.encoding))
(function
| Discover_blocks (Net genesis_bh, bhs) -> Some (genesis_bh, bhs)
| _ -> None)
(fun (genesis_bh, bhs) -> Discover_blocks (Net genesis_bh, bhs));
case ~tag:0x11 (tup2 Block_hash.encoding (list Block_hash.encoding))
(function
| Block_inventory (Net genesis_bh, bhs) -> Some (genesis_bh, bhs)
| _ -> None)
(fun (genesis_bh, bhs) -> Block_inventory (Net genesis_bh, bhs));
let to_frame msg =
case ~tag:0x12 (list Block_hash.encoding)
(function
| Get_blocks bhs -> Some bhs
| _ -> None)
(fun bhs -> Get_blocks bhs);
case ~tag:0x13 Data_encoding.bytes
(function Block b -> Some b | _ -> None)
(fun b -> Block b);
let bh h = B (Block_hash.to_bytes h) in
let oph h = B (Operation_hash.to_bytes h) in
let ph h = B (Protocol_hash.to_bytes h) in
match msg with
case ~tag:0x20 Block_hash.encoding
(function Current_operations (Net genesis_bh) -> Some genesis_bh | _ -> None)
(fun genesis_bh -> Current_operations (Net genesis_bh));
case ~tag:0x21 (tup2 Block_hash.encoding (list Operation_hash.encoding))
(function Operation_inventory ((Net genesis_bh), ops) -> Some (genesis_bh, ops) | _ -> None)
(fun (genesis_bh, ops) -> Operation_inventory (Net genesis_bh, ops));
| Discover_blocks (Net netid, blocks) ->
[ S 2100 ; bh netid ; F (List.map bh blocks) ]
| Block_inventory (Net netid, blocks) ->
[ S 2101 ; bh netid ; F (List.map bh blocks) ]
| Get_blocks blocks ->
[ S 2102 ; F (List.map bh blocks) ]
| Block b ->
[ S 2103 ; B b ]
| Current_operations (Net net_id) ->
[ S 2700 ; bh net_id ]
| Operation_inventory (Net net_id, ops) ->
[ S 2701 ; bh net_id ; F (List.map oph ops) ]
| Get_operations ops ->
[ S 2702 ; F (List.map oph ops) ]
| Operation b ->
[ S 2703 ; B b ]
| Get_protocols protos ->
[ S 2800 ; F (List.map ph protos) ]
| Protocol p ->
[ S 2801 ; B p ]
let from_frame msg =
let bh = function B s -> (Block_hash.of_bytes s) | _ -> invalid_arg "bh" in
let oph = function B s -> (Operation_hash.of_bytes s) | _ -> invalid_arg "oph" in
let ph = function B s -> (Protocol_hash.of_bytes s) | _ -> invalid_arg "ph" in
let net = function netid -> Store.Net (Block_hash.of_bytes netid) in
try match msg with
| [ S 2100 ; B netid ; F blocks ] ->
Some (Discover_blocks (net netid, List.map bh blocks))
| [ S 2101 ; B netid ; F blocks ] ->
Some (Block_inventory (net netid, List.map bh blocks))
| [ S 2102 ; F blocks ] ->
Some (Get_blocks (List.map bh blocks))
| [ S 2103 ; B bh ] -> Some (Block bh)
| [ S 2700 ; B netid ] ->
Some (Current_operations (net netid))
| [ S 2701 ; B netid ; F ops ] ->
Some (Operation_inventory (net netid, List.map oph ops))
| [ S 2702 ; F ops ] ->
Some (Get_operations (List.map oph ops))
| [ S 2703 ; B contents ] -> Some (Operation contents)
| [ S 2800 ; F protos ] -> Some (Get_protocols (List.map ph protos))
| [ S 2801 ; B contents ] -> Some (Protocol contents)
| _ -> None
with Invalid_argument _ -> None
case ~tag:0x22 (list Operation_hash.encoding)
(function
| Get_operations ops -> Some ops
| _ -> None)
(fun ops -> Get_operations ops);
case ~tag:0x23 Data_encoding.bytes
(function Operation o -> Some o | _ -> None)
(fun o -> Operation o);
case ~tag:0x32 (list Protocol_hash.encoding)
(function
| Get_protocols protos -> Some protos
| _ -> None)
(fun protos -> Get_protocols protos);
case ~tag:0x33 Data_encoding.bytes
(function Protocol proto -> Some proto | _ -> None)
(fun proto -> Protocol proto);
]

9
src/node/shell/messages.mli
View File

@ -8,7 +8,7 @@
(**************************************************************************)
(** High level messages *)
type message =
type t =
| Discover_blocks of Store.net_id * Block_hash.t list (* Block locator *)
| Block_inventory of Store.net_id * Block_hash.t list
@ -25,9 +25,4 @@ type message =
| Get_protocols of Protocol_hash.t list
| Protocol of MBytes.t
(** Converts a high level message to a network frame *)
val to_frame: message -> Netbits.frame
(** Tries and convert a network frame to a high level message *)
val from_frame: Netbits.frame -> message option
val encoding : t P2p.msg_encoding list

32
src/node/shell/node.ml
View File

@ -7,12 +7,12 @@
(* *)
(**************************************************************************)
module P2p = Netparams
open Logging.Node.Worker
let (>|=) = Lwt.(>|=)
let supported_versions = ["TEZOS", 0, 0]
let inject_operation validator ?force bytes =
let t =
match Store.Operation.of_bytes bytes with
@ -194,18 +194,17 @@ type t = {
let request_operations net _net_id operations =
(* TODO improve the lookup strategy.
For now simply broadcast the request to all our neighbours. *)
P2p.broadcast
(Messages.(to_frame (Get_operations operations))) net
P2p.broadcast net (Get_operations operations)
let request_blocks net _net_id blocks =
(* TODO improve the lookup strategy.
For now simply broadcast the request to all our neighbours. *)
P2p.broadcast (Messages.(to_frame (Get_blocks blocks))) net
P2p.broadcast net (Get_blocks blocks)
let request_protocols net protocols =
(* TODO improve the lookup strategy.
For now simply broadcast the request to all our neighbours. *)
P2p.broadcast (Messages.(to_frame (Get_protocols protocols))) net
P2p.broadcast net (Get_protocols protocols)
let init_p2p net_params =
match net_params with
@ -244,21 +243,12 @@ let create
lwt_log_info "starting worker..." >>= fun () ->
let worker =
let handle_msg peer frame =
lwt_log_info "received message" >>= fun () ->
match Messages.from_frame frame with
| None ->
lwt_warn "can't parse message" >>= fun () ->
(* FIXME 60 second ? parameter... and Log_notice *)
let addr, _, _ = P2p.peer_info peer p2p in
P2p.blacklist ~duration:60. addr p2p ;
Lwt.return_unit
| Some msg ->
process state validator msg >>= fun msgs ->
List.iter
(fun msg -> P2p.push (peer, Messages.to_frame msg) p2p)
msgs;
Lwt.return_unit
let handle_msg peer msg =
process state validator msg >>= fun msgs ->
List.iter
(fun msg -> ignore @@ P2p.try_send p2p peer msg)
msgs;
Lwt.return_unit
in
let rec worker_loop () =
P2p.recv p2p >>= fun (peer, msg) ->

2
src/node/shell/node.mli
View File

@ -9,8 +9,6 @@
type t
val supported_versions: P2p.version list
val create:
genesis:Store.genesis ->
store_root:string ->

6
src/node/shell/prevalidator.ml
View File

@ -7,6 +7,8 @@
(* *)
(**************************************************************************)
module P2p = Netparams
open Logging.Node.Prevalidator
let preapply
@ -95,9 +97,7 @@ let create p2p net =
Lwt.return_unit in
let broadcast_operation ops =
P2p.broadcast
Messages.(to_frame @@ Operation_inventory (State.Net.id net, ops))
p2p in
P2p.broadcast p2p (Operation_inventory (State.Net.id net, ops)) in
let handle_unprocessed () =
if Operation_hash_set.is_empty !unprocessed then

2
src/node/shell/prevalidator.mli
View File

@ -26,6 +26,8 @@
*)
module P2p = Netparams
type t
(** Creation and destruction of a "prevalidation" worker. *)

4
src/node/shell/validator.ml
View File

@ -7,6 +7,8 @@
(* *)
(**************************************************************************)
module P2p = Netparams
open Logging.Node.Validator
type worker = {
@ -43,7 +45,7 @@ let test_validator w = w.test_validator ()
let fetch_block v = v.fetch_block
let prevalidator v = v.prevalidator
let broadcast w m = P2p.broadcast (Messages.to_frame m) w.p2p
let broadcast w m = P2p.broadcast w.p2p m
(** Current block computation *)

2
src/node/shell/validator.mli
View File

@ -9,6 +9,8 @@
type worker
module P2p = Netparams
val create_worker: P2p.net -> State.t -> worker
val shutdown: worker -> unit Lwt.t

1
src/node_main.ml
View File

@ -288,7 +288,6 @@ let init_node () =
{ incoming_port = Globals.incoming_port#get ;
discovery_port =
if Globals.discovery_port#get then Some 7732 else None ;
supported_versions = Node.supported_versions ;
known_peers = Globals.bootstrap_peers#get ;
peers_file = Globals.peers_file#get ;
closed_network = Globals.closed_network#get }