diff --git a/src/node/net/p2p.ml b/src/node/net/p2p.ml index 10348749a..c7975ca48 100644 --- a/src/node/net/p2p.ml +++ b/src/node/net/p2p.ml @@ -168,7 +168,7 @@ module Real = struct let discoverer = may_create_discovery_worker config pool in let maintenance = create_maintenance_worker limits pool discoverer in may_create_welcome_worker config limits pool >>= fun welcome -> - Lwt.return { + return { config ; limits ; io_sched ; @@ -335,9 +335,42 @@ type ('msg, 'meta) t = { } type ('msg, 'meta) net = ('msg, 'meta) t +let check_limits = + let fail_1 v orig = + if not (v <= 0.) then return () + else + Error_monad.failwith "value of option %S cannot be negative or null@." + orig + in + let fail_2 v orig = + if not (v < 0) then return () + else + Error_monad.failwith "value of option %S cannot be negative@." orig + in + fun c -> + fail_1 c.authentification_timeout + "authentification-timeout" >>=? fun () -> + fail_2 c.min_connections + "min-connections" >>=? fun () -> + fail_2 c.expected_connections + "expected-connections" >>=? fun () -> + fail_2 c.max_connections + "max-connections" >>=? fun () -> + fail_2 c.max_incoming_connections + "max-incoming-connections" >>=? fun () -> + fail_2 c.read_buffer_size + "read-buffer-size" >>=? fun () -> + fail_2 c.known_peer_ids_history_size + "known-peer-ids-history-size" >>=? fun () -> + fail_2 c.known_points_history_size + "known-points-history-size" >>=? fun () -> + fail_1 c.swap_linger + "swap-linger" + let create ~config ~limits meta_cfg msg_cfg = - Real.create ~config ~limits meta_cfg msg_cfg >>= fun net -> - Lwt.return { + check_limits limits >>=? fun () -> + Real.create ~config ~limits meta_cfg msg_cfg >>=? fun net -> + return { peer_id = Real.peer_id net ; maintain = Real.maintain net ; roll = Real.roll net ; diff --git a/src/node/net/p2p.mli b/src/node/net/p2p.mli index a8547bf77..5d78a85a7 100644 --- a/src/node/net/p2p.mli +++ b/src/node/net/p2p.mli @@ -139,7 +139,7 @@ val faked_network : 'meta meta_config -> ('msg, 'meta) net (** Main network initialisation function *) val create : config:config -> limits:limits -> - 'meta meta_config -> 'msg message_config -> ('msg, 'meta) net Lwt.t + '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 diff --git a/src/node/shell/node.ml b/src/node/shell/node.ml index 9bbd77e13..401562e0a 100644 --- a/src/node/shell/node.ml +++ b/src/node/shell/node.ml @@ -73,15 +73,15 @@ let init_p2p net_params = match net_params with | None -> lwt_log_notice "P2P layer is disabled" >>= fun () -> - Lwt.return (P2p.faked_network Distributed_db_metadata.cfg) + Error_monad.return (P2p.faked_network Distributed_db_metadata.cfg) | Some (config, limits) -> lwt_log_notice "bootstraping network..." >>= fun () -> P2p.create ~config ~limits Distributed_db_metadata.cfg - Distributed_db_message.cfg >>= fun p2p -> + Distributed_db_message.cfg >>=? fun p2p -> Lwt.async (fun () -> P2p.maintain p2p) ; - Lwt.return p2p + Error_monad.return p2p type config = { genesis: State.Net.genesis ; @@ -102,7 +102,7 @@ let may_create_net state genesis = let create { genesis ; store_root ; context_root ; patch_context ; p2p = net_params ; test_network_max_tll = max_ttl } = - init_p2p net_params >>= fun p2p -> + init_p2p net_params >>=? fun p2p -> State.read ~store_root ~context_root ?patch_context () >>=? fun state -> let distributed_db = Distributed_db.create state p2p in