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

Alpha, Michelson: add gas limits for block and operations

Browse Source
This commit is contained in:
Benjamin Canou 2018-03-24 16:39:48 +01:00 committed by Grégoire Henry
parent eef5885265
commit c3cf4dfbfb
33 changed files with 412 additions and 231 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/bin_client/test/test_contracts.sh
View File

@ -208,7 +208,7 @@ assert_output $contract_dir/exec_concat.tz Unit '""' '"_abc"'
assert_output $contract_dir/exec_concat.tz Unit '"test"' '"test_abc"'
# Get current steps to quota
assert_output $contract_dir/steps_to_quota.tz Unit Unit 39968
assert_output $contract_dir/steps_to_quota.tz Unit Unit 39989
# Get the current balance of the contract
assert_output $contract_dir/balance.tz Unit Unit '"4,000,000"'

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

@ -149,6 +149,20 @@ let fee_arg =
~parameter:"fee"
~doc:"fee in \xEA\x9C\xA9 to pay to the baker"
let gas_limit_arg =
arg
~long:"gas-limit"
~short:'G'
~placeholder:"amount"
~doc:"Set the gas limit of the transaction instead \
of letting the client decide based on a simulation"
(parameter (fun _ s ->
try
let v = Z.of_string s in
assert Compare.Z.(v >= Z.zero) ;
return v
with _ -> failwith "invalid gas limit (must be a positive number)"))
let max_priority_arg =
arg
~long:"max-priority"

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

@ -14,6 +14,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 arg_arg: (string, Proto_alpha.full) Clic.arg
val source_arg: (string option, Proto_alpha.full) Clic.arg

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

@ -36,9 +36,9 @@ let parse_expression arg =
(Micheline_parser.no_parsing_error
(Michelson_v1_parser.parse_expression arg))
let transfer cctxt
let transfer (cctxt : #Proto_alpha.full)
block ?branch
~source ~src_pk ~src_sk ~destination ?arg ~amount ~fee () =
~source ~src_pk ~src_sk ~destination ?arg ~amount ~fee ?gas_limit () =
get_branch cctxt block branch >>=? fun (chain_id, branch) ->
begin match arg with
| Some arg ->
@ -49,17 +49,43 @@ let transfer cctxt
Alpha_services.Contract.counter
cctxt block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in
Block_services.predecessor cctxt block >>=? fun predecessor ->
begin match gas_limit with
| Some gas_limit -> return gas_limit
| None ->
Alpha_services.Constants.hard_gas_limits cctxt block >>=? fun (_, max_gas) ->
Alpha_services.Forge.Manager.transaction
cctxt block
~branch ~source ~sourcePubKey:src_pk ~counter ~amount
~destination ?parameters ~fee () >>=? fun bytes ->
Block_services.predecessor cctxt block >>=? fun predecessor ->
~destination ?parameters ~fee ~gas_limit:max_gas () >>=? fun bytes ->
Client_keys.sign
src_sk ~watermark:Generic_operation bytes >>=? fun signature ->
let signed_bytes = Signature.concat bytes signature in
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Alpha_services.Helpers.apply_operation cctxt block
predecessor oph bytes (Some signature) >>=? fun contracts ->
predecessor oph bytes (Some signature) >>=? fun (_, gas) ->
match gas with
| Limited { remaining } ->
let gas = Z.sub max_gas remaining in
if Z.equal gas Z.zero then
cctxt#message "Estimated gas: none" >>= fun () ->
return Z.zero
else
let gas = Z.sub max_gas remaining in
cctxt#message "Estimated gas: %s units (will add 100 for safety)" (Z.to_string gas) >>= fun () ->
return (Z.add gas (Z.of_int 100))
| Unaccounted -> assert false
end >>=? fun gas_limit ->
Alpha_services.Forge.Manager.transaction
cctxt block
~branch ~source ~sourcePubKey:src_pk ~counter ~amount
~destination ?parameters ~fee ~gas_limit () >>=? fun bytes ->
Client_keys.sign
src_sk ~watermark:Generic_operation bytes >>=? fun signature ->
let signed_bytes = Signature.concat bytes signature in
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Alpha_services.Helpers.apply_operation cctxt block
predecessor oph bytes (Some signature) >>=? fun (contracts, _gas) ->
Shell_services.inject_operation
cctxt ~chain_id signed_bytes >>=? fun injected_oph ->
assert (Operation_hash.equal oph injected_oph) ;
@ -91,12 +117,12 @@ let originate rpc_config ?chain_id ~block ?signature bytes =
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Alpha_services.Helpers.apply_operation rpc_config block
predecessor oph bytes signature >>=? function
| [ contract ] ->
| [ contract ], _ ->
Shell_services.inject_operation
rpc_config ?chain_id signed_bytes >>=? fun injected_oph ->
assert (Operation_hash.equal oph injected_oph) ;
return (oph, contract)
| contracts ->
| contracts, _ ->
failwith
"The origination introduced %d contracts instead of one."
(List.length contracts)
@ -121,7 +147,7 @@ let originate_account ?branch
Alpha_services.Forge.Manager.origination cctxt block
~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
~counter ~balance ~spendable:true
?delegatable ?delegatePubKey:delegate ~fee () >>=? fun bytes ->
?delegatable ?delegatePubKey:delegate ~fee ~gas_limit:Z.zero () >>=? fun bytes ->
Client_keys.sign
src_sk ~watermark:Generic_operation bytes >>=? fun signature ->
originate cctxt ~block ~chain_id ~signature bytes
@ -216,6 +242,7 @@ let save_contract ~force cctxt alias_name contract =
let originate_contract
~fee
?gas_limit
~delegate
?(delegatable=true)
?(spendable=false)
@ -235,11 +262,38 @@ let originate_contract
cctxt block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in
get_branch cctxt block None >>=? fun (_chain_id, branch) ->
begin match gas_limit with
| Some gas_limit -> return gas_limit
| None ->
Alpha_services.Constants.hard_gas_limits cctxt block >>=? fun (_, max_gas) ->
Alpha_services.Forge.Manager.origination cctxt block
~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager
~counter ~balance ~spendable:spendable
~delegatable ?delegatePubKey:delegate
~script:{ code ; storage } ~fee () >>=? fun bytes ->
~script:{ code ; storage } ~fee ~gas_limit:max_gas () >>=? fun bytes ->
Client_keys.sign
~watermark:Generic_operation src_sk bytes >>=? fun signature ->
let signed_bytes = Signature.concat bytes signature in
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Block_services.predecessor cctxt block >>=? fun predecessor ->
Alpha_services.Helpers.apply_operation cctxt block
predecessor oph bytes (Some signature) >>=? fun (_, gas) ->
match gas with
| Limited { remaining } ->
let gas = Z.sub max_gas remaining in
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))
| Unaccounted -> assert false
end >>=? fun gas_limit ->
Alpha_services.Forge.Manager.origination cctxt block
~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager
~counter ~balance ~spendable:spendable
~delegatable ?delegatePubKey:delegate
~script:{ code ; storage } ~fee ~gas_limit () >>=? fun bytes ->
Client_keys.sign
src_sk ~watermark:Generic_operation bytes >>=? fun signature ->
originate cctxt ~block ~signature bytes

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

@ -91,6 +91,7 @@ val operation_submitted_message :
val originate_contract:
fee:Tez.t ->
?gas_limit:Z.t ->
delegate:public_key_hash option ->
?delegatable:bool ->
?spendable:bool ->
@ -115,6 +116,7 @@ val transfer :
?arg:string ->
amount:Tez.t ->
fee:Tez.t ->
?gas_limit:Z.t ->
unit ->
(Operation_hash.t * Contract.t list) tzresult Lwt.t

6
src/proto_alpha/lib_client/client_proto_programs.mli
View File

@ -51,7 +51,7 @@ val print_trace_result :
tzresult -> unit tzresult Lwt.t
val hash_and_sign :
?gas:int ->
?gas:Z.t ->
Michelson_v1_parser.parsed ->
Michelson_v1_parser.parsed ->
Client_keys.sk_uri ->
@ -60,7 +60,7 @@ val hash_and_sign :
(string * string * Gas.t) tzresult Lwt.t
val typecheck_data :
?gas:int ->
?gas:Z.t ->
data:Michelson_v1_parser.parsed ->
ty:Michelson_v1_parser.parsed ->
'a ->
@ -68,7 +68,7 @@ val typecheck_data :
Gas.t tzresult Lwt.t
val typecheck_program :
?gas:int ->
?gas:Z.t ->
Michelson_v1_parser.parsed ->
Block_services.block ->
#Proto_alpha.rpc_context ->

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

@ -206,9 +206,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.Quota_exceeded :: rest ->
| Alpha_environment.Ecoproto_error Gas.Block_quota_exceeded :: rest ->
Format.fprintf ppf
"@[<v 0>Gas limit exceeded during typechecking or execution. Try again with a higher gas limit.@]" ;
"@[<v 0>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 ->
Format.fprintf ppf
"@[<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 err :: rest ->

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

@ -181,8 +181,8 @@ let commands () =
end ;
command ~group ~desc: "Launch a smart contract on the blockchain."
(args7
fee_arg delegate_arg (Client_keys.force_switch ())
(args8
fee_arg gas_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
@ -201,12 +201,12 @@ let commands () =
~name:"prg" ~desc: "script of the account\n\
Combine with -init if the storage type is not unit."
@@ stop)
begin fun (fee, delegate, force, delegatable, spendable, initial_storage, no_print_source)
begin fun (fee, gas_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 ~fee ~delegate ~delegatable ~spendable ~initial_storage
originate_contract ~fee ?gas_limit ~delegate ~delegatable ~spendable ~initial_storage
~manager ~balance ~source ~src_pk ~src_sk ~code cctxt >>= fun errors ->
report_michelson_errors ~no_print_source ~msg:"origination simulation failed" cctxt errors >>= function
| None -> return ()
@ -217,7 +217,7 @@ let commands () =
end ;
command ~group ~desc: "Transfer tokens / call a smart contract."
(args3 fee_arg arg_arg no_print_source_flag)
(args4 fee_arg gas_limit_arg arg_arg no_print_source_flag)
(prefixes [ "transfer" ]
@@ tez_param
~name: "qty" ~desc: "amount taken from source"
@ -228,10 +228,10 @@ let commands () =
@@ ContractAlias.destination_param
~name: "dst" ~desc: "name/literal of the destination contract"
@@ stop)
begin fun (fee, arg, no_print_source) amount (_, source) (_, destination) cctxt ->
begin fun (fee, gas_limit, arg, no_print_source) amount (_, source) (_, destination) cctxt ->
source_to_keys cctxt cctxt#block source >>=? fun (src_pk, src_sk) ->
transfer cctxt ~fee cctxt#block
~source ~src_pk ~src_sk ~destination ~arg ~amount () >>=
~source ~src_pk ~src_sk ~destination ~arg ~amount ?gas_limit () >>=
report_michelson_errors ~no_print_source ~msg:"transfer simulation failed" cctxt >>= function
| None -> return ()
| Some (oph, contracts) ->

15
src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml
View File

@ -47,14 +47,15 @@ let commands () =
~short:'G'
~doc:"Initial quantity of gas for typechecking and execution"
~placeholder:"gas"
(parameter
(fun _ctx str ->
(parameter (fun _ctx str ->
try
return (int_of_string str)
with _ ->
failwith "Invalid gas literal: '%s'" str)) in
let resolve_max_gas ctxt block = function
| None -> Alpha_services.Constants.max_gas ctxt block >>=? fun gas ->
let v = Z.of_string str in
assert Compare.Z.(v >= Z.zero) ;
return v
with _ -> failwith "invalid gas limit (must be a positive number)")) in
let resolve_max_gas cctxt block = function
| None ->
Alpha_services.Constants.hard_gas_limits cctxt block >>=? fun (_, gas) ->
return gas
| Some gas -> return gas in
let data_parameter =

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

@ -67,6 +67,7 @@ module Gas = struct
let set_unlimited = Raw_context.set_gas_unlimited
let consume = Raw_context.consume_gas
let level = Raw_context.gas_level
let block_level = Raw_context.block_gas_level
end
module Level = struct
include Level_repr

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

@ -109,7 +109,7 @@ end
module Gas : sig
type t = private
| Unaccounted
| Limited of { remaining : int }
| Limited of { remaining : Z.t }
val encoding : t Data_encoding.encoding
val pp : Format.formatter -> t -> unit
@ -119,7 +119,8 @@ module Gas : sig
val cost_encoding : cost Data_encoding.encoding
val pp_cost : Format.formatter -> cost -> unit
type error += Quota_exceeded
type error += Block_quota_exceeded (* `Temporary *)
type error += Operation_quota_exceeded (* `Temporary *)
val free : cost
val step_cost : int -> cost
@ -130,10 +131,11 @@ module Gas : sig
val ( *@ ) : int -> cost -> cost
val ( +@ ) : cost -> cost -> cost
val set_limit: context -> int -> context
val set_limit: context -> Z.t -> context tzresult
val set_unlimited: context -> context
val consume: context -> cost -> context tzresult
val level: context -> t
val block_level: context -> Z.t
end
module Script_int : module type of Script_int_repr
@ -299,7 +301,8 @@ module Constants : sig
time_between_blocks: Period.t list ;
first_free_baking_slot: int ;
endorsers_per_block: int ;
max_gas: int ;
hard_gas_limit_per_operation: Z.t ;
hard_gas_limit_per_block: Z.t ;
proof_of_work_threshold: int64 ;
dictator_pubkey: Signature.Public_key.t ;
max_operation_data_length: int ;
@ -323,7 +326,8 @@ module Constants : sig
val time_between_blocks: context -> Period.t list
val first_free_baking_slot: context -> int
val endorsers_per_block: context -> int
val max_gas: context -> int
val hard_gas_limit_per_operation: context -> Z.t
val hard_gas_limit_per_block: context -> Z.t
val proof_of_work_threshold: context -> int64
val dictator_pubkey: context -> Signature.Public_key.t
val max_operation_data_length: context -> int
@ -764,6 +768,7 @@ and manager_operation =
amount: Tez.t ;
parameters: Script.expr option ;
destination: Contract.contract ;
gas_limit: Z.t;
}
| Origination of {
manager: public_key_hash ;
@ -772,6 +777,7 @@ and manager_operation =
spendable: bool ;
delegatable: bool ;
credit: Tez.t ;
gas_limit: Z.t;
}
| Delegation of public_key_hash option

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

@ -371,8 +371,8 @@ let apply_amendment_operation_content ctxt delegate = function
let apply_manager_operation_content
ctxt origination_nonce source = function
| Reveal _ -> return (ctxt, origination_nonce, None)
| Transaction { amount ; parameters ; destination } ->
let ctxt = Gas.set_limit ctxt (Constants.max_gas ctxt) in
| Transaction { amount ; parameters ; destination ; gas_limit } ->
Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt ->
begin
Contract.spend ctxt source amount >>=? fun ctxt ->
Contract.credit ctxt destination amount >>=? fun ctxt ->
@ -422,8 +422,8 @@ let apply_manager_operation_content
| None, _ -> fail (Bad_contract_parameter (destination, Some arg_type, None))
end
| Origination { manager ; delegate ; script ;
spendable ; delegatable ; credit } ->
let ctxt = Gas.set_limit ctxt (Constants.max_gas ctxt) in
spendable ; delegatable ; credit ; gas_limit } ->
Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt ->
begin match script with
| None -> return (None, None, ctxt)
| Some script ->
@ -488,7 +488,6 @@ let apply_sourced_operation
ctxt origination_nonce source content)
(ctxt, origination_nonce, None) contents
>>=? fun (ctxt, origination_nonce, err) ->
let ctxt = Gas.set_unlimited ctxt in
return (ctxt, origination_nonce, err)
| Consensus_operation content ->
apply_consensus_operation_content ctxt
@ -616,8 +615,7 @@ let apply_anonymous_operation ctxt _delegate origination_nonce kind =
let apply_operation
ctxt delegate pred_block block_prio hash operation =
let ctxt = Gas.set_unlimited ctxt in
match operation.contents with
begin match operation.contents with
| Anonymous_operations ops ->
let origination_nonce = Contract.initial_origination_nonce hash in
fold_left_s
@ -632,6 +630,10 @@ let apply_operation
ctxt pred_block block_prio
operation origination_nonce op >>=? fun (ctxt, origination_nonce, err) ->
return (ctxt, Contract.originated_contracts origination_nonce, err)
end >>=? fun (ctxt, contracts, err) ->
let gas = Gas.level ctxt in
let ctxt = Gas.set_unlimited ctxt in
return (ctxt, gas, contracts, err)
let may_snapshot_roll ctxt =
let level = Alpha_context.Level.current ctxt in

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

@ -52,7 +52,8 @@ type parametric = {
time_between_blocks: Period_repr.t list ;
first_free_baking_slot: int ;
endorsers_per_block: int ;
max_gas: int ;
hard_gas_limit_per_operation: Z.t ;
hard_gas_limit_per_block: Z.t ;
proof_of_work_threshold: int64 ;
dictator_pubkey: Signature.Public_key.t ;
max_operation_data_length: int ;
@ -76,7 +77,8 @@ let default = {
List.map Period_repr.of_seconds_exn [ 60L ] ;
first_free_baking_slot = 16 ;
endorsers_per_block = 32 ;
max_gas = 40_000 ;
hard_gas_limit_per_operation = Z.of_int 40_000 ;
hard_gas_limit_per_block = Z.of_int 4_000_000 ;
proof_of_work_threshold =
Int64.(sub (shift_left 1L 56) 1L) ;
dictator_pubkey =
@ -113,9 +115,10 @@ let parametric_encoding =
c.time_between_blocks,
c.first_free_baking_slot,
c.endorsers_per_block,
c.max_gas,
c.proof_of_work_threshold ),
( c.dictator_pubkey,
c.hard_gas_limit_per_operation,
c.hard_gas_limit_per_block),
((c.proof_of_work_threshold,
c.dictator_pubkey,
c.max_operation_data_length,
c.tokens_per_roll,
c.michelson_maximum_type_size,
@ -123,8 +126,8 @@ let parametric_encoding =
c.origination_burn,
c.block_security_deposit,
c.endorsement_security_deposit,
c.block_reward,
c.endorsement_reward)) )
c.block_reward),
(c.endorsement_reward))) )
(fun (( preserved_cycles,
blocks_per_cycle,
blocks_per_commitment,
@ -133,9 +136,10 @@ let parametric_encoding =
time_between_blocks,
first_free_baking_slot,
endorsers_per_block,
max_gas,
proof_of_work_threshold ),
( dictator_pubkey,
hard_gas_limit_per_operation,
hard_gas_limit_per_block),
((proof_of_work_threshold,
dictator_pubkey,
max_operation_data_length,
tokens_per_roll,
michelson_maximum_type_size,
@ -143,8 +147,8 @@ let parametric_encoding =
origination_burn,
block_security_deposit,
endorsement_security_deposit,
block_reward,
endorsement_reward )) ->
block_reward),
(endorsement_reward))) ->
{ preserved_cycles ;
blocks_per_cycle ;
blocks_per_commitment ;
@ -153,7 +157,8 @@ let parametric_encoding =
time_between_blocks ;
first_free_baking_slot ;
endorsers_per_block ;
max_gas ;
hard_gas_limit_per_operation ;
hard_gas_limit_per_block ;
proof_of_work_threshold ;
dictator_pubkey ;
max_operation_data_length ;
@ -176,9 +181,11 @@ let parametric_encoding =
(req "time_between_blocks" (list Period_repr.encoding))
(req "first_free_baking_slot" uint16)
(req "endorsers_per_block" uint16)
(req "instructions_per_transaction" int31)
(req "proof_of_work_threshold" int64))
(req "hard_gas_limit_per_operation" z)
(req "hard_gas_limit_per_block" z))
(merge_objs
(obj10
(req "proof_of_work_threshold" int64)
(req "dictator_pubkey" Signature.Public_key.encoding)
(req "max_operation_data_length" int31)
(req "tokens_per_roll" Tez_repr.encoding)
@ -187,8 +194,9 @@ let parametric_encoding =
(req "origination_burn" Tez_repr.encoding)
(req "block_security_deposit" Tez_repr.encoding)
(req "endorsement_security_deposit" Tez_repr.encoding)
(req "block_reward" Tez_repr.encoding)
(req "endorsement_reward" Tez_repr.encoding)))
(req "block_reward" Tez_repr.encoding))
(obj1
(req "endorsement_reward" Tez_repr.encoding))))
type t = {
fixed : fixed ;

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

@ -80,13 +80,14 @@ module S = struct
~output: (obj1 (req "endorsers_per_block" uint16))
RPC_path.(custom_root / "endorsers_per_block")
let max_gas =
let hard_gas_limits =
RPC_service.post_service
~description: "Instructions per transaction"
~description: "Hard maximum amount of gas per operation and per block"
~query: RPC_query.empty
~input: empty
~output: (obj1 (req "instructions_per_transaction" int31))
RPC_path.(custom_root / "max_gas")
~output: (obj2 (req "per_block" z) (req "per_operation" z))
RPC_path.(custom_root / "hard_gas_limits")
let proof_of_work_threshold =
RPC_service.post_service
@ -189,8 +190,9 @@ let () =
register0 S.endorsers_per_block begin fun ctxt () () ->
return (Constants.endorsers_per_block ctxt)
end ;
register0 S.max_gas begin fun ctxt () () ->
return (Constants.max_gas ctxt)
register0 S.hard_gas_limits begin fun ctxt () () ->
return (Constants.hard_gas_limit_per_block ctxt,
Constants.hard_gas_limit_per_operation ctxt)
end ;
register0 S.proof_of_work_threshold begin fun ctxt () () ->
return (Constants.proof_of_work_threshold ctxt)
@ -238,8 +240,8 @@ let first_free_baking_slot ctxt block =
RPC_context.make_call0 S.first_free_baking_slot ctxt block () ()
let endorsers_per_block ctxt block =
RPC_context.make_call0 S.endorsers_per_block ctxt block () ()
let max_gas ctxt block =
RPC_context.make_call0 S.max_gas ctxt block () ()
let hard_gas_limits ctxt block =
RPC_context.make_call0 S.hard_gas_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 =

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

@ -33,8 +33,8 @@ val first_free_baking_slot:
val endorsers_per_block:
'a #RPC_context.simple -> 'a -> int shell_tzresult Lwt.t
val max_gas:
'a #RPC_context.simple -> 'a -> int shell_tzresult Lwt.t
val hard_gas_limits:
'a #RPC_context.simple -> 'a -> (Z.t * Z.t) shell_tzresult Lwt.t
val proof_of_work_threshold:
'a #RPC_context.simple -> 'a -> Int64.t shell_tzresult Lwt.t

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

@ -31,9 +31,12 @@ let first_free_baking_slot c =
let endorsers_per_block c =
let constants = Raw_context.constants c in
constants.endorsers_per_block
let max_gas c =
let hard_gas_limit_per_operation c =
let constants = Raw_context.constants c in
constants.max_gas
constants.hard_gas_limit_per_operation
let hard_gas_limit_per_block c =
let constants = Raw_context.constants c in
constants.hard_gas_limit_per_block
let proof_of_work_threshold c =
let constants = Raw_context.constants c in
constants.proof_of_work_threshold

90
src/proto_alpha/lib_protocol/src/gas_repr.ml
View File

@ -9,16 +9,16 @@
type t =
| Unaccounted
| Limited of { remaining : int }
| Limited of { remaining : Z.t }
type cost =
{ allocations : int ;
steps : int }
{ allocations : Z.t ;
steps : Z.t }
let encoding =
let open Data_encoding in
union
[ case (Tag 0) int31
[ case (Tag 0) z
(function Limited { remaining } -> Some remaining | _ -> None)
(fun remaining -> Limited { remaining }) ;
case (Tag 1) (constant "unaccounted")
@ -29,7 +29,7 @@ let pp ppf = function
| Unaccounted ->
Format.fprintf ppf "unaccounted"
| Limited { remaining } ->
Format.fprintf ppf "%d units remaining" remaining
Format.fprintf ppf "%s units remaining" (Z.to_string remaining)
let cost_encoding =
let open Data_encoding in
@ -39,30 +39,40 @@ let cost_encoding =
(fun (allocations, steps) ->
{ allocations ; steps })
(obj2
(req "allocations" int31)
(req "steps" int31))
(req "allocations" z)
(req "steps" z))
let pp_cost ppf { allocations ; steps } =
Format.fprintf ppf
"(steps: %d, allocs: %d)"
steps allocations
"(steps: %s, allocs: %s)"
(Z.to_string steps) (Z.to_string allocations)
type error += Quota_exceeded
type error += Block_quota_exceeded (* `Temporary *)
type error += Operation_quota_exceeded (* `Temporary *)
let consume t cost = match t with
| Unaccounted -> ok Unaccounted
let allocation_weight = Z.of_int 2
let step_weight = Z.of_int 1
let consume block_gas operation_gas cost = match operation_gas with
| Unaccounted -> ok (block_gas, Unaccounted)
| Limited { remaining } ->
let weighted_cost =
Z.add
(Z.mul allocation_weight cost.allocations)
(Z.mul step_weight cost.steps) in
let remaining =
remaining
- 2 * cost.allocations
- 1 * cost.steps in
if Compare.Int.(remaining <= 0)
then error Quota_exceeded
else ok (Limited { remaining })
Z.sub remaining weighted_cost in
let block_remaining =
Z.sub block_gas weighted_cost in
if Compare.Z.(remaining <= Z.zero)
then error Operation_quota_exceeded
else if Compare.Z.(block_remaining <= Z.zero)
then error Block_quota_exceeded
else ok (block_remaining, Limited { remaining })
let alloc_cost n =
{ allocations = n + 1 ;
steps = 0 }
{ allocations = Z.of_int (n + 1) ;
steps = Z.zero }
let alloc_bytes_cost n =
alloc_cost (n / 8)
@ -71,30 +81,40 @@ let alloc_bits_cost n =
alloc_cost (n / 64)
let step_cost n =
{ allocations = 0 ;
steps = n }
{ allocations = Z.zero ;
steps = Z.of_int n }
let free =
{ allocations = 0 ;
steps = 0 }
{ allocations = Z.zero ;
steps = Z.zero }
let ( +@ ) x y =
{ allocations = x.allocations + y.allocations ;
steps = x.steps + y.steps }
{ allocations = Z.add x.allocations y.allocations ;
steps = Z.add x.steps y.steps }
let ( *@ ) x y =
{ allocations = x * y.allocations ;
steps = x * y.steps }
{ allocations = Z.mul (Z.of_int x) y.allocations ;
steps = Z.mul (Z.of_int x) y.steps }
let () =
let open Data_encoding in
register_error_kind
`Permanent
~id:"quotaExceededRuntimeError"
~title: "Quota exceeded (runtime script error)"
`Temporary
~id:"gas_exhausted.operation"
~title: "Gas quota exceeded for the operation"
~description:
"A script or one of its callee took too much \
time or storage space"
"A script or one of its callee took more \
time than the operation said it would"
empty
(function Quota_exceeded -> Some () | _ -> None)
(fun () -> Quota_exceeded) ;
(function Operation_quota_exceeded -> Some () | _ -> None)
(fun () -> Operation_quota_exceeded) ;
register_error_kind
`Temporary
~id:"gas_exhausted.block"
~title: "Gas quota exceeded for the block"
~description:
"The sum of gas consumed by all the operations in the block \
exceeds the hard gas limit per block"
empty
(function Block_quota_exceeded -> Some () | _ -> None)
(fun () -> Block_quota_exceeded) ;

7
src/proto_alpha/lib_protocol/src/gas_repr.mli
View File

@ -9,7 +9,7 @@
type t =
| Unaccounted
| Limited of { remaining : int }
| Limited of { remaining : Z.t }
val encoding : t Data_encoding.encoding
val pp : Format.formatter -> t -> unit
@ -19,9 +19,10 @@ type cost
val cost_encoding : cost Data_encoding.encoding
val pp_cost : Format.formatter -> cost -> unit
type error += Quota_exceeded
type error += Block_quota_exceeded (* `Temporary *)
type error += Operation_quota_exceeded (* `Temporary *)
val consume : t -> cost -> t tzresult
val consume : Z.t -> t -> cost -> (Z.t * t) tzresult
val free : cost
val step_cost : int -> cost

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

@ -52,10 +52,11 @@ module S = struct
(req "operation_hash" Operation_hash.encoding)
(req "forged_operation" bytes)
(opt "signature" Signature.encoding))
~output: (obj1 (req "contracts" (list Contract.encoding)))
~output: (obj2
(req "contracts" (list Contract.encoding))
(req "remaining_gas" Gas.encoding))
RPC_path.(custom_root / "apply_operation")
let trace_code =
RPC_service.post_service
~description: "Run a piece of code in the current context, \
@ -79,7 +80,7 @@ module S = struct
~query: RPC_query.empty
~input: (obj2
(req "program" Script.expr_encoding)
(opt "gas" int31))
(opt "gas" z))
~output: (obj2
(req "type_map" Script_tc_errors_registration.type_map_enc)
(req "gas" Gas.encoding))
@ -93,7 +94,7 @@ module S = struct
~input: (obj3
(req "data" Script.expr_encoding)
(req "type" Script.expr_encoding)
(opt "gas" int31))
(opt "gas" z))
~output: (obj1 (req "gas" Gas.encoding))
RPC_path.(custom_root / "typecheck_data")
@ -105,7 +106,7 @@ module S = struct
~input: (obj3
(req "data" Script.expr_encoding)
(req "type" Script.expr_encoding)
(opt "gas" int31))
(opt "gas" z))
~output: (obj2
(req "hash" string)
(req "gas" Gas.encoding))
@ -150,13 +151,13 @@ module I = struct
Apply.apply_operation
ctxt (Some baker_pkh) pred_block block_prio hash operation
>>=? function
| (_ctxt, _, Some script_err) -> Lwt.return (Error script_err)
| (_ctxt, contracts, None) -> Lwt.return (Ok contracts)
| (_ctxt, _, _, Some script_err) -> Lwt.return (Error script_err)
| (_ctxt, gas, contracts, None) -> Lwt.return (Ok (contracts, gas))
let run_parameters ctxt (script, storage, input, amount, contract, origination_nonce) =
let max_gas =
Constants.max_gas ctxt in
Constants.hard_gas_limit_per_operation ctxt in
let origination_nonce =
match origination_nonce with
| Some origination_nonce -> origination_nonce
@ -178,7 +179,10 @@ let () =
register0 S.run_code begin fun ctxt () parameters ->
let (code, storage, input, amount, contract, gas, origination_nonce) =
I.run_parameters ctxt parameters in
let ctxt = if Compare.Int.(gas > 0) then Gas.set_limit ctxt gas else Gas.set_unlimited ctxt in
begin if Compare.Z.(gas > Z.zero) then
Lwt.return (Gas.set_limit ctxt gas)
else
return (Gas.set_unlimited ctxt) end >>=? fun ctxt ->
Script_interpreter.execute
origination_nonce
contract (* transaction initiator *)
@ -191,7 +195,10 @@ let () =
register0 S.trace_code begin fun ctxt () parameters ->
let (code, storage, input, amount, contract, gas, origination_nonce) =
I.run_parameters ctxt parameters in
let ctxt = if Compare.Int.(gas > 0) then Gas.set_limit ctxt gas else Gas.set_unlimited ctxt in
begin if Compare.Z.(gas > Z.zero) then
Lwt.return (Gas.set_limit ctxt gas)
else
return (Gas.set_unlimited ctxt) end >>=? fun ctxt ->
Script_interpreter.trace
origination_nonce
contract (* transaction initiator *)
@ -203,24 +210,24 @@ let () =
~f:(Script_ir_translator.to_printable_big_map ctxt))
end ;
register0 S.typecheck_code begin fun ctxt () (expr, maybe_gas) ->
let ctxt = match maybe_gas with
| None -> Gas.set_unlimited ctxt
| Some gas -> Gas.set_limit ctxt gas in
begin match maybe_gas with
| None -> return (Gas.set_unlimited ctxt)
| Some gas -> Lwt.return (Gas.set_limit ctxt gas) end >>=? fun ctxt ->
Script_ir_translator.typecheck_code ctxt expr >>=? fun (res, ctxt) ->
return (res, Gas.level ctxt)
end ;
register0 S.typecheck_data begin fun ctxt () (data, ty, maybe_gas) ->
let ctxt = match maybe_gas with
| None -> Gas.set_unlimited ctxt
| Some gas -> Gas.set_limit ctxt gas in
begin match maybe_gas with
| None -> return (Gas.set_unlimited ctxt)
| Some gas -> Lwt.return (Gas.set_limit ctxt gas) end >>=? fun ctxt ->
Script_ir_translator.typecheck_data ctxt (data, ty) >>=? fun ctxt ->
return (Gas.level ctxt)
end ;
register0 S.hash_data begin fun ctxt () (expr, typ, maybe_gas) ->
let open Script_ir_translator in
let ctxt = match maybe_gas with
| None -> Gas.set_unlimited ctxt
| Some gas -> Gas.set_limit ctxt gas in
begin match maybe_gas with
| None -> return (Gas.set_unlimited ctxt)
| Some gas -> Lwt.return (Gas.set_limit ctxt gas) end >>=? fun ctxt ->
Lwt.return (parse_ty false (Micheline.root typ)) >>=? fun (Ex_ty typ, _) ->
parse_data ctxt typ (Micheline.root expr) >>=? fun (data, ctxt) ->
Lwt.return (Script_ir_translator.hash_data ctxt typ data) >>=? fun (hash, ctxt) ->
@ -343,9 +350,9 @@ module Forge = struct
let transaction ctxt
block ~branch ~source ?sourcePubKey ~counter
~amount ~destination ?parameters ~fee ()=
~amount ~destination ?parameters ~gas_limit ~fee ()=
operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee
Alpha_context.[Transaction { amount ; parameters ; destination }]
Alpha_context.[Transaction { amount ; parameters ; destination ; gas_limit }]
let origination ctxt
block ~branch
@ -353,7 +360,8 @@ module Forge = struct
~managerPubKey ~balance
?(spendable = true)
?(delegatable = true)
?delegatePubKey ?script ~fee () =
?delegatePubKey ?script
~gas_limit ~fee () =
operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee
Alpha_context.[
Origination { manager = managerPubKey ;
@ -361,7 +369,8 @@ module Forge = struct
script ;
spendable ;
delegatable ;
credit = balance }
credit = balance ;
gas_limit }
]
let delegation ctxt

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

@ -19,7 +19,7 @@ val minimal_time:
val apply_operation:
'a #RPC_context.simple ->
'a -> Block_hash.t -> Operation_hash.t -> MBytes.t -> Signature.t option ->
(Contract.t list) shell_tzresult Lwt.t
(Contract.t list * Gas.t) shell_tzresult Lwt.t
val run_code:
'a #RPC_context.simple ->
@ -37,16 +37,16 @@ val trace_code:
val typecheck_code:
'a #RPC_context.simple ->
'a -> (Script.expr * int option) ->
'a -> (Script.expr * Z.t option) ->
(Script_tc_errors.type_map * Gas.t) shell_tzresult Lwt.t
val typecheck_data:
'a #RPC_context.simple ->
'a -> Script.expr * Script.expr * int option -> Gas.t shell_tzresult Lwt.t
'a -> Script.expr * Script.expr * Z.t option -> Gas.t shell_tzresult Lwt.t
val hash_data:
'a #RPC_context.simple ->
'a -> Script.expr * Script.expr * int option -> (string * Gas.t) shell_tzresult Lwt.t
'a -> Script.expr * Script.expr * Z.t option -> (string * Gas.t) shell_tzresult Lwt.t
val level:
'a #RPC_context.simple ->
@ -88,6 +88,7 @@ module Forge : sig
amount:Tez.t ->
destination:Contract.t ->
?parameters:Script.expr ->
gas_limit:Z.t ->
fee:Tez.t ->
unit -> MBytes.t shell_tzresult Lwt.t
@ -103,6 +104,7 @@ module Forge : sig
?delegatable:bool ->
?delegatePubKey: public_key_hash ->
?script:Script.t ->
gas_limit:Z.t ->
fee:Tez.t->
unit -> MBytes.t shell_tzresult Lwt.t

2
src/proto_alpha/lib_protocol/src/main.ml
View File

@ -116,7 +116,7 @@ let apply_operation ({ mode ; ctxt ; op_count ; _ } as data) operation =
Some baker in
Apply.apply_operation ctxt baker pred_block block_prio
(Alpha_context.Operation.hash operation) operation
>>=? fun (ctxt, _contracts, _ignored_script_error) ->
>>=? fun (ctxt, _gas, _contracts, _ignored_script_error) ->
let op_count = op_count + 1 in
return { data with ctxt ; op_count }

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

@ -82,6 +82,7 @@ and manager_operation =
amount: Tez_repr.tez ;
parameters: Script_repr.expr option ;
destination: Contract_repr.contract ;
gas_limit: Z.t;
}
| Origination of {
manager: Signature.Public_key_hash.t ;
@ -90,6 +91,7 @@ and manager_operation =
spendable: bool ;
delegatable: bool ;
credit: Tez_repr.tez ;
gas_limit: Z.t;
}
| Delegation of Signature.Public_key_hash.t option
@ -118,47 +120,49 @@ module Encoding = struct
let transaction_encoding =
describe ~title:"Transaction operation" @@
obj4
obj5
(req "kind" (constant "transaction"))
(req "amount" Tez_repr.encoding)
(req "destination" Contract_repr.encoding)
(opt "parameters" Script_repr.expr_encoding)
(req "gas_limit" z)
let transaction_case tag =
case tag ~name:"Transaction" transaction_encoding
(function
| Transaction { amount ; destination ; parameters } ->
Some ((), amount, destination, parameters)
| Transaction { amount ; destination ; parameters ; gas_limit } ->
Some ((), amount, destination, parameters, gas_limit)
| _ -> None)
(fun ((), amount, destination, parameters) ->
Transaction { amount ; destination ; parameters })
(fun ((), amount, destination, parameters, gas_limit) ->
Transaction { amount ; destination ; parameters ; gas_limit })
let origination_encoding =
describe ~title:"Origination operation" @@
(obj7
(obj8
(req "kind" (constant "origination"))
(req "managerPubkey" Signature.Public_key_hash.encoding)
(req "balance" Tez_repr.encoding)
(opt "spendable" bool)
(opt "delegatable" bool)
(opt "delegate" Signature.Public_key_hash.encoding)
(opt "script" Script_repr.encoding))
(opt "script" Script_repr.encoding)
(req "gas_limit" z))
let origination_case tag =
case tag ~name:"Origination" origination_encoding
(function
| Origination { manager ; credit ; spendable ;
delegatable ; delegate ; script } ->
delegatable ; delegate ; script ; gas_limit } ->
Some ((), manager, credit, Some spendable,
Some delegatable, delegate, script)
Some delegatable, delegate, script, gas_limit)
| _ -> None)
(fun ((), manager, credit, spendable, delegatable, delegate, script) ->
(fun ((), manager, credit, spendable, delegatable, delegate, script, gas_limit) ->
let delegatable =
match delegatable with None -> true | Some b -> b in
let spendable =
match spendable with None -> true | Some b -> b in
Origination
{manager ; credit ; spendable ; delegatable ; delegate ; script })
{manager ; credit ; spendable ; delegatable ; delegate ; script ; gas_limit })
let delegation_encoding =
describe ~title:"Delegation operation" @@

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

@ -82,6 +82,7 @@ and manager_operation =
amount: Tez_repr.tez ;
parameters: Script_repr.expr option ;
destination: Contract_repr.contract ;
gas_limit: Z.t ;
}
| Origination of {
manager: Signature.Public_key_hash.t ;
@ -90,6 +91,7 @@ and manager_operation =
spendable: bool ;
delegatable: bool ;
credit: Tez_repr.tez ;
gas_limit: Z.t ;
}
| Delegation of Signature.Public_key_hash.t option

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

@ -27,6 +27,7 @@ let bootstrap_account_encoding =
(fun (public_key, amount) -> { public_key ; amount })
(tup2 Signature.Public_key.encoding Tez_repr.encoding)
(* This encoding is used to read configuration files (e.g. sandbox.json)
where some fields can be missing, in that case they are replaced by
the default. *)
@ -62,9 +63,12 @@ let constants_encoding =
and endorsers_per_block =
opt Compare.Int.(=)
default.endorsers_per_block c.endorsers_per_block
and max_gas =
opt Compare.Int.(=)
default.max_gas c.max_gas
and hard_gas_limit_per_operation =
opt Compare.Z.(=)
default.hard_gas_limit_per_operation c.hard_gas_limit_per_operation
and hard_gas_limit_per_block =
opt Compare.Z.(=)
default.hard_gas_limit_per_block c.hard_gas_limit_per_block
and proof_of_work_threshold =
opt Compare.Int64.(=)
default.proof_of_work_threshold c.proof_of_work_threshold
@ -107,9 +111,10 @@ let constants_encoding =
time_between_blocks,
first_free_baking_slot,
endorsers_per_block,
max_gas,
proof_of_work_threshold),
( dictator_pubkey,
hard_gas_limit_per_operation,
hard_gas_limit_per_block),
((proof_of_work_threshold,
dictator_pubkey,
max_operation_data_length,
tokens_per_roll,
michelson_maximum_type_size,
@ -117,8 +122,8 @@ let constants_encoding =
origination_burn,
block_security_deposit,
endorsement_security_deposit,
block_reward,
endorsement_reward)))
block_reward),
(endorsement_reward))))
(fun (( preserved_cycles,
blocks_per_cycle,
blocks_per_commitment,
@ -127,9 +132,10 @@ let constants_encoding =
time_between_blocks,
first_free_baking_slot,
endorsers_per_block,
max_gas,
proof_of_work_threshold),
( dictator_pubkey,
hard_gas_limit_per_operation,
hard_gas_limit_per_block),
((proof_of_work_threshold,
dictator_pubkey,
max_operation_data_length,
tokens_per_roll,
michelson_maximum_type_size,
@ -137,8 +143,8 @@ let constants_encoding =
origination_burn,
block_security_deposit,
endorsement_security_deposit,
block_reward,
endorsement_reward)) ->
block_reward),
(endorsement_reward))) ->
let unopt def = function None -> def | Some v -> v in
let default = Constants_repr.default in
{ Constants_repr.preserved_cycles =
@ -158,8 +164,10 @@ let constants_encoding =
unopt default.first_free_baking_slot first_free_baking_slot ;
endorsers_per_block =
unopt default.endorsers_per_block endorsers_per_block ;
max_gas =
unopt default.max_gas max_gas ;
hard_gas_limit_per_operation =
unopt default.hard_gas_limit_per_operation hard_gas_limit_per_operation ;
hard_gas_limit_per_block =
unopt default.hard_gas_limit_per_block hard_gas_limit_per_block ;
proof_of_work_threshold =
unopt default.proof_of_work_threshold proof_of_work_threshold ;
dictator_pubkey =
@ -193,9 +201,11 @@ let constants_encoding =
(opt "time_between_blocks" (list Period_repr.encoding))
(opt "first_free_baking_slot" uint16)
(opt "endorsers_per_block" uint16)
(opt "instructions_per_transaction" int31)
(opt "proof_of_work_threshold" int64))
(opt "hard_gas_limit_per_operation" z)
(opt "hard_gas_limit_per_block" z))
(merge_objs
(obj10
(opt "proof_of_work_threshold" int64)
(opt "dictator_pubkey" Signature.Public_key.encoding)
(opt "max_operation_data_length" int31)
(opt "tokens_per_roll" Tez_repr.encoding)
@ -204,8 +214,9 @@ let constants_encoding =
(opt "origination_burn" Tez_repr.encoding)
(opt "block_security_deposit" Tez_repr.encoding)
(opt "endorsement_security_deposit" Tez_repr.encoding)
(opt "block_reward" Tez_repr.encoding)
(opt "endorsement_reward" Tez_repr.encoding)))
(opt "block_reward" Tez_repr.encoding))
(obj1
(opt "endorsement_reward" Tez_repr.encoding))))
let encoding =
let open Data_encoding in

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

@ -19,7 +19,8 @@ type t = {
endorsements_received: Int_set.t;
fees: Tez_repr.t ;
rewards: Tez_repr.t ;
gas: Gas_repr.t;
block_gas: Z.t ;
operation_gas: Gas_repr.t ;
}
type context = t
@ -48,12 +49,32 @@ let add_rewards ctxt rewards =
let get_rewards ctxt = ctxt.rewards
let get_fees ctxt = ctxt.fees
let set_gas_limit ctxt remaining = { ctxt with gas = Limited { remaining } }
let set_gas_unlimited ctxt = { ctxt with gas = Unaccounted }
type error += Gas_limit_too_high (* `Permanent *)
let () =
let open Data_encoding in
register_error_kind
`Permanent
~id:"gas_limit_too_high"
~title: "Gas limit higher than the hard limit"
~description:
"A transaction tried to exceed the hard limit on gas"
empty
(function Gas_limit_too_high -> Some () | _ -> None)
(fun () -> Gas_limit_too_high)
let set_gas_limit ctxt remaining =
if Compare.Z.(remaining > ctxt.constants.hard_gas_limit_per_operation) 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.gas cost >>? fun gas ->
ok { ctxt with gas }
let gas_level ctxt = ctxt.gas
Gas_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 storage_error =
@ -272,7 +293,8 @@ let prepare ~level ~timestamp ~fitness ctxt =
endorsements_received = Int_set.empty ;
fees = Tez_repr.zero ;
rewards = Tez_repr.zero ;
gas = Unaccounted ;
operation_gas = Unaccounted ;
block_gas = constants.Constants_repr.hard_gas_limit_per_block ;
}
let check_first_block ctxt =
@ -317,7 +339,8 @@ let register_resolvers enc resolve =
endorsements_received = Int_set.empty ;
fees = Tez_repr.zero ;
rewards = Tez_repr.zero ;
gas = Unaccounted ;
block_gas = Constants_repr.default.hard_gas_limit_per_block ;
operation_gas = Unaccounted ;
} in
resolve faked_context str in
Context.register_resolver enc resolve

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

@ -73,10 +73,13 @@ val add_rewards: context -> Tez_repr.t -> context tzresult Lwt.t
val get_fees: context -> Tez_repr.t
val get_rewards: context -> Tez_repr.t
val set_gas_limit: t -> int -> t
type error += Gas_limit_too_high (* `Permanent *)
val set_gas_limit: t -> Z.t -> t tzresult
val set_gas_unlimited: t -> t
val consume_gas: t -> Gas_repr.cost -> t tzresult
val gas_level: t -> Gas_repr.t
val block_gas_level: t -> Z.t
(** {1 Generic accessors} *************************************************)

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

@ -791,8 +791,8 @@ let rec interp
Lwt.return (Gas.consume ctxt Interp_costs.steps_to_quota) >>=? fun ctxt ->
let steps = match Gas.level ctxt with
| Limited { remaining } -> remaining
| Unaccounted -> max_int in
logged_return (Item (Script_int.(abs (of_int steps)), rest), ctxt)
| Unaccounted -> Z.of_string "99999999" in
logged_return (Item (Script_int.(abs (of_zint steps)), rest), ctxt)
| Source (ta, tb), rest ->
Lwt.return (Gas.consume ctxt Interp_costs.source) >>=? fun ctxt ->
logged_return (Item ((ta, tb, orig), rest), ctxt)

8
src/proto_alpha/lib_protocol/test/helpers/helpers_apply.ml
View File

@ -20,7 +20,7 @@ let operation
pred_block_hash
0
hash
operation >>=? fun (tc, contracts, err) ->
operation >>=? fun (tc, _, contracts, err) ->
return ((contracts, err), tc)
@ -31,6 +31,7 @@ let transaction ~tc ?(fee = 0) ?baker
src dst.contract
(Helpers_cast.cents_of_int amount)
~fee: (Helpers_cast.cents_of_int fee)
(Proto_alpha.Alpha_context.Constants.hard_gas_limit_per_operation tc)
@@ Helpers_cast.ctxt_of_tc tc
>>=? fun protop ->
operation ~tc ?baker ~src pbh opsh protop
@ -45,7 +46,9 @@ let transaction_pred ?tc ~(pred: Helpers_block.result) ?baker (src, dst, amount,
let script_origination
~tc pbh opsh script src amount =
Helpers_operation.script_origination_full
script src (Helpers_cast.cents_of_int amount) @@ Helpers_cast.ctxt_of_tc tc
script src (Helpers_cast.cents_of_int amount)
(Proto_alpha.Alpha_context.Constants.hard_gas_limit_per_operation tc)
@@ Helpers_cast.ctxt_of_tc tc
>>=? fun protop -> operation ~tc ?baker: None ~src pbh opsh protop
@ -55,6 +58,7 @@ let origination
Helpers_operation.origination_full
src ~spendable ~delegatable
(Helpers_cast.cents_of_int amount) ~fee:(Helpers_cast.tez_of_int fee)
(Proto_alpha.Alpha_context.Constants.hard_gas_limit_per_operation tc)
@@ Helpers_cast.ctxt_of_tc tc
>>=? fun protop ->
operation ~tc ?baker ~src pbh opsh protop

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

@ -32,18 +32,19 @@ let manager_full src ?(fee = Tez.zero) ops context =
manager src ~fee ops context >>=? fun ops -> return @@ sourced ops
let transaction ?parameters amount destination =
let transaction ?parameters amount destination gas_limit =
Transaction {
amount ;
parameters ;
destination
destination ;
gas_limit
}
let origination
?(delegatable = true) ?(script = None)
?(spendable = true) ?(delegate = None)
(manager: Helpers_account.t) credit
(manager: Helpers_account.t) credit gas_limit
=
Origination {
manager = manager.hpub ;
@ -51,7 +52,8 @@ let origination
spendable ;
delegatable ;
script ;
credit
credit ;
gas_limit
}
@ -63,16 +65,16 @@ let delegation_full ?(fee = Tez.zero) src delegate context =
manager_full src ~fee [delegation delegate] context
let script_origination_full script src credit context =
manager_full src ~fee: Tez.zero [origination ~script src credit] context
let script_origination_full script src credit gas_limit context =
manager_full src ~fee: Tez.zero [origination ~script src credit gas_limit] context
let origination_full ?(spendable = true) ?(delegatable = true) ?(fee = Tez.zero) src credit context =
manager_full src ~fee [origination ~spendable ~delegatable src credit] context
let origination_full ?(spendable = true) ?(delegatable = true) ?(fee = Tez.zero) src credit gas_limit context =
manager_full src ~fee [origination ~spendable ~delegatable src credit gas_limit] context
let transaction_full ?(fee = Tez.zero) ?parameters src dst amount context =
manager src ~fee [transaction ?parameters amount dst] context
let transaction_full ?(fee = Tez.zero) ?parameters src dst amount gas_limit context =
manager src ~fee [transaction ?parameters amount dst gas_limit] context
>>=? fun manager_op ->
return @@ sourced manager_op

10
src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli
View File

@ -23,12 +23,12 @@ val manager_full :
Alpha_environment.Context.t -> proto_operation proto_tzresult Lwt.t
val transaction :
?parameters:Script.expr -> Tez.t -> Contract.contract ->
?parameters:Script.expr -> Tez.t -> Contract.contract -> Z.t ->
manager_operation
val origination :
?delegatable:bool -> ?script:Script.t option -> ?spendable:bool ->
?delegate:public_key_hash option -> Helpers_account.t -> Tez.t -> manager_operation
?delegate:public_key_hash option -> Helpers_account.t -> Tez.t -> Z.t -> manager_operation
val delegation : public_key_hash -> manager_operation
@ -37,16 +37,16 @@ val delegation_full :
proto_operation proto_tzresult Lwt.t
val script_origination_full :
Script.t option -> Helpers_account.t -> Tez.t -> Alpha_environment.Context.t ->
Script.t option -> Helpers_account.t -> Tez.t -> Z.t -> Alpha_environment.Context.t ->
proto_operation proto_tzresult Lwt.t
val origination_full :
?spendable:bool -> ?delegatable:bool -> ?fee:Tez.tez ->
Helpers_account.t -> Tez.t -> Alpha_environment.Context.t ->
Helpers_account.t -> Tez.t -> Z.t -> Alpha_environment.Context.t ->
proto_operation proto_tzresult Lwt.t
val transaction_full :
?fee:Tez.tez -> ?parameters:Proto_alpha.Alpha_context.Script.expr -> Helpers_account.t -> Contract.contract -> Tez.t ->
?fee:Tez.tez -> ?parameters:Proto_alpha.Alpha_context.Script.expr -> Helpers_account.t -> Contract.contract -> Tez.t -> Z.t ->
Alpha_environment.Context.t -> proto_operation proto_tzresult Lwt.t
val amendment_operation :

6
src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml
View File

@ -21,7 +21,8 @@ let execute_code_pred
>>=? fun ((dst, _), tc) ->
let dst = List.hd dst in
let ctxt = Helpers_cast.ctxt_of_tc tc in
Helpers_operation.transaction_full op dst Tez.zero ctxt
let gas = Proto_alpha.Alpha_context.Constants.hard_gas_limit_per_operation tc in
Helpers_operation.transaction_full op dst Tez.zero gas ctxt
>>=? fun dummy_protop ->
let op_header = Helpers_block.get_op_header_res pred in
let apply_op = Helpers_operation.apply_of_proto
@ -29,8 +30,7 @@ let execute_code_pred
let hash = Operation.hash apply_op in
let dummy_nonce = Contract.initial_origination_nonce hash in
let amount = Tez.zero in
let gas = Proto_alpha.Alpha_context.Constants.max_gas tc in
let tc = Proto_alpha.Alpha_context.Gas.set_limit tc gas in
Lwt.return (Proto_alpha.Alpha_context.Gas.set_limit tc gas) >>=? fun tc ->
let return = Script_interpreter.execute
dummy_nonce op.contract dst
tc script amount argument in

3
src/proto_alpha/lib_protocol/test/test_big_maps.ml
View File

@ -94,9 +94,10 @@ let main () =
debug "initial big map is ok" ;
let call tc input result =
Lwt.return (parse_expr input) >>=? fun parameters ->
let gas = Proto_alpha.Alpha_context.Constants.hard_gas_limit_per_operation tc in
Helpers.Operation.transaction_full
src contract (Helpers_cast.cents_of_int 100_00)
(Helpers_cast.ctxt_of_tc tc)
gas (Helpers_cast.ctxt_of_tc tc)
~parameters >>=?? fun op ->
Helpers.Apply.operation ~tc
~src pred.Helpers_block.hash

2
src/proto_alpha/lib_protocol/test/test_michelson.ml
View File

@ -287,7 +287,7 @@ let test_example () =
test_output ~location: __LOC__ "exec_concat" "Unit" "\"test\"" "\"test_abc\"" >>=? fun _ ->
(* Get current steps to quota *)
test_output ~location: __LOC__ "steps_to_quota" "Unit" "Unit" "39968" >>=? fun _ ->
test_output ~location: __LOC__ "steps_to_quota" "Unit" "Unit" "39989" >>=? fun _ ->
let bootstrap_0 = List.nth Account.bootstrap_accounts 0 in
get_balance_res bootstrap_0 sb >>=?? fun _balance ->