Client: Add "network stat" command.

src/Makefile

@@ -495,6 +495,7 @@ CLIENT_LIB_INTFS := \
   client/client_keys.mli \
   client/client_protocols.mli \
   client/client_blocks.mli \
+  client/client_network.mli \
 
 CLIENT_LIB_IMPLS := \
   client/client_commands.ml \
@@ -506,6 +507,7 @@ CLIENT_LIB_IMPLS := \
   client/client_keys.ml \
   client/client_protocols.ml \
   client/client_blocks.ml \
+  client/client_network.ml \
 
 WEBCLIENT_LIB_INTFS := \
 

src/client/client_network.ml

@@ -0,0 +1,69 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+let group =
+  { Cli_entries.name = "network" ;
+    title = "Commands for monitoring and controlling network state" }
+
+let commands () = [
+  let open Cli_entries in
+  command ~group ~desc: "show global network status"
+    (prefixes ["network" ; "stat"] stop) begin fun cctxt ->
+    Client_node_rpcs.Network.stat cctxt >>= fun stat ->
+    Client_node_rpcs.Network.connections cctxt >>= fun conns ->
+    Client_node_rpcs.Network.peers cctxt >>= fun peers ->
+    Client_node_rpcs.Network.points cctxt >>= fun points ->
+    cctxt.message "GLOBAL STATS" >>= fun () ->
+    cctxt.message "  %a" P2p_types.Stat.pp stat >>= fun () ->
+    cctxt.message "CONNECTIONS" >>= fun () ->
+    let incoming, outgoing =
+      List.partition (fun c -> c.P2p_types.Connection_info.incoming) conns in
+    Lwt_list.iter_s begin fun conn ->
+      cctxt.message "  %a" P2p_types.Connection_info.pp conn
+    end incoming >>= fun () ->
+    Lwt_list.iter_s begin fun conn ->
+      cctxt.message "  %a" P2p_types.Connection_info.pp conn
+    end outgoing >>= fun () ->
+    cctxt.message "KNOWN PEERS" >>= fun () ->
+    Lwt_list.iter_s begin fun (p, pi) ->
+      let open P2p.RPC.Peer_id in
+      cctxt.message "  %a  %.0f %a %a %s"
+        pp_state_digram pi.state
+        pi.score
+        pp p P2p_types.Stat.pp pi.stat
+        (if pi.trusted then "★" else " ")
+    end peers >>= fun () ->
+    cctxt.message "KNOWN POINTS" >>= fun () ->
+    Lwt_list.iter_s begin fun (p, pi) ->
+      let open P2p.RPC in
+      match pi.Point.state with
+      | Running peer_id ->
+          cctxt.message "  %a  %a %a %s"
+            Point.pp_state_digram pi.state
+            Point.pp p
+            Peer_id.pp peer_id
+            (if pi.trusted then "★" else " ")
+      | _ ->
+          match pi.last_seen with
+          | Some (peer_id, ts) ->
+              cctxt.message "  %a  %a (last seen: %a %a) %s"
+                Point.pp_state_digram pi.state
+                Point.pp p
+                Peer_id.pp peer_id
+                Time.pp_hum ts
+                (if pi.trusted then "★" else " ")
+          | None ->
+              cctxt.message "  %a  %a %s"
+                Point.pp_state_digram pi.state
+                Point.pp p
+                (if pi.trusted then "★" else " ")
+    end points >>= fun () ->
+    Lwt.return_unit
+  end
+]

src/client/client_network.mli

@@ -0,0 +1,10 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+val commands: unit -> Client_commands.command list

src/client/client_node_rpcs.ml

@@ -218,3 +218,14 @@ module Protocols = struct
   let list cctxt ?contents () =
     call_service0 cctxt Services.Protocols.list { contents; monitor = Some false }
 end
+
+module Network = struct
+  let stat cctxt =
+    call_service0 cctxt Services.Network.stat ()
+  let connections cctxt =
+    call_service0 cctxt Services.Network.Connection.list ()
+  let peers cctxt =
+    call_service0 cctxt Services.Network.Peer_id.list []
+  let points cctxt =
+    call_service0 cctxt Services.Network.Point.list []
+end

src/client/client_node_rpcs.mli

@@ -152,6 +152,17 @@ end
 val bootstrapped:
   Client_commands.context -> (Block_hash.t * Time.t) Lwt_stream.t Lwt.t
 
+module Network : sig
+  val stat:
+    Client_commands.context -> P2p_types.Stat.t Lwt.t
+  val connections:
+    Client_commands.context -> P2p_types.Connection_info.t list Lwt.t
+  val peers:
+    Client_commands.context -> (P2p.Peer_id.t * P2p.RPC.Peer_id.info) list Lwt.t
+  val points:
+    Client_commands.context -> (P2p.Point.t * P2p.RPC.Point.info) list Lwt.t
+end
+
 val complete:
   Client_commands.context ->
   ?block:Blocks.block -> string -> string list Lwt.t

src/client_main.ml

@@ -54,6 +54,7 @@ let main () =
        >>= fun version ->
        let commands =
          Client_generic_rpcs.commands @
+         Client_network.commands () @
          Client_keys.commands () @
          Client_protocols.commands () @
          Client_helpers.commands () @

src/node/net/p2p.ml

@@ -461,26 +461,60 @@ module RPC = struct
   end
 
   module Point = struct
+    include Point
+
     type state =
       | Requested
-      | Accepted
+      | Accepted of Peer_id.t
-      | Running
+      | Running of Peer_id.t
       | Disconnected
 
+    let peer_id_of_state = function
+      | Requested -> None
+      | Accepted pi -> Some pi
+      | Running pi -> Some pi
+      | Disconnected -> None
+
+    let state_of_state_peerid state pi = match state, pi with
+      | Requested, _ -> Requested
+      | Accepted _, Some pi -> Accepted pi
+      | Running _, Some pi -> Running pi
+      | Disconnected, _ -> Disconnected
+      | _ -> invalid_arg "state_of_state_peerid"
+
+    let pp_state_digram ppf = function
+      | Requested -> Format.fprintf ppf "⚎"
+      | Accepted _ -> Format.fprintf ppf "⚍"
+      | Running _ -> Format.fprintf ppf "⚌"
+      | Disconnected -> Format.fprintf ppf "⚏"
+
     let state_encoding =
       let open Data_encoding in
-      string_enum [
+      let branch_encoding name obj =
-        "requested", Requested ;
+        conv (fun x -> (), x) (fun ((), x) -> x)
-        "accepted", Accepted ;
+          (merge_objs
-        "running", Running ;
+             (obj1 (req "event_kind" (constant name))) obj) in
-        "disconnected", Disconnected ;
+      union ~tag_size:`Uint8 [
+        case ~tag:0 (branch_encoding "requested" empty)
+          (function Requested -> Some () | _ -> None)
+          (fun () -> Requested) ;
+        case ~tag:1 (branch_encoding "accepted"
+                       (obj1 (req "peer_id" Peer_id.encoding)))
+          (function Accepted peer_id -> Some peer_id | _ -> None)
+          (fun peer_id -> Accepted peer_id) ;
+        case ~tag:2 (branch_encoding "running"
+                       (obj1 (req "peer_id" Peer_id.encoding)))
+          (function Running peer_id -> Some peer_id | _ -> None)
+          (fun peer_id -> Running peer_id) ;
+        case ~tag:3 (branch_encoding "disconnected" empty)
+          (function Disconnected -> Some () | _ -> None)
+          (fun () -> Disconnected) ;
       ]
 
     type info = {
       trusted : bool ;
       greylisted_until : Time.t ;
       state : state ;
-      peer_id : Peer_id.t option ;
       last_failed_connection : Time.t option ;
       last_rejected_connection : (Peer_id.t * Time.t) option ;
       last_established_connection : (Peer_id.t * Time.t) option ;
@@ -492,26 +526,24 @@ module RPC = struct
     let info_encoding =
       let open Data_encoding in
       conv
-        (fun { trusted ; greylisted_until ; state ; peer_id ;
+        (fun { trusted ; greylisted_until ; state ;
                last_failed_connection ; last_rejected_connection ;
                last_established_connection ; last_disconnection ;
-               last_seen ; last_miss ;
+               last_seen ; last_miss } ->
-             } ->
+          let peer_id = peer_id_of_state state in
           (trusted, greylisted_until, state, peer_id,
            last_failed_connection, last_rejected_connection,
            last_established_connection, last_disconnection,
-           last_seen, last_miss)
+           last_seen, last_miss))
-        )
         (fun (trusted, greylisted_until, state, peer_id,
               last_failed_connection, last_rejected_connection,
               last_established_connection, last_disconnection,
               last_seen, last_miss) ->
-          { trusted ; greylisted_until ; state ; peer_id ;
+          let state = state_of_state_peerid state peer_id in
+          { trusted ; greylisted_until ; state ;
             last_failed_connection ; last_rejected_connection ;
             last_established_connection ; last_disconnection ;
-            last_seen ; last_miss ;
+            last_seen ; last_miss })
-          }
-        )
         (obj10
            (req "trusted" bool)
            (dft "greylisted_until" Time.encoding Time.epoch)
@@ -527,14 +559,14 @@ module RPC = struct
     let info_of_point_info i =
       let open P2p_connection_pool in
       let open P2p_connection_pool_types in
-      let state, peer_id = match Point_info.State.get i with
+      let state = match Point_info.State.get i with
-        | Requested _ -> Requested, None
+        | Requested _ -> Requested
-        | Accepted { current_peer_id } -> Accepted, Some current_peer_id
+        | Accepted { current_peer_id } -> Accepted current_peer_id
-        | Running { current_peer_id } -> Running, Some current_peer_id
+        | Running { current_peer_id } -> Running current_peer_id
-        | Disconnected -> Disconnected, None in
+        | Disconnected -> Disconnected in
       Point_info.{
         trusted = trusted i ;
-        state ; peer_id ;
+        state ;
         greylisted_until = greylisted_until i ;
         last_failed_connection = last_failed_connection i ;
         last_rejected_connection = last_rejected_connection i ;
@@ -576,7 +608,7 @@ module RPC = struct
           | None -> raise Not_found
           | Some pi -> P2p_connection_pool_types.Point_info.watch pi
 
-    let infos ?(restrict=[]) net =
+    let list ?(restrict=[]) net =
       match net.pool with
       | None -> []
       | Some pool ->
@@ -593,11 +625,18 @@ module RPC = struct
   end
 
   module Peer_id = struct
+    include Peer_id
+
     type state =
       | Accepted
       | Running
       | Disconnected
 
+    let pp_state_digram ppf = function
+      | Accepted -> Format.fprintf ppf "⚎"
+      | Running -> Format.fprintf ppf "⚌"
+      | Disconnected -> Format.fprintf ppf "⚏"
+
     let state_encoding =
       let open Data_encoding in
       string_enum [
@@ -716,7 +755,7 @@ module RPC = struct
           | None -> raise Not_found
           | Some gi -> P2p_connection_pool_types.Peer_info.watch gi
 
-    let infos ?(restrict=[]) net =
+    let list ?(restrict=[]) net =
       match net.pool with
       | None -> []
       | Some pool ->

src/node/net/p2p.mli

@@ -206,20 +206,21 @@ module RPC : sig
   end
 
   module Point : sig
+    include module type of Point
 
     type state =
       | Requested
-      | Accepted
+      | Accepted of Peer_id.t
-      | Running
+      | Running of Peer_id.t
       | Disconnected
 
+    val pp_state_digram : Format.formatter -> state -> unit
     val state_encoding : state Data_encoding.t
 
     type info = {
       trusted : bool ;
       greylisted_until : Time.t ;
       state : state ;
-      peer_id : Peer_id.t option ;
       last_failed_connection : Time.t option ;
       last_rejected_connection : (Peer_id.t * Time.t) option ;
       last_established_connection : (Peer_id.t * Time.t) option ;
@@ -234,7 +235,7 @@ module RPC : sig
 
     val info :
       ('msg, 'meta) net -> Point.t -> info option
-    val infos :
+    val list :
       ?restrict:state list -> ('msg, 'meta) net -> (Point.t * info) list
     val events :
       ?max:int -> ?rev:bool -> ('msg, 'meta) net -> Point.t -> Event.t list
@@ -243,12 +244,14 @@ module RPC : sig
   end
 
   module Peer_id : sig
+    include module type of Peer_id
 
     type state =
       | Accepted
       | Running
       | Disconnected
 
+    val pp_state_digram : Format.formatter -> state -> unit
     val state_encoding : state Data_encoding.t
 
     type info = {
@@ -270,7 +273,7 @@ module RPC : sig
 
     val info :
       ('msg, 'meta) net -> Peer_id.t -> info option
-    val infos :
+    val list :
       ?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

src/node/net/p2p_types.ml

@@ -18,6 +18,9 @@ module Version = struct
     minor : int ;
   }
 
+  let pp ppf { name ; major ; minor } =
+    Format.fprintf ppf "%s.%d.%d" name major minor
+
   let encoding =
     let open Data_encoding in
     conv
@@ -83,7 +86,7 @@ module Stat = struct
 
   let pp ppf stat =
     Format.fprintf ppf
-      "sent: %a (%a/s) recv: %a (%a/s)"
+      "↗ %a (%a/s) ↘ %a (%a/s)"
       print_size64 stat.total_sent print_size stat.current_outflow
       print_size64 stat.total_recv print_size stat.current_inflow
 
@@ -314,14 +317,15 @@ module Connection_info = struct
          (req "versions" (list Version.encoding)))
 
   let pp ppf
-      { incoming ; id_point = (remote_addr, remote_port) ; peer_id } =
+      { incoming ; id_point = (remote_addr, remote_port) ;
-    Format.fprintf ppf "%a:%a {%a}%s"
+        remote_socket_port ; peer_id ; versions } =
-      Ipaddr.V6.pp_hum remote_addr
+    let version = List.hd versions in
-      (fun ppf port ->
+    let point = match remote_port with
-         match port with
+      | None -> remote_addr, remote_socket_port
-         | None -> Format.pp_print_string ppf "??"
+      | Some port -> remote_addr, port in
-         | Some port -> Format.pp_print_int ppf port) remote_port
+    Format.fprintf ppf "%s %a %a (%a)"
+      (if incoming then "↘" else "↗")
       Peer_id.pp peer_id
-      (if incoming then " (incoming)" else "")
+      Point.pp point
-
+      Version.pp version
 end

src/node/net/p2p_types.mli

@@ -19,6 +19,7 @@ module Version : sig
   }
   (** Type of a protocol version. *)
 
+  val pp : Format.formatter -> t -> unit
   val encoding : t Data_encoding.t
   val common: t list -> t list -> t option
 end
@@ -35,6 +36,7 @@ module Peer_id : sig
   val pp : Format.formatter -> t -> unit
   val pp_short : Format.formatter -> t -> unit
   val encoding : t Data_encoding.t
+  val of_string_exn : string -> t
   module Map : Map.S with type key = t
   module Set : Set.S with type elt = t
   module Table : Hashtbl.S with type key = t

src/node/shell/node.ml

@@ -565,8 +565,8 @@ module RPC = struct
       let info (node : t) =
         P2p.RPC.Point.info node.p2p
 
-      let infos (node : t) restrict =
+      let list (node : t) restrict =
-        P2p.RPC.Point.infos ~restrict node.p2p
+        P2p.RPC.Point.list ~restrict node.p2p
 
       let events (node : t) =
         P2p.RPC.Point.events node.p2p
@@ -581,8 +581,8 @@ module RPC = struct
       let info (node : t) =
         P2p.RPC.Peer_id.info node.p2p
 
-      let infos (node : t) restrict =
+      let list (node : t) restrict =
-        P2p.RPC.Peer_id.infos ~restrict node.p2p
+        P2p.RPC.Peer_id.list ~restrict node.p2p
 
       let events (node : t) =
         P2p.RPC.Peer_id.events node.p2p

src/node/shell/node.mli

@@ -103,7 +103,7 @@ module RPC : sig
     end
 
     module Peer_id : sig
-      val infos : t ->
+      val list : t ->
         P2p.RPC.Peer_id.state list -> (P2p.Peer_id.t * P2p.RPC.Peer_id.info) list
       val info : t -> P2p.Peer_id.t -> P2p.RPC.Peer_id.info option
       val events : t -> P2p.Peer_id.t -> P2p.RPC.Peer_id.Event.t list
@@ -112,7 +112,7 @@ module RPC : sig
     end
 
     module Point : sig
-      val infos : t ->
+      val list : t ->
         P2p.RPC.Point.state list -> (P2p.Point.t * P2p.RPC.Point.info) list
       val info : t -> P2p.Point.t -> P2p.RPC.Point.info option
       val events : t -> P2p.Point.t -> P2p.RPC.Point.Event.t list

src/node/shell/node_rpc.ml

@@ -490,8 +490,8 @@ let build_rpc_directory node =
 
   let dir =
     let implementation state =
-      Node.RPC.Network.Peer_id.infos node state |> RPC.Answer.return in
+      Node.RPC.Network.Peer_id.list node state |> RPC.Answer.return in
-    RPC.register0 dir Services.Network.Peer_id.infos implementation in
+    RPC.register0 dir Services.Network.Peer_id.list implementation in
   let dir =
     let implementation peer_id () =
       Node.RPC.Network.Peer_id.info node peer_id |> RPC.Answer.return in
@@ -518,8 +518,8 @@ let build_rpc_directory node =
 
   let dir =
     let implementation state =
-      Node.RPC.Network.Point.infos node state |> RPC.Answer.return in
+      Node.RPC.Network.Point.list node state |> RPC.Answer.return in
-    RPC.register0 dir Services.Network.Point.infos implementation in
+    RPC.register0 dir Services.Network.Point.list implementation in
   let dir =
     let implementation point () =
       Node.RPC.Network.Point.info node point |> RPC.Answer.return in

src/node/shell/node_rpc_services.ml

@@ -559,16 +559,6 @@ module Network = struct
 
   module Point = struct
 
-    let infos =
-      let filter =
-        obj1 (dft "filter" (list P2p.RPC.Point.state_encoding) []) in
-      RPC.service
-        ~input: filter
-        ~output: (list (tup2 P2p.Point.encoding P2p.RPC.Point.info_encoding))
-        ~description:"List the pool of known `IP:port` \
-                      used for establishing P2P connections ."
-        RPC.Path.(root / "network" / "point")
-
     let info =
       RPC.service
         ~input: empty
@@ -583,19 +573,20 @@ module Network = struct
         ~description: "Monitor network events related to an `IP:addr`."
         RPC.Path.(root / "network" / "point" /: point_arg / "log")
 
+    let list =
+      let filter =
+        obj1 (dft "filter" (list P2p.RPC.Point.state_encoding) []) in
+      RPC.service
+        ~input: filter
+        ~output: (list (tup2 P2p.Point.encoding P2p.RPC.Point.info_encoding))
+        ~description:"List the pool of known `IP:port` \
+                      used for establishing P2P connections ."
+        RPC.Path.(root / "network" / "point")
+
   end
 
   module Peer_id = struct
 
-    let infos =
-      let filter =
-        obj1 (dft "filter" (list P2p.RPC.Peer_id.state_encoding) []) in
-      RPC.service
-        ~input: filter
-        ~output: (list (tup2 P2p.Peer_id.encoding P2p.RPC.Peer_id.info_encoding))
-        ~description:"List the peers the node ever met."
-        RPC.Path.(root / "network" / "peer_id")
-
     let info =
       RPC.service
         ~input: empty
@@ -610,6 +601,15 @@ module Network = struct
         ~description:"Monitor network events related to a given peer."
         RPC.Path.(root / "network" / "peer_id" /: peer_id_arg / "log")
 
+    let list =
+      let filter =
+        obj1 (dft "filter" (list P2p.RPC.Peer_id.state_encoding) []) in
+      RPC.service
+        ~input: filter
+        ~output: (list (tup2 P2p.Peer_id.encoding P2p.RPC.Peer_id.info_encoding))
+        ~description:"List the peers the node ever met."
+        RPC.Path.(root / "network" / "peer_id")
+
   end
 
 end

src/node/shell/node_rpc_services.mli

@@ -140,7 +140,7 @@ module Network : sig
   end
 
   module Point : sig
-    val infos :
+    val list :
       (unit, unit, P2p.RPC.Point.state list,
        (P2p.Point.t * P2p.RPC.Point.info) list) RPC.service
     val info :
@@ -150,7 +150,7 @@ module Network : sig
   end
 
   module Peer_id : sig
-    val infos :
+    val list :
       (unit, unit, P2p.RPC.Peer_id.state list,
        (P2p.Peer_id.t * P2p.RPC.Peer_id.info) list) RPC.service
     val info :