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 ; endorsement_security_deposit: Tez.t ;
block_reward: Tez.t ; block_reward: Tez.t ;
endorsement_reward: Tez.t ; endorsement_reward: Tez.t ;
cost_per_byte: Tez.t ;
} }
val parametric_encoding: parametric Data_encoding.t val parametric_encoding: parametric Data_encoding.t
val parametric: context -> parametric val parametric: context -> parametric
@ -515,7 +516,7 @@ module Contract : sig
origination_nonce -> origination_nonce ->
balance: Tez.t -> balance: Tez.t ->
manager: public_key_hash -> manager: public_key_hash ->
?script: (Script.t * (Tez.t * Tez.t)) -> ?script: Script.t ->
delegate: public_key_hash option -> delegate: public_key_hash option ->
spendable: bool -> spendable: bool ->
delegatable: bool -> (context * contract * origination_nonce) tzresult Lwt.t delegatable: bool -> (context * contract * origination_nonce) tzresult Lwt.t
@ -535,8 +536,9 @@ module Contract : sig
Script.expr -> (string * Script.expr option) list option -> Script.expr -> (string * Script.expr option) list option ->
context tzresult Lwt.t context tzresult Lwt.t
val code_and_storage_fee: context -> contract -> Tez.t tzresult Lwt.t val fees: context -> t -> Tez.t tzresult Lwt.t
val update_storage_fee: context -> contract -> Tez.t -> context 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: val increment_counter:
context -> contract -> context tzresult Lwt.t 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 Contract.update_script_storage
ctxt destination ctxt destination
storage_res diff >>=? fun ctxt -> storage_res diff >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source Fees.update_script_storage ctxt ~source destination >>=? fun ctxt ->
destination Script_interpreter.dummy_storage_fee >>=? fun ctxt ->
return (ctxt, origination_nonce, None) return (ctxt, origination_nonce, None)
| Error err -> | Error err ->
return (ctxt, origination_nonce, Some err) in return (ctxt, origination_nonce, Some err) in
@ -429,8 +428,7 @@ let apply_manager_operation_content
| Some script -> | Some script ->
Script_ir_translator.parse_script ctxt script >>=? fun (_, ctxt) -> Script_ir_translator.parse_script ctxt script >>=? fun (_, ctxt) ->
Script_ir_translator.erase_big_map_initialization ctxt script >>=? fun (script, big_map_diff, 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)), return (Some script, big_map_diff, ctxt)
big_map_diff, ctxt)
end >>=? fun (script, big_map, ctxt) -> end >>=? fun (script, big_map, ctxt) ->
Contract.spend ctxt source credit >>=? fun ctxt -> Contract.spend ctxt source credit >>=? fun ctxt ->
Contract.originate 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 ; endorsement_security_deposit: Tez_repr.t ;
block_reward: Tez_repr.t ; block_reward: Tez_repr.t ;
endorsement_reward: Tez_repr.t ; endorsement_reward: Tez_repr.t ;
cost_per_byte: Tez_repr.t ;
} }
let default = { let default = {
@ -99,6 +100,7 @@ let default = {
endorsement_security_deposit = Tez_repr.(mul_exn one 64) ; endorsement_security_deposit = Tez_repr.(mul_exn one 64) ;
block_reward = Tez_repr.(mul_exn one 16) ; block_reward = Tez_repr.(mul_exn one 16) ;
endorsement_reward = Tez_repr.(mul_exn one 2) ; endorsement_reward = Tez_repr.(mul_exn one 2) ;
cost_per_byte = Tez_repr.of_mutez_exn 1_000L ;
} }
module CompareListInt = Compare.List (Compare.Int) module CompareListInt = Compare.List (Compare.Int)
@ -127,7 +129,8 @@ let parametric_encoding =
c.block_security_deposit, c.block_security_deposit,
c.endorsement_security_deposit, c.endorsement_security_deposit,
c.block_reward), c.block_reward),
(c.endorsement_reward))) ) (c.endorsement_reward,
c.cost_per_byte))) )
(fun (( preserved_cycles, (fun (( preserved_cycles,
blocks_per_cycle, blocks_per_cycle,
blocks_per_commitment, blocks_per_commitment,
@ -148,7 +151,8 @@ let parametric_encoding =
block_security_deposit, block_security_deposit,
endorsement_security_deposit, endorsement_security_deposit,
block_reward), block_reward),
(endorsement_reward))) -> (endorsement_reward,
cost_per_byte))) ->
{ preserved_cycles ; { preserved_cycles ;
blocks_per_cycle ; blocks_per_cycle ;
blocks_per_commitment ; blocks_per_commitment ;
@ -170,6 +174,7 @@ let parametric_encoding =
endorsement_security_deposit ; endorsement_security_deposit ;
block_reward ; block_reward ;
endorsement_reward ; endorsement_reward ;
cost_per_byte ;
} ) } )
(merge_objs (merge_objs
(obj10 (obj10
@ -195,8 +200,9 @@ let parametric_encoding =
(req "block_security_deposit" Tez_repr.encoding) (req "block_security_deposit" Tez_repr.encoding)
(req "endorsement_security_deposit" Tez_repr.encoding) (req "endorsement_security_deposit" Tez_repr.encoding)
(req "block_reward" Tez_repr.encoding)) (req "block_reward" Tez_repr.encoding))
(obj1 (obj2
(req "endorsement_reward" Tez_repr.encoding)))) (req "endorsement_reward" Tez_repr.encoding)
(req "cost_per_byte" Tez_repr.encoding))))
type t = { type t = {
fixed : fixed ; fixed : fixed ;

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

@ -182,6 +182,14 @@ let () =
let failwith msg = fail (Failure msg) 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 let create_base c contract
~balance ~manager ~delegate ?script ~spendable ~delegatable = ~balance ~manager ~delegate ?script ~spendable ~delegatable =
(match Contract_repr.is_implicit contract with (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.Delegatable.set c contract delegatable >>= fun c ->
Storage.Contract.Counter.init c contract counter >>=? fun c -> Storage.Contract.Counter.init c contract counter >>=? fun c ->
(match script with (match script with
| Some ({ Script_repr.code ; storage }, (code_fees, storage_fees)) -> | Some { Script_repr.code ; storage } ->
Storage.Contract.Code.init c contract code >>=? fun (c, _) -> let fees = Tez_repr.zero in
Storage.Contract.Storage.init c contract storage >>=? fun (c, _) -> Storage.Contract.Code.init c contract code >>=? fun (c, code_size) ->
Storage.Contract.Code_fees.init c contract code_fees >>=? fun c -> add_fees_for_bytes c fees code_size >>=? fun fees ->
Storage.Contract.Storage_fees.init c contract storage_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 -> | None ->
return c) >>=? fun c -> return c) >>=? fun c ->
return (c, contract) return (c, contract)
@ -227,9 +238,9 @@ let delete c contract =
Storage.Contract.Counter.delete c contract >>=? fun c -> Storage.Contract.Counter.delete c contract >>=? fun c ->
Storage.Contract.Code.remove c contract >>=? fun (c, _) -> Storage.Contract.Code.remove c contract >>=? fun (c, _) ->
Storage.Contract.Storage.remove c contract >>=? fun (c, _) -> Storage.Contract.Storage.remove c contract >>=? fun (c, _) ->
Storage.Contract.Code_fees.remove c contract >>= fun c -> Storage.Contract.Paid_fees.remove c contract >>= fun c ->
Storage.Contract.Storage_fees.remove c contract >>= fun c -> Storage.Contract.Fees.remove c contract >>= fun c ->
Storage.Contract.Big_map.clear (c, contract) >>=? fun c -> Storage.Contract.Big_map.clear (c, contract) >>=? fun (c, _) ->
return c return c
let allocated c contract = let allocated c contract =
@ -341,37 +352,40 @@ let is_spendable c contract =
| None -> | None ->
Storage.Contract.Spendable.mem c contract >>= return 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 type big_map_diff = (string * Script_repr.expr option) list
let update_script_storage c contract storage big_map = let update_script_storage c contract storage big_map =
begin match big_map with begin match big_map with
| None -> return c | None -> return (c, Tez_repr.zero, Tez_repr.zero)
| Some diff -> | Some diff ->
fold_left_s (fun c (key, value) -> fold_left_s (fun (c, total_added, total_freed) (key, value) ->
match value with match value with
| None -> | None ->
Storage.Contract.Big_map.remove (c, contract) key >>=? fun (c, _) -> Storage.Contract.Big_map.remove (c, contract) key >>=? fun (c, freed) ->
return c add_fees_for_bytes c total_freed freed >>=? fun total_freed ->
return (c, total_added, total_freed)
| Some v -> | Some v ->
Storage.Contract.Big_map.init_set (c, contract) key v >>=? fun (c, _) -> Storage.Contract.Big_map.init_set (c, contract) key v >>=? fun (c, diff) ->
return c) if Compare.Int.(diff > 0) then
c diff add_fees_for_bytes c total_added diff >>=? fun total_added ->
end >>=? fun c -> return (c, total_added, total_freed)
Storage.Contract.Storage.set c contract storage >>=? fun (c, _) -> 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 return c
let spend_from_script c contract amount = let spend_from_script c contract amount =
@ -394,8 +408,7 @@ let spend_from_script c contract amount =
return c return c
| None -> | None ->
(* Delete empty implicit contract *) (* Delete empty implicit contract *)
delete c contract >>=? fun (c, _) -> delete c contract
return c
let credit c contract amount = let credit c contract amount =
begin begin
@ -441,13 +454,31 @@ let spend c contract amount =
let init c = let init c =
Storage.Contract.Global_counter.init c 0l 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 module Big_map = struct
let set ctxt contract key value = let set ctxt contract key value =
Storage.Contract.Big_map.init_set (ctxt, contract) key value >>=? fun (c, _) -> Storage.Contract.Big_map.init_set (ctxt, contract) key value >>=? fun (c, _) ->
return c return c (* ignore the fees*)
let remove ctxt contract key = let remove ctxt contract key =
Storage.Contract.Big_map.delete (ctxt, contract) key >>=? fun (c, _) -> Storage.Contract.Big_map.delete (ctxt, contract) key >>=? fun (c, _) ->
return c return c (* ignore the fees*)
let mem ctxt contract key = let mem ctxt contract key =
Storage.Contract.Big_map.mem (ctxt, contract) key Storage.Contract.Big_map.mem (ctxt, contract) key
let get_opt 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 -> Contract_repr.t -> Tez_repr.t ->
Raw_context.t tzresult Lwt.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: val originate:
Raw_context.t -> Raw_context.t ->
Contract_repr.origination_nonce -> Contract_repr.origination_nonce ->
balance:Tez_repr.t -> balance:Tez_repr.t ->
manager:Signature.Public_key_hash.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 -> delegate:Signature.Public_key_hash.t option ->
spendable:bool -> spendable:bool ->
delegatable:bool -> delegatable:bool ->
@ -101,6 +95,11 @@ val originate:
val init: val init:
Raw_context.t -> Raw_context.t tzresult Lwt.t 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 module Big_map : sig
val set : val set :
Raw_context.t -> Contract_repr.t -> string -> Script_repr.expr -> Raw_context.t tzresult Lwt.t 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 c ~source contract =
let origination_burn = Constants.origination_burn c in let origination_burn = Constants.origination_burn c in
Contract.spend_from_script c source origination_burn >>=? fun c -> Contract.spend_from_script c source origination_burn >>=? fun c ->
Contract.code_and_storage_fee c contract >>=? fun storage_fee -> Contract.fees c contract >>=? fun fees ->
Contract.spend_from_script c source storage_fee trace Cannot_pay_storage_fee
|> 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 = let update_script_storage c ~source contract =
Contract.code_and_storage_fee c contract >>=? fun paid_fees -> Contract.paid_fees c contract >>=? fun paid_fees ->
Contract.update_storage_fee c contract storage_fees >>=? fun c -> Contract.fees c contract >>=? fun fees ->
Contract.code_and_storage_fee c contract >>=? fun fee -> match Tez.(fees -? paid_fees) with
match Tez.(fee -? paid_fees) with
| Error _ -> | Error _ ->
(* Previously paid fees are greater than required fees. *) (* Previously paid fees are greater than required fees. *)
return c return c
| Ok to_be_paid -> | Ok to_be_paid ->
(* Burning the fees... *) (* 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: val update_script_storage:
Alpha_context.t -> source:Contract.t -> 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 = and endorsement_reward =
opt Tez_repr.(=) opt Tez_repr.(=)
default.endorsement_reward c.endorsement_reward default.endorsement_reward c.endorsement_reward
and cost_per_byte =
opt Tez_repr.(=)
default.cost_per_byte c.cost_per_byte
in in
(( preserved_cycles, (( preserved_cycles,
blocks_per_cycle, blocks_per_cycle,
@ -123,7 +126,8 @@ let constants_encoding =
block_security_deposit, block_security_deposit,
endorsement_security_deposit, endorsement_security_deposit,
block_reward), block_reward),
(endorsement_reward)))) (endorsement_reward,
cost_per_byte))))
(fun (( preserved_cycles, (fun (( preserved_cycles,
blocks_per_cycle, blocks_per_cycle,
blocks_per_commitment, blocks_per_commitment,
@ -144,7 +148,8 @@ let constants_encoding =
block_security_deposit, block_security_deposit,
endorsement_security_deposit, endorsement_security_deposit,
block_reward), block_reward),
(endorsement_reward))) -> (endorsement_reward,
cost_per_byte))) ->
let unopt def = function None -> def | Some v -> v in let unopt def = function None -> def | Some v -> v in
let default = Constants_repr.default in let default = Constants_repr.default in
{ Constants_repr.preserved_cycles = { Constants_repr.preserved_cycles =
@ -190,6 +195,8 @@ let constants_encoding =
unopt default.block_reward block_reward ; unopt default.block_reward block_reward ;
endorsement_reward = endorsement_reward =
unopt default.endorsement_reward endorsement_reward ; unopt default.endorsement_reward endorsement_reward ;
cost_per_byte =
unopt default.cost_per_byte cost_per_byte ;
} ) } )
(merge_objs (merge_objs
(obj10 (obj10
@ -215,8 +222,9 @@ let constants_encoding =
(opt "block_security_deposit" Tez_repr.encoding) (opt "block_security_deposit" Tez_repr.encoding)
(opt "endorsement_security_deposit" Tez_repr.encoding) (opt "endorsement_security_deposit" Tez_repr.encoding)
(opt "block_reward" Tez_repr.encoding)) (opt "block_reward" Tez_repr.encoding))
(obj1 (obj2
(opt "endorsement_reward" Tez_repr.encoding)))) (opt "endorsement_reward" Tez_repr.encoding)
(opt "cost_per_byte" Tez_repr.encoding))))
let encoding = let encoding =
let open Data_encoding in 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_tc_errors
open Script_ir_translator open Script_ir_translator
let dummy_code_fee = Tez.fifty_cents
let dummy_storage_fee = Tez.fifty_cents
(* ---- Run-time errors -----------------------------------------------------*) (* ---- Run-time errors -----------------------------------------------------*)
type error += Reject of Script.location type error += Reject of Script.location
@ -172,7 +169,7 @@ let rec interp
Contract.originate ctxt Contract.originate ctxt
origination origination
~manager ~delegate ~balance:credit ~manager ~delegate ~balance:credit
~script:({ code ; storage }, (dummy_code_fee, dummy_storage_fee)) ~script:{ code ; storage }
~spendable ~delegatable ~spendable ~delegatable
>>=? fun (ctxt, contract, origination) -> >>=? fun (ctxt, contract, origination) ->
Fees.origination_burn ctxt ~source:orig contract >>=? fun ctxt -> Fees.origination_burn ctxt ~source:orig contract >>=? fun ctxt ->
@ -659,7 +656,7 @@ let rec interp
return (Some diff, ctxt) return (Some diff, ctxt)
end >>=? fun (diff, ctxt) -> end >>=? fun (diff, ctxt) ->
Contract.update_script_storage ctxt source sto diff >>=? fun 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 begin match destination_script with
| None -> | None ->
(* we see non scripted contracts as (unit, unit) contract *) (* we see non scripted contracts as (unit, unit) contract *)
@ -681,8 +678,7 @@ let rec interp
trace trace
(Invalid_contract (loc, destination)) (Invalid_contract (loc, destination))
(parse_data ctxt Unit_t ret) >>=? fun ((), ctxt) -> (parse_data ctxt Unit_t ret) >>=? fun ((), ctxt) ->
Fees.update_script_storage ctxt ~source:orig Fees.update_script_storage ctxt ~source:orig destination >>=? fun ctxt ->
destination dummy_storage_fee >>=? fun ctxt ->
return (ctxt, origination) return (ctxt, origination)
end >>=? fun (ctxt, origination) -> end >>=? fun (ctxt, origination) ->
Contract.get_script ctxt source >>=? (fun (ctxt, script) -> match script with 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) -> Lwt.return (unparse_data ctxt storage_type sto) >>=? fun (sto, ctxt) ->
let sto = Micheline.strip_locations sto in let sto = Micheline.strip_locations sto in
Contract.update_script_storage ctxt source sto maybe_diff >>=? fun ctxt -> Contract.update_script_storage ctxt source sto maybe_diff >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source:orig Fees.update_script_storage ctxt ~source:orig source >>=? fun ctxt ->
source dummy_storage_fee >>=? fun ctxt ->
Lwt.return (unparse_data ctxt tp p) >>=? fun (p, ctxt) -> Lwt.return (unparse_data ctxt tp p) >>=? fun (p, ctxt) ->
execute origination source destination ctxt script amount p execute origination source destination ctxt script amount p
>>=? fun (sto, ret, ctxt, origination, maybe_diff) -> >>=? fun (sto, ret, ctxt, origination, maybe_diff) ->
@ -722,8 +717,7 @@ let rec interp
return (Some diff, ctxt) return (Some diff, ctxt)
end >>=? fun (diff, ctxt) -> end >>=? fun (diff, ctxt) ->
Contract.update_script_storage ctxt destination sto diff >>=? fun ctxt -> Contract.update_script_storage ctxt destination sto diff >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source:orig Fees.update_script_storage ctxt ~source:orig destination >>=? fun ctxt ->
destination dummy_storage_fee >>=? fun ctxt ->
trace trace
(Invalid_contract (loc, destination)) (Invalid_contract (loc, destination))
(parse_data ctxt tr ret) >>=? fun (v, ctxt) -> (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 += Reject of Script.location
type error += Runtime_contract_error : Contract.t * Script.expr -> error type error += Runtime_contract_error : Contract.t * Script.expr -> error
val dummy_code_fee : Tez.t
val dummy_storage_fee : Tez.t
val execute: val execute:
Contract.origination_nonce -> Contract.origination_nonce ->
Contract.t -> Contract.t -> Alpha_context.t -> 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 let encoding = Script_repr.expr_encoding
end)) end))
module Code_fees = module Paid_fees =
Indexed_context.Make_map Indexed_context.Make_map
(struct let name = ["code_fees"] end) (struct let name = ["paid_fees"] end)
(Make_value(Tez_repr)) (Make_value(Tez_repr))
module Storage_fees = module Fees =
Indexed_context.Make_map Indexed_context.Make_map
(struct let name = ["storage_fees"] end) (struct let name = ["fees"] end)
(Make_value(Tez_repr)) (Make_value(Tez_repr))
module Roll_list = 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 value = Script_repr.expr
and type t := Raw_context.t 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 with type key = Contract_repr.t
and type value = Tez_repr.t and type value = Tez_repr.t
and type t := Raw_context.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 with type key = Contract_repr.t
and type value = Tez_repr.t and type value = Tez_repr.t
and type t := Raw_context.t and type t := Raw_context.t