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

Alpha: update storage fees policy.

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml
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

1
src/proto_alpha/lib_baking/test/proto_alpha_helpers.mli
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 *)

14
src/proto_alpha/lib_baking/test/test_origination.ml
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

1
src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL
View File

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

12
src/proto_alpha/lib_protocol/src/alpha_context.mli
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

7
src/proto_alpha/lib_protocol/src/apply.ml
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 ->

3
src/proto_alpha/lib_protocol/src/constants_repr.ml
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 =

92
src/proto_alpha/lib_protocol/src/contract_storage.ml
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 () ->
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
| None ->
Storage.Contract.Big_map.remove (c, contract) key >>=
return
| Some v ->
Storage.Contract.Big_map.init_set (c, contract) key v >>= return)
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
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
(* TODO: do we really want to allow overspending ? *)
delete c contract
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,12 +384,6 @@ 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
end
@ -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

14
src/proto_alpha/lib_protocol/src/contract_storage.mli
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 ->

43
src/proto_alpha/lib_protocol/src/fees.ml Normal file
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

21
src/proto_alpha/lib_protocol/src/fees.mli Normal file
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

17
src/proto_alpha/lib_protocol/src/script_interpreter.ml
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

6
src/proto_alpha/lib_protocol/test/helpers/helpers_assert.ml
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

1
src/proto_alpha/lib_protocol/test/helpers/helpers_assert.mli
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

8
src/proto_alpha/lib_protocol/test/test_origination.ml
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 ()