balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Alpha: rework reward storage.

Browse Source 
We now keep track per delegate and per cycle of three distinct "frozen
balance": one for the bond, one for the fees, one for the rewards.
All tokens frozen during cycle 'N' are unfrozen at the end of the
cycle 'N+5'.

The frozen bond and fees count allows to gain rolls. The frozen
rewards do not.
This commit is contained in:
Grégoire Henry 2018-02-23 18:47:12 -05:00 committed by Benjamin Canou
parent 2be83eafc1
commit 39f919e07b
24 changed files with 547 additions and 399 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/proto_alpha/lib_baking/test/test_endorsement.ml
View File

@ -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 =

1
src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL
View File

@ -41,7 +41,6 @@
"Roll_storage",
"Delegate_storage",
"Contract_storage",
"Reward_storage",
"Bootstrap_storage",
"Fitness_storage",
"Vote_storage",

1
src/proto_alpha/lib_protocol/src/alpha_context.ml
View File

@ -80,7 +80,6 @@ module Seed = struct
include Seed_storage
end
module Bootstrap = Bootstrap_storage
module Reward = Reward_storage
module Fitness = struct

63
src/proto_alpha/lib_protocol/src/alpha_context.mli
View File

@ -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 ->

113
src/proto_alpha/lib_protocol/src/apply.ml
View File

@ -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 ->

82
src/proto_alpha/lib_protocol/src/baking.ml
View File

@ -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 =

39
src/proto_alpha/lib_protocol/src/baking.mli
View File

@ -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

4
src/proto_alpha/lib_protocol/src/contract_storage.ml
View File

@ -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') ;

2
src/proto_alpha/lib_protocol/src/contract_storage.mli
View File

@ -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

178
src/proto_alpha/lib_protocol/src/delegate_storage.ml
View File

@ -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)

69
src/proto_alpha/lib_protocol/src/delegate_storage.mli
View File

@ -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

7
src/proto_alpha/lib_protocol/src/helpers_services.ml
View File

@ -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) =

1
src/proto_alpha/lib_protocol/src/init_storage.ml
View File

@ -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 ->

45
src/proto_alpha/lib_protocol/src/main.ml
View File

@ -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

6
src/proto_alpha/lib_protocol/src/main.mli
View File

@ -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

37
src/proto_alpha/lib_protocol/src/nonce_storage.ml
View File

@ -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

29
src/proto_alpha/lib_protocol/src/nonce_storage.mli
View File

@ -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

75
src/proto_alpha/lib_protocol/src/reward_storage.ml
View File

@ -1,75 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

21
src/proto_alpha/lib_protocol/src/reward_storage.mli
View File

@ -1,21 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

14
src/proto_alpha/lib_protocol/src/seed_storage.ml
View File

@ -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

3
src/proto_alpha/lib_protocol/src/seed_storage.mli
View File

@ -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

88
src/proto_alpha/lib_protocol/src/storage.ml
View File

@ -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 nonce_status =
| Unrevealed of {
type unrevealed_nonce = {
nonce_hash: Nonce_hash.t ;
delegate_to_reward: Ed25519.Public_key_hash.t ;
reward_amount: Tez_repr.t ;
delegate: Ed25519.Public_key_hash.t ;
bond: Tez_repr.t ;
rewards: Tez_repr.t ;
fees: Tez_repr.t ;
}
type nonce_status =
| 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 nonce_status = Cycle.nonce_status =
| Unrevealed of {
type unrevealed_nonce = Cycle.unrevealed_nonce = {
nonce_hash: Nonce_hash.t ;
delegate_to_reward: Ed25519.Public_key_hash.t ;
reward_amount: Tez_repr.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 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 () =

54
src/proto_alpha/lib_protocol/src/storage.mli
View File

@ -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 nonce_status =
| Unrevealed of {
type unrevealed_nonce = {
nonce_hash: Nonce_hash.t ;
delegate_to_reward: Ed25519.Public_key_hash.t ;
reward_amount: Tez_repr.t ;
delegate: Ed25519.Public_key_hash.t ;
bond: Tez_repr.t ;
rewards: Tez_repr.t ;
fees: Tez_repr.t ;
}
type nonce_status =
| 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

5
src/proto_alpha/lib_protocol/test/helpers/helpers_apply.ml
View File

@ -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