diff --git a/src/bin_node/node_config_file.ml b/src/bin_node/node_config_file.ml index 87a0da3672795a5f0b72ea31c4c6377d54f8cf1c..1583f8522226365da3f271a3aeafe02b0046c7c9 100644 --- a/src/bin_node/node_config_file.ml +++ b/src/bin_node/node_config_file.ml @@ -1161,6 +1161,7 @@ let string_of_json_encoding_error exn = let read fp = if Sys.file_exists fp then Lwt_utils_unix.Json.read_file fp + >|= tzresult_of_exn_result >>=? fun json -> try return (Data_encoding.Json.destruct encoding json) with | Json_encoding.Cannot_destruct (path, exn) -> @@ -1181,6 +1182,7 @@ let write fp cfg = Node_data_version.ensure_data_dir (Filename.dirname fp) >>=? fun () -> Lwt_utils_unix.Json.write_file fp (Data_encoding.Json.construct encoding cfg) + >|= tzresult_of_exn_result let to_string cfg = Data_encoding.Json.to_string (Data_encoding.Json.construct encoding cfg) diff --git a/src/bin_node/node_data_version.ml b/src/bin_node/node_data_version.ml index ee5708964b50df74e1f1bf782150ab51397e7d7c..122bce13c001ac60f08ba76bc14d35334bd36229 100644 --- a/src/bin_node/node_data_version.ml +++ b/src/bin_node/node_data_version.ml @@ -251,10 +251,12 @@ let write_version_file data_dir = Lwt_utils_unix.Json.write_file version_file (Data_encoding.Json.construct version_encoding data_version) + >|= tzresult_of_exn_result |> trace (Could_not_write_version_file version_file) let read_version_file version_file = Lwt_utils_unix.Json.read_file version_file + >|= tzresult_of_exn_result |> trace (Could_not_read_data_dir_version version_file) >>=? fun json -> try return (Data_encoding.Json.destruct version_encoding json) diff --git a/src/bin_node/node_identity_file.ml b/src/bin_node/node_identity_file.ml index 6e8003f5ed16237a252c7b4acea57acc94362861..9abc7505f461b7ba78bd385707a8dd281b5f5294 100644 --- a/src/bin_node/node_identity_file.ml +++ b/src/bin_node/node_identity_file.ml @@ -138,6 +138,7 @@ let read ?expected_pow filename = fail (No_identity_file filename) | true -> ( Lwt_utils_unix.Json.read_file filename + >|= tzresult_of_exn_result >>=? fun json -> let id = Data_encoding.Json.destruct P2p_identity.encoding json in let pkh = Crypto_box.hash id.public_key in @@ -191,6 +192,7 @@ let write file identity = Lwt_utils_unix.Json.write_file file (Data_encoding.Json.construct P2p_identity.encoding identity) + >|= tzresult_of_exn_result let generate_with_animation ppf target = let duration = 1200 / Animation.number_of_frames in diff --git a/src/bin_node/node_reconstruct_command.ml b/src/bin_node/node_reconstruct_command.ml index c386250d13f80e4b1df63fbb16bad5d56f4f670f..4ffac3422fe4c5689605c886c41e400e0c20d8de 100644 --- a/src/bin_node/node_reconstruct_command.ml +++ b/src/bin_node/node_reconstruct_command.ml @@ -71,6 +71,7 @@ module Term = struct return_some ("sandbox_parameter", json) ) ) >>=? fun sandbox_parameters -> Lwt_lock_file.is_locked (Node_data_version.lock_file data_dir) + >|= tzresult_of_exn_result >>=? fun is_locked -> fail_when is_locked Locked_directory >>=? fun () -> diff --git a/src/bin_node/node_replay_command.ml b/src/bin_node/node_replay_command.ml index 667a90f9ed9e322fd2444d70f5c4f64396ea66c4..0804ce85829a416d99472f90515eeb32ed59b64a 100644 --- a/src/bin_node/node_replay_command.ml +++ b/src/bin_node/node_replay_command.ml @@ -362,6 +362,7 @@ let run ?verbosity ~singleprocess (config : Node_config_file.t) block = Node_data_version.ensure_data_dir config.data_dir >>=? fun () -> Lwt_lock_file.is_locked (Node_data_version.lock_file config.data_dir) + >|= tzresult_of_exn_result >>=? (function | true -> failwith "Data directory is locked by another process" @@ -371,6 +372,7 @@ let run ?verbosity ~singleprocess (config : Node_config_file.t) block = Lwt_lock_file.create ~unlink_on_exit:true (Node_data_version.lock_file config.data_dir) + >|= tzresult_of_exn_result >>=? fun () -> (* Main loop *) let log_cfg = diff --git a/src/bin_node/node_run_command.ml b/src/bin_node/node_run_command.ml index e7f98d4626426d2916164c8c8dd1a5d7a34681be..27aea72637d0718f95ff90386019236387a27a0f 100644 --- a/src/bin_node/node_run_command.ml +++ b/src/bin_node/node_run_command.ml @@ -402,6 +402,7 @@ let run ?verbosity ?sandbox ?target ~singleprocess ~force_history_mode_switch Lwt_lock_file.create ~unlink_on_exit:true (Node_data_version.lock_file config.data_dir) + >|= tzresult_of_exn_result >>=? fun () -> (* Main loop *) let log_cfg = @@ -508,6 +509,7 @@ let process sandbox verbosity target singleprocess force_history_mode_switch value was expected.") ) >>=? fun target -> Lwt_lock_file.is_locked (Node_data_version.lock_file config.data_dir) + >|= tzresult_of_exn_result >>=? function | false -> Lwt.catch diff --git a/src/bin_node/node_shared_arg.ml b/src/bin_node/node_shared_arg.ml index e85a66d2f6c28e5f56f8661d2d8b30f3eb5c08c0..4c2706b8d8b32b26c97d7ae69210bdded2656c10 100644 --- a/src/bin_node/node_shared_arg.ml +++ b/src/bin_node/node_shared_arg.ml @@ -137,7 +137,8 @@ let load_net_config = function fail (Network_http_error (resp.status, body_str)) ) >>=? decode_net_config (Uri.to_string uri) | Filename filename -> - Lwt_utils_unix.Json.read_file filename >>=? decode_net_config filename + Lwt_utils_unix.Json.read_file filename + >|= tzresult_of_exn_result >>=? decode_net_config filename let wrap data_dir config_file network connections max_download_speed max_upload_speed binary_chunks_size peer_table_size listen_addr diff --git a/src/bin_node/node_snapshot_command.ml b/src/bin_node/node_snapshot_command.ml index b765d2437b37b3fc681747743aa3e720dad292bd..678c808b3963dffcbc9e26076e5d7c45536ef134 100644 --- a/src/bin_node/node_snapshot_command.ml +++ b/src/bin_node/node_snapshot_command.ml @@ -208,6 +208,7 @@ module Term = struct Lwt_lock_file.create ~unlink_on_exit:true (Node_data_version.lock_file data_dir) + >|= tzresult_of_exn_result >>=? fun () -> ( match (node_config.blockchain_network.genesis_parameters, sandbox_file) diff --git a/src/bin_node/node_upgrade_command.ml b/src/bin_node/node_upgrade_command.ml index dc71e6a29f0057c2428cb749dc67c6d83437efb2..6e391ab9796a4b9be65e6423d5565456e228dc81 100644 --- a/src/bin_node/node_upgrade_command.ml +++ b/src/bin_node/node_upgrade_command.ml @@ -57,9 +57,10 @@ module Term = struct trace (failure "Fail to lock the data directory. Is a `tezos-node` running?") - @@ Lwt_lock_file.create - ~unlink_on_exit:true - (Node_data_version.lock_file data_dir) + @@ ( Lwt_lock_file.create + ~unlink_on_exit:true + (Node_data_version.lock_file data_dir) + >|= tzresult_of_exn_result ) >>=? fun () -> Node_data_version.upgrade_data_dir ~data_dir diff --git a/src/bin_signer/main_signer.ml b/src/bin_signer/main_signer.ml index 9c3853d05aec1c7ed7405756bec9ffa032a20d8d..e7115e264a6d3b8b29de43ce3a73f7c51fae49de 100644 --- a/src/bin_signer/main_signer.ml +++ b/src/bin_signer/main_signer.ml @@ -114,7 +114,8 @@ let may_setup_pidfile = function return_unit | Some pidfile -> trace (failure "Failed to create the pidfile: %s" pidfile) - @@ Lwt_lock_file.create ~unlink_on_exit:true pidfile + @@ ( Lwt_lock_file.create ~unlink_on_exit:true pidfile + >|= tzresult_of_exn_result ) let commands base_dir require_auth : Client_context.full command list = Tezos_signer_backends_unix.Ledger.commands () diff --git a/src/bin_signer/socket_daemon.ml b/src/bin_signer/socket_daemon.ml index b04534d4c6fcf15142b8f6c6bac20fc444352516..2fc1d6185ac778463c84f7235b469c054312674f 100644 --- a/src/bin_signer/socket_daemon.ml +++ b/src/bin_signer/socket_daemon.ml @@ -125,6 +125,7 @@ let run ?magic_bytes ?timeout ~check_high_watermark ~require_auth cfd) (fun () -> Lwt_utils_unix.safe_close cfd + >|= tzresult_of_exn_result >>= function | Error trace -> Format.eprintf diff --git a/src/lib_base/unix/protocol_files.ml b/src/lib_base/unix/protocol_files.ml index 5d469cf9195ac3fcf23b9aa22652ac783bd66cd5..faebbe13c97fd433aff81ec26f1d482142c5b50a 100644 --- a/src/lib_base/unix/protocol_files.ml +++ b/src/lib_base/unix/protocol_files.ml @@ -12,9 +12,11 @@ let to_file ~dir:dirname ?hash ?env_version modules = {hash; expected_env_version = env_version; modules} in Lwt_utils_unix.Json.write_file (dirname // name) config_file + >|= tzresult_of_exn_result let of_file ~dir:dirname = Lwt_utils_unix.Json.read_file (dirname // name) + >|= tzresult_of_exn_result >>=? fun json -> return (Data_encoding.Json.destruct Meta.encoding json) let find_component dirname module_name = diff --git a/src/lib_base/unix/socket.ml b/src/lib_base/unix/socket.ml index 28c772a3722ff1c6232340bb9772603d6083f2d4..efeacada1845510b14fa2c498d8051d42e011789 100644 --- a/src/lib_base/unix/socket.ml +++ b/src/lib_base/unix/socket.ml @@ -81,9 +81,14 @@ let with_connection ?timeout addr f = protect (fun () -> f conn - >>=? fun a -> Lwt_utils_unix.safe_close conn >>=? fun () -> return a) + >>=? fun a -> + Lwt_utils_unix.safe_close conn + >|= tzresult_of_exn_result + >>=? fun () -> return a) ~on_error:(fun e -> - Lwt_utils_unix.safe_close conn >>=? fun () -> Lwt.return (Error e)) + Lwt_utils_unix.safe_close conn + >|= tzresult_of_exn_result + >>=? fun () -> Lwt.return (Error e)) let bind ?(backlog = 10) = function | Unix path -> diff --git a/src/lib_client_base_unix/client_config.ml b/src/lib_client_base_unix/client_config.ml index 481c1a7448007b508860d905bd7e5fc15d723a6f..15a32f49c944c165402fe15520e65750d568b901 100644 --- a/src/lib_client_base_unix/client_config.ml +++ b/src/lib_client_base_unix/client_config.ml @@ -276,12 +276,15 @@ module Cfg_file = struct let from_json json = Data_encoding.Json.destruct encoding json let read fp = - Lwt_utils_unix.Json.read_file fp >>=? fun json -> return (from_json json) + Lwt_utils_unix.Json.read_file fp + >|= tzresult_of_exn_result + >>=? fun json -> return (from_json json) let write out cfg = Lwt_utils_unix.Json.write_file out (Data_encoding.Json.construct encoding cfg) + >|= tzresult_of_exn_result end let default_cli_args = @@ -516,6 +519,7 @@ let client_mode_arg () = let read_config_file config_file = Lwt_utils_unix.Json.read_file config_file + >|= tzresult_of_exn_result >>= function | Error errs -> failwith @@ -652,6 +656,7 @@ let config_init_mockup cctxt protocol_hash_opt bootstrap_accounts_file protocol_constants in Lwt_utils_unix.Json.write_file protocol_constants_file string_to_write + >|= tzresult_of_exn_result >>=? fun () -> cctxt#message "Written default --%s file: %s" diff --git a/src/lib_client_base_unix/client_context_unix.ml b/src/lib_client_base_unix/client_context_unix.ml index 9bc579fad58020f19d10a239bfc50e2a4f55a1a1..070d58c8c364879acb4b9c6ee34c77c40cd2bc49 100644 --- a/src/lib_client_base_unix/client_context_unix.ml +++ b/src/lib_client_base_unix/client_context_unix.ml @@ -85,6 +85,7 @@ class unix_wallet ~base_dir ~password_filename : Client_context.wallet = if not (Sys.file_exists filename) then return default else Lwt_utils_unix.Json.read_file filename + >|= tzresult_of_exn_result |> generic_trace "could not read the %s alias file" alias_name >>=? fun json -> match Data_encoding.Json.destruct encoding json with @@ -106,7 +107,8 @@ class unix_wallet ~base_dir ~password_filename : Client_context.wallet = >>= fun () -> let filename = self#filename alias_name in let json = Data_encoding.Json.construct encoding list in - Lwt_utils_unix.Json.write_file filename json) + Lwt_utils_unix.Json.write_file filename json + >|= tzresult_of_exn_result) (fun exn -> Lwt.return (error_exn exn)) |> generic_trace "could not write the %s alias file." alias_name end diff --git a/src/lib_client_base_unix/test/test_mockup_wallet.ml b/src/lib_client_base_unix/test/test_mockup_wallet.ml index f55c4d765e8822181eddc98189f3a45f21dff814..9e0fec366ce7ef1dbaf8f92d6d9b476b4d2bb64b 100644 --- a/src/lib_client_base_unix/test/test_mockup_wallet.ml +++ b/src/lib_client_base_unix/test/test_mockup_wallet.ml @@ -162,6 +162,7 @@ let test_with_valid_bootstrap_accounts_file_populates = Lwt_utils_unix.Json.write_file bootstrap_accounts_file_path bootstrap_accounts + >|= tzresult_of_exn_result >>=? fun () -> populate io_wallet (Some bootstrap_accounts_file_path) >>=? fun () -> diff --git a/src/lib_error_monad/error_monad.ml b/src/lib_error_monad/error_monad.ml index fc4f6fc10f088fd72ea330b8aa35b0e57749a9fc..dc7f4b73a79bd203b66da1335d1dfbff124f2177 100644 --- a/src/lib_error_monad/error_monad.ml +++ b/src/lib_error_monad/error_monad.ml @@ -55,6 +55,9 @@ let () = None) (fun msg -> Exn (Failure msg)) +let tzresult_of_exn_result r = + Result.map_error (fun exc -> TzTrace.make @@ Exn exc) r + let generic_error fmt = Format.kasprintf (fun s -> error (Exn (Failure s))) fmt let failwith fmt = Format.kasprintf (fun s -> fail (Exn (Failure s))) fmt diff --git a/src/lib_error_monad/error_monad.mli b/src/lib_error_monad/error_monad.mli index b1c0cddc8c25272ad7129b284f29c249e99bc11b..1577052f064baf365b1df93ca92c8ef4cc96ba94 100644 --- a/src/lib_error_monad/error_monad.mli +++ b/src/lib_error_monad/error_monad.mli @@ -78,6 +78,8 @@ val failure : ('a, Format.formatter, unit, error) format4 -> 'a (** Wrapped OCaml/Lwt exception *) type error += Exn of exn +val tzresult_of_exn_result : ('a, exn) result -> 'a tzresult + type error += Canceled (** [protect] is a wrapper around [Lwt.catch] where the error handler operates diff --git a/src/lib_mockup/local_services.ml b/src/lib_mockup/local_services.ml index e4711bb071a49d60e1391f31b60f67cb82f711bf..13224c4edf4650f8739c6ae2215273a1d701d936 100644 --- a/src/lib_mockup/local_services.ml +++ b/src/lib_mockup/local_services.ml @@ -241,6 +241,7 @@ module Make (E : MENV) = struct let unsafe_read () = Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file file + >|= tzresult_of_exn_result >>=? fun json -> return @@ Data_encoding.Json.destruct ops_encoding json let read () = @@ -256,6 +257,7 @@ module Make (E : MENV) = struct >>=? fun ops -> let json = Data_encoding.Json.construct ops_encoding ops in Tezos_stdlib_unix.Lwt_utils_unix.Json.write_file file json + >|= tzresult_of_exn_result let append = write ~mode:Append end diff --git a/src/lib_mockup/mockup_wallet.ml b/src/lib_mockup/mockup_wallet.ml index 909212a42e2af9f3426050a8eb99ac0ed59e3c84..d3d5ce9011ec55f564f14f3ae823c194d43fcc17 100644 --- a/src/lib_mockup/mockup_wallet.ml +++ b/src/lib_mockup/mockup_wallet.ml @@ -85,6 +85,7 @@ let populate (cctxt : #Tezos_client_base.Client_context.io_wallet) default_bootstrap_accounts | Some accounts_file -> ( Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file accounts_file + >|= tzresult_of_exn_result >>=? fun json -> match Data_encoding.Json.destruct bootstrap_secrets_encoding json with | accounts -> diff --git a/src/lib_mockup/persistence.ml b/src/lib_mockup/persistence.ml index 485aa9f6423b183fbdbe8ddb277cd28671a03702..3b38b37b72e84efb55cb02c43e2973bf8bfbd4b7 100644 --- a/src/lib_mockup/persistence.ml +++ b/src/lib_mockup/persistence.ml @@ -169,6 +169,7 @@ module Internal = struct failwith "get_mockup_context_from_disk: file %s not found" file else Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file file + >|= tzresult_of_exn_result >>=? fun context_json -> match Persistent_mockup_environment.of_json context_json with | persisted_mockup -> @@ -203,6 +204,7 @@ module Internal = struct Persistent_mockup_environment.( to_json {protocol_hash; chain_id; rpc_context}) |> Tezos_stdlib_unix.Lwt_utils_unix.Json.write_file context_file + >|= tzresult_of_exn_result type base_dir_class = | Base_dir_does_not_exist @@ -288,6 +290,7 @@ module Internal = struct Persistent_mockup_environment.( to_json {protocol_hash; chain_id; rpc_context}) |> Tezos_stdlib_unix.Lwt_utils_unix.Json.write_file context_file + >|= tzresult_of_exn_result >>=? fun () -> if asynchronous then (* Setup a local persistent mempool *) diff --git a/src/lib_p2p/p2p_discovery.ml b/src/lib_p2p/p2p_discovery.ml index e7f049ba8f5141d45ac1f22f0044619821b80223..7188e346839fd44567a9478f8bbcf82e87872729 100644 --- a/src/lib_p2p/p2p_discovery.ml +++ b/src/lib_p2p/p2p_discovery.ml @@ -59,6 +59,7 @@ module Answer = struct Lwt_unix.set_close_on_exec socket ; Lwt_canceler.on_cancel st.canceler (fun () -> Lwt_utils_unix.safe_close socket + >|= tzresult_of_exn_result >>= function | Error trace -> Format.eprintf "Uncaught error: %a\n%!" pp_print_error trace ; @@ -176,6 +177,7 @@ module Sender = struct let socket = Lwt_unix.(socket PF_INET SOCK_DGRAM 0) in Lwt_canceler.on_cancel st.canceler (fun () -> Lwt_utils_unix.safe_close socket + >|= tzresult_of_exn_result >>= function | Error trace -> Format.eprintf "Uncaught error: %a\n%!" pp_print_error trace ; @@ -192,6 +194,7 @@ module Sender = struct Lwt_unix.sendto socket msg 0 Message.length [] addr >>= fun _len -> Lwt_utils_unix.safe_close socket + >|= tzresult_of_exn_result >>= function | Error trace -> Format.eprintf "Uncaught error: %a\n%!" pp_print_error trace ; diff --git a/src/lib_p2p/p2p_fd.ml b/src/lib_p2p/p2p_fd.ml index 111f13ead5d1d8426eb4b7ff3c83f447b7357a36..f71ca10160dbf72faca5e118685f6f43ad87a97b 100644 --- a/src/lib_p2p/p2p_fd.ml +++ b/src/lib_p2p/p2p_fd.ml @@ -68,7 +68,7 @@ let socket proto kind arg = let close t = Events.(emit close_fd) (t.id, t.nread, t.nwrit) - >>= fun () -> Lwt_utils_unix.safe_close t.fd + >>= fun () -> Lwt_utils_unix.safe_close t.fd >|= tzresult_of_exn_result let read t buf pos len = Events.(emit try_read) (t.id, len) diff --git a/src/lib_p2p/p2p_peer_state.ml b/src/lib_p2p/p2p_peer_state.ml index eae4949e0c8d937b9aab465a210441566357862c..8287b5f91a50f9476320a33bf37fee3f3a08bc31 100644 --- a/src/lib_p2p/p2p_peer_state.ml +++ b/src/lib_p2p/p2p_peer_state.ml @@ -194,6 +194,7 @@ module Info = struct let enc = Data_encoding.list (encoding peer_metadata_encoding) in if path <> "/dev/null" && Sys.file_exists path then Lwt_utils_unix.Json.read_file path + >|= tzresult_of_exn_result >>=? fun json -> return (Data_encoding.Json.destruct enc json) else return_nil @@ -205,6 +206,7 @@ module Info = struct let tempfile = path ^ ".tmp" in Lwt_utils_unix.Json.write_file tempfile @@ Json.construct (list (encoding peer_metadata_encoding)) peers + >|= tzresult_of_exn_result >>=? fun () -> protect (fun () -> Lwt_unix.rename tempfile path >>= fun () -> return_unit) diff --git a/src/lib_p2p/p2p_welcome.ml b/src/lib_p2p/p2p_welcome.ml index da011dbe2618738b73d7fcddc898a5c08d164384..9940174c54b947750ff50f14e82442211d05383d 100644 --- a/src/lib_p2p/p2p_welcome.ml +++ b/src/lib_p2p/p2p_welcome.ml @@ -122,6 +122,7 @@ let create ?addr ~backlog connect_handler port = let canceler = Lwt_canceler.create () in Lwt_canceler.on_cancel canceler (fun () -> Lwt_utils_unix.safe_close socket + >|= tzresult_of_exn_result >>= function | Error trace -> Format.eprintf "Uncaught error: %a\n%!" pp_print_error trace ; diff --git a/src/lib_p2p/test/p2p_test_utils.ml b/src/lib_p2p/test/p2p_test_utils.ml index 677f1f1a88c00038ec307551086ecc6186e2fb19..c54ec29af268e26da6ec57ff467c58e4ab827b42 100644 --- a/src/lib_p2p/test/p2p_test_utils.ml +++ b/src/lib_p2p/test/p2p_test_utils.ml @@ -175,6 +175,7 @@ let run_nodes client server = >>=? fun server_node -> Process.detach ~prefix:"client: " (fun channel -> Lwt_utils_unix.safe_close main_socket + >|= tzresult_of_exn_result >>= (function | Error trace -> Format.eprintf "Uncaught error: %a\n%!" pp_print_error trace ; diff --git a/src/lib_p2p/test/test_p2p_io_scheduler.ml b/src/lib_p2p/test/test_p2p_io_scheduler.ml index e3b95d321437d5a1a744b5870744f61aa6e30b87..21714bdd0c19b0dff9afd5dfb288509c01341eff 100644 --- a/src/lib_p2p/test/test_p2p_io_scheduler.ml +++ b/src/lib_p2p/test/test_p2p_io_scheduler.ml @@ -193,6 +193,7 @@ let run ?display_client_stat ?max_download_speed ?max_upload_speed let prefix = Printf.sprintf "client(%d): " n in Process.detach ~prefix (fun _ -> Lwt_utils_unix.safe_close main_socket + >|= tzresult_of_exn_result >>= (function | Error trace -> Format.eprintf "Uncaught error: %a\n%!" pp_print_error trace ; diff --git a/src/lib_shell/bench/bench_tool.ml b/src/lib_shell/bench/bench_tool.ml index db50219751ce1047f96729ac1ff8267b70b94fe8..d6383c3e19fe59196a8e9648d36f6233298fb782 100644 --- a/src/lib_shell/bench/bench_tool.ml +++ b/src/lib_shell/bench/bench_tool.ml @@ -69,6 +69,7 @@ let parse_param_file name = failwith "Parameters : Inexistent JSON file" else Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file name + >|= tzresult_of_exn_result >>=? fun json -> match Data_encoding.Json.destruct Parameters.encoding json with | exception exn -> diff --git a/src/lib_stdlib_unix/file_event_sink.ml b/src/lib_stdlib_unix/file_event_sink.ml index 4142ae9e8760d05ccc154c577f7a3a7c18025aeb..19fdeb2141147a79a764aa41d7184c35b55378c9 100644 --- a/src/lib_stdlib_unix/file_event_sink.ml +++ b/src/lib_stdlib_unix/file_event_sink.ml @@ -289,14 +289,13 @@ module Sink_implementation : Internal_event.SINK with type t = t = struct >>= function | Ok () -> return_unit - | Error el -> + | Error exc -> failwith - "ERROR while Handling %a,@ cannot write JSON to %s:@ %a\n%!" + "ERROR while Handling %a,@ cannot write JSON to %s:@ %s\n%!" pp () file_path - Error_monad.pp_print_error - el) + (Printexc.to_string exc)) (function | e -> failwith @@ -572,7 +571,8 @@ module Query = struct >>=? fun user_return -> return (fst previous, user_return) with e -> return_with_error previous (`Parsing_event (`Encoding (path, e))) ) - | Error el -> + | Error exc -> + let el = TzTrace.make @@ Exn exc in return_with_error previous (`Parsing_event (`Json (path, el))) in fold_event_kind_directory diff --git a/src/lib_stdlib_unix/internal_event_unix.ml b/src/lib_stdlib_unix/internal_event_unix.ml index 5a4b947b828fe4876933bb0d4b6e2b477c259d2d..d1fa6cf9acdd5958f7a4162099bb739f19ec6112 100644 --- a/src/lib_stdlib_unix/internal_event_unix.ml +++ b/src/lib_stdlib_unix/internal_event_unix.ml @@ -45,6 +45,7 @@ module Configuration = struct let of_file path = Lwt_utils_unix.Json.read_file path + >|= Error_monad.tzresult_of_exn_result >>=? fun json -> protect (fun () -> return (Data_encoding.Json.destruct encoding json)) diff --git a/src/lib_stdlib_unix/lwt_lock_file.ml b/src/lib_stdlib_unix/lwt_lock_file.ml index 47ec04e3218a742cf72317f63187c153730ad94a..7ef2240c980d64002ef7eac1f11292d41ca11e74 100644 --- a/src/lib_stdlib_unix/lwt_lock_file.ml +++ b/src/lib_stdlib_unix/lwt_lock_file.ml @@ -24,34 +24,34 @@ (* *) (*****************************************************************************) -open Error_monad +open Lwt.Infix let create ?(close_on_exec = true) ?(unlink_on_exit = false) fn = - protect (fun () -> - let flags = - let open Unix in - let flags = [O_TRUNC; O_CREAT; O_WRONLY] in - if close_on_exec then O_CLOEXEC :: flags else flags - in - Lwt_unix.openfile fn flags 0o644 - >>= fun fd -> - Lwt_unix.lockf fd Unix.F_TLOCK 0 - >>= fun () -> - if unlink_on_exit then Lwt_main.at_exit (fun () -> Lwt_unix.unlink fn) ; - let pid_str = string_of_int @@ Unix.getpid () in - Lwt_unix.write_string fd pid_str 0 (String.length pid_str) - >>= fun _ -> return_unit) + Lwt_result.catch + (let flags = + let open Unix in + let flags = [O_TRUNC; O_CREAT; O_WRONLY] in + if close_on_exec then O_CLOEXEC :: flags else flags + in + Lwt_unix.openfile fn flags 0o644 + >>= fun fd -> + Lwt_unix.lockf fd Unix.F_TLOCK 0 + >>= fun () -> + if unlink_on_exit then Lwt_main.at_exit (fun () -> Lwt_unix.unlink fn) ; + let pid_str = string_of_int @@ Unix.getpid () in + Lwt_unix.write_string fd pid_str 0 (String.length pid_str) + >>= fun _ -> Lwt.return_unit) let is_locked fn = - if not @@ Sys.file_exists fn then return_false + if not @@ Sys.file_exists fn then Lwt.return_ok false else - protect (fun () -> - Lwt_unix.openfile fn Unix.[O_RDONLY; O_CLOEXEC] 0o644 - >>= fun fd -> - Lwt.finalize - (fun () -> - Lwt.try_bind - (fun () -> Lwt_unix.(lockf fd F_TEST 0)) - (fun () -> return_false) - (fun _ -> return_true)) - (fun () -> Lwt_unix.close fd)) + Lwt_result.catch + ( Lwt_unix.openfile fn Unix.[O_RDONLY; O_CLOEXEC] 0o644 + >>= fun fd -> + Lwt.finalize + (fun () -> + Lwt.try_bind + (fun () -> Lwt_unix.(lockf fd F_TEST 0)) + (fun () -> Lwt.return_false) + (fun _ -> Lwt.return_true)) + (fun () -> Lwt_unix.close fd) ) diff --git a/src/lib_stdlib_unix/lwt_lock_file.mli b/src/lib_stdlib_unix/lwt_lock_file.mli index a3b8f30391d48f3f3a6af3a514a3d2ea7ae0856c..e8f8cc164887ac66325946402c1a4949cfdf2b0f 100644 --- a/src/lib_stdlib_unix/lwt_lock_file.mli +++ b/src/lib_stdlib_unix/lwt_lock_file.mli @@ -23,9 +23,10 @@ (* *) (*****************************************************************************) -open Error_monad - val create : - ?close_on_exec:bool -> ?unlink_on_exit:bool -> string -> unit tzresult Lwt.t + ?close_on_exec:bool -> + ?unlink_on_exit:bool -> + string -> + (unit, exn) result Lwt.t -val is_locked : string -> bool tzresult Lwt.t +val is_locked : string -> (bool, exn) result Lwt.t diff --git a/src/lib_stdlib_unix/lwt_utils_unix.ml b/src/lib_stdlib_unix/lwt_utils_unix.ml index 248a83673079d2adc1bb7acc332ba7bea03acc78..05617959293e9ea76ee63661aed2647474e4357d 100644 --- a/src/lib_stdlib_unix/lwt_utils_unix.ml +++ b/src/lib_stdlib_unix/lwt_utils_unix.ml @@ -24,9 +24,10 @@ (* *) (*****************************************************************************) -open Error_monad +open Lwt.Infix let () = + let open Error_monad in register_error_kind `Temporary ~id:"unix_error" @@ -175,10 +176,7 @@ let rec create_dir ?(perm = 0o755) dir = | _ -> Stdlib.failwith "Not a directory" ) -let safe_close fd = - Lwt.catch - (fun () -> Lwt_unix.close fd >>= fun () -> return_unit) - (fun exc -> fail (Exn exc)) +let safe_close fd = Lwt_result.catch (Lwt_unix.close fd) let create_file ?(close_on_exec = true) ?(perm = 0o644) name content = let flags = @@ -193,16 +191,16 @@ let create_file ?(close_on_exec = true) ?(perm = 0o644) name content = (fun v -> safe_close fd >>= function - | Error trace -> - Format.eprintf "Uncaught error: %a\n%!" pp_print_error trace ; + | Error exc -> + Format.eprintf "Uncaught error: %s\n%!" (Printexc.to_string exc) ; Lwt.return v | Ok () -> Lwt.return v) (fun exc -> safe_close fd >>= function - | Error trace -> - Format.eprintf "Uncaught error: %a\n%!" pp_print_error trace ; + | Error exc -> + Format.eprintf "Uncaught error: %s\n%!" (Printexc.to_string exc) ; raise exc | Ok () -> raise exc) @@ -296,17 +294,16 @@ module Json = struct let write_file file json = let json = to_root json in - protect (fun () -> - Lwt_io.with_file ~mode:Output file (fun chan -> - let str = Data_encoding.Json.to_string ~minify:false json in - Lwt_io.write chan str >|= ok)) + Lwt_result.catch + (Lwt_io.with_file ~mode:Output file (fun chan -> + let str = Data_encoding.Json.to_string ~minify:false json in + Lwt_io.write chan str)) let read_file file = - protect (fun () -> - Lwt_io.with_file ~mode:Input file (fun chan -> - Lwt_io.read chan - >>= fun str -> - return (Ezjsonm.from_string str :> Data_encoding.json))) + Lwt_result.catch + (Lwt_io.with_file ~mode:Input file (fun chan -> + Lwt_io.read chan + >|= fun str -> (Ezjsonm.from_string str :> Data_encoding.json))) end let with_tempdir name f = @@ -336,6 +333,8 @@ type 'action io_error = { arg : string; } +let ( >>=? ) = Lwt_result.bind + let with_open_file ~flags ?(perm = 0o640) filename task = Lwt.catch (fun () -> @@ -345,19 +344,16 @@ let with_open_file ~flags ?(perm = 0o640) filename task = Lwt.return (Error {action = `Open; unix_code; caller; arg}) | exn -> raise exn) - >>= function - | Error _ as x -> - Lwt.return x - | Ok fd -> - task fd - >>= fun res -> - Lwt.catch - (fun () -> Lwt_unix.close fd >>= fun () -> return res) - (function - | Unix.Unix_error (unix_code, caller, arg) -> - Lwt.return (Error {action = `Close; unix_code; caller; arg}) - | exn -> - raise exn) + >>=? fun fd -> + task fd + >>= fun res -> + Lwt.catch + (fun () -> Lwt_unix.close fd >|= fun () -> Ok res) + (function + | Unix.Unix_error (unix_code, caller, arg) -> + Lwt.return (Error {action = `Close; unix_code; caller; arg}) + | exn -> + raise exn) let with_open_out ?(overwrite = true) file task = let flags = diff --git a/src/lib_stdlib_unix/lwt_utils_unix.mli b/src/lib_stdlib_unix/lwt_utils_unix.mli index 1ce14d6fb2bcd2d9f12b6470c761bc779391e62d..0c505d2a235681aea46af362e3897ce7e29aa8d3 100644 --- a/src/lib_stdlib_unix/lwt_utils_unix.mli +++ b/src/lib_stdlib_unix/lwt_utils_unix.mli @@ -24,8 +24,6 @@ (* *) (*****************************************************************************) -open Error_monad - (** [default_net_timeout] is the default timeout used by functions in this library which admit a timeout value, i.e. [read_bytes_with_timeout], [Socket.connect], [Socket.recv]. *) @@ -99,7 +97,7 @@ val create_file : val with_tempdir : string -> (string -> 'a Lwt.t) -> 'a Lwt.t -val safe_close : Lwt_unix.file_descr -> unit tzresult Lwt.t +val safe_close : Lwt_unix.file_descr -> (unit, exn) result Lwt.t val getaddrinfo : passive:bool -> @@ -113,10 +111,10 @@ val getpass : unit -> string module Json : sig (** Loads a JSON file in memory *) - val read_file : string -> Data_encoding.json tzresult Lwt.t + val read_file : string -> (Data_encoding.json, exn) result Lwt.t (** (Over)write a JSON file from in memory data *) - val write_file : string -> Data_encoding.json -> unit tzresult Lwt.t + val write_file : string -> Data_encoding.json -> (unit, exn) result Lwt.t end val retry : diff --git a/src/lib_store/legacy_store/legacy_store_builder.ml b/src/lib_store/legacy_store/legacy_store_builder.ml index 97bfeeee6efaa340c1e7632d03821d9a7e43d2ad..70c11f0bf7111c06d7bfb815b5fb9661f8a0c499 100644 --- a/src/lib_store/legacy_store/legacy_store_builder.ml +++ b/src/lib_store/legacy_store/legacy_store_builder.ml @@ -122,6 +122,7 @@ let generate identity_file pow = Lwt_utils_unix.Json.write_file identity_file (Data_encoding.Json.construct P2p_identity.encoding id) + >|= tzresult_of_exn_result >>=? fun () -> return_unit let dump_config data_dir = @@ -135,6 +136,7 @@ let dump_config data_dir = Lwt_utils_unix.Json.write_file version_file (Data_encoding.Json.construct version_encoding data_version) + >|= tzresult_of_exn_result in write_version_file data_dir >>=? fun () -> diff --git a/src/lib_store/snapshots.ml b/src/lib_store/snapshots.ml index a991894cd1a663c1d1887fc001078fe6b04fefee..c486cd0db3305b0d2a64dd0ec65aeb54a6a20539 100644 --- a/src/lib_store/snapshots.ml +++ b/src/lib_store/snapshots.ml @@ -2482,6 +2482,7 @@ module Raw_loader : LOADER = struct Data_encoding.Json.destruct metadata_encoding json in Lwt_utils_unix.Json.read_file metadata_file + >|= tzresult_of_exn_result >>=? fun json -> return (read_config json) let close _ = Lwt.return_unit @@ -2630,6 +2631,7 @@ module Raw_importer : IMPORTER = struct Data_encoding.Json.destruct metadata_encoding json in Lwt_utils_unix.Json.read_file metadata_file + >|= tzresult_of_exn_result >>=? fun json -> return (read_config json) let load_block_data t = diff --git a/src/proto_000_Ps9mPmXa/lib_client/client_proto_main.ml b/src/proto_000_Ps9mPmXa/lib_client/client_proto_main.ml index e3fe4cf71a83d04a15789e2664cc540747ddfd23..4029b5ed2f9d094e68bac0a120ffbb1b47d5ef45 100644 --- a/src/proto_000_Ps9mPmXa/lib_client/client_proto_main.ml +++ b/src/proto_000_Ps9mPmXa/lib_client/client_proto_main.ml @@ -136,6 +136,7 @@ let commands () = (cctxt : Client_context.full) -> let fitness = fitness_from_int64 fitness in Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file param_json_file + >|= tzresult_of_exn_result >>=? fun json -> let protocol_parameters = Data_encoding.Binary.to_bytes_exn Data_encoding.json json diff --git a/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml b/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml index a6323f0594447a0d9726637cf8e8c9227d6b8a59..e693bf5c67e4e72ea19d7ed8359e935a27977ffc 100644 --- a/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_006_PsCARTHA/lib_client_commands/client_proto_context_commands.ml @@ -69,9 +69,10 @@ let json_file_or_text_parameter = | ["text"; text] -> return (Ezjsonm.from_string text) | ["file"; path] -> - Lwt_utils_unix.Json.read_file path + Lwt_utils_unix.Json.read_file path >|= tzresult_of_exn_result | _ -> ( - if Sys.file_exists p then Lwt_utils_unix.Json.read_file p + if Sys.file_exists p then + Lwt_utils_unix.Json.read_file p >|= tzresult_of_exn_result else try return (Ezjsonm.from_string p) with Ezjsonm.Parse_error _ -> diff --git a/src/proto_008_PtEdo2Zk/lib_client_commands/client_proto_context_commands.ml b/src/proto_008_PtEdo2Zk/lib_client_commands/client_proto_context_commands.ml index cdafa53cb67ba92d06ccc6805417f37483fefb7c..af1d807b28b8a025daa60f633773814662879b49 100644 --- a/src/proto_008_PtEdo2Zk/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_008_PtEdo2Zk/lib_client_commands/client_proto_context_commands.ml @@ -69,9 +69,10 @@ let json_file_or_text_parameter = | ["text"; text] -> return (Ezjsonm.from_string text) | ["file"; path] -> - Lwt_utils_unix.Json.read_file path + Lwt_utils_unix.Json.read_file path >|= tzresult_of_exn_result | _ -> ( - if Sys.file_exists p then Lwt_utils_unix.Json.read_file p + if Sys.file_exists p then + Lwt_utils_unix.Json.read_file p >|= tzresult_of_exn_result else try return (Ezjsonm.from_string p) with Ezjsonm.Parse_error _ -> diff --git a/src/proto_008_PtEdo2Zk/lib_client_sapling/client_sapling_commands.ml b/src/proto_008_PtEdo2Zk/lib_client_sapling/client_sapling_commands.ml index 0e87dd733e6d93e9a5b8cafb83e9caf70a5c610d..026ee8a7b67d0887eef19fc7399ffaa6ca72d4b2 100644 --- a/src/proto_008_PtEdo2Zk/lib_client_sapling/client_sapling_commands.ml +++ b/src/proto_008_PtEdo2Zk/lib_client_sapling/client_sapling_commands.ml @@ -499,6 +499,7 @@ let submit_shielded_cmd = let open Context in ( if use_json_format then Lwt_utils_unix.Json.read_file filename + >|= tzresult_of_exn_result >>=? fun json -> return @@ Data_encoding.Json.destruct UTXO.transaction_encoding json else diff --git a/src/proto_008_PtEdo2Zk/lib_delegate/client_baking_forge.ml b/src/proto_008_PtEdo2Zk/lib_delegate/client_baking_forge.ml index c5c40f9ae693c903b8d341f0f50f7dd3658fe918..b5f0b25f1550d090ead336cfaf9dd9e5db69cc8b 100644 --- a/src/proto_008_PtEdo2Zk/lib_delegate/client_baking_forge.ml +++ b/src/proto_008_PtEdo2Zk/lib_delegate/client_baking_forge.ml @@ -496,6 +496,7 @@ let unopt_operations cctxt chain mempool = function return ops | Some file -> Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file file + >|= tzresult_of_exn_result >>=? fun json -> let mpool = Data_encoding.Json.destruct diff --git a/src/proto_008_PtEdo2Zk/lib_delegate/delegate_commands.ml b/src/proto_008_PtEdo2Zk/lib_delegate/delegate_commands.ml index f7bcf06e678c020aa3dfc3693719e79dae202f2d..27819f04b3713e4b9c14ec6db38fe2655682a214 100644 --- a/src/proto_008_PtEdo2Zk/lib_delegate/delegate_commands.ml +++ b/src/proto_008_PtEdo2Zk/lib_delegate/delegate_commands.ml @@ -68,7 +68,8 @@ let may_lock_pidfile = function return_unit | Some pidfile -> trace (failure "Failed to create the pidfile: %s" pidfile) - @@ Lwt_lock_file.create ~unlink_on_exit:true pidfile + @@ ( Lwt_lock_file.create ~unlink_on_exit:true pidfile + >|= tzresult_of_exn_result ) let block_param t = Clic.param diff --git a/src/proto_009_PsFLoren/lib_client_commands/client_proto_context_commands.ml b/src/proto_009_PsFLoren/lib_client_commands/client_proto_context_commands.ml index e1fb772e0676cc96c6650aed5f3caa71b2147dab..09eef38a7b5f48e34c9b50f5b8d87c43260702c7 100644 --- a/src/proto_009_PsFLoren/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_009_PsFLoren/lib_client_commands/client_proto_context_commands.ml @@ -69,9 +69,10 @@ let json_file_or_text_parameter = | ["text"; text] -> return (Ezjsonm.from_string text) | ["file"; path] -> - Lwt_utils_unix.Json.read_file path + Lwt_utils_unix.Json.read_file path >|= tzresult_of_exn_result | _ -> ( - if Sys.file_exists p then Lwt_utils_unix.Json.read_file p + if Sys.file_exists p then + Lwt_utils_unix.Json.read_file p >|= tzresult_of_exn_result else try return (Ezjsonm.from_string p) with Ezjsonm.Parse_error _ -> diff --git a/src/proto_009_PsFLoren/lib_client_sapling/client_sapling_commands.ml b/src/proto_009_PsFLoren/lib_client_sapling/client_sapling_commands.ml index ca3b8647d0594b1fb0e1bbcd1fc2fdd0e92cb182..680f73e494d7aa31e197eff343116f87aaf1f4d6 100644 --- a/src/proto_009_PsFLoren/lib_client_sapling/client_sapling_commands.ml +++ b/src/proto_009_PsFLoren/lib_client_sapling/client_sapling_commands.ml @@ -499,6 +499,7 @@ let submit_shielded_cmd = let open Context in ( if use_json_format then Lwt_utils_unix.Json.read_file filename + >|= tzresult_of_exn_result >>=? fun json -> return @@ Data_encoding.Json.destruct UTXO.transaction_encoding json else diff --git a/src/proto_009_PsFLoren/lib_delegate/client_baking_forge.ml b/src/proto_009_PsFLoren/lib_delegate/client_baking_forge.ml index 7bc030f5df4a713a6872cb47b6a8fe29fe1155b3..97316e470cfe5a7896509c5af86111bd79d402bb 100644 --- a/src/proto_009_PsFLoren/lib_delegate/client_baking_forge.ml +++ b/src/proto_009_PsFLoren/lib_delegate/client_baking_forge.ml @@ -494,6 +494,7 @@ let unopt_operations cctxt chain mempool = function return ops | Some file -> Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file file + >|= tzresult_of_exn_result >>=? fun json -> let mpool = Data_encoding.Json.destruct diff --git a/src/proto_009_PsFLoren/lib_delegate/delegate_commands.ml b/src/proto_009_PsFLoren/lib_delegate/delegate_commands.ml index f7bcf06e678c020aa3dfc3693719e79dae202f2d..27819f04b3713e4b9c14ec6db38fe2655682a214 100644 --- a/src/proto_009_PsFLoren/lib_delegate/delegate_commands.ml +++ b/src/proto_009_PsFLoren/lib_delegate/delegate_commands.ml @@ -68,7 +68,8 @@ let may_lock_pidfile = function return_unit | Some pidfile -> trace (failure "Failed to create the pidfile: %s" pidfile) - @@ Lwt_lock_file.create ~unlink_on_exit:true pidfile + @@ ( Lwt_lock_file.create ~unlink_on_exit:true pidfile + >|= tzresult_of_exn_result ) let block_param t = Clic.param diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml index e1fb772e0676cc96c6650aed5f3caa71b2147dab..09eef38a7b5f48e34c9b50f5b8d87c43260702c7 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml @@ -69,9 +69,10 @@ let json_file_or_text_parameter = | ["text"; text] -> return (Ezjsonm.from_string text) | ["file"; path] -> - Lwt_utils_unix.Json.read_file path + Lwt_utils_unix.Json.read_file path >|= tzresult_of_exn_result | _ -> ( - if Sys.file_exists p then Lwt_utils_unix.Json.read_file p + if Sys.file_exists p then + Lwt_utils_unix.Json.read_file p >|= tzresult_of_exn_result else try return (Ezjsonm.from_string p) with Ezjsonm.Parse_error _ -> diff --git a/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml b/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml index ca3b8647d0594b1fb0e1bbcd1fc2fdd0e92cb182..680f73e494d7aa31e197eff343116f87aaf1f4d6 100644 --- a/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml +++ b/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml @@ -499,6 +499,7 @@ let submit_shielded_cmd = let open Context in ( if use_json_format then Lwt_utils_unix.Json.read_file filename + >|= tzresult_of_exn_result >>=? fun json -> return @@ Data_encoding.Json.destruct UTXO.transaction_encoding json else diff --git a/src/proto_alpha/lib_delegate/client_baking_forge.ml b/src/proto_alpha/lib_delegate/client_baking_forge.ml index b0ccfc7cfa52bd2fcde734d8465a75554e77d3da..514d5751c850e089c33ca9542521f37467784025 100644 --- a/src/proto_alpha/lib_delegate/client_baking_forge.ml +++ b/src/proto_alpha/lib_delegate/client_baking_forge.ml @@ -500,6 +500,7 @@ let unopt_operations cctxt chain mempool = function return ops | Some file -> Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file file + >|= tzresult_of_exn_result >>=? fun json -> let mpool = Data_encoding.Json.destruct diff --git a/src/proto_alpha/lib_delegate/delegate_commands.ml b/src/proto_alpha/lib_delegate/delegate_commands.ml index f7bcf06e678c020aa3dfc3693719e79dae202f2d..27819f04b3713e4b9c14ec6db38fe2655682a214 100644 --- a/src/proto_alpha/lib_delegate/delegate_commands.ml +++ b/src/proto_alpha/lib_delegate/delegate_commands.ml @@ -68,7 +68,8 @@ let may_lock_pidfile = function return_unit | Some pidfile -> trace (failure "Failed to create the pidfile: %s" pidfile) - @@ Lwt_lock_file.create ~unlink_on_exit:true pidfile + @@ ( Lwt_lock_file.create ~unlink_on_exit:true pidfile + >|= tzresult_of_exn_result ) let block_param t = Clic.param diff --git a/src/proto_genesis/lib_client/client_proto_main.ml b/src/proto_genesis/lib_client/client_proto_main.ml index 6bc3af382dc1a73e1afa4ee9872884c4d4bdd078..9667581780dd33b0434cd70131b47d7a9b9b948b 100644 --- a/src/proto_genesis/lib_client/client_proto_main.ml +++ b/src/proto_genesis/lib_client/client_proto_main.ml @@ -145,6 +145,7 @@ let commands () = (cctxt : Client_context.full) -> let fitness = fitness_from_int64 fitness in Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file param_json_file + >|= tzresult_of_exn_result >>=? fun json -> let protocol_parameters = Data_encoding.Binary.to_bytes_exn Data_encoding.json json @@ -182,6 +183,7 @@ let commands () = (fun (timestamp, delay) hash fitness sk param_json_file cctxt -> let fitness = fitness_from_int64 fitness in Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file param_json_file + >|= tzresult_of_exn_result >>=? fun json -> let protocol_parameters = Data_encoding.Binary.to_bytes_exn Data_encoding.json json diff --git a/src/proto_genesis_carthagenet/lib_client/client_proto_main.ml b/src/proto_genesis_carthagenet/lib_client/client_proto_main.ml index e49bc5205298a3872758096e8e6b480479248886..2d4a14b03baf090aae4cc3a2baee973163a6c0ae 100644 --- a/src/proto_genesis_carthagenet/lib_client/client_proto_main.ml +++ b/src/proto_genesis_carthagenet/lib_client/client_proto_main.ml @@ -149,6 +149,7 @@ let commands () = (cctxt : Client_context.full) -> let fitness = fitness_from_int64 fitness in Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file param_json_file + >|= tzresult_of_exn_result >>=? fun json -> let protocol_parameters = Data_encoding.Binary.to_bytes_exn Data_encoding.json json @@ -186,6 +187,7 @@ let commands () = (fun (timestamp, delay) hash fitness sk param_json_file cctxt -> let fitness = fitness_from_int64 fitness in Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file param_json_file + >|= tzresult_of_exn_result >>=? fun json -> let protocol_parameters = Data_encoding.Binary.to_bytes_exn Data_encoding.json json