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

Alpha: count origination burn towards storage limit

Browse Source
This commit is contained in:
Tom Jack 2018-11-22 14:43:58 -08:00 committed by Pierre Boutillier
parent 94378f9809
commit 9afdd9b167
No known key found for this signature in database
GPG Key ID: C2F73508B56A193C
22 changed files with 133 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/lib_shell/bench/helpers/block.ml
View File

@ -302,7 +302,7 @@ let genesis
?(tokens_per_roll = Constants_repr.default.tokens_per_roll)
?(michelson_maximum_type_size = Constants_repr.default.michelson_maximum_type_size)
?(seed_nonce_revelation_tip = Constants_repr.default.seed_nonce_revelation_tip)
?(origination_burn = Constants_repr.default.origination_burn)
?(origination_size = Constants_repr.default.origination_size)
?(block_security_deposit = Constants_repr.default.block_security_deposit)
?(endorsement_security_deposit = Constants_repr.default.endorsement_security_deposit)
?(block_reward = Constants_repr.default.block_reward)
@ -324,7 +324,7 @@ let genesis
tokens_per_roll ;
michelson_maximum_type_size ;
seed_nonce_revelation_tip ;
origination_burn ;
origination_size ;
block_security_deposit ;
endorsement_security_deposit ;
block_reward ;

2
src/lib_shell/bench/helpers/block.mli
View File

@ -110,7 +110,7 @@ val genesis:
?tokens_per_roll:Tez_repr.tez ->
?michelson_maximum_type_size:int ->
?seed_nonce_revelation_tip:Tez_repr.tez ->
?origination_burn:Tez_repr.tez ->
?origination_size:int ->
?block_security_deposit:Tez_repr.tez ->
?endorsement_security_deposit:Tez_repr.tez ->
?block_reward:Tez_repr.tez ->

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

@ -141,13 +141,19 @@ let rec estimated_gas :
let estimated_storage_single
(type kind)
origination_size
(Manager_operation_result { operation_result ;
internal_operation_results }
: kind Kind.manager contents_result) =
let storage_size_diff (type kind) (result : kind manager_operation_result) =
match result with
| Applied (Transaction_result { paid_storage_size_diff }) -> Ok paid_storage_size_diff
| Applied (Origination_result { paid_storage_size_diff }) -> Ok paid_storage_size_diff
| Applied (Transaction_result { paid_storage_size_diff ; allocated_destination_contract }) ->
if allocated_destination_contract then
Ok (Z.add paid_storage_size_diff origination_size)
else
Ok paid_storage_size_diff
| Applied (Origination_result { paid_storage_size_diff }) ->
Ok (Z.add paid_storage_size_diff origination_size)
| Applied Reveal_result -> Ok Z.zero
| Applied Delegation_result -> Ok Z.zero
| Skipped _ -> assert false
@ -161,13 +167,13 @@ let estimated_storage_single
Ok (Z.add acc storage))
(storage_size_diff operation_result) internal_operation_results
let estimated_storage res =
let estimated_storage origination_size res =
let rec estimated_storage :
type kind. kind Kind.manager contents_result_list -> _ =
function
| Single_result res -> estimated_storage_single res
| Single_result res -> estimated_storage_single origination_size res
| Cons_result (res, rest) ->
estimated_storage_single res >>? fun storage1 ->
estimated_storage_single origination_size res >>? fun storage1 ->
estimated_storage rest >>? fun storage2 ->
Ok (Z.add storage1 storage2) in
estimated_storage res >>? fun diff ->
@ -254,6 +260,7 @@ let may_patch_limits
(chain, block) >>=? fun { parametric = {
hard_gas_limit_per_operation = gas_limit ;
hard_storage_limit_per_operation = storage_limit ;
origination_size ;
} } ->
let may_need_patching_single
: type kind. kind contents -> kind contents option = function
@ -309,7 +316,7 @@ let may_patch_limits
end >>=? fun gas_limit ->
begin
if c.storage_limit < Z.zero || storage_limit <= c.storage_limit then
Lwt.return (estimated_storage_single result) >>=? fun storage ->
Lwt.return (estimated_storage_single (Z.of_int origination_size) result) >>=? fun storage ->
begin
if Z.equal storage Z.zero then
cctxt#message "Estimated storage: no bytes added" >>= fun () ->

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

@ -372,7 +372,7 @@ module Constants : sig
tokens_per_roll: Tez.t ;
michelson_maximum_type_size: int;
seed_nonce_revelation_tip: Tez.t ;
origination_burn: Tez.t ;
origination_size: int ;
block_security_deposit: Tez.t ;
endorsement_security_deposit: Tez.t ;
block_reward: Tez.t ;
@ -399,7 +399,7 @@ module Constants : sig
val block_reward: context -> Tez.t
val endorsement_reward: context -> Tez.t
val seed_nonce_revelation_tip: context -> Tez.t
val origination_burn: context -> Tez.t
val origination_size: context -> int
val block_security_deposit: context -> Tez.t
val endorsement_security_deposit: context -> Tez.t
@ -950,7 +950,7 @@ val manager_kind: 'kind manager_operation -> 'kind Kind.manager
module Fees : sig
val origination_burn:
context -> payer:Contract.t -> (context * Tez.t) tzresult Lwt.t
context -> (context * Tez.t) tzresult Lwt.t
val record_paid_storage_space:
context -> Contract.t -> (context * Z.t * Z.t * Tez.t) tzresult Lwt.t

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

@ -374,14 +374,14 @@ let apply_manager_operation_content :
| Transaction { amount ; parameters ; destination } -> begin
spend ctxt source amount >>=? fun ctxt ->
begin match Contract.is_implicit destination with
| None -> return (ctxt, [])
| None -> return (ctxt, [], false)
| Some _ ->
Contract.allocated ctxt destination >>=? function
| true -> return (ctxt, [])
| true -> return (ctxt, [], false)
| false ->
Fees.origination_burn ctxt ~payer >>=? fun (ctxt, orignation_burn) ->
return (ctxt, [ Delegate.Contract payer, Delegate.Debited orignation_burn ])
end >>=? fun (ctxt, maybe_burn_balance_update) ->
Fees.origination_burn ctxt >>=? fun (ctxt, origination_burn) ->
return (ctxt, [ Delegate.Contract payer, Delegate.Debited origination_burn ], true)
end >>=? fun (ctxt, maybe_burn_balance_update, allocated_destination_contract) ->
Contract.credit ctxt destination amount >>=? fun ctxt ->
Contract.get_script ctxt destination >>=? fun (ctxt, script) ->
match script with
@ -414,6 +414,7 @@ let apply_manager_operation_content :
consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt ;
storage_size = Z.zero ;
paid_storage_size_diff = Z.zero ;
allocated_destination_contract ;
} in
return (ctxt, result, [])
| Some script ->
@ -451,7 +452,8 @@ let apply_manager_operation_content :
originated_contracts ;
consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt ;
storage_size = new_size ;
paid_storage_size_diff } in
paid_storage_size_diff ;
allocated_destination_contract } in
return (ctxt, result, operations)
end
| Origination { manager ; delegate ; script ; preorigination ;
@ -482,14 +484,14 @@ let apply_manager_operation_content :
~manager ~delegate ~balance:credit
?script
~spendable ~delegatable >>=? fun ctxt ->
Fees.origination_burn ctxt ~payer >>=? fun (ctxt, orignation_burn) ->
Fees.origination_burn ctxt >>=? fun (ctxt, origination_burn) ->
Fees.record_paid_storage_space ctxt contract >>=? fun (ctxt, size, paid_storage_size_diff, fees) ->
Lwt.return Tez.(orignation_burn +? fees) >>=? fun all_fees ->
let result =
Origination_result
{ balance_updates =
Delegate.cleanup_balance_updates
[ Contract payer, Debited all_fees ;
[ Contract payer, Debited fees ;
Contract payer, Debited origination_burn ;
Contract source, Debited credit ;
Contract contract, Credited credit ] ;
originated_contracts = [ contract ] ;

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

@ -51,6 +51,7 @@ type _ successful_manager_operation_result =
consumed_gas : Z.t ;
storage_size : Z.t ;
paid_storage_size_diff : Z.t ;
allocated_destination_contract : bool ;
} -> Kind.transaction successful_manager_operation_result
| Origination_result :
{ balance_updates : Delegate.balance_updates ;
@ -164,14 +165,15 @@ module Manager_result = struct
make
~op_case: Operation.Encoding.Manager_operations.transaction_case
~encoding:
(obj7
(obj8
(opt "storage" Script.expr_encoding)
(opt "big_map_diff" Contract.big_map_diff_encoding)
(dft "balance_updates" Delegate.balance_updates_encoding [])
(dft "originated_contracts" (list Contract.encoding) [])
(dft "consumed_gas" z Z.zero)
(dft "storage_size" z Z.zero)
(dft "paid_storage_size_diff" z Z.zero))
(dft "paid_storage_size_diff" z Z.zero)
(dft "allocated_destination_contract" bool false))
~iselect:
(function
| Internal_operation_result
@ -188,17 +190,21 @@ module Manager_result = struct
| Transaction_result
{ storage ; big_map_diff ; balance_updates ;
originated_contracts ; consumed_gas ;
storage_size ; paid_storage_size_diff } ->
storage_size ; paid_storage_size_diff ;
allocated_destination_contract } ->
(storage, big_map_diff, balance_updates,
originated_contracts, consumed_gas,
storage_size, paid_storage_size_diff))
storage_size, paid_storage_size_diff,
allocated_destination_contract))
~inj:
(fun (storage, big_map_diff, balance_updates,
originated_contracts, consumed_gas,
storage_size, paid_storage_size_diff) ->
storage_size, paid_storage_size_diff,
allocated_destination_contract) ->
Transaction_result { storage ; big_map_diff ; balance_updates ;
originated_contracts ; consumed_gas ;
storage_size ; paid_storage_size_diff })
storage_size ; paid_storage_size_diff ;
allocated_destination_contract })
let origination_case =
make

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

@ -95,6 +95,7 @@ and _ successful_manager_operation_result =
consumed_gas : Z.t ;
storage_size : Z.t ;
paid_storage_size_diff : Z.t ;
allocated_destination_contract : bool ;
} -> Kind.transaction successful_manager_operation_result
| Origination_result :
{ balance_updates : Delegate.balance_updates ;

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

@ -87,7 +87,7 @@ type parametric = {
tokens_per_roll: Tez_repr.t ;
michelson_maximum_type_size: int;
seed_nonce_revelation_tip: Tez_repr.t ;
origination_burn: Tez_repr.t ;
origination_size: int ;
block_security_deposit: Tez_repr.t ;
endorsement_security_deposit: Tez_repr.t ;
block_reward: Tez_repr.t ;
@ -117,7 +117,7 @@ let default = {
| Ok c -> c
| Error _ -> assert false
end ;
origination_burn = Tez_repr.of_mutez_exn 257_000L ;
origination_size = 257 ;
block_security_deposit = Tez_repr.(mul_exn one 512) ;
endorsement_security_deposit = Tez_repr.(mul_exn one 64) ;
block_reward = Tez_repr.(mul_exn one 16) ;
@ -145,7 +145,7 @@ let parametric_encoding =
c.tokens_per_roll,
c.michelson_maximum_type_size,
c.seed_nonce_revelation_tip,
c.origination_burn,
c.origination_size,
c.block_security_deposit,
c.endorsement_security_deposit,
c.block_reward),
@ -165,7 +165,7 @@ let parametric_encoding =
tokens_per_roll,
michelson_maximum_type_size,
seed_nonce_revelation_tip,
origination_burn,
origination_size,
block_security_deposit,
endorsement_security_deposit,
block_reward),
@ -185,7 +185,7 @@ let parametric_encoding =
tokens_per_roll ;
michelson_maximum_type_size ;
seed_nonce_revelation_tip ;
origination_burn ;
origination_size ;
block_security_deposit ;
endorsement_security_deposit ;
block_reward ;
@ -210,7 +210,7 @@ let parametric_encoding =
(req "tokens_per_roll" Tez_repr.encoding)
(req "michelson_maximum_type_size" uint16)
(req "seed_nonce_revelation_tip" Tez_repr.encoding)
(req "origination_burn" Tez_repr.encoding)
(req "origination_size" int31)
(req "block_security_deposit" Tez_repr.encoding)
(req "endorsement_security_deposit" Tez_repr.encoding)
(req "block_reward" Tez_repr.encoding))

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

@ -68,9 +68,9 @@ let michelson_maximum_type_size c =
let seed_nonce_revelation_tip c =
let constants = Raw_context.constants c in
constants.seed_nonce_revelation_tip
let origination_burn c =
let origination_size c =
let constants = Raw_context.constants c in
constants.origination_burn
constants.origination_size
let block_security_deposit c =
let constants = Raw_context.constants c in
constants.block_security_deposit

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

@ -58,10 +58,14 @@ let () =
(function Storage_limit_too_high -> Some () | _ -> None)
(fun () -> Storage_limit_too_high)
let origination_burn c ~payer =
let origination_burn = Constants_storage.origination_burn c in
Contract_storage.spend_from_script c payer origination_burn >>=? fun c ->
return (c, origination_burn)
let origination_burn c =
let origination_size = Constants_storage.origination_size c in
let cost_per_byte = Constants_storage.cost_per_byte c in
(* the origination burn, measured in bytes *)
Lwt.return
Tez_repr.(cost_per_byte *? (Int64.of_int origination_size)) >>=? fun to_be_paid ->
return (Raw_context.update_allocated_contracts_count c,
to_be_paid)
let record_paid_storage_space c contract =
Contract_storage.used_storage_space c contract >>=? fun size ->
@ -72,13 +76,19 @@ let record_paid_storage_space c contract =
return (c, size, to_be_paid, to_burn)
let burn_storage_fees c ~storage_limit ~payer =
let c, storage_space_to_pay = Raw_context.clear_storage_space_to_pay c in
let remaining = Z.sub storage_limit storage_space_to_pay in
let origination_size = Constants_storage.origination_size c in
let c, storage_space_to_pay, allocated_contracts =
Raw_context.clear_storage_space_to_pay c in
let storage_space_for_allocated_contracts =
Z.mul (Z.of_int allocated_contracts) (Z.of_int origination_size) in
let consumed =
Z.add storage_space_to_pay storage_space_for_allocated_contracts in
let remaining = Z.sub storage_limit consumed in
if Compare.Z.(remaining < Z.zero) then
fail Operation_quota_exceeded
else
let cost_per_byte = Constants_storage.cost_per_byte c in
Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 storage_space_to_pay))) >>=? fun to_burn ->
Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 consumed))) >>=? fun to_burn ->
(* Burning the fees... *)
if Tez_repr.(to_burn = Tez_repr.zero) then
(* If the payer was was deleted by transfering all its balance, and no space was used,

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

@ -27,8 +27,9 @@ type error += Cannot_pay_storage_fee (* `Temporary *)
type error += Operation_quota_exceeded (* `Temporary *)
type error += Storage_limit_too_high (* `Permanent *)
(** Does not burn, only adds the burn to storage space to be paid *)
val origination_burn:
Raw_context.t -> payer:Contract_repr.t -> (Raw_context.t * Tez_repr.t) tzresult Lwt.t
Raw_context.t -> (Raw_context.t * Tez_repr.t) tzresult Lwt.t
(** The returned Tez quantity is for logging purpose only *)
val record_paid_storage_space:

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

@ -135,9 +135,9 @@ let constants_encoding =
and seed_nonce_revelation_tip =
opt Tez_repr.(=)
default.seed_nonce_revelation_tip c.seed_nonce_revelation_tip
and origination_burn =
opt Tez_repr.(=)
default.origination_burn c.origination_burn
and origination_size =
opt Compare.Int.(=)
default.origination_size c.origination_size
and block_security_deposit =
opt Tez_repr.(=)
default.block_security_deposit c.block_security_deposit
@ -170,7 +170,7 @@ let constants_encoding =
tokens_per_roll,
michelson_maximum_type_size,
seed_nonce_revelation_tip,
origination_burn,
origination_size,
block_security_deposit,
endorsement_security_deposit,
block_reward),
@ -190,7 +190,7 @@ let constants_encoding =
tokens_per_roll,
michelson_maximum_type_size,
seed_nonce_revelation_tip,
origination_burn,
origination_size,
block_security_deposit,
endorsement_security_deposit,
block_reward),
@ -226,8 +226,8 @@ let constants_encoding =
unopt default.michelson_maximum_type_size michelson_maximum_type_size ;
seed_nonce_revelation_tip =
unopt default.seed_nonce_revelation_tip seed_nonce_revelation_tip ;
origination_burn =
unopt default.origination_burn origination_burn ;
origination_size =
unopt default.origination_size origination_size ;
block_security_deposit =
unopt default.block_security_deposit block_security_deposit ;
endorsement_security_deposit =
@ -258,7 +258,7 @@ let constants_encoding =
(opt "tokens_per_roll" Tez_repr.encoding)
(opt "michelson_maximum_type_size" uint16)
(opt "seed_nonce_revelation_tip" Tez_repr.encoding)
(opt "origination_burn" Tez_repr.encoding)
(opt "origination_size" int31)
(opt "block_security_deposit" Tez_repr.encoding)
(opt "endorsement_security_deposit" Tez_repr.encoding)
(opt "block_reward" Tez_repr.encoding))

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

@ -40,6 +40,7 @@ type t = {
block_gas: Z.t ;
operation_gas: Gas_limit_repr.t ;
storage_space_to_pay: Z.t option ;
allocated_contracts: int option ;
origination_nonce: Contract_repr.origination_nonce option ;
internal_nonce: int ;
internal_nonces_used: Int_set.t ;
@ -203,7 +204,7 @@ let init_storage_space_to_pay ctxt =
| Some _ ->
assert false
| None ->
{ ctxt with storage_space_to_pay = Some Z.zero }
{ ctxt with storage_space_to_pay = Some Z.zero ; allocated_contracts = Some 0 }
let update_storage_space_to_pay ctxt n =
match ctxt.storage_space_to_pay with
@ -212,12 +213,22 @@ let update_storage_space_to_pay ctxt n =
| Some storage_space_to_pay ->
{ ctxt with storage_space_to_pay = Some (Z.add n storage_space_to_pay) }
let clear_storage_space_to_pay ctxt =
match ctxt.storage_space_to_pay with
let update_allocated_contracts_count ctxt =
match ctxt.allocated_contracts with
| None ->
assert false
| Some storage_space_to_pay ->
{ ctxt with storage_space_to_pay = None }, storage_space_to_pay
| Some allocated_contracts ->
{ ctxt with allocated_contracts = Some (succ allocated_contracts) }
let clear_storage_space_to_pay ctxt =
match ctxt.storage_space_to_pay, ctxt.allocated_contracts with
| None, _ | _, None ->
assert false
| Some storage_space_to_pay, Some allocated_contracts ->
{ ctxt with storage_space_to_pay = None ;
allocated_contracts = None},
storage_space_to_pay,
allocated_contracts
type storage_error =
| Incompatible_protocol_version of string
@ -442,6 +453,7 @@ let prepare ~level ~timestamp ~fitness ctxt =
deposits = Signature.Public_key_hash.Map.empty ;
operation_gas = Unaccounted ;
storage_space_to_pay = None ;
allocated_contracts = None ;
block_gas = constants.Constants_repr.hard_gas_limit_per_block ;
origination_nonce = None ;
internal_nonce = 0 ;
@ -502,6 +514,7 @@ let register_resolvers enc resolve =
fitness = 0L ;
allowed_endorsements = Signature.Public_key_hash.Map.empty ;
storage_space_to_pay = None ;
allocated_contracts = None ;
fees = Tez_repr.zero ;
rewards = Tez_repr.zero ;
deposits = Signature.Public_key_hash.Map.empty ;

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

@ -119,7 +119,8 @@ val block_gas_level: t -> Z.t
val init_storage_space_to_pay: t -> t
val update_storage_space_to_pay: t -> Z.t -> t
val clear_storage_space_to_pay: t -> t * Z.t
val update_allocated_contracts_count: t -> t
val clear_storage_space_to_pay: t -> t * Z.t * int
type error += Undefined_operation_nonce (* `Permanent *)

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

@ -70,7 +70,7 @@ let multiple_origination_and_delegation () =
Context.init 2 >>=? fun (blk, contracts) ->
let c1 = List.nth contracts 0 in
let n = 10 in
Context.get_constants (B blk) >>=? fun { parametric = { origination_burn } } ->
Context.get_constants (B blk) >>=? fun { parametric = { origination_size ; cost_per_byte } } ->
Context.Contract.pkh c1 >>=? fun delegate_pkh ->
let new_accounts = List.map (fun _ -> Account.new_account ()) (1 -- n) in
@ -111,6 +111,7 @@ let multiple_origination_and_delegation () =
) tickets in
(* Previous balance - (Credit (n * 10tz) + Origination cost (n tz)) *)
Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
Tez.(origination_burn *? (Int64.of_int n)) >>?= fun origination_total_cost ->
Tez.((Tez.of_int (10 * n)) +? origination_total_cost) >>?= fun total_cost ->
Assert.balance_was_debited ~loc:__LOC__

11
src/proto_alpha/lib_protocol/test/delegation.ml
View File

@ -150,7 +150,8 @@ let delegate_to_bootstrap_by_origination ~fee () =
Context.Contract.balance (I i) bootstrap >>=? fun balance ->
(* originate a contract with bootstrap's manager as delegate *)
Op.origination ~fee ~credit:Tez.zero ~delegate:manager.pkh (I i) bootstrap >>=? fun (op, orig_contract) ->
Context.get_constants (I i) >>=? fun { parametric = { origination_burn ; _ }} -> (* 0.257tz *)
Context.get_constants (I i) >>=? fun { parametric = { origination_size ; cost_per_byte ; _ }} -> (* 0.257tz *)
Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
Lwt.return (Tez.(+?) fee origination_burn) >>=? fun total_fee ->
if fee > balance then
begin
@ -258,7 +259,7 @@ let tests_bootstrap_contracts = [
Test.tztest "bootstrap keys are already registered as delegate keys (max fee)" `Quick (bootstrap_manager_already_registered_delegate ~fee:Tez.max_tez) ;
Test.tztest "bootstrap manager can be delegate (init origination, small fee)" `Quick (delegate_to_bootstrap_by_origination ~fee:Tez.one_mutez) ;
(* balance enough for fee but not for fee + origination burn *)
Test.tztest "bootstrap manager can be delegate (init origination, edge case)" `Quick (delegate_to_bootstrap_by_origination ~fee:(Tez.of_mutez_exn 3_999_999_750_000L)) ;
Test.tztest "bootstrap manager can be delegate (init origination, edge case)" `Quick (delegate_to_bootstrap_by_origination ~fee:(Tez.of_mutez_exn 3_999_999_743_000L)) ;
(* fee bigger than bootstrap's initial balance*)
Test.tztest "bootstrap manager can be delegate (init origination, large fee)" `Quick (delegate_to_bootstrap_by_origination ~fee:(Tez.of_int 10_000_000)) ;
Test.tztest "bootstrap manager can be delegate (init delegation, small fee)" `Quick (delegate_to_bootstrap_by_delegation ~fee:Tez.one_mutez) ;
@ -337,7 +338,8 @@ let unregistered_delegate_key_init_origination ~fee () =
let unregistered_pkh = Account.(unregistered_account.pkh) in
(* origination with delegate argument *)
Op.origination ~fee ~delegate:unregistered_pkh (I i) bootstrap >>=? fun (op, orig_contract) ->
Context.get_constants (I i) >>=? fun { parametric = { origination_burn ; _ }} ->
Context.get_constants (I i) >>=? fun { parametric = { origination_size ; cost_per_byte ; _ }} ->
Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
Lwt.return (Tez.(+?) fee origination_burn) >>=? fun _total_fee -> (* FIXME unused variable *)
Context.Contract.balance (I i) bootstrap >>=? fun balance ->
if fee > balance then
@ -1062,7 +1064,8 @@ let registered_self_delegate_key_init_origination () =
Op.delegation (I i) contract (Some pkh) >>=? fun op ->
Incremental.add_operation i op >>=? fun i ->
Context.Contract.balance (I i) contract >>=? fun balance ->
Context.get_constants (I i) >>=? fun { parametric = { origination_burn ; _ }} ->
Context.get_constants (I i) >>=? fun { parametric = { origination_size ; cost_per_byte ; _ }} ->
Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
(* origination with delegate argument *)
Op.origination ~delegate:pkh ~credit:Tez.one (I i) contract >>=? fun (op, orig_contract) ->
Tez.(origination_burn +? Tez.one) >>?= fun total_cost ->

4
src/proto_alpha/lib_protocol/test/helpers/block.ml
View File

@ -245,7 +245,7 @@ let genesis
?(tokens_per_roll = Constants_repr.default.tokens_per_roll)
?(michelson_maximum_type_size = Constants_repr.default.michelson_maximum_type_size)
?(seed_nonce_revelation_tip = Constants_repr.default.seed_nonce_revelation_tip)
?(origination_burn = Constants_repr.default.origination_burn)
?(origination_size = Constants_repr.default.origination_size)
?(block_security_deposit = Constants_repr.default.block_security_deposit)
?(endorsement_security_deposit = Constants_repr.default.endorsement_security_deposit)
?(block_reward = Constants_repr.default.block_reward)
@ -288,7 +288,7 @@ let genesis
tokens_per_roll ;
michelson_maximum_type_size ;
seed_nonce_revelation_tip ;
origination_burn ;
origination_size ;
block_security_deposit ;
endorsement_security_deposit ;
block_reward ;

2
src/proto_alpha/lib_protocol/test/helpers/block.mli
View File

@ -103,7 +103,7 @@ val genesis:
?tokens_per_roll:Tez_repr.tez ->
?michelson_maximum_type_size:int ->
?seed_nonce_revelation_tip:Tez_repr.tez ->
?origination_burn:Tez_repr.tez ->
?origination_size:int ->
?block_security_deposit:Tez_repr.tez ->
?endorsement_security_deposit:Tez_repr.tez ->
?block_reward:Tez_repr.tez ->

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

@ -30,6 +30,6 @@ let tztest name speed f =
| Ok () -> Lwt.return_unit
| Error err ->
Tezos_stdlib_unix.Logging_unix.close () >>= fun () ->
Format.printf "WWW %a@." pp_print_error err ;
Format.printf "@.%a@." pp_print_error err ;
Lwt.fail Alcotest.Test_error
end

19
src/proto_alpha/lib_protocol/test/origination.ml
View File

@ -43,8 +43,10 @@ let register_origination ?(fee=Tez.zero) ?(credit=Tez.zero) ?spendable ?delegata
>>=? fun (operation, originated) ->
Block.bake ~operation b >>=? fun b ->
(* fee + credit + block security deposit were debited from source *)
Context.get_constants (B b) >>=? fun {parametric = {origination_burn ;
Context.get_constants (B b) >>=? fun {parametric = { origination_size ;
cost_per_byte ;
block_security_deposit }} ->
Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
Lwt.return (
Tez.(+?) credit block_security_deposit >>?
Tez.(+?) fee >>?
@ -78,10 +80,12 @@ let test_origination_balances ~loc ?(fee=Tez.zero) ?(credit=Tez.zero)
tests.*)
Context.get_constants (B b) >>=? fun
{ parametric =
{ origination_burn ;
{ origination_size ;
cost_per_byte ;
block_security_deposit
}
} ->
Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
Lwt.return (
Tez.(+?) credit block_security_deposit >>?
Tez.(+?) fee >>?
@ -259,7 +263,9 @@ let register_origination_inc ~credit () =
Context.init 1 >>=? fun (b, contracts) ->
let source_contract = List.hd contracts in
Incremental.begin_construction b >>=? fun inc ->
Op.origination (I inc) ~credit source_contract >>=? fun (operation, new_contract) ->
Op.origination (I inc)
~storage_limit:(Z.of_int Constants_repr.default.origination_size)
~credit source_contract >>=? fun (operation, new_contract) ->
Incremental.add_operation inc operation >>=? fun inc ->
return (inc, source_contract, new_contract)
@ -274,10 +280,11 @@ let origination_contract_from_origination_contract_not_enough_fund fee () =
(* contract's balance is not enough to afford origination burn *)
Op.origination ~fee (I inc) ~credit:amount contract >>=? fun (operation, orig_contract) ->
let expect_failure = function
| Alpha_environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ ->
| Alpha_environment.Ecoproto_error (Alpha_context.Fees.Cannot_pay_storage_fee) :: _ ->
return_unit
| _ ->
failwith "The contract has not enough funds, it fails!"
| e ->
failwith "The contract has not enough funds, it fails! %a"
Error_monad.pp_print_error e
in
Incremental.add_operation ~expect_failure inc operation >>=? fun inc ->
Context.Contract.balance (I inc) contract >>=? fun balance_aft ->

8
src/proto_alpha/lib_protocol/test/rolls.ml
View File

@ -25,6 +25,8 @@
open Proto_alpha
open Alpha_context
open Test_tez
open Test_utils
let account_pair = function
| [a1; a2] -> (a1, a2)
@ -153,7 +155,8 @@ let deactivation_then_empty_then_self_delegation () =
Context.Contract.balance (B b) deactivated_contract >>=? fun balance ->
let sink_account = Account.new_account () in
let sink_contract = Contract.implicit_contract sink_account.pkh in
Context.get_constants (B b) >>=? fun { parametric = { origination_burn } } ->
Context.get_constants (B b) >>=? fun { parametric = { origination_size ; cost_per_byte } } ->
Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
let amount = match Tez.(balance -? origination_burn) with Ok r -> r | Error _ -> assert false in
Op.transaction (B b) deactivated_contract sink_contract amount >>=? fun empty_contract ->
Block.bake ~policy:(By_account m2.pkh) ~operation:empty_contract b >>=? fun b ->
@ -173,7 +176,8 @@ let deactivation_then_empty_then_self_delegation_then_recredit () =
(* empty the contract *)
let sink_account = Account.new_account () in
let sink_contract = Contract.implicit_contract sink_account.pkh in
Context.get_constants (B b) >>=? fun { parametric = { origination_burn } } ->
Context.get_constants (B b) >>=? fun { parametric = { origination_size ; cost_per_byte } } ->
Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
let amount = match Tez.(balance -? origination_burn) with Ok r -> r | Error _ -> assert false in
Op.transaction (B b) deactivated_contract sink_contract amount >>=? fun empty_contract ->
Block.bake ~policy:(By_account m2.pkh) ~operation:empty_contract b >>=? fun b ->

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

@ -53,7 +53,8 @@ let transfer_and_check_balances ?(with_burn = false) ~loc b ?(fee=Tez.zero) ?exp
Context.Contract.balance (I b) dst >>=? fun bal_dst ->
Op.transaction (I b) ~fee src dst amount >>=? fun op ->
Incremental.add_operation ?expect_failure b op >>=? fun b ->
Context.get_constants (I b) >>=? fun { parametric = { origination_burn } } ->
Context.get_constants (I b) >>=? fun { parametric = { origination_size ; cost_per_byte } } ->
Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
let amount_fee_maybe_burn =
if with_burn then
match Tez.(amount_fee +? origination_burn) with