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

Alpha: storage fees accounting

Browse Source
This commit is contained in:
Benjamin Canou 2018-04-07 17:51:11 +02:00 committed by Grégoire Henry
parent be4deb44bf
commit 25a1930c32
12 changed files with 130 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -315,6 +315,7 @@ module Constants : sig
endorsement_security_deposit: Tez.t ;
block_reward: Tez.t ;
endorsement_reward: Tez.t ;
cost_per_byte: Tez.t ;
}
val parametric_encoding: parametric Data_encoding.t
val parametric: context -> parametric
@ -515,7 +516,7 @@ module Contract : sig
origination_nonce ->
balance: Tez.t ->
manager: public_key_hash ->
?script: (Script.t * (Tez.t * Tez.t)) ->
?script: Script.t ->
delegate: public_key_hash option ->
spendable: bool ->
delegatable: bool -> (context * contract * origination_nonce) tzresult Lwt.t
@ -535,8 +536,9 @@ module Contract : sig
Script.expr -> (string * Script.expr option) list option ->
context tzresult Lwt.t
val code_and_storage_fee: context -> contract -> Tez.t tzresult Lwt.t
val update_storage_fee: context -> contract -> Tez.t -> context tzresult Lwt.t
val fees: context -> t -> Tez.t tzresult Lwt.t
val paid_fees: context -> t -> Tez.t tzresult Lwt.t
val add_to_paid_fees: context -> t -> Tez.t -> context tzresult Lwt.t
val increment_counter:
context -> contract -> context tzresult Lwt.t

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

@ -402,8 +402,7 @@ let apply_manager_operation_content
Contract.update_script_storage
ctxt destination
storage_res diff >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source
destination Script_interpreter.dummy_storage_fee >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source destination >>=? fun ctxt ->
return (ctxt, origination_nonce, None)
| Error err ->
return (ctxt, origination_nonce, Some err) in
@ -429,8 +428,7 @@ let apply_manager_operation_content
| Some script ->
Script_ir_translator.parse_script ctxt script >>=? fun (_, ctxt) ->
Script_ir_translator.erase_big_map_initialization ctxt script >>=? fun (script, big_map_diff, ctxt) ->
return (Some (script, (Script_interpreter.dummy_code_fee, Script_interpreter.dummy_storage_fee)),
big_map_diff, ctxt)
return (Some script, big_map_diff, ctxt)
end >>=? fun (script, big_map, ctxt) ->
Contract.spend ctxt source credit >>=? fun ctxt ->
Contract.originate ctxt

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

@ -65,6 +65,7 @@ type parametric = {
endorsement_security_deposit: Tez_repr.t ;
block_reward: Tez_repr.t ;
endorsement_reward: Tez_repr.t ;
cost_per_byte: Tez_repr.t ;
}
let default = {
@ -99,6 +100,7 @@ let default = {
endorsement_security_deposit = Tez_repr.(mul_exn one 64) ;
block_reward = Tez_repr.(mul_exn one 16) ;
endorsement_reward = Tez_repr.(mul_exn one 2) ;
cost_per_byte = Tez_repr.of_mutez_exn 1_000L ;
}
module CompareListInt = Compare.List (Compare.Int)
@ -127,7 +129,8 @@ let parametric_encoding =
c.block_security_deposit,
c.endorsement_security_deposit,
c.block_reward),
(c.endorsement_reward))) )
(c.endorsement_reward,
c.cost_per_byte))) )
(fun (( preserved_cycles,
blocks_per_cycle,
blocks_per_commitment,
@ -148,7 +151,8 @@ let parametric_encoding =
block_security_deposit,
endorsement_security_deposit,
block_reward),
(endorsement_reward))) ->
(endorsement_reward,
cost_per_byte))) ->
{ preserved_cycles ;
blocks_per_cycle ;
blocks_per_commitment ;
@ -170,6 +174,7 @@ let parametric_encoding =
endorsement_security_deposit ;
block_reward ;
endorsement_reward ;
cost_per_byte ;
} )
(merge_objs
(obj10
@ -195,8 +200,9 @@ let parametric_encoding =
(req "block_security_deposit" Tez_repr.encoding)
(req "endorsement_security_deposit" Tez_repr.encoding)
(req "block_reward" Tez_repr.encoding))
(obj1
(req "endorsement_reward" Tez_repr.encoding))))
(obj2
(req "endorsement_reward" Tez_repr.encoding)
(req "cost_per_byte" Tez_repr.encoding))))
type t = {
fixed : fixed ;

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

@ -182,6 +182,14 @@ let () =
let failwith msg = fail (Failure msg)
let add_fees_for_bytes c base added =
let open Tez_repr in
let cost_per_byte = (Raw_context.constants c).cost_per_byte in
Lwt.return begin
cost_per_byte *? Int64.of_int added >>? fun added ->
base +? added
end
let create_base c contract
~balance ~manager ~delegate ?script ~spendable ~delegatable =
(match Contract_repr.is_implicit contract with
@ -199,11 +207,14 @@ let create_base c contract
Storage.Contract.Delegatable.set c contract delegatable >>= fun c ->
Storage.Contract.Counter.init c contract counter >>=? fun c ->
(match script with
| Some ({ Script_repr.code ; storage }, (code_fees, storage_fees)) ->
Storage.Contract.Code.init c contract code >>=? fun (c, _) ->
Storage.Contract.Storage.init c contract storage >>=? fun (c, _) ->
Storage.Contract.Code_fees.init c contract code_fees >>=? fun c ->
Storage.Contract.Storage_fees.init c contract storage_fees
| Some { Script_repr.code ; storage } ->
let fees = Tez_repr.zero in
Storage.Contract.Code.init c contract code >>=? fun (c, code_size) ->
add_fees_for_bytes c fees code_size >>=? fun fees ->
Storage.Contract.Storage.init c contract storage >>=? fun (c, storage_size) ->
add_fees_for_bytes c fees storage_size >>=? fun fees ->
Storage.Contract.Fees.init c contract fees >>=? fun c ->
Storage.Contract.Paid_fees.init c contract Tez_repr.zero
| None ->
return c) >>=? fun c ->
return (c, contract)
@ -227,9 +238,9 @@ 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.Code_fees.remove c contract >>= fun c ->
Storage.Contract.Storage_fees.remove c contract >>= fun c ->
Storage.Contract.Big_map.clear (c, contract) >>=? fun c ->
Storage.Contract.Paid_fees.remove c contract >>= fun c ->
Storage.Contract.Fees.remove c contract >>= fun c ->
Storage.Contract.Big_map.clear (c, contract) >>=? fun (c, _) ->
return c
let allocated c contract =
@ -341,37 +352,40 @@ let is_spendable c contract =
| None ->
Storage.Contract.Spendable.mem c contract >>= return
let code_and_storage_fee c contract =
Storage.Contract.Code_fees.get_option c contract >>=? fun code_fees ->
Storage.Contract.Storage_fees.get_option c contract >>=? fun storage_fees ->
match code_fees, storage_fees with
| (None, Some _) | (Some _, None) ->
failwith "contract_fee" (* Internal error *)
| None, None ->
return Tez_repr.zero
| Some code_fees, Some storage_fees ->
Lwt.return Tez_repr.(code_fees +? storage_fees)
let update_storage_fee c contract storage_fees =
Storage.Contract.Storage_fees.set c contract storage_fees
type big_map_diff = (string * Script_repr.expr option) list
let update_script_storage c contract storage big_map =
begin match big_map with
| None -> return c
| None -> return (c, Tez_repr.zero, Tez_repr.zero)
| Some diff ->
fold_left_s (fun c (key, value) ->
fold_left_s (fun (c, total_added, total_freed) (key, value) ->
match value with
| None ->
Storage.Contract.Big_map.remove (c, contract) key >>=? fun (c, _) ->
return c
Storage.Contract.Big_map.remove (c, contract) key >>=? fun (c, freed) ->
add_fees_for_bytes c total_freed freed >>=? fun total_freed ->
return (c, total_added, total_freed)
| Some v ->
Storage.Contract.Big_map.init_set (c, contract) key v >>=? fun (c, _) ->
return c)
c diff
end >>=? fun c ->
Storage.Contract.Storage.set c contract storage >>=? fun (c, _) ->
Storage.Contract.Big_map.init_set (c, contract) key v >>=? fun (c, diff) ->
if Compare.Int.(diff > 0) then
add_fees_for_bytes c total_added diff >>=? fun total_added ->
return (c, total_added, total_freed)
else
add_fees_for_bytes c total_freed (-diff) >>=? fun total_freed ->
return (c, total_added, total_freed))
(c, Tez_repr.zero, Tez_repr.zero) diff
end >>=? fun (c, total_added, total_freed) ->
Storage.Contract.Storage.set c contract storage >>=? fun (c, diff) ->
begin if Compare.Int.(diff > 0) then
add_fees_for_bytes c total_added diff >>=? fun total_added ->
return (c, total_added, total_freed)
else
add_fees_for_bytes c total_freed (-diff) >>=? fun total_freed ->
return (c, total_added, total_freed)
end >>=? fun (c, total_added, total_freed) ->
Storage.Contract.Fees.get c contract >>=? fun fees ->
Lwt.return (Tez_repr.(fees +? total_added)) >>=? fun fees ->
Lwt.return (Tez_repr.(fees -? total_freed)) >>=? fun fees ->
Storage.Contract.Fees.set c contract fees >>=? fun c ->
return c
let spend_from_script c contract amount =
@ -394,8 +408,7 @@ let spend_from_script c contract amount =
return c
| None ->
(* Delete empty implicit contract *)
delete c contract >>=? fun (c, _) ->
return c
delete c contract
let credit c contract amount =
begin
@ -441,13 +454,31 @@ let spend c contract amount =
let init c =
Storage.Contract.Global_counter.init c 0l
let fees c contract =
Storage.Contract.Fees.get_option c contract >>=? function
| None -> return Tez_repr.zero
| Some fees -> return fees
let paid_fees c contract =
Storage.Contract.Paid_fees.get_option c contract >>=? function
| None -> return Tez_repr.zero
| Some paid_fees -> return paid_fees
let add_to_paid_fees c contract fees =
if Tez_repr.equal fees Tez_repr.zero then
return c
else
Storage.Contract.Paid_fees.get c contract >>=? fun paid_fees ->
Lwt.return (Tez_repr.(paid_fees +? fees)) >>=? fun paid_fees ->
Storage.Contract.Paid_fees.set c contract paid_fees
module Big_map = struct
let set ctxt contract key value =
Storage.Contract.Big_map.init_set (ctxt, contract) key value >>=? fun (c, _) ->
return c
return c (* ignore the fees*)
let remove ctxt contract key =
Storage.Contract.Big_map.delete (ctxt, contract) key >>=? fun (c, _) ->
return c
return c (* ignore the fees*)
let mem ctxt contract key =
Storage.Contract.Big_map.mem (ctxt, contract) key
let get_opt ctxt contract key =

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

@ -81,18 +81,12 @@ val spend_from_script:
Raw_context.t -> Contract_repr.t -> Tez_repr.t ->
Raw_context.t tzresult Lwt.t
val code_and_storage_fee:
Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
val update_storage_fee:
Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
val originate:
Raw_context.t ->
Contract_repr.origination_nonce ->
balance:Tez_repr.t ->
manager:Signature.Public_key_hash.t ->
?script:(Script_repr.t * (Tez_repr.t * Tez_repr.t)) ->
?script:Script_repr.t ->
delegate:Signature.Public_key_hash.t option ->
spendable:bool ->
delegatable:bool ->
@ -101,6 +95,11 @@ val originate:
val init:
Raw_context.t -> Raw_context.t tzresult Lwt.t
val fees: Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
val paid_fees: Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
val add_to_paid_fees: Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
module Big_map : sig
val set :
Raw_context.t -> Contract_repr.t -> string -> Script_repr.expr -> Raw_context.t tzresult Lwt.t

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

@ -26,19 +26,20 @@ let () =
let origination_burn c ~source contract =
let origination_burn = Constants.origination_burn c in
Contract.spend_from_script c source origination_burn >>=? fun c ->
Contract.code_and_storage_fee c contract >>=? fun storage_fee ->
Contract.spend_from_script c source storage_fee
|> trace Cannot_pay_storage_fee
Contract.fees c contract >>=? fun fees ->
trace Cannot_pay_storage_fee
(Contract.spend_from_script c source fees >>=? fun c ->
Contract.add_to_paid_fees c contract fees)
let update_script_storage c ~source contract storage_fees =
Contract.code_and_storage_fee c contract >>=? fun paid_fees ->
Contract.update_storage_fee c contract storage_fees >>=? fun c ->
Contract.code_and_storage_fee c contract >>=? fun fee ->
match Tez.(fee -? paid_fees) with
let update_script_storage c ~source contract =
Contract.paid_fees c contract >>=? fun paid_fees ->
Contract.fees c contract >>=? fun fees ->
match Tez.(fees -? paid_fees) with
| Error _ ->
(* Previously paid fees are greater than required fees. *)
return c
| Ok to_be_paid ->
(* Burning the fees... *)
Contract.spend_from_script c source to_be_paid
|> trace Cannot_pay_storage_fee
trace Cannot_pay_storage_fee
(Contract.spend_from_script c source to_be_paid >>=? fun c ->
Contract.add_to_paid_fees c contract to_be_paid)

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

@ -17,5 +17,5 @@ val origination_burn:
val update_script_storage:
Alpha_context.t -> source:Contract.t ->
Contract.t -> Tez.t -> Alpha_context.t tzresult Lwt.t
Contract.t -> Alpha_context.t tzresult Lwt.t

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

@ -102,6 +102,9 @@ let constants_encoding =
and endorsement_reward =
opt Tez_repr.(=)
default.endorsement_reward c.endorsement_reward
and cost_per_byte =
opt Tez_repr.(=)
default.cost_per_byte c.cost_per_byte
in
(( preserved_cycles,
blocks_per_cycle,
@ -123,7 +126,8 @@ let constants_encoding =
block_security_deposit,
endorsement_security_deposit,
block_reward),
(endorsement_reward))))
(endorsement_reward,
cost_per_byte))))
(fun (( preserved_cycles,
blocks_per_cycle,
blocks_per_commitment,
@ -144,7 +148,8 @@ let constants_encoding =
block_security_deposit,
endorsement_security_deposit,
block_reward),
(endorsement_reward))) ->
(endorsement_reward,
cost_per_byte))) ->
let unopt def = function None -> def | Some v -> v in
let default = Constants_repr.default in
{ Constants_repr.preserved_cycles =
@ -190,6 +195,8 @@ let constants_encoding =
unopt default.block_reward block_reward ;
endorsement_reward =
unopt default.endorsement_reward endorsement_reward ;
cost_per_byte =
unopt default.cost_per_byte cost_per_byte ;
} )
(merge_objs
(obj10
@ -215,8 +222,9 @@ let constants_encoding =
(opt "block_security_deposit" Tez_repr.encoding)
(opt "endorsement_security_deposit" Tez_repr.encoding)
(opt "block_reward" Tez_repr.encoding))
(obj1
(opt "endorsement_reward" Tez_repr.encoding))))
(obj2
(opt "endorsement_reward" Tez_repr.encoding)
(opt "cost_per_byte" Tez_repr.encoding))))
let encoding =
let open Data_encoding in

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

@ -13,9 +13,6 @@ open Script_typed_ir
open Script_tc_errors
open Script_ir_translator
let dummy_code_fee = Tez.fifty_cents
let dummy_storage_fee = Tez.fifty_cents
(* ---- Run-time errors -----------------------------------------------------*)
type error += Reject of Script.location
@ -172,7 +169,7 @@ let rec interp
Contract.originate ctxt
origination
~manager ~delegate ~balance:credit
~script:({ code ; storage }, (dummy_code_fee, dummy_storage_fee))
~script:{ code ; storage }
~spendable ~delegatable
>>=? fun (ctxt, contract, origination) ->
Fees.origination_burn ctxt ~source:orig contract >>=? fun ctxt ->
@ -659,7 +656,7 @@ let rec interp
return (Some diff, ctxt)
end >>=? fun (diff, ctxt) ->
Contract.update_script_storage ctxt source sto diff >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source:orig source dummy_storage_fee >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source:orig source >>=? fun ctxt ->
begin match destination_script with
| None ->
(* we see non scripted contracts as (unit, unit) contract *)
@ -681,8 +678,7 @@ let rec interp
trace
(Invalid_contract (loc, destination))
(parse_data ctxt Unit_t ret) >>=? fun ((), ctxt) ->
Fees.update_script_storage ctxt ~source:orig
destination dummy_storage_fee >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source:orig destination >>=? fun ctxt ->
return (ctxt, origination)
end >>=? fun (ctxt, origination) ->
Contract.get_script ctxt source >>=? (fun (ctxt, script) -> match script with
@ -709,8 +705,7 @@ let rec interp
Lwt.return (unparse_data ctxt storage_type sto) >>=? fun (sto, ctxt) ->
let sto = Micheline.strip_locations sto in
Contract.update_script_storage ctxt source sto maybe_diff >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source:orig
source dummy_storage_fee >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source:orig source >>=? fun ctxt ->
Lwt.return (unparse_data ctxt tp p) >>=? fun (p, ctxt) ->
execute origination source destination ctxt script amount p
>>=? fun (sto, ret, ctxt, origination, maybe_diff) ->
@ -722,8 +717,7 @@ let rec interp
return (Some diff, ctxt)
end >>=? fun (diff, ctxt) ->
Contract.update_script_storage ctxt destination sto diff >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source:orig
destination dummy_storage_fee >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source:orig destination >>=? fun ctxt ->
trace
(Invalid_contract (loc, destination))
(parse_data ctxt tr ret) >>=? fun (v, ctxt) ->

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

@ -13,9 +13,6 @@ type error += Overflow of Script.location
type error += Reject of Script.location
type error += Runtime_contract_error : Contract.t * Script.expr -> error
val dummy_code_fee : Tez.t
val dummy_storage_fee : Tez.t
val execute:
Contract.origination_nonce ->
Contract.t -> Contract.t -> Alpha_context.t ->

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

@ -155,14 +155,14 @@ module Contract = struct
let encoding = Script_repr.expr_encoding
end))
module Code_fees =
module Paid_fees =
Indexed_context.Make_map
(struct let name = ["code_fees"] end)
(struct let name = ["paid_fees"] end)
(Make_value(Tez_repr))
module Storage_fees =
module Fees =
Indexed_context.Make_map
(struct let name = ["storage_fees"] end)
(struct let name = ["fees"] end)
(Make_value(Tez_repr))
module Roll_list =

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

@ -166,12 +166,17 @@ module Contract : sig
and type value = Script_repr.expr
and type t := Raw_context.t
module Code_fees : Indexed_data_storage
(** Exact cost of current storage.
Includes code, global storage and big map elements.
Always less than or equal to {!Paid_fees}. *)
module Fees : Indexed_data_storage
with type key = Contract_repr.t
and type value = Tez_repr.t
and type t := Raw_context.t
module Storage_fees : Indexed_data_storage
(** Maximum cost of storage since the contract's origination.
Always greater than or equal to {!Fees}. *)
module Paid_fees : Indexed_data_storage
with type key = Contract_repr.t
and type value = Tez_repr.t
and type t := Raw_context.t