Alpha: Storage burn hapens at the end of manager operations

src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL

@@ -52,11 +52,11 @@
         "Vote_storage",
         "Commitment_storage",
         "Init_storage",
+        "Fees",
 
         "Alpha_context",
 
         "Script_typed_ir",
-        "Fees",
         "Script_tc_errors",
         "Michelson_v1_gas",
         "Script_ir_annot",

src/proto_alpha/lib_protocol/src/alpha_context.ml

@@ -54,6 +54,7 @@ module Script = struct
   include Michelson_v1_primitives
   include Script_repr
 end
+module Fees = Fees
 
 type public_key = Signature.Public_key.t
 type public_key_hash = Signature.Public_key_hash.t

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -578,8 +578,6 @@ module Contract : sig
   val set_storage_unlimited: context -> context
 
   val used_storage_space: context -> t -> Z.t tzresult Lwt.t
-  val paid_storage_space_fees: context -> t -> Tez.t tzresult Lwt.t
-  val pay_for_storage_space: context -> t -> Tez.t -> context tzresult Lwt.t
 
   val increment_counter:
     context -> contract -> context tzresult Lwt.t
@@ -895,6 +893,21 @@ type packed_internal_operation =
 
 val manager_kind: 'kind manager_operation -> 'kind Kind.manager
 
+module Fees : sig
+
+  val origination_burn:
+    context -> payer:Contract.t -> (context * Tez.t) tzresult Lwt.t
+
+  val record_paid_storage_space:
+    context -> Contract.t -> (context * Z.t * Tez.t) tzresult Lwt.t
+
+  val with_fees_for_storage:
+    context -> payer:Contract.t ->
+    (context -> (context * 'a) tzresult Lwt.t) ->
+    (context * 'a) tzresult Lwt.t
+
+end
+
 module Operation : sig
 
   type nonrec 'kind contents = 'kind contents

src/proto_alpha/lib_protocol/src/apply.ml

@@ -398,8 +398,8 @@ let apply_manager_operation_content :
             Contract.used_storage_space ctxt destination >>=? fun old_size ->
             Contract.update_script_storage
               ctxt destination storage big_map_diff >>=? fun ctxt ->
-            Fees.update_script_storage
+            Fees.record_paid_storage_space
-              ctxt ~payer destination >>=? fun (ctxt, new_size, fees) ->
+              ctxt destination >>=? fun (ctxt, new_size, fees) ->
             Contract.originated_from_current_nonce
               ~since: before_operation
               ~until: ctxt >>=? fun originated_contracts ->
@@ -440,12 +440,14 @@ let apply_manager_operation_content :
           ~manager ~delegate ~balance:credit
           ?script
           ~spendable ~delegatable >>=? fun ctxt ->
-        Fees.origination_burn ctxt ~payer contract >>=? fun (ctxt, size, fees) ->
+        Fees.origination_burn ctxt ~payer >>=? fun (ctxt, orignation_burn) ->
+        Fees.record_paid_storage_space ctxt contract >>=? fun (ctxt, size, fees) ->
+        Lwt.return Tez.(orignation_burn +? fees) >>=? fun all_fees ->
         let result =
           Origination_result
             { balance_updates =
                 cleanup_balance_updates
-                  [ Contract payer, Debited fees ;
+                  [ Contract payer, Debited all_fees ;
                     Contract source, Debited credit ;
                     Contract contract, Credited credit ] ;
               originated_contracts = [ contract ] ;
@@ -516,22 +518,24 @@ let apply_manager_contents
   Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt ->
   Lwt.return (Contract.set_storage_limit ctxt storage_limit) >>=? fun ctxt ->
   let level = Level.current ctxt in
-  apply_manager_operation_content ctxt mode
+  Fees.with_fees_for_storage ctxt ~payer:source begin fun ctxt ->
-    ~source ~payer:source ~internal:false operation >>= begin function
+    apply_manager_operation_content ctxt mode
-    | Ok (ctxt, operation_results, internal_operations) -> begin
+      ~source ~payer:source ~internal:false operation >>= begin function
-        apply_internal_manager_operations
+      | Ok (ctxt, operation_results, internal_operations) -> begin
-          ctxt mode ~payer:source internal_operations >>= function
+          apply_internal_manager_operations
-        | Ok (ctxt, internal_operations_results) ->
+            ctxt mode ~payer:source internal_operations >>= function
-            return (ctxt,
+          | Ok (ctxt, internal_operations_results) ->
-                    Applied operation_results, internal_operations_results)
+              return (ctxt,
-        | Error internal_operations_results ->
+                      (Applied operation_results, internal_operations_results))
-            return (ctxt (* backtracked *),
+          | Error internal_operations_results ->
-                    Applied operation_results, internal_operations_results)
+              return (ctxt (* backtracked *),
-      end
+                      (Applied operation_results, internal_operations_results))
-    | Error operation_results ->
+        end
-        return (ctxt (* backtracked *),
+      | Error operation_results ->
-                Failed (manager_kind operation, operation_results), [])
+          return (ctxt (* backtracked *),
-  end >>=? fun (ctxt, operation_result, internal_operation_results) ->
+                  (Failed (manager_kind operation, operation_results), []))
+    end
+  end >>=? fun (ctxt, (operation_result, internal_operation_results)) ->
   return (ctxt,
           Manager_operation_result
             { balance_updates =

src/proto_alpha/lib_protocol/src/constants_repr.ml

@@ -99,7 +99,7 @@ let default = {
     | Ok c -> c
     | Error _ -> assert false
   end ;
-  origination_burn = Tez_repr.one ;
+  origination_burn = Tez_repr.of_mutez_exn 257L ;
   block_security_deposit = Tez_repr.(mul_exn one 512) ;
   endorsement_security_deposit = Tez_repr.(mul_exn one 64) ;
   block_reward = Tez_repr.(mul_exn one 16) ;

src/proto_alpha/lib_protocol/src/contract_storage.ml

@@ -225,7 +225,7 @@ let create_base c contract
        let total_size = Z.add (Z.add (Z.of_int code_size) (Z.of_int storage_size)) big_map_size in
        assert Compare.Z.(total_size >= Z.zero) ;
        Storage.Contract.Used_storage_space.init c contract total_size >>=? fun c ->
-       Storage.Contract.Paid_storage_space_fees.init c contract Tez_repr.zero
+       Storage.Contract.Paid_storage_space.init c contract Z.zero
    | None ->
        return c) >>=? fun c ->
   return c
@@ -252,7 +252,7 @@ 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.Paid_storage_space_fees.remove c contract >>= fun c ->
+      Storage.Contract.Paid_storage_space.remove c contract >>= fun c ->
       Storage.Contract.Used_storage_space.remove c contract >>= fun c ->
       return c
 
@@ -461,18 +461,19 @@ let used_storage_space c contract =
   | None -> return Z.zero
   | Some fees -> return fees
 
-let paid_storage_space_fees c contract =
+let paid_storage_space c contract =
-  Storage.Contract.Paid_storage_space_fees.get_option c contract >>=? function
+  Storage.Contract.Paid_storage_space.get_option c contract >>=? function
-  | None -> return Tez_repr.zero
+  | None -> return Z.zero
-  | Some paid_fees -> return paid_fees
+  | Some paid_space -> return paid_space
 
-let pay_for_storage_space c contract fees =
+let record_paid_storage_space c contract paid_storage =
-  if Tez_repr.equal fees Tez_repr.zero then
+  Storage.Contract.Paid_storage_space.get c contract >>=? fun already_paid_fees ->
-    return c
+  if Compare.Z.(already_paid_fees < paid_storage) then
+    return (Z.zero, c)
   else
-    Storage.Contract.Paid_storage_space_fees.get c contract >>=? fun paid_fees ->
+    let to_pay = Z.sub paid_storage already_paid_fees in
-    Lwt.return (Tez_repr.(paid_fees +? fees)) >>=? fun paid_fees ->
+    Storage.Contract.Paid_storage_space.set c contract paid_storage >>=? fun c ->
-    Storage.Contract.Paid_storage_space_fees.set c contract paid_fees
+    return (to_pay, c)
 
 module Big_map = struct
   let mem ctxt contract key =

src/proto_alpha/lib_protocol/src/contract_storage.mli

@@ -103,8 +103,8 @@ val init:
   Raw_context.t -> Raw_context.t tzresult Lwt.t
 
 val used_storage_space: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
-val paid_storage_space_fees: Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
+val paid_storage_space: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
-val pay_for_storage_space: Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
+val record_paid_storage_space: Raw_context.t -> Contract_repr.t -> Z.t -> (Z.t * Raw_context.t) tzresult Lwt.t
 
 module Big_map : sig
   val mem :

src/proto_alpha/lib_protocol/src/fees.ml

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Alpha_context
-
 type error += Cannot_pay_storage_fee
 
 let () =
@@ -23,29 +21,30 @@ let () =
     (fun () -> Cannot_pay_storage_fee)
 
 
-let origination_burn c ~payer contract =
+let origination_burn c ~payer =
-  let origination_burn = Constants.origination_burn c in
+  let origination_burn = Constants_storage.origination_burn c in
-  Contract.spend_from_script c payer origination_burn >>=? fun c ->
+  Contract_storage.spend_from_script c payer origination_burn >>=? fun c ->
-  Contract.used_storage_space c contract >>=? fun size ->
+  return (c, origination_burn)
-  let cost_per_byte = Constants.cost_per_byte c in
-  Lwt.return (Tez.(cost_per_byte *? (Z.to_int64 size))) >>=? fun fees ->
-  trace Cannot_pay_storage_fee
-    (Contract.spend_from_script c payer fees >>=? fun c ->
-     Contract.pay_for_storage_space c contract fees) >>=? fun c ->
-  return (c, size, fees)
 
-let update_script_storage c ~payer contract =
+let record_paid_storage_space c contract =
-  Contract.paid_storage_space_fees c contract >>=? fun paid_fees ->
+  Contract_storage.used_storage_space c contract >>=? fun size ->
-  Contract.used_storage_space c contract >>=? fun size ->
+  Contract_storage.record_paid_storage_space c contract size >>=? fun (to_be_paid, c) ->
-  let cost_per_byte = Constants.cost_per_byte c in
+  Lwt.return (Raw_context.update_storage_space_to_pay c to_be_paid) >>=? fun c ->
-  Lwt.return (Tez.(cost_per_byte *? (Z.to_int64 size))) >>=? fun fees ->
+  let cost_per_byte = Constants_storage.cost_per_byte c in
-  match Tez.(fees -? paid_fees) with
+  Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 to_be_paid))) >>=? fun to_burn ->
-  | Error _ ->
+  return (c, size, to_burn)
-      (* Previously paid fees are greater than required fees. *)
+
-      return (c, size, Tez.zero)
+let burn_fees_for_storage c ~payer =
-  | Ok to_be_paid ->
+  let c, storage_space_to_pay = Raw_context.clear_storage_space_to_pay c in
-      (* Burning the fees... *)
+  let cost_per_byte = Constants_storage.cost_per_byte c in
-      trace Cannot_pay_storage_fee
+  Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 storage_space_to_pay))) >>=? fun to_burn ->
-        (Contract.spend_from_script c payer to_be_paid >>=? fun c ->
+  (* Burning the fees... *)
-         Contract.pay_for_storage_space c contract to_be_paid) >>=? fun c ->
+  trace Cannot_pay_storage_fee
-      return (c, size, to_be_paid)
+    (Contract_storage.spend_from_script c payer to_burn) >>=? fun c ->
+  return c
+
+let with_fees_for_storage c ~payer f =
+  Lwt.return (Raw_context.init_storage_space_to_pay c) >>=? fun c ->
+  f c >>=? fun (c, ret) ->
+  burn_fees_for_storage c ~payer >>=? fun c ->
+  return (c, ret)

src/proto_alpha/lib_protocol/src/fees.mli

@@ -7,14 +7,17 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Alpha_context
-
 type error += Cannot_pay_storage_fee
 
 val origination_burn:
-  Alpha_context.t -> payer:Contract.t ->
+  Raw_context.t -> payer:Contract_repr.t -> (Raw_context.t * Tez_repr.t) tzresult Lwt.t
-  Contract.t -> (Alpha_context.t * Z.t * Tez.t) tzresult Lwt.t
 
-val update_script_storage:
+(** The returned Tez quantity is for logging purpose only *)
-  Alpha_context.t -> payer:Contract.t ->
+val record_paid_storage_space:
-  Contract.t -> (Alpha_context.t * Z.t * Tez.t) tzresult Lwt.t
+  Raw_context.t -> Contract_repr.t ->
+  (Raw_context.t * Z.t * Tez_repr.t) tzresult Lwt.t
+
+val with_fees_for_storage:
+  Raw_context.t -> payer:Contract_repr.t ->
+  (Raw_context.t -> (Raw_context.t * 'a) tzresult Lwt.t) ->
+  (Raw_context.t * 'a) tzresult Lwt.t

src/proto_alpha/lib_protocol/src/raw_context.ml

@@ -23,6 +23,7 @@ type t = {
   rewards: Tez_repr.t ;
   block_gas: Z.t ;
   operation_gas: Gas_limit_repr.t ;
+  storage_space_to_pay: Z.t option ;
   block_storage: Z.t ;
   operation_storage: Storage_limit_repr.t ;
   origination_nonce: Contract_repr.origination_nonce option ;
@@ -181,6 +182,27 @@ let gas_consumed ~since ~until =
 
 type error += Storage_limit_too_high (* `Permanent *)
 
+let init_storage_space_to_pay ctxt =
+  match ctxt.storage_space_to_pay with
+  | Some _ ->
+      assert false
+  | None ->
+      ok { ctxt with storage_space_to_pay = Some Z.zero }
+
+let update_storage_space_to_pay ctxt n =
+  match ctxt.storage_space_to_pay with
+  | None ->
+      assert false
+  | Some storage_space_to_pay ->
+      ok { ctxt with storage_space_to_pay = Some (Z.add n storage_space_to_pay) }
+
+let clear_storage_space_to_pay ctxt =
+  match ctxt.storage_space_to_pay with
+  | None ->
+      assert false
+  | Some storage_space_to_pay ->
+      { ctxt with storage_space_to_pay = None }, storage_space_to_pay
+
 let () =
   let open Data_encoding in
   register_error_kind
@@ -427,6 +449,7 @@ let prepare ~level ~timestamp ~fitness ctxt =
     rewards = Tez_repr.zero ;
     deposits = Signature.Public_key_hash.Map.empty ;
     operation_gas = Unaccounted ;
+    storage_space_to_pay = None ;
     block_gas = constants.Constants_repr.hard_gas_limit_per_block ;
     operation_storage = Unaccounted ;
     block_storage = constants.Constants_repr.hard_storage_limit_per_block ;
@@ -475,6 +498,7 @@ let register_resolvers enc resolve =
       timestamp = Time.of_seconds 0L ;
       fitness = 0L ;
       allowed_endorsements = Signature.Public_key_hash.Map.empty ;
+      storage_space_to_pay = None ;
       fees = Tez_repr.zero ;
       rewards = Tez_repr.zero ;
       deposits = Signature.Public_key_hash.Map.empty ;

src/proto_alpha/lib_protocol/src/raw_context.mli

@@ -88,6 +88,10 @@ val block_gas_level: t -> Z.t
 
 type error += Storage_limit_too_high (* `Permanent *)
 
+val init_storage_space_to_pay: t -> t tzresult
+val update_storage_space_to_pay: t -> Z.t -> t tzresult
+val clear_storage_space_to_pay: t -> t * Z.t
+
 val set_storage_limit: t -> Z.t -> t tzresult
 val set_storage_unlimited: t -> t
 

src/proto_alpha/lib_protocol/src/storage.ml

@@ -172,10 +172,10 @@ module Contract = struct
         let encoding = Script_repr.expr_encoding
       end)
 
-  module Paid_storage_space_fees =
+  module Paid_storage_space =
     Indexed_context.Make_map
       (struct let name = ["paid_bytes"] end)
-      (Tez_repr)
+      (Z)
 
   module Used_storage_space =
     Indexed_context.Make_map

src/proto_alpha/lib_protocol/src/storage.mli

@@ -179,10 +179,10 @@ module Contract : sig
      and type value = Z.t
      and type t := Raw_context.t
 
-  (** Total fees burnt for storage space. *)
+  (** Maximal space available without needing to burn new fees. *)
-  module Paid_storage_space_fees : Indexed_data_storage
+  module Paid_storage_space : Indexed_data_storage
     with type key = Contract_repr.t
-     and type value = Tez_repr.t
+     and type value = Z.t
      and type t := Raw_context.t
 
   type bigmap_key = Raw_context.t * Contract_repr.t