diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index d1f3ffa4c..0442464b4 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -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 diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml index 744e6a4b2..25ea10ad5 100644 --- a/src/proto_alpha/lib_protocol/src/apply.ml +++ b/src/proto_alpha/lib_protocol/src/apply.ml @@ -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 diff --git a/src/proto_alpha/lib_protocol/src/delegate_storage.ml b/src/proto_alpha/lib_protocol/src/delegate_storage.ml index 4a5843be1..a8f82fa39 100644 --- a/src/proto_alpha/lib_protocol/src/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/src/delegate_storage.ml @@ -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 diff --git a/src/proto_alpha/lib_protocol/src/delegate_storage.mli b/src/proto_alpha/lib_protocol/src/delegate_storage.mli index 01b721523..eec393d5e 100644 --- a/src/proto_alpha/lib_protocol/src/delegate_storage.mli +++ b/src/proto_alpha/lib_protocol/src/delegate_storage.mli @@ -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 diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.ml b/src/proto_alpha/lib_protocol/src/helpers_services.ml index fd7106095..54c327327 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.ml +++ b/src/proto_alpha/lib_protocol/src/helpers_services.ml @@ -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 diff --git a/src/proto_alpha/lib_protocol/src/main.ml b/src/proto_alpha/lib_protocol/src/main.ml index ebd0e9200..d34a2ee80 100644 --- a/src/proto_alpha/lib_protocol/src/main.ml +++ b/src/proto_alpha/lib_protocol/src/main.ml @@ -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