Alpha: check hard gas limit in precheck

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

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

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

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) ->

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 =

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