diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index 4707d5988..017e73adf 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -286,8 +286,6 @@ module Script : sig type lazy_expr = expr Data_encoding.lazy_t - val force_decode : lazy_expr -> expr tzresult - val force_bytes : lazy_expr -> MBytes.t tzresult val lazy_expr : expr -> lazy_expr type node = (location, prim) Micheline.node @@ -301,7 +299,12 @@ module Script : sig val prim_encoding: prim Data_encoding.t val encoding: t Data_encoding.t val lazy_expr_encoding: lazy_expr Data_encoding.t - val expr_cost : expr -> Gas.cost + val deserialized_cost : expr -> Gas.cost + val serialized_cost : MBytes.t -> Gas.cost + val force_decode : lazy_expr -> (expr * Gas.cost) tzresult + val force_bytes : lazy_expr -> (MBytes.t * Gas.cost) tzresult + val minimal_deserialize_cost : lazy_expr -> Gas.cost + val minimal_serialize_cost : lazy_expr -> Gas.cost end module Constants : sig diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml index 02f80ece5..f7e613d6b 100644 --- a/src/proto_alpha/lib_protocol/src/apply.ml +++ b/src/proto_alpha/lib_protocol/src/apply.ml @@ -359,15 +359,16 @@ let apply_manager_operation_content : match script with | None -> begin match parameters with - | None -> return_unit + | None -> return ctxt | Some arg -> - Lwt.return (Script.force_decode arg) >>=? fun arg -> + Lwt.return (Script.force_decode arg) >>=? fun (arg, cost_arg) -> + Lwt.return (Gas.consume ctxt cost_arg) >>=? fun ctxt -> match Micheline.root arg with | Prim (_, D_Unit, [], _) -> (* Allow [Unit] parameter to non-scripted contracts. *) - return_unit + return ctxt | _ -> fail (Script_interpreter.Bad_contract_parameter destination) - end >>=? fun () -> + end >>=? fun ctxt -> let result = Transaction_result { storage = None ; @@ -388,7 +389,8 @@ let apply_manager_operation_content : let unit = Micheline.strip_locations (Prim (0, Script.D_Unit, [], [])) in return (ctxt, unit) | Some parameters -> - Lwt.return (Script.force_decode parameters) >>=? fun arg -> + Lwt.return (Script.force_decode parameters) >>=? fun (arg, cost_arg) -> + Lwt.return (Gas.consume ctxt cost_arg) >>=? fun ctxt -> return (ctxt, arg) end >>=? fun (ctxt, parameter) -> Script_interpreter.execute @@ -501,13 +503,27 @@ let precheck_manager_contents | Reveal pk -> Contract.reveal_manager_key ctxt source pk | Transaction { parameters = Some arg ; _ } -> - let min_gas = Michelson_v1_gas.Cost_of.Typechecking.minimal_deserialize arg in (* Fail if not enough gas for minimal deserialization cost *) - begin - match Gas.consume ctxt min_gas with + begin match Gas.consume ctxt (Script.minimal_deserialize_cost arg) with | Ok _ -> return ctxt | Error _ -> fail Not_enough_gas_minimal_deserialize - end + end >>=? fun ctxt -> + Lwt.return @@ Script.force_decode arg >>=? fun (_arg, cost_arg) -> + Lwt.return @@ Gas.consume ctxt cost_arg + | Origination { script = Some script ; _ } -> + (* Fail if not enough gas for minimal deserialization cost *) + begin + match + Gas.consume ctxt (Script.minimal_deserialize_cost script.code) >>? fun ctxt -> + Gas.consume ctxt (Script.minimal_deserialize_cost script.storage) + with + | Ok _ -> return ctxt + | Error _ -> fail Not_enough_gas_minimal_deserialize + end >>=? fun ctxt -> + Lwt.return @@ Script.force_decode script.code >>=? fun (_code, cost_code) -> + Lwt.return @@ Gas.consume ctxt cost_code >>=? fun ctxt -> + Lwt.return @@ Script.force_decode script.storage >>=? fun (_storage, cost_storage) -> + Lwt.return @@ Gas.consume ctxt cost_storage | _ -> return ctxt end >>=? fun ctxt -> Contract.get_manager_key ctxt source >>=? fun public_key -> diff --git a/src/proto_alpha/lib_protocol/src/contract_services.ml b/src/proto_alpha/lib_protocol/src/contract_services.ml index eb7c85d9f..d631452c2 100644 --- a/src/proto_alpha/lib_protocol/src/contract_services.ml +++ b/src/proto_alpha/lib_protocol/src/contract_services.ml @@ -168,8 +168,9 @@ let register () = let ctxt = Gas.set_unlimited ctxt in let open Script_ir_translator in parse_script ctxt script >>=? fun (Ex_script script, ctxt) -> - unparse_script ctxt Readable script >>=? fun (script, _ctxt) -> - Lwt.return (Script.force_decode script.storage) >>=? fun storage -> + unparse_script ctxt Readable script >>=? fun (script, ctxt) -> + Lwt.return @@ Script.force_decode script.storage >>=? fun (storage, cost_storage) -> + Lwt.return @@ Gas.consume ctxt cost_storage >>=? fun _ctxt -> return_some storage) ; register_field S.info (fun ctxt contract -> Contract.get_balance ctxt contract >>=? fun balance -> diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.ml b/src/proto_alpha/lib_protocol/src/contract_storage.ml index adf9bc27e..a253c9934 100644 --- a/src/proto_alpha/lib_protocol/src/contract_storage.ml +++ b/src/proto_alpha/lib_protocol/src/contract_storage.ml @@ -339,7 +339,8 @@ let get_storage ctxt contract = Storage.Contract.Storage.get_option ctxt contract >>=? function | (ctxt, None) -> return (ctxt, None) | (ctxt, Some storage) -> - Lwt.return (Script_repr.force_decode storage) >>=? fun storage -> + Lwt.return (Script_repr.force_decode storage) >>=? fun (storage, cost) -> + Lwt.return (Raw_context.consume_gas ctxt cost) >>=? fun ctxt -> return (ctxt, Some storage) let get_counter c contract = diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml index c77d3d055..5d4582e90 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml @@ -233,12 +233,6 @@ module Cost_of = struct (* TODO: proper handling of (de)serialization costs *) let len = MBytes.length b in alloc_cost len +@ step_cost (len * 10) - let minimal_deserialize expr = - Data_encoding.fold_lazy - Script.expr_cost - (fun b -> alloc_bytes_cost (MBytes.length b)) - (fun c _ -> c) (* keep expr cost if present *) - expr end module Unparse = struct diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli index a6f4aaaf7..87498fa7e 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli @@ -132,8 +132,6 @@ module Cost_of : sig val two_arg_type : Gas.cost val operation : MBytes.t -> Gas.cost - - val minimal_deserialize : Script.lazy_expr -> Gas.cost end module Unparse : sig diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml index b8d4332fe..e772b03bc 100644 --- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml @@ -749,7 +749,8 @@ and execute ?log ctxt mode ~source ~payer ~self script amount arg : trace (Bad_contract_parameter self) (parse_data ctxt arg_type arg) >>=? fun (arg, ctxt) -> - Lwt.return (Script.force_decode script.code) >>=? fun script_code -> + Lwt.return @@ Script.force_decode script.code >>=? fun (script_code, cost_script_code) -> + Lwt.return @@ Gas.consume ctxt cost_script_code >>=? fun ctxt -> trace (Runtime_contract_error (self, script_code)) (interp ?log ctxt ~source ~payer ~self amount code (arg, storage)) diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml index 3595dd044..05fc02615 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -2550,7 +2550,8 @@ and parse_contract ok (ctxt, contract)) | Some { code ; _ } -> Lwt.return - (Script.force_decode code >>? fun code -> + (Script.force_decode code >>? fun (code, cost_code) -> + Gas.consume ctxt cost_code >>? fun ctxt -> parse_toplevel code >>? fun (arg_type, _, _) -> parse_ty ~allow_big_map:false ~allow_operation:false arg_type >>? fun (Ex_ty targ) -> ty_eq targ arg >>? fun Eq -> @@ -2606,8 +2607,10 @@ let parse_script : ?type_logger: type_logger -> context -> Script.t -> (ex_script * context) tzresult Lwt.t = fun ?type_logger ctxt { code ; storage } -> - Lwt.return @@ Script.force_decode code >>=? fun code -> - Lwt.return @@ Script.force_decode storage >>=? fun storage -> + Lwt.return @@ Script.force_decode code >>=? fun (code, cost_code) -> + Lwt.return @@ Gas.consume ctxt cost_code >>=? fun ctxt -> + Lwt.return @@ Script.force_decode storage >>=? fun (storage, cost_storage) -> + Lwt.return @@ Gas.consume ctxt cost_storage >>=? fun ctxt -> Lwt.return @@ parse_toplevel code >>=? fun (arg_type, storage_type, code_field) -> trace (Ill_formed_type (Some "parameter", code, location arg_type)) @@ -2932,8 +2935,10 @@ let extract_big_map : type a. a ty -> a -> ex_big_map option = fun ty x -> | _, _ -> None let erase_big_map_initialization ctxt mode ({ code ; storage } : Script.t) = - Lwt.return (Script.force_decode code) >>=? fun code -> - Lwt.return (Script.force_decode storage) >>=? fun storage -> + Lwt.return @@ Script.force_decode code >>=? fun (code, cost_code) -> + Lwt.return @@ Gas.consume ctxt cost_code >>=? fun ctxt -> + Lwt.return @@ Script.force_decode storage >>=? fun (storage, cost_storage) -> + Lwt.return @@ Gas.consume ctxt cost_storage >>=? fun ctxt -> Lwt.return @@ parse_toplevel code >>=? fun (_, storage_type, _) -> Lwt.return @@ parse_ty ~allow_big_map:true ~allow_operation:false storage_type >>=? fun (Ex_ty ty) -> parse_data ctxt ty diff --git a/src/proto_alpha/lib_protocol/src/script_repr.ml b/src/proto_alpha/lib_protocol/src/script_repr.ml index 013fc22cd..bdad89873 100644 --- a/src/proto_alpha/lib_protocol/src/script_repr.ml +++ b/src/proto_alpha/lib_protocol/src/script_repr.ml @@ -42,16 +42,6 @@ let lazy_expr_encoding = let lazy_expr expr = Data_encoding.make_lazy expr_encoding expr -let force_decode expr = - match Data_encoding.force_decode expr with - | Some v -> ok v - | None -> error Lazy_script_decode - -let force_bytes expr = - match Data_encoding.force_bytes expr with - | bytes -> ok bytes - | exception _ -> error Lazy_script_decode - type t = { code : lazy_expr ; storage : lazy_expr @@ -95,6 +85,62 @@ let rec node_size node = let expr_size expr = node_size (Micheline.root expr) -let expr_cost expr = +let traversal_cost expr = + let blocks, _words = expr_size expr in + Gas_limit_repr.step_cost blocks + +let deserialized_cost expr = + let open Gas_limit_repr in let blocks, words = expr_size expr in - Gas_limit_repr.(((Compare.Int.max 0 (blocks - 1)) *@ alloc_cost 0) +@ alloc_cost words) + ((Compare.Int.max 0 (blocks - 1)) *@ alloc_cost 0) +@ + alloc_cost words +@ + step_cost blocks + +let serialized_cost bytes = + let open Gas_limit_repr in + alloc_bytes_cost (MBytes.length bytes) + +let force_decode lexpr = + match Data_encoding.force_decode lexpr with + | Some v -> + let deserialize_cost = + Data_encoding.fold_lazy + (fun _ -> Gas_limit_repr.free) + (fun _ -> deserialized_cost v) + (fun c_free _ -> c_free) + lexpr in + ok (v, deserialize_cost) + | None -> error Lazy_script_decode + +let force_bytes expr = + let open Gas_limit_repr in + match Data_encoding.force_bytes expr with + | bytes -> + let serialize_cost = + Data_encoding.fold_lazy + (fun v -> traversal_cost v +@ serialized_cost bytes) + (fun _ -> Gas_limit_repr.free) + (fun _ c_free -> c_free) + expr in + ok (bytes, serialize_cost) + | exception _ -> error Lazy_script_decode + +let minimal_deserialize_cost lexpr = + let open Gas_limit_repr in + Data_encoding.fold_lazy + (fun _ -> Gas_limit_repr.free) + (fun b -> alloc_bytes_cost (MBytes.length b)) + (fun c_free _ -> c_free) + lexpr + +let minimal_serialize_cost lexpr = + let open Gas_limit_repr in + Data_encoding.fold_lazy + (fun v -> + let blocks, _words = expr_size v in + step_cost blocks +@ + alloc_bytes_cost blocks (* TODO *) + ) + (fun _ -> Gas_limit_repr.free) + (fun _ c_free -> c_free) + lexpr diff --git a/src/proto_alpha/lib_protocol/src/script_repr.mli b/src/proto_alpha/lib_protocol/src/script_repr.mli index a25359377..8299c38ff 100644 --- a/src/proto_alpha/lib_protocol/src/script_repr.mli +++ b/src/proto_alpha/lib_protocol/src/script_repr.mli @@ -17,10 +17,6 @@ type error += Lazy_script_decode (* `Permanent *) type lazy_expr = expr Data_encoding.lazy_t -val force_decode : lazy_expr -> expr tzresult - -val force_bytes : lazy_expr -> MBytes.t tzresult - type node = (location, Michelson_v1_primitives.prim) Micheline.node val location_encoding : location Data_encoding.t @@ -35,4 +31,14 @@ type t = { code : lazy_expr ; storage : lazy_expr } val encoding : t Data_encoding.encoding -val expr_cost : expr -> Gas_limit_repr.cost +val deserialized_cost : expr -> Gas_limit_repr.cost + +val serialized_cost : MBytes.t -> Gas_limit_repr.cost + +val force_decode : lazy_expr -> (expr * Gas_limit_repr.cost) tzresult + +val force_bytes : lazy_expr -> (MBytes.t * Gas_limit_repr.cost) tzresult + +val minimal_deserialize_cost : lazy_expr -> Gas_limit_repr.cost + +val minimal_serialize_cost : lazy_expr -> Gas_limit_repr.cost