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

Alpha: better threading of fees and rewards

Browse Source
This commit is contained in:
Grégoire Henry 2018-03-22 16:57:08 +01:00 committed by Benjamin Canou
parent 401eeceefb
commit c6ffe4a5d9
10 changed files with 69 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

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

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

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

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

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

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

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

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

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

17
src/proto_alpha/lib_protocol/src/raw_context.ml
View File

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

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

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

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

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

2
src/proto_alpha/lib_protocol/test/test_activation.ml
View File

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