From 41d30777a60a45833275cd202bf5285d970e3079 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Thu, 8 Feb 2018 10:51:02 +0100 Subject: [PATCH] Client refactor: remove `Utils.read_file`... --- src/bin_node/node_data_version.ml | 2 +- src/lib_client_base/client_config.ml | 50 +++++++++++--------------- src/lib_stdlib/utils.ml | 27 -------------- src/lib_stdlib/utils.mli | 8 ----- src/lib_stdlib_unix/lwt_utils_unix.ml | 15 +++++--- src/lib_stdlib_unix/lwt_utils_unix.mli | 1 + 6 files changed, 34 insertions(+), 69 deletions(-) diff --git a/src/bin_node/node_data_version.ml b/src/bin_node/node_data_version.ml index 548ff69bd..078cee603 100644 --- a/src/bin_node/node_data_version.ml +++ b/src/bin_node/node_data_version.ml @@ -113,7 +113,7 @@ let ensure_data_dir data_dir = | [| single |] when single = default_identity_file_name -> write_version () | _ -> check_data_dir_version data_dir else begin - Utils.mkdir ~perm:0o700 data_dir ; + Lwt_utils_unix.create_dir ~perm:0o700 data_dir >>= fun () -> write_version () end with Sys_error _ | Unix.Unix_error _ -> diff --git a/src/lib_client_base/client_config.ml b/src/lib_client_base/client_config.ml index 0ed340408..105b50391 100644 --- a/src/lib_client_base/client_config.ml +++ b/src/lib_client_base/client_config.ml @@ -96,9 +96,8 @@ module Cfg_file = struct return (from_json json) let write out cfg = - Utils.write_file ~bin:false out - (Data_encoding.Json.construct encoding cfg |> - Data_encoding.Json.to_string) + Lwt_utils_unix.Json.write_file out + (Data_encoding.Json.construct encoding cfg) end @@ -200,24 +199,13 @@ let tls_switch = ~parameter:"-tls" ~doc:"use TLS to connect to node." -let read_config_file config_file = match - Utils.read_file ~bin:false config_file - |> Data_encoding.Json.from_string - with - | exception (Sys_error msg) -> - failwith - "Can't read the configuration file: %s@,%s" - config_file msg - | Error msg -> - failwith - "Can't parse the configuration file: %s@,%s" - config_file msg - | Ok cfg_json -> - try return @@ Cfg_file.from_json cfg_json - with exn -> - failwith - "Can't parse the configuration file: %s@,%a" - config_file (fun ppf exn -> Json_encoding.print_error ppf exn) exn +let read_config_file config_file = + Lwt_utils_unix.Json.read_file config_file >>=? fun cfg_json -> + try return @@ Cfg_file.from_json cfg_json + with exn -> + failwith + "Can't parse the configuration file: %s@,%a" + config_file (fun ppf exn -> Json_encoding.print_error ppf exn) exn let default_config_file_name = "config" @@ -244,7 +232,7 @@ let commands config_file cfg = no_options (fixed [ "config" ; "reset" ]) (fun () _cctxt -> - return Cfg_file.(write config_file default)) ; + Cfg_file.(write config_file default)) ; command ~group ~desc:"Update the config based on the current cli values.\n\ @@ -255,7 +243,7 @@ let commands config_file cfg = no_options (fixed [ "config" ; "update" ]) (fun () _cctxt -> - return Cfg_file.(write config_file cfg)) ; + Cfg_file.(write config_file cfg)) ; command ~group ~desc:"Create a config file based on the current CLI values.\n\ @@ -278,7 +266,7 @@ let commands config_file cfg = (fixed [ "config" ; "init" ]) (fun config_file _cctxt -> if not (Sys.file_exists config_file) - then return Cfg_file.(write config_file cfg) (* Should be default or command would have failed *) + then Cfg_file.(write config_file cfg) (* Should be default or command would have failed *) else failwith "Config file already exists at location") ; ] @@ -310,8 +298,9 @@ let parse_config_args (ctx : Client_commands.full_context) argv = begin match base_dir with | None -> let base_dir = Client_commands.default_base_dir in - if not (Sys.file_exists base_dir) - then Utils.mkdir base_dir ; + unless (Sys.file_exists base_dir) begin fun () -> + Lwt_utils_unix.create_dir base_dir >>= return + end >>=? fun () -> return base_dir | Some dir -> if not (Sys.file_exists dir) @@ -338,7 +327,7 @@ let parse_config_args (ctx : Client_commands.full_context) argv = return { Cfg_file.default with base_dir = base_dir } else read_config_file config_file - end >>|? fun cfg -> + end >>=? fun cfg -> let tls = cfg.tls || tls in let node_addr = Option.unopt ~default:cfg.node_addr node_addr in let node_port = Option.unopt ~default:cfg.node_port node_port in @@ -351,5 +340,8 @@ let parse_config_args (ctx : Client_commands.full_context) argv = Format.eprintf "%s is not a directory.@." config_dir ; exit 1 ; end ; - Utils.mkdir config_dir ; - (cfg, { block ; print_timings = timings ; log_requests ; protocol }, commands config_file cfg, remaining) + Lwt_utils_unix.create_dir config_dir >>= fun () -> + return + (cfg, + { block ; print_timings = timings ; log_requests ; protocol }, + commands config_file cfg, remaining) diff --git a/src/lib_stdlib/utils.ml b/src/lib_stdlib/utils.ml index 5fab4a5f8..36a6026de 100644 --- a/src/lib_stdlib/utils.ml +++ b/src/lib_stdlib/utils.ml @@ -32,30 +32,3 @@ let display_paragraph ppf description = (TzString.split ~dup:false '\n' description) let finalize f g = try let res = f () in g (); res with exn -> g (); raise exn - -let read_file ?(bin=false) fn = - let ic = (if bin then open_in_bin else open_in) fn in - finalize (fun () -> - let len = in_channel_length ic in - really_input_string ic len) - (fun () -> close_in ic) - -let write_file ?(bin=false) fn contents = - let oc = (if bin then open_out_bin else open_out) fn in - finalize (fun () -> - let contents = Bytes.unsafe_of_string contents in - output oc contents 0 @@ Bytes.length contents - ) - (fun () -> close_out oc) - -let mkdir ?(perm=0o755) dir = - let safe_mkdir dir = - if not (Sys.file_exists dir) then - try Unix.mkdir dir perm - with Unix.Unix_error(Unix.EEXIST,_,_) -> () in - let rec aux dir = - if not (Sys.file_exists dir) then begin - aux (Filename.dirname dir); - safe_mkdir dir; - end in - aux dir diff --git a/src/lib_stdlib/utils.mli b/src/lib_stdlib/utils.mli index 66d93de6e..e9b049554 100644 --- a/src/lib_stdlib/utils.mli +++ b/src/lib_stdlib/utils.mli @@ -22,11 +22,3 @@ val display_paragraph: Format.formatter -> string -> unit (** [finalize f g ] ensures g() called after f(), even if exception raised **) val finalize: (unit -> 'a) -> (unit -> unit) -> 'a - -(** Return contents of file at given filename. **) -val read_file: ?bin:bool -> string -> string - -(** [write_file p c] writes c to file at path p **) -val write_file: ?bin:bool -> string -> string -> unit - -val mkdir: ?perm:Unix.file_perm -> string -> unit diff --git a/src/lib_stdlib_unix/lwt_utils_unix.ml b/src/lib_stdlib_unix/lwt_utils_unix.ml index fb5a33a64..2d9d5f34c 100644 --- a/src/lib_stdlib_unix/lwt_utils_unix.ml +++ b/src/lib_stdlib_unix/lwt_utils_unix.ml @@ -92,6 +92,13 @@ let create_file ?(perm = 0o644) name content = Lwt_unix.write_string fd content 0 (String.length content) >>= fun _ -> Lwt_unix.close fd +let read_file fn = + Lwt_io.with_file fn ~mode:Input begin fun ch -> + Lwt_io.read ch + end + + + let safe_close fd = Lwt.catch (fun () -> Lwt_unix.close fd) @@ -172,16 +179,16 @@ module Protocol = struct match Sys.file_exists implementation, Sys.file_exists interface with | false, _ -> Pervasives.failwith @@ "Not such file: " ^ implementation | true, false -> - let implementation = Utils.read_file ~bin:false implementation in + read_file implementation >|= fun implementation -> { name = module_name; interface = None; implementation } | _ -> - let interface = Utils.read_file ~bin:false interface in - let implementation = Utils.read_file ~bin:false implementation in + read_file interface >>= fun interface -> + read_file implementation >|= fun implementation -> { name = module_name; interface = Some interface; implementation } let read_dir dir = of_file ~dir >>=? fun meta -> - let components = List.map (find_component dir) meta.modules in + Lwt_list.map_p (find_component dir) meta.modules >>= fun components -> let expected_env = match meta.expected_env_version with | None -> V1 diff --git a/src/lib_stdlib_unix/lwt_utils_unix.mli b/src/lib_stdlib_unix/lwt_utils_unix.mli index e6cf428e7..444fd0c76 100644 --- a/src/lib_stdlib_unix/lwt_utils_unix.mli +++ b/src/lib_stdlib_unix/lwt_utils_unix.mli @@ -22,6 +22,7 @@ val write_mbytes: val remove_dir: string -> unit Lwt.t val create_dir: ?perm:int -> string -> unit Lwt.t +val read_file: string -> string Lwt.t val create_file: ?perm:int -> string -> string -> unit Lwt.t val safe_close: Lwt_unix.file_descr -> unit Lwt.t