balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Alpha: add storage limits

Browse Source
This commit is contained in:
Benjamin Canou 2018-04-22 19:57:49 +02:00 committed by Grégoire Henry
parent dd9cd8a1c3
commit 23f9949e70
29 changed files with 401 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/proto_alpha/lib_client/client_proto_args.ml
View File

@ -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"

1
src/proto_alpha/lib_client/client_proto_args.mli
View File

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

19
src/proto_alpha/lib_client/client_proto_context.ml
View File

@ -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 ;

2
src/proto_alpha/lib_client/client_proto_context.mli
View File

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

45
src/proto_alpha/lib_client/injection.ml
View File

@ -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,16 +103,19 @@ 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) ->
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
@ -107,14 +126,30 @@ let may_patch_gas_limit
"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) ->

22
src/proto_alpha/lib_client/michelson_v1_error_reporter.ml
View File

@ -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
"@[<v 0>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 =
"@[<v 0>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
"@[<v 0>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, _) ->

13
src/proto_alpha/lib_client/operation_result.ml
View File

@ -229,7 +229,7 @@ let pp_operation_result ppf ({ contents ; _ }, operation_result) =
"@[<v 2>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
"@[<v 2>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 ->

14
src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
View File

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

3
src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL
View File

@ -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",

8
src/proto_alpha/lib_protocol/src/alpha_context.ml
View File

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

13
src/proto_alpha/lib_protocol/src/alpha_context.mli
View File

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

4
src/proto_alpha/lib_protocol/src/apply.ml
View File

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

20
src/proto_alpha/lib_protocol/src/constants_repr.ml
View File

@ -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 ;

14
src/proto_alpha/lib_protocol/src/constants_services.ml
View File

@ -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 =

2
src/proto_alpha/lib_protocol/src/constants_services.mli
View File

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

6
src/proto_alpha/lib_protocol/src/constants_storage.ml
View File

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

4
src/proto_alpha/lib_protocol/src/gas_repr.ml → src/proto_alpha/lib_protocol/src/gas_limit_repr.ml
View File

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

0
src/proto_alpha/lib_protocol/src/gas_repr.mli → src/proto_alpha/lib_protocol/src/gas_limit_repr.mli
View File

23
src/proto_alpha/lib_protocol/src/helpers_services.ml
View File

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

3
src/proto_alpha/lib_protocol/src/helpers_services.mli
View File

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

12
src/proto_alpha/lib_protocol/src/operation_repr.ml
View File

@ -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" @@ *)

1
src/proto_alpha/lib_protocol/src/operation_repr.mli
View File

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

24
src/proto_alpha/lib_protocol/src/parameters_repr.ml
View File

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

44
src/proto_alpha/lib_protocol/src/raw_context.ml
View File

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

13
src/proto_alpha/lib_protocol/src/raw_context.mli
View File

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

88
src/proto_alpha/lib_protocol/src/storage_functors.ml
View File

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

51
src/proto_alpha/lib_protocol/src/storage_limit_repr.ml Normal file
View File

@ -0,0 +1,51 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 })

17
src/proto_alpha/lib_protocol/src/storage_limit_repr.mli Normal file
View File

@ -0,0 +1,17 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

1
src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml
View File

@ -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 ;
}