Alpha: better threading of fees and rewards

src/proto_alpha/lib_protocol/src/alpha_context.ml

@@ -111,3 +111,9 @@ let fork_test_chain = Raw_context.fork_test_chain
 
 let endorsement_already_recorded = Raw_context.endorsement_already_recorded
 let record_endorsement = Raw_context.record_endorsement
+
+let add_fees = Raw_context.add_fees
+let add_rewards = Raw_context.add_rewards
+
+let get_fees = Raw_context.get_fees
+let get_rewards = Raw_context.get_rewards

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -818,3 +818,9 @@ val fork_test_chain: context -> Protocol_hash.t -> Time.t -> context Lwt.t
 
 val endorsement_already_recorded: context -> int -> bool
 val record_endorsement: context -> int -> context
+
+val add_fees: context -> Tez.t -> context tzresult Lwt.t
+val add_rewards: context -> Tez.t -> context tzresult Lwt.t
+
+val get_fees: context -> Tez.t
+val get_rewards: context -> Tez.t

src/proto_alpha/lib_protocol/src/apply.ml

@@ -454,6 +454,7 @@ let apply_sourced_operation
       Contract.check_counter_increment ctxt source counter >>=? fun () ->
       Contract.increment_counter ctxt source >>=? fun ctxt ->
       Contract.spend ctxt source fee >>=? fun ctxt ->
+      add_fees ctxt fee >>=? fun ctxt ->
       fold_left_s (fun (ctxt, origination_nonce, err) content ->
           match err with
           | Some _ -> return (ctxt, origination_nonce, err)
@@ -463,38 +464,38 @@ let apply_sourced_operation
                 ctxt origination_nonce source content)
         (ctxt, origination_nonce, None) contents
       >>=? fun (ctxt, origination_nonce, err) ->
-      return (ctxt, origination_nonce, err, fee, Tez.zero)
+      return (ctxt, origination_nonce, err)
   | Consensus_operation content ->
       apply_consensus_operation_content ctxt
         pred_block block_prio operation content >>=? fun ctxt ->
-      return (ctxt, origination_nonce, None, Tez.zero, Tez.zero)
+      return (ctxt, origination_nonce, None)
   | Amendment_operation { source ; operation = content } ->
       Roll.delegate_pubkey ctxt source >>=? fun delegate ->
       Operation.check_signature delegate operation >>=? fun () ->
       (* TODO, see how to extract the public key hash after this operation to
          pass it to apply_delegate_operation_content *)
       apply_amendment_operation_content ctxt source content >>=? fun ctxt ->
-      return (ctxt, origination_nonce, None, Tez.zero, Tez.zero)
+      return (ctxt, origination_nonce, None)
   | Dictator_operation (Activate hash) ->
       let dictator_pubkey = Constants.dictator_pubkey ctxt in
       Operation.check_signature dictator_pubkey operation >>=? fun () ->
       activate ctxt hash >>= fun ctxt ->
-      return (ctxt, origination_nonce, None, Tez.zero, Tez.zero)
+      return (ctxt, origination_nonce, None)
   | Dictator_operation (Activate_testchain hash) ->
       let dictator_pubkey = Constants.dictator_pubkey ctxt in
       Operation.check_signature dictator_pubkey operation >>=? fun () ->
       let expiration = (* in two days maximum... *)
         Time.add (Timestamp.current ctxt) (Int64.mul 48L 3600L) in
       fork_test_chain ctxt hash expiration >>= fun ctxt ->
-      return (ctxt, origination_nonce, None, Tez.zero, Tez.zero)
+      return (ctxt, origination_nonce, None)
 
 let apply_anonymous_operation ctxt _delegate origination_nonce kind =
   match kind with
   | Seed_nonce_revelation { level ; nonce } ->
       let level = Level.from_raw ctxt level in
       Nonce.reveal ctxt level nonce >>=? fun ctxt ->
-      return (ctxt, origination_nonce,
+      add_rewards ctxt Constants.seed_nonce_revelation_tip >>=? fun ctxt ->
-              Tez.zero, Constants.seed_nonce_revelation_tip)
+      return (ctxt, origination_nonce)
   | Double_endorsement_evidence { op1 ; op2 } -> begin
       match op1.contents, op2.contents with
       | Sourced_operations (Consensus_operation (Endorsements e1)),
@@ -532,7 +533,8 @@ let apply_anonymous_operation ctxt _delegate origination_nonce kind =
             match Tez.(burned /? 2L) with
             | Ok v -> v
             | Error _ -> Tez.zero in
-          return (ctxt, origination_nonce, Tez.zero, reward)
+          add_rewards ctxt reward >>=? fun ctxt ->
+          return (ctxt, origination_nonce)
       | _, _ -> fail Invalid_double_endorsement_evidence
     end
   | Double_baking_evidence { bh1 ; bh2 } ->
@@ -570,7 +572,8 @@ let apply_anonymous_operation ctxt _delegate origination_nonce kind =
         match Tez.(burned /? 2L) with
         | Ok v -> v
         | Error _ -> Tez.zero in
-      return (ctxt, origination_nonce, Tez.zero, reward)
+      add_rewards ctxt reward >>=? fun ctxt ->
+      return (ctxt, origination_nonce)
   | Activation { id = pkh ; secret } ->
       let h_pkh = Unclaimed_public_key_hash.of_ed25519_pkh pkh in
       Commitment.get_opt ctxt h_pkh >>=? function
@@ -582,7 +585,7 @@ let apply_anonymous_operation ctxt _delegate origination_nonce kind =
             Wrong_activation_secret >>=? fun () ->
           Commitment.delete ctxt h_pkh >>=? fun ctxt ->
           Contract.(credit ctxt (implicit_contract pkh) amount) >>=? fun ctxt ->
-          return (ctxt, origination_nonce,  Tez.zero, Tez.zero)
+          return (ctxt, origination_nonce)
 
 let apply_operation
     ctxt delegate pred_block block_prio hash operation =
@@ -590,24 +593,17 @@ let apply_operation
   | Anonymous_operations ops ->
       let origination_nonce = Contract.initial_origination_nonce hash in
       fold_left_s
-        (fun (ctxt, origination_nonce, fees, rewards) op ->
+        (fun (ctxt, origination_nonce) op ->
-           apply_anonymous_operation ctxt delegate origination_nonce op
+           apply_anonymous_operation ctxt delegate origination_nonce op)
-           >>=? fun (ctxt, origination_nonce, fee, reward) ->
+        (ctxt, origination_nonce) ops
-           return (ctxt, origination_nonce,
+      >>=? fun (ctxt, origination_nonce) ->
-                   fees >>? Tez.(+?) fee,
+      return (ctxt, Contract.originated_contracts origination_nonce, None)
-                   rewards >>? Tez.(+?) reward))
-        (ctxt, origination_nonce, Ok Tez.zero, Ok Tez.zero) ops
-      >>=? fun (ctxt, origination_nonce, fees, rewards) ->
-      return (ctxt, Contract.originated_contracts origination_nonce, None,
-              fees, rewards)
   | Sourced_operations op ->
       let origination_nonce = Contract.initial_origination_nonce hash in
       apply_sourced_operation
         ctxt pred_block block_prio
-        operation origination_nonce op >>=? fun (ctxt, origination_nonce, err,
+        operation origination_nonce op >>=? fun (ctxt, origination_nonce, err) ->
-                                                 fees, rewards) ->
+      return (ctxt, Contract.originated_contracts origination_nonce, err)
-      return (ctxt, Contract.originated_contracts origination_nonce, err,
-              Ok fees, Ok rewards)
 
 let may_snapshot_roll ctxt =
   let level = Alpha_context.Level.current ctxt in
@@ -666,10 +662,12 @@ let begin_application ctxt block_header pred_timestamp =
   let ctxt = Fitness.increase ctxt in
   return (ctxt, delegate_pk, deposit)
 
-let finalize_application ctxt protocol_data delegate deposit fees rewards =
+let finalize_application ctxt protocol_data delegate deposit =
+  add_rewards ctxt Constants.block_reward >>=? fun ctxt ->
   (* end of level (from this point nothing should fail) *)
-  Lwt.return Tez.(rewards +? Constants.block_reward) >>=? fun rewards ->
+  let fees = Alpha_context.get_fees ctxt in
   Delegate.freeze_fees ctxt delegate fees >>=? fun ctxt ->
+  let rewards = Alpha_context.get_rewards ctxt in
   Delegate.freeze_rewards ctxt delegate rewards >>=? fun ctxt ->
   begin
     match protocol_data.Block_header.seed_nonce_hash with

src/proto_alpha/lib_protocol/src/helpers_services.ml

@@ -140,8 +140,8 @@ module I = struct
         Apply.apply_operation
           ctxt (Some baker_pkh) pred_block block_prio hash operation
         >>=? function
-        | (_ctxt, _, Some script_err, _, _) -> Lwt.return (Error script_err)
+        | (_ctxt, _, Some script_err) -> Lwt.return (Error script_err)
-        | (_ctxt, contracts, None,_ , _) -> Lwt.return (Ok contracts)
+        | (_ctxt, contracts, None) -> Lwt.return (Ok contracts)
 
 
   let run_parameters ctxt (script, storage, input, amount, contract, origination_nonce) =

src/proto_alpha/lib_protocol/src/main.ml

@@ -45,8 +45,6 @@ type validation_state =
     ctxt : Alpha_context.t ;
     op_count : int ;
     deposit : Alpha_context.Tez.t ;
-    fees : Alpha_context.Tez.t ;
-    rewards : Alpha_context.Tez.t ;
   }
 
 let current_context { ctxt ; _ } =
@@ -73,9 +71,7 @@ let begin_application
   Apply.begin_application
     ctxt block_header pred_timestamp >>=? fun (ctxt, baker, deposit) ->
   let mode = Application { block_header ; baker = Ed25519.Public_key.hash baker } in
-  return { mode ; ctxt ; op_count = 0 ; deposit ;
+  return { mode ; ctxt ; op_count = 0 ; deposit }
-           fees = Alpha_context.Tez.zero ;
-           rewards = Alpha_context.Tez.zero }
 
 let begin_construction
     ~predecessor_context:ctxt
@@ -104,9 +100,7 @@ let begin_construction
           Full_construction { predecessor ; baker ; protocol_data } in
         return (mode, ctxt, deposit)
   end >>=? fun (mode, ctxt, deposit) ->
-  return { mode ; ctxt ; op_count = 0 ; deposit ;
+  return { mode ; ctxt ; op_count = 0 ; deposit }
-           fees = Alpha_context.Tez.zero ;
-           rewards = Alpha_context.Tez.zero  }
 
 let apply_operation ({ mode ; ctxt ; op_count ; _ } as data) operation =
   let pred_block, block_prio, baker =
@@ -122,13 +116,11 @@ let apply_operation ({ mode ; ctxt ; op_count ; _ } as data) operation =
         Some baker in
   Apply.apply_operation ctxt baker pred_block block_prio
     (Alpha_context.Operation.hash operation) operation
-  >>=? fun (ctxt, _contracts, _ignored_script_error, fees, rewards) ->
+  >>=? fun (ctxt, _contracts, _ignored_script_error) ->
   let op_count = op_count + 1 in
-  Lwt.return Alpha_context.Tez.(fees >>? (+?) data.fees) >>=? fun fees ->
+  return { data with ctxt ; op_count }
-  Lwt.return Alpha_context.Tez.(rewards >>? (+?) data.rewards) >>=? fun rewards ->
-  return { data with ctxt ; op_count ; fees ; rewards }
 
-let finalize_block { mode ; ctxt ; op_count ; deposit ; fees ; rewards } =
+let finalize_block { mode ; ctxt ; op_count ; deposit } =
   match mode with
   | Partial_construction _ ->
       let ctxt = Alpha_context.finalize ctxt in
@@ -137,7 +129,7 @@ let finalize_block { mode ; ctxt ; op_count ; deposit ; fees ; rewards } =
       { baker ;  block_header = { protocol_data ; _ } }
   | Full_construction { protocol_data ; baker ; _ } ->
       Apply.finalize_application
-        ctxt protocol_data baker deposit fees rewards >>=? fun ctxt ->
+        ctxt protocol_data baker deposit  >>=? fun ctxt ->
       let { level ; _ } : Alpha_context.Level.t =
         Alpha_context. Level.current ctxt in
       let priority = protocol_data.priority in

src/proto_alpha/lib_protocol/src/main.mli

@@ -28,8 +28,6 @@ type validation_state =
     ctxt : Alpha_context.t ;
     op_count : int ;
     deposit : Alpha_context.Tez.t ;
-    fees : Alpha_context.Tez.t ;
-    rewards : Alpha_context.Tez.t ;
   }
 
 include Updater.PROTOCOL with type operation = Alpha_context.Operation.t

src/proto_alpha/lib_protocol/src/raw_context.ml

@@ -17,6 +17,8 @@ type t = {
   timestamp: Time.t ;
   fitness: Int64.t ;
   endorsements_received: Int_set.t;
+  fees: Tez_repr.t ;
+  rewards: Tez_repr.t ;
 }
 
 type context = t
@@ -34,6 +36,17 @@ let endorsement_already_recorded ctxt k = Int_set.mem k ctxt.endorsements_receiv
 
 let set_current_fitness ctxt fitness = { ctxt with fitness }
 
+let add_fees ctxt fees =
+  Lwt.return Tez_repr.(ctxt.fees +? fees) >>=? fun fees ->
+  return { ctxt with fees}
+
+let add_rewards ctxt rewards =
+  Lwt.return Tez_repr.(ctxt.rewards +? rewards) >>=? fun rewards ->
+  return { ctxt with rewards}
+
+let get_rewards ctxt = ctxt.rewards
+let get_fees ctxt = ctxt.fees
+
 type storage_error =
   | Incompatible_protocol_version of string
   | Missing_key of string list * [`Get | `Set | `Del | `Copy]
@@ -234,6 +247,8 @@ let prepare ~level ~timestamp ~fitness ctxt =
     context = ctxt ; constants ; level ;
     timestamp ; fitness ; first_level ;
     endorsements_received = Int_set.empty ;
+    fees = Tez_repr.zero ;
+    rewards = Tez_repr.zero ;
   }
 
 let check_first_block ctxt =
@@ -278,6 +293,8 @@ let register_resolvers enc resolve =
       timestamp = Time.of_seconds 0L ;
       fitness = 0L ;
       endorsements_received = Int_set.empty ;
+      fees = Tez_repr.zero ;
+      rewards = Tez_repr.zero ;
     } in
     resolve faked_context str in
   Context.register_resolver enc  resolve

src/proto_alpha/lib_protocol/src/raw_context.mli

@@ -62,6 +62,12 @@ val set_current_fitness: context -> Int64.t -> t
 val constants: context -> Constants_repr.parametric
 val first_level: context -> Raw_level_repr.t
 
+val add_fees: context -> Tez_repr.t -> context tzresult Lwt.t
+val add_rewards: context -> Tez_repr.t -> context tzresult Lwt.t
+
+val get_fees: context -> Tez_repr.t
+val get_rewards: context -> Tez_repr.t
+
 (** {1 Generic accessors} *************************************************)
 
 type key = string list

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

@@ -20,7 +20,7 @@ let operation
     pred_block_hash
     0
     hash
-    operation >>=? fun (tc, contracts, err, _fees, _rewards) ->
+    operation >>=? fun (tc, contracts, err) ->
   return ((contracts, err), tc)
 
 

src/proto_alpha/lib_protocol/test/test_activation.ml

@@ -78,7 +78,7 @@ let test_simple_activation () =
     starting_block.tezos_context
     None
     starting_block.hash
-    activation_operation >>=? fun (ctxt, _, _, _) ->
+    activation_operation >>=? fun (ctxt, _) ->
 
   let contract = Contract.implicit_contract pkh in