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

Alpha: Storage burn hapens at the end of manager operations

Browse Source
This commit is contained in:
Pierre Chambart 2018-06-22 00:01:29 +02:00
parent 1e9a6e9941
commit a754672bcf
13 changed files with 126 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL
View File

@ -52,11 +52,11 @@
"Vote_storage",
"Commitment_storage",
"Init_storage",
"Fees",
"Alpha_context",
"Script_typed_ir",
"Fees",
"Script_tc_errors",
"Michelson_v1_gas",
"Script_ir_annot",

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

@ -54,6 +54,7 @@ module Script = struct
include Michelson_v1_primitives
include Script_repr
end
module Fees = Fees
type public_key = Signature.Public_key.t
type public_key_hash = Signature.Public_key_hash.t

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

@ -578,8 +578,6 @@ module Contract : sig
val set_storage_unlimited: context -> context
val used_storage_space: context -> t -> Z.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
val increment_counter:
context -> contract -> context tzresult Lwt.t
@ -895,6 +893,21 @@ type packed_internal_operation =
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
val record_paid_storage_space:
context -> Contract.t -> (context * Z.t * Tez.t) tzresult Lwt.t
val with_fees_for_storage:
context -> payer:Contract.t ->
(context -> (context * 'a) tzresult Lwt.t) ->
(context * 'a) tzresult Lwt.t
end
module Operation : sig
type nonrec 'kind contents = 'kind contents

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

@ -398,8 +398,8 @@ let apply_manager_operation_content :
Contract.used_storage_space ctxt destination >>=? fun old_size ->
Contract.update_script_storage
ctxt destination storage big_map_diff >>=? fun ctxt ->
Fees.update_script_storage
ctxt ~payer destination >>=? fun (ctxt, new_size, fees) ->
Fees.record_paid_storage_space
ctxt destination >>=? fun (ctxt, new_size, fees) ->
Contract.originated_from_current_nonce
~since: before_operation
~until: ctxt >>=? fun originated_contracts ->
@ -440,12 +440,14 @@ let apply_manager_operation_content :
~manager ~delegate ~balance:credit
?script
~spendable ~delegatable >>=? fun ctxt ->
Fees.origination_burn ctxt ~payer contract >>=? fun (ctxt, size, fees) ->
Fees.origination_burn ctxt ~payer >>=? fun (ctxt, orignation_burn) ->
Fees.record_paid_storage_space ctxt contract >>=? fun (ctxt, size, fees) ->
Lwt.return Tez.(orignation_burn +? fees) >>=? fun all_fees ->
let result =
Origination_result
{ balance_updates =
cleanup_balance_updates
[ Contract payer, Debited fees ;
[ Contract payer, Debited all_fees ;
Contract source, Debited credit ;
Contract contract, Credited credit ] ;
originated_contracts = [ contract ] ;
@ -516,22 +518,24 @@ let apply_manager_contents
Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt ->
Lwt.return (Contract.set_storage_limit ctxt storage_limit) >>=? fun ctxt ->
let level = Level.current ctxt in
apply_manager_operation_content ctxt mode
~source ~payer:source ~internal:false operation >>= begin function
| Ok (ctxt, operation_results, internal_operations) -> begin
apply_internal_manager_operations
ctxt mode ~payer:source internal_operations >>= function
| Ok (ctxt, internal_operations_results) ->
return (ctxt,
Applied operation_results, internal_operations_results)
| Error internal_operations_results ->
return (ctxt (* backtracked *),
Applied operation_results, internal_operations_results)
end
| Error operation_results ->
return (ctxt (* backtracked *),
Failed (manager_kind operation, operation_results), [])
end >>=? fun (ctxt, operation_result, internal_operation_results) ->
Fees.with_fees_for_storage ctxt ~payer:source begin fun ctxt ->
apply_manager_operation_content ctxt mode
~source ~payer:source ~internal:false operation >>= begin function
| Ok (ctxt, operation_results, internal_operations) -> begin
apply_internal_manager_operations
ctxt mode ~payer:source internal_operations >>= function
| Ok (ctxt, internal_operations_results) ->
return (ctxt,
(Applied operation_results, internal_operations_results))
| Error internal_operations_results ->
return (ctxt (* backtracked *),
(Applied operation_results, internal_operations_results))
end
| Error operation_results ->
return (ctxt (* backtracked *),
(Failed (manager_kind operation, operation_results), []))
end
end >>=? fun (ctxt, (operation_result, internal_operation_results)) ->
return (ctxt,
Manager_operation_result
{ balance_updates =

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

@ -99,7 +99,7 @@ let default = {
| Ok c -> c
| Error _ -> assert false
end ;
origination_burn = Tez_repr.one ;
origination_burn = Tez_repr.of_mutez_exn 257L ;
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) ;

25
src/proto_alpha/lib_protocol/src/contract_storage.ml
View File

@ -225,7 +225,7 @@ let create_base c contract
let total_size = Z.add (Z.add (Z.of_int code_size) (Z.of_int storage_size)) big_map_size in
assert Compare.Z.(total_size >= Z.zero) ;
Storage.Contract.Used_storage_space.init c contract total_size >>=? fun c ->
Storage.Contract.Paid_storage_space_fees.init c contract Tez_repr.zero
Storage.Contract.Paid_storage_space.init c contract Z.zero
| None ->
return c) >>=? fun c ->
return c
@ -252,7 +252,7 @@ let delete c contract =
Storage.Contract.Counter.delete c contract >>=? fun c ->
Storage.Contract.Code.remove c contract >>=? fun (c, _) ->
Storage.Contract.Storage.remove c contract >>=? fun (c, _) ->
Storage.Contract.Paid_storage_space_fees.remove c contract >>= fun c ->
Storage.Contract.Paid_storage_space.remove c contract >>= fun c ->
Storage.Contract.Used_storage_space.remove c contract >>= fun c ->
return c
@ -461,18 +461,19 @@ let used_storage_space c contract =
| None -> return Z.zero
| Some fees -> return fees
let paid_storage_space_fees c contract =
Storage.Contract.Paid_storage_space_fees.get_option c contract >>=? function
| None -> return Tez_repr.zero
| Some paid_fees -> return paid_fees
let paid_storage_space c contract =
Storage.Contract.Paid_storage_space.get_option c contract >>=? function
| None -> return Z.zero
| Some paid_space -> return paid_space
let pay_for_storage_space c contract fees =
if Tez_repr.equal fees Tez_repr.zero then
return c
let record_paid_storage_space c contract paid_storage =
Storage.Contract.Paid_storage_space.get c contract >>=? fun already_paid_fees ->
if Compare.Z.(already_paid_fees < paid_storage) then
return (Z.zero, c)
else
Storage.Contract.Paid_storage_space_fees.get c contract >>=? fun paid_fees ->
Lwt.return (Tez_repr.(paid_fees +? fees)) >>=? fun paid_fees ->
Storage.Contract.Paid_storage_space_fees.set c contract paid_fees
let to_pay = Z.sub paid_storage already_paid_fees in
Storage.Contract.Paid_storage_space.set c contract paid_storage >>=? fun c ->
return (to_pay, c)
module Big_map = struct
let mem ctxt contract key =

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

@ -103,8 +103,8 @@ val init:
Raw_context.t -> Raw_context.t tzresult Lwt.t
val used_storage_space: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
val paid_storage_space_fees: Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
val pay_for_storage_space: Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
val paid_storage_space: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
val record_paid_storage_space: Raw_context.t -> Contract_repr.t -> Z.t -> (Z.t * Raw_context.t) tzresult Lwt.t
module Big_map : sig
val mem :

53
src/proto_alpha/lib_protocol/src/fees.ml
View File

@ -7,8 +7,6 @@
(* *)
(**************************************************************************)
open Alpha_context
type error += Cannot_pay_storage_fee
let () =
@ -23,29 +21,30 @@ let () =
(fun () -> Cannot_pay_storage_fee)
let origination_burn c ~payer contract =
let origination_burn = Constants.origination_burn c in
Contract.spend_from_script c payer origination_burn >>=? fun c ->
Contract.used_storage_space c contract >>=? fun size ->
let cost_per_byte = Constants.cost_per_byte c in
Lwt.return (Tez.(cost_per_byte *? (Z.to_int64 size))) >>=? fun fees ->
trace Cannot_pay_storage_fee
(Contract.spend_from_script c payer fees >>=? fun c ->
Contract.pay_for_storage_space c contract fees) >>=? fun c ->
return (c, size, fees)
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 update_script_storage c ~payer contract =
Contract.paid_storage_space_fees c contract >>=? fun paid_fees ->
Contract.used_storage_space c contract >>=? fun size ->
let cost_per_byte = Constants.cost_per_byte c in
Lwt.return (Tez.(cost_per_byte *? (Z.to_int64 size))) >>=? fun fees ->
match Tez.(fees -? paid_fees) with
| Error _ ->
(* Previously paid fees are greater than required fees. *)
return (c, size, Tez.zero)
| Ok to_be_paid ->
(* Burning the fees... *)
trace Cannot_pay_storage_fee
(Contract.spend_from_script c payer to_be_paid >>=? fun c ->
Contract.pay_for_storage_space c contract to_be_paid) >>=? fun c ->
return (c, size, to_be_paid)
let record_paid_storage_space c contract =
Contract_storage.used_storage_space c contract >>=? fun size ->
Contract_storage.record_paid_storage_space c contract size >>=? fun (to_be_paid, c) ->
Lwt.return (Raw_context.update_storage_space_to_pay c to_be_paid) >>=? fun c ->
let cost_per_byte = Constants_storage.cost_per_byte c in
Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 to_be_paid))) >>=? fun to_burn ->
return (c, size, to_burn)
let burn_fees_for_storage c ~payer =
let c, storage_space_to_pay = Raw_context.clear_storage_space_to_pay c in
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 ->
(* Burning the fees... *)
trace Cannot_pay_storage_fee
(Contract_storage.spend_from_script c payer to_burn) >>=? fun c ->
return c
let with_fees_for_storage c ~payer f =
Lwt.return (Raw_context.init_storage_space_to_pay c) >>=? fun c ->
f c >>=? fun (c, ret) ->
burn_fees_for_storage c ~payer >>=? fun c ->
return (c, ret)

17
src/proto_alpha/lib_protocol/src/fees.mli
View File

@ -7,14 +7,17 @@
(* *)
(**************************************************************************)
open Alpha_context
type error += Cannot_pay_storage_fee
val origination_burn:
Alpha_context.t -> payer:Contract.t ->
Contract.t -> (Alpha_context.t * Z.t * Tez.t) tzresult Lwt.t
Raw_context.t -> payer:Contract_repr.t -> (Raw_context.t * Tez_repr.t) tzresult Lwt.t
val update_script_storage:
Alpha_context.t -> payer:Contract.t ->
Contract.t -> (Alpha_context.t * Z.t * Tez.t) tzresult Lwt.t
(** The returned Tez quantity is for logging purpose only *)
val record_paid_storage_space:
Raw_context.t -> Contract_repr.t ->
(Raw_context.t * Z.t * Tez_repr.t) tzresult Lwt.t
val with_fees_for_storage:
Raw_context.t -> payer:Contract_repr.t ->
(Raw_context.t -> (Raw_context.t * 'a) tzresult Lwt.t) ->
(Raw_context.t * 'a) tzresult Lwt.t

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

@ -23,6 +23,7 @@ type t = {
rewards: Tez_repr.t ;
block_gas: Z.t ;
operation_gas: Gas_limit_repr.t ;
storage_space_to_pay: Z.t option ;
block_storage: Z.t ;
operation_storage: Storage_limit_repr.t ;
origination_nonce: Contract_repr.origination_nonce option ;
@ -181,6 +182,27 @@ let gas_consumed ~since ~until =
type error += Storage_limit_too_high (* `Permanent *)
let init_storage_space_to_pay ctxt =
match ctxt.storage_space_to_pay with
| Some _ ->
assert false
| None ->
ok { ctxt with storage_space_to_pay = Some Z.zero }
let update_storage_space_to_pay ctxt n =
match ctxt.storage_space_to_pay with
| None ->
assert false
| Some storage_space_to_pay ->
ok { 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
| None ->
assert false
| Some storage_space_to_pay ->
{ ctxt with storage_space_to_pay = None }, storage_space_to_pay
let () =
let open Data_encoding in
register_error_kind
@ -427,6 +449,7 @@ let prepare ~level ~timestamp ~fitness ctxt =
rewards = Tez_repr.zero ;
deposits = Signature.Public_key_hash.Map.empty ;
operation_gas = Unaccounted ;
storage_space_to_pay = None ;
block_gas = constants.Constants_repr.hard_gas_limit_per_block ;
operation_storage = Unaccounted ;
block_storage = constants.Constants_repr.hard_storage_limit_per_block ;
@ -475,6 +498,7 @@ let register_resolvers enc resolve =
timestamp = Time.of_seconds 0L ;
fitness = 0L ;
allowed_endorsements = Signature.Public_key_hash.Map.empty ;
storage_space_to_pay = None ;
fees = Tez_repr.zero ;
rewards = Tez_repr.zero ;
deposits = Signature.Public_key_hash.Map.empty ;

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

@ -88,6 +88,10 @@ val block_gas_level: t -> Z.t
type error += Storage_limit_too_high (* `Permanent *)
val init_storage_space_to_pay: t -> t tzresult
val update_storage_space_to_pay: t -> Z.t -> t tzresult
val clear_storage_space_to_pay: t -> t * Z.t
val set_storage_limit: t -> Z.t -> t tzresult
val set_storage_unlimited: t -> t

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

@ -172,10 +172,10 @@ module Contract = struct
let encoding = Script_repr.expr_encoding
end)
module Paid_storage_space_fees =
module Paid_storage_space =
Indexed_context.Make_map
(struct let name = ["paid_bytes"] end)
(Tez_repr)
(Z)
module Used_storage_space =
Indexed_context.Make_map

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

@ -179,10 +179,10 @@ module Contract : sig
and type value = Z.t
and type t := Raw_context.t
(** Total fees burnt for storage space. *)
module Paid_storage_space_fees : Indexed_data_storage
(** Maximal space available without needing to burn new fees. *)
module Paid_storage_space : Indexed_data_storage
with type key = Contract_repr.t
and type value = Tez_repr.t
and type value = Z.t
and type t := Raw_context.t
type bigmap_key = Raw_context.t * Contract_repr.t