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

Shell: improve Utils

Browse Source
This commit is contained in:
Grégoire Henry 2017-01-23 11:09:33 +01:00
parent 6efa84fa37
commit 866e7add2f
11 changed files with 58 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
src/minutils/utils.ml
View File

@ -9,13 +9,16 @@
module StringMap = Map.Make (String)
let split delim ?(limit = max_int) path =
let split delim ?(dup = true) ?(limit = max_int) path =
let l = String.length path in
let rec do_slashes acc limit i =
if i >= l then
List.rev acc
else if String.get path i = delim then
do_slashes acc limit (i + 1)
if dup then
do_slashes acc limit (i + 1)
else
do_split acc limit (i + 1)
else
do_split acc limit i
and do_split acc limit i =
@ -55,8 +58,8 @@ let iter_option ~f = function
| None -> ()
| Some x -> f x
let unopt x = function
| None -> x
let unopt ~default = function
| None -> default
| Some x -> x
let unopt_map ~f ~default = function
@ -85,8 +88,16 @@ let list_sub l n = list_rev_sub l n |> List.rev
let display_paragraph ppf description =
Format.fprintf ppf "@[%a@]"
(fun ppf words -> List.iter (Format.fprintf ppf "%s@ ") words)
(split ' ' description)
(Format.pp_print_list ~pp_sep:Format.pp_print_newline
(fun ppf line ->
Format.pp_print_list ~pp_sep:Format.pp_print_space
(fun ppf w ->
(* replace   by real spaces... *)
Format.fprintf ppf "%s@ "
(Stringext.replace_all ~pattern:"\xC2\xA0" ~with_:" " w))
ppf
(split ' ' line)))
(split ~dup:false '\n' description)
let rec remove_elem_from_list nb = function
| [] -> []
@ -128,6 +139,8 @@ let rec (--) i j =
if j < i then acc else loop (j :: acc) (pred j) in
loop [] j
let rec repeat n x = if n <= 0 then [] else x :: repeat (pred n) x
let take_n_unsorted n l =
let rec loop acc n = function
| [] -> l

6
src/minutils/utils.mli
View File

@ -16,12 +16,12 @@ val split_path: string -> string list
(** Splits a string on a delimier character, grouping multiple
delimiters, and ignoring delimiters at the beginning and end of
string, if [limit] is passed, stops after [limit] split(s). *)
val split: char -> ?limit: int -> string -> string list
val split: char -> ?dup:bool -> ?limit: int -> string -> string list
val map_option: f:('a -> 'b) -> 'a option -> 'b option
val apply_option: f:('a -> 'b option) -> 'a option -> 'b option
val iter_option: f:('a -> unit) -> 'a option -> unit
val unopt: 'a -> 'a option -> 'a
val unopt: default:'a -> 'a option -> 'a
val unopt_map: f:('a -> 'b) -> default:'b -> 'a option -> 'b
val unopt_list: 'a option list -> 'a list
val first_some: 'a option -> 'a option -> 'a option
@ -51,6 +51,8 @@ val (<<) : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c
(** Sequence: [i--j] is the sequence [i;i+1;...;j-1;j] *)
val (--) : int -> int -> int list
val repeat: int -> 'a -> 'a list
(** [take_n n l] returns the [n] first elements of [n]. When [compare]
is provided, it returns the [n] greatest element of [l]. *)
val take_n: ?compare:('a -> 'a -> int) -> int -> 'a list -> 'a list

2
src/node/net/p2p_connection_pool_types.ml
View File

@ -451,7 +451,7 @@ module Gid_info = struct
let enc = Data_encoding.list (encoding metadata_encoding) in
Data_encoding_ezjsonm.read_file path >|=
map_option ~f:(Data_encoding.Json.destruct enc) >|=
unopt []
unopt ~default:[]
let save path metadata_encoding peers =
let open Data_encoding in

10
src/node/net/p2p_io_scheduler.ml
View File

@ -147,7 +147,7 @@ module Scheduler(IO : IO) = struct
canceler = Canceler.create () ;
worker = Lwt.return_unit ;
counter = Moving_average.create ~init:0 ~alpha ;
max_speed ; quota = unopt 0 max_speed ;
max_speed ; quota = unopt ~default:0 max_speed ;
quota_updated = Lwt_condition.create () ;
readys = Lwt_condition.create () ;
readys_high = Queue.create () ;
@ -358,9 +358,9 @@ let write_now { write_queue } msg = Lwt_pipe.push_now write_queue msg
let read_from conn ?pos ?len buf msg =
let maxlen = MBytes.length buf in
let pos = unopt 0 pos in
let pos = unopt ~default:0 pos in
assert (0 <= pos && pos < maxlen) ;
let len = unopt (maxlen - pos) len in
let len = unopt ~default:(maxlen - pos) len in
assert (len <= maxlen - pos) ;
match msg with
| Ok msg ->
@ -400,8 +400,8 @@ let read conn ?pos ?len buf =
let read_full conn ?pos ?len buf =
let maxlen = MBytes.length buf in
let pos = unopt 0 pos in
let len = unopt (maxlen - pos) len in
let pos = unopt ~default:0 pos in
let len = unopt ~default:(maxlen - pos) len in
assert (0 <= pos && pos < maxlen) ;
assert (len <= maxlen - pos) ;
let rec loop pos len =

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

@ -394,9 +394,9 @@ let build_rpc_directory node =
let dir =
let implementation (net_id, pred, time, fitness, operations, header) =
Node.RPC.block_info node (`Head 0) >>= fun bi ->
let timestamp = Utils.unopt (Time.now ()) time in
let net_id = Utils.unopt bi.net net_id in
let predecessor = Utils.unopt bi.hash pred in
let timestamp = Utils.unopt ~default:(Time.now ()) time in
let net_id = Utils.unopt ~default:bi.net net_id in
let predecessor = Utils.unopt ~default:bi.hash pred in
let res =
Store.Block.to_bytes {
shell = { net_id ; predecessor ; timestamp ; fitness ; operations } ;

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

@ -524,7 +524,7 @@ let inject_block =
(fun (block, blocking, force) ->
(block, Some blocking, force))
(fun (block, blocking, force) ->
(block, Utils.unopt true blocking, force))
(block, Utils.unopt ~default:true blocking, force))
(obj3
(req "data" bytes)
(opt "blocking"
@ -557,7 +557,7 @@ let inject_operation =
~input:
(conv
(fun (block, blocking, force) -> (block, Some blocking, force))
(fun (block, blocking, force) -> (block, unopt true blocking, force))
(fun (block, blocking, force) -> (block, unopt ~default:true blocking, force))
(obj3
(req "signedOperationContents"
(describe ~title: "Tezos signed operation (hex encoded)"
@ -611,7 +611,7 @@ let inject_protocol =
~input:
(conv
(fun (proto, blocking, force) -> (rpc_of_proto proto, Some blocking, force))
(fun (proto, blocking, force) -> (proto_of_rpc proto, unopt true blocking, force))
(fun (proto, blocking, force) -> (proto_of_rpc proto, unopt ~default:true blocking, force))
(obj3
(req "protocol"
(describe ~title: "Tezos protocol"

3
src/node/shell/state.ml
View File

@ -699,7 +699,8 @@ module Valid_block = struct
(* TODO check coherency: test_protocol. *)
Lwt.return res
| None ->
let test_protocol = Utils.unopt genesis.protocol test_protocol in
let test_protocol =
Utils.unopt ~default:genesis.protocol test_protocol in
Context.create_genesis_context
vstate.index genesis test_protocol >>= fun _context ->
Block.db_store vstate.block_db genesis.block {

30
src/node_main.ml
View File

@ -207,19 +207,19 @@ module Cfg_file = struct
(rpc_addr, cors_origins, cors_headers),
log_output) ->
let open Utils in
let store = unopt default_cfg.store store in
let context = unopt default_cfg.context context in
let protocol = unopt default_cfg.protocol protocol in
let store = unopt ~default:default_cfg.store store in
let context = unopt ~default:default_cfg.context context in
let protocol = unopt ~default:default_cfg.protocol protocol in
let net_addr = map_option sockaddr_of_string_exn net_addr in
let net_addr, net_port = unopt (default_cfg.net_addr, default_cfg.net_port) net_addr in
let net_addr, net_port = unopt ~default:(default_cfg.net_addr, default_cfg.net_port) net_addr in
let rpc_addr = map_option sockaddr_of_string_exn rpc_addr in
let peers = unopt [] peers in
let peers = unopt ~default:[] peers in
let peers = ListLabels.map peers ~f:sockaddr_of_string_exn in
let peers_cache = unopt default_cfg.peers_cache peers_cache in
let log_output = unopt default_cfg.log_output (map_option log_of_string log_output) in
let min_connections = unopt default_cfg.min_connections min_connections in
let max_connections = unopt default_cfg.max_connections max_connections in
let expected_connections = unopt default_cfg.expected_connections expected_connections in
let peers_cache = unopt ~default:default_cfg.peers_cache peers_cache in
let log_output = unopt ~default:default_cfg.log_output (map_option log_of_string log_output) in
let min_connections = unopt ~default:default_cfg.min_connections min_connections in
let max_connections = unopt ~default:default_cfg.max_connections max_connections in
let expected_connections = unopt ~default:default_cfg.expected_connections expected_connections in
(* let local_discovery = map_option local_discovery ~f:mcast_params_of_string in *)
{ default_cfg with
store ; context ; protocol ;
@ -320,8 +320,8 @@ module Cmdline = struct
(* local_discovery *)
peers closed rpc_addr tls cors_origins cors_headers reset_cfg update_cfg =
let base_dir = Utils.(unopt (unopt default_cfg.base_dir base_dir) sandbox) in
let config_file = Utils.(unopt ((unopt base_dir sandbox) // "config")) config_file in
let base_dir = Utils.(unopt ~default:(unopt ~default:default_cfg.base_dir base_dir) sandbox) in
let config_file = Utils.(unopt ~default:((unopt ~default:base_dir sandbox) // "config")) config_file in
let no_config () =
warn "Found no config file at %s" config_file;
warn "Using factory defaults";
@ -355,9 +355,9 @@ module Cmdline = struct
sandbox = Utils.first_some sandbox cfg.sandbox ;
sandbox_param = Utils.first_some sandbox_param cfg.sandbox_param ;
log_level = Utils.first_some log_level cfg.log_level ;
min_connections = Utils.unopt cfg.min_connections min_connections ;
max_connections = Utils.unopt cfg.max_connections max_connections ;
expected_connections = Utils.unopt cfg.expected_connections expected_connections ;
min_connections = Utils.unopt ~default:cfg.min_connections min_connections ;
max_connections = Utils.unopt ~default:cfg.max_connections max_connections ;
expected_connections = Utils.unopt ~default:cfg.expected_connections expected_connections ;
net_addr = (match net_saddr with None -> cfg.net_addr | Some (addr, _) -> addr) ;
net_port = (match net_saddr with None -> cfg.net_port | Some (_, port) -> port) ;
(* local_discovery = Utils.first_some local_discovery cfg.local_discovery ; *)

2
src/utils/error_monad.ml
View File

@ -74,7 +74,7 @@ module Make() = struct
category ;
from_error ;
encoding_case ;
pp = Utils.unopt (json_pp encoding) pp } :: !error_kinds
pp = Utils.unopt ~default:(json_pp encoding) pp } :: !error_kinds
let register_wrapped_error_kind
category ~id ~title ~description ?pp

7
test/test_p2p_connection_pool.ml
View File

@ -158,7 +158,7 @@ let make_net points repeat n =
let addr = ref Ipaddr.V6.localhost
let port = ref (1024 + Random.int 8192)
let clients = ref 10
let repeat = ref 5
let repeat_connections = ref 5
let spec = Arg.[
@ -169,7 +169,8 @@ let spec = Arg.[
"--clients", Set_int clients, " Number of concurrent clients." ;
"--repeat", Set_int repeat, " Number of connections/disconnections." ;
"--repeat", Set_int repeat_connections,
" Number of connections/disconnections." ;
"-v", Unit (fun () -> Lwt_log_core.(add_rule "p2p.connection-pool" Info)),
" Log up to info msgs" ;
@ -186,7 +187,7 @@ let main () =
Arg.parse spec anon_fun usage_msg ;
let ports = !port -- (!port + !clients - 1) in
let points = List.map (fun port -> !addr, port) ports in
Lwt_list.iter_p (make_net points !repeat) (0 -- (!clients - 1))
Lwt_list.iter_p (make_net points !repeat_connections) (0 -- (!clients - 1))
let () =
Sys.catch_break true ;

2
test/test_state.ml
View File

@ -39,7 +39,7 @@ let incr_fitness fitness =
| [ _ ; fitness ] ->
Pervasives.(
Data_encoding.Binary.of_bytes Data_encoding.int64 fitness
|> Utils.unopt 0L
|> Utils.unopt ~default:0L
|> Int64.succ
|> Data_encoding.Binary.to_bytes Data_encoding.int64
)