From 141acc09daca122e1da0abd6be7e9620a9f05167 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Wed, 16 Nov 2022 15:18:52 +0100 Subject: [PATCH 1/3] Proto-env-v8: rename legacy `fail` to `tzfail` to match syntax modules --- src/lib_protocol_environment/environment_V8.ml | 2 +- src/lib_protocol_environment/sigs/v8.ml | 2 +- src/lib_protocol_environment/sigs/v8/error_monad.mli | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/lib_protocol_environment/environment_V8.ml b/src/lib_protocol_environment/environment_V8.ml index 2fe47218c427..699fbb819a32 100644 --- a/src/lib_protocol_environment/environment_V8.ml +++ b/src/lib_protocol_environment/environment_V8.ml @@ -633,7 +633,7 @@ struct (* Backwards compatibility additions (dont_wait, trace helpers) *) include Tezos_protocol_environment_structs.V8.Error_monad_infix_globals - let fail e = Lwt.return_error (TzTrace.make e) + let tzfail e = Lwt.return_error (TzTrace.make e) let error e = Error (TzTrace.make e) diff --git a/src/lib_protocol_environment/sigs/v8.ml b/src/lib_protocol_environment/sigs/v8.ml index 1a88fd4b2f04..09089087c8d2 100644 --- a/src/lib_protocol_environment/sigs/v8.ml +++ b/src/lib_protocol_environment/sigs/v8.ml @@ -5693,7 +5693,7 @@ val error : 'err -> ('a, 'err trace) result val trace_of_error : 'err -> 'err trace -val fail : 'err -> ('a, 'err trace) result Lwt.t +val tzfail : 'err -> ('a, 'err trace) result Lwt.t val ( >>= ) : 'a Lwt.t -> ('a -> 'b Lwt.t) -> 'b Lwt.t diff --git a/src/lib_protocol_environment/sigs/v8/error_monad.mli b/src/lib_protocol_environment/sigs/v8/error_monad.mli index 79a35861114e..b6196a25fad3 100644 --- a/src/lib_protocol_environment/sigs/v8/error_monad.mli +++ b/src/lib_protocol_environment/sigs/v8/error_monad.mli @@ -98,7 +98,7 @@ val error : 'err -> ('a, 'err trace) result val trace_of_error : 'err -> 'err trace -val fail : 'err -> ('a, 'err trace) result Lwt.t +val tzfail : 'err -> ('a, 'err trace) result Lwt.t val ( >>= ) : 'a Lwt.t -> ('a -> 'b Lwt.t) -> 'b Lwt.t -- GitLab From 7d9808ec4ceabaa56fc3240d63426337211501b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Wed, 16 Nov 2022 15:19:41 +0100 Subject: [PATCH 2/3] Proto-alpha: adapt to enviornment's legacy `fail` rename --- src/proto_alpha/lib_plugin/RPC.ml | 2 +- .../lib_protocol/alpha_services.ml | 2 +- src/proto_alpha/lib_protocol/apply.ml | 10 +-- .../lib_protocol/contract_manager_storage.ml | 10 +-- .../lib_protocol/contract_storage.ml | 14 ++-- .../lib_protocol/delegate_services.ml | 2 +- src/proto_alpha/lib_protocol/fees_storage.ml | 4 +- .../lib_protocol/global_constants_storage.ml | 8 +- .../lib_protocol/liquidity_baking_repr.ml | 2 +- src/proto_alpha/lib_protocol/nonce_storage.ml | 8 +- src/proto_alpha/lib_protocol/raw_context.ml | 2 +- .../lib_protocol/sc_rollup_proof_repr.ml | 2 +- .../lib_protocol/script_interpreter.ml | 18 ++-- .../lib_protocol/script_ir_translator.ml | 84 +++++++++---------- .../lib_protocol/script_ir_unparser.ml | 4 +- .../lib_protocol/ticket_lazy_storage_diff.ml | 4 +- .../lib_protocol/ticket_scanner.ml | 2 +- .../tx_rollup_commitment_storage.ml | 18 ++-- .../lib_protocol/tx_rollup_inbox_storage.ml | 4 +- .../lib_protocol/tx_rollup_l2_verifier.ml | 4 +- .../lib_protocol/tx_rollup_state_storage.ml | 2 +- src/proto_demo_counter/lib_protocol/main.ml | 8 +- src/proto_demo_noops/lib_protocol/main.ml | 6 +- 23 files changed, 110 insertions(+), 110 deletions(-) diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 35b444d2ddd4..29dd4b57827e 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -3464,7 +3464,7 @@ let register () = Dal.register () ; Tx_rollup.register () ; Registration.register0 ~chunked:false S.current_level (fun ctxt q () -> - if q.offset < 0l then fail Negative_level_offset + if q.offset < 0l then tzfail Negative_level_offset else Lwt.return (Level.from_raw_with_offset diff --git a/src/proto_alpha/lib_protocol/alpha_services.ml b/src/proto_alpha/lib_protocol/alpha_services.ml index 1dfb872f9cca..b2f703214956 100644 --- a/src/proto_alpha/lib_protocol/alpha_services.ml +++ b/src/proto_alpha/lib_protocol/alpha_services.ml @@ -200,7 +200,7 @@ module Snapshot_index = struct if Compare.Int32.(Cycle.to_int32 cycle <= Int32.succ preserved_cycles) then (* Early cycles are corner cases, fail if requested *) - fail + tzfail (No_available_snapshots {min_cycle = Int32.add preserved_cycles 2l}) else let max_snapshot_index = diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index e5885cd71380..8cfcca75fe65 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -329,7 +329,7 @@ let apply_transaction_to_smart_contract ~ctxt ~source ~contract_hash ~amount >>=? fun (ctxt, balance_updates) -> Script_cache.find ctxt contract_hash >>=? fun (ctxt, cache_key, script) -> match script with - | None -> fail (Contract.Non_existing_contract contract) + | None -> tzfail (Contract.Non_existing_contract contract) | Some (script, script_ir) -> (* Token.transfer which is being called before already loads this value into the Irmin cache, so no need to burn gas for it. *) @@ -1304,7 +1304,7 @@ let apply_manager_operation : } in return (ctxt, result, []) - | None -> fail Tx_rollup_errors.Proof_undecodable) + | None -> tzfail Tx_rollup_errors.Proof_undecodable) | Dal_publish_slot_header {slot_header} -> Dal_apply.apply_publish_slot_header ctxt slot_header >>?= fun ctxt -> let consumed_gas = Gas.consumed ~since:ctxt_before_op ~until:ctxt in @@ -1443,7 +1443,7 @@ let apply_internal_operations ctxt ~payer ~chain_id ops = :: rest -> ( (if internal_nonce_already_recorded ctxt nonce then let op_res = Apply_internal_results.internal_operation op in - fail (Internal_operation_replay (Internal_operation op_res)) + tzfail (Internal_operation_replay (Internal_operation op_res)) else let ctxt = record_internal_nonce ctxt nonce in apply_internal_operation_contents @@ -2259,7 +2259,7 @@ let apply_contents_list (type kind) ctxt chain_id (mode : mode) | Single (Failing_noop _) -> (* This operation always fails. It should already have been rejected by {!Validate.validate_operation}. *) - fail Validate_errors.Failing_noop_error + tzfail Validate_errors.Failing_noop_error | Single (Manager_operation _) -> apply_manager_operations ctxt @@ -2356,7 +2356,7 @@ let apply_liquidity_baking_subsidy ctxt ~toggle_vote = Script_cache.find ctxt liquidity_baking_cpmm_contract_hash >>=? fun (ctxt, cache_key, script) -> match script with - | None -> fail (Script_tc_errors.No_such_entrypoint Entrypoint.default) + | None -> tzfail (Script_tc_errors.No_such_entrypoint Entrypoint.default) | Some (script, script_ir) -> ( (* Token.transfer which is being called above already loads this value into the Irmin cache, so no need to burn gas for it. *) diff --git a/src/proto_alpha/lib_protocol/contract_manager_storage.ml b/src/proto_alpha/lib_protocol/contract_manager_storage.ml index 5c9d0e6d46ae..a40e1aba1861 100644 --- a/src/proto_alpha/lib_protocol/contract_manager_storage.ml +++ b/src/proto_alpha/lib_protocol/contract_manager_storage.ml @@ -124,7 +124,7 @@ let check_public_key public_key expected_hash = let reveal_manager_key ?(check_consistency = true) c manager public_key = let contract = Contract_repr.Implicit manager in Storage.Contract.Manager.get c contract >>=? function - | Public_key _ -> fail (Previously_revealed_key contract) + | Public_key _ -> tzfail (Previously_revealed_key contract) | Hash expected_hash -> (* Ensure that the manager is equal to the retrieved hash. *) error_unless @@ -153,12 +153,12 @@ let get_manager_key ?error ctxt pkh = Storage.Contract.Manager.find ctxt contract >>=? function | None -> ( match error with - | None -> fail (Missing_manager_contract contract) - | Some error -> fail error) + | None -> tzfail (Missing_manager_contract contract) + | Some error -> tzfail error) | Some (Manager_repr.Hash _) -> ( match error with - | None -> fail (Unrevealed_manager_key contract) - | Some error -> fail error) + | None -> tzfail (Unrevealed_manager_key contract) + | Some error -> tzfail error) | Some (Manager_repr.Public_key pk) -> return pk let remove_existing = Storage.Contract.Manager.remove_existing diff --git a/src/proto_alpha/lib_protocol/contract_storage.ml b/src/proto_alpha/lib_protocol/contract_storage.ml index ebd98ea2d021..7364f0a6b7b0 100644 --- a/src/proto_alpha/lib_protocol/contract_storage.ml +++ b/src/proto_alpha/lib_protocol/contract_storage.ml @@ -223,7 +223,7 @@ let () = | Frozen_bonds_must_be_spent_at_once (c, b) -> Some (c, b) | _ -> None) (fun (c, b) -> Frozen_bonds_must_be_spent_at_once (c, b)) -let failwith msg = fail (Failure msg) +let failwith msg = tzfail (Failure msg) module Legacy_big_map_diff = struct (* @@ -477,15 +477,15 @@ let exists c contract = let must_exist c contract = exists c contract >>= function | true -> return_unit - | false -> fail (Non_existing_contract contract) + | false -> tzfail (Non_existing_contract contract) let must_be_allocated c contract = allocated c contract >>= function | true -> return_unit | false -> ( match contract with - | Implicit pkh -> fail (Empty_implicit_contract pkh) - | Originated _ -> fail (Non_existing_contract contract)) + | Implicit pkh -> tzfail (Empty_implicit_contract pkh) + | Originated _ -> tzfail (Non_existing_contract contract)) let list c = Storage.Contract.list c @@ -507,8 +507,8 @@ let check_counter_increment c manager counter = let expected = Manager_counter_repr.succ contract_counter in if Manager_counter_repr.(expected = counter) then return_unit else if Manager_counter_repr.(expected > counter) then - fail (Counter_in_the_past {contract; expected; found = counter}) - else fail (Counter_in_the_future {contract; expected; found = counter}) + tzfail (Counter_in_the_past {contract; expected; found = counter}) + else tzfail (Counter_in_the_future {contract; expected; found = counter}) let increment_counter c manager = let contract = Contract_repr.Implicit manager in @@ -632,7 +632,7 @@ let credit_only_call_from_token c contract amount = Storage.Contract.Spendable_balance.find c contract >>=? function | None -> ( match contract with - | Originated _ -> fail (Non_existing_contract contract) + | Originated _ -> tzfail (Non_existing_contract contract) | Implicit manager -> create_implicit c manager ~balance:amount) | Some balance -> Tez_repr.(amount +? balance) >>?= fun balance -> diff --git a/src/proto_alpha/lib_protocol/delegate_services.ml b/src/proto_alpha/lib_protocol/delegate_services.ml index 3388da4761e4..db989a7a0ba5 100644 --- a/src/proto_alpha/lib_protocol/delegate_services.ml +++ b/src/proto_alpha/lib_protocol/delegate_services.ml @@ -393,7 +393,7 @@ end let check_delegate_registered ctxt pkh = Delegate.registered ctxt pkh >>= function | true -> return_unit - | false -> fail (Not_registered pkh) + | false -> tzfail (Not_registered pkh) let register () = let open Services_registration in diff --git a/src/proto_alpha/lib_protocol/fees_storage.ml b/src/proto_alpha/lib_protocol/fees_storage.ml index d09f06b5ed9e..fd345d65b4e4 100644 --- a/src/proto_alpha/lib_protocol/fees_storage.ml +++ b/src/proto_alpha/lib_protocol/fees_storage.ml @@ -96,7 +96,7 @@ let source_must_exist c src = let burn_storage_fees ?(origin = Receipt_repr.Block_application) c ~storage_limit ~payer consumed = let remaining = Z.sub storage_limit consumed in - if Compare.Z.(remaining < Z.zero) then fail Operation_quota_exceeded + if Compare.Z.(remaining < Z.zero) then tzfail Operation_quota_exceeded else let cost_per_byte = Constants_storage.cost_per_byte c in Tez_repr.(cost_per_byte *? Z.to_int64 consumed) >>?= fun to_burn -> @@ -115,7 +115,7 @@ let burn_storage_fees ?(origin = Receipt_repr.Block_application) c let burn_storage_increase_fees ?(origin = Receipt_repr.Block_application) c ~payer amount_in_bytes = - if Compare.Z.(amount_in_bytes <= Z.zero) then fail Negative_storage_input + if Compare.Z.(amount_in_bytes <= Z.zero) then tzfail Negative_storage_input else let cost_per_byte = Constants_storage.cost_per_byte c in Tez_repr.(cost_per_byte *? Z.to_int64 amount_in_bytes) >>?= fun to_burn -> diff --git a/src/proto_alpha/lib_protocol/global_constants_storage.ml b/src/proto_alpha/lib_protocol/global_constants_storage.ml index be7b9dc62f46..e34c04c0bb08 100644 --- a/src/proto_alpha/lib_protocol/global_constants_storage.ml +++ b/src/proto_alpha/lib_protocol/global_constants_storage.ml @@ -140,7 +140,7 @@ let () = let get context hash = Storage.Global_constants.Map.find context hash >>=? fun (context, value) -> match value with - | None -> fail Nonexistent_global + | None -> tzfail Nonexistent_global | Some value -> return (context, value) let expr_to_address_in_context context expr = @@ -186,7 +186,7 @@ let expand_node context node = being a properly formatted hash. *) | [String (_, address)], [] -> ( match Script_expr_hash.of_b58check_opt address with - | None -> fail Badly_formed_constant_expression + | None -> tzfail Badly_formed_constant_expression | Some hash -> ( match Expr_hash_map.find hash map with | Some node -> @@ -204,7 +204,7 @@ let expand_node context node = (Gas_costs.expand_no_constants_branch_cost node) >>?= fun context -> k (context, Expr_hash_map.add hash node map, true) node)) - | _ -> fail Badly_formed_constant_expression) + | _ -> tzfail Badly_formed_constant_expression) | Int _ | String _ | Bytes _ | Prim _ | Seq _ -> k (context, map, did_expansion) node) >>=? fun (context, node, did_expansion) -> @@ -212,7 +212,7 @@ let expand_node context node = (* Gas charged during expansion is at least proportional to the size of the resulting node so the execution time of [node_too_large] is already covered. *) - if node_too_large node then fail Expression_too_large + if node_too_large node then tzfail Expression_too_large else return (context, node) else return (context, node) diff --git a/src/proto_alpha/lib_protocol/liquidity_baking_repr.ml b/src/proto_alpha/lib_protocol/liquidity_baking_repr.ml index 7a15716270cc..09ea87b0e4c4 100644 --- a/src/proto_alpha/lib_protocol/liquidity_baking_repr.ml +++ b/src/proto_alpha/lib_protocol/liquidity_baking_repr.ml @@ -72,7 +72,7 @@ end = struct let of_int32 x = if check_bounds x then return x - else fail @@ Liquidity_baking_toggle_ema_out_of_bound x + else tzfail @@ Liquidity_baking_toggle_ema_out_of_bound x let zero = Int32.zero diff --git a/src/proto_alpha/lib_protocol/nonce_storage.ml b/src/proto_alpha/lib_protocol/nonce_storage.ml index adfcc8eee003..feb0b2edebf6 100644 --- a/src/proto_alpha/lib_protocol/nonce_storage.ml +++ b/src/proto_alpha/lib_protocol/nonce_storage.ml @@ -86,19 +86,19 @@ let () = let get_unrevealed ctxt (level : Level_repr.t) = let current_level = Level_storage.current ctxt in match Cycle_repr.pred current_level.cycle with - | None -> fail Too_early_revelation (* no revelations during cycle 0 *) + | None -> tzfail Too_early_revelation (* no revelations during cycle 0 *) | Some revealed_cycle -> ( if Cycle_repr.(revealed_cycle < level.Level_repr.cycle) then - fail Too_early_revelation + tzfail Too_early_revelation else if Cycle_repr.(level.Level_repr.cycle < revealed_cycle) || Compare.Int32.( current_level.cycle_position >= Constants_storage.nonce_revelation_threshold ctxt) - then fail Too_late_revelation + then tzfail Too_late_revelation else Storage.Seed.Nonce.get ctxt level >>=? function - | Revealed _ -> fail Already_revealed_nonce + | Revealed _ -> tzfail Already_revealed_nonce | Unrevealed status -> return status) let record_hash ctxt unrevealed = diff --git a/src/proto_alpha/lib_protocol/raw_context.ml b/src/proto_alpha/lib_protocol/raw_context.ml index cd5cd74d5a96..ee9815358c6d 100644 --- a/src/proto_alpha/lib_protocol/raw_context.ml +++ b/src/proto_alpha/lib_protocol/raw_context.ml @@ -729,7 +729,7 @@ let get_proto_param ctxt = | None -> failwith "Missing protocol parameters." | Some bytes -> ( match Data_encoding.Binary.of_bytes_opt Data_encoding.json bytes with - | None -> fail (Failed_to_parse_parameter bytes) + | None -> tzfail (Failed_to_parse_parameter bytes) | Some json -> ( Context.remove ctxt protocol_param_key >|= fun ctxt -> match Data_encoding.Json.destruct Parameters_repr.encoding json with diff --git a/src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml b/src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml index f0b1ad0f61ca..bdcf201620c5 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml @@ -191,7 +191,7 @@ let check p reason = let check_inbox_proof snapshot serialized_inbox_proof (level, counter) = match Sc_rollup_inbox_repr.of_serialized_proof serialized_inbox_proof with - | None -> fail Sc_rollup_invalid_serialized_inbox_proof + | None -> tzfail Sc_rollup_invalid_serialized_inbox_proof | Some inbox_proof -> Sc_rollup_inbox_repr.verify_proof (level, counter) snapshot inbox_proof diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index be1ed375d998..1a3d93551e59 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -326,7 +326,7 @@ module Raw = struct (r * f * outdated_context * local_gas_counter) tzresult Lwt.t = fun ((ctxt, _) as g) gas ks0 accu stack -> match consume_control gas ks0 with - | None -> fail Gas.Operation_quota_exceeded + | None -> tzfail Gas.Operation_quota_exceeded | Some gas -> ( match ks0 with | KLog (ks, sty, logger) -> @@ -458,7 +458,7 @@ module Raw = struct let x = accu in let y, stack = stack in match Script_int.to_int64 y with - | None -> get_log logger >>=? fun log -> fail (Overflow (loc, log)) + | None -> get_log logger >>=? fun log -> tzfail (Overflow (loc, log)) | Some y -> Tez.(x *? y) >>?= fun res -> (step [@ocaml.tailcall]) g gas k ks res stack @@ -468,7 +468,7 @@ module Raw = struct let y = accu in let x, stack = stack in match Script_int.to_int64 y with - | None -> get_log logger >>=? fun log -> fail (Overflow (loc, log)) + | None -> get_log logger >>=? fun log -> tzfail (Overflow (loc, log)) | Some y -> Tez.(x *? y) >>?= fun res -> (step [@ocaml.tailcall]) g gas k ks res stack @@ -477,21 +477,21 @@ module Raw = struct fun logger g gas loc k ks accu stack -> let x = accu and y, stack = stack in match Script_int.shift_left_n x y with - | None -> get_log logger >>=? fun log -> fail (Overflow (loc, log)) + | None -> get_log logger >>=? fun log -> tzfail (Overflow (loc, log)) | Some x -> (step [@ocaml.tailcall]) g gas k ks x stack and ilsr_nat : type a b c d e f. (a, b, c, d, e, f) ilsr_nat_type = fun logger g gas loc k ks accu stack -> let x = accu and y, stack = stack in match Script_int.shift_right_n x y with - | None -> get_log logger >>=? fun log -> fail (Overflow (loc, log)) + | None -> get_log logger >>=? fun log -> tzfail (Overflow (loc, log)) | Some r -> (step [@ocaml.tailcall]) g gas k ks r stack and ilsl_bytes : type a b c d e f. (a, b, c, d, e, f) ilsl_bytes_type = fun logger g gas loc k ks accu stack -> let x = accu and y, stack = stack in match Script_bytes.bytes_lsl x y with - | None -> get_log logger >>=? fun log -> fail (Overflow (loc, log)) + | None -> get_log logger >>=? fun log -> tzfail (Overflow (loc, log)) | Some res -> (step [@ocaml.tailcall]) g gas k ks res stack and ifailwith : ifailwith_type = @@ -502,7 +502,7 @@ module Raw = struct let ctxt = update_context gas ctxt in trace Cannot_serialize_failure (unparse_data ctxt Optimized tv v) >>=? fun (v, _ctxt) -> - get_log logger >>=? fun log -> fail (Reject (kloc, v, log))); + get_log logger >>=? fun log -> tzfail (Reject (kloc, v, log))); } and iexec : type a b c d e f g. (a, b, c, d, e, f, g) iexec_type = @@ -629,7 +629,7 @@ module Raw = struct and step : type a s b t r f. (a, s, b, t, r, f) step_type = fun ((ctxt, sc) as g) gas i ks accu stack -> match consume_instr gas i accu stack with - | None -> fail Gas.Operation_quota_exceeded + | None -> tzfail Gas.Operation_quota_exceeded | Some gas -> ( match i with | ILog (_, sty, event, logger, k) -> @@ -1548,7 +1548,7 @@ module Raw = struct let ticketer = Contract.Originated sc.self in let accu = {ticketer; contents; amount} in (step [@ocaml.tailcall]) g gas k ks accu stack - | None -> fail Script_tc_errors.Forbidden_zero_ticket_quantity) + | None -> tzfail Script_tc_errors.Forbidden_zero_ticket_quantity) | ITicket (_, _, k) -> ( let contents = accu and amount, stack = stack in match Ticket_amount.of_n amount with diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index cc840c066d66..80ec18fbe31f 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1707,11 +1707,11 @@ let parse_pair (type r) parse_l parse_r ctxt ~legacy (if legacy then Result.return_unit else error_unexpected_annot loc annot) >>?= fun () -> parse_comb loc l rs | Prim (loc, D_Pair, l, _) -> - fail @@ Invalid_arity (loc, D_Pair, 2, List.length l) + tzfail @@ Invalid_arity (loc, D_Pair, 2, List.length l) (* Unfold [{x1; ...; xn}] as [Pair x1 x2 ... xn-1 xn] for n >= 2 *) | Seq (loc, l :: (_ :: _ as rs)) -> parse_comb loc l rs - | Seq (loc, l) -> fail @@ Invalid_seq_arity (loc, 2, List.length l) - | expr -> fail @@ unexpected expr [] Constant_namespace [D_Pair] + | Seq (loc, l) -> tzfail @@ Invalid_seq_arity (loc, 2, List.length l) + | expr -> tzfail @@ unexpected expr [] Constant_namespace [D_Pair] let parse_union parse_l parse_r ctxt ~legacy = function | Prim (loc, D_Left, [v], annot) -> @@ -1719,14 +1719,14 @@ let parse_union parse_l parse_r ctxt ~legacy = function >>?= fun () -> parse_l ctxt v >|=? fun (v, ctxt) -> (L v, ctxt) | Prim (loc, D_Left, l, _) -> - fail @@ Invalid_arity (loc, D_Left, 1, List.length l) + tzfail @@ Invalid_arity (loc, D_Left, 1, List.length l) | Prim (loc, D_Right, [v], annot) -> (if legacy then Result.return_unit else error_unexpected_annot loc annot) >>?= fun () -> parse_r ctxt v >|=? fun (v, ctxt) -> (R v, ctxt) | Prim (loc, D_Right, l, _) -> - fail @@ Invalid_arity (loc, D_Right, 1, List.length l) - | expr -> fail @@ unexpected expr [] Constant_namespace [D_Left; D_Right] + tzfail @@ Invalid_arity (loc, D_Right, 1, List.length l) + | expr -> tzfail @@ unexpected expr [] Constant_namespace [D_Left; D_Right] let parse_option parse_v ctxt ~legacy = function | Prim (loc, D_Some, [v], annot) -> @@ -1734,15 +1734,15 @@ let parse_option parse_v ctxt ~legacy = function >>?= fun () -> parse_v ctxt v >|=? fun (v, ctxt) -> (Some v, ctxt) | Prim (loc, D_Some, l, _) -> - fail @@ Invalid_arity (loc, D_Some, 1, List.length l) + tzfail @@ Invalid_arity (loc, D_Some, 1, List.length l) | Prim (loc, D_None, [], annot) -> Lwt.return ( (if legacy then Result.return_unit else error_unexpected_annot loc annot) >|? fun () -> (None, ctxt) ) | Prim (loc, D_None, l, _) -> - fail @@ Invalid_arity (loc, D_None, 0, List.length l) - | expr -> fail @@ unexpected expr [] Constant_namespace [D_Some; D_None] + tzfail @@ Invalid_arity (loc, D_None, 0, List.length l) + | expr -> tzfail @@ unexpected expr [] Constant_namespace [D_Some; D_None] let comb_witness1 : type t tc. (t, tc) ty -> (t, unit -> unit) comb_witness = function @@ -1891,7 +1891,7 @@ let rec parse_data : Gas.consume ctxt Typecheck_costs.parse_data_cycle >>?= fun ctxt -> let non_terminal_recursion ctxt ty script_data = if Compare.Int.(stack_depth > 10_000) then - fail Typechecking_too_many_recursive_calls + tzfail Typechecking_too_many_recursive_calls else parse_data ~elab_conf @@ -1905,7 +1905,7 @@ let rec parse_data : let ty = serialize_ty_for_error ty in Invalid_constant (location script_data, strip_locations script_data, ty) in - let fail_parse_data () = fail (parse_data_error ()) in + let fail_parse_data () = tzfail (parse_data_error ()) in let traced_no_lwt body = record_trace_eval parse_data_error body in let traced body = trace_eval parse_data_error body in let traced_fail err = Lwt.return @@ traced_no_lwt (error err) in @@ -1947,9 +1947,9 @@ let rec parse_data : (Some k, Script_map.update k (Some (item_wrapper v)) map, ctxt) ) | Prim (loc, D_Elt, l, _) -> - fail @@ Invalid_arity (loc, D_Elt, 2, List.length l) + tzfail @@ Invalid_arity (loc, D_Elt, 2, List.length l) | Prim (loc, name, _, _) -> - fail @@ Invalid_primitive (loc, [D_Elt], name) + tzfail @@ Invalid_primitive (loc, [D_Elt], name) | Int _ | String _ | Bytes _ | Seq _ -> fail_parse_data ()) (None, Script_map.empty key_type, ctxt) items @@ -2006,9 +2006,9 @@ let rec parse_data : }, ctxt ) ) | Prim (loc, D_Elt, l, _) -> - fail @@ Invalid_arity (loc, D_Elt, 2, List.length l) + tzfail @@ Invalid_arity (loc, D_Elt, 2, List.length l) | Prim (loc, name, _, _) -> - fail @@ Invalid_primitive (loc, [D_Elt], name) + tzfail @@ Invalid_primitive (loc, [D_Elt], name) | Int _ | String _ | Bytes _ | Seq _ -> fail_parse_data ()) (None, {map = Big_map_overlay.empty; size = 0}, ctxt) items @@ -2116,7 +2116,7 @@ let rec parse_data : match destination with | Contract ticketer -> return ({ticketer; contents; amount}, ctxt) | Tx_rollup _ | Sc_rollup _ | Zk_rollup _ -> - fail (Unexpected_ticket_owner destination)) + tzfail (Unexpected_ticket_owner destination)) | None -> traced_fail Forbidden_zero_ticket_quantity else traced_fail (Unexpected_forged_value (location expr)) (* Sets *) @@ -2433,7 +2433,7 @@ and parse_kdescr : | Typed {loc; aft = stack_ty; _}, ctxt -> let ret = serialize_ty_for_error ret in let stack_ty = serialize_stack_for_error ctxt stack_ty in - fail @@ Bad_return (loc, stack_ty, ret) + tzfail @@ Bad_return (loc, stack_ty, ret) | Failed {descr}, ctxt -> return ( (close_descr (descr (Item_t (ret, Bot_t))) @@ -2475,7 +2475,7 @@ and parse_lam_rec : | Typed {loc; aft = stack_ty; _}, ctxt -> let ret = serialize_ty_for_error ret in let stack_ty = serialize_stack_for_error ctxt stack_ty in - fail @@ Bad_return (loc, stack_ty, ret) + tzfail @@ Bad_return (loc, stack_ty, ret) | Failed {descr}, ctxt -> return ( (LamRec (close_descr (descr (Item_t (ret, Bot_t))), script_instr) @@ -2527,7 +2527,7 @@ and parse_instr : Gas.consume ctxt Typecheck_costs.parse_instr_cycle >>?= fun ctxt -> let non_terminal_recursion tc_context ctxt script_instr stack_ty = if Compare.Int.(stack_depth > 10000) then - fail Typechecking_too_many_recursive_calls + tzfail Typechecking_too_many_recursive_calls else parse_instr ~elab_conf @@ -2573,7 +2573,7 @@ and parse_instr : | Prim (loc, I_DROP, (_ :: _ :: _ as l), _), _ -> (* Technically, the arities 0 and 1 are allowed but the error only mentions 1. However, DROP is equivalent to DROP 1 so hinting at an arity of 1 makes sense. *) - fail (Invalid_arity (loc, I_DROP, 1, List.length l)) + tzfail (Invalid_arity (loc, I_DROP, 1, List.length l)) | Prim (loc, I_DUP, [], annot), (Item_t (v, _) as stack) -> check_var_annot loc annot >>?= fun () -> record_trace_eval @@ -2635,7 +2635,7 @@ and parse_instr : let dig = {apply = (fun k -> IDig (loc, n, n', k))} in typed ctxt loc dig (Item_t (x, aft)) | Prim (loc, I_DIG, (([] | _ :: _ :: _) as l), _), _ -> - fail (Invalid_arity (loc, I_DIG, 1, List.length l)) + tzfail (Invalid_arity (loc, I_DIG, 1, List.length l)) | Prim (loc, I_DUG, [n], result_annot), Item_t (x, whole_stack) -> ( parse_uint10 n >>?= fun whole_n -> Gas.consume ctxt (Typecheck_costs.proof_argument whole_n) >>?= fun ctxt -> @@ -2643,7 +2643,7 @@ and parse_instr : match make_dug_proof_argument loc whole_n x whole_stack with | None -> let whole_stack = serialize_stack_for_error ctxt whole_stack in - fail (Bad_stack (loc, I_DUG, whole_n, whole_stack)) + tzfail (Bad_stack (loc, I_DUG, whole_n, whole_stack)) | Some (Dug_proof_argument (n', aft)) -> let dug = {apply = (fun k -> IDug (loc, whole_n, n', k))} in typed ctxt loc dug aft) @@ -2653,7 +2653,7 @@ and parse_instr : let stack = serialize_stack_for_error ctxt stack in error (Bad_stack (loc, I_DUG, 1, stack)) ) | Prim (loc, I_DUG, (([] | _ :: _ :: _) as l), _), _ -> - fail (Invalid_arity (loc, I_DUG, 1, List.length l)) + tzfail (Invalid_arity (loc, I_DUG, 1, List.length l)) | Prim (loc, I_SWAP, [], annot), Item_t (v, Item_t (w, rest)) -> error_unexpected_annot loc annot >>?= fun () -> let swap = {apply = (fun k -> ISwap (loc, k))} in @@ -2800,7 +2800,7 @@ and parse_instr : match make_comb_get_proof_argument n comb_ty with | None -> let whole_stack = serialize_stack_for_error ctxt stack_ty in - fail (Bad_stack (loc, I_GET, 1, whole_stack)) + tzfail (Bad_stack (loc, I_GET, 1, whole_stack)) | Some (Comb_get_proof_argument (witness, ty')) -> let after_stack_ty = Item_t (ty', rest_ty) in let comb_get = {apply = (fun k -> IComb_get (loc, n, witness, k))} in @@ -3210,7 +3210,7 @@ and parse_instr : option_t loc pair_ty >>?= fun ty -> let stack = Item_t (ty, rest) in typed ctxt loc instr stack - else fail (Deprecated_instruction T_sapling_transaction_deprecated) + else tzfail (Deprecated_instruction T_sapling_transaction_deprecated) | ( Prim (loc, I_SAPLING_VERIFY_UPDATE, [], _), Item_t ( Sapling_transaction_t transaction_memo_size, @@ -3236,7 +3236,7 @@ and parse_instr : non_terminal_recursion tc_context ctxt hd stack >>=? fun (judgement, ctxt) -> match judgement with - | Failed _ -> fail (Fail_not_in_tail_position (Micheline.location hd)) + | Failed _ -> tzfail (Fail_not_in_tail_position (Micheline.location hd)) | Typed ({aft = middle; _} as ihd) -> non_terminal_recursion tc_context @@ -3413,7 +3413,7 @@ and parse_instr : check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun k -> IApply (loc, capture_ty, k))} in lambda_t loc arg_ty ret - (* This cannot fail because the type [lambda 'arg 'ret] is always smaller than + (* This cannot tzfail because the type [lambda 'arg 'ret] is always smaller than the input type [lambda (pair 'arg 'capture) 'ret]. In an ideal world, there would be a smart deconstructor to ensure this statically. *) >>?= @@ -3437,7 +3437,7 @@ and parse_instr : in let stack = Item_t (v, descr.aft) in typed ctxt loc instr stack - | Failed _ -> fail (Fail_not_in_tail_position loc)) + | Failed _ -> tzfail (Fail_not_in_tail_position loc)) | Prim (loc, I_DIP, [n; code], result_annot), stack -> parse_uint10 n >>?= fun n -> Gas.consume ctxt (Typecheck_costs.proof_argument n) >>?= fun ctxt -> @@ -3476,7 +3476,7 @@ and parse_instr : | Prim (loc, I_DIP, (([] | _ :: _ :: _ :: _) as l), _), _ -> (* Technically, the arities 1 and 2 are allowed but the error only mentions 2. However, DIP {code} is equivalent to DIP 1 {code} so hinting at an arity of 2 makes sense. *) - fail (Invalid_arity (loc, I_DIP, 2, List.length l)) + tzfail (Invalid_arity (loc, I_DIP, 2, List.length l)) | Prim (loc, I_FAILWITH, [], annot), Item_t (v, _rest) -> Lwt.return ( error_unexpected_annot loc annot >>? fun () -> @@ -3570,7 +3570,7 @@ and parse_instr : check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun k -> ISub_tez_legacy (loc, k))} in typed ctxt loc instr stack - else fail (Deprecated_instruction I_SUB) + else tzfail (Deprecated_instruction I_SUB) | Prim (loc, I_SUB_MUTEZ, [], annot), Item_t (Mutez_t, Item_t (Mutez_t, rest)) -> check_var_annot loc annot >>?= fun () -> @@ -3917,7 +3917,7 @@ and parse_instr : let stack = Item_t (operation_t, rest) in typed ctxt loc instr stack | Prim (_, I_CREATE_ACCOUNT, _, _), _ -> - fail (Deprecated_instruction I_CREATE_ACCOUNT) + tzfail (Deprecated_instruction I_CREATE_ACCOUNT) | Prim (loc, I_IMPLICIT_ACCOUNT, [], annot), Item_t (Key_hash_t, rest) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun k -> IImplicit_account (loc, k))} in @@ -4030,7 +4030,7 @@ and parse_instr : let stack = Item_t (nat_t, stack) in typed ctxt loc instr stack | Prim (_, I_STEPS_TO_QUOTA, _, _), _ -> - fail (Deprecated_instruction I_STEPS_TO_QUOTA) + tzfail (Deprecated_instruction I_STEPS_TO_QUOTA) | Prim (loc, I_SOURCE, [], annot), stack -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun k -> ISource (loc, k))} in @@ -4206,7 +4206,7 @@ and parse_instr : in let stack = Item_t (res_ty, rest) in typed ctxt loc instr stack - else fail (Deprecated_instruction I_TICKET_DEPRECATED) + else tzfail (Deprecated_instruction I_TICKET_DEPRECATED) | ( Prim (loc, I_READ_TICKET, [], annot), (Item_t (Ticket_t (t, _), _) as full_stack) ) -> check_var_annot loc annot >>?= fun () -> @@ -4251,7 +4251,7 @@ and parse_instr : if legacy then let instr = {apply = (fun k -> IOpen_chest (loc, k))} in typed ctxt loc instr (Item_t (union_bytes_bool_t, rest)) - else fail (Deprecated_instruction I_OPEN_CHEST) + else tzfail (Deprecated_instruction I_OPEN_CHEST) (* Events *) | Prim (loc, I_EMIT, [], annot), Item_t (data, rest) -> check_packable ~legacy loc data >>?= fun () -> @@ -4294,7 +4294,7 @@ and parse_instr : (_ :: _ as l), _ ), _ ) -> - fail (Invalid_arity (loc, name, 0, List.length l)) + tzfail (Invalid_arity (loc, name, 0, List.length l)) | ( Prim ( loc, (( I_NONE | I_LEFT | I_RIGHT | I_NIL | I_MAP | I_ITER | I_EMPTY_SET @@ -4303,7 +4303,7 @@ and parse_instr : (([] | _ :: _ :: _) as l), _ ), _ ) -> - fail (Invalid_arity (loc, name, 1, List.length l)) + tzfail (Invalid_arity (loc, name, 1, List.length l)) | ( Prim ( loc, (( I_PUSH | I_VIEW | I_IF_NONE | I_IF_LEFT | I_IF_CONS | I_EMPTY_MAP @@ -4311,10 +4311,10 @@ and parse_instr : (([] | [_] | _ :: _ :: _ :: _) as l), _ ), _ ) -> - fail (Invalid_arity (loc, name, 2, List.length l)) + tzfail (Invalid_arity (loc, name, 2, List.length l)) | ( Prim (loc, I_LAMBDA, (([] | [_] | [_; _] | _ :: _ :: _ :: _ :: _) as l), _), _ ) -> - fail (Invalid_arity (loc, I_LAMBDA, 3, List.length l)) + tzfail (Invalid_arity (loc, I_LAMBDA, 3, List.length l)) (* Stack errors *) | ( Prim ( loc, @@ -4325,7 +4325,7 @@ and parse_instr : Item_t (ta, Item_t (tb, _)) ) -> let ta = serialize_ty_for_error ta in let tb = serialize_ty_for_error tb in - fail (Undefined_binop (loc, name, ta, tb)) + tzfail (Undefined_binop (loc, name, ta, tb)) | ( Prim ( loc, (( I_NEG | I_ABS | I_NOT | I_SIZE | I_EQ | I_NEQ | I_LT | I_GT | I_LE @@ -4337,14 +4337,14 @@ and parse_instr : _ ), Item_t (t, _) ) -> let t = serialize_ty_for_error t in - fail (Undefined_unop (loc, name, t)) + tzfail (Undefined_unop (loc, name, t)) | Prim (loc, ((I_UPDATE | I_SLICE | I_OPEN_CHEST) as name), [], _), stack -> Lwt.return (let stack = serialize_stack_for_error ctxt stack in error (Bad_stack (loc, name, 3, stack))) | Prim (loc, I_CREATE_CONTRACT, _, _), stack -> let stack = serialize_stack_for_error ctxt stack in - fail (Bad_stack (loc, I_CREATE_CONTRACT, 7, stack)) + tzfail (Bad_stack (loc, I_CREATE_CONTRACT, 7, stack)) | Prim (loc, I_TRANSFER_TOKENS, [], _), stack -> Lwt.return (let stack = serialize_stack_for_error ctxt stack in @@ -4379,7 +4379,7 @@ and parse_instr : error (Bad_stack (loc, name, 2, stack))) (* Generic parsing errors *) | expr, _ -> - fail + tzfail @@ unexpected expr [Seq_kind] diff --git a/src/proto_alpha/lib_protocol/script_ir_unparser.ml b/src/proto_alpha/lib_protocol/script_ir_unparser.ml index c37c8ef5cfa6..6315ff10db35 100644 --- a/src/proto_alpha/lib_protocol/script_ir_unparser.ml +++ b/src/proto_alpha/lib_protocol/script_ir_unparser.ml @@ -492,7 +492,7 @@ module Data_unparser (P : MICHELSON_PARSER) = struct Gas.consume ctxt Unparse_costs.unparse_data_cycle >>?= fun ctxt -> let non_terminal_recursion ctxt mode ty a = if Compare.Int.(stack_depth > 10_000) then - fail Script_tc_errors.Unparsing_too_many_recursive_calls + tzfail Script_tc_errors.Unparsing_too_many_recursive_calls else unparse_data_rec ctxt ~stack_depth:(stack_depth + 1) mode ty a in let loc = Micheline.dummy_location in @@ -695,7 +695,7 @@ module Data_unparser (P : MICHELSON_PARSER) = struct Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>?= fun ctxt -> let non_terminal_recursion ctxt mode code = if Compare.Int.(stack_depth > 10_000) then - fail Unparsing_too_many_recursive_calls + tzfail Unparsing_too_many_recursive_calls else unparse_code_rec ctxt ~stack_depth:(stack_depth + 1) mode code in match code with diff --git a/src/proto_alpha/lib_protocol/ticket_lazy_storage_diff.ml b/src/proto_alpha/lib_protocol/ticket_lazy_storage_diff.ml index cb4005939c5f..d49fe0b3cc5d 100644 --- a/src/proto_alpha/lib_protocol/ticket_lazy_storage_diff.ml +++ b/src/proto_alpha/lib_protocol/ticket_lazy_storage_diff.ml @@ -220,7 +220,7 @@ let collect_token_diffs_of_big_map ctxt ~get_token_and_amount big_map_id acc = acc) (acc, ctxt) exprs - | None -> fail (Failed_to_load_big_map_value_type big_map_id) + | None -> tzfail (Failed_to_load_big_map_value_type big_map_id) (** Collects ticket-token diffs from a big-map and a list of updates, and prepends them to the given accumulator [acc]. *) @@ -236,7 +236,7 @@ let collect_token_diffs_of_big_map_and_updates ctxt big_map_id updates acc = ~value_type updates acc - | None -> fail (Failed_to_load_big_map_value_type big_map_id) + | None -> tzfail (Failed_to_load_big_map_value_type big_map_id) (** Inspects the given [Lazy_storage.diffs_item] and prepends all ticket-token diffs, resulting from the updates, to the given accumulator [acc]. *) diff --git a/src/proto_alpha/lib_protocol/ticket_scanner.ml b/src/proto_alpha/lib_protocol/ticket_scanner.ml index 6c48ef0bc026..152e51c1c635 100644 --- a/src/proto_alpha/lib_protocol/ticket_scanner.ml +++ b/src/proto_alpha/lib_protocol/ticket_scanner.ml @@ -480,7 +480,7 @@ module Ticket_collection = struct k -> consume_gas_steps ctxt ~num_steps:1 >>?= fun ctxt -> (* Require empty overlay *) - if Compare.Int.(size > 0) then fail Unsupported_non_empty_overlay + if Compare.Int.(size > 0) then tzfail Unsupported_non_empty_overlay else (* Traverse the keys for tickets, although currently keys should never contain any tickets. *) diff --git a/src/proto_alpha/lib_protocol/tx_rollup_commitment_storage.ml b/src/proto_alpha/lib_protocol/tx_rollup_commitment_storage.ml index 6d6d94eb9305..797c2a7f25a0 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_commitment_storage.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_commitment_storage.ml @@ -95,11 +95,11 @@ let remove_bond : Storage.Tx_rollup.Commitment_bond.find (ctxt, tx_rollup) contract >>=? fun (ctxt, bond) -> match bond with - | None -> fail (Bond_does_not_exist contract) + | None -> tzfail (Bond_does_not_exist contract) | Some 0 -> Storage.Tx_rollup.Commitment_bond.remove (ctxt, tx_rollup) contract >>=? fun (ctxt, _, _) -> return ctxt - | Some _ -> fail (Bond_in_use contract) + | Some _ -> tzfail (Bond_in_use contract) let slash_bond ctxt tx_rollup contract = Storage.Tx_rollup.Commitment_bond.find (ctxt, tx_rollup) contract @@ -136,7 +136,7 @@ let get : fun ctxt tx_rollup state level -> find ctxt tx_rollup state level >>=? fun (ctxt, commitment) -> match commitment with - | None -> fail @@ Tx_rollup_errors_repr.Commitment_does_not_exist level + | None -> tzfail @@ Tx_rollup_errors_repr.Commitment_does_not_exist level | Some commitment -> return (ctxt, commitment) let get_finalized : @@ -159,7 +159,7 @@ let get_finalized : Storage.Tx_rollup.Commitment.find (ctxt, tx_rollup) level >>=? fun (ctxt, commitment) -> match commitment with - | None -> fail @@ Tx_rollup_errors_repr.Commitment_does_not_exist level + | None -> tzfail @@ Tx_rollup_errors_repr.Commitment_does_not_exist level | Some commitment -> return (ctxt, commitment) let check_commitment_level current_level state commitment = @@ -186,7 +186,7 @@ let check_commitment_predecessor ctxt state commitment = | Some pred_hash, Some expected_hash when Hash.(pred_hash = expected_hash) -> return ctxt | None, None -> return ctxt - | provided, expected -> fail (Wrong_predecessor_hash {provided; expected}) + | provided, expected -> tzfail (Wrong_predecessor_hash {provided; expected}) let check_commitment_batches_and_merkle_root ctxt state inbox commitment = let Tx_rollup_inbox_repr.{inbox_length; merkle_root; _} = inbox in @@ -298,7 +298,7 @@ let finalize_commitment ctxt rollup state = (* We update the state *) Tx_rollup_state_repr.record_inbox_deletion state oldest_inbox_level >>?= fun state -> return (ctxt, state, oldest_inbox_level) - | None -> fail No_commitment_to_finalize + | None -> tzfail No_commitment_to_finalize let remove_commitment ctxt rollup state = match Tx_rollup_state_repr.next_commitment_to_remove state with @@ -316,7 +316,7 @@ let remove_commitment ctxt rollup state = Remove_commitment_too_early | None -> (* unreachable code if the implementation is correct *) - fail (Internal_error "Missing finalized_at field")) + tzfail (Internal_error "Missing finalized_at field")) >>=? fun () -> (* Decrement the bond count of the committer *) adjust_commitments_count ctxt rollup commitment.committer ~dir:`Decr @@ -335,7 +335,7 @@ let remove_commitment ctxt rollup state = commitment.commitment_hash msg_hash >>?= fun state -> return (ctxt, state, tail) - | None -> fail No_commitment_to_remove + | None -> tzfail No_commitment_to_remove let check_agreed_and_disputed_results ctxt tx_rollup state (submitted_commitment : Submitted_commitment.t) ~agreed_result @@ -382,7 +382,7 @@ let check_agreed_and_disputed_results ctxt tx_rollup state (Wrong_rejection_hash {provided = agreed; expected = `Hash last_hash}) >>=? fun () -> return ctxt - | None -> fail (Internal_error "Missing commitment predecessor"))) + | None -> tzfail (Internal_error "Missing commitment predecessor"))) else check_message_result ctxt diff --git a/src/proto_alpha/lib_protocol/tx_rollup_inbox_storage.ml b/src/proto_alpha/lib_protocol/tx_rollup_inbox_storage.ml index 330f6fdd2e5d..6ee40893346d 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_inbox_storage.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_inbox_storage.ml @@ -42,7 +42,7 @@ let get : (Raw_context.t * Tx_rollup_inbox_repr.t) tzresult Lwt.t = fun ctxt level tx_rollup -> find ctxt level tx_rollup >>=? function - | _, None -> fail (Inbox_does_not_exist (tx_rollup, level)) + | _, None -> tzfail (Inbox_does_not_exist (tx_rollup, level)) | ctxt, Some inbox -> return (ctxt, inbox) (** [prepare_inbox ctxt rollup state level] prepares the metadata @@ -71,7 +71,7 @@ let prepare_inbox : let current_levels = Tx_rollup_state_repr.head_levels state in match current_levels with | Some (_, tezos_lvl) when Raw_level_repr.(level < tezos_lvl) -> - fail (Internal_error "Trying to write into an inbox from the past") + tzfail (Internal_error "Trying to write into an inbox from the past") | Some (tx_lvl, tezos_lvl) when Raw_level_repr.(tezos_lvl = level) -> (* An inbox should already exists *) Storage.Tx_rollup.Inbox.get (ctxt, rollup) tx_lvl diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_verifier.ml b/src/proto_alpha/lib_protocol/tx_rollup_l2_verifier.ml index ad7fc7e804aa..50270fbe30c5 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_l2_verifier.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_verifier.ml @@ -175,7 +175,7 @@ let compute_proof_after_hash ~proof_length ~max_proof_size ctxt parameters hash_message_result ctxt tree_hash withdrawals >>?= fun res -> return res | Error _ -> (* Finally, the proof verification leads to an internal Irmin error *) - fail Proof_failed_to_reject + tzfail Proof_failed_to_reject let verify_proof ctxt parameters message proof ~proof_length ~(agreed : Tx_rollup_message_result.t) ~rejected ~max_proof_size = @@ -190,7 +190,7 @@ let verify_proof ctxt parameters message proof ~proof_length >>=? fun (ctxt, computed_result) -> if Alpha_context.Tx_rollup_message_result_hash.(computed_result <> rejected) then return ctxt - else fail Proof_produced_rejected_state + else tzfail Proof_produced_rejected_state module Internal_for_tests = struct let verify_l2_proof = verify_l2_proof diff --git a/src/proto_alpha/lib_protocol/tx_rollup_state_storage.ml b/src/proto_alpha/lib_protocol/tx_rollup_state_storage.ml index 6f03c574dbfc..e31fa5f273fd 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_state_storage.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_state_storage.ml @@ -52,7 +52,7 @@ let get : find ctxt tx_rollup >>=? fun (ctxt, state) -> match state with | Some state -> return (ctxt, state) - | None -> fail (Tx_rollup_does_not_exist tx_rollup) + | None -> tzfail (Tx_rollup_does_not_exist tx_rollup) let assert_exist : Raw_context.t -> Tx_rollup_repr.t -> Raw_context.t tzresult Lwt.t = diff --git a/src/proto_demo_counter/lib_protocol/main.ml b/src/proto_demo_counter/lib_protocol/main.ml index 07551afdf8d3..f9c997b9661e 100644 --- a/src/proto_demo_counter/lib_protocol/main.ml +++ b/src/proto_demo_counter/lib_protocol/main.ml @@ -163,7 +163,7 @@ let apply_operation_aux application_state operation = let {context; fitness} = application_state in State.get_state context >>= fun state -> match Apply.apply state operation.protocol_data with - | None -> Error_monad.fail Error.Invalid_operation + | None -> Error_monad.tzfail Error.Invalid_operation | Some state -> State.update_state context state >>= fun context -> return {context; fitness} @@ -209,7 +209,7 @@ let finalize_application application_state _shell_header = let decode_json json = match Proto_params.from_json json with | exception _ -> - fail Error.Invalid_protocol_parameters + tzfail Error.Invalid_protocol_parameters | proto_params -> return proto_params @@ -222,14 +222,14 @@ let get_init_state context : State.t tzresult Lwt.t = | Some bytes -> ( match Data_encoding.Binary.of_bytes_opt Data_encoding.json bytes with | None -> - fail (Error.Failed_to_parse_parameter bytes) + tzfail (Error.Failed_to_parse_parameter bytes) | Some json -> decode_json json )) >>=? function | Proto_params.{init_a; init_b} -> ( match State.create init_a init_b with | None -> - fail Error.Invalid_protocol_parameters + tzfail Error.Invalid_protocol_parameters | Some state -> return state ) diff --git a/src/proto_demo_noops/lib_protocol/main.ml b/src/proto_demo_noops/lib_protocol/main.ml index 9b5cb2458486..f194751ac3a6 100644 --- a/src/proto_demo_noops/lib_protocol/main.ml +++ b/src/proto_demo_noops/lib_protocol/main.ml @@ -125,9 +125,9 @@ let () = (function No_error -> Some () | _ -> None) (fun () -> No_error) -let validate_operation ?check_signature:_ _state _oph _op = fail No_error +let validate_operation ?check_signature:_ _state _oph _op = tzfail No_error -let apply_operation _state _oph _op = fail No_error +let apply_operation _state _oph _op = tzfail No_error let finalize_validation _state = return_unit @@ -157,7 +157,7 @@ let init _chain_id context block_header = let value_of_key ~chain_id:_ ~predecessor_context:_ ~predecessor_timestamp:_ ~predecessor_level:_ ~predecessor_fitness:_ ~predecessor:_ ~timestamp:_ = - return (fun _ -> fail No_error) + return (fun _ -> tzfail No_error) let rpc_services = RPC_directory.empty -- GitLab From d07c0dfa8d19e963e3d173c8b9af404b8013a4b4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Tue, 22 Nov 2022 08:14:45 +0100 Subject: [PATCH 3/3] Client/test: adapt injection test protocol to tzfail rename --- src/bin_client/test/proto_test_injection/main.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/bin_client/test/proto_test_injection/main.ml b/src/bin_client/test/proto_test_injection/main.ml index c3f1b9fc2270..dc3c67868fba 100644 --- a/src/bin_client/test/proto_test_injection/main.ml +++ b/src/bin_client/test/proto_test_injection/main.ml @@ -81,7 +81,7 @@ module Fitness = struct b let int64_of_bytes b = - if Compare.Int.(Bytes.length b <> 8) then fail Invalid_fitness2 + if Compare.Int.(Bytes.length b <> 8) then tzfail Invalid_fitness2 else return (TzEndian.get_int64 b 0) let from_int64 fitness = [int64_to_bytes fitness] @@ -89,7 +89,7 @@ module Fitness = struct let to_int64 = function | [fitness] -> int64_of_bytes fitness | [] -> return 0L - | _ -> fail Invalid_fitness + | _ -> tzfail Invalid_fitness let get {fitness; _} = fitness end @@ -160,7 +160,7 @@ type error += Missing_value_in_cache let value_of_key ~chain_id:_ ~predecessor_context:_ ~predecessor_timestamp:_ ~predecessor_level:_ ~predecessor_fitness:_ ~predecessor:_ ~timestamp:_ = - return (fun _ -> fail Missing_value_in_cache) + return (fun _ -> tzfail Missing_value_in_cache) (* Fake mempool *) module Mempool = struct -- GitLab