diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 35a7e205fe73370bd796676542e20ff7efac6801..f4c7393f237cf6a4bd6d810e0b80b925bf1d7e57 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -4890,6 +4890,14 @@ module Unstake_requests : sig val update : context -> Contract.t -> stored_requests -> context tzresult Lwt.t + + val add : + context -> + contract:Contract.t -> + delegate:public_key_hash -> + Cycle.t -> + Tez.t -> + context tzresult Lwt.t end (** This module re-exports definitions from {!Staking_pseudotoken_repr} and @@ -4897,11 +4905,24 @@ end module Staking_pseudotokens : sig type t + val min : t -> t -> t + + val frozen_deposits_pseudotokens_for_tez_amount : + context -> public_key_hash -> Tez.t -> t tzresult Lwt.t + val credit_frozen_deposits_pseudotokens_for_tez_amount : context -> public_key_hash -> Tez.t -> (context * t) tzresult Lwt.t + val debit_frozen_deposits_pseudotokens : + context -> public_key_hash -> t -> (context * Tez.t) tzresult Lwt.t + + val costaking_pseudotokens_balance : context -> Contract.t -> t tzresult Lwt.t + val credit_costaking_pseudotokens : context -> Contract.t -> t -> context tzresult Lwt.t + + val debit_costaking_pseudotokens : + context -> Contract.t -> t -> context tzresult Lwt.t end (** This module re-exports definitions from {!Fees_storage}. *) diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index c0390ff3289d4ed396a0702743b87db1b4c69051..3da6215c27e28cc08207d31e1a5318d4ff3a2985 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -46,6 +46,7 @@ type error += | Invalid_self_transaction_destination | Staking_for_nondelegate_while_costaking_disabled | Invalid_nonzero_transaction_amount of Tez.t + | Invalid_unstake_request_amount of {requested_amount : Z.t} let () = register_error_kind @@ -267,7 +268,24 @@ let () = Data_encoding.(obj1 (req "amount" Tez.encoding)) (function | Invalid_nonzero_transaction_amount amount -> Some amount | _ -> None) - (fun amount -> Invalid_nonzero_transaction_amount amount) + (fun amount -> Invalid_nonzero_transaction_amount amount) ; + register_error_kind + `Permanent + ~id:"operations.invalid_unstake_request_amount" + ~title:"Invalid unstake request amount" + ~description:"The unstake requested amount is negative or too large." + ~pp:(fun ppf requested_amount -> + Format.fprintf + ppf + "The unstake requested amount, %a, is negative or too large." + Z.pp_print + requested_amount) + Data_encoding.(obj1 (req "requested_amount" z)) + (function + | Invalid_unstake_request_amount {requested_amount} -> + Some requested_amount + | _ -> None) + (fun requested_amount -> Invalid_unstake_request_amount {requested_amount}) open Apply_results open Apply_operation_result @@ -357,6 +375,53 @@ let apply_stake ~ctxt ~sender ~amount ~destination ~before_operation = in return (ctxt, result, []) +let apply_unstake ~ctxt ~sender ~amount ~requested_amount ~destination + ~before_operation = + let open Lwt_result_syntax in + let*? () = + error_when Tez.(amount <> zero) (Invalid_nonzero_transaction_amount amount) + in + let*? () = + error_unless + Signature.Public_key_hash.(sender = destination) + Invalid_self_transaction_destination + in + let requested_amount_opt = + if Z.fits_int64 requested_amount then + Tez.of_mutez (Z.to_int64 requested_amount) + else None + in + let*? requested_amount = + match requested_amount_opt with + | None -> error (Invalid_unstake_request_amount {requested_amount}) + | Some requested_amount -> Ok requested_amount + in + let sender_contract = Contract.Implicit sender in + let* delegate_opt = Contract.Delegate.find ctxt sender_contract in + match delegate_opt with + | None -> tzfail Staking_for_nondelegate_while_costaking_disabled + | Some delegate when Signature.Public_key_hash.(delegate <> sender) -> + tzfail Staking_for_nondelegate_while_costaking_disabled + | Some delegate -> + let* ctxt, balance_updates = + Staking.request_unstake ctxt ~sender_contract ~delegate requested_amount + in + let result = + Transaction_to_contract_result + { + storage = None; + lazy_storage_diff = None; + balance_updates; + ticket_receipt = []; + originated_contracts = []; + consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt; + storage_size = Z.zero; + paid_storage_size_diff = Z.zero; + allocated_destination_contract = false; + } + in + return (ctxt, result, []) + let apply_finalize_unstake ~ctxt ~sender ~amount ~destination ~before_operation = error_when Tez.(amount <> zero) (Invalid_nonzero_transaction_amount amount) @@ -367,7 +432,7 @@ let apply_finalize_unstake ~ctxt ~sender ~amount ~destination ~before_operation >>?= fun () -> let contract = Contract.Implicit sender in Contract.allocated ctxt contract >>= fun already_allocated -> - Staking.finalize_unstake ctxt sender >>=? fun (ctxt, balance_updates) -> + Staking.finalize_unstake ctxt contract >>=? fun (ctxt, balance_updates) -> let result = Transaction_to_contract_result { @@ -869,6 +934,14 @@ let apply_manager_operation : ~amount ~destination:pkh ~before_operation:ctxt_before_op + | "unstake", Int (_, requested_amount) -> + apply_unstake + ~ctxt + ~sender:source + ~amount + ~requested_amount + ~destination:pkh + ~before_operation:ctxt_before_op | "finalize_unstake", Prim (_, D_Unit, [], _) -> apply_finalize_unstake ~ctxt @@ -876,9 +949,11 @@ let apply_manager_operation : ~amount ~destination:pkh ~before_operation:ctxt_before_op - | ("default" | "stake" | "finalize_unstake"), _ -> - (* Only allow [Unit] parameter to implicit accounts' default, stake, - and finalize_unstake entrypoints. *) + | ("default" | "stake" | "unstake" | "finalize_unstake"), _ -> + (* Only allow: + - [unit] parameter to implicit accounts' default, stake, + and finalize_unstake entrypoints; + - [nat] parameter to implicit accounts' unstake entrypoint. *) tzfail (Script_interpreter.Bad_contract_parameter source_contract) | _ -> tzfail (Script_tc_errors.No_such_entrypoint entrypoint)) >|=? fun (ctxt, res, ops) -> (ctxt, Transaction_result res, ops) diff --git a/src/proto_alpha/lib_protocol/staking.ml b/src/proto_alpha/lib_protocol/staking.ml index 663c545b1290cec7e82cee969067d064c95989bc..11d901fa0ed2da96e78478aa681ba9771137f614 100644 --- a/src/proto_alpha/lib_protocol/staking.ml +++ b/src/proto_alpha/lib_protocol/staking.ml @@ -64,9 +64,8 @@ let perform_finalizable_unstake_transfers ctxt contract finalizable = (ctxt, []) finalizable -let finalize_unstake_and_check ~check_unfinalizable ctxt pkh = +let finalize_unstake_and_check ~check_unfinalizable ctxt contract = let open Lwt_result_syntax in - let contract = Contract.Implicit pkh in let* prepared_opt = Unstake_requests.prepare_finalize_unstake ctxt contract in match prepared_opt with | None -> return (ctxt, []) @@ -75,9 +74,9 @@ let finalize_unstake_and_check ~check_unfinalizable ctxt pkh = let* ctxt = Unstake_requests.update ctxt contract unfinalizable in perform_finalizable_unstake_transfers ctxt contract finalizable -let finalize_unstake ctxt pkh = +let finalize_unstake ctxt contract = let check_unfinalizable _unfinalizable = Lwt_result_syntax.return_unit in - finalize_unstake_and_check ~check_unfinalizable ctxt pkh + finalize_unstake_and_check ~check_unfinalizable ctxt contract let punish_delegate ctxt delegate level mistake ~rewarded = let open Lwt_result_syntax in @@ -119,8 +118,9 @@ let stake ctxt ~sender ~delegate amount = Signature.Public_key_hash.(delegate <> unstake_delegate) Cannot_stake_with_unfinalizable_unstake_requests_to_another_delegate in + let sender_contract = Contract.Implicit sender in let* ctxt, finalize_balance_updates = - finalize_unstake_and_check ~check_unfinalizable ctxt sender + finalize_unstake_and_check ~check_unfinalizable ctxt sender_contract in let* ctxt, new_pseudotokens = Staking_pseudotokens.credit_frozen_deposits_pseudotokens_for_tez_amount @@ -128,7 +128,6 @@ let stake ctxt ~sender ~delegate amount = delegate amount in - let sender_contract = Contract.Implicit sender in let* ctxt, stake_balance_updates = Token.transfer ctxt @@ -143,3 +142,48 @@ let stake ctxt ~sender ~delegate amount = new_pseudotokens in return (ctxt, stake_balance_updates @ finalize_balance_updates) + +let request_unstake ctxt ~sender_contract ~delegate requested_amount = + let open Lwt_result_syntax in + let* ctxt, finalize_balance_updates = finalize_unstake ctxt sender_contract in + let* requested_pseudotokens = + Staking_pseudotokens.frozen_deposits_pseudotokens_for_tez_amount + ctxt + delegate + requested_amount + in + let* available_pseudotokens = + Staking_pseudotokens.costaking_pseudotokens_balance ctxt sender_contract + in + let pseudotokens_to_unstake = + Staking_pseudotokens.min requested_pseudotokens available_pseudotokens + in + let* ctxt, tez_to_unstake = + Staking_pseudotokens.debit_frozen_deposits_pseudotokens + ctxt + delegate + pseudotokens_to_unstake + in + let* ctxt = + Staking_pseudotokens.debit_costaking_pseudotokens + ctxt + sender_contract + pseudotokens_to_unstake + in + let current_cycle = (Level.current ctxt).cycle in + let* ctxt, unstake_balance_updates = + Token.transfer + ctxt + (`Frozen_deposits delegate) + (`Unstaked_frozen_deposits (delegate, current_cycle)) + tez_to_unstake + in + let+ ctxt = + Unstake_requests.add + ctxt + ~contract:sender_contract + ~delegate + current_cycle + tez_to_unstake + in + (ctxt, unstake_balance_updates @ finalize_balance_updates) diff --git a/src/proto_alpha/lib_protocol/staking.mli b/src/proto_alpha/lib_protocol/staking.mli index 5d7af413b97d89de64081bef2e16960b6aaec5e3..14612f3e20b9c79fc41489519327bf75aca2f67d 100644 --- a/src/proto_alpha/lib_protocol/staking.mli +++ b/src/proto_alpha/lib_protocol/staking.mli @@ -34,19 +34,26 @@ val stake : Tez.t -> (context * Receipt.balance_updates) tzresult Lwt.t -(** [finalize_unstake ctxt pkh] performs the finalization of all unstake - requests from [pkh] that can be finalized. +(** [request_unstake ctxt ~sender_contract ~delegate amount] records a request + from [sender_contract] to unstake [amount] from [delegate]. *) +val request_unstake : + context -> + sender_contract:Contract.t -> + delegate:public_key_hash -> + Tez.t -> + (context * Receipt.balance_updates) tzresult Lwt.t + +(** [finalize_unstake ctxt contract] performs the finalization of all unstake + requests from [contract] that can be finalized. An unstake request can be finalized if it is old enough, specifically the requested amount must not be at stake anymore and must not be slashable anymore, i.e. after [preserved_cycles + max_slashing_period] after the request. - Amounts are transferred from the [pkh]'s delegate (at request time) unstaked - frozen deposits to [pkh]'s spendable balance, minus slashing the requested - stake undergone in between. *) + Amounts are transferred from the [contract]'s delegate (at request time) + unstaked frozen deposits to [contract]'s spendable balance, minus slashing + the requested stake undergone in between. *) val finalize_unstake : - context -> - public_key_hash -> - (context * Receipt.balance_updates) tzresult Lwt.t + context -> Contract.t -> (context * Receipt.balance_updates) tzresult Lwt.t (** [punish_delegate ctxt delegate level mistake ~rewarded] slashes [delegate] for a [mistake] at [level] and rewards [rewarded]. *) diff --git a/src/proto_alpha/lib_protocol/staking_pseudotoken_repr.mli b/src/proto_alpha/lib_protocol/staking_pseudotoken_repr.mli index fce0311008aee679fe96702d5fb43c48b0155a4f..91540c1885a20532d489bfd38272c6f218504e96 100644 --- a/src/proto_alpha/lib_protocol/staking_pseudotoken_repr.mli +++ b/src/proto_alpha/lib_protocol/staking_pseudotoken_repr.mli @@ -38,3 +38,7 @@ val to_int64 : t -> int64 val ( = ) : t -> t -> bool val ( +? ) : t -> t -> t tzresult + +val ( -? ) : t -> t -> t tzresult + +val min : t -> t -> t diff --git a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml index 17b45f13a38cd05d35f61de7435f658ddcc4d0ab..bc7cf45c70fed02e1a85312f3d72e2448d6ef63b 100644 --- a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml +++ b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml @@ -69,6 +69,35 @@ let pseudotokens_of ~frozen_deposits_pseudotokens ~frozen_deposits_tez in Staking_pseudotoken_repr.of_int64_exn (Z.to_int64 res_z) +let tez_of ~frozen_deposits_pseudotokens ~frozen_deposits_tez + ~pseudotoken_amount = + let frozen_deposits_tez_z = + Z.of_int64 (Tez_repr.to_mutez frozen_deposits_tez) + in + let frozen_deposits_pseudotokens_z = + Z.of_int64 (Staking_pseudotoken_repr.to_int64 frozen_deposits_pseudotokens) + in + let pseudotoken_amount_z = + Z.of_int64 (Staking_pseudotoken_repr.to_int64 pseudotoken_amount) + in + let res_z = + Z.div + (Z.mul frozen_deposits_tez_z pseudotoken_amount_z) + frozen_deposits_pseudotokens_z + in + Tez_repr.of_mutez_exn (Z.to_int64 res_z) + +let frozen_deposits_pseudotokens_for_tez_amount ctxt delegate tez_amount = + let open Lwt_result_syntax in + let contract = Contract_repr.Implicit delegate in + let* {current_amount = frozen_deposits_tez; initial_amount = _} = + Frozen_deposits_storage.get ctxt contract + in + let+ frozen_deposits_pseudotokens = + Storage.Contract.Frozen_deposits_pseudotokens.get ctxt contract + in + pseudotokens_of ~frozen_deposits_pseudotokens ~frozen_deposits_tez ~tez_amount + let update_frozen_deposits_pseudotokens ~f ctxt delegate = let open Lwt_result_syntax in let contract = Contract_repr.Implicit delegate in @@ -107,16 +136,33 @@ let credit_frozen_deposits_pseudotokens_for_tez_amount ctxt delegate tez_amount in update_frozen_deposits_pseudotokens ~f ctxt delegate -let update_costaking_pseudotokens ~f ctxt contract = +let debit_frozen_deposits_pseudotokens ctxt delegate pseudotoken_amount = + let f ~frozen_deposits_pseudotokens ~frozen_deposits_tez = + let open Result_syntax in + let+ new_pseudotokens_balance = + Staking_pseudotoken_repr.( + frozen_deposits_pseudotokens -? pseudotoken_amount) + in + let tez_amount = + tez_of + ~frozen_deposits_pseudotokens + ~frozen_deposits_tez + ~pseudotoken_amount + in + (new_pseudotokens_balance, tez_amount) + in + update_frozen_deposits_pseudotokens ~f ctxt delegate + +let costaking_pseudotokens_balance ctxt contract = let open Lwt_result_syntax in - let* costaking_pseudotokens_opt = + let+ costaking_pseudotokens_opt = Storage.Contract.Costaking_pseudotokens.find ctxt contract in - let costaking_pseudotokens = - Option.value - ~default:Staking_pseudotoken_repr.zero - costaking_pseudotokens_opt - in + Option.value ~default:Staking_pseudotoken_repr.zero costaking_pseudotokens_opt + +let update_costaking_pseudotokens ~f ctxt contract = + let open Lwt_result_syntax in + let* costaking_pseudotokens = costaking_pseudotokens_balance ctxt contract in let*? new_costaking_pseudotokens = f costaking_pseudotokens in let*! ctxt = Storage.Contract.Costaking_pseudotokens.add @@ -132,3 +178,10 @@ let credit_costaking_pseudotokens ctxt contract pseudotokens_to_add = current_pseudotokens_balance +? pseudotokens_to_add) in update_costaking_pseudotokens ~f ctxt contract + +let debit_costaking_pseudotokens ctxt contract pseudotokens_to_subtract = + let f current_pseudotokens_balance = + Staking_pseudotoken_repr.( + current_pseudotokens_balance -? pseudotokens_to_subtract) + in + update_costaking_pseudotokens ~f ctxt contract diff --git a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli index dd60fadcec83bb84174bd8aac93a466078c3ea05..2f8523e46d0a6af78a1d73d32859504745af61f3 100644 --- a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli +++ b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli @@ -27,10 +27,22 @@ {!Storage.Contract.Frozen_deposits_pseudotokens} and {!Storage.Contract.Costaking_pseudotokens} tables. *) +(** [frozen_deposits_pseudotokens_for_tez_amount ctxt delegate tez_amount] + returns the amount of [delegate]'s stake pseudotokens the [tez_amount] is + currently worth. + + Returns an error if [delegate]'s pseudotokens haven't been initialized yet. *) +val frozen_deposits_pseudotokens_for_tez_amount : + Raw_context.t -> + Signature.Public_key_hash.t -> + Tez_repr.t -> + Staking_pseudotoken_repr.t tzresult Lwt.t + (** [credit_frozen_deposits_pseudotokens_for_tez_amount ctxt delegate tez_amount] increases [delegate]'s stake pseudotokens by an amount [pa] corresponding to [tez_amount] multiplied by the current rate of the delegate's frozen - deposits pseudotokens per tez. + deposits pseudotokens per tez, as + [frozen_deposits_pseudotokens_for_tez_amount] would return. The function also returns [pa]. This function must be called on "stake" before transferring tez to @@ -41,6 +53,21 @@ val credit_frozen_deposits_pseudotokens_for_tez_amount : Tez_repr.t -> (Raw_context.t * Staking_pseudotoken_repr.t) tzresult Lwt.t +(** [debit_frozen_deposits_pseudotokens ctxt delegate p_amount] decreases + [delegate]'s stake pseudotokens by [p_amount]. + The function also returns the amount of tez [p_amount] current worth. +*) +val debit_frozen_deposits_pseudotokens : + Raw_context.t -> + Signature.Public_key_hash.t -> + Staking_pseudotoken_repr.t -> + (Raw_context.t * Tez_repr.t) tzresult Lwt.t + +(** [costaking_pseudotokens_balance ctxt contract] returns [contract]'s + current costaking balance. *) +val costaking_pseudotokens_balance : + Raw_context.t -> Contract_repr.t -> Staking_pseudotoken_repr.t tzresult Lwt.t + (** [credit_costaking_pseudotokens ctxt contract p_amount] increases [contract]'s costaking pseudotokens balance by [p_amount]. *) val credit_costaking_pseudotokens : @@ -48,3 +75,11 @@ val credit_costaking_pseudotokens : Contract_repr.t -> Staking_pseudotoken_repr.t -> Raw_context.t tzresult Lwt.t + +(** [debit_costaking_pseudotokens ctxt contract p_amount] decreases + [contract]'s costaking pseudotokens balance by [p_amount]. *) +val debit_costaking_pseudotokens : + Raw_context.t -> + Contract_repr.t -> + Staking_pseudotoken_repr.t -> + Raw_context.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml index ff6c3b966122f2782cedab76ae58f858600b84ae..13ec99c65698a5948ad38a629e8b8104adcabc37 100644 --- a/src/proto_alpha/lib_protocol/storage.ml +++ b/src/proto_alpha/lib_protocol/storage.ml @@ -204,6 +204,21 @@ module Unstake_request = struct (obj2 (req "delegate" Contract_repr.implicit_encoding) (req "requests" requests_encoding)) + + let add cycle amount requests = + let rec loop rev_prefix = + let open Result_syntax in + function + | [] -> + (* cycle does not exist -> add at the head *) + Ok ((cycle, amount) :: requests) + | (c, a) :: tl when Cycle_repr.(c = cycle) -> + let+ a = Tez_repr.(a +? amount) in + (* cycle found, do not change the order *) + List.rev_append rev_prefix ((c, a) :: tl) + | hd :: tl -> loop (hd :: rev_prefix) tl + in + loop [] requests end module Contract = struct diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli index 764545e67faa989c3d33d0a3f9e17434d3600376..1d207dcf7c2c5b5da581435ae4b77f19585b1a17 100644 --- a/src/proto_alpha/lib_protocol/storage.mli +++ b/src/proto_alpha/lib_protocol/storage.mli @@ -72,6 +72,8 @@ module Unstake_request : sig type requests = request list type t = {delegate : Signature.Public_key_hash.t; requests : requests} + + val add : Cycle_repr.t -> Tez_repr.t -> requests -> requests tzresult end module Contract : sig diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml index 012650903e510bad366554cd562297558e12806c..8305dc2af856514918cfffac7232dd0fe29a5c8c 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml @@ -108,3 +108,20 @@ let prepare_finalize_unstake ctxt contract = return_some {finalizable; unfinalizable}) let update = Storage.Contract.Unstake_requests.update + +let add ctxt ~contract ~delegate cycle amount = + let open Lwt_result_syntax in + let* requests_opt = Storage.Contract.Unstake_requests.find ctxt contract in + let requests = + match requests_opt with + | None -> [] + | Some {delegate = request_delegate; requests} -> + assert (Signature.Public_key_hash.(delegate = request_delegate)) ; + requests + in + let*? requests = Storage.Unstake_request.add cycle amount requests in + let unstake_request = Storage.Unstake_request.{delegate; requests} in + let*! ctxt = + Storage.Contract.Unstake_requests.add ctxt contract unstake_request + in + return ctxt diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli index 6c6043aa52e332b86cb6fc5445f5af5deb500ad0..91f98b60b7372ed54e2b39124e45b327e45f65e8 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli @@ -60,3 +60,16 @@ val update : Contract_repr.t -> stored_requests -> Raw_context.t tzresult Lwt.t + +(** [add ctxt ~contract ~delegate cycle amount] adds a request from [contract] + to unstake [amount] from [delegate] at cycle [cycle]. + + @raises Assert_failure if [contract] already has unstake requests from another + delegate (broken invariant). *) +val add : + Raw_context.t -> + contract:Contract_repr.t -> + delegate:Signature.Public_key_hash.t -> + Cycle_repr.t -> + Tez_repr.t -> + Raw_context.t tzresult Lwt.t