Alpha: update storage fees policy.

Instead of having a minimal amount for contracts, we now burn
token when increasing the size of a contract storage.
This commit is contained in:
Grégoire Henry 2018-02-20 23:02:23 +01:00 committed by Benjamin Canou
parent 892acb0c72
commit c125f822f5
15 changed files with 135 additions and 139 deletions

View File

@ -392,12 +392,6 @@ module Assert = struct
| _ -> false)
end
let initial_amount_too_low ~msg =
contain_error ~msg ~f:begin ecoproto_error (function
| Contract.Initial_amount_too_low _ -> true
| _ -> false)
end
let non_delegatable ~msg =
contain_error ~msg ~f:begin ecoproto_error (function
| Contract_storage.Non_delegatable_contract _ -> true

View File

@ -195,7 +195,6 @@ module Assert : sig
(** Origination assertions *)
val initial_amount_too_low : msg:string -> 'a tzresult -> unit
val non_delegatable : msg:string -> 'a tzresult -> unit
(** Endorsement / baking assertions *)

View File

@ -29,20 +29,6 @@ let run blkid ({ b1 ; b2 ; _ } : Helpers.Account.bootstrap_accounts) =
~balance:Tez.zero () >>= fun result ->
Assert.unknown_contract ~msg:__LOC__ result ;
(* Origination with amount = .5 tez *)
Helpers.Account.originate
~src:b1
~manager_pkh:foo.pkh
~balance:Tez.fifty_cents () >>= fun result ->
Assert.initial_amount_too_low ~msg:__LOC__ result ;
(* Origination with amount = 1 tez *)
Helpers.Account.originate
~src:b1
~manager_pkh:foo.pkh
~balance:(cents 99L) () >>= fun result ->
Assert.initial_amount_too_low ~msg:__LOC__ result ;
(* Origination with amount > 1 tez *)
Helpers.Account.originate
~src:b1

View File

@ -49,6 +49,7 @@
"Alpha_context",
"Script_typed_ir",
"Fees",
"Gas",
"Script_tc_errors",
"Script_ir_translator",

View File

@ -440,8 +440,6 @@ module Contract : sig
val set_delegate:
context -> contract -> public_key_hash option -> context tzresult Lwt.t
type error += Initial_amount_too_low of contract * Tez.t * Tez.t
val originate:
context ->
origination_nonce ->
@ -462,9 +460,13 @@ module Contract : sig
val credit:
context -> contract -> Tez.t -> context tzresult Lwt.t
val update_script_storage_and_fees:
context -> contract -> Tez.t -> Script.expr ->
(string * Script.expr option) list option -> context tzresult Lwt.t
val update_script_storage:
context -> contract ->
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 increment_counter:
context -> contract -> context tzresult Lwt.t

View File

@ -138,14 +138,15 @@ let apply_manager_operation_content
| Ok (storage_res, _res, _steps, ctxt, origination_nonce, maybe_big_map_diff) ->
(* TODO: pay for the steps and the storage diff:
update_script_storage checks the storage cost *)
Contract.update_script_storage_and_fees
Contract.update_script_storage
ctxt destination
Script_interpreter.dummy_storage_fee
storage_res
(match maybe_big_map_diff with
| None -> None
| Some map ->
Some (Script_ir_translator.to_serializable_big_map map)) >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source
destination Script_interpreter.dummy_storage_fee >>=? fun ctxt ->
return (ctxt, origination_nonce, None)
| Error err ->
return (ctxt, origination_nonce, Some err) in
@ -173,13 +174,13 @@ let apply_manager_operation_content
return (Some (script, (Script_interpreter.dummy_code_fee, Script_interpreter.dummy_storage_fee)),
big_map_diff)
end >>=? fun (script, big_map) ->
Contract.spend ctxt source Constants.origination_burn >>=? fun ctxt ->
Contract.spend ctxt source credit >>=? fun ctxt ->
Contract.originate ctxt
origination_nonce
~manager ~delegate ~balance:credit
?script
~spendable ~delegatable >>=? fun (ctxt, contract, origination_nonce) ->
Fees.origination_burn ctxt ~source contract >>=? fun ctxt ->
begin match big_map with
| None -> return ctxt
| Some diff ->

View File

@ -19,9 +19,6 @@ let seed_nonce_revelation_tip =
(* 1 tez *)
let origination_burn =
Tez_repr.one
(* 1 tez *)
let minimal_contract_balance =
Tez_repr.one
(* 1000 tez *)
let baking_bond_cost =

View File

@ -8,9 +8,7 @@
(**************************************************************************)
type error +=
| Initial_amount_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Permanent *)
| Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Temporary *)
| Cannot_pay_storage_fee of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Temporary *)
| Counter_in_the_past of Contract_repr.contract * int32 * int32 (* `Branch *)
| Counter_in_the_future of Contract_repr.contract * int32 * int32 (* `Temporary *)
| Unspendable_contract of Contract_repr.contract (* `Permanent *)
@ -22,21 +20,6 @@ type error +=
| Failure of string (* `Permanent *)
let () =
register_error_kind
`Permanent
~id:"contract.initial_amount_too_low"
~title:"Initial amount too low"
~description:"Not enough tokens provided for an origination"
~pp:(fun ppf (c, r, p) ->
Format.fprintf ppf "Initial amount of contract %a too low (required %a but provided %a)"
Contract_repr.pp c
Tez_repr.pp p Tez_repr.pp r)
Data_encoding.(obj3
(req "contract" Contract_repr.encoding)
(req "required" Tez_repr.encoding)
(req "provided" Tez_repr.encoding))
(function Initial_amount_too_low (c, r, p) -> Some (c, r, p) | _ -> None)
(fun (c, r, p) -> Initial_amount_too_low (c, r, p)) ;
register_error_kind
`Permanent
~id:"contract.unspendable_contract"
@ -62,20 +45,6 @@ let () =
(req "amount" Tez_repr.encoding))
(function Balance_too_low (c, b, a) -> Some (c, b, a) | _ -> None)
(fun (c, b, a) -> Balance_too_low (c, b, a)) ;
register_error_kind
`Temporary
~id:"contract.cannot_pay_storage_fee"
~title:"Cannot pay storage fee"
~description:"The storage fee is higher than the contract balance"
~pp:(fun ppf (c, b, a) ->
Format.fprintf ppf "Balance of contract %a too low (%a) to pay storage fee %a"
Contract_repr.pp c Tez_repr.pp b Tez_repr.pp a)
Data_encoding.(obj3
(req "contract" Contract_repr.encoding)
(req "balance" Tez_repr.encoding)
(req "storage_fee" Tez_repr.encoding))
(function Cannot_pay_storage_fee (c, b, a) -> Some (c, b, a) | _ -> None)
(fun (c, b, a) -> Cannot_pay_storage_fee (c, b, a)) ;
register_error_kind
`Temporary
~id:"contract.counter_in_the_future"
@ -213,7 +182,7 @@ let create_base c contract
Roll_storage.Contract.add_amount c contract balance >>=? fun c ->
return (c, contract)
let create c nonce ~balance ~manager ~delegate ?script ~spendable ~delegatable =
let originate c nonce ~balance ~manager ?script ~delegate ~spendable ~delegatable =
let contract = Contract_repr.originated_contract nonce in
create_base c contract ~balance ~manager ~delegate ?script ~spendable ~delegatable >>=? fun (ctxt, contract) ->
return (ctxt, contract, Contract_repr.incr_origination_nonce nonce)
@ -363,52 +332,51 @@ let set_delegate c contract delegate =
Storage.Contract.Delegate.init_set c contract delegate >>= fun c ->
return c
let contract_fee c contract =
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"
| (None, Some _) | (Some _, None) ->
failwith "contract_fee" (* Internal error *)
| None, None ->
return Constants_repr.minimal_contract_balance
return Tez_repr.zero
| Some code_fees, Some storage_fees ->
Lwt.return Tez_repr.(code_fees +? storage_fees) >>=? fun script_fees ->
Lwt.return Tez_repr.(Constants_repr.minimal_contract_balance +? script_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_and_fees c contract storage_fees storage big_map =
Storage.Contract.Balance.get_option c contract >>=? function
| None ->
(* The contract was destroyed *)
return c
| Some balance ->
Storage.Contract.Storage_fees.set c contract storage_fees >>=? fun c ->
contract_fee c contract >>=? fun fee ->
fail_unless Tez_repr.(balance > fee)
(Cannot_pay_storage_fee (contract, balance, fee)) >>=? fun () ->
begin match big_map with
| None -> return c
| Some diff ->
fold_left_s (fun c (key, value) ->
match value with
| None -> Storage.Contract.Big_map.remove (c, contract) key >>= return
| Some v ->
Storage.Contract.Big_map.init_set (c, contract) key v >>= return)
c diff
end >>=? fun c ->
Storage.Contract.Storage.set c contract storage
let update_script_storage c contract storage big_map =
begin match big_map with
| None -> return c
| Some diff ->
fold_left_s (fun c (key, value) ->
match value with
| None ->
Storage.Contract.Big_map.remove (c, contract) key >>=
return
| Some v ->
Storage.Contract.Big_map.init_set (c, contract) key v >>=
return)
c diff
end >>=? fun c ->
Storage.Contract.Storage.set c contract storage
let spend_from_script c contract amount =
Storage.Contract.Balance.get c contract >>=? fun balance ->
Lwt.return Tez_repr.(balance -? amount) |>
trace (Balance_too_low (contract, balance, amount)) >>=? fun new_balance ->
contract_fee c contract >>=? fun fee ->
if Tez_repr.(new_balance > fee) then
Storage.Contract.Balance.set c contract new_balance >>=? fun c ->
Roll_storage.Contract.remove_amount c contract amount
else
(* TODO: do we really want to allow overspending ? *)
delete c contract
match Tez_repr.(balance -? amount) with
| Error _ ->
fail (Balance_too_low (contract, balance, amount))
| Ok new_balance ->
if Tez_repr.(new_balance > Tez_repr.zero) then
Storage.Contract.Balance.set c contract new_balance >>=? fun c ->
Roll_storage.Contract.remove_amount c contract amount
else
match Contract_repr.is_default contract with
| Some _ -> delete c contract
| None -> return c
let credit c contract amount =
Storage.Contract.Balance.get_option c contract >>=? function
@ -416,14 +384,8 @@ let credit c contract amount =
match Contract_repr.is_default contract with
| None -> fail (Non_existing_contract contract)
| Some manager ->
if Tez_repr.(amount < Constants_repr.minimal_contract_balance)
then
(* Not enough to keep a default contract alive: burn the tokens *)
return c
else
(* Otherwise, create the default contract. *)
create_default c manager ~balance:amount >>=? fun (c, _) ->
return c
create_default c manager ~balance:amount >>=? fun (c, _) ->
return c
end
| Some balance ->
Lwt.return Tez_repr.(amount +? balance) >>=? fun balance ->
@ -436,14 +398,6 @@ let spend c contract amount =
then fail (Unspendable_contract contract)
else spend_from_script c contract amount
let originate c nonce ~balance ~manager ?script ~delegate ~spendable ~delegatable =
create c nonce ~balance ~manager ~delegate ?script ~spendable ~delegatable >>=? fun (c, contract, nonce) ->
(* check contract fee *)
contract_fee c contract >>=? fun fee ->
fail_unless Tez_repr.(balance >= fee)
(Initial_amount_too_low (contract, balance, fee)) >>=? fun () ->
return (c, contract, nonce)
let init c =
Storage.Contract.Global_counter.init c 0l

View File

@ -8,9 +8,7 @@
(**************************************************************************)
type error +=
| Initial_amount_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Permanent *)
| Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Temporary *)
| Cannot_pay_storage_fee of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Temporary *)
| Counter_in_the_past of Contract_repr.contract * int32 * int32 (* `Branch *)
| Counter_in_the_future of Contract_repr.contract * int32 * int32 (* `Temporary *)
| Unspendable_contract of Contract_repr.contract (* `Permanent *)
@ -60,9 +58,9 @@ val get_storage:
type big_map_diff = (string * Script_repr.expr option) list
val update_script_storage_and_fees:
Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Script_repr.expr ->
big_map_diff option ->
val update_script_storage:
Raw_context.t -> Contract_repr.t ->
Script_repr.expr -> big_map_diff option ->
Raw_context.t tzresult Lwt.t
(** fails if the contract is not delegatable *)
@ -84,6 +82,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 ->

View File

@ -0,0 +1,43 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Alpha_context
type error += Cannot_pay_storage_fee
let () =
register_error_kind
`Temporary
~id:"contract.cannot_pay_storage_fee"
~title:"Cannot pay storage fee"
~description:"The storage fee is higher than the contract balance"
~pp:(fun ppf () -> Format.fprintf ppf "Cannot pay storage storage fee")
Data_encoding.empty
(function Cannot_pay_storage_fee -> Some () | _ -> None)
(fun () -> Cannot_pay_storage_fee)
let origination_burn c ~source contract =
Contract.spend_from_script c source Constants.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
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
| 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

View File

@ -0,0 +1,21 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Alpha_context
type error += Cannot_pay_storage_fee
val origination_burn:
Alpha_context.t -> source:Contract.t ->
Contract.t -> Alpha_context.t tzresult Lwt.t
val update_script_storage:
Alpha_context.t -> source:Contract.t ->
Contract.t -> Tez.t -> Alpha_context.t tzresult Lwt.t

View File

@ -196,6 +196,7 @@ let rec interp
~script:({ code ; storage }, (dummy_code_fee, dummy_storage_fee))
~spendable ~delegatable
>>=? fun (ctxt, contract, origination) ->
Fees.origination_burn ctxt ~source:orig contract >>=? fun ctxt ->
logged_return descr ~origination (Item ((param_type, return_type, contract), rest), gas, ctxt) in
let logged_return : ?origination:Contract.origination_nonce ->
a stack * Gas.t * context ->
@ -655,9 +656,10 @@ let rec interp
Contract.credit ctxt destination amount >>=? fun ctxt ->
Contract.get_script ctxt destination >>=? fun destination_script ->
let sto = Micheline.strip_locations (unparse_data storage_type storage) in
Contract.update_script_storage_and_fees ctxt source dummy_storage_fee sto
Contract.update_script_storage ctxt source sto
(Option.map ~f:Script_ir_translator.to_serializable_big_map
(Script_ir_translator.extract_big_map storage_type storage)) >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source:orig source dummy_storage_fee >>=? fun ctxt ->
begin match destination_script with
| None ->
(* we see non scripted contracts as (unit, unit) contract *)
@ -668,11 +670,13 @@ let rec interp
let p = unparse_data tp p in
execute origination source destination ctxt script amount p gas
>>=? fun (csto, ret, gas, ctxt, origination, maybe_diff) ->
Contract.update_script_storage_and_fees ctxt destination dummy_storage_fee csto
Contract.update_script_storage ctxt destination csto
(Option.map ~f:Script_ir_translator.to_serializable_big_map maybe_diff) >>=? fun ctxt ->
trace
(Invalid_contract (loc, destination))
(parse_data ctxt Unit_t ret) >>=? fun () ->
Fees.update_script_storage ctxt ~source:orig
destination dummy_storage_fee >>=? fun ctxt ->
return (ctxt, gas, origination)
end >>=? fun (ctxt, gas, origination) ->
Contract.get_script ctxt source >>=? (function
@ -694,12 +698,16 @@ let rec interp
Option.map ~f:to_serializable_big_map
@@ extract_big_map storage_type sto) in
let sto = Micheline.strip_locations (unparse_data storage_type sto) in
Contract.update_script_storage_and_fees ctxt source dummy_storage_fee sto maybe_diff >>=? fun ctxt ->
Contract.update_script_storage ctxt source sto maybe_diff >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source:orig
source dummy_storage_fee >>=? fun ctxt ->
let p = unparse_data tp p in
execute origination source destination ctxt script amount p gas
>>=? fun (sto, ret, gas, ctxt, origination, maybe_diff) ->
Contract.update_script_storage_and_fees ctxt destination dummy_storage_fee sto
Contract.update_script_storage ctxt destination sto
(Option.map ~f:Script_ir_translator.to_serializable_big_map maybe_diff) >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source:orig
destination dummy_storage_fee >>=? fun ctxt ->
trace
(Invalid_contract (loc, destination))
(parse_data ctxt tr ret) >>=? fun v ->
@ -719,6 +727,7 @@ let rec interp
origination
~manager ~delegate ~balance
?script:None ~spendable:true ~delegatable >>=? fun (ctxt, contract, origination) ->
Fees.origination_burn ctxt ~source contract >>=? fun ctxt ->
logged_return ~origination (Item ((Unit_t, Unit_t, contract), rest), gas, ctxt)
| Default_account, Item (key, rest) ->
let gas = Gas.consume gas Gas.Cost_of.default_account in

View File

@ -213,12 +213,6 @@ let inconsistent_pkh ~msg =
| _ -> false)
end
let initial_amount_too_low ~msg =
contain_error ~msg ~f: begin ecoproto_error (function
| Contract.Initial_amount_too_low _ -> true
| _ -> false)
end
let non_delegatable ~msg =
contain_error ~msg ~f: begin ecoproto_error (function
| Proto_alpha.Contract_storage.Non_delegatable_contract _ -> true

View File

@ -86,7 +86,6 @@ val non_existing_contract : msg:string -> 'a proto_tzresult -> unit
val balance_too_low : msg:string -> 'a proto_tzresult -> unit
val non_spendable : msg:string -> 'a tzresult -> unit
val inconsistent_pkh : msg:string -> 'a tzresult -> unit
val initial_amount_too_low : msg:string -> 'a tzresult -> unit
val non_delegatable : msg:string -> 'a tzresult -> unit
val wrong_delegate : msg:string -> 'a tzresult -> unit

View File

@ -35,14 +35,6 @@ let test_simple_origination () =
Init.main () >>=? fun root ->
let src = List.hd Account.bootstrap_accounts in
(* 0 balance should fail *)
originate root src 0 >>= Assert.wrap >>= fun result ->
Assert.initial_amount_too_low ~msg: __LOC__ result ;
(* .5 Balance should fail *)
originate root src 50 >>= Assert.wrap >>= fun result ->
Assert.initial_amount_too_low ~msg: __LOC__ result ;
(* 2. Balance should work *)
originate root src 200 >>= Assert.ok >>= fun _ ->
return ()