From d70fdccfff11a574798cb0bc2ae1828e2ea9d414 Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Tue, 5 Dec 2023 17:23:44 +0000 Subject: [PATCH 01/10] Sc_rollup_node: Remove dependency on Error Monad --- src/proto_alpha/lib_sc_rollup_node/RPC_directory.ml | 1 + src/proto_alpha/lib_sc_rollup_node/dal_slots_tracker.ml | 2 +- src/proto_alpha/lib_sc_rollup_node/fueled_pvm.ml | 1 + 3 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_sc_rollup_node/RPC_directory.ml b/src/proto_alpha/lib_sc_rollup_node/RPC_directory.ml index fb6149208365..c29bf12b0bc2 100644 --- a/src/proto_alpha/lib_sc_rollup_node/RPC_directory.ml +++ b/src/proto_alpha/lib_sc_rollup_node/RPC_directory.ml @@ -85,6 +85,7 @@ module Common = struct Z.of_int num_messages let () = + let open Lwt_result_syntax in Block_directory.register0 Sc_rollup_services.Block.hash @@ fun (_node_ctxt, block) () () -> return block diff --git a/src/proto_alpha/lib_sc_rollup_node/dal_slots_tracker.ml b/src/proto_alpha/lib_sc_rollup_node/dal_slots_tracker.ml index ba7676a6bfeb..1282cb8011c0 100644 --- a/src/proto_alpha/lib_sc_rollup_node/dal_slots_tracker.ml +++ b/src/proto_alpha/lib_sc_rollup_node/dal_slots_tracker.ml @@ -271,8 +271,8 @@ module Confirmed_slots_history = struct ~default:read_slots_history_from_l1 let slots_history_cache_of_hash node_ctxt block = + let open Lwt_result_syntax in let find node_ctxt block = - let open Lwt_result_syntax in let+ hist = Node_context.find_confirmed_slots_histories node_ctxt block in Option.map Sc_rollup_proto_types.Dal.Slot_history_cache.of_octez hist in diff --git a/src/proto_alpha/lib_sc_rollup_node/fueled_pvm.ml b/src/proto_alpha/lib_sc_rollup_node/fueled_pvm.ml index 77be540af041..e96ddcbec142 100644 --- a/src/proto_alpha/lib_sc_rollup_node/fueled_pvm.ml +++ b/src/proto_alpha/lib_sc_rollup_node/fueled_pvm.ml @@ -35,6 +35,7 @@ module Make_fueled (F : Fuel.S) : FUELED_PVM with type fuel = F.t = struct type pvm_state = Irmin_context.tree let get_reveal ~dac_client ~data_dir ~pvm_kind reveal_map hash = + let open Lwt_result_syntax in let found_in_map = match reveal_map with | None -> None -- GitLab From b9ed3a9cf9c8be7edac13250ba509e282e6ac9bc Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Tue, 5 Dec 2023 17:24:10 +0000 Subject: [PATCH 02/10] Sc_rollup_client: Remove dependency on Error Monad --- src/proto_alpha/lib_sc_rollup_client/commands.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/proto_alpha/lib_sc_rollup_client/commands.ml b/src/proto_alpha/lib_sc_rollup_client/commands.ml index e32184feeee4..118548853889 100644 --- a/src/proto_alpha/lib_sc_rollup_client/commands.ml +++ b/src/proto_alpha/lib_sc_rollup_client/commands.ml @@ -11,6 +11,7 @@ open Protocol.Alpha_context let possible_block_ids = ["head"; "finalized"; "cemented"; ""; ""] let block_arg = + let open Lwt_result_syntax in Tezos_clic.default_arg ~long:"block" ~short:'B' -- GitLab From 94c77d5db8742bd0f1771db80324e558ddbd9c3f Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Tue, 5 Dec 2023 17:24:33 +0000 Subject: [PATCH 03/10] Demo_counter: Remove dependency on Error Monad --- src/proto_demo_counter/lib_client/client_proto_args.ml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/proto_demo_counter/lib_client/client_proto_args.ml b/src/proto_demo_counter/lib_client/client_proto_args.ml index e2d627828b67..52a4446aa017 100644 --- a/src/proto_demo_counter/lib_client/client_proto_args.ml +++ b/src/proto_demo_counter/lib_client/client_proto_args.ml @@ -25,13 +25,16 @@ type error += Bad_amount_param of (string * string) -let msg_parameter _param = Tezos_clic.parameter (fun _ s -> return s) +let msg_parameter _param = + let open Lwt_result_syntax in + Tezos_clic.parameter (fun _ s -> return s) let amount_parameter param = + let open Lwt_result_syntax in Tezos_clic.parameter (fun _ s -> match Int32.of_string_opt s with | Some amount -> return amount - | None -> fail (Bad_amount_param (param, s))) + | None -> tzfail (Bad_amount_param (param, s))) let amount_param ~name ~desc next = Tezos_clic.param ~name ~desc (amount_parameter name) next -- GitLab From 1cc2596341ffbfc96884c101c1c60df9c7254bcd Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Tue, 5 Dec 2023 17:24:49 +0000 Subject: [PATCH 04/10] Genesis: Remove dependency on Error Monad --- src/proto_genesis/lib_client/client_proto_main.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/proto_genesis/lib_client/client_proto_main.ml b/src/proto_genesis/lib_client/client_proto_main.ml index f85c1915cfda..89f129687351 100644 --- a/src/proto_genesis/lib_client/client_proto_main.ml +++ b/src/proto_genesis/lib_client/client_proto_main.ml @@ -50,6 +50,7 @@ let bake cctxt ?timestamp block command sk = Shell_services.Injection.block cctxt signed_blk [] let int32_parameter = + let open Lwt_result_syntax in Tezos_clic.parameter (fun _ p -> match Int32.of_string p with | i32 -> @@ -59,6 +60,7 @@ let int32_parameter = | exception _ -> failwith "Cannot read int32") let file_parameter = + let open Lwt_result_syntax in Tezos_clic.parameter (fun _ p -> if not (Sys.file_exists p) then failwith "File doesn't exist: '%s'" p else return p) @@ -97,6 +99,7 @@ let fitness_from_uint32 fitness = ] let timestamp_arg = + let open Lwt_result_syntax in Tezos_clic.arg ~long:"timestamp" ~placeholder:"date" @@ -108,6 +111,7 @@ let timestamp_arg = | Some t -> return t)) let test_delay_arg = + let open Lwt_result_syntax in Tezos_clic.default_arg ~long:"delay" ~placeholder:"time" -- GitLab From fbcbddff5f9b691577f4c7914ef2c360b4e06751 Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Tue, 5 Dec 2023 17:25:12 +0000 Subject: [PATCH 05/10] Plugin: Remove dependency on Error Monad --- src/proto_alpha/lib_plugin/RPC.ml | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 6804daf297b5..b50dc53262d2 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -1212,9 +1212,9 @@ module Scripts = struct end) (op, chain_id) - let default_from_context ctxt get = function - | None -> get ctxt - | Some x -> return x + let default_from_context ctxt get = + let open Lwt_result_syntax in + function None -> get ctxt | Some x -> return x (* A convenience type for return values of [ensure_contracts_exist] below. *) type run_code_config = { @@ -2325,6 +2325,7 @@ module Contract = struct end let get_contract contract f = + let open Lwt_result_syntax in match contract with | Contract.Implicit _ -> return_none | Contract.Originated contract -> f contract @@ -3253,6 +3254,7 @@ module Forge = struct end let register () = + let open Lwt_result_syntax in Registration.register0_noctxt ~chunked:true S.operations @@ -4152,10 +4154,10 @@ module Staking = struct else return_none let check_delegate_registered ctxt pkh = - Delegate.registered ctxt pkh >>= function - | true -> return_unit - | false -> - Environment.Error_monad.tzfail (Delegate_services.Not_registered pkh) + let open Lwt_result_syntax in + let*! result = Delegate.registered ctxt pkh in + if result then return_unit + else Environment.Error_monad.tzfail (Delegate_services.Not_registered pkh) let register () = Registration.register1 ~chunked:true S.stakers (fun ctxt pkh () () -> @@ -4226,6 +4228,7 @@ let () = (fun () -> Negative_level_offset) let register () = + let open Lwt_result_syntax in Scripts.register () ; Forge.register () ; Parse.register () ; -- GitLab From 5d0830c14c293489d79833b071b34103e2acb188 Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Tue, 5 Dec 2023 17:25:48 +0000 Subject: [PATCH 06/10] Client_sapling: Remove dependency on Error Monad --- src/proto_alpha/lib_client_sapling/client_sapling_commands.ml | 3 +++ src/proto_alpha/lib_client_sapling/context.ml | 3 +++ 2 files changed, 6 insertions(+) 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 70aec92f5ceb..9f4732e89ce2 100644 --- a/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml +++ b/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml @@ -120,6 +120,7 @@ let do_sapling_transfer cctxt ?message contract src_name amount dst = anti_replay let message_arg = + let open Lwt_result_syntax in let open Tezos_clic in arg ~long:"message" @@ -128,6 +129,7 @@ let message_arg = (parameter (fun _ x -> return @@ Bytes.of_string x)) let memo_size_arg = + let open Lwt_result_syntax in let open Tezos_clic in arg ~long:"memo-size" @@ -330,6 +332,7 @@ let unshield_cmd = let sapling_transaction_file = "sapling_transaction" let file_arg default_filename = + let open Lwt_result_syntax in let open Tezos_clic in arg ~long:"file" diff --git a/src/proto_alpha/lib_client_sapling/context.ml b/src/proto_alpha/lib_client_sapling/context.ml index 2bfa917eec1e..86bfca88e8e5 100644 --- a/src/proto_alpha/lib_client_sapling/context.ml +++ b/src/proto_alpha/lib_client_sapling/context.ml @@ -250,6 +250,7 @@ module Contract_state = struct let find_account vk contract_state = Accounts.find vk contract_state.accounts let init ~force vk state = + let open Lwt_result_syntax in Accounts.find vk state.accounts |> function | None -> let accounts = Accounts.add (Account.create vk) state.accounts in @@ -349,6 +350,7 @@ module Client_state = struct let write (cctxt : #Client_context.wallet) t = cctxt#write filename t encoding let get_or_init ~default_memo_size contract client_state = + let open Lwt_result_syntax in Map.find contract client_state |> function | None -> ( match default_memo_size with @@ -374,6 +376,7 @@ module Client_state = struct write cctxt client_state let find (cctxt : #Client_context.full) contract state = + let open Lwt_result_syntax in Map.find contract state |> function | None -> cctxt#error -- GitLab From c20845e8d6d4f9cd925236f63142aa1137f96c0c Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Tue, 5 Dec 2023 17:26:25 +0000 Subject: [PATCH 07/10] Benchmarks_proto: Remove dependency on Error Monad --- src/proto_alpha/lib_benchmarks_proto/michelson_commands.ml | 6 ++++++ src/proto_alpha/lib_benchmarks_proto/sapling_commands.ml | 4 ++++ src/proto_alpha/lib_benchmarks_proto/sapling_generation.ml | 2 ++ 3 files changed, 12 insertions(+) diff --git a/src/proto_alpha/lib_benchmarks_proto/michelson_commands.ml b/src/proto_alpha/lib_benchmarks_proto/michelson_commands.ml index 2c8f3c34acd4..b53daf1b8e5b 100644 --- a/src/proto_alpha/lib_benchmarks_proto/michelson_commands.ml +++ b/src/proto_alpha/lib_benchmarks_proto/michelson_commands.ml @@ -33,6 +33,7 @@ let group = module Michelson_concat_cmd = struct let handler () file1 file2 file3 () = + let open Lwt_result_syntax in let trace1 = Michelson_mcmc_samplers.load ~filename:file1 in let trace2 = Michelson_mcmc_samplers.load ~filename:file2 in let terms = trace1 @ trace2 in @@ -75,6 +76,7 @@ module Michelson_gen_cmd = struct let handler (min_size, max_size, burn_in, seed) terms_count terms_kind filename () = + let open Lwt_result_syntax in let default = Michelson_generation.default_generator_config in let min = Option.value ~default:default.target_size.min min_size in let max = Option.value ~default:default.target_size.max max_size in @@ -132,6 +134,7 @@ module Michelson_gen_cmd = struct return_unit let min_size_arg = + let open Lwt_result_syntax in let min_size = Tezos_clic.parameter (fun (_ : unit) parsed -> try return (int_of_string parsed) @@ -146,6 +149,7 @@ module Michelson_gen_cmd = struct min_size let max_size_arg = + let open Lwt_result_syntax in let max_size = Tezos_clic.parameter (fun (_ : unit) parsed -> try return (int_of_string parsed) @@ -160,6 +164,7 @@ module Michelson_gen_cmd = struct max_size let burn_in_arg = + let open Lwt_result_syntax in let target_size = Tezos_clic.parameter (fun (_ : unit) parsed -> try return (int_of_string parsed) @@ -174,6 +179,7 @@ module Michelson_gen_cmd = struct target_size let seed_arg = + let open Lwt_result_syntax in let seed = Tezos_clic.parameter (fun (_ : unit) parsed -> try return (int_of_string parsed) diff --git a/src/proto_alpha/lib_benchmarks_proto/sapling_commands.ml b/src/proto_alpha/lib_benchmarks_proto/sapling_commands.ml index c397ecf27d2a..8700b7ccd5a4 100644 --- a/src/proto_alpha/lib_benchmarks_proto/sapling_commands.ml +++ b/src/proto_alpha/lib_benchmarks_proto/sapling_commands.ml @@ -32,6 +32,7 @@ module Sapling_gen_cmd = struct (* Generic max-%s argument *) let max name = + let open Lwt_result_syntax in Tezos_clic.arg ~doc:(Printf.sprintf "Maximum number of %s" name) ~long:(Printf.sprintf "max-%s" name) @@ -52,6 +53,7 @@ module Sapling_gen_cmd = struct (* Integer argument --seed *) let seed_arg = + let open Lwt_result_syntax in let seed = Tezos_clic.parameter (fun (_ : unit) parsed -> try return (int_of_string parsed) @@ -62,6 +64,7 @@ module Sapling_gen_cmd = struct Tezos_clic.arg ~doc:"RNG seed" ~long:"seed" ~placeholder:"int" seed let positive_param = + let open Lwt_result_syntax in Tezos_clic.parameter (fun _ s -> match int_of_string_opt s with | Some i when i > 0 -> return i @@ -84,6 +87,7 @@ module Sapling_gen_cmd = struct let sapling_handler (max_inputs, max_outputs, max_nullifiers, max_additional_commitments, seed) tx_count save_to () = + let open Lwt_result_syntax in let sapling_gen_options = default_sapling_gen_options |> lift_opt set_max_inputs max_inputs diff --git a/src/proto_alpha/lib_benchmarks_proto/sapling_generation.ml b/src/proto_alpha/lib_benchmarks_proto/sapling_generation.ml index 94c8c8451a78..1cfdcd91d55a 100644 --- a/src/proto_alpha/lib_benchmarks_proto/sapling_generation.ml +++ b/src/proto_alpha/lib_benchmarks_proto/sapling_generation.ml @@ -127,6 +127,7 @@ let rec gen_rcm state = (* Adds a commitment, ciphertext, cv to an rpc_diff *) let add_input diff vk index position sum state = + let open Lwt_result_syntax in let rcm = gen_rcm state in let amount = random_amount state sum in let new_idx, address = @@ -272,6 +273,7 @@ let outputs nb_output proving_ctx vk state = (* Create the list of inputs. To use once the merkle tree is completed. *) let make_inputs to_forge local_state proving_ctx sk vk root anti_replay = + let open Lwt_result_syntax in List.map_ep (fun {rcm; position; amount; address; nf} -> let witness = Tezos_sapling.Storage.get_witness local_state position in -- GitLab From 69aee0d0ae1675b23c6a7750ab2c5268594f1669 Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Tue, 5 Dec 2023 17:26:56 +0000 Subject: [PATCH 08/10] Benchmark/Test: Remove dependency on Error Monad --- .../lib_benchmark/test/test_helpers.ml | 74 ++++++++++--------- 1 file changed, 40 insertions(+), 34 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/test/test_helpers.ml b/src/proto_alpha/lib_benchmark/test/test_helpers.ml index 8d5db86cc9ed..e3d49fe0ec1c 100644 --- a/src/proto_alpha/lib_benchmark/test/test_helpers.ml +++ b/src/proto_alpha/lib_benchmark/test/test_helpers.ml @@ -40,32 +40,35 @@ let print_script_expr_list fmtr (exprs : Protocol.Script_repr.expr list) = exprs let typecheck_by_tezos = + let open Lwt_result_wrap_syntax in let context_init_memory ~rng_state = - Context.init_n - ~rng_state - ~bootstrap_balances: - [ - 4_000_000_000_000L; - 4_000_000_000_000L; - 4_000_000_000_000L; - 4_000_000_000_000L; - 4_000_000_000_000L; - ] - 5 - () - >>=? fun (block, _accounts) -> - Context.get_constants (B block) >>=? fun csts -> + let* block, _accounts = + Context.init_n + ~rng_state + ~bootstrap_balances: + [ + 4_000_000_000_000L; + 4_000_000_000_000L; + 4_000_000_000_000L; + 4_000_000_000_000L; + 4_000_000_000_000L; + ] + 5 + () + in + let* csts = Context.get_constants (B block) in let minimal_block_delay = Protocol.Alpha_context.Period.to_seconds csts.parametric.minimal_block_delay in - Incremental.begin_construction - ~timestamp: - (Tezos_base.Time.Protocol.add - block.header.shell.timestamp - minimal_block_delay) - block - >>=? fun vs -> + let* vs = + Incremental.begin_construction + ~timestamp: + (Tezos_base.Time.Protocol.add + block.header.shell.timestamp + minimal_block_delay) + block + in let ctxt = Incremental.alpha_ctxt vs in (* Required for eg Create_contract *) return @@ -76,16 +79,19 @@ let typecheck_by_tezos = fun bef node -> Stdlib.Result.get_ok (Lwt_main.run - ( context_init_memory ~rng_state >>=? fun ctxt -> - let (Protocol.Script_ir_translator.Ex_stack_ty bef) = - Type_helpers.michelson_type_list_to_ex_stack_ty bef ctxt - in - Protocol.Script_ir_translator.parse_instr - Protocol.Script_tc_context.data - ctxt - ~elab_conf: - (Protocol.Script_ir_translator_config.make ~legacy:false ()) - (Micheline.root node) - bef - >|= Environment.wrap_tzresult - >>=? fun _ -> return_unit )) + (let* ctxt = context_init_memory ~rng_state in + let (Protocol.Script_ir_translator.Ex_stack_ty bef) = + Type_helpers.michelson_type_list_to_ex_stack_ty bef ctxt + in + let*@ (_ : + _ Protocol.Script_ir_translator.judgement + * Protocol.Alpha_context.t) = + Protocol.Script_ir_translator.parse_instr + Protocol.Script_tc_context.data + ctxt + ~elab_conf: + (Protocol.Script_ir_translator_config.make ~legacy:false ()) + (Micheline.root node) + bef + in + return_unit)) -- GitLab From ce3a5a409664d8c2fcae60149608632b705cbed6 Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Tue, 5 Dec 2023 17:27:29 +0000 Subject: [PATCH 09/10] Bin_baker: Remove dependency on Error Monad --- src/proto_alpha/bin_baker/main_baker_alpha.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/proto_alpha/bin_baker/main_baker_alpha.ml b/src/proto_alpha/bin_baker/main_baker_alpha.ml index bd7485151dc4..05b95923263b 100644 --- a/src/proto_alpha/bin_baker/main_baker_alpha.ml +++ b/src/proto_alpha/bin_baker/main_baker_alpha.ml @@ -30,6 +30,7 @@ let () = @@ Baking_commands.baker_commands () let select_commands _ _ = + let open Lwt_result_syntax in return (List.map (Tezos_clic.map_command (new Protocol_client_context.wrap_full)) -- GitLab From 919149fd8e8c2257e3470ddcd2dcc22fa910b5e3 Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Tue, 5 Dec 2023 17:27:55 +0000 Subject: [PATCH 10/10] Bin_accuser: Remove dependency on Error Monad --- src/proto_alpha/bin_accuser/main_accuser_alpha.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/proto_alpha/bin_accuser/main_accuser_alpha.ml b/src/proto_alpha/bin_accuser/main_accuser_alpha.ml index ebbd70c5ebed..17efa9e364ad 100644 --- a/src/proto_alpha/bin_accuser/main_accuser_alpha.ml +++ b/src/proto_alpha/bin_accuser/main_accuser_alpha.ml @@ -30,6 +30,7 @@ let () = @@ Baking_commands.accuser_commands () let select_commands _ _ = + let open Lwt_result_syntax in return (List.map (Tezos_clic.map_command (new Protocol_client_context.wrap_full)) -- GitLab