diff --git a/src/Makefile b/src/Makefile index f4d28b00c..195086693 100644 --- a/src/Makefile +++ b/src/Makefile @@ -227,6 +227,7 @@ NODE_LIB_INTFS := \ node/updater/proto_environment.mli \ node/updater/register.mli \ \ + node/shell/tezos_p2p.mli \ node/shell/state.mli \ node/shell/prevalidator.mli \ node/shell/validator.mli \ @@ -256,10 +257,8 @@ NODE_LIB_IMPLS := \ node/updater/proto_environment.ml \ node/updater/register.ml \ \ - node/shell/messages.ml \ - node/shell/netparams.ml \ + node/shell/tezos_p2p.ml \ node/shell/state.ml \ - \ node/shell/prevalidator.ml \ node/shell/validator.ml \ \ diff --git a/src/node/shell/discoverer.ml b/src/node/shell/discoverer.ml index 86af9ca0a..443dcdace 100644 --- a/src/node/shell/discoverer.ml +++ b/src/node/shell/discoverer.ml @@ -7,8 +7,6 @@ (* *) (**************************************************************************) -module P2p = Netparams - type worker = { shutdown: unit -> unit Lwt.t; } @@ -17,7 +15,7 @@ let create_worker p2p state = let cancelation, cancel, _on_cancel = Lwt_utils.canceler () in - let broadcast m = P2p.broadcast p2p m in + let broadcast m = Tezos_p2p.broadcast p2p m in let discovery_worker = let rec worker_loop () = @@ -26,8 +24,8 @@ let create_worker p2p state = (fun net -> State.Net.Blockchain.head net >>= fun head -> State.Valid_block.block_locator state 50 head >>= fun locator -> - broadcast Messages.(Discover_blocks (State.Net.id net, locator)) ; - broadcast Messages.(Current_operations (State.Net.id net)) ; + broadcast Tezos_p2p.(Discover_blocks (State.Net.id net, locator)) ; + broadcast Tezos_p2p.(Current_operations (State.Net.id net)) ; Lwt.return_unit) nets >>= fun () -> let timeout = 15. +. Random.float 15. in diff --git a/src/node/shell/discoverer.mli b/src/node/shell/discoverer.mli index 35e11b81e..3d7fd04bf 100644 --- a/src/node/shell/discoverer.mli +++ b/src/node/shell/discoverer.mli @@ -9,6 +9,6 @@ type worker -val create_worker: Netparams.net -> State.t -> worker +val create_worker: Tezos_p2p.net -> State.t -> worker val shutdown: worker -> unit Lwt.t diff --git a/src/node/shell/messages.ml b/src/node/shell/messages.ml deleted file mode 100644 index 0c3904663..000000000 --- a/src/node/shell/messages.ml +++ /dev/null @@ -1,78 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -type net_id = Store.net_id - -type t = - - | Discover_blocks of net_id * Block_hash.t list (* Block locator *) - | Block_inventory of net_id * Block_hash.t list - - | Get_blocks of Block_hash.t list - | Block of MBytes.t - - | Current_operations of net_id - | Operation_inventory of net_id * Operation_hash.t list - - | Get_operations of Operation_hash.t list - | Operation of MBytes.t - - | 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)); - - 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); - - 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)); - - 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); -] diff --git a/src/node/shell/messages.mli b/src/node/shell/messages.mli deleted file mode 100644 index b4e976539..000000000 --- a/src/node/shell/messages.mli +++ /dev/null @@ -1,28 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -(** High level messages *) -type t = - - | Discover_blocks of Store.net_id * Block_hash.t list (* Block locator *) - | Block_inventory of Store.net_id * Block_hash.t list - - | Get_blocks of Block_hash.t list - | Block of MBytes.t - - | Current_operations of Store.net_id - | Operation_inventory of Store.net_id * Operation_hash.t list - - | Get_operations of Operation_hash.t list - | Operation of MBytes.t - - | Get_protocols of Protocol_hash.t list - | Protocol of MBytes.t - -val encoding : t P2p.msg_encoding list diff --git a/src/node/shell/node.ml b/src/node/shell/node.ml index e43806b69..22534aca5 100644 --- a/src/node/shell/node.ml +++ b/src/node/shell/node.ml @@ -7,8 +7,6 @@ (* *) (**************************************************************************) -module P2p = Netparams - open Logging.Node.Worker let (>|=) = Lwt.(>|=) @@ -93,7 +91,7 @@ let inject_block state validator ?(force = false) bytes = Lwt.return (hash, validation) let process state validator msg = - let open Messages in + let open Tezos_p2p in match msg with | Discover_blocks (net_id, blocks) -> @@ -194,26 +192,26 @@ 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 net (Get_operations operations) + Tezos_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 net (Get_blocks blocks) + Tezos_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 net (Get_protocols protocols) + Tezos_p2p.broadcast net (Get_protocols protocols) let init_p2p net_params = match net_params with | None -> lwt_log_notice "P2P layer is disabled" >>= fun () -> - Lwt.return P2p.faked_network + Lwt.return Tezos_p2p.faked_network | Some (config, limits) -> lwt_log_notice "bootstraping network..." >>= fun () -> - P2p.bootstrap config limits + Tezos_p2p.bootstrap config limits let create ~genesis ~store_root ~context_root ?test_protocol ?patch_context net_params = @@ -246,12 +244,12 @@ let create let handle_msg peer msg = process state validator msg >>= fun msgs -> List.iter - (fun msg -> ignore @@ P2p.try_send p2p peer msg) + (fun msg -> ignore @@ Tezos_p2p.try_send p2p peer msg) msgs; Lwt.return_unit in let rec worker_loop () = - P2p.recv p2p >>= fun (peer, msg) -> + Tezos_p2p.recv p2p >>= fun (peer, msg) -> handle_msg peer msg >>= fun () -> worker_loop () in Lwt.catch @@ -261,12 +259,12 @@ let create | exn -> lwt_log_error "unexpected exception in worker\n%s" (Printexc.to_string exn) >>= fun () -> - P2p.shutdown p2p >>= fun () -> + Tezos_p2p.shutdown p2p >>= fun () -> cleanup ()) in let shutdown () = lwt_log_info "stopping worker..." >>= fun () -> - P2p.shutdown p2p >>= fun () -> + Tezos_p2p.shutdown p2p >>= fun () -> worker >>= fun () -> lwt_log_info "stopped" in diff --git a/src/node/shell/prevalidator.ml b/src/node/shell/prevalidator.ml index ebf417302..ab631d7ad 100644 --- a/src/node/shell/prevalidator.ml +++ b/src/node/shell/prevalidator.ml @@ -7,8 +7,6 @@ (* *) (**************************************************************************) -module P2p = Netparams - open Logging.Node.Prevalidator let preapply @@ -97,7 +95,7 @@ let create p2p net = Lwt.return_unit in let broadcast_operation ops = - P2p.broadcast p2p (Operation_inventory (State.Net.id net, ops)) in + Tezos_p2p.broadcast p2p (Operation_inventory (State.Net.id net, ops)) in let handle_unprocessed () = if Operation_hash_set.is_empty !unprocessed then diff --git a/src/node/shell/prevalidator.mli b/src/node/shell/prevalidator.mli index d9194eb7d..2c966199d 100644 --- a/src/node/shell/prevalidator.mli +++ b/src/node/shell/prevalidator.mli @@ -26,12 +26,10 @@ *) -module P2p = Netparams - type t (** Creation and destruction of a "prevalidation" worker. *) -val create: P2p.net -> State.Net.t -> t Lwt.t +val create: Tezos_p2p.net -> State.Net.t -> t Lwt.t val shutdown: t -> unit Lwt.t (** Notify the prevalidator of a new operation. This is the diff --git a/src/node/shell/tezos_p2p.ml b/src/node/shell/tezos_p2p.ml new file mode 100644 index 000000000..4b89512e2 --- /dev/null +++ b/src/node/shell/tezos_p2p.ml @@ -0,0 +1,90 @@ + +module Param = struct + + type net_id = Store.net_id + + type msg = + + | Discover_blocks of net_id * Block_hash.t list (* Block locator *) + | Block_inventory of net_id * Block_hash.t list + + | Get_blocks of Block_hash.t list + | Block of MBytes.t + + | Current_operations of net_id + | Operation_inventory of net_id * Operation_hash.t list + + | Get_operations of Operation_hash.t list + | Operation of MBytes.t + + | Get_protocols of Protocol_hash.t list + | Protocol of MBytes.t + + let msg_encodings = + 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)); + + 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); + + 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)); + + 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); + ] + + type meta = unit + let init_meta = () + let score_enc = Data_encoding.empty + let score () = 0. + + let supported_versions = + let open P2p in + [ { name = "TEZOS" ; + major = 0 ; + minor = 0 ; + } + ] + +end + +include Param +include P2p.Make(Param) diff --git a/src/node/shell/tezos_p2p.mli b/src/node/shell/tezos_p2p.mli new file mode 100644 index 000000000..d584dd288 --- /dev/null +++ b/src/node/shell/tezos_p2p.mli @@ -0,0 +1,86 @@ + +open P2p + +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 global identifier *) + +type meta = unit + +val get_meta : net -> gid -> meta option +val set_meta : net -> gid -> meta -> unit + +type net_id = Store.net_id + +type msg = + + | Discover_blocks of net_id * Block_hash.t list (* Block locator *) + | Block_inventory of net_id * Block_hash.t list + + | Get_blocks of Block_hash.t list + | Block of MBytes.t + + | Current_operations of net_id + | Operation_inventory of net_id * Operation_hash.t list + + | Get_operations of Operation_hash.t list + | Operation of MBytes.t + + | Get_protocols of Protocol_hash.t list + | Protocol of MBytes.t + +(** 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 msg 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 diff --git a/src/node/shell/validator.ml b/src/node/shell/validator.ml index b330a302a..9bc560df0 100644 --- a/src/node/shell/validator.ml +++ b/src/node/shell/validator.ml @@ -7,12 +7,10 @@ (* *) (**************************************************************************) -module P2p = Netparams - open Logging.Node.Validator type worker = { - p2p: P2p.net ; + p2p: Tezos_p2p.net ; activate: ?parent:t -> State.Net.t -> t Lwt.t ; get: State.net_id -> t tzresult Lwt.t ; get_exn: State.net_id -> t Lwt.t ; @@ -45,7 +43,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 w.p2p m +let broadcast w m = Tezos_p2p.broadcast w.p2p m (** Current block computation *) @@ -75,7 +73,7 @@ let rec may_set_head v (block: State.Valid_block.t) = State.Net.Blockchain.test_and_set_head v.net ~old:head block >>= function | false -> may_set_head v block | true -> - broadcast v.worker Messages.(Block_inventory (State.Net.id v.net, [])) ; + broadcast v.worker Tezos_p2p.(Block_inventory (State.Net.id v.net, [])) ; Prevalidator.flush v.prevalidator ; may_change_test_network v block >>= fun () -> lwt_log_notice "update current head %a %a %a(%t)" diff --git a/src/node/shell/validator.mli b/src/node/shell/validator.mli index ca45a78e0..b9053c66b 100644 --- a/src/node/shell/validator.mli +++ b/src/node/shell/validator.mli @@ -9,9 +9,7 @@ type worker -module P2p = Netparams - -val create_worker: P2p.net -> State.t -> worker +val create_worker: Tezos_p2p.net -> State.t -> worker val shutdown: worker -> unit Lwt.t val notify_block: worker -> Block_hash.t -> Store.block -> unit Lwt.t