From c6ffe4a5d94a2657d4fbf889515024df637e8177 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Thu, 22 Mar 2018 16:57:08 +0100 Subject: [PATCH] Alpha: better threading of fees and rewards --- .../lib_protocol/src/alpha_context.ml | 6 +++ .../lib_protocol/src/alpha_context.mli | 6 +++ src/proto_alpha/lib_protocol/src/apply.ml | 50 +++++++++---------- .../lib_protocol/src/helpers_services.ml | 4 +- src/proto_alpha/lib_protocol/src/main.ml | 20 +++----- src/proto_alpha/lib_protocol/src/main.mli | 2 - .../lib_protocol/src/raw_context.ml | 17 +++++++ .../lib_protocol/src/raw_context.mli | 6 +++ .../test/helpers/helpers_apply.ml | 2 +- .../lib_protocol/test/test_activation.ml | 2 +- 10 files changed, 69 insertions(+), 46 deletions(-) diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.ml b/src/proto_alpha/lib_protocol/src/alpha_context.ml index 471ccd55f..5de066bc0 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.ml +++ b/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 diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index 06d0dc973..9e7af9444 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/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 diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml index f39295882..4756d1799 100644 --- a/src/proto_alpha/lib_protocol/src/apply.ml +++ b/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, - Tez.zero, Constants.seed_nonce_revelation_tip) + add_rewards ctxt Constants.seed_nonce_revelation_tip >>=? fun ctxt -> + 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 -> - apply_anonymous_operation ctxt delegate origination_nonce op - >>=? fun (ctxt, origination_nonce, fee, reward) -> - return (ctxt, origination_nonce, - fees >>? Tez.(+?) fee, - 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) + (fun (ctxt, origination_nonce) op -> + apply_anonymous_operation ctxt delegate origination_nonce op) + (ctxt, origination_nonce) ops + >>=? fun (ctxt, origination_nonce) -> + return (ctxt, Contract.originated_contracts origination_nonce, None) | 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, - fees, rewards) -> - return (ctxt, Contract.originated_contracts origination_nonce, err, - Ok fees, Ok rewards) + operation origination_nonce op >>=? fun (ctxt, origination_nonce, err) -> + return (ctxt, Contract.originated_contracts origination_nonce, err) 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 diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.ml b/src/proto_alpha/lib_protocol/src/helpers_services.ml index 99628b624..3024f8ac0 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.ml +++ b/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, contracts, None,_ , _) -> Lwt.return (Ok contracts) + | (_ctxt, _, Some script_err) -> Lwt.return (Error script_err) + | (_ctxt, contracts, None) -> Lwt.return (Ok contracts) let run_parameters ctxt (script, storage, input, amount, contract, origination_nonce) = diff --git a/src/proto_alpha/lib_protocol/src/main.ml b/src/proto_alpha/lib_protocol/src/main.ml index 94769d59e..d26a1e088 100644 --- a/src/proto_alpha/lib_protocol/src/main.ml +++ b/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 ; - fees = Alpha_context.Tez.zero ; - rewards = Alpha_context.Tez.zero } + return { mode ; ctxt ; op_count = 0 ; deposit } 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 ; - fees = Alpha_context.Tez.zero ; - rewards = Alpha_context.Tez.zero } + return { mode ; ctxt ; op_count = 0 ; deposit } 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 -> - Lwt.return Alpha_context.Tez.(rewards >>? (+?) data.rewards) >>=? fun rewards -> - return { data with ctxt ; op_count ; fees ; rewards } + return { data with ctxt ; op_count } -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 diff --git a/src/proto_alpha/lib_protocol/src/main.mli b/src/proto_alpha/lib_protocol/src/main.mli index b068654b7..15b8f1c51 100644 --- a/src/proto_alpha/lib_protocol/src/main.mli +++ b/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 diff --git a/src/proto_alpha/lib_protocol/src/raw_context.ml b/src/proto_alpha/lib_protocol/src/raw_context.ml index 05835bfcf..bf3dbcca2 100644 --- a/src/proto_alpha/lib_protocol/src/raw_context.ml +++ b/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 diff --git a/src/proto_alpha/lib_protocol/src/raw_context.mli b/src/proto_alpha/lib_protocol/src/raw_context.mli index e17fea0f4..9cc981436 100644 --- a/src/proto_alpha/lib_protocol/src/raw_context.mli +++ b/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 diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_apply.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_apply.ml index d97c01086..e9aa80543 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_apply.ml +++ b/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) diff --git a/src/proto_alpha/lib_protocol/test/test_activation.ml b/src/proto_alpha/lib_protocol/test/test_activation.ml index 4af103a78..c21f295f4 100644 --- a/src/proto_alpha/lib_protocol/test/test_activation.ml +++ b/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