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

Alpha: add missing balance updates in operation receipts

Browse Source
This commit is contained in:
Lý Kim Quyên 2018-06-15 16:09:02 +02:00 committed by Grégoire Henry
parent 3860d689d7
commit 9d655696da
6 changed files with 109 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -625,9 +625,15 @@ module Delegate : sig
val cycle_end:
context -> Cycle.t -> Nonce.unrevealed list -> context tzresult Lwt.t
type frozen_balance = {
deposit : Tez.t ;
fees : Tez.t ;
rewards : Tez.t ;
}
val punish:
context -> public_key_hash -> Cycle.t ->
(context * Tez.t) tzresult Lwt.t
(context * frozen_balance) tzresult Lwt.t
val full_balance:
context -> public_key_hash -> Tez.t tzresult Lwt.t
@ -639,12 +645,6 @@ module Delegate : sig
val frozen_balance:
context -> public_key_hash -> Tez.t tzresult Lwt.t
type frozen_balance = {
deposit : Tez.t ;
fees : Tez.t ;
rewards : Tez.t ;
}
val frozen_balance_encoding: frozen_balance Data_encoding.t
val frozen_balance_by_cycle_encoding: frozen_balance Cycle.Map.t Data_encoding.t

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

@ -322,6 +322,17 @@ let () =
open Apply_operation_result
(**
Transaction: source/payer A -> destination B
- payer: is the signer of the operation, the one that pays the storage fee.
This fee is not going to the baker but it will be burned.
- source: is the one who will pay for the fees: space and gas consumption.
This amount will go to the baker.
- internal: set to true in the case of transaction between smart contracts.
Where there is a new storage cost for each smart contract may occurs. The
source may not be the same A any more.
*)
let apply_manager_operation_content :
type kind.
( Alpha_context.t -> Script_ir_translator.unparsing_mode -> payer:Contract.t -> source:Contract.t ->
@ -498,12 +509,13 @@ let precheck_manager_contents
return ctxt
let apply_manager_contents
(type kind) ctxt mode (op : kind Kind.manager contents)
(type kind) ctxt mode baker (op : kind Kind.manager contents)
: (context * kind Kind.manager contents_result) tzresult Lwt.t =
let Manager_operation
{ source ; fee ; operation ; gas_limit ; storage_limit } = op in
Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt ->
Lwt.return (Contract.set_storage_limit ctxt storage_limit) >>=? fun ctxt ->
let level = Level.current ctxt in
apply_manager_operation_content ctxt mode
~source ~payer:source ~internal:false operation >>= begin function
| Ok (ctxt, operation_results, internal_operations) -> begin
@ -524,8 +536,10 @@ let apply_manager_contents
Manager_operation_result
{ balance_updates =
cleanup_balance_updates
[ Contract source, Debited fee ;
(* FIXME: add credit to the baker *) ] ;
[
Contract source, Debited fee ;
Rewards (baker, level.cycle), Credited fee
] ;
operation_result ;
internal_operation_results })
@ -561,12 +575,12 @@ let rec precheck_manager_contents_list
let rec apply_manager_contents_list
: type kind.
Alpha_context.t -> _ -> kind Kind.manager contents_list ->
Alpha_context.t -> _ -> _ -> kind Kind.manager contents_list ->
(context * kind Kind.manager contents_result_list) Lwt.t =
fun ctxt mode contents_list ->
fun ctxt mode baker contents_list ->
match contents_list with
| Single (Manager_operation { operation ; _ } as op) -> begin
apply_manager_contents ctxt mode op >>= function
apply_manager_contents ctxt mode baker op >>= function
| Error errors ->
let result =
Manager_operation_result {
@ -584,7 +598,7 @@ let rec apply_manager_contents_list
Lwt.return (ctxt, Single_result (result))
end
| Cons (Manager_operation { operation ; _ } as op, rest) ->
apply_manager_contents ctxt mode op >>= function
apply_manager_contents ctxt mode baker op >>= function
| Error errors ->
let result =
Manager_operation_result {
@ -595,7 +609,7 @@ let rec apply_manager_contents_list
Lwt.return (ctxt, Cons_result (result, mark_skipped rest))
| Ok (ctxt, (Manager_operation_result
{ operation_result = Applied _ ; _ } as result)) ->
apply_manager_contents_list ctxt mode rest >>= fun (ctxt, results) ->
apply_manager_contents_list ctxt mode baker rest >>= fun (ctxt, results) ->
Lwt.return (ctxt, Cons_result (result, results))
| Ok (ctxt,
(Manager_operation_result
@ -603,7 +617,7 @@ let rec apply_manager_contents_list
Lwt.return (ctxt, Cons_result (result, mark_skipped rest))
let apply_contents_list
(type kind) ctxt mode pred_block
(type kind) ctxt mode pred_block baker
(operation : kind operation)
(contents_list : kind contents_list)
: (context * kind contents_result_list) tzresult Lwt.t =
@ -637,7 +651,11 @@ let apply_contents_list
let seed_nonce_revelation_tip =
Constants.seed_nonce_revelation_tip ctxt in
add_rewards ctxt seed_nonce_revelation_tip >>=? fun ctxt ->
return (ctxt, Single_result (Seed_nonce_revelation_result [(* FIXME *)]))
return (ctxt, Single_result
(Seed_nonce_revelation_result
[
Rewards (baker, level.cycle), Credited seed_nonce_revelation_tip
]))
| Single (Double_endorsement_evidence { op1 ; op2 }) -> begin
match op1.protocol_data.contents, op2.protocol_data.contents with
| Single (Endorsement e1),
@ -662,13 +680,22 @@ let apply_contents_list
{ delegate1 ; delegate2 }) >>=? fun () ->
Delegate.has_frozen_balance ctxt delegate1 level.cycle >>=? fun valid ->
fail_unless valid Unrequired_double_endorsement_evidence >>=? fun () ->
Delegate.punish ctxt delegate1 level.cycle >>=? fun (ctxt, burned) ->
Delegate.punish ctxt delegate1 level.cycle >>=? fun (ctxt, balance) ->
Lwt.return Tez.(balance.deposit +? balance.fees) >>=? fun burned ->
let reward =
match Tez.(burned /? 2L) with
| Ok v -> v
| Error _ -> Tez.zero in
add_rewards ctxt reward >>=? fun ctxt ->
return (ctxt, Single_result (Double_endorsement_evidence_result [(* FIXME *)]))
return
(ctxt,
Single_result
(Double_endorsement_evidence_result [
Rewards (baker, level.cycle), Credited reward;
Rewards (delegate1, level.cycle), Debited balance.rewards;
Deposits (delegate1, level.cycle), Debited balance.deposit;
Fees (delegate1, level.cycle), Debited balance.fees
]))
| _, _ -> fail Invalid_double_endorsement_evidence
end
| Single (Double_baking_evidence { bh1 ; bh2 }) ->
@ -708,13 +735,22 @@ let apply_contents_list
let delegate = Signature.Public_key.hash delegate1 in
Delegate.has_frozen_balance ctxt delegate level.cycle >>=? fun valid ->
fail_unless valid Unrequired_double_baking_evidence >>=? fun () ->
Delegate.punish ctxt delegate level.cycle >>=? fun (ctxt, burned) ->
Delegate.punish ctxt delegate level.cycle >>=? fun (ctxt, balance) ->
Lwt.return Tez.(balance.deposit +? balance.fees) >>=? fun burned ->
let reward =
match Tez.(burned /? 2L) with
| Ok v -> v
| Error _ -> Tez.zero in
add_rewards ctxt reward >>=? fun ctxt ->
return (ctxt, Single_result (Double_baking_evidence_result [(* FIXME *)]))
return
(ctxt,
Single_result
(Double_baking_evidence_result [
Rewards (baker, level.cycle), Credited reward ;
Rewards (delegate, level.cycle), Debited balance.rewards ;
Deposits (delegate, level.cycle), Debited balance.deposit ;
Fees (delegate, level.cycle), Debited balance.fees ;
]))
| Single (Activate_account { id = pkh ; activation_code }) -> begin
let blinded_pkh =
Blinded_public_key_hash.of_ed25519_pkh activation_code pkh in
@ -722,8 +758,13 @@ let apply_contents_list
| None -> fail (Invalid_activation { pkh })
| Some amount ->
Commitment.delete ctxt blinded_pkh >>=? fun ctxt ->
Contract.(credit ctxt (implicit_contract (Signature.Ed25519 pkh)) amount) >>=? fun ctxt ->
return (ctxt, Single_result (Activate_account_result [(* FIXME *)]))
let contract = Contract.implicit_contract (Signature.Ed25519 pkh) in
Contract.(credit ctxt contract amount) >>=? fun ctxt ->
return (ctxt, Single_result (
Activate_account_result
[
Contract contract, Credited amount
]))
end
| Single (Proposals { source ; period ; proposals }) ->
Roll.delegate_pubkey ctxt source >>=? fun delegate ->
@ -743,17 +784,17 @@ let apply_contents_list
return (ctxt, Single_result Ballot_result)
| Single (Manager_operation _) as op ->
precheck_manager_contents_list ctxt operation op >>=? fun ctxt ->
apply_manager_contents_list ctxt mode op >>= fun (ctxt, result) ->
apply_manager_contents_list ctxt mode baker op >>= fun (ctxt, result) ->
return (ctxt, result)
| Cons (Manager_operation _, _) as op ->
precheck_manager_contents_list ctxt operation op >>=? fun ctxt ->
apply_manager_contents_list ctxt mode op >>= fun (ctxt, result) ->
apply_manager_contents_list ctxt mode baker op >>= fun (ctxt, result) ->
return (ctxt, result)
let apply_operation ctxt mode pred_block hash operation =
let apply_operation ctxt mode pred_block baker hash operation =
let ctxt = Contract.init_origination_nonce ctxt hash in
apply_contents_list
ctxt mode pred_block operation
ctxt mode pred_block baker operation
operation.protocol_data.contents >>=? fun (ctxt, result) ->
let ctxt = Gas.set_unlimited ctxt in
let ctxt = Contract.set_storage_unlimited ctxt in

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

@ -7,6 +7,22 @@
(* *)
(**************************************************************************)
type frozen_balance = {
deposit : Tez_repr.t ;
fees : Tez_repr.t ;
rewards : Tez_repr.t ;
}
let frozen_balance_encoding =
let open Data_encoding in
conv
(fun { deposit ; fees ; rewards } -> (deposit, fees, rewards))
(fun (deposit, fees, rewards) -> { deposit ; fees ; rewards })
(obj3
(req "deposit" Tez_repr.encoding)
(req "fees" Tez_repr.encoding)
(req "rewards" Tez_repr.encoding))
type error +=
| Non_delegatable_contract of Contract_repr.contract (* `Permanent *)
| No_deletion of Signature.Public_key_hash.t (* `Permanent *)
@ -357,13 +373,14 @@ let punish ctxt delegate cycle =
let contract = Contract_repr.implicit_contract delegate in
get_frozen_deposit ctxt contract cycle >>=? fun deposit ->
get_frozen_fees ctxt contract cycle >>=? fun fees ->
get_frozen_rewards ctxt contract cycle >>=? fun rewards ->
Roll_storage.Delegate.remove_amount ctxt delegate deposit >>=? fun ctxt ->
Roll_storage.Delegate.remove_amount ctxt delegate fees >>=? fun ctxt ->
(* Rewards are not in the delegate balnace yet... *)
Storage.Contract.Frozen_deposits.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 ->
Lwt.return Tez_repr.(deposit +? fees) >>=? fun burned ->
return (ctxt, burned)
return (ctxt, { deposit ; fees ; rewards })
let has_frozen_balance ctxt delegate cycle =
@ -377,22 +394,6 @@ let has_frozen_balance ctxt delegate cycle =
get_frozen_rewards ctxt contract cycle >>=? fun rewards ->
return Tez_repr.(rewards <> zero)
type frozen_balance = {
deposit : Tez_repr.t ;
fees : Tez_repr.t ;
rewards : Tez_repr.t ;
}
let frozen_balance_encoding =
let open Data_encoding in
conv
(fun { deposit ; fees ; rewards } -> (deposit, fees, rewards))
(fun (deposit, fees, rewards) -> { deposit ; fees ; rewards })
(obj3
(req "deposit" Tez_repr.encoding)
(req "fees" Tez_repr.encoding)
(req "rewards" Tez_repr.encoding))
let frozen_balance_by_cycle_encoding =
let open Data_encoding in
conv

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

@ -7,6 +7,12 @@
(* *)
(**************************************************************************)
type frozen_balance = {
deposit : Tez_repr.t ;
fees : Tez_repr.t ;
rewards : Tez_repr.t ;
}
(** Is the contract eligible to delegation ? *)
val is_delegatable:
Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
@ -91,7 +97,7 @@ val cycle_end:
cycle. Returns the burned amount. *)
val punish:
Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t ->
(Raw_context.t * Tez_repr.t) tzresult Lwt.t
(Raw_context.t * frozen_balance) tzresult Lwt.t
(** Has the given key some frozen tokens in its implicit contract? *)
val has_frozen_balance:
@ -104,12 +110,6 @@ val frozen_balance:
Raw_context.t -> Signature.Public_key_hash.t ->
Tez_repr.t tzresult Lwt.t
type frozen_balance = {
deposit : Tez_repr.t ;
fees : Tez_repr.t ;
rewards : Tez_repr.t ;
}
val frozen_balance_encoding: frozen_balance Data_encoding.t
val frozen_balance_by_cycle_encoding:
frozen_balance Cycle_repr.Map.t Data_encoding.t

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

@ -227,18 +227,19 @@ module Scripts = struct
let operation : _ operation = { shell ; protocol_data } in
let hash = Operation.hash { shell ; protocol_data } in
let ctxt = Contract.init_origination_nonce ctxt hash in
let baker = Signature.Public_key_hash.zero in
match protocol_data.contents with
| Single (Manager_operation _) as op ->
partial_precheck_manager_contents_list ctxt op >>=? fun ctxt ->
Apply.apply_manager_contents_list ctxt Readable op >>= fun (_ctxt, result) ->
Apply.apply_manager_contents_list ctxt Readable baker op >>= fun (_ctxt, result) ->
return result
| Cons (Manager_operation _, _) as op ->
partial_precheck_manager_contents_list ctxt op >>=? fun ctxt ->
Apply.apply_manager_contents_list ctxt Readable op >>= fun (_ctxt, result) ->
Apply.apply_manager_contents_list ctxt Readable baker op >>= fun (_ctxt, result) ->
return result
| _ ->
Apply.apply_contents_list
ctxt Readable shell.branch operation
ctxt Readable shell.branch baker operation
operation.protocol_data.contents >>=? fun (_ctxt, result) ->
return result

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

@ -162,12 +162,21 @@ let apply_operation
match mode with
| Partial_application
{ block_header = { shell = { predecessor ; _ } ; _ } ; _ }
| Partial_construction { predecessor }
| Application
{ block_header = { shell = { predecessor ; _ } ; _ } ; _ }
| Full_construction { predecessor ; _ } ->
predecessor
| Partial_construction { predecessor } ->
predecessor in
Apply.apply_operation ctxt Optimized predecessor
let baker =
match mode with
| Partial_application { baker ; _ }
| Application { baker ; _ }
| Full_construction { baker ; _ } ->
baker
| Partial_construction _ ->
Signature.Public_key_hash.zero in
Apply.apply_operation ctxt Optimized predecessor baker
(Alpha_context.Operation.hash operation)
operation >>=? fun (ctxt, result) ->
let op_count = op_count + 1 in