Alpha: Fix burns

src/proto_alpha/lib_protocol/src/alpha_context.ml

@@ -84,6 +84,11 @@ end
 module Contract = struct
   include Contract_repr
   include Contract_storage
+
+  let originate c contract ~balance ~manager ?script ~delegate
+      ~spendable ~delegatable =
+    originate c contract ~balance ~manager ?script ~delegate
+      ~spendable ~delegatable
   let init_origination_nonce = Raw_context.init_origination_nonce
   let unset_origination_nonce = Raw_context.unset_origination_nonce
   type error += Block_storage_quota_exceeded = Storage_limit_repr.Block_quota_exceeded

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -547,7 +547,8 @@ module Contract : sig
   type big_map_diff = (Script_expr_hash.t * Script.expr option) list
 
   val originate:
-    context -> contract ->
+    context ->
+    contract ->
     balance: Tez.t ->
     manager: public_key_hash ->
     ?script: (Script.t * big_map_diff option) ->

src/proto_alpha/lib_protocol/src/bootstrap_storage.ml

@@ -26,6 +26,7 @@ let init_contract ~typecheck ctxt
   typecheck ctxt script >>=? fun ctxt ->
   Contract_storage.originate ctxt contract
     ~balance:amount
+    ~prepaid_bootstrap_storage:true
     ~manager:Signature.Public_key_hash.zero
     ~script:(script, None)
     ~delegate:(Some delegate)

src/proto_alpha/lib_protocol/src/contract_storage.ml

@@ -201,13 +201,13 @@ let update_script_big_map c contract = function
               return (c, Z.add total (Z.of_int size_diff)))
         (c, Z.zero) diff
 
-let create_base c contract
+let create_base c
+    ?(prepaid_bootstrap_storage=false) (* Free space for bootstrap contracts *)
+    contract
     ~balance ~manager ~delegate ?script ~spendable ~delegatable =
   (match Contract_repr.is_implicit contract with
    | None -> return Z.zero
-   | Some _ ->
-       Storage.Contract.Paid_storage_space.init c contract Z.zero >>=? fun c ->
-       Storage.Contract.Global_counter.get c) >>=? fun counter ->
+   | Some _ -> Storage.Contract.Global_counter.get c) >>=? fun counter ->
   Storage.Contract.Balance.init c contract balance >>=? fun c ->
   Storage.Contract.Manager.init c contract (Manager_repr.Hash manager) >>=? fun c ->
   begin
@@ -226,10 +226,18 @@ let create_base c contract
        update_script_big_map c contract big_map_diff >>=? fun (c, big_map_size) ->
        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) ;
+       let prepaid_bootstrap_storage =
+         if prepaid_bootstrap_storage then
+           total_size
+         else
+           Z.zero
+       in
+       Storage.Contract.Paid_storage_space.init c contract prepaid_bootstrap_storage >>=? fun c ->
        Storage.Contract.Used_storage_space.init c contract total_size
    | None -> begin
        match Contract_repr.is_implicit contract with
        | None ->
+           Storage.Contract.Paid_storage_space.init c contract Z.zero >>=? fun c ->
            Storage.Contract.Used_storage_space.init c contract Z.zero
        | Some _ ->
            return c
@@ -237,11 +245,14 @@ let create_base c contract
        return c) >>=? fun c ->
   return c
 
-let originate c contract ~balance ~manager ?script ~delegate ~spendable ~delegatable =
-  create_base c contract ~balance ~manager ~delegate ?script ~spendable ~delegatable
+let originate c ?prepaid_bootstrap_storage contract
+    ~balance ~manager ?script ~delegate ~spendable ~delegatable =
+  create_base c ?prepaid_bootstrap_storage contract ~balance ~manager
+    ~delegate ?script ~spendable ~delegatable
 
-let create_implicit c manager ~balance =
-  create_base c (Contract_repr.implicit_contract manager)
+let create_implicit c manager ~balance : Raw_context.t tzresult Lwt.t =
+  create_base c
+    (Contract_repr.implicit_contract manager)
     ~balance ~manager ?script:None ~delegate:None
     ~spendable:true ~delegatable:false
 
@@ -473,13 +484,13 @@ let paid_storage_space c contract =
   | None -> return Z.zero
   | Some paid_space -> return paid_space
 
-let record_paid_storage_space c contract paid_storage =
-  Storage.Contract.Used_storage_space.get c contract >>=? fun already_paid_fees ->
-  if Compare.Z.(already_paid_fees >= paid_storage) then
+let set_paid_storage_space_and_return_fees_to_pay c contract new_storage_space =
+  Storage.Contract.Paid_storage_space.get c contract >>=? fun already_paid_space ->
+  if Compare.Z.(already_paid_space >= new_storage_space) then
     return (Z.zero, c)
   else
-    let to_pay = Z.sub paid_storage already_paid_fees in
-    Storage.Contract.Paid_storage_space.set c contract paid_storage >>=? fun c ->
+    let to_pay = Z.sub new_storage_space already_paid_space in
+    Storage.Contract.Paid_storage_space.set c contract new_storage_space >>=? fun c ->
     return (to_pay, c)
 
 module Big_map = struct

src/proto_alpha/lib_protocol/src/contract_storage.mli

@@ -84,6 +84,7 @@ val spend_from_script:
 
 val originate:
   Raw_context.t ->
+  ?prepaid_bootstrap_storage:bool ->
   Contract_repr.t ->
   balance:Tez_repr.t ->
   manager:Signature.Public_key_hash.t ->
@@ -105,7 +106,7 @@ val init:
 
 val used_storage_space: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
 val paid_storage_space: Raw_context.t -> Contract_repr.t -> Z.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
+val set_paid_storage_space_and_return_fees_to_pay: 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_storage.ml

@@ -28,7 +28,7 @@ let origination_burn c ~payer =
 
 let record_paid_storage_space c contract =
   Contract_storage.used_storage_space c contract >>=? fun size ->
-  Contract_storage.record_paid_storage_space c contract size >>=? fun (to_be_paid, c) ->
+  Contract_storage.set_paid_storage_space_and_return_fees_to_pay c contract size >>=? fun (to_be_paid, c) ->
   Lwt.return (Raw_context.update_storage_space_to_pay c to_be_paid) >>=? fun c ->
   let cost_per_byte = Constants_storage.cost_per_byte c in
   Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 to_be_paid))) >>=? fun to_burn ->