diff --git a/src/proto_alpha/lib_client/client_proto_args.ml b/src/proto_alpha/lib_client/client_proto_args.ml index a36daa55b..321012908 100644 --- a/src/proto_alpha/lib_client/client_proto_args.ml +++ b/src/proto_alpha/lib_client/client_proto_args.ml @@ -163,6 +163,20 @@ let gas_limit_arg = return v with _ -> failwith "invalid gas limit (must be a positive number)")) +let storage_limit_arg = + arg + ~long:"storage-limit" + ~short:'S' + ~placeholder:"amount" + ~doc:"Set the storage limit of the transaction instead \ + of letting the client decide based on a simulation" + (parameter (fun _ s -> + try + let v = Int64.of_string s in + assert Compare.Int64.(v >= 0L) ; + return v + with _ -> failwith "invalid storage limit (must be a positive number of bytes)")) + let max_priority_arg = arg ~long:"max-priority" diff --git a/src/proto_alpha/lib_client/client_proto_args.mli b/src/proto_alpha/lib_client/client_proto_args.mli index 08fc898c7..9049b1a73 100644 --- a/src/proto_alpha/lib_client/client_proto_args.mli +++ b/src/proto_alpha/lib_client/client_proto_args.mli @@ -15,6 +15,7 @@ val tez_sym: string val init_arg: (string, Proto_alpha.full) Clic.arg val fee_arg: (Tez.t, Proto_alpha.full) Clic.arg val gas_limit_arg: (Z.t option, Proto_alpha.full) Clic.arg +val storage_limit_arg: (Int64.t option, Proto_alpha.full) Clic.arg val arg_arg: (string, Proto_alpha.full) Clic.arg val source_arg: (string option, Proto_alpha.full) Clic.arg diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml index 6df23ae8d..e09deb5e2 100644 --- a/src/proto_alpha/lib_client/client_proto_context.ml +++ b/src/proto_alpha/lib_client/client_proto_context.ml @@ -39,7 +39,7 @@ let append_reveal let transfer (cctxt : #Proto_alpha.full) block ?confirmations ?branch ~source ~src_pk ~src_sk ~destination ?arg - ~amount ~fee ?(gas_limit = Z.minus_one) () = + ~amount ~fee ?(gas_limit = Z.minus_one) ?(storage_limit = -1L) () = begin match arg with | Some arg -> parse_expression arg >>=? fun { expanded = arg } -> @@ -54,7 +54,7 @@ let transfer (cctxt : #Proto_alpha.full) let contents = Sourced_operation (Manager_operations { source ; fee ; counter ; - gas_limit ; operations }) in + gas_limit ; storage_limit ; operations }) in Injection.inject_operation cctxt block ?confirmations ?branch ~src_sk contents >>=? fun (_oph, _op, result as res) -> Lwt.return (Injection.originated_contracts result) >>=? fun contracts -> @@ -70,18 +70,19 @@ let reveal cctxt | [] -> failwith "The manager key was previously revealed." | _ :: _ -> - let gas_limit = Z.zero in let contents = Sourced_operation (Manager_operations { source ; fee ; counter ; - gas_limit ; operations }) in + gas_limit = Z.zero ; storage_limit = 0L ; + operations }) in Injection.inject_operation cctxt block ?confirmations ?branch ~src_sk contents >>=? fun res -> return res let originate cctxt block ?confirmations - ?branch ~source ~src_pk ~src_sk ~fee ?(gas_limit = Z.minus_one) origination = + ?branch ~source ~src_pk ~src_sk ~fee + ?(gas_limit = Z.minus_one) ?(storage_limit = -1L) origination = Alpha_services.Contract.counter cctxt block source >>=? fun pcounter -> let counter = Int32.succ pcounter in let operations = [origination] in @@ -90,7 +91,7 @@ let originate let contents = Sourced_operation (Manager_operations { source ; fee ; counter ; - gas_limit ; operations }) in + gas_limit ; storage_limit ; operations }) in Injection.inject_operation cctxt block ?confirmations ?branch ~src_sk contents >>=? fun (_oph, _op, result as res) -> Lwt.return (Injection.originated_contracts result) >>=? function @@ -129,7 +130,8 @@ let delegate_contract cctxt let contents = Sourced_operation (Manager_operations { source ; fee ; counter ; - gas_limit = Z.zero ; operations }) in + gas_limit = Z.zero ; storage_limit = 0L ; + operations }) in Injection.inject_operation cctxt block ?confirmations ?branch ~src_sk contents >>=? fun res -> return res @@ -204,6 +206,7 @@ let originate_contract block ?confirmations ?branch ~fee ?gas_limit + ?storage_limit ~delegate ?(delegatable=true) ?(spendable=false) @@ -227,7 +230,7 @@ let originate_contract credit = balance ; preorigination = None } in originate cctxt block ?confirmations - ?branch ~source ~src_pk ~src_sk ~fee ?gas_limit origination + ?branch ~source ~src_pk ~src_sk ~fee ?gas_limit ?storage_limit origination type activation_key = { pkh : Ed25519.Public_key_hash.t ; diff --git a/src/proto_alpha/lib_client/client_proto_context.mli b/src/proto_alpha/lib_client/client_proto_context.mli index c0fbced42..734476eec 100644 --- a/src/proto_alpha/lib_client/client_proto_context.mli +++ b/src/proto_alpha/lib_client/client_proto_context.mli @@ -89,6 +89,7 @@ val originate_contract: ?branch:int -> fee:Tez.t -> ?gas_limit:Z.t -> + ?storage_limit:Int64.t -> delegate:public_key_hash option -> ?delegatable:bool -> ?spendable:bool -> @@ -114,6 +115,7 @@ val transfer : amount:Tez.t -> fee:Tez.t -> ?gas_limit:Z.t -> + ?storage_limit:Int64.t -> unit -> (Injection.result * Contract.t list) tzresult Lwt.t diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml index 0716b58fb..b286dfc97 100644 --- a/src/proto_alpha/lib_client/injection.ml +++ b/src/proto_alpha/lib_client/injection.ml @@ -72,6 +72,22 @@ let estimated_gas = function (Ok Z.zero) operation_results | _ -> Ok Z.zero +let estimated_storage = function + | Sourced_operation_result (Manager_operations_result { operation_results }) -> + List.fold_left + (fun acc (_, r) -> acc >>? fun acc -> + match r with + | Applied (Transaction_result { storage_size_diff } + | Origination_result { storage_size_diff }) -> + Ok (Int64.add storage_size_diff acc) + | Applied Reveal_result -> Ok acc + | Applied Delegation_result -> Ok acc + | Skipped -> assert false + | Failed errs -> Alpha_environment.wrap_error (Error errs)) + (Ok 0L) operation_results >>? fun diff -> + Ok (max 0L diff) + | _ -> Ok 0L + let originated_contracts = function | Sourced_operation_result (Manager_operations_result { operation_results }) -> List.fold_left @@ -87,34 +103,53 @@ let originated_contracts = function (Ok []) operation_results | _ -> Ok [] -let may_patch_gas_limit +let may_patch_limits (cctxt : #Proto_alpha.full) block ?branch ?src_sk contents = Alpha_services.Constants.hard_gas_limits cctxt block >>=? fun (_, gas_limit) -> + Alpha_services.Constants.hard_storage_limits cctxt block >>=? fun (_, storage_limit) -> match contents with | Sourced_operation (Manager_operations c) - when c.gas_limit < Z.zero || gas_limit < c.gas_limit -> + when c.gas_limit < Z.zero || gas_limit < c.gas_limit + || c.storage_limit < 0L || storage_limit < c.storage_limit -> let contents = - Sourced_operation (Manager_operations { c with gas_limit }) in + Sourced_operation (Manager_operations { c with gas_limit ; storage_limit }) in preapply cctxt block ?branch ?src_sk contents >>=? fun (_, _, result) -> - Lwt.return (estimated_gas result) >>=? fun gas -> - begin - if Z.equal gas Z.zero then - cctxt#message "Estimated gas: none" >>= fun () -> - return Z.zero - else - cctxt#message - "Estimated gas: %s units (will add 100 for safety)" - (Z.to_string gas) >>= fun () -> - return (Z.add gas (Z.of_int 100)) + begin if c.gas_limit < Z.zero || gas_limit < c.gas_limit then + Lwt.return (estimated_gas result) >>=? fun gas -> + begin + if Z.equal gas Z.zero then + cctxt#message "Estimated gas: none" >>= fun () -> + return Z.zero + else + cctxt#message + "Estimated gas: %s units (will add 100 for safety)" + (Z.to_string gas) >>= fun () -> + return (Z.add gas (Z.of_int 100)) + end + else return c.gas_limit end >>=? fun gas_limit -> - return (Sourced_operation (Manager_operations { c with gas_limit })) + begin if c.storage_limit < 0L || storage_limit < c.storage_limit then + Lwt.return (estimated_storage result) >>=? fun storage -> + begin + if Int64.equal storage 0L then + cctxt#message "Estimated storage: no bytes added" >>= fun () -> + return 0L + else + cctxt#message + "Estimated storage: %Ld bytes added (will add 20 for safety)" + storage >>= fun () -> + return (Int64.add storage 20L) + end + else return c.storage_limit + end >>=? fun storage_limit -> + return (Sourced_operation (Manager_operations { c with gas_limit ; storage_limit })) | op -> return op let inject_operation cctxt block ?confirmations ?branch ?src_sk contents = - may_patch_gas_limit + may_patch_limits cctxt block ?branch ?src_sk contents >>=? fun contents -> preapply cctxt block ?branch ?src_sk contents >>=? fun (_oph, op, result) -> diff --git a/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml b/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml index 71a4143ec..c127c672c 100644 --- a/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml +++ b/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml @@ -204,9 +204,14 @@ let report_errors ~details ~show_source ?parsed ppf errs = print_source (parsed, hilights) ; if rest <> [] then Format.fprintf ppf "@," ; print_trace (parsed_locations parsed) rest + | Alpha_environment.Ecoproto_error Gas.Gas_limit_too_high :: rest -> + Format.fprintf ppf + "Gas limit for the block is out of the protocol hard bounds." ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest | Alpha_environment.Ecoproto_error Gas.Block_quota_exceeded :: rest -> Format.fprintf ppf - "@[Gas limit for the block exceeded during typechecking or execution.@]" ; + "Gas limit for the block exceeded during typechecking or execution." ; if rest <> [] then Format.fprintf ppf "@," ; print_trace locations rest | Alpha_environment.Ecoproto_error Gas.Operation_quota_exceeded :: rest -> @@ -214,6 +219,21 @@ let report_errors ~details ~show_source ?parsed ppf errs = "@[Gas limit exceeded during typechecking or execution.@,Try again with a higher gas limit.@]" ; if rest <> [] then Format.fprintf ppf "@," ; print_trace locations rest + | Alpha_environment.Ecoproto_error Contract.Storage_limit_too_high :: rest -> + Format.fprintf ppf + "Storage limit for the block is out of the protocol hard bounds." ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Alpha_environment.Ecoproto_error Contract.Block_storage_quota_exceeded :: rest -> + Format.fprintf ppf + "Storage limit for the block exceeded during typechecking or execution." ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest + | Alpha_environment.Ecoproto_error Contract.Operation_storage_quota_exceeded :: rest -> + Format.fprintf ppf + "@[Storage limit exceeded during typechecking or execution.@,Try again with a higher storage limit.@]" ; + if rest <> [] then Format.fprintf ppf "@," ; + print_trace locations rest | Alpha_environment.Ecoproto_error err :: rest -> begin match err with | Apply.Bad_contract_parameter (c, None, _) -> diff --git a/src/proto_alpha/lib_client/operation_result.ml b/src/proto_alpha/lib_client/operation_result.ml index 3d6110b34..aa05ff627 100644 --- a/src/proto_alpha/lib_client/operation_result.ml +++ b/src/proto_alpha/lib_client/operation_result.ml @@ -229,7 +229,7 @@ let pp_operation_result ppf ({ contents ; _ }, operation_result) = "@[Dictator test protocol activation:@,\ Protocol: %a@]" Protocol_hash.pp protocol - | Sourced_operation (Manager_operations { source ; fee ; counter ; operations ; gas_limit }), + | Sourced_operation (Manager_operations { source ; fee ; counter ; operations ; gas_limit ; storage_limit }), Sourced_operation_result (Manager_operations_result { balance_updates ; operation_results }) -> let pp_result ppf result = Format.fprintf ppf "@," ; @@ -237,10 +237,9 @@ let pp_operation_result ppf ({ contents ; _ }, operation_result) = | Skipped -> Format.fprintf ppf "This operation was skipped" - | Failed errs -> + | Failed _errs -> Format.fprintf ppf - "@[This operation FAILED with the folllowing error:@,%a@]" - (Format.pp_print_list Alpha_environment.Error_monad.pp) errs + "This operation FAILED." | Applied Reveal_result -> Format.fprintf ppf "This revelation was successfully applied" @@ -325,12 +324,14 @@ let pp_operation_result ppf ({ contents ; _ }, operation_result) = From: %a@,\ Fee to the baker: %s%a@,\ Expected counter: %ld@,\ - Gas limit: %s" + Gas limit: %s@,\ + Storage limit: %Ld bytes" Contract.pp source Client_proto_args.tez_sym Tez.pp fee counter - (Z.to_string gas_limit) ; + (Z.to_string gas_limit) + storage_limit ; begin match balance_updates with | [] -> () | balance_updates -> diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml index e05901e72..27b1429e2 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml @@ -197,8 +197,8 @@ let commands () = end ; command ~group ~desc: "Launch a smart contract on the blockchain." - (args8 - fee_arg gas_limit_arg delegate_arg (Client_keys.force_switch ()) + (args9 + fee_arg gas_limit_arg storage_limit_arg delegate_arg (Client_keys.force_switch ()) delegatable_switch spendable_switch init_arg no_print_source_flag) (prefixes [ "originate" ; "contract" ] @@ RawContractAlias.fresh_alias_param @@ -217,13 +217,13 @@ let commands () = ~name:"prg" ~desc: "script of the account\n\ Combine with -init if the storage type is not unit." @@ stop) - begin fun (fee, gas_limit, delegate, force, delegatable, spendable, initial_storage, no_print_source) + begin fun (fee, gas_limit, storage_limit, delegate, force, delegatable, spendable, initial_storage, no_print_source) alias_name manager balance (_, source) program (cctxt : Proto_alpha.full) -> RawContractAlias.of_fresh cctxt force alias_name >>=? fun alias_name -> Lwt.return (Micheline_parser.no_parsing_error program) >>=? fun { expanded = code } -> source_to_keys cctxt cctxt#block source >>=? fun (src_pk, src_sk) -> originate_contract cctxt cctxt#block ?confirmations:cctxt#confirmations - ~fee ?gas_limit ~delegate ~delegatable ~spendable ~initial_storage + ~fee ?gas_limit ?storage_limit ~delegate ~delegatable ~spendable ~initial_storage ~manager ~balance ~source ~src_pk ~src_sk ~code () >>= fun errors -> report_michelson_errors ~no_print_source ~msg:"origination simulation failed" cctxt errors >>= function | None -> return () @@ -233,7 +233,7 @@ let commands () = end ; command ~group ~desc: "Transfer tokens / call a smart contract." - (args4 fee_arg gas_limit_arg arg_arg no_print_source_flag) + (args5 fee_arg gas_limit_arg storage_limit_arg arg_arg no_print_source_flag) (prefixes [ "transfer" ] @@ tez_param ~name: "qty" ~desc: "amount taken from source" @@ -244,10 +244,10 @@ let commands () = @@ ContractAlias.destination_param ~name: "dst" ~desc: "name/literal of the destination contract" @@ stop) - begin fun (fee, gas_limit, arg, no_print_source) amount (_, source) (_, destination) cctxt -> + begin fun (fee, gas_limit, storage_limit, arg, no_print_source) amount (_, source) (_, destination) cctxt -> source_to_keys cctxt cctxt#block source >>=? fun (src_pk, src_sk) -> transfer cctxt cctxt#block ?confirmations:cctxt#confirmations - ~source ~fee ~src_pk ~src_sk ~destination ~arg ~amount ?gas_limit () >>= + ~source ~fee ~src_pk ~src_sk ~destination ~arg ~amount ?gas_limit ?storage_limit () >>= report_michelson_errors ~no_print_source ~msg:"transfer simulation failed" cctxt >>= function | None -> return () | Some (_res, _contracts) -> diff --git a/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL index dd6fbba25..58533341c 100644 --- a/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL @@ -20,7 +20,8 @@ "Cycle_repr", "Level_repr", "Seed_repr", - "Gas_repr", + "Gas_limit_repr", + "Storage_limit_repr", "Script_int_repr", "Script_timestamp_repr", "Michelson_v1_primitives", diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.ml b/src/proto_alpha/lib_protocol/src/alpha_context.ml index 583506008..cb7a6ced6 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/src/alpha_context.ml @@ -62,7 +62,8 @@ end module Voting_period = Voting_period_repr module Gas = struct - include Gas_repr + include Gas_limit_repr + type error += Gas_limit_too_high = Raw_context.Gas_limit_too_high let set_limit = Raw_context.set_gas_limit let set_unlimited = Raw_context.set_gas_unlimited let consume = Raw_context.consume_gas @@ -78,6 +79,11 @@ module Contract = struct include Contract_storage let init_origination_nonce = Raw_context.init_origination_nonce let unset_origination_nonce = Raw_context.unset_origination_nonce + type error += Block_storage_quota_exceeded = Storage_limit_repr.Block_quota_exceeded + type error += Operation_storage_quota_exceeded = Storage_limit_repr.Operation_quota_exceeded + type error += Storage_limit_too_high = Raw_context.Storage_limit_too_high + let set_storage_limit = Raw_context.set_storage_limit + let set_storage_unlimited = Raw_context.set_storage_unlimited end module Delegate = Delegate_storage module Roll = struct diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index 33286a727..c6eaa13f3 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -121,6 +121,7 @@ module Gas : sig type error += Block_quota_exceeded (* `Temporary *) type error += Operation_quota_exceeded (* `Temporary *) + type error += Gas_limit_too_high (* `Permanent *) val free : cost val step_cost : int -> cost @@ -323,6 +324,8 @@ module Constants : sig block_reward: Tez.t ; endorsement_reward: Tez.t ; cost_per_byte: Tez.t ; + hard_storage_limit_per_operation: Int64.t ; + hard_storage_limit_per_block: Int64.t ; } val parametric_encoding: parametric Data_encoding.t val parametric: context -> parametric @@ -338,6 +341,8 @@ module Constants : sig val hard_gas_limit_per_operation: context -> Z.t val hard_gas_limit_per_block: context -> Z.t val cost_per_byte: context -> Tez.t + val hard_storage_limit_per_operation: context -> Int64.t + val hard_storage_limit_per_block: context -> Int64.t val proof_of_work_threshold: context -> int64 val dictator_pubkey: context -> Signature.Public_key.t val max_operation_data_length: context -> int @@ -542,6 +547,13 @@ module Contract : sig Script.expr -> big_map_diff option -> context tzresult Lwt.t + type error += Block_storage_quota_exceeded (* `Temporary *) + type error += Operation_storage_quota_exceeded (* `Temporary *) + type error += Storage_limit_too_high (* `Permanent *) + + val set_storage_limit: context -> Int64.t -> context tzresult + val set_storage_unlimited: context -> context + val used_storage_space: context -> t -> Int64.t tzresult Lwt.t val paid_storage_space_fees: context -> t -> Tez.t tzresult Lwt.t val pay_for_storage_space: context -> t -> Tez.t -> context tzresult Lwt.t @@ -750,6 +762,7 @@ and sourced_operation = counter: counter ; operations: manager_operation list ; gas_limit: Z.t ; + storage_limit: Int64.t; } | Dictator_operation of dictator_operation diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml index d6017eefa..b5abe5bfd 100644 --- a/src/proto_alpha/lib_protocol/src/apply.ml +++ b/src/proto_alpha/lib_protocol/src/apply.ml @@ -542,7 +542,7 @@ let apply_manager_operations ctxt source ops = let apply_sourced_operation ctxt pred_block operation ops = match ops with - | Manager_operations { source ; fee ; counter ; operations ; gas_limit } -> + | Manager_operations { source ; fee ; counter ; operations ; gas_limit ; storage_limit } -> let revealed_public_keys = List.fold_left (fun acc op -> match op with @@ -564,6 +564,7 @@ let apply_sourced_operation ctxt pred_block operation ops = Contract.spend ctxt source fee >>=? fun ctxt -> add_fees ctxt fee >>=? fun ctxt -> Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt -> + Lwt.return (Contract.set_storage_limit ctxt storage_limit) >>=? fun ctxt -> apply_manager_operations ctxt source operations >>= begin function | Ok (ctxt, operation_results) -> return (ctxt, operation_results) | Error operation_results -> return (ctxt (* backtracked *), operation_results) @@ -716,6 +717,7 @@ let apply_operation ctxt pred_block hash operation = return (ctxt, Sourced_operation_result result) end >>=? fun (ctxt, result) -> let ctxt = Gas.set_unlimited ctxt in + let ctxt = Contract.set_storage_unlimited ctxt in let ctxt = Contract.unset_origination_nonce ctxt in return (ctxt, result) diff --git a/src/proto_alpha/lib_protocol/src/constants_repr.ml b/src/proto_alpha/lib_protocol/src/constants_repr.ml index 65effb20a..8a94563e4 100644 --- a/src/proto_alpha/lib_protocol/src/constants_repr.ml +++ b/src/proto_alpha/lib_protocol/src/constants_repr.ml @@ -66,6 +66,8 @@ type parametric = { block_reward: Tez_repr.t ; endorsement_reward: Tez_repr.t ; cost_per_byte: Tez_repr.t ; + hard_storage_limit_per_operation: Int64.t ; + hard_storage_limit_per_block: Int64.t ; } let default = { @@ -100,6 +102,8 @@ let default = { endorsement_security_deposit = Tez_repr.(mul_exn one 64) ; block_reward = Tez_repr.(mul_exn one 16) ; endorsement_reward = Tez_repr.(mul_exn one 2) ; + hard_storage_limit_per_operation = 60_000L ; + hard_storage_limit_per_block = 1_000_000L ; cost_per_byte = Tez_repr.of_mutez_exn 1_000L ; } @@ -130,7 +134,9 @@ let parametric_encoding = c.endorsement_security_deposit, c.block_reward), (c.endorsement_reward, - c.cost_per_byte))) ) + c.cost_per_byte, + c.hard_storage_limit_per_operation, + c.hard_storage_limit_per_block))) ) (fun (( preserved_cycles, blocks_per_cycle, blocks_per_commitment, @@ -152,7 +158,9 @@ let parametric_encoding = endorsement_security_deposit, block_reward), (endorsement_reward, - cost_per_byte))) -> + cost_per_byte, + hard_storage_limit_per_operation, + hard_storage_limit_per_block))) -> { preserved_cycles ; blocks_per_cycle ; blocks_per_commitment ; @@ -175,6 +183,8 @@ let parametric_encoding = block_reward ; endorsement_reward ; cost_per_byte ; + hard_storage_limit_per_operation ; + hard_storage_limit_per_block ; } ) (merge_objs (obj10 @@ -200,9 +210,11 @@ let parametric_encoding = (req "block_security_deposit" Tez_repr.encoding) (req "endorsement_security_deposit" Tez_repr.encoding) (req "block_reward" Tez_repr.encoding)) - (obj2 + (obj4 (req "endorsement_reward" Tez_repr.encoding) - (req "cost_per_byte" Tez_repr.encoding)))) + (req "cost_per_byte" Tez_repr.encoding) + (req "hard_storage_limit_per_operation" int64) + (req "hard_storage_limit_per_block" int64)))) type t = { fixed : fixed ; diff --git a/src/proto_alpha/lib_protocol/src/constants_services.ml b/src/proto_alpha/lib_protocol/src/constants_services.ml index 65d019f0c..4eb1499ff 100644 --- a/src/proto_alpha/lib_protocol/src/constants_services.ml +++ b/src/proto_alpha/lib_protocol/src/constants_services.ml @@ -88,6 +88,14 @@ module S = struct ~output: (obj2 (req "per_block" z) (req "per_operation" z)) RPC_path.(custom_root / "hard_gas_limits") + let hard_storage_limits = + RPC_service.post_service + ~description: "Hard maximum amount of bytes stored per operation and per block" + ~query: RPC_query.empty + ~input: empty + ~output: (obj2 (req "per_block" int64) (req "per_operation" int64)) + RPC_path.(custom_root / "hard_storage_limits") + let cost_per_byte = RPC_service.post_service ~description: "The cost per bytes added to the storage" @@ -201,6 +209,10 @@ let () = return (Constants.hard_gas_limit_per_block ctxt, Constants.hard_gas_limit_per_operation ctxt) end ; + register0 S.hard_storage_limits begin fun ctxt () () -> + return (Constants.hard_storage_limit_per_block ctxt, + Constants.hard_storage_limit_per_operation ctxt) + end ; register0 S.cost_per_byte begin fun ctxt () () -> return (Constants.cost_per_byte ctxt) end ; @@ -254,6 +266,8 @@ let hard_gas_limits ctxt block = RPC_context.make_call0 S.hard_gas_limits ctxt block () () let cost_per_byte ctxt block = RPC_context.make_call0 S.cost_per_byte ctxt block () () +let hard_storage_limits ctxt block = + RPC_context.make_call0 S.hard_storage_limits ctxt block () () let proof_of_work_threshold ctxt block = RPC_context.make_call0 S.proof_of_work_threshold ctxt block () () let seed_nonce_revelation_tip ctxt block = diff --git a/src/proto_alpha/lib_protocol/src/constants_services.mli b/src/proto_alpha/lib_protocol/src/constants_services.mli index 0e5cfd628..b48636704 100644 --- a/src/proto_alpha/lib_protocol/src/constants_services.mli +++ b/src/proto_alpha/lib_protocol/src/constants_services.mli @@ -36,6 +36,8 @@ val endorsers_per_block: val hard_gas_limits: 'a #RPC_context.simple -> 'a -> (Z.t * Z.t) shell_tzresult Lwt.t +val hard_storage_limits: + 'a #RPC_context.simple -> 'a -> (Int64.t * Int64.t) shell_tzresult Lwt.t val cost_per_byte: 'a #RPC_context.simple -> 'a -> Tez.t shell_tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/src/constants_storage.ml b/src/proto_alpha/lib_protocol/src/constants_storage.ml index 945a9515b..f6bdb7004 100644 --- a/src/proto_alpha/lib_protocol/src/constants_storage.ml +++ b/src/proto_alpha/lib_protocol/src/constants_storage.ml @@ -40,6 +40,12 @@ let hard_gas_limit_per_block c = let cost_per_byte c = let constants = Raw_context.constants c in constants.cost_per_byte +let hard_storage_limit_per_operation c = + let constants = Raw_context.constants c in + constants.hard_storage_limit_per_operation +let hard_storage_limit_per_block c = + let constants = Raw_context.constants c in + constants.hard_storage_limit_per_block let proof_of_work_threshold c = let constants = Raw_context.constants c in constants.proof_of_work_threshold diff --git a/src/proto_alpha/lib_protocol/src/gas_repr.ml b/src/proto_alpha/lib_protocol/src/gas_limit_repr.ml similarity index 98% rename from src/proto_alpha/lib_protocol/src/gas_repr.ml rename to src/proto_alpha/lib_protocol/src/gas_limit_repr.ml index 8646d2048..7f3149527 100644 --- a/src/proto_alpha/lib_protocol/src/gas_repr.ml +++ b/src/proto_alpha/lib_protocol/src/gas_limit_repr.ml @@ -89,9 +89,9 @@ let consume block_gas operation_gas cost = match operation_gas with Z.sub remaining weighted_cost in let block_remaining = Z.sub block_gas weighted_cost in - if Compare.Z.(remaining <= Z.zero) + if Compare.Z.(remaining < Z.zero) then error Operation_quota_exceeded - else if Compare.Z.(block_remaining <= Z.zero) + else if Compare.Z.(block_remaining < Z.zero) then error Block_quota_exceeded else ok (block_remaining, Limited { remaining }) diff --git a/src/proto_alpha/lib_protocol/src/gas_repr.mli b/src/proto_alpha/lib_protocol/src/gas_limit_repr.mli similarity index 100% rename from src/proto_alpha/lib_protocol/src/gas_repr.mli rename to src/proto_alpha/lib_protocol/src/gas_limit_repr.mli diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.ml b/src/proto_alpha/lib_protocol/src/helpers_services.ml index f4091e996..d2a10120e 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.ml +++ b/src/proto_alpha/lib_protocol/src/helpers_services.ml @@ -300,7 +300,8 @@ module Forge = struct module Manager = struct let operations ctxt - block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit operations = + block ~branch ~source ?sourcePubKey ~counter ~fee + ~gas_limit ~storage_limit operations = Contract_services.manager_key ctxt block source >>= function | Error _ as e -> Lwt.return e | Ok (_, revealed) -> @@ -313,18 +314,22 @@ module Forge = struct | Some pk -> Reveal pk :: operations in let ops = Manager_operations { source ; - counter ; operations ; fee ; gas_limit } in + counter ; operations ; fee ; + gas_limit ; storage_limit } in (RPC_context.make_call0 S.operations ctxt block () ({ branch }, Sourced_operation ops)) let reveal ctxt block ~branch ~source ~sourcePubKey ~counter ~fee ()= - operations ctxt block ~branch ~source ~sourcePubKey ~counter ~fee ~gas_limit:Z.zero [] + operations ctxt block ~branch ~source ~sourcePubKey ~counter ~fee + ~gas_limit:Z.zero ~storage_limit:0L [] let transaction ctxt block ~branch ~source ?sourcePubKey ~counter - ~amount ~destination ?parameters ~gas_limit ~fee ()= - operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit + ~amount ~destination ?parameters + ~gas_limit ~storage_limit ~fee ()= + operations ctxt block ~branch ~source ?sourcePubKey ~counter + ~fee ~gas_limit ~storage_limit Alpha_context.[Transaction { amount ; parameters ; destination }] let origination ctxt @@ -334,8 +339,9 @@ module Forge = struct ?(spendable = true) ?(delegatable = true) ?delegatePubKey ?script - ~gas_limit ~fee () = - operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit + ~gas_limit ~storage_limit ~fee () = + operations ctxt block ~branch ~source ?sourcePubKey ~counter + ~fee ~gas_limit ~storage_limit Alpha_context.[ Origination { manager = managerPubKey ; delegate = delegatePubKey ; @@ -348,7 +354,8 @@ module Forge = struct let delegation ctxt block ~branch ~source ?sourcePubKey ~counter ~fee delegate = - operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit:Z.zero + operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee + ~gas_limit:Z.zero ~storage_limit:0L Alpha_context.[Delegation delegate] end diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.mli b/src/proto_alpha/lib_protocol/src/helpers_services.mli index d38ec5473..afebbfa55 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.mli +++ b/src/proto_alpha/lib_protocol/src/helpers_services.mli @@ -72,6 +72,7 @@ module Forge : sig counter:int32 -> fee:Tez.t -> gas_limit:Z.t -> + storage_limit:Int64.t -> manager_operation list -> MBytes.t shell_tzresult Lwt.t val reveal: @@ -93,6 +94,7 @@ module Forge : sig destination:Contract.t -> ?parameters:Script.expr -> gas_limit:Z.t -> + storage_limit:Int64.t -> fee:Tez.t -> unit -> MBytes.t shell_tzresult Lwt.t @@ -109,6 +111,7 @@ module Forge : sig ?delegatePubKey: public_key_hash -> ?script:Script.t -> gas_limit:Z.t -> + storage_limit:Int64.t -> fee:Tez.t-> unit -> MBytes.t shell_tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/src/operation_repr.ml b/src/proto_alpha/lib_protocol/src/operation_repr.ml index 6aed575cf..85abd36b7 100644 --- a/src/proto_alpha/lib_protocol/src/operation_repr.ml +++ b/src/proto_alpha/lib_protocol/src/operation_repr.ml @@ -56,6 +56,7 @@ and sourced_operation = counter: counter ; operations: manager_operation list ; gas_limit: Z.t; + storage_limit: Int64.t; } | Dictator_operation of dictator_operation @@ -186,7 +187,7 @@ module Encoding = struct (fun ((), key) -> Delegation key) let manager_kind_encoding = - obj6 + obj7 (req "kind" (constant "manager")) (req "source" Contract_repr.encoding) (req "fee" Tez_repr.encoding) @@ -199,15 +200,16 @@ module Encoding = struct delegation_case (Tag 3) ; ]))) (req "gas_limit" z) + (req "storage_limit" int64) let manager_kind_case tag = case tag ~name:"Manager operations" manager_kind_encoding (function - | Manager_operations { source; fee ; counter ; operations ; gas_limit } -> - Some ((), source, fee, counter, operations, gas_limit) + | Manager_operations { source; fee ; counter ; operations ; gas_limit ; storage_limit } -> + Some ((), source, fee, counter, operations, gas_limit, storage_limit) | _ -> None) - (fun ((), source, fee, counter, operations, gas_limit) -> - Manager_operations { source; fee ; counter ; operations ; gas_limit }) + (fun ((), source, fee, counter, operations, gas_limit, storage_limit) -> + Manager_operations { source; fee ; counter ; operations ; gas_limit ; storage_limit }) let endorsement_encoding = (* describe ~title:"Endorsement operation" @@ *) diff --git a/src/proto_alpha/lib_protocol/src/operation_repr.mli b/src/proto_alpha/lib_protocol/src/operation_repr.mli index fac1715cb..fc43f5465 100644 --- a/src/proto_alpha/lib_protocol/src/operation_repr.mli +++ b/src/proto_alpha/lib_protocol/src/operation_repr.mli @@ -56,6 +56,7 @@ and sourced_operation = counter: counter ; operations: manager_operation list ; gas_limit: Z.t ; + storage_limit: Int64.t; } | Dictator_operation of dictator_operation diff --git a/src/proto_alpha/lib_protocol/src/parameters_repr.ml b/src/proto_alpha/lib_protocol/src/parameters_repr.ml index dcae8b6c7..e43c591ba 100644 --- a/src/proto_alpha/lib_protocol/src/parameters_repr.ml +++ b/src/proto_alpha/lib_protocol/src/parameters_repr.ml @@ -105,6 +105,12 @@ let constants_encoding = and cost_per_byte = opt Tez_repr.(=) default.cost_per_byte c.cost_per_byte + and hard_storage_limit_per_operation = + opt Compare.Int64.(=) + default.hard_storage_limit_per_operation c.hard_storage_limit_per_operation + and hard_storage_limit_per_block = + opt Compare.Int64.(=) + default.hard_storage_limit_per_block c.hard_storage_limit_per_block in (( preserved_cycles, blocks_per_cycle, @@ -127,7 +133,9 @@ let constants_encoding = endorsement_security_deposit, block_reward), (endorsement_reward, - cost_per_byte)))) + cost_per_byte, + hard_storage_limit_per_operation, + hard_storage_limit_per_block)))) (fun (( preserved_cycles, blocks_per_cycle, blocks_per_commitment, @@ -149,7 +157,9 @@ let constants_encoding = endorsement_security_deposit, block_reward), (endorsement_reward, - cost_per_byte))) -> + cost_per_byte, + hard_storage_limit_per_operation, + hard_storage_limit_per_block))) -> let unopt def = function None -> def | Some v -> v in let default = Constants_repr.default in { Constants_repr.preserved_cycles = @@ -197,6 +207,10 @@ let constants_encoding = unopt default.endorsement_reward endorsement_reward ; cost_per_byte = unopt default.cost_per_byte cost_per_byte ; + hard_storage_limit_per_operation = + unopt default.hard_storage_limit_per_operation hard_storage_limit_per_operation ; + hard_storage_limit_per_block = + unopt default.hard_storage_limit_per_block hard_storage_limit_per_block ; } ) (merge_objs (obj10 @@ -222,9 +236,11 @@ let constants_encoding = (opt "block_security_deposit" Tez_repr.encoding) (opt "endorsement_security_deposit" Tez_repr.encoding) (opt "block_reward" Tez_repr.encoding)) - (obj2 + (obj4 (opt "endorsement_reward" Tez_repr.encoding) - (opt "cost_per_byte" Tez_repr.encoding)))) + (opt "cost_per_byte" Tez_repr.encoding) + (opt "hard_storage_limit_per_operation" int64) + (opt "hard_storage_limit_per_block" int64)))) let encoding = let open Data_encoding in diff --git a/src/proto_alpha/lib_protocol/src/raw_context.ml b/src/proto_alpha/lib_protocol/src/raw_context.ml index 8a50d5c96..25cc506ca 100644 --- a/src/proto_alpha/lib_protocol/src/raw_context.ml +++ b/src/proto_alpha/lib_protocol/src/raw_context.ml @@ -20,7 +20,9 @@ type t = { fees: Tez_repr.t ; rewards: Tez_repr.t ; block_gas: Z.t ; - operation_gas: Gas_repr.t ; + operation_gas: Gas_limit_repr.t ; + block_storage: Int64.t ; + operation_storage: Storage_limit_repr.t ; origination_nonce: Contract_repr.origination_nonce option ; } @@ -92,7 +94,7 @@ let () = register_error_kind `Permanent ~id:"gas_limit_too_high" - ~title: "Gas limit higher than the hard limit" + ~title: "Gas limit out of protocol hard bounds" ~description: "A transaction tried to exceed the hard limit on gas" empty @@ -100,18 +102,44 @@ let () = (fun () -> Gas_limit_too_high) let set_gas_limit ctxt remaining = - if Compare.Z.(remaining > ctxt.constants.hard_gas_limit_per_operation) then + 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 } } let set_gas_unlimited ctxt = { ctxt with operation_gas = Unaccounted } let consume_gas ctxt cost = - Gas_repr.consume ctxt.block_gas ctxt.operation_gas cost >>? fun (block_gas, operation_gas) -> + Gas_limit_repr.consume ctxt.block_gas ctxt.operation_gas cost >>? fun (block_gas, operation_gas) -> ok { ctxt with block_gas ; operation_gas } let gas_level ctxt = ctxt.operation_gas let block_gas_level ctxt = ctxt.block_gas +type error += Storage_limit_too_high (* `Permanent *) + +let () = + let open Data_encoding in + register_error_kind + `Permanent + ~id:"storage_limit_too_high" + ~title: "Storage limit out of protocol hard bounds" + ~description: + "A transaction tried to exceed the hard limit on storage" + empty + (function Storage_limit_too_high -> Some () | _ -> None) + (fun () -> Storage_limit_too_high) + +let set_storage_limit ctxt remaining = + if Compare.Int64.(remaining > ctxt.constants.hard_storage_limit_per_operation) + || Compare.Int64.(remaining < 0L)then + error Storage_limit_too_high + else + ok { ctxt with operation_storage = Limited { remaining } } +let set_storage_unlimited ctxt = + { ctxt with operation_storage = Unaccounted } +let record_bytes_stored ctxt bytes = + Storage_limit_repr.consume ctxt.block_storage ctxt.operation_storage ~bytes >>? fun (block_storage, operation_storage) -> + ok { ctxt with block_storage ; operation_storage } type storage_error = | Incompatible_protocol_version of string @@ -331,6 +359,8 @@ let prepare ~level ~timestamp ~fitness ctxt = rewards = Tez_repr.zero ; operation_gas = Unaccounted ; block_gas = constants.Constants_repr.hard_gas_limit_per_block ; + operation_storage = Unaccounted ; + block_storage = constants.Constants_repr.hard_storage_limit_per_block ; origination_nonce = None ; } @@ -378,6 +408,8 @@ let register_resolvers enc resolve = rewards = Tez_repr.zero ; block_gas = Constants_repr.default.hard_gas_limit_per_block ; operation_gas = Unaccounted ; + block_storage = Constants_repr.default.hard_storage_limit_per_block ; + operation_storage = Unaccounted ; origination_nonce = None ; } in resolve faked_context str in @@ -421,7 +453,9 @@ module type T = sig val absolute_key: context -> key -> key - val consume_gas: context -> Gas_repr.cost -> context tzresult + val consume_gas: context -> Gas_limit_repr.cost -> context tzresult + + val record_bytes_stored: context -> Int64.t -> context tzresult end diff --git a/src/proto_alpha/lib_protocol/src/raw_context.mli b/src/proto_alpha/lib_protocol/src/raw_context.mli index fa8b62dbe..2ddd40861 100644 --- a/src/proto_alpha/lib_protocol/src/raw_context.mli +++ b/src/proto_alpha/lib_protocol/src/raw_context.mli @@ -79,9 +79,14 @@ type error += Gas_limit_too_high (* `Permanent *) val set_gas_limit: t -> Z.t -> t tzresult val set_gas_unlimited: t -> t -val gas_level: t -> Gas_repr.t +val gas_level: t -> Gas_limit_repr.t val block_gas_level: t -> Z.t +type error += Storage_limit_too_high (* `Permanent *) + +val set_storage_limit: t -> Int64.t -> t tzresult +val set_storage_unlimited: t -> t + type error += Undefined_operation_nonce (* `Permanent *) val init_origination_nonce: t -> Operation_hash.t -> t @@ -171,7 +176,11 @@ module type T = sig (** Internally used in {!Storage_functors} to consume gas from within a view. *) - val consume_gas: context -> Gas_repr.cost -> context tzresult + val consume_gas: context -> Gas_limit_repr.cost -> context tzresult + + (** Internally used in {!Storage_functors} to consume storage from + within a view. *) + val record_bytes_stored: context -> Int64.t -> context tzresult end diff --git a/src/proto_alpha/lib_protocol/src/storage_functors.ml b/src/proto_alpha/lib_protocol/src/storage_functors.ml index 23d8fdc5e..2c2d76641 100644 --- a/src/proto_alpha/lib_protocol/src/storage_functors.ml +++ b/src/proto_alpha/lib_protocol/src/storage_functors.ml @@ -89,6 +89,7 @@ module Make_subcontext (C : Raw_context.T) (N : NAME) let project = C.project let absolute_key c k = C.absolute_key c (to_key k) let consume_gas = C.consume_gas + let record_bytes_stored = C.record_bytes_stored end module Make_single_data_storage (C : Raw_context.T) (N : NAME) (V : VALUE) @@ -139,7 +140,7 @@ module Make_single_carbonated_data_storage type context = t type value = V.t let consume_mem_gas c = - Lwt.return (C.consume_gas c (Gas_repr.read_bytes_cost Z.zero)) + Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero)) let existing_size c = match V.size with | Fixed len -> @@ -152,26 +153,26 @@ module Make_single_carbonated_data_storage let consume_read_gas get c = match V.size with | Fixed len -> - Lwt.return (C.consume_gas c (Gas_repr.read_bytes_cost (Z.of_int len))) + Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost (Z.of_int len))) | Variable -> get c (len_name N.name) >>=? fun len -> decode_len_value N.name len >>=? fun len -> - Lwt.return (C.consume_gas c (Gas_repr.read_bytes_cost (Z.of_int len))) + Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost (Z.of_int len))) let consume_write_gas set c v = match V.size with | Fixed s -> - Lwt.return (C.consume_gas c (Gas_repr.write_bytes_cost (Z.of_int s))) >>=? fun c -> + Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int s))) >>=? fun c -> return (c, V.to_bytes v) | Variable -> let bytes = V.to_bytes v in let len = MBytes.length bytes in - Lwt.return (C.consume_gas c (Gas_repr.write_bytes_cost (Z.of_int len))) >>=? fun c -> + Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int len))) >>=? fun c -> set c (len_name N.name) (encode_len_value bytes) >>=? fun c -> return (c, bytes) let consume_remove_gas del c = match V.size with | Fixed _ | Variable -> - Lwt.return (C.consume_gas c (Gas_repr.write_bytes_cost Z.zero)) >>=? fun c -> + Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost Z.zero)) >>=? fun c -> del c (len_name N.name) let mem c = consume_mem_gas c >>=? fun c -> @@ -192,30 +193,38 @@ module Make_single_carbonated_data_storage else return (C.project c, None) let init c v = + consume_write_gas C.set c v >>=? fun (c, bytes) -> + C.init c N.name bytes >>=? fun c -> + let size = MBytes.length bytes in + Lwt.return (C.record_bytes_stored c (Int64.of_int size)) >>=? fun c -> + return (C.project c, size) + let set c v = consume_write_gas C.init c v >>=? fun (c, bytes) -> existing_size c >>=? fun prev_size -> - C.init c N.name bytes >>=? fun c -> - return (C.project c, MBytes.length bytes - prev_size) - let set c v = - consume_write_gas C.set c v >>=? fun (c, bytes) -> C.set c N.name bytes >>=? fun c -> - return (C.project c, MBytes.length bytes) + let size_diff = MBytes.length bytes - prev_size in + Lwt.return (C.record_bytes_stored c (Int64.of_int size_diff)) >>=? fun c -> + return (C.project c, size_diff) let init_set c v = let init_set c k v = C.init_set c k v >>= return in consume_write_gas init_set c v >>=? fun (c, bytes) -> existing_size c >>=? fun prev_size -> init_set c N.name bytes >>=? fun c -> - return (C.project c, MBytes.length bytes - prev_size) + let size_diff = MBytes.length bytes - prev_size in + Lwt.return (C.record_bytes_stored c (Int64.of_int size_diff)) >>=? fun c -> + return (C.project c, size_diff) let remove c = let remove c k = C.remove c k >>= return in consume_remove_gas remove c >>=? fun c -> existing_size c >>=? fun prev_size -> remove c N.name >>=? fun c -> + Lwt.return (C.record_bytes_stored c (Int64.of_int ~-prev_size)) >>=? fun c -> return (C.project c, prev_size) let delete c = consume_remove_gas C.delete c >>=? fun c -> existing_size c >>=? fun prev_size -> C.delete c N.name >>=? fun c -> + Lwt.return (C.record_bytes_stored c (Int64.of_int ~-prev_size)) >>=? fun c -> return (C.project c, prev_size) let set_option c v = match v with @@ -392,7 +401,7 @@ module Make_indexed_carbonated_data_storage | [ last ] -> Compare.Char.(=) (String.get last (String.length last - 1)) '$' | _ :: rest -> is_len_name rest let consume_mem_gas c = - Lwt.return (C.consume_gas c (Gas_repr.read_bytes_cost Z.zero)) + Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero)) let existing_size c i = match V.size with | Fixed len -> @@ -405,26 +414,26 @@ module Make_indexed_carbonated_data_storage let consume_read_gas get c i = match V.size with | Fixed len -> - Lwt.return (C.consume_gas c (Gas_repr.read_bytes_cost (Z.of_int len))) + Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost (Z.of_int len))) | Variable -> get c (len_name i) >>=? fun len -> decode_len_value (name i) len >>=? fun len -> - Lwt.return (C.consume_gas c (Gas_repr.read_bytes_cost (Z.of_int len))) + Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost (Z.of_int len))) let consume_write_gas set c i v = match V.size with | Fixed s -> - Lwt.return (C.consume_gas c (Gas_repr.write_bytes_cost (Z.of_int s))) >>=? fun c -> + Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int s))) >>=? fun c -> return (c, V.to_bytes v) | Variable -> let bytes = V.to_bytes v in let len = MBytes.length bytes in - Lwt.return (C.consume_gas c (Gas_repr.write_bytes_cost (Z.of_int len))) >>=? fun c -> + Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int len))) >>=? fun c -> set c (len_name i) (encode_len_value bytes) >>=? fun c -> return (c, bytes) let consume_remove_gas del c i = match V.size with | Fixed _ | Variable -> - Lwt.return (C.consume_gas c (Gas_repr.write_bytes_cost Z.zero)) >>=? fun c -> + Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost Z.zero)) >>=? fun c -> del c (len_name i) let mem s i = consume_mem_gas s >>=? fun s -> @@ -448,27 +457,35 @@ module Make_indexed_carbonated_data_storage consume_write_gas C.set s i v >>=? fun (s, bytes) -> existing_size s i >>=? fun prev_size -> C.set s (name i) bytes >>=? fun t -> - return (C.project t, MBytes.length bytes - prev_size) + let size_diff = MBytes.length bytes - prev_size in + Lwt.return (C.record_bytes_stored t (Int64.of_int size_diff)) >>=? fun t -> + return (C.project t, size_diff) let init s i v = consume_write_gas C.init s i v >>=? fun (s, bytes) -> C.init s (name i) bytes >>=? fun t -> - return (C.project t, MBytes.length bytes) + let size = MBytes.length bytes in + Lwt.return (C.record_bytes_stored t (Int64.of_int size)) >>=? fun t -> + return (C.project t, size) let init_set s i v = let init_set s i v = C.init_set s i v >>= return in consume_write_gas init_set s i v >>=? fun (s, bytes) -> existing_size s i >>=? fun prev_size -> init_set s (name i) bytes >>=? fun t -> - return (C.project t, MBytes.length bytes - prev_size) + let size_diff = MBytes.length bytes - prev_size in + Lwt.return (C.record_bytes_stored t (Int64.of_int size_diff)) >>=? fun t -> + return (C.project t, size_diff) let remove s i = let remove s i = C.remove s i >>= return in consume_remove_gas remove s i >>=? fun s -> existing_size s i >>=? fun prev_size -> remove s (name i) >>=? fun t -> + Lwt.return (C.record_bytes_stored t (Int64.of_int ~-prev_size)) >>=? fun t -> return (C.project t, prev_size) let delete s i = consume_remove_gas C.delete s i >>=? fun s -> existing_size s i >>=? fun prev_size -> C.delete s (name i) >>=? fun t -> + Lwt.return (C.record_bytes_stored t (Int64.of_int ~-prev_size)) >>=? fun t -> return (C.project t, prev_size) let set_option s i v = match v with @@ -512,6 +529,7 @@ module Make_indexed_carbonated_data_storage consume_remove_gas C.delete s path >>=? fun s -> existing_size s path >>=? fun prev_size -> C.delete s (name path) >>=? fun s -> + Lwt.return (C.record_bytes_stored s (Int64.of_int ~-prev_size)) >>=? fun s -> return (s, Z.add (Z.of_int prev_size) total) in fold_keys_unaccounted s ~init:Z.zero ~f let fold s ~init ~f = @@ -610,6 +628,7 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) let project (t, _) = C.project t let absolute_key (t, i) k = C.absolute_key t (to_key i k) let consume_gas (t, k) c = C.consume_gas t c >>? fun t -> ok (t, k) + let record_bytes_stored (t, k) c = C.record_bytes_stored t c >>? fun t -> ok (t, k) end let fold_keys t ~init ~f = @@ -766,7 +785,7 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) type key = I.t type value = V.t let consume_mem_gas c = - Lwt.return (Raw_context.consume_gas c (Gas_repr.read_bytes_cost Z.zero)) + Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero)) let existing_size c = match V.size with | Fixed len -> @@ -779,26 +798,26 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) let consume_read_gas get c = match V.size with | Fixed len -> - Lwt.return (Raw_context.consume_gas c (Gas_repr.read_bytes_cost (Z.of_int len))) + Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost (Z.of_int len))) | Variable -> get c (len_name N.name) >>=? fun len -> decode_len_value N.name len >>=? fun len -> - Lwt.return (Raw_context.consume_gas c (Gas_repr.read_bytes_cost (Z.of_int len))) + Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost (Z.of_int len))) let consume_write_gas set c v = match V.size with | Fixed s -> - Lwt.return (Raw_context.consume_gas c (Gas_repr.write_bytes_cost (Z.of_int s))) >>=? fun c -> + Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int s))) >>=? fun c -> return (c, V.to_bytes v) | Variable -> let bytes = V.to_bytes v in let len = MBytes.length bytes in - Lwt.return (Raw_context.consume_gas c (Gas_repr.write_bytes_cost (Z.of_int len))) >>=? fun c -> + Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int len))) >>=? fun c -> set c (len_name N.name) (encode_len_value bytes) >>=? fun c -> return (c, bytes) let consume_remove_gas del c = match V.size with | Fixed _ | Variable -> - Lwt.return (Raw_context.consume_gas c (Gas_repr.write_bytes_cost Z.zero)) >>=? fun c -> + Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.write_bytes_cost Z.zero)) >>=? fun c -> del c (len_name N.name) let mem s i = consume_mem_gas (s, i) >>=? fun c -> @@ -822,27 +841,35 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) consume_write_gas Raw_context.set (s, i) v >>=? fun (c, bytes) -> existing_size (s, i) >>=? fun prev_size -> Raw_context.set c N.name bytes >>=? fun c -> - return (Raw_context.project c, MBytes.length bytes - prev_size) + let size_diff = MBytes.length bytes - prev_size in + Lwt.return (Raw_context.record_bytes_stored c (Int64.of_int size_diff)) >>=? fun c -> + return (Raw_context.project c, size_diff) let init s i v = consume_write_gas Raw_context.init (s, i) v >>=? fun (c, bytes) -> Raw_context.init c N.name bytes >>=? fun c -> - return (Raw_context.project c, MBytes.length bytes) + let size = MBytes.length bytes in + Lwt.return (Raw_context.record_bytes_stored c (Int64.of_int size)) >>=? fun c -> + return (Raw_context.project c, size) let init_set s i v = let init_set c k v = Raw_context.init_set c k v >>= return in consume_write_gas init_set (s, i) v >>=? fun (c, bytes) -> existing_size c >>=? fun prev_size -> init_set c N.name bytes >>=? fun c -> - return (Raw_context.project c, MBytes.length bytes - prev_size) + let size_diff = MBytes.length bytes - prev_size in + Lwt.return (Raw_context.record_bytes_stored c (Int64.of_int size_diff)) >>=? fun c -> + return (Raw_context.project c, size_diff) let remove s i = let remove c k = Raw_context.remove c k >>= return in consume_remove_gas remove (s, i) >>=? fun c -> existing_size (s, i) >>=? fun prev_size -> remove c N.name >>=? fun c -> + Lwt.return (Raw_context.record_bytes_stored c (Int64.of_int ~-prev_size)) >>=? fun c -> return (Raw_context.project c, prev_size) let delete s i = consume_remove_gas Raw_context.delete (s, i) >>=? fun c -> existing_size (s, i) >>=? fun prev_size -> Raw_context.delete c N.name >>=? fun c -> + Lwt.return (Raw_context.record_bytes_stored c (Int64.of_int ~-prev_size)) >>=? fun c -> return (Raw_context.project c, prev_size) let set_option s i v = match v with @@ -856,6 +883,7 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) consume_remove_gas remove (s, i) >>=? fun (s, _) -> existing_size (s, i) >>=? fun prev_size -> remove (s,i) N.name >>=? fun (s, _) -> + Lwt.return (Raw_context.record_bytes_stored (s, i) (Int64.of_int ~-prev_size)) >>=? fun (s, _) -> return (s, Z.add total (Z.of_int prev_size)) end >>=? fun (s, total) -> return (C.project s, total) diff --git a/src/proto_alpha/lib_protocol/src/storage_limit_repr.ml b/src/proto_alpha/lib_protocol/src/storage_limit_repr.ml new file mode 100644 index 000000000..8584cdf1b --- /dev/null +++ b/src/proto_alpha/lib_protocol/src/storage_limit_repr.ml @@ -0,0 +1,51 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +type t = + | Unaccounted + | Limited of { remaining : Int64.t } + +type error += Block_quota_exceeded (* `Temporary *) +type error += Operation_quota_exceeded (* `Temporary *) + +let () = + let open Data_encoding in + register_error_kind + `Temporary + ~id:"storage_exhausted.operation" + ~title: "Storage quota exceeded for the operation" + ~description: + "A script or one of its callee wrote more \ + bytes than the operation said it would" + empty + (function Operation_quota_exceeded -> Some () | _ -> None) + (fun () -> Operation_quota_exceeded) ; + register_error_kind + `Temporary + ~id:"storage_exhausted.block" + ~title: "Storage quota exceeded for the block" + ~description: + "The sum of storage consumed by all the operations in the block \ + exceeds the hard storage limit per block" + empty + (function Block_quota_exceeded -> Some () | _ -> None) + (fun () -> Block_quota_exceeded) + +let consume block_storage operation_storage ~bytes = match operation_storage with + | Unaccounted -> ok (block_storage, Unaccounted) + | Limited { remaining } -> + let remaining = + Int64.sub remaining bytes in + let block_remaining = + Int64.sub block_storage bytes in + if Compare.Int64.(remaining < 0L) + then error Operation_quota_exceeded + else if Compare.Int64.(block_remaining < 0L) + then error Block_quota_exceeded + else ok (block_remaining, Limited { remaining }) diff --git a/src/proto_alpha/lib_protocol/src/storage_limit_repr.mli b/src/proto_alpha/lib_protocol/src/storage_limit_repr.mli new file mode 100644 index 000000000..11dc00af2 --- /dev/null +++ b/src/proto_alpha/lib_protocol/src/storage_limit_repr.mli @@ -0,0 +1,17 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +type t = + | Unaccounted + | Limited of { remaining : Int64.t } + +type error += Block_quota_exceeded (* `Temporary *) +type error += Operation_quota_exceeded (* `Temporary *) + +val consume : Int64.t -> t -> bytes:Int64.t -> (Int64.t * t) tzresult diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml index 657139900..9d25dd753 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml @@ -26,6 +26,7 @@ let manager (src : Helpers_account.t) ?(fee = Tez.zero) operations context gas_l counter ; operations = (if revealed then operations else Reveal src.pub :: operations) ; gas_limit ; + storage_limit = 30_000L ; }