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.

src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml

@@ -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

src/proto_alpha/lib_baking/test/proto_alpha_helpers.mli

@@ -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 *)

src/proto_alpha/lib_baking/test/test_origination.ml

@@ -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

src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL

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

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -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:
+  val update_script_storage:
-    context -> contract -> Tez.t -> Script.expr ->
+    context -> contract ->
-    (string * Script.expr option) list option -> context tzresult Lwt.t
+    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

src/proto_alpha/lib_protocol/src/apply.ml

@@ -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 ->

src/proto_alpha/lib_protocol/src/constants_repr.ml

@@ -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 =

src/proto_alpha/lib_protocol/src/contract_storage.ml

@@ -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.(code_fees +? storage_fees)
-      Lwt.return Tez_repr.(Constants_repr.minimal_contract_balance +? script_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  =
+let update_script_storage c contract 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
+            | 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) |>
+  match Tez_repr.(balance -? amount) with
-  trace (Balance_too_low (contract, balance, amount)) >>=? fun new_balance ->
+  | Error _ ->
-  contract_fee c contract >>=? fun fee ->
+      fail (Balance_too_low (contract, balance, amount))
-  if Tez_repr.(new_balance > fee) then
+  | 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 ? *)
+        match Contract_repr.is_default contract with
-    delete c contract
+        | 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
 

src/proto_alpha/lib_protocol/src/contract_storage.mli

@@ -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:
+val update_script_storage:
-  Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Script_repr.expr ->
+  Raw_context.t -> Contract_repr.t ->
-  big_map_diff option ->
+  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 ->

src/proto_alpha/lib_protocol/src/fees.ml

@@ -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

src/proto_alpha/lib_protocol/src/fees.mli

@@ -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
+

src/proto_alpha/lib_protocol/src/script_interpreter.ml

@@ -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

src/proto_alpha/lib_protocol/test/helpers/helpers_assert.ml

@@ -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

src/proto_alpha/lib_protocol/test/helpers/helpers_assert.mli

@@ -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
 

src/proto_alpha/lib_protocol/test/test_origination.ml

@@ -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 ()