diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.ml b/src/proto_alpha/lib_protocol/src/alpha_context.ml index 142a71688..fd7aec34d 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/src/alpha_context.ml @@ -70,6 +70,7 @@ module Voting_period = Voting_period_repr module Gas = struct include Gas_limit_repr type error += Gas_limit_too_high = Raw_context.Gas_limit_too_high + let check_limit = Raw_context.check_gas_limit let set_limit = Raw_context.set_gas_limit let set_unlimited = Raw_context.set_gas_unlimited let consume = Raw_context.consume_gas diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index 2a438c0c9..3c7697f88 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -136,7 +136,8 @@ module Gas : sig val ( *@ ) : int -> cost -> cost val ( +@ ) : cost -> cost -> cost - val set_limit: context -> Z.t -> context tzresult + val check_limit: context -> Z.t -> unit tzresult + val set_limit: context -> Z.t -> context val set_unlimited: context -> context val consume: context -> cost -> context tzresult val level: context -> t diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml index be8b453a3..e86e3990f 100644 --- a/src/proto_alpha/lib_protocol/src/apply.ml +++ b/src/proto_alpha/lib_protocol/src/apply.ml @@ -482,7 +482,8 @@ let apply_internal_manager_operations ctxt mode ~payer ops = let precheck_manager_contents (type kind) ctxt raw_operation (op : kind Kind.manager contents) : context tzresult Lwt.t = - let Manager_operation { source ; fee ; counter ; operation } = op in + let Manager_operation { source ; fee ; counter ; operation ; gas_limit } = op in + Lwt.return (Gas.check_limit ctxt gas_limit) >>=? fun () -> Contract.must_be_allocated ctxt source >>=? fun () -> Contract.check_counter_increment ctxt source counter >>=? fun () -> begin @@ -507,7 +508,7 @@ let apply_manager_contents : (context * kind Kind.manager contents_result) tzresult Lwt.t = let Manager_operation { source ; fee ; operation ; gas_limit ; storage_limit } = op in - Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt -> + let ctxt = Gas.set_limit ctxt gas_limit in let level = Level.current ctxt in Fees.with_fees_for_storage ctxt ~payer:source ~storage_limit begin fun ctxt -> apply_manager_operation_content ctxt mode diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.ml b/src/proto_alpha/lib_protocol/src/helpers_services.ml index 10869be6a..b60ca4135 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.ml +++ b/src/proto_alpha/lib_protocol/src/helpers_services.ml @@ -156,7 +156,7 @@ module Scripts = struct let storage = Script.lazy_expr storage in let code = Script.lazy_expr code in originate_dummy_contract ctxt { storage ; code } >>=? fun (ctxt, dummy_contract) -> - Lwt.return (Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt)) >>=? fun ctxt -> + let ctxt = Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt) in Script_interpreter.execute ctxt Readable ~source:dummy_contract @@ -171,7 +171,7 @@ module Scripts = struct let storage = Script.lazy_expr storage in let code = Script.lazy_expr code in originate_dummy_contract ctxt { storage ; code } >>=? fun (ctxt, dummy_contract) -> - Lwt.return (Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt)) >>=? fun ctxt -> + let ctxt = Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt) in Script_interpreter.trace ctxt Readable ~source:dummy_contract @@ -182,24 +182,24 @@ module Scripts = struct return (storage, operations, trace, big_map_diff) end ; register0 S.typecheck_code begin fun ctxt () (expr, maybe_gas) -> - begin match maybe_gas with - | None -> return (Gas.set_unlimited ctxt) - | Some gas -> Lwt.return (Gas.set_limit ctxt gas) end >>=? fun ctxt -> + let ctxt = match maybe_gas with + | None -> Gas.set_unlimited ctxt + | Some gas -> Gas.set_limit ctxt gas in Script_ir_translator.typecheck_code ctxt expr >>=? fun (res, ctxt) -> return (res, Gas.level ctxt) end ; register0 S.typecheck_data begin fun ctxt () (data, ty, maybe_gas) -> - begin match maybe_gas with - | None -> return (Gas.set_unlimited ctxt) - | Some gas -> Lwt.return (Gas.set_limit ctxt gas) end >>=? fun ctxt -> + let ctxt = match maybe_gas with + | None -> Gas.set_unlimited ctxt + | Some gas -> Gas.set_limit ctxt gas in Script_ir_translator.typecheck_data ctxt (data, ty) >>=? fun ctxt -> return (Gas.level ctxt) end ; register0 S.pack_data begin fun ctxt () (expr, typ, maybe_gas) -> let open Script_ir_translator in - begin match maybe_gas with - | None -> return (Gas.set_unlimited ctxt) - | Some gas -> Lwt.return (Gas.set_limit ctxt gas) end >>=? fun ctxt -> + let ctxt = match maybe_gas with + | None -> Gas.set_unlimited ctxt + | Some gas -> Gas.set_limit ctxt gas in Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:false (Micheline.root typ)) >>=? fun (Ex_ty typ) -> parse_data ctxt typ (Micheline.root expr) >>=? fun (data, ctxt) -> Script_ir_translator.pack_data ctxt typ data >>=? fun (bytes, ctxt) -> diff --git a/src/proto_alpha/lib_protocol/src/raw_context.ml b/src/proto_alpha/lib_protocol/src/raw_context.ml index 300f48f7b..10f4f5ac8 100644 --- a/src/proto_alpha/lib_protocol/src/raw_context.ml +++ b/src/proto_alpha/lib_protocol/src/raw_context.ml @@ -160,12 +160,14 @@ let () = (function Gas_limit_too_high -> Some () | _ -> None) (fun () -> Gas_limit_too_high) -let set_gas_limit ctxt remaining = +let check_gas_limit ctxt remaining = if Compare.Z.(remaining > ctxt.constants.hard_gas_limit_per_operation) || Compare.Z.(remaining < Z.zero) then error Gas_limit_too_high else - ok { ctxt with operation_gas = Limited { remaining } } + ok () +let set_gas_limit ctxt remaining = + { ctxt with operation_gas = Limited { remaining } } let set_gas_unlimited ctxt = { ctxt with operation_gas = Unaccounted } let consume_gas ctxt cost = diff --git a/src/proto_alpha/lib_protocol/src/raw_context.mli b/src/proto_alpha/lib_protocol/src/raw_context.mli index b5b132f1e..72039c0d6 100644 --- a/src/proto_alpha/lib_protocol/src/raw_context.mli +++ b/src/proto_alpha/lib_protocol/src/raw_context.mli @@ -90,7 +90,8 @@ val get_deposits: context -> Tez_repr.t Signature.Public_key_hash.Map.t type error += Gas_limit_too_high (* `Permanent *) -val set_gas_limit: t -> Z.t -> t tzresult +val check_gas_limit: t -> Z.t -> unit tzresult +val set_gas_limit: t -> Z.t -> t val set_gas_unlimited: t -> t val gas_level: t -> Gas_limit_repr.t val gas_consumed: since: t -> until: t -> Z.t