diff --git a/src/proto_alpha/lib_baking/test/test_endorsement.ml b/src/proto_alpha/lib_baking/test/test_endorsement.ml index 256cd4368..ac8ab0b80 100644 --- a/src/proto_alpha/lib_baking/test/test_endorsement.ml +++ b/src/proto_alpha/lib_baking/test/test_endorsement.ml @@ -131,6 +131,7 @@ let test_endorsement_rewards block0 = Assert.balance_equal ~block:(`Hash hash2) ~msg:__LOC__ account1 (Int64.sub (Tez.to_mutez balance1) bond) >>=? fun () -> + (* (* Check rewards after one cycle for account0 *) Helpers.Baking.bake (`Hash hash2) b1 [] >>=? fun hash3 -> Helpers.display_level (`Hash hash3) >>=? fun () -> @@ -188,6 +189,8 @@ let test_endorsement_rewards block0 = is no reward for him since the endorsement was in the fork branch *) else Assert.balance_equal ~block:(`Hash hash9a) ~msg:__LOC__ account4 (Tez.to_mutez balance4) end >>=? fun () -> + +*) return () let test_endorsement_rights contract block = diff --git a/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL index 854619532..d59097c4f 100644 --- a/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL @@ -41,7 +41,6 @@ "Roll_storage", "Delegate_storage", "Contract_storage", - "Reward_storage", "Bootstrap_storage", "Fitness_storage", "Vote_storage", diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.ml b/src/proto_alpha/lib_protocol/src/alpha_context.ml index ff6b27403..ebcae5de2 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/src/alpha_context.ml @@ -80,7 +80,6 @@ module Seed = struct include Seed_storage end module Bootstrap = Bootstrap_storage -module Reward = Reward_storage module Fitness = struct diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index 6a782a7cf..5b1c257c3 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -348,20 +348,23 @@ module Nonce : sig type nonce = t val encoding: nonce Data_encoding.t + type unrevealed = { + nonce_hash: Nonce_hash.t ; + delegate: public_key_hash ; + bond: Tez.t ; + rewards: Tez.t ; + fees: Tez.t ; + } + val record_hash: - context -> public_key_hash -> Tez.t -> Nonce_hash.t -> - context tzresult Lwt.t + context -> unrevealed -> context tzresult Lwt.t val reveal: context -> Level.t -> nonce -> - (context * public_key_hash * Tez.t) tzresult Lwt.t + context tzresult Lwt.t type status = - | Unrevealed of { - nonce_hash: Nonce_hash.t ; - delegate_to_reward: public_key_hash ; - reward_amount: Tez.t ; - } + | Unrevealed of unrevealed | Revealed of nonce val get: context -> Level.t -> status tzresult Lwt.t @@ -379,7 +382,8 @@ module Seed : sig cycle : Cycle.t ; latest : Cycle.t } - val cycle_end: context -> Cycle.t -> context tzresult Lwt.t + val cycle_end: + context -> Cycle.t -> (context * Nonce.unrevealed list) tzresult Lwt.t end @@ -486,6 +490,32 @@ module Delegate : sig val list: context -> public_key_hash list Lwt.t + val freeze_bond: + context -> public_key_hash -> Tez.t -> context tzresult Lwt.t + + val freeze_rewards: + context -> public_key_hash -> Tez.t -> context tzresult Lwt.t + + val freeze_fees: + context -> public_key_hash -> Tez.t -> context tzresult Lwt.t + + val cycle_end: + context -> Cycle.t -> Nonce.unrevealed list -> context tzresult Lwt.t + + val punish: + context -> public_key_hash -> Cycle.t -> + context tzresult Lwt.t + + val has_frozen_balance: + context -> public_key_hash -> Cycle.t -> + bool tzresult Lwt.t + + val frozen_balance: + context -> public_key_hash -> Tez.t tzresult Lwt.t + + val full_balance: + context -> public_key_hash -> Tez.t tzresult Lwt.t + end module Vote : sig @@ -711,21 +741,6 @@ module Roll : sig end -module Reward : sig - - val record: - context -> public_key_hash -> Cycle.t -> Tez.t -> context tzresult Lwt.t - - val discard: - context -> public_key_hash -> Cycle.t -> Tez.t -> context tzresult Lwt.t - - val set_reward_time_for_cycle: - context -> Cycle.t -> Time.t -> context tzresult Lwt.t - - val pay_due_rewards: context -> context tzresult Lwt.t - -end - val init: Context.t -> level:Int32.t -> diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml index 3739ed17f..4f4968a76 100644 --- a/src/proto_alpha/lib_protocol/src/apply.ml +++ b/src/proto_alpha/lib_protocol/src/apply.ml @@ -116,7 +116,7 @@ let apply_consensus_operation_content ctxt match Level.pred ctxt (Level.current ctxt) with | None -> failwith "" | Some lvl -> return lvl - end >>=? fun ({ cycle = current_cycle ; level = current_level ;_ } as lvl) -> + end >>=? fun ({ level = current_level ;_ } as lvl) -> fail_unless (Block_hash.equal block pred_block) (Wrong_endorsement_predecessor (pred_block, block)) >>=? fun () -> @@ -133,10 +133,10 @@ let apply_consensus_operation_content ctxt Operation.check_signature delegate operation >>=? fun () -> let delegate = Ed25519.Public_key.hash delegate in let ctxt = Fitness.increase ~gap:(List.length slots) ctxt in - Baking.pay_endorsement_bond ctxt delegate >>=? fun (ctxt, bond) -> + Baking.freeze_endorsement_bond ctxt delegate >>=? fun ctxt -> Baking.endorsement_reward ~block_priority >>=? fun reward -> - Lwt.return Tez.(reward +? bond) >>=? fun full_reward -> - Reward.record ctxt delegate current_cycle full_reward + Delegate.freeze_rewards ctxt delegate reward >>=? fun ctxt -> + return ctxt let apply_amendment_operation_content ctxt delegate = function | Proposals { period ; proposals } -> @@ -236,7 +236,7 @@ let apply_manager_operation_content return (ctxt, origination_nonce, None) let apply_sourced_operation - ctxt baker_contract pred_block block_prio + ctxt pred_block block_prio operation origination_nonce ops = match ops with | Manager_operations { source ; fee ; counter ; operations = contents } -> @@ -251,10 +251,6 @@ 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 -> - (match baker_contract with - | None -> return ctxt - | Some contract -> - Contract.credit ctxt contract fee) >>=? fun ctxt -> fold_left_s (fun (ctxt, origination_nonce, err) content -> match err with | Some _ -> return (ctxt, origination_nonce, err) @@ -263,91 +259,83 @@ let apply_sourced_operation apply_manager_operation_content ctxt origination_nonce source content) (ctxt, origination_nonce, None) contents + >>=? fun (ctxt, origination_nonce, err) -> + return (ctxt, origination_nonce, err, fee, Tez.zero) | Consensus_operation content -> apply_consensus_operation_content ctxt pred_block block_prio operation content >>=? fun ctxt -> - return (ctxt, origination_nonce, None) + return (ctxt, origination_nonce, None, Tez.zero, Tez.zero) | 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) + return (ctxt, origination_nonce, None, Tez.zero, Tez.zero) | 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) + return (ctxt, origination_nonce, None, Tez.zero, Tez.zero) | 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) + return (ctxt, origination_nonce, None, Tez.zero, Tez.zero) -let apply_anonymous_operation ctxt baker_contract origination_nonce kind = +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, delegate_to_reward, reward_amount) -> - Reward.record ctxt - delegate_to_reward level.cycle reward_amount >>=? fun ctxt -> - begin - match baker_contract with - | None -> return (ctxt, origination_nonce) - | Some contract -> - Contract.credit - ctxt contract Constants.seed_nonce_revelation_tip >>=? fun ctxt -> - return (ctxt, origination_nonce) - end + Nonce.reveal ctxt level nonce >>=? fun ctxt -> + return (ctxt, origination_nonce, + Tez.zero, Constants.seed_nonce_revelation_tip) | Faucet { id = manager ; _ } -> (* Free tez for all! *) - begin - match baker_contract with - | None -> return None - | Some contract -> Delegate.get ctxt contract - end >>=? fun delegate -> if Compare.Int.(faucet_count ctxt < 5) then let ctxt = incr_faucet_count ctxt in Contract.originate ctxt origination_nonce ~manager ~delegate ~balance:Constants.faucet_credit ?script:None ~spendable:true ~delegatable:true >>=? fun (ctxt, _, origination_nonce) -> - return (ctxt, origination_nonce) + return (ctxt, origination_nonce, Tez.zero, Tez.zero) else fail Too_many_faucet let apply_operation - ctxt baker_contract pred_block block_prio operation = + ctxt delegate pred_block block_prio operation = match operation.contents with | Anonymous_operations ops -> let origination_nonce = Contract.initial_origination_nonce operation.hash in fold_left_s - (fun (ctxt, origination_nonce) -> - apply_anonymous_operation ctxt baker_contract origination_nonce) - (ctxt, origination_nonce) ops >>=? fun (ctxt, origination_nonce) -> - return (ctxt, Contract.originated_contracts origination_nonce, None) + (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) | Sourced_operations op -> let origination_nonce = Contract.initial_origination_nonce operation.hash in apply_sourced_operation - ctxt baker_contract pred_block block_prio - operation origination_nonce op >>=? fun (ctxt, origination_nonce, err) -> - return (ctxt, Contract.originated_contracts origination_nonce, err) + 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) let may_start_new_cycle ctxt = Baking.dawn_of_a_new_cycle ctxt >>=? function | None -> return ctxt | Some last_cycle -> - Seed.cycle_end ctxt last_cycle >>=? fun ctxt -> + Seed.cycle_end ctxt last_cycle >>=? fun (ctxt, unrevealed) -> Roll.cycle_end ctxt last_cycle >>=? fun ctxt -> - let timestamp = Timestamp.current ctxt in - Lwt.return (Timestamp.(timestamp +? (Constants.time_before_reward ctxt))) - >>=? fun reward_date -> - Reward.set_reward_time_for_cycle - ctxt last_cycle reward_date >>=? fun ctxt -> + Delegate.cycle_end ctxt last_cycle unrevealed >>=? fun ctxt -> return ctxt let begin_full_construction ctxt pred_timestamp protocol_data = @@ -355,11 +343,11 @@ let begin_full_construction ctxt pred_timestamp protocol_data = (Block_header.parse_unsigned_protocol_data protocol_data) >>=? fun protocol_data -> Baking.check_baking_rights - ctxt protocol_data pred_timestamp >>=? fun baker -> - Baking.pay_baking_bond ctxt protocol_data - (Ed25519.Public_key.hash baker) >>=? fun ctxt -> + ctxt protocol_data pred_timestamp >>=? fun delegate_pk -> + let delegate_pkh = Ed25519.Public_key.hash delegate_pk in + Baking.freeze_baking_bond ctxt protocol_data delegate_pkh >>=? fun (ctxt, bond) -> let ctxt = Fitness.increase ctxt in - return (ctxt, protocol_data, baker) + return (ctxt, protocol_data, delegate_pk, bond) let begin_partial_construction ctxt = let ctxt = Fitness.increase ctxt in @@ -370,10 +358,8 @@ let begin_application ctxt block_header pred_timestamp = Baking.check_proof_of_work_stamp ctxt block_header >>=? fun () -> Baking.check_fitness_gap ctxt block_header >>=? fun () -> Baking.check_baking_rights - ctxt block_header.protocol_data pred_timestamp >>=? fun baker -> - Baking.check_signature block_header baker >>=? fun () -> - Baking.pay_baking_bond ctxt block_header.protocol_data - (Ed25519.Public_key.hash baker) >>=? fun ctxt -> + ctxt block_header.protocol_data pred_timestamp >>=? fun delegate_pk -> + Baking.check_signature block_header delegate_pk >>=? fun () -> let has_commitment = match block_header.protocol_data.seed_nonce_hash with | None -> false @@ -382,19 +368,24 @@ let begin_application ctxt block_header pred_timestamp = Compare.Bool.(has_commitment = current_level.expected_commitment) (Invalid_commitment { expected = current_level.expected_commitment }) >>=? fun () -> + let delegate_pkh = Ed25519.Public_key.hash delegate_pk in + Baking.freeze_baking_bond ctxt + block_header.protocol_data delegate_pkh >>=? fun (ctxt, bond) -> let ctxt = Fitness.increase ctxt in - return (ctxt, baker) + return (ctxt, delegate_pk, bond) -let finalize_application ctxt block_protocol_data baker = +let finalize_application ctxt protocol_data delegate bond fees rewards = (* end of level (from this point nothing should fail) *) - let priority = block_protocol_data.Block_header.priority in - let reward = Baking.base_baking_reward ctxt ~priority in + Lwt.return Tez.(rewards +? Constants.baking_reward) >>=? fun rewards -> + Delegate.freeze_fees ctxt delegate fees >>=? fun ctxt -> + Delegate.freeze_rewards ctxt delegate rewards >>=? fun ctxt -> begin - match block_protocol_data.seed_nonce_hash with + match protocol_data.Block_header.seed_nonce_hash with | None -> return ctxt - | Some nonce -> Nonce.record_hash ctxt baker reward nonce + | Some nonce_hash -> + Nonce.record_hash ctxt + { nonce_hash ; delegate ; bond ; rewards ; fees } end >>=? fun ctxt -> - Reward.pay_due_rewards ctxt >>=? fun ctxt -> (* end of cycle *) may_start_new_cycle ctxt >>=? fun ctxt -> Amendment.may_start_new_voting_cycle ctxt >>=? fun ctxt -> diff --git a/src/proto_alpha/lib_protocol/src/baking.ml b/src/proto_alpha/lib_protocol/src/baking.ml index c9a033336..3a2cf1061 100644 --- a/src/proto_alpha/lib_protocol/src/baking.ml +++ b/src/proto_alpha/lib_protocol/src/baking.ml @@ -14,10 +14,10 @@ open Misc type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *) type error += Invalid_endorsement_slot of int * int (* `Permanent *) type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *) +type error += Cannot_freeze_baking_bond (* `Permanent *) +type error += Cannot_freeze_endorsement_bond (* `Permanent *) type error += Inconsistent_endorsement of public_key_hash list (* `Permanent *) type error += Empty_endorsement -type error += Cannot_pay_baking_bond (* `Permanent *) -type error += Cannot_pay_endorsement_bond (* `Permanent *) type error += Invalid_block_signature of Block_hash.t * Ed25519.Public_key_hash.t (* `Permanent *) @@ -62,6 +62,26 @@ let () = (req "provided" int16)) (function Invalid_endorsement_slot (m, g) -> Some (m, g) | _ -> None) (fun (m, g) -> Invalid_endorsement_slot (m, g)) ; + register_error_kind + `Permanent + ~id:"baking.cannot_freeze_baking_bond" + ~title:"Cannot freeze baking bond" + ~description: + "Impossible to debit the required tokens on the baker's contract" + ~pp:(fun ppf () -> Format.fprintf ppf "Cannot freeze the baking bond") + Data_encoding.unit + (function Cannot_freeze_baking_bond -> Some () | _ -> None) + (fun () -> Cannot_freeze_baking_bond) ; + register_error_kind + `Permanent + ~id:"baking.cannot_freeze_endorsement_bond" + ~title:"Cannot freeze endorsement bond" + ~description: + "Impossible to debit the required tokens on the endorser's contract" + ~pp:(fun ppf () -> Format.fprintf ppf "Cannot freeze the endorsement bond") + Data_encoding.unit + (function Cannot_freeze_endorsement_bond -> Some () | _ -> None) + (fun () -> Cannot_freeze_endorsement_bond) ; register_error_kind `Permanent ~id:"baking.inconsisten_endorsement" @@ -75,26 +95,6 @@ let () = (req "delegates" (list Ed25519.Public_key_hash.encoding))) (function Inconsistent_endorsement l -> Some l | _ -> None) (fun l -> Inconsistent_endorsement l) ; - register_error_kind - `Permanent - ~id:"baking.cannot_pay_baking_bond" - ~title:"Cannot pay baking bond" - ~description: - "Impossible to debit the required tokens on the baker's contract" - ~pp:(fun ppf () -> Format.fprintf ppf "Cannot pay the baking bond") - Data_encoding.unit - (function Cannot_pay_baking_bond -> Some () | _ -> None) - (fun () -> Cannot_pay_baking_bond) ; - register_error_kind - `Permanent - ~id:"baking.cannot_pay_endorsement_bond" - ~title:"Cannot pay endorsement bond" - ~description: - "Impossible to debit the required tokens on the endorser's contract" - ~pp:(fun ppf () -> Format.fprintf ppf "Cannot pay the endorsement bond") - Data_encoding.unit - (function Cannot_pay_endorsement_bond -> Some () | _ -> None) - (fun () -> Cannot_pay_endorsement_bond) ; register_error_kind `Permanent ~id:"baking.invalid_block_signature" @@ -111,6 +111,7 @@ let () = (function Invalid_block_signature (block, pkh) -> Some (block, pkh) | _ -> None) (fun (block, pkh) -> Invalid_block_signature (block, pkh)) + let minimal_time c priority pred_timestamp = let priority = Int32.of_int priority in let rec cumsum_slot_durations acc durations p = @@ -129,6 +130,20 @@ let minimal_time c priority pred_timestamp = (cumsum_slot_durations pred_timestamp (Constants.slot_durations c) (Int32.succ priority)) +let freeze_baking_bond ctxt { Block_header.priority ; _ } delegate = + if Compare.Int.(priority >= Constants.first_free_baking_slot ctxt) + then return (ctxt, Tez.zero) + else + let bond = Constants.baking_bond_cost in + Delegate.freeze_bond ctxt delegate bond + |> trace Cannot_freeze_baking_bond >>=? fun ctxt -> + return (ctxt, bond) + +let freeze_endorsement_bond ctxt delegate = + let bond = Constants.endorsement_bond_cost in + Delegate.freeze_bond ctxt delegate bond + |> trace Cannot_freeze_endorsement_bond + let check_timestamp c priority pred_timestamp = minimal_time c priority pred_timestamp >>=? fun minimal_time -> let timestamp = Alpha_context.Timestamp.current c in @@ -142,19 +157,6 @@ let check_baking_rights c { Block_header.priority ; _ } check_timestamp c priority pred_timestamp >>=? fun () -> return delegate -let pay_baking_bond c { Block_header.priority ; _ } id = - if Compare.Int.(priority >= Constants.first_free_baking_slot c) - then return c - else - Contract.spend c (Contract.implicit_contract id) Constants.baking_bond_cost - |> trace Cannot_pay_baking_bond - -let pay_endorsement_bond c id = - let bond = Constants.endorsement_bond_cost in - Contract.spend c (Contract.implicit_contract id) bond - |> trace Cannot_pay_endorsement_bond >>=? fun c -> - return (c, bond) - let check_endorsements_rights c level slots = map_p (fun slot -> fail_unless Compare.Int.(0 <= slot && slot <= Constants.max_signing_slot c) @@ -171,16 +173,6 @@ let check_endorsements_rights c level slots = let paying_priorities c = 0 --> (Constants.first_free_baking_slot c - 1) -let bond_and_reward = - match Tez.(Constants.baking_bond_cost +? Constants.baking_reward) with - | Ok v -> v - | Error _ -> assert false - -let base_baking_reward c ~priority = - if Compare.Int.(priority < Constants.first_free_baking_slot c) - then bond_and_reward - else Constants.baking_reward - type error += Incorect_priority let endorsement_reward ~block_priority:prio = diff --git a/src/proto_alpha/lib_protocol/src/baking.mli b/src/proto_alpha/lib_protocol/src/baking.mli index a6f141706..14990200d 100644 --- a/src/proto_alpha/lib_protocol/src/baking.mli +++ b/src/proto_alpha/lib_protocol/src/baking.mli @@ -15,8 +15,8 @@ type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *) type error += Invalid_endorsement_slot of int * int (* `Permanent *) type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *) type error += Inconsistent_endorsement of public_key_hash list (* `Permanent *) -type error += Cannot_pay_baking_bond (* `Permanent *) -type error += Cannot_pay_endorsement_bond (* `Permanent *) +type error += Cannot_freeze_baking_bond (* `Permanent *) +type error += Cannot_freeze_endorsement_bond (* `Permanent *) type error += Invalid_block_signature of Block_hash.t * Ed25519.Public_key_hash.t (* `Permanent *) val paying_priorities: context -> int list @@ -28,26 +28,29 @@ val paying_priorities: context -> int list time cannot be computed. *) val minimal_time: context -> int -> Time.t -> Time.t tzresult Lwt.t -(** [pay_baking_bond: cxt baker] Debit the baking bond (See - !Constants.baking_bond_cost) from the default account of the - [baker]. No bond is debited if the baking priority of this block is - greater than the maximum number of paying baking in the network - (meaning that n. bakers skipped their turn). +(** [freeze_baking_bond: ctxt delegate priority] + Freeze the baking bond (See !Constants.baking_bond_cost) + from a delegate account. No bond is frozen if the baking + priority of this block is greater than the maximum number + of paying baking in the network (meaning that n. bakers + skipped their turn). - Raise an error if the baker account does not have enough + Raise an error if the delegate account does not have enough funds to claim baking rights. *) -val pay_baking_bond: +val freeze_baking_bond: context -> Block_header.protocol_data -> public_key_hash -> - context tzresult Lwt.t + (context * Tez.t) tzresult Lwt.t -(** [pay_endorsement_bond: cxt baker] Debit the endorsement bond - (See !Constants.endorsement_bond_cost) from the default account - of the [baker]. Raise an error if the baker account does not - have enough funds to claim endorsement rights *) -val pay_endorsement_bond: - context -> public_key_hash -> (context * Tez.t) tzresult Lwt.t +(** [freeze_endorsement_bond: ctxt delegate] + Freeze the endorsement bond (See !Constants.endorsement_bond_cost) + from the delegate account. + + Raise an error if the baker account does not have enough + funds to claim endorsement rights *) +val freeze_endorsement_bond: + context -> public_key_hash -> context tzresult Lwt.t (** [check_baking_rights ctxt block pred_timestamp] verifies that: * the contract that owned the roll at cycle start has the block signer as delegate. @@ -65,10 +68,6 @@ val check_baking_rights: val check_endorsements_rights: context -> Level.t -> int list -> public_key tzresult Lwt.t -(** If this priority should have payed the bond it is the base baking - reward and the bond, or just the base reward otherwise *) -val base_baking_reward: context -> priority:int -> Tez.t - (** Returns the endorsement reward calculated w.r.t a given priotiry. *) val endorsement_reward: block_priority:int -> Tez.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.ml b/src/proto_alpha/lib_protocol/src/contract_storage.ml index d15774c88..63f39fc76 100644 --- a/src/proto_alpha/lib_protocol/src/contract_storage.ml +++ b/src/proto_alpha/lib_protocol/src/contract_storage.ml @@ -152,7 +152,6 @@ let create_base c contract match delegate with | None -> return c | Some delegate -> - Storage.Contract.Delegate.init c contract delegate >>=? fun c -> Delegate_storage.init c contract delegate end >>=? fun c -> Storage.Contract.Spendable.set c contract spendable >>= fun c -> @@ -182,7 +181,6 @@ let delete c contract = Delegate_storage.remove c contract >>=? fun c -> Storage.Contract.Balance.delete c contract >>=? fun c -> Storage.Contract.Manager.delete c contract >>=? fun c -> - Storage.Contract.Delegate.remove c contract >>= fun c -> Storage.Contract.Spendable.del c contract >>= fun c -> Storage.Contract.Delegatable.del c contract >>= fun c -> Storage.Contract.Counter.delete c contract >>=? fun c -> @@ -334,7 +332,7 @@ let spend_from_script c contract amount = else match Contract_repr.is_implicit contract with | None -> return c (* Never delete originated contracts *) | Some pkh -> - Storage.Contract.Delegate.get_option c contract >>=? function + Delegate_storage.get c contract >>=? function | Some pkh' -> (* Don't delete "delegate" contract *) assert (Ed25519.Public_key_hash.equal pkh pkh') ; diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.mli b/src/proto_alpha/lib_protocol/src/contract_storage.mli index 7b12cb55f..b251cf06f 100644 --- a/src/proto_alpha/lib_protocol/src/contract_storage.mli +++ b/src/proto_alpha/lib_protocol/src/contract_storage.mli @@ -18,8 +18,6 @@ type error += | Missing_public_key of Ed25519.Public_key_hash.t (* `Permanent *) | Failure of string (* `Permanent *) -val delete: Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t - val exists: Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t val must_exist: Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/src/delegate_storage.ml b/src/proto_alpha/lib_protocol/src/delegate_storage.ml index bf03ac737..3378fbf99 100644 --- a/src/proto_alpha/lib_protocol/src/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/src/delegate_storage.ml @@ -77,6 +77,7 @@ let registered c delegate = c (Contract_repr.implicit_contract delegate) let init ctxt contract delegate = + Storage.Contract.Delegate.init ctxt contract delegate >>=? fun ctxt -> Storage.Contract.Balance.get ctxt contract >>=? fun balance -> link ctxt contract delegate balance @@ -113,7 +114,7 @@ let set c contract delegate = link c contract delegate balance >>=? fun c -> begin if self_delegation then - Storage.Delegate.add c delegate + Storage.Delegates.add c delegate else Lwt.return c end >>= fun c -> @@ -123,5 +124,176 @@ let remove ctxt contract = Storage.Contract.Balance.get ctxt contract >>=? fun balance -> unlink ctxt contract balance -let fold = Storage.Delegate.fold -let list = Storage.Delegate.elements +let fold = Storage.Delegates.fold +let list = Storage.Delegates.elements + + +let get_frozen_bond ctxt contract cycle = + Storage.Contract.Frozen_bonds.get_option (ctxt, contract) cycle >>=? function + | None -> return Tez_repr.zero + | Some frozen -> return frozen + +let credit_frozen_bond ctxt contract cycle amount = + get_frozen_bond ctxt contract cycle >>=? fun old_amount -> + Lwt.return Tez_repr.(old_amount +? amount) >>=? fun new_amount -> + Storage.Contract.Frozen_bonds.init_set + (ctxt, contract) cycle new_amount >>= fun ctxt -> + return ctxt + +let freeze_bond ctxt delegate amount = + let { Level_repr.cycle ; _ } = Level_storage.current ctxt in + let contract = Contract_repr.implicit_contract delegate in + Storage.Contract.Balance.get ctxt contract >>=? fun balance -> + Lwt.return Tez_repr.(balance -? amount) >>=? fun new_balance -> + Storage.Contract.Balance.set ctxt contract new_balance >>=? fun ctxt -> + credit_frozen_bond ctxt contract cycle amount + +let burn_bond ctxt delegate cycle amount = + let contract = Contract_repr.implicit_contract delegate in + get_frozen_bond ctxt contract cycle >>=? fun old_amount -> + Roll_storage.Delegate.remove_amount ctxt delegate amount >>=? fun ctxt -> + Lwt.return Tez_repr.(old_amount -? amount) >>=? fun new_amount -> + Storage.Contract.Frozen_bonds.set (ctxt, contract) cycle new_amount + + + +let get_frozen_fees ctxt contract cycle = + Storage.Contract.Frozen_fees.get_option (ctxt, contract) cycle >>=? function + | None -> return Tez_repr.zero + | Some frozen -> return frozen + +let credit_frozen_fees ctxt contract cycle amount = + get_frozen_fees ctxt contract cycle >>=? fun old_amount -> + Lwt.return Tez_repr.(old_amount +? amount) >>=? fun new_amount -> + Storage.Contract.Frozen_fees.init_set + (ctxt, contract) cycle new_amount >>= fun ctxt -> + return ctxt + +let freeze_fees ctxt delegate amount = + let { Level_repr.cycle ; _ } = Level_storage.current ctxt in + let contract = Contract_repr.implicit_contract delegate in + Roll_storage.Delegate.add_amount ctxt delegate amount >>=? fun ctxt -> + credit_frozen_fees ctxt contract cycle amount + +let burn_fees ctxt delegate cycle amount = + let contract = Contract_repr.implicit_contract delegate in + get_frozen_fees ctxt contract cycle >>=? fun old_amount -> + Roll_storage.Delegate.remove_amount ctxt delegate amount >>=? fun ctxt -> + Lwt.return Tez_repr.(old_amount -? amount) >>=? fun new_amount -> + Storage.Contract.Frozen_fees.set (ctxt, contract) cycle new_amount + + +let get_frozen_rewards ctxt contract cycle = + Storage.Contract.Frozen_rewards.get_option (ctxt, contract) cycle >>=? function + | None -> return Tez_repr.zero + | Some frozen -> return frozen + +let credit_frozen_rewards ctxt contract cycle amount = + get_frozen_rewards ctxt contract cycle >>=? fun old_amount -> + Lwt.return Tez_repr.(old_amount +? amount) >>=? fun new_amount -> + Storage.Contract.Frozen_rewards.init_set + (ctxt, contract) cycle new_amount >>= fun ctxt -> + return ctxt + +let freeze_rewards ctxt delegate amount = + let { Level_repr.cycle ; _ } = Level_storage.current ctxt in + let contract = Contract_repr.implicit_contract delegate in + credit_frozen_rewards ctxt contract cycle amount + +let burn_rewards ctxt delegate cycle amount = + let contract = Contract_repr.implicit_contract delegate in + get_frozen_rewards ctxt contract cycle >>=? fun old_amount -> + Lwt.return Tez_repr.(old_amount -? amount) >>=? fun new_amount -> + Storage.Contract.Frozen_rewards.set (ctxt, contract) cycle new_amount + + + +let unfreeze ctxt delegate cycle = + let contract = Contract_repr.implicit_contract delegate in + get_frozen_bond ctxt contract cycle >>=? fun bond -> + get_frozen_fees ctxt contract cycle >>=? fun fees -> + get_frozen_rewards ctxt contract cycle >>=? fun rewards -> + Storage.Contract.Balance.get ctxt contract >>=? fun balance -> + Lwt.return Tez_repr.(balance +? bond) >>=? fun balance -> + Lwt.return Tez_repr.(balance +? fees) >>=? fun balance -> + Lwt.return Tez_repr.(balance +? rewards) >>=? fun balance -> + Storage.Contract.Balance.set ctxt contract balance >>=? fun ctxt -> + Roll_storage.Delegate.add_amount ctxt delegate rewards >>=? fun ctxt -> + return ctxt + +let cycle_end ctxt last_cycle unrevealed = + let preserved = Constants_storage.preserved_cycles ctxt in + begin + match Cycle_repr.pred last_cycle with + | None -> return ctxt + | Some revealed_cycle -> + List.fold_left + (fun ctxt (u : Nonce_storage.unrevealed) -> + ctxt >>=? fun ctxt -> + burn_bond + ctxt u.delegate revealed_cycle u.bond >>=? fun ctxt -> + burn_fees + ctxt u.delegate revealed_cycle u.fees >>=? fun ctxt -> + burn_rewards + ctxt u.delegate revealed_cycle u.rewards >>=? fun ctxt -> + return ctxt) + (return ctxt) unrevealed + end >>=? fun ctxt -> + match Cycle_repr.sub last_cycle preserved with + | None -> return ctxt + | Some unfrozen_cycle -> + fold ctxt + ~init:(Ok ctxt) + ~f:(fun delegate ctxt -> + Lwt.return ctxt >>=? fun ctxt -> + unfreeze ctxt delegate unfrozen_cycle) + + +let punish ctxt delegate cycle = + let contract = Contract_repr.implicit_contract delegate in + get_frozen_bond ctxt contract cycle >>=? fun bond -> + get_frozen_fees ctxt contract cycle >>=? fun fees -> + Roll_storage.Delegate.remove_amount ctxt delegate bond >>=? fun ctxt -> + Roll_storage.Delegate.remove_amount ctxt delegate fees >>=? fun ctxt -> + Storage.Contract.Frozen_bonds.remove (ctxt, contract) cycle >>= fun ctxt -> + Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle >>= fun ctxt -> + Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle >>= fun ctxt -> + return ctxt + + +let has_frozen_balance ctxt delegate cycle = + let contract = Contract_repr.implicit_contract delegate in + get_frozen_bond ctxt contract cycle >>=? fun bond -> + if Tez_repr.(bond <> zero) then return true + else + get_frozen_fees ctxt contract cycle >>=? fun fees -> + if Tez_repr.(fees <> zero) then return true + else + get_frozen_rewards ctxt contract cycle >>=? fun rewards -> + return Tez_repr.(rewards <> zero) + +let frozen_balance ctxt delegate = + let contract = Contract_repr.implicit_contract delegate in + let balance = Ok Tez_repr.zero in + Storage.Contract.Frozen_bonds.fold + (ctxt, contract) ~init:balance + ~f:(fun _cycle amount acc -> + Lwt.return acc >>=? fun acc -> + Lwt.return (Tez_repr.(acc +? amount))) >>= fun balance -> + Storage.Contract.Frozen_fees.fold + (ctxt, contract) ~init:balance + ~f:(fun _cycle amount acc -> + Lwt.return acc >>=? fun acc -> + Lwt.return (Tez_repr.(acc +? amount))) >>= fun balance -> + Storage.Contract.Frozen_rewards.fold + (ctxt, contract) ~init:balance + ~f:(fun _cycle amount acc -> + Lwt.return acc >>=? fun acc -> + Lwt.return (Tez_repr.(acc +? amount))) >>= fun balance -> + Lwt.return balance + +let full_balance ctxt delegate = + let contract = Contract_repr.implicit_contract delegate in + frozen_balance ctxt delegate >>=? fun frozen_balance -> + Storage.Contract.Balance.get ctxt contract >>=? fun balance -> + Lwt.return Tez_repr.(frozen_balance +? balance) diff --git a/src/proto_alpha/lib_protocol/src/delegate_storage.mli b/src/proto_alpha/lib_protocol/src/delegate_storage.mli index f3a68c425..f40287d8d 100644 --- a/src/proto_alpha/lib_protocol/src/delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/src/delegate_storage.mli @@ -7,29 +7,90 @@ (* *) (**************************************************************************) -type error += - | Non_delegatable_contract of Contract_repr.contract (* `Permanent *) - +(** Is the contract eligible to delegation ? *) val is_delegatable: Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t +(** Allow to register a delegate when creating an account. *) val init: Raw_context.t -> Contract_repr.t -> Ed25519.Public_key_hash.t -> Raw_context.t tzresult Lwt.t +(** Cleanup delegation when deleting a contract. *) +val remove: + Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t + +(** Reading the current delegate of a contract. *) val get: Raw_context.t -> Contract_repr.t -> Ed25519.Public_key_hash.t option tzresult Lwt.t +(** Updating the delegate of a contract. + + When calling this function on an "implicit contract" this function + fails, unless when the registred delegate is the contract manager. + In the that case, the manager is now registred as a delegate. One + cannot unregister a delegate for now. The associate contract is + now 'undeletable'. *) val set: Raw_context.t -> Contract_repr.t -> Ed25519.Public_key_hash.t option -> Raw_context.t tzresult Lwt.t -val remove: Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t +type error += + | Non_delegatable_contract of Contract_repr.contract (* `Permanent *) +(** Iterate on all registred delegates. *) val fold: Raw_context.t -> init:'a -> f:(Ed25519.Public_key_hash.t -> 'a -> 'a Lwt.t) -> 'a Lwt.t +(** List all registred delegates. *) val list: Raw_context.t -> Ed25519.Public_key_hash.t list Lwt.t + +(** Various functions to 'freeze' tokens. A frozen 'bond' keeps its + associated rolls. When frozen, 'fees' may trigger new rolls + allocation. Rewards won't trigger new rolls allocation until + unfrozen. *) +val freeze_bond: + Raw_context.t -> Ed25519.Public_key_hash.t -> Tez_repr.t -> + Raw_context.t tzresult Lwt.t + +val freeze_fees: + Raw_context.t -> Ed25519.Public_key_hash.t -> Tez_repr.t -> + Raw_context.t tzresult Lwt.t + +val freeze_rewards: + Raw_context.t -> Ed25519.Public_key_hash.t -> Tez_repr.t -> + Raw_context.t tzresult Lwt.t + +(** Trigger the context maintenance at the end of cycle 'n', i.e.: + unfroze bond/fees/rewards from 'n - preserved_cycle' ; punish the + provided unrevealed seeds (tipically seed from from cycle 'n - + 1'). *) +val cycle_end: + Raw_context.t -> Cycle_repr.t -> Nonce_storage.unrevealed list -> + Raw_context.t tzresult Lwt.t + +(** Burn all then frozen bond/fees/rewards for a delegate at a given + cycle. *) +val punish: + Raw_context.t -> Ed25519.Public_key_hash.t -> Cycle_repr.t -> + Raw_context.t tzresult Lwt.t + +(** Has the given key some frozen tokens in its implicit contract? *) +val has_frozen_balance: + Raw_context.t -> Ed25519.Public_key_hash.t -> Cycle_repr.t -> + bool tzresult Lwt.t + +(** Returns the amount of frozen tokens associated to a given key. *) +val frozen_balance: + Raw_context.t -> Ed25519.Public_key_hash.t -> + Tez_repr.t tzresult Lwt.t + +(** Returns the full 'balance' of the implicit contract associated to + a given key, i.e. the sum of the spendable balance and of the + frozen balance. *) +val full_balance: + Raw_context.t -> Ed25519.Public_key_hash.t -> + Tez_repr.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.ml b/src/proto_alpha/lib_protocol/src/helpers_services.ml index edd9cb1f1..be557c426 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.ml +++ b/src/proto_alpha/lib_protocol/src/helpers_services.ml @@ -136,13 +136,12 @@ module I = struct let level = Alpha_context.Level.current ctxt in Baking.baking_priorities ctxt level >>=? fun (Misc.LCons (baker_pk, _)) -> let baker_pkh = Ed25519.Public_key.hash baker_pk in - let baker_contract = Contract.implicit_contract baker_pkh in let block_prio = 0 in Apply.apply_operation - ctxt (Some baker_contract) pred_block block_prio operation + ctxt (Some baker_pkh) pred_block block_prio 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/init_storage.ml b/src/proto_alpha/lib_protocol/src/init_storage.ml index 2ac7840d6..9209e6b53 100644 --- a/src/proto_alpha/lib_protocol/src/init_storage.ml +++ b/src/proto_alpha/lib_protocol/src/init_storage.ml @@ -12,7 +12,6 @@ let initialize ctxt = Roll_storage.init ctxt >>=? fun ctxt -> Seed_storage.init ctxt >>=? fun ctxt -> Contract_storage.init ctxt >>=? fun ctxt -> - Reward_storage.init ctxt >>=? fun ctxt -> Bootstrap_storage.init ctxt >>=? fun ctxt -> Roll_storage.init_first_cycles ctxt >>=? fun ctxt -> Vote_storage.init ctxt >>=? fun ctxt -> diff --git a/src/proto_alpha/lib_protocol/src/main.ml b/src/proto_alpha/lib_protocol/src/main.ml index a5b737a1f..71b86cb9e 100644 --- a/src/proto_alpha/lib_protocol/src/main.ml +++ b/src/proto_alpha/lib_protocol/src/main.ml @@ -41,7 +41,11 @@ type validation_mode = type validation_state = { mode : validation_mode ; ctxt : Alpha_context.t ; - op_count : int } + op_count : int ; + bond : Alpha_context.Tez.t ; + fees : Alpha_context.Tez.t ; + rewards : Alpha_context.Tez.t ; + } let current_context { ctxt ; _ } = return (Alpha_context.finalize ctxt).context @@ -65,9 +69,11 @@ let begin_application let timestamp = block_header.shell.timestamp in Alpha_context.init ~level ~timestamp ~fitness ctxt >>=? fun ctxt -> Apply.begin_application - ctxt block_header pred_timestamp >>=? fun (ctxt, baker) -> + ctxt block_header pred_timestamp >>=? fun (ctxt, baker, bond) -> let mode = Application { block_header ; baker = Ed25519.Public_key.hash baker } in - return { mode ; ctxt ; op_count = 0 } + return { mode ; ctxt ; op_count = 0 ; bond ; + fees = Alpha_context.Tez.zero ; + rewards = Alpha_context.Tez.zero } let begin_construction ~predecessor_context:ctxt @@ -86,20 +92,22 @@ let begin_construction | None -> Apply.begin_partial_construction ctxt >>=? fun ctxt -> let mode = Partial_construction { predecessor } in - return (mode, ctxt) + return (mode, ctxt, Alpha_context.Tez.zero) | Some proto_header -> Apply.begin_full_construction ctxt pred_timestamp - proto_header >>=? fun (ctxt, protocol_data, baker) -> + proto_header >>=? fun (ctxt, protocol_data, baker, bond) -> let mode = let baker = Ed25519.Public_key.hash baker in Full_construction { predecessor ; baker ; protocol_data } in - return (mode, ctxt) - end >>=? fun (mode, ctxt) -> - return { mode ; ctxt ; op_count = 0 } + return (mode, ctxt, bond) + end >>=? fun (mode, ctxt, bond) -> + return { mode ; ctxt ; op_count = 0 ; bond ; + 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_contract = +let apply_operation ({ mode ; ctxt ; op_count ; _ } as data) operation = + let pred_block, block_prio, baker = match mode with | Partial_construction { predecessor } -> predecessor, 0, None @@ -109,21 +117,24 @@ let apply_operation ({ mode ; ctxt ; op_count } as data) operation = | Full_construction { predecessor ; protocol_data ; baker } -> predecessor, protocol_data.priority, - Some (Alpha_context.Contract.implicit_contract baker) in - Apply.apply_operation - ctxt baker_contract pred_block block_prio operation - >>=? fun (ctxt, _contracts, _ignored_script_error) -> + Some baker in + Apply.apply_operation ctxt baker pred_block block_prio operation + >>=? fun (ctxt, _contracts, _ignored_script_error, fees, rewards) -> let op_count = op_count + 1 in - return { data with ctxt ; op_count } + 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 } -let finalize_block { mode ; ctxt ; op_count } = match mode with +let finalize_block { mode ; ctxt ; op_count ; bond ; fees ; rewards } = + match mode with | Partial_construction _ -> let ctxt = Alpha_context.finalize ctxt in return ctxt | Application { baker ; block_header = { protocol_data ; _ } } | Full_construction { protocol_data ; baker ; _ } -> - Apply.finalize_application ctxt protocol_data baker >>=? fun ctxt -> + Apply.finalize_application + ctxt protocol_data baker bond fees rewards >>=? 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 aa5d1a074..4e615b65f 100644 --- a/src/proto_alpha/lib_protocol/src/main.mli +++ b/src/proto_alpha/lib_protocol/src/main.mli @@ -26,7 +26,11 @@ type validation_mode = type validation_state = { mode : validation_mode ; ctxt : Alpha_context.t ; - op_count : int } + op_count : int ; + bond : Alpha_context.Tez.t ; + fees : Alpha_context.Tez.t ; + rewards : Alpha_context.Tez.t ; + } include Updater.PROTOCOL with type operation = Alpha_context.Operation.t and type validation_state := validation_state diff --git a/src/proto_alpha/lib_protocol/src/nonce_storage.ml b/src/proto_alpha/lib_protocol/src/nonce_storage.ml index 7b5521489..81baabaf3 100644 --- a/src/proto_alpha/lib_protocol/src/nonce_storage.ml +++ b/src/proto_alpha/lib_protocol/src/nonce_storage.ml @@ -30,35 +30,32 @@ let get_unrevealed c level = Raw_level_repr.(level.level < cur_level.level) Too_early_revelation >>=? fun () -> Storage.Seed.Nonce.get c level >>=? function - | Revealed _ -> - fail Previously_revealed_nonce - | Unrevealed { nonce_hash; delegate_to_reward ; reward_amount } -> - return (nonce_hash, delegate_to_reward, reward_amount) + | Revealed _ -> fail Previously_revealed_nonce + | Unrevealed status -> return status -(* let get_unrevealed_hash c level = *) -(* get_unrevealed c level >>=? fun (nonce_hash, _) -> *) -(* return nonce_hash *) - -let record_hash c delegate_to_reward reward_amount nonce_hash = +let record_hash c unrevealed = let level = Level_storage.current c in - Storage.Seed.Nonce.init c level - (Unrevealed { nonce_hash; delegate_to_reward ; reward_amount }) + Storage.Seed.Nonce.init c level (Unrevealed unrevealed) let reveal c level nonce = - get_unrevealed c level >>=? fun (nonce_hash, delegate_to_reward, reward_amount) -> + get_unrevealed c level >>=? fun unrevealed -> fail_unless - (Seed_repr.check_hash nonce nonce_hash) + (Seed_repr.check_hash nonce unrevealed.nonce_hash) Unexpected_nonce >>=? fun () -> Storage.Seed.Nonce.set c level (Revealed nonce) >>=? fun c -> - return (c, delegate_to_reward, reward_amount) + return c + +type unrevealed = Storage.Seed.unrevealed_nonce = { + nonce_hash: Nonce_hash.t ; + delegate: Ed25519.Public_key_hash.t ; + bond: Tez_repr.t ; + rewards: Tez_repr.t ; + fees: Tez_repr.t ; +} type status = Storage.Seed.nonce_status = - | Unrevealed of { - nonce_hash: Nonce_hash.t ; - delegate_to_reward: Ed25519.Public_key_hash.t ; - reward_amount: Tez_repr.t ; - } - | Revealed of nonce + | Unrevealed of unrevealed + | Revealed of Seed_repr.nonce let get c level = Storage.Seed.Nonce.get c level diff --git a/src/proto_alpha/lib_protocol/src/nonce_storage.mli b/src/proto_alpha/lib_protocol/src/nonce_storage.mli index 836439b3c..09ce5f193 100644 --- a/src/proto_alpha/lib_protocol/src/nonce_storage.mli +++ b/src/proto_alpha/lib_protocol/src/nonce_storage.mli @@ -17,25 +17,26 @@ type t = Seed_repr.nonce type nonce = t val encoding: nonce Data_encoding.t -val record_hash: - Raw_context.t -> - Ed25519.Public_key_hash.t -> Tez_repr.t -> - Nonce_hash.t -> Raw_context.t tzresult Lwt.t - -val reveal: - Raw_context.t -> Level_repr.t -> nonce -> - (Raw_context.t * Ed25519.Public_key_hash.t * Tez_repr.t) tzresult Lwt.t +type unrevealed = Storage.Seed.unrevealed_nonce = { + nonce_hash: Nonce_hash.t ; + delegate: Ed25519.Public_key_hash.t ; + bond: Tez_repr.t ; + rewards: Tez_repr.t ; + fees: Tez_repr.t ; +} type status = - | Unrevealed of { - nonce_hash: Nonce_hash.t ; - delegate_to_reward: Ed25519.Public_key_hash.t ; - reward_amount: Tez_repr.t ; - } - | Revealed of nonce + | Unrevealed of unrevealed + | Revealed of Seed_repr.nonce val get: Raw_context.t -> Level_repr.t -> status tzresult Lwt.t +val record_hash: + Raw_context.t -> unrevealed -> Raw_context.t tzresult Lwt.t + +val reveal: + Raw_context.t -> Level_repr.t -> nonce -> Raw_context.t tzresult Lwt.t + val of_bytes: MBytes.t -> nonce tzresult val hash: nonce -> Nonce_hash.t val check_hash: nonce -> Nonce_hash.t -> bool diff --git a/src/proto_alpha/lib_protocol/src/reward_storage.ml b/src/proto_alpha/lib_protocol/src/reward_storage.ml deleted file mode 100644 index e57d2f2cb..000000000 --- a/src/proto_alpha/lib_protocol/src/reward_storage.ml +++ /dev/null @@ -1,75 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -type error += - | Too_late_reward_recording - | Too_late_reward_discarding - | Incorrect_discard - -let record c delegate cycle amount = - Storage.Rewards.Next.get c >>=? fun min_cycle -> - fail_unless Cycle_repr.(min_cycle <= cycle) - Too_late_reward_recording >>=? fun () -> - Storage.Rewards.Amount.get_option (c, cycle) delegate >>=? function - | None -> - Storage.Rewards.Amount.init (c, cycle) delegate amount - | Some previous_amount -> - Lwt.return Tez_repr.(previous_amount +? amount) >>=? fun amount -> - Storage.Rewards.Amount.set (c, cycle) delegate amount - -let discard c delegate cycle amount = - Storage.Rewards.Next.get c >>=? fun min_cycle -> - fail_unless Cycle_repr.(min_cycle <= cycle) - Too_late_reward_discarding >>=? fun () -> - Storage.Rewards.Amount.get_option (c, cycle) delegate >>=? function - | None -> - fail Incorrect_discard - | Some previous_amount -> - match Tez_repr.(previous_amount -? amount) with - | Ok amount -> - if Tez_repr.(amount = zero) then - Storage.Rewards.Amount.remove (c, cycle) delegate >>= fun ctxt -> - return ctxt - else - Storage.Rewards.Amount.set (c, cycle) delegate amount - | Error _ -> - fail Incorrect_discard - -let pay_rewards_for_cycle c cycle = - Storage.Rewards.Amount.fold (c, cycle) ~init:(Ok c) - ~f:(fun delegate amount c -> - match c with - | Error _ -> Lwt.return c - | Ok c -> - Contract_storage.credit c - (Contract_repr.implicit_contract delegate) - amount) >>=? fun c -> - Storage.Rewards.Amount.clear (c, cycle) >>= fun c -> - return c - -let pay_due_rewards c = - let timestamp = Raw_context.current_timestamp c in - let rec loop c cycle = - Storage.Rewards.Date.get_option c cycle >>=? function - | None -> - Storage.Rewards.Next.set c cycle - | Some reward_time -> - if Time_repr.(reward_time > timestamp) - then - Storage.Rewards.Next.set c cycle - else - pay_rewards_for_cycle c cycle >>=? fun c -> - loop c (Cycle_repr.succ cycle) in - Storage.Rewards.Next.get c >>=? fun cycle -> - loop c cycle - -let set_reward_time_for_cycle = Storage.Rewards.Date.init - -let init c = - Storage.Rewards.Next.init c Cycle_repr.root diff --git a/src/proto_alpha/lib_protocol/src/reward_storage.mli b/src/proto_alpha/lib_protocol/src/reward_storage.mli deleted file mode 100644 index b580c1d9d..000000000 --- a/src/proto_alpha/lib_protocol/src/reward_storage.mli +++ /dev/null @@ -1,21 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -val record: - Raw_context.t -> Ed25519.Public_key_hash.t -> Cycle_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t - -val discard: - Raw_context.t -> Ed25519.Public_key_hash.t -> Cycle_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t - -val pay_due_rewards: Raw_context.t -> Raw_context.t tzresult Lwt.t - -val set_reward_time_for_cycle: - Raw_context.t -> Cycle_repr.t -> Time.t -> Raw_context.t tzresult Lwt.t - -val init: Raw_context.t -> Raw_context.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/src/seed_storage.ml b/src/proto_alpha/lib_protocol/src/seed_storage.ml index ec3daaf63..4bba561ba 100644 --- a/src/proto_alpha/lib_protocol/src/seed_storage.ml +++ b/src/proto_alpha/lib_protocol/src/seed_storage.ml @@ -47,19 +47,19 @@ let compute_for_cycle c ~revealed cycle = | None -> assert false (* should not happen *) | Some previous_cycle -> let levels = Level_storage.levels_with_commitments_in_cycle c revealed in - let combine (c, random_seed) level = + let combine (c, random_seed, unrevealed) level = Storage.Seed.Nonce.get c level >>=? function | Revealed nonce -> Storage.Seed.Nonce.delete c level >>=? fun c -> - return (c, Seed_repr.nonce random_seed nonce) - | Unrevealed _ -> + return (c, Seed_repr.nonce random_seed nonce, unrevealed) + | Unrevealed u -> Storage.Seed.Nonce.delete c level >>=? fun c -> - return (c, random_seed) + return (c, random_seed, u :: unrevealed) in Storage.Seed.For_cycle.get c previous_cycle >>=? fun seed -> - fold_left_s combine (c, seed) levels >>=? fun (c, seed) -> + fold_left_s combine (c, seed, []) levels >>=? fun (c, seed, unrevealed) -> Storage.Seed.For_cycle.init c cycle seed >>=? fun c -> - return c + return (c, unrevealed) let for_cycle ctxt cycle = let preserved = Constants_storage.preserved_cycles ctxt in @@ -97,7 +97,7 @@ let cycle_end ctxt last_cycle = clear_cycle ctxt cleared_cycle end >>=? fun ctxt -> match Cycle_repr.pred last_cycle with - | None -> return ctxt + | None -> return (ctxt, []) | Some revealed -> let inited_seed_cycle = Cycle_repr.add last_cycle (preserved+1) in compute_for_cycle ctxt ~revealed inited_seed_cycle diff --git a/src/proto_alpha/lib_protocol/src/seed_storage.mli b/src/proto_alpha/lib_protocol/src/seed_storage.mli index 7fd1f5516..76f52df66 100644 --- a/src/proto_alpha/lib_protocol/src/seed_storage.mli +++ b/src/proto_alpha/lib_protocol/src/seed_storage.mli @@ -19,4 +19,5 @@ val for_cycle: Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t val cycle_end: - Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t + Raw_context.t -> Cycle_repr.t -> + (Raw_context.t * Nonce_storage.unrevealed list) tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/src/storage.ml b/src/proto_alpha/lib_protocol/src/storage.ml index 6f1438158..14bf1eac9 100644 --- a/src/proto_alpha/lib_protocol/src/storage.ml +++ b/src/proto_alpha/lib_protocol/src/storage.ml @@ -49,6 +49,28 @@ module Contract = struct (struct let name = ["balance"] end) (Make_value(Tez_repr)) + module Frozen_balance_index = + Make_indexed_subcontext + (Make_subcontext + (Indexed_context.Raw_context) + (struct let name = ["frozen_balance"] end)) + (Cycle_repr.Index) + + module Frozen_bonds = + Frozen_balance_index.Make_map + (struct let name = ["bonds"] end) + (Make_value(Tez_repr)) + + module Frozen_fees = + Frozen_balance_index.Make_map + (struct let name = ["fees"] end) + (Make_value(Tez_repr)) + + module Frozen_rewards = + Frozen_balance_index.Make_map + (struct let name = ["rewards"] end) + (Make_value(Tez_repr)) + module Manager = Indexed_context.Make_map (struct let name = ["manager"] end) @@ -129,7 +151,7 @@ module Contract = struct end -module Delegate = +module Delegates = Make_data_set_storage (Make_subcontext(Raw_context)(struct let name = ["delegates"] end)) (Ed25519.Public_key_hash) @@ -148,28 +170,34 @@ module Cycle = struct (struct let name = ["last_roll"] end) (Make_value(Roll_repr)) + type unrevealed_nonce = { + nonce_hash: Nonce_hash.t ; + delegate: Ed25519.Public_key_hash.t ; + bond: Tez_repr.t ; + rewards: Tez_repr.t ; + fees: Tez_repr.t ; + } + type nonce_status = - | Unrevealed of { - nonce_hash: Nonce_hash.t ; - delegate_to_reward: Ed25519.Public_key_hash.t ; - reward_amount: Tez_repr.t ; - } + | Unrevealed of unrevealed_nonce | Revealed of Seed_repr.nonce let nonce_status_encoding = let open Data_encoding in union [ case (Tag 0) - (tup3 + (tup5 Nonce_hash.encoding Ed25519.Public_key_hash.encoding + Tez_repr.encoding + Tez_repr.encoding Tez_repr.encoding) (function - | Unrevealed { nonce_hash ; delegate_to_reward ; reward_amount } -> - Some (nonce_hash, delegate_to_reward, reward_amount) + | Unrevealed { nonce_hash ; delegate ; bond ; rewards ; fees } -> + Some (nonce_hash, delegate, bond, rewards, fees) | _ -> None) - (fun (nonce_hash, delegate_to_reward, reward_amount) -> - Unrevealed { nonce_hash ; delegate_to_reward ; reward_amount }) ; + (fun (nonce_hash, delegate, bond, rewards, fees) -> + Unrevealed { nonce_hash ; delegate ; bond ; rewards ; fees }) ; case (Tag 1) Seed_repr.nonce_encoding (function @@ -197,19 +225,6 @@ module Cycle = struct let encoding = Seed_repr.seed_encoding end)) - module Reward_date = - Indexed_context.Make_map - (struct let name = [ "reward_date" ] end) - (Make_value(Time_repr)) - - module Reward_amount = - Make_indexed_data_storage - (Make_subcontext - (Indexed_context.Raw_context) - (struct let name = [ "rewards" ] end)) - (Ed25519.Public_key_hash) - (Make_value(Tez_repr)) - end module Roll = struct @@ -326,12 +341,16 @@ end module Seed = struct + type unrevealed_nonce = Cycle.unrevealed_nonce = { + nonce_hash: Nonce_hash.t ; + delegate: Ed25519.Public_key_hash.t ; + bond: Tez_repr.t ; + rewards: Tez_repr.t ; + fees: Tez_repr.t ; + } + type nonce_status = Cycle.nonce_status = - | Unrevealed of { - nonce_hash: Nonce_hash.t ; - delegate_to_reward: Ed25519.Public_key_hash.t ; - reward_amount: Tez_repr.t ; - } + | Unrevealed of unrevealed_nonce | Revealed of Seed_repr.nonce module Nonce = struct @@ -351,21 +370,6 @@ module Seed = struct end -(** Rewards *) - -module Rewards = struct - - module Next = - Make_single_data_storage - (Raw_context) - (struct let name = ["next_cycle_to_be_rewarded"] end) - (Make_value(Cycle_repr)) - - module Date = Cycle.Reward_date - module Amount = Cycle.Reward_amount - -end - (** Resolver *) let () = diff --git a/src/proto_alpha/lib_protocol/src/storage.mli b/src/proto_alpha/lib_protocol/src/storage.mli index 53b21d862..3b045435c 100644 --- a/src/proto_alpha/lib_protocol/src/storage.mli +++ b/src/proto_alpha/lib_protocol/src/storage.mli @@ -64,8 +64,7 @@ module Roll : sig and type value = Tez_repr.t and type t := Raw_context.t - (** Frozen rolls per cycle *) - + (** Last roll in the snapshoted roll allocation of a given cycle. *) module Last_for_cycle : Indexed_data_storage with type key = Cycle_repr.t and type value = Roll_repr.t @@ -96,6 +95,22 @@ module Contract : sig and type value = Tez_repr.t and type t := Raw_context.t + (** Frozen balance, see 'delegate_storage.mli' for more explanation *) + module Frozen_bonds : Indexed_data_storage + with type key = Cycle_repr.t + and type value = Tez_repr.t + and type t = Raw_context.t * Contract_repr.t + + module Frozen_fees : Indexed_data_storage + with type key = Cycle_repr.t + and type value = Tez_repr.t + and type t = Raw_context.t * Contract_repr.t + + module Frozen_rewards : Indexed_data_storage + with type key = Cycle_repr.t + and type value = Tez_repr.t + and type t = Raw_context.t * Contract_repr.t + (** The manager of a contract *) module Manager : Indexed_data_storage with type key = Contract_repr.t @@ -154,7 +169,8 @@ module Contract : sig end -module Delegate : Data_set_storage +(** Set of all registred delegates. *) +module Delegates : Data_set_storage with type t := Raw_context.t and type elt = Ed25519.Public_key_hash.t @@ -201,12 +217,16 @@ module Seed : sig (** Storage from this submodule must only be accessed through the module `Seed`. *) + type unrevealed_nonce = { + nonce_hash: Nonce_hash.t ; + delegate: Ed25519.Public_key_hash.t ; + bond: Tez_repr.t ; + rewards: Tez_repr.t ; + fees: Tez_repr.t ; + } + type nonce_status = - | Unrevealed of { - nonce_hash: Nonce_hash.t ; - delegate_to_reward: Ed25519.Public_key_hash.t ; - reward_amount: Tez_repr.t ; - } + | Unrevealed of unrevealed_nonce | Revealed of Seed_repr.nonce module Nonce : Non_iterable_indexed_data_storage @@ -221,23 +241,3 @@ module Seed : sig end end - -(** Rewards *) - -module Rewards : sig - - module Next : Single_data_storage - with type value = Cycle_repr.t - and type t := Raw_context.t - - module Date : Indexed_data_storage - with type key = Cycle_repr.t - and type value = Time.t - and type t := Raw_context.t - - module Amount : Indexed_data_storage - with type key = Ed25519.Public_key_hash.t - and type value = Tez_repr.t - and type t = Raw_context.t * Cycle_repr.t - -end 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 0d24e0799..34ca8e998 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_apply.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_apply.ml @@ -15,10 +15,11 @@ let operation return @@ Helpers_operation.apply_of_proto src op_sh proto_op >>=? fun operation -> Proto_alpha.Apply.apply_operation tc - (Option.map ~f:(fun x -> x.Helpers_account.contract) baker) + (Option.map ~f:(fun x -> x.Helpers_account.hpub) baker) pred_block_hash 0 - operation >>=? fun (tc, contracts, err) -> return ((contracts, err), tc) + operation >>=? fun (tc, contracts, err, _fees, _rewards) -> + return ((contracts, err), tc) let transaction ~tc ?(fee = 0) ?baker