diff --git a/src/proto_alpha/lib_plugin/contract_services.ml b/src/proto_alpha/lib_plugin/contract_services.ml index 216c72be6ec23c41d76d83d0b20f09d6f9919157..6970215343b2159e9c45671bb0060561ee80e9f3 100644 --- a/src/proto_alpha/lib_plugin/contract_services.ml +++ b/src/proto_alpha/lib_plugin/contract_services.ml @@ -146,7 +146,8 @@ module S = struct spendable balance with a [finalize_unstake] operation call. Returns \ None if there is no unstake request pending." ~query:RPC_query.empty - ~output:(option Unstake_requests.prepared_finalize_unstake_encoding) + ~output: + (option Unstake_requests.For_RPC.prepared_finalize_unstake_encoding) RPC_path.(custom_root /: Contract.rpc_arg / "unstake_requests") let full_balance = @@ -520,17 +521,17 @@ let register () = Contract.For_RPC.get_unstaked_finalizable_balance ; register_field ~chunked:false S.full_balance Contract.For_RPC.get_full_balance ; register1 ~chunked:false S.unstake_requests (fun ctxt contract () () -> - let* result = Unstake_requests.prepare_finalize_unstake ctxt contract in + let open Unstake_requests.For_RPC in + let* result = prepare_finalize_unstake ctxt contract in match result with | None -> return_none | Some {finalizable; unfinalizable} -> let* unfinalizable = - Unstake_requests.For_RPC - .apply_slash_to_unstaked_unfinalizable_stored_requests + apply_slash_to_unstaked_unfinalizable_stored_requests ctxt unfinalizable in - return_some Unstake_requests.{finalizable; unfinalizable}) ; + return_some {finalizable; unfinalizable}) ; opt_register1 ~chunked:false S.manager_key (fun ctxt contract () () -> match contract with | Originated _ -> return_none diff --git a/src/proto_alpha/lib_plugin/contract_services.mli b/src/proto_alpha/lib_plugin/contract_services.mli index 70a5d42332a6256f8caa0a192caed94cd94ce538..caaccc2aac59937db5c6cf3a09e8ccb072914a5d 100644 --- a/src/proto_alpha/lib_plugin/contract_services.mli +++ b/src/proto_alpha/lib_plugin/contract_services.mli @@ -88,7 +88,7 @@ val unstake_requests : 'a #RPC_context.simple -> 'a -> Contract.t -> - Unstake_requests.prepared_finalize_unstake option shell_tzresult Lwt.t + Unstake_requests.For_RPC.prepared_finalize_unstake option shell_tzresult Lwt.t val full_balance : 'a #RPC_context.simple -> 'a -> Contract.t -> Tez.t shell_tzresult Lwt.t diff --git a/src/proto_alpha/lib_plugin/delegate_services.ml b/src/proto_alpha/lib_plugin/delegate_services.ml index 1394aa53b54f6e3460496657b42b87f50ebbe843..a2294cd474be62ed130a4edf79a0a900b445daaa 100644 --- a/src/proto_alpha/lib_plugin/delegate_services.ml +++ b/src/proto_alpha/lib_plugin/delegate_services.ml @@ -1054,21 +1054,19 @@ let own_staked ctxt pkh = let unstake_requests ctxt pkh = let open Lwt_result_syntax in + let open Unstake_requests.For_RPC in let* result = (* This function applies slashing to finalizable requests. *) - Unstake_requests.prepare_finalize_unstake ctxt pkh + prepare_finalize_unstake ctxt pkh in match result with | None -> return_none | Some {finalizable; unfinalizable} -> let* unfinalizable = (* Apply slashing to unfinalizable requests too. *) - Unstake_requests.For_RPC - .apply_slash_to_unstaked_unfinalizable_stored_requests - ctxt - unfinalizable + apply_slash_to_unstaked_unfinalizable_stored_requests ctxt unfinalizable in - return_some Unstake_requests.{finalizable; unfinalizable} + return_some {finalizable; unfinalizable} let own_staked_and_delegated ctxt pkh = let open Lwt_result_syntax in diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL index b304bdd315b78ab959b4ed5f9421864f5d062759..bed70e8c340978b30d30f5d6621bcf7fd6785673 100644 --- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL @@ -161,6 +161,7 @@ "Zk_rollup_storage", "Stake_context", + "Adaptive_issuance_costs", "Contract_delegate_storage", "Stake_storage", "Unstaked_frozen_deposits_storage", @@ -171,7 +172,6 @@ "Contract_storage", "Token", "Fees_storage", - "Adaptive_issuance_costs", "Adaptive_issuance_storage", "Delegate_staking_parameters", "Shared_stake", diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index 1574be3a8b207b64d6b8a3399af90a7beb2191f7..aba85493eabebf2900a093b67896e4eb1560b551 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -747,6 +747,8 @@ module Unstake_requests = struct include Unstake_requests_storage module For_RPC = struct + include Unstake_requests_storage.For_RPC + let apply_slash_to_unstaked_unfinalizable ctxt ~delegate ~requests = Unstake_requests_storage.For_RPC.apply_slash_to_unstaked_unfinalizable ctxt diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index c95a50c39f7cd882eb0bf706e7b66586a569100a..bb68ab42cbcb83e173dbdd7d70abf5d1bf3905d8 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -5426,23 +5426,23 @@ end module Unstake_requests : sig type finalizable = (public_key_hash * Cycle.t * Tez.t) list - type stored_requests = private { - delegate : public_key_hash; - requests : (Cycle.t * Tez.t) list; - } + module For_RPC : sig + type stored_requests = private { + delegate : public_key_hash; + requests : (Cycle.t * Tez.t) list; + } - type prepared_finalize_unstake = { - finalizable : finalizable; - unfinalizable : stored_requests; - } + type prepared_finalize_unstake = { + finalizable : finalizable; + unfinalizable : stored_requests; + } - val prepared_finalize_unstake_encoding : - prepared_finalize_unstake Data_encoding.encoding + val prepared_finalize_unstake_encoding : + prepared_finalize_unstake Data_encoding.encoding - val prepare_finalize_unstake : - context -> Contract.t -> prepared_finalize_unstake option tzresult Lwt.t + val prepare_finalize_unstake : + context -> Contract.t -> prepared_finalize_unstake option tzresult Lwt.t - module For_RPC : sig val apply_slash_to_unstaked_unfinalizable : context -> delegate:public_key_hash -> diff --git a/src/proto_alpha/lib_protocol/contract_storage.ml b/src/proto_alpha/lib_protocol/contract_storage.ml index 2ede5839b1cc2459e4679d6a7628fce8493b4a26..c8d2665b57c2caf6901fa48b207a16542b5325c9 100644 --- a/src/proto_alpha/lib_protocol/contract_storage.ml +++ b/src/proto_alpha/lib_protocol/contract_storage.ml @@ -881,7 +881,9 @@ module For_RPC = struct | Contract_repr.Originated _ -> return_none | Implicit _ as contract -> ( let* result = - Unstake_requests_storage.prepare_finalize_unstake ctxt contract + Unstake_requests_storage.For_RPC.prepare_finalize_unstake + ctxt + contract in match result with | None -> return_some (Tez_repr.zero, Tez_repr.zero) diff --git a/src/proto_alpha/lib_protocol/delegate_storage.ml b/src/proto_alpha/lib_protocol/delegate_storage.ml index 519a31c6839bc54dbda05832bcd319cd0caf8a2a..d669c71689d6179d9057562f067eb91dfbbeec5e 100644 --- a/src/proto_alpha/lib_protocol/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/delegate_storage.ml @@ -349,7 +349,7 @@ module For_RPC = struct in let* unstaked_frozen = let* result = - Unstake_requests_storage.prepare_finalize_unstake + Unstake_requests_storage.For_RPC.prepare_finalize_unstake ctxt (Contract_repr.Implicit delegate) in diff --git a/src/proto_alpha/lib_protocol/dune b/src/proto_alpha/lib_protocol/dune index e1c9e1ae8d76e9d30f9dc5b75ba480d8f4fad7f8..cfb3f8ebb60b063b49bffa583afffd704cebc9ea 100644 --- a/src/proto_alpha/lib_protocol/dune +++ b/src/proto_alpha/lib_protocol/dune @@ -178,6 +178,7 @@ Cache_repr Zk_rollup_storage Stake_context + Adaptive_issuance_costs Contract_delegate_storage Stake_storage Unstaked_frozen_deposits_storage @@ -187,7 +188,6 @@ Contract_storage Token Fees_storage - Adaptive_issuance_costs Adaptive_issuance_storage Delegate_staking_parameters Shared_stake @@ -475,6 +475,7 @@ cache_repr.ml cache_repr.mli zk_rollup_storage.ml zk_rollup_storage.mli stake_context.ml stake_context.mli + adaptive_issuance_costs.ml adaptive_issuance_costs.mli contract_delegate_storage.ml contract_delegate_storage.mli stake_storage.ml stake_storage.mli unstaked_frozen_deposits_storage.ml unstaked_frozen_deposits_storage.mli @@ -484,7 +485,6 @@ contract_storage.ml contract_storage.mli token.ml token.mli fees_storage.ml fees_storage.mli - adaptive_issuance_costs.ml adaptive_issuance_costs.mli adaptive_issuance_storage.ml adaptive_issuance_storage.mli delegate_staking_parameters.ml delegate_staking_parameters.mli shared_stake.ml shared_stake.mli @@ -774,6 +774,7 @@ cache_repr.ml cache_repr.mli zk_rollup_storage.ml zk_rollup_storage.mli stake_context.ml stake_context.mli + adaptive_issuance_costs.ml adaptive_issuance_costs.mli contract_delegate_storage.ml contract_delegate_storage.mli stake_storage.ml stake_storage.mli unstaked_frozen_deposits_storage.ml unstaked_frozen_deposits_storage.mli @@ -783,7 +784,6 @@ contract_storage.ml contract_storage.mli token.ml token.mli fees_storage.ml fees_storage.mli - adaptive_issuance_costs.ml adaptive_issuance_costs.mli adaptive_issuance_storage.ml adaptive_issuance_storage.mli delegate_staking_parameters.ml delegate_staking_parameters.mli shared_stake.ml shared_stake.mli @@ -1057,6 +1057,7 @@ cache_repr.ml cache_repr.mli zk_rollup_storage.ml zk_rollup_storage.mli stake_context.ml stake_context.mli + adaptive_issuance_costs.ml adaptive_issuance_costs.mli contract_delegate_storage.ml contract_delegate_storage.mli stake_storage.ml stake_storage.mli unstaked_frozen_deposits_storage.ml unstaked_frozen_deposits_storage.mli @@ -1066,7 +1067,6 @@ contract_storage.ml contract_storage.mli token.ml token.mli fees_storage.ml fees_storage.mli - adaptive_issuance_costs.ml adaptive_issuance_costs.mli adaptive_issuance_storage.ml adaptive_issuance_storage.mli delegate_staking_parameters.ml delegate_staking_parameters.mli shared_stake.ml shared_stake.mli diff --git a/src/proto_alpha/lib_protocol/staking.ml b/src/proto_alpha/lib_protocol/staking.ml index 19c39cc1e3921623a53d9ef13a9d058078b4be99..c622dbded40a85e4f381608b320ef464a678c682 100644 --- a/src/proto_alpha/lib_protocol/staking.ml +++ b/src/proto_alpha/lib_protocol/staking.ml @@ -47,7 +47,7 @@ let () = (fun () -> Cannot_stake_with_unfinalizable_unstake_requests_to_another_delegate) -let perform_finalizable_unstake_transfers ctxt contract finalizable = +let perform_finalizable_unstake_transfers contract ctxt finalizable = let open Lwt_result_syntax in List.fold_left_es (fun (ctxt, balance_updates) (delegate, cycle, amount) -> @@ -63,234 +63,76 @@ let perform_finalizable_unstake_transfers ctxt contract finalizable = (ctxt, []) finalizable -(* The [check_unfinalizable] function in argument must consume its gas, if - relevant. *) -let finalize_unstake_and_check ~check_unfinalizable ctxt contract = - let open Lwt_result_syntax in - let*? ctxt = - Raw_context.consume_gas - ctxt - Adaptive_issuance_costs.prepare_finalize_unstake_cost - in - let* prepared_opt = - Unstake_requests_storage.prepare_finalize_unstake ctxt contract - in - match prepared_opt with - | None -> return (ctxt, [], None) - | Some {finalizable; unfinalizable} -> ( - let* ctxt = check_unfinalizable ctxt unfinalizable in - match finalizable with - | [] -> return (ctxt, [], Some unfinalizable) - | _ -> - (* We only update the unstake requests if the [finalizable] list is not empty. - Indeed, if it is not empty, it means that at least one of the unstake operations - will be finalized, and the storage needs to be updated accordingly. - Conversely, if finalizable is empty, then [unfinalizable] contains - all the previous unstake requests, that should remain as requests after this - operation. *) - let*? ctxt = - Raw_context.consume_gas - ctxt - Adaptive_issuance_costs.finalize_unstake_and_check_cost - in - let* ctxt = - Unstake_requests_storage.update ctxt contract unfinalizable - in - let* ctxt, balance_updates = - perform_finalizable_unstake_transfers ctxt contract finalizable - in - return (ctxt, balance_updates, Some unfinalizable)) - let finalize_unstake ctxt contract = let open Lwt_result_syntax in - let check_unfinalizable ctxt _unfinalizable = return ctxt in - let* ctxt, balance_updates, _ = - finalize_unstake_and_check ~check_unfinalizable ctxt contract + let* ctxt, balance_updates = + Unstake_requests_storage.handle_finalizable_and_clear + ~check_delegate_of_unfinalizable_requests:(fun _ -> return_unit) + ~handle_finalizable:(perform_finalizable_unstake_transfers contract) + ctxt + contract in return (ctxt, balance_updates) -let can_stake_from_unstake ctxt ~delegate = +let transfer_from_unstake ctxt cycle delegate sender_contract amount = let open Lwt_result_syntax in - let* slashing_history_opt = Storage.Slashed_deposits.find ctxt delegate in - let slashing_history = Option.value slashing_history_opt ~default:[] in - - let* slashing_history_opt_o = - Storage.Contract.Slashed_deposits__Oxford.find + let* ctxt, balance_updates = + Token.transfer ctxt - (Contract_repr.Implicit delegate) + (`Unstaked_frozen_deposits + (Unstaked_frozen_staker_repr.Single (sender_contract, delegate), cycle)) + (`Frozen_deposits + (Frozen_staker_repr.single_staker ~staker:sender_contract ~delegate)) + amount in - let slashing_history_o = - Option.value slashing_history_opt_o ~default:[] - |> List.map (fun (a, b) -> (a, Percentage.convert_from_o_to_p b)) + let* ctxt = + Unstaked_frozen_deposits_storage + .decrease_initial_amount_only_for_stake_from_unstake + ctxt + delegate + cycle + amount in + return (ctxt, balance_updates) - let slashing_history = slashing_history @ slashing_history_o in +(** [may_stake_from_unstake_for_delegate_and_finalize ctxt ~delegate + ~sender_contract amount] + tries to transfer the amount to stake from unfinalizable unstake request if possible, + and finalize all finalizable unstake requests. - let current_cycle = (Raw_context.current_level ctxt).cycle in - let slashable_deposits_period = - Constants_storage.slashable_deposits_period ctxt - in - let oldest_slashable_cycle = - Cycle_repr.sub current_cycle (slashable_deposits_period + 1) - |> Option.value ~default:Cycle_repr.root - in - let*! is_denounced = - Pending_denunciations_storage.has_pending_denunciations ctxt delegate - in - let is_slashed = - List.exists - (fun (x, _) -> Cycle_repr.(x >= oldest_slashable_cycle)) - slashing_history - in - return @@ not (is_denounced || is_slashed) + The conditions that allow a transfer from unfinalizable unstake requests are + defined in {!Unstake_requests_storage.remove_from_unfinalizable_requests_and_finalize}. -let stake_from_unstake_for_delegate ctxt ~delegate ~unfinalizable_requests_opt - amount = + It returns the modified context, the balance updates, and the amount that + remains to be staked from spendable balance. + *) +let may_stake_from_unstake_for_delegate_and_finalize ctxt ~delegate + ~sender_contract amount = let open Lwt_result_syntax in - let remove_from_unstaked_frozen_deposit ctxt cycle delegate sender_contract - amount = - let* ctxt, balance_updates = - Token.transfer - ctxt - (`Unstaked_frozen_deposits - (Unstaked_frozen_staker_repr.Single (sender_contract, delegate), cycle)) - (`Frozen_deposits - (Frozen_staker_repr.single_staker ~staker:sender_contract ~delegate)) - amount - in - let* ctxt = - Unstaked_frozen_deposits_storage - .decrease_initial_amount_only_for_stake_from_unstake - ctxt - delegate - cycle - amount - in - return (ctxt, balance_updates) - in - match unfinalizable_requests_opt with - | None -> return (ctxt, [], amount) - | Some Unstake_requests_storage.{delegate = delegate_requests; requests} -> - if - Signature.Public_key_hash.(delegate <> delegate_requests) - && not (List.is_empty requests) - then (* Should not be possible *) - return (ctxt, [], Tez_repr.zero) - else - let* allowed = can_stake_from_unstake ctxt ~delegate in - if not allowed then - (* a slash could have modified the unstaked frozen deposits: cannot stake from unstake *) - return (ctxt, [], amount) - else - let sender_contract = Contract_repr.Implicit delegate in - let requests_sorted = - List.sort - (fun (cycle1, _) (cycle2, _) -> - Cycle_repr.compare cycle2 cycle1 - (* decreasing cycle order, to release first the tokens - that would be frozen for the longest time *)) - requests - in - let rec transfer_from_unstake ctxt balance_updates - remaining_amount_to_transfer updated_requests_rev requests = - if Tez_repr.(remaining_amount_to_transfer = zero) then - return - ( ctxt, - balance_updates, - Tez_repr.zero, - List.rev_append requests updated_requests_rev ) - else - match requests with - | [] -> - return - ( ctxt, - balance_updates, - remaining_amount_to_transfer, - updated_requests_rev ) - | (cycle, requested_amount) :: t -> - if Tez_repr.(remaining_amount_to_transfer >= requested_amount) - then - let* ctxt, cycle_balance_updates = - remove_from_unstaked_frozen_deposit - ctxt - cycle - delegate - sender_contract - requested_amount - in - let*? remaining_amount = - Tez_repr.( - remaining_amount_to_transfer -? requested_amount) - in - transfer_from_unstake - ctxt - (balance_updates @ cycle_balance_updates) - remaining_amount - updated_requests_rev - t - else - let* ctxt, cycle_balance_updates = - remove_from_unstaked_frozen_deposit - ctxt - cycle - delegate - sender_contract - remaining_amount_to_transfer - in - let*? new_requested_amount = - Tez_repr.( - requested_amount -? remaining_amount_to_transfer) - in - return - ( ctxt, - balance_updates @ cycle_balance_updates, - Tez_repr.zero, - List.rev_append - t - ((cycle, new_requested_amount) :: updated_requests_rev) - ) - in - let* ( ctxt, - balance_updates, - remaining_amount_to_transfer, - updated_requests_rev ) = - transfer_from_unstake ctxt [] amount [] requests_sorted - in - let updated_requests = List.rev updated_requests_rev in - let* ctxt = - Unstake_requests_storage.update - ctxt - sender_contract - {delegate; requests = updated_requests} - in - return (ctxt, balance_updates, remaining_amount_to_transfer) + let check_delegate_of_unfinalizable_requests requests_delegate = + if Signature.Public_key_hash.(delegate <> requests_delegate) then + tzfail + Cannot_stake_with_unfinalizable_unstake_requests_to_another_delegate + else return_unit + in + Unstake_requests_storage.remove_from_unfinalizable_requests_and_finalize + ctxt + ~delegate + ~contract:sender_contract + ~transfer_from_unstake + ~handle_finalizable:(perform_finalizable_unstake_transfers sender_contract) + ~check_delegate_of_unfinalizable_requests + amount let stake ctxt ~(amount : Tez_repr.t) ~sender ~delegate = let open Lwt_result_syntax in - let check_unfinalizable ctxt - Unstake_requests_storage.{delegate = unstake_delegate; requests} = - match requests with - | [] -> return ctxt - | _ :: _ -> - if Signature.Public_key_hash.(delegate <> unstake_delegate) then - tzfail - Cannot_stake_with_unfinalizable_unstake_requests_to_another_delegate - else return ctxt - in let sender_contract = Contract_repr.Implicit sender in - let* ctxt, finalize_balance_updates, unfinalizable_requests_opt = - finalize_unstake_and_check ~check_unfinalizable ctxt sender_contract - in - (* stake from unstake for eligible delegates *) - let* ctxt, stake_balance_updates1, amount_from_liquid = - if Signature.Public_key_hash.(sender <> delegate) then - return (ctxt, [], amount) - else - stake_from_unstake_for_delegate - ctxt - ~delegate - ~unfinalizable_requests_opt - amount + let* (ctxt, stake_unstaked_and_finalize_balance_updates), amount_from_liquid = + may_stake_from_unstake_for_delegate_and_finalize + ctxt + ~delegate + ~sender_contract + amount in (* Issue pseudotokens for delegators *) let* ctxt, stake_balance_updates2 = @@ -311,8 +153,8 @@ let stake ctxt ~(amount : Tez_repr.t) ~sender ~delegate = amount_from_liquid in ( ctxt, - stake_balance_updates1 @ stake_balance_updates2 @ stake_balance_updates3 - @ finalize_balance_updates ) + stake_unstaked_and_finalize_balance_updates @ stake_balance_updates2 + @ stake_balance_updates3 ) let request_unstake ctxt ~sender_contract ~delegate requested_amount = let open Lwt_result_syntax in @@ -340,14 +182,13 @@ let request_unstake ctxt ~sender_contract ~delegate requested_amount = current_cycle )) tez_to_unstake in - let* ctxt, finalize_balance_updates = - finalize_unstake ctxt sender_contract - in - let+ ctxt = - Unstake_requests_storage.add + let+ ctxt, finalize_balance_updates = + Unstake_requests_storage.finalize_and_add ctxt ~contract:sender_contract ~delegate + ~handle_finalizable: + (perform_finalizable_unstake_transfers sender_contract) current_cycle tez_to_unstake in diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml index 5d35d827f7477e242e2accf8ae4c9ee9e098e50c..7b50f52ec17fb96f9efbb9cc34c7770f7c46f51f 100644 --- a/src/proto_alpha/lib_protocol/storage.ml +++ b/src/proto_alpha/lib_protocol/storage.ml @@ -234,17 +234,19 @@ module Unstake_request = struct let add cycle amount requests = let open Result_syntax in - let rec loop rev_prefix = 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 + if Tez_repr.(amount > zero) then + let rec loop rev_prefix = 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 + else return requests end module Contract = struct diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli index 0e7b60543e8a876d13607d7248bbe885952df668..5c8a6bf0ca7c6520e23c6a2fdff762a02dc80cb6 100644 --- a/src/proto_alpha/lib_protocol/storage.mli +++ b/src/proto_alpha/lib_protocol/storage.mli @@ -80,10 +80,19 @@ module Slashed_deposits_history__Oxford : module Unstake_request : sig type request = Cycle_repr.t * Tez_repr.t + (** List of unstake requests. + + Invariant: there is at most one request per cycle in the + list. *) type requests = request list type t = {delegate : Signature.Public_key_hash.t; requests : requests} + (** [add cycle amount requests] adds [amount] to the tez value + associated with [cycle]. + + If there was no unstake request for [cycle], a new request for + it containing [amount] is added at the beginning of the list. *) val add : Cycle_repr.t -> Tez_repr.t -> requests -> requests tzresult end diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml index 68022c072d816e8587de70706b080abccf9204ab..4ff1186700e6c8adb72da49e437256904d45b90f 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml @@ -47,6 +47,8 @@ let () = type finalizable = (Signature.Public_key_hash.t * Cycle_repr.t * Tez_repr.t) list +type transfer_result = Raw_context.t * Receipt_repr.balance_update_item list + let finalizable_encoding = let open Data_encoding in let elt_encoding = @@ -112,7 +114,8 @@ let apply_slashes ~slashable_deposits_period slashing_history ~from_cycle amount amount slashing_history -let prepare_finalize_unstake ctxt contract = +let prepare_finalize_unstake_uncarbonated ctxt + ~check_delegate_of_unfinalizable_requests contract = let open Lwt_result_syntax in let slashable_deposits_period = Constants_storage.slashable_deposits_period ctxt @@ -174,38 +177,272 @@ let prepare_finalize_unstake ctxt contract = Storage.Unstake_request. {delegate; requests = unfinalizable_requests} in + let* () = + if not (List.is_empty unfinalizable_requests) then + check_delegate_of_unfinalizable_requests delegate + else return_unit + in return_some {finalizable; unfinalizable}) -let update = Storage.Contract.Unstake_requests.update +let prepare_finalize_unstake ctxt ~check_delegate_of_unfinalizable_requests + contract = + let open Lwt_result_syntax in + let*? ctxt = + Raw_context.consume_gas + ctxt + Adaptive_issuance_costs.prepare_finalize_unstake_cost + in + let* prepared = + prepare_finalize_unstake_uncarbonated + ctxt + ~check_delegate_of_unfinalizable_requests + contract + in + return (ctxt, prepared) + +(* Update the storage with the given requests. -let add ctxt ~contract ~delegate cycle amount = + If the given structure contains an empty list of requests, it means that + there are no more funds to unstake, and thus there is no need to keep an + entry for the contract. +*) +let set_stored_requests ctxt contract updated_requests = + match updated_requests.requests with + | [] -> Storage.Contract.Unstake_requests.remove ctxt contract + | _ :: _ -> + Storage.Contract.Unstake_requests.add ctxt contract updated_requests + +let handle_finalizable_and_clear ctxt contract + ~check_delegate_of_unfinalizable_requests ~handle_finalizable = let open Lwt_result_syntax in - let* requests_opt = Storage.Contract.Unstake_requests.find ctxt contract in - let*? requests = - match requests_opt with - | None -> Ok [] - | Some {delegate = request_delegate; requests} -> ( - match requests with - | [] -> Ok [] - | _ -> - if Signature.Public_key_hash.(delegate <> request_delegate) then - (* This would happen if the staker was allowed to stake towards - a new delegate while having unfinalizable unstake requests, - which is not allowed: it will fail earlier. Also, unstaking - for 0 tez is a noop and does not change the state of the storage, - so it does not allow to reach this error either. *) - Result_syntax.tzfail - Cannot_unstake_with_unfinalizable_unstake_requests_to_another_delegate - else Ok requests) + let* ctxt, prepared_opt = + prepare_finalize_unstake + ~check_delegate_of_unfinalizable_requests + ctxt + contract + in + match prepared_opt with + | None -> return (ctxt, []) + | Some {finalizable; unfinalizable} -> + let*? ctxt = + Raw_context.consume_gas + ctxt + Adaptive_issuance_costs.finalize_unstake_and_check_cost + in + let* ctxt, balance_updates_finalized = + handle_finalizable ctxt finalizable + in + let*! ctxt = set_stored_requests ctxt contract unfinalizable in + return (ctxt, balance_updates_finalized) + +let finalize_and_add ctxt ~contract ~delegate ~handle_finalizable cycle amount = + let open Lwt_result_syntax in + let* ctxt, prepared_opt = + prepare_finalize_unstake + ~check_delegate_of_unfinalizable_requests:(fun request_delegate -> + if Signature.Public_key_hash.(delegate <> request_delegate) then + (* This would happen if the staker was allowed to stake towards + a new delegate while having unfinalizable unstake requests, + which is not allowed: it will fail earlier. Also, unstaking + for 0 tez is a noop and does not change the state of the storage, + so it does not allow to reach this error either. *) + tzfail + Cannot_unstake_with_unfinalizable_unstake_requests_to_another_delegate + else return_unit) + ctxt + contract + in + let finalizable, requests = + match prepared_opt with + | None -> ([], []) + | Some {finalizable; unfinalizable = {delegate = _; requests}} -> + (finalizable, 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 + let*! ctxt = set_stored_requests ctxt contract unstake_request in + handle_finalizable ctxt finalizable + +let can_stake_from_unstake ctxt ~delegate = + let open Lwt_result_syntax in + let* slashing_history_opt = Storage.Slashed_deposits.find ctxt delegate in + let slashing_history = Option.value slashing_history_opt ~default:[] in + + let* slashing_history_opt_o = + Storage.Contract.Slashed_deposits__Oxford.find + ctxt + (Contract_repr.Implicit delegate) in - return ctxt + let slashing_history_o = + Option.value slashing_history_opt_o ~default:[] + |> List.map (fun (a, b) -> (a, Percentage.convert_from_o_to_p b)) + in + + let slashing_history = slashing_history @ slashing_history_o in + + let current_cycle = (Raw_context.current_level ctxt).cycle in + let slashable_deposits_period = + Constants_storage.slashable_deposits_period ctxt + in + let oldest_slashable_cycle = + Cycle_repr.sub current_cycle (slashable_deposits_period + 1) + |> Option.value ~default:Cycle_repr.root + in + let*! is_denounced = + Pending_denunciations_storage.has_pending_denunciations ctxt delegate + in + let is_slashed = + List.exists + (fun (x, _) -> Cycle_repr.(x >= oldest_slashable_cycle)) + slashing_history + in + return @@ not (is_denounced || is_slashed) + +let remove_from_unfinalizable_requests_and_finalize ctxt ~contract ~delegate + ~check_delegate_of_unfinalizable_requests + ~(transfer_from_unstake : + Raw_context.t -> + Cycle_repr.t -> + Signature.public_key_hash -> + Contract_repr.t -> + Tez_repr.t -> + (Raw_context.t * 'a list) tzresult Lwt.t) + ~(handle_finalizable : + Raw_context.t -> finalizable -> transfer_result tzresult Lwt.t) amount : + (transfer_result * Tez_repr.t) tzresult Lwt.t = + let open Lwt_result_syntax in + let* allowed = + match contract with + | Contract_repr.Implicit contract + when Signature.Public_key_hash.(contract = delegate) -> + can_stake_from_unstake ctxt ~delegate + | Contract_repr.Originated _ | Contract_repr.Implicit _ -> return false + in + if not allowed then + (* a slash could have modified the unstaked frozen deposits: + unfinalizable stake requests cannot be spent *) + let* ctxt, balance_updates = + handle_finalizable_and_clear + ~check_delegate_of_unfinalizable_requests + ~handle_finalizable + ctxt + contract + in + return ((ctxt, balance_updates), amount) + else + let* ctxt, prepared_opt = + prepare_finalize_unstake + ~check_delegate_of_unfinalizable_requests + ctxt + contract + in + match prepared_opt with + | None -> return ((ctxt, []), amount) + | Some {finalizable; unfinalizable = {delegate; requests}} -> + let requests_sorted = + List.sort + (fun (cycle1, _) (cycle2, _) -> + Cycle_repr.compare cycle2 cycle1 + (* decreasing cycle order, to release first the tokens + that would be frozen for the longest time *)) + requests + in + let rec transfer_from_all_unstake ctxt balance_updates + remaining_amount_to_transfer updated_requests_rev requests = + if Tez_repr.(remaining_amount_to_transfer = zero) then + return + ( ctxt, + balance_updates, + Tez_repr.zero, + List.rev_append requests updated_requests_rev ) + else + match requests with + | [] -> + return + ( ctxt, + balance_updates, + remaining_amount_to_transfer, + updated_requests_rev ) + | (cycle, requested_amount) :: t -> + if Tez_repr.(remaining_amount_to_transfer >= requested_amount) + then + let* ctxt, cycle_balance_updates = + transfer_from_unstake + ctxt + cycle + delegate + contract + requested_amount + in + let*? remaining_amount = + Tez_repr.(remaining_amount_to_transfer -? requested_amount) + in + transfer_from_all_unstake + ctxt + (balance_updates @ cycle_balance_updates) + remaining_amount + updated_requests_rev + t + else + let* ctxt, cycle_balance_updates = + transfer_from_unstake + ctxt + cycle + delegate + contract + remaining_amount_to_transfer + in + let*? new_requested_amount = + Tez_repr.(requested_amount -? remaining_amount_to_transfer) + in + return + ( ctxt, + balance_updates @ cycle_balance_updates, + Tez_repr.zero, + List.rev_append + t + ((cycle, new_requested_amount) :: updated_requests_rev) + ) + in + let* ( ctxt, + balance_updates, + remaining_amount_to_transfer, + updated_requests_rev ) = + transfer_from_all_unstake ctxt [] amount [] requests_sorted + in + let updated_requests = List.rev updated_requests_rev in + let*! ctxt = + set_stored_requests + ctxt + contract + {delegate; requests = updated_requests} + in + let* ctxt, balance_updates_finalisation = + handle_finalizable ctxt finalizable + in + return + ( (ctxt, balance_updates @ balance_updates_finalisation), + remaining_amount_to_transfer ) module For_RPC = struct + type nonrec prepared_finalize_unstake = prepared_finalize_unstake = { + finalizable : finalizable; + unfinalizable : stored_requests; + } + + type nonrec stored_requests = stored_requests = { + delegate : Signature.Public_key_hash.t; + requests : (Cycle_repr.t * Tez_repr.t) list; + } + + let prepared_finalize_unstake_encoding : + prepared_finalize_unstake Data_encoding.t = + prepared_finalize_unstake_encoding + + let prepare_finalize_unstake = + prepare_finalize_unstake_uncarbonated + ~check_delegate_of_unfinalizable_requests:(fun _ -> return_unit) + let apply_slash_to_unstaked_unfinalizable ctxt {requests; delegate} = let open Lwt_result_syntax in let slashable_deposits_period = diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli index 7f7ecb57b763c125362f64c3f20e72763f561f98..7aa553251b37a5a7942d0af5dc474a6c12cc9b29 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli @@ -23,66 +23,138 @@ (* *) (*****************************************************************************) -(** Simple abstraction from low-level storage to handle unstake requests. +(** Abstraction from low-level storage to handle unstake requests. This module is responsible for maintaining the - {!Storage.Contract.Unstake_requests} table. *) + {!Storage.Contract.Unstake_requests} table. + + Unstake requests added to this table are merged on a per-cycle basis, + i.e. for a given contract we only retain, for each cycle, the total amount + unstaked in the cycle. + + The table cannot contain more than + {!Constants_storage.slashable_deposits_period} + + {!Constants_repr.max_slashing_period} entries per contract, as one cannot + add value without removing the finalizable ones. + + The table cannot contain a request of zero tez. + Such a request would prevent a change of delegate while there are no + unstaked tez. + + This module is responsible for applying slashing on unstake requests. + + *) type finalizable = (Signature.Public_key_hash.t * Cycle_repr.t * Tez_repr.t) list -type stored_requests = Storage.Unstake_request.t = { - delegate : Signature.Public_key_hash.t; - requests : (Cycle_repr.t * Tez_repr.t) list; -} +type transfer_result = Raw_context.t * Receipt_repr.balance_update_item list -type prepared_finalize_unstake = { - finalizable : finalizable; - unfinalizable : stored_requests; -} +(** [handle_finalizable_and_clear ctxt ~check_delegate_of_unfinalizable_requests ~handle_finalizable contract] will update the storage + by removing all finalizable unstake request and calling [handle_finalizable] + on each of them. -val prepared_finalize_unstake_encoding : - prepared_finalize_unstake Data_encoding.encoding + This operation consumes the cost of the extraction of unstake_requests: + {!Adaptive_issuance_costs.prepare_finalize_unstake_cost}. -(** [prepare_finalize_unstake ctxt contract] - preprocesses a [finalize_unstake] for [contract]. It returns a - list of transfers [(d, c, a)] to do from delegate's [d] unstaked frozen - deposits for cycle [c] of amount [a] in the [finalizable_field] as well as - the remaining unfinalizable requests that should be kept in the storage in - [unfinalizable]. - - It returns [None] if there are no unstake requests. + [check_delegate_of_unfinalizable_requests] can be used to interrupt the current + finalisation by returning an error if it would be illegal to actually unstake funds from the given delegate. *) -val prepare_finalize_unstake : +val handle_finalizable_and_clear : Raw_context.t -> Contract_repr.t -> - prepared_finalize_unstake option tzresult Lwt.t + check_delegate_of_unfinalizable_requests: + (Signature.public_key_hash -> unit tzresult Lwt.t) -> + handle_finalizable: + (Raw_context.t -> finalizable -> transfer_result tzresult Lwt.t) -> + transfer_result tzresult Lwt.t + +(** [remove_from_unfinalizable_requests_and_finalize ctxt ~contract ~delegate + ~check_delegate_of_unfinalizable_requests ~transfer_from_unstake ~handle_finalizable] + allows to spend from unfinalizable unstake requests. -(** [update ctxt contract requests] updates unstake requests for [contract]. *) -val update : + This function ensures that the transfers from unstake request are licit. + If not, it will only finalize the finalizable requests. + + Conditions to allow stake from unstake are the following: + - the delegate of the unfinalizable requests is the staker, + - the delegate has not been slashed in an unfinalizable cycle and has no + pending denunciation. + + Transfers are done using the provided [transfer_from_unstake] and + [handle_finalizable] functions successively. + + It returns the updated context, the balance updates and the part of the + requested amount that could not be taken from the unfinalizable unstake + requests. +*) +val remove_from_unfinalizable_requests_and_finalize : Raw_context.t -> - Contract_repr.t -> - stored_requests -> - Raw_context.t tzresult Lwt.t + contract:Contract_repr.t -> + delegate:Signature.public_key_hash -> + check_delegate_of_unfinalizable_requests: + (Signature.public_key_hash -> unit tzresult Lwt.t) -> + transfer_from_unstake: + (Raw_context.t -> + Cycle_repr.t -> + Signature.public_key_hash -> + Contract_repr.t -> + Tez_repr.t -> + transfer_result tzresult Lwt.t) -> + handle_finalizable: + (Raw_context.t -> finalizable -> transfer_result tzresult Lwt.t) -> + Tez_repr.t -> + (transfer_result * Tez_repr.t) tzresult Lwt.t type error += | Cannot_unstake_with_unfinalizable_unstake_requests_to_another_delegate -(** [add ctxt ~contract ~delegate cycle amount] adds a request from [contract] +(** [finalize_and_add ctxt ~contract ~delegate ~handle_finalizable cycle amount] adds a request from [contract] to unstake [amount] from [delegate] at cycle [cycle]. + It also finalizes all finalizable unstake requests. + @raises Assert_failure if [contract] already has unstake requests from another delegate (broken invariant). *) -val add : +val finalize_and_add : Raw_context.t -> contract:Contract_repr.t -> delegate:Signature.Public_key_hash.t -> + handle_finalizable: + (Raw_context.t -> finalizable -> transfer_result tzresult Lwt.t) -> Cycle_repr.t -> Tez_repr.t -> - Raw_context.t tzresult Lwt.t + transfer_result tzresult Lwt.t (** Slow functions only used for RPCs *) module For_RPC : sig + type stored_requests = Storage.Unstake_request.t = { + delegate : Signature.Public_key_hash.t; + requests : (Cycle_repr.t * Tez_repr.t) list; + } + + type prepared_finalize_unstake = { + finalizable : finalizable; + unfinalizable : stored_requests; + } + + val prepared_finalize_unstake_encoding : + prepared_finalize_unstake Data_encoding.encoding + + (** [prepare_finalize_unstake ctxt contract] + preprocesses a [finalize_unstake] for [contract]. It returns a + list of transfers [(d, c, a)] to do from delegate's [d] unstaked frozen + deposits for cycle [c] of amount [a] in the [finalizable_field] as well as + the remaining unfinalizable requests that should be kept in the storage in + [unfinalizable]. + + It returns [None] if there are no unstake requests. + *) + val prepare_finalize_unstake : + Raw_context.t -> + Contract_repr.t -> + prepared_finalize_unstake option tzresult Lwt.t + (** Apply current slash history to unfinalizable unstake requests. [prepare_finalize_unstake] does not compute this value because it is never used internally. However, we need to apply slashes anyways when trying to