From a9aa84ea219ac1d5e8a06d763038d8d6d4ed7e02 Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Thu, 7 Nov 2024 20:40:46 +0100 Subject: [PATCH 01/14] proto/Unstake_requests_storage: document module --- .../lib_protocol/unstake_requests_storage.mli | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli index 7f7ecb57b763..1a05e1f15aad 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli @@ -23,10 +23,23 @@ (* *) (*****************************************************************************) -(** 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. + + This module is responsible for applying slashing on unstake requests. + + *) type finalizable = (Signature.Public_key_hash.t * Cycle_repr.t * Tez_repr.t) list -- GitLab From feaf29c85e8c261993384b0d732bce55f101c9b2 Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Thu, 7 Nov 2024 10:20:22 +0100 Subject: [PATCH 02/14] proto/Unstake_requests_storage: add helper update_stored_request --- .../lib_protocol/unstake_requests_storage.ml | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml index 68022c072d81..7fa20abe6c06 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml @@ -176,7 +176,22 @@ let prepare_finalize_unstake ctxt contract = in return_some {finalizable; unfinalizable}) -let update = Storage.Contract.Unstake_requests.update +(* Update the storage with the given requests. + + 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 update_stored_request ctxt contract updated_requests = + let open Lwt_result_syntax in + match updated_requests.requests with + | [] -> + let*! ctxt = Storage.Contract.Unstake_requests.remove ctxt contract in + return ctxt + | _ :: _ -> + Storage.Contract.Unstake_requests.update ctxt contract updated_requests + +let update = update_stored_request let add ctxt ~contract ~delegate cycle amount = let open Lwt_result_syntax in -- GitLab From 91f2e49908c9f35ef59aca359fd47e96be42beda Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Tue, 12 Nov 2024 12:16:49 +0100 Subject: [PATCH 03/14] proto/TEZOS_PROTOCOL: update dependency order So that adaptive_issuance_costs is available in unstake_requests_storage. --- src/proto_alpha/lib_protocol/TEZOS_PROTOCOL | 2 +- src/proto_alpha/lib_protocol/dune | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL index b304bdd315b7..bed70e8c3409 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/dune b/src/proto_alpha/lib_protocol/dune index e1c9e1ae8d76..cfb3f8ebb60b 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 -- GitLab From 210cb2f1122ca8ebb810975dcbcb91bcdb38dbd4 Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Wed, 11 Dec 2024 11:02:39 +0100 Subject: [PATCH 04/14] proto/Unstake_request_storage: Move finalize in unstake_request_storage --- src/proto_alpha/lib_protocol/staking.ml | 50 ++++--------------- .../lib_protocol/unstake_requests_storage.ml | 35 +++++++++++++ .../lib_protocol/unstake_requests_storage.mli | 16 ++++++ 3 files changed, 61 insertions(+), 40 deletions(-) diff --git a/src/proto_alpha/lib_protocol/staking.ml b/src/proto_alpha/lib_protocol/staking.ml index 19c39cc1e392..b7224d464bb8 100644 --- a/src/proto_alpha/lib_protocol/staking.ml +++ b/src/proto_alpha/lib_protocol/staking.ml @@ -63,49 +63,15 @@ 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 + Unstake_requests_storage.finalize_unstake_and_check + ~check_unfinalizable + ~perform_finalizable_unstake_transfers + ctxt + contract in return (ctxt, balance_updates) @@ -279,7 +245,11 @@ let stake ctxt ~(amount : Tez_repr.t) ~sender ~delegate = 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 + Unstake_requests_storage.finalize_unstake_and_check + ~check_unfinalizable + ~perform_finalizable_unstake_transfers + ctxt + sender_contract in (* stake from unstake for eligible delegates *) let* ctxt, stake_balance_updates1, amount_from_liquid = diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml index 7fa20abe6c06..bc17a5fd891a 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml @@ -193,6 +193,41 @@ let update_stored_request ctxt contract updated_requests = let update = update_stored_request +(* The [check_unfinalizable] function in argument must consume its gas, if + relevant. *) +let finalize_unstake_and_check ~check_unfinalizable + ~perform_finalizable_unstake_transfers 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 = 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 = update ctxt contract unfinalizable in + let* ctxt, balance_updates = + perform_finalizable_unstake_transfers ctxt contract finalizable + in + return (ctxt, balance_updates, Some unfinalizable)) + let add ctxt ~contract ~delegate cycle amount = let open Lwt_result_syntax in let* requests_opt = Storage.Contract.Unstake_requests.find ctxt contract in diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli index 1a05e1f15aad..5f52421da943 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli @@ -78,6 +78,22 @@ val update : stored_requests -> Raw_context.t tzresult Lwt.t +val finalize_unstake_and_check : + check_unfinalizable: + (Raw_context.t -> stored_requests -> Raw_context.t tzresult Lwt.t) -> + perform_finalizable_unstake_transfers: + (Raw_context.t -> + Contract_repr.t -> + (Signature.public_key_hash * Cycle_repr.t * Tez_repr.t) list -> + (Raw_context.t * Receipt_repr.balance_update_item list) tzresult Lwt.t) -> + Raw_context.t -> + Contract_repr.t -> + (Raw_context.t + * Receipt_repr.balance_update_item list + * stored_requests option) + tzresult + Lwt.t + type error += | Cannot_unstake_with_unfinalizable_unstake_requests_to_another_delegate -- GitLab From 740f2955f61477403246f43b0619bebfc2f9a3da Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Thu, 12 Dec 2024 09:31:47 +0100 Subject: [PATCH 05/14] proto/staking: extract transfer_from_unstake function --- src/proto_alpha/lib_protocol/staking.ml | 46 ++++++++++++------------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/src/proto_alpha/lib_protocol/staking.ml b/src/proto_alpha/lib_protocol/staking.ml index b7224d464bb8..fdb5d29c5d51 100644 --- a/src/proto_alpha/lib_protocol/staking.ml +++ b/src/proto_alpha/lib_protocol/staking.ml @@ -110,30 +110,30 @@ let can_stake_from_unstake ctxt ~delegate = in return @@ not (is_denounced || is_slashed) +let transfer_from_unstake_request ctxt cycle delegate sender_contract amount = + let open Lwt_result_syntax in + 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) + let stake_from_unstake_for_delegate ctxt ~delegate ~unfinalizable_requests_opt 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} -> @@ -177,7 +177,7 @@ let stake_from_unstake_for_delegate ctxt ~delegate ~unfinalizable_requests_opt if Tez_repr.(remaining_amount_to_transfer >= requested_amount) then let* ctxt, cycle_balance_updates = - remove_from_unstaked_frozen_deposit + transfer_from_unstake_request ctxt cycle delegate @@ -196,7 +196,7 @@ let stake_from_unstake_for_delegate ctxt ~delegate ~unfinalizable_requests_opt t else let* ctxt, cycle_balance_updates = - remove_from_unstaked_frozen_deposit + transfer_from_unstake_request ctxt cycle delegate -- GitLab From f9951d01023b24e28507834dd416c11d9660664d Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Thu, 12 Dec 2024 09:40:17 +0100 Subject: [PATCH 06/14] proto/staking,unstake_request_storage: move stake_from_unstake --- src/proto_alpha/lib_protocol/staking.ml | 138 +----------------- .../lib_protocol/unstake_requests_storage.ml | 132 +++++++++++++++++ .../lib_protocol/unstake_requests_storage.mli | 14 ++ 3 files changed, 148 insertions(+), 136 deletions(-) diff --git a/src/proto_alpha/lib_protocol/staking.ml b/src/proto_alpha/lib_protocol/staking.ml index fdb5d29c5d51..5c75317b5021 100644 --- a/src/proto_alpha/lib_protocol/staking.ml +++ b/src/proto_alpha/lib_protocol/staking.ml @@ -75,41 +75,6 @@ let finalize_unstake ctxt contract = in return (ctxt, balance_updates) -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 - 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 transfer_from_unstake_request ctxt cycle delegate sender_contract amount = let open Lwt_result_syntax in let* ctxt, balance_updates = @@ -131,106 +96,6 @@ let transfer_from_unstake_request ctxt cycle delegate sender_contract amount = in return (ctxt, balance_updates) -let stake_from_unstake_for_delegate ctxt ~delegate ~unfinalizable_requests_opt - amount = - let open Lwt_result_syntax 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 = - transfer_from_unstake_request - 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 = - transfer_from_unstake_request - 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 stake ctxt ~(amount : Tez_repr.t) ~sender ~delegate = let open Lwt_result_syntax in let check_unfinalizable ctxt @@ -256,9 +121,10 @@ let stake ctxt ~(amount : Tez_repr.t) ~sender ~delegate = if Signature.Public_key_hash.(sender <> delegate) then return (ctxt, [], amount) else - stake_from_unstake_for_delegate + Unstake_requests_storage.stake_from_unstake_for_delegate ctxt ~delegate + ~transfer_from_unstake_request ~unfinalizable_requests_opt amount in diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml index bc17a5fd891a..35ead4ce4fd1 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml @@ -255,6 +255,138 @@ let add ctxt ~contract ~delegate cycle amount = in return ctxt +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 + 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 stake_from_unstake_for_delegate ctxt ~delegate + ~transfer_from_unstake_request ~unfinalizable_requests_opt amount = + let open Lwt_result_syntax in + match unfinalizable_requests_opt with + | None -> return (ctxt, [], amount) + | Some {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 = + transfer_from_unstake_request + 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 = + transfer_from_unstake_request + 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 = + update ctxt sender_contract {delegate; requests = updated_requests} + in + return (ctxt, balance_updates, remaining_amount_to_transfer) + module For_RPC = struct let apply_slash_to_unstaked_unfinalizable ctxt {requests; delegate} = let open Lwt_result_syntax in diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli index 5f52421da943..f69fc34e782c 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli @@ -78,6 +78,20 @@ val update : stored_requests -> Raw_context.t tzresult Lwt.t +val stake_from_unstake_for_delegate : + Raw_context.t -> + delegate:Signature.public_key_hash -> + transfer_from_unstake_request: + (Raw_context.t -> + Cycle_repr.t -> + Signature.public_key_hash -> + Contract_repr.t -> + Tez_repr.t -> + (Raw_context.t * 'a list) tzresult Lwt.t) -> + unfinalizable_requests_opt:stored_requests option -> + Tez_repr.t -> + (Raw_context.t * 'a list * Tez_repr.t) tzresult Lwt.t + val finalize_unstake_and_check : check_unfinalizable: (Raw_context.t -> stored_requests -> Raw_context.t tzresult Lwt.t) -> -- GitLab From 2ec27bfbf76ae168b8f3fc93100b40129a77b9ab Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Thu, 12 Dec 2024 09:48:44 +0100 Subject: [PATCH 07/14] proto/unstake_request_storage: removing update from the interface --- src/proto_alpha/lib_protocol/unstake_requests_storage.ml | 9 +++++---- .../lib_protocol/unstake_requests_storage.mli | 7 ------- 2 files changed, 5 insertions(+), 11 deletions(-) diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml index 35ead4ce4fd1..34b1e18c6377 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml @@ -191,8 +191,6 @@ let update_stored_request ctxt contract updated_requests = | _ :: _ -> Storage.Contract.Unstake_requests.update ctxt contract updated_requests -let update = update_stored_request - (* The [check_unfinalizable] function in argument must consume its gas, if relevant. *) let finalize_unstake_and_check ~check_unfinalizable @@ -222,7 +220,7 @@ let finalize_unstake_and_check ~check_unfinalizable ctxt Adaptive_issuance_costs.finalize_unstake_and_check_cost in - let* ctxt = update ctxt contract unfinalizable in + let* ctxt = update_stored_request ctxt contract unfinalizable in let* ctxt, balance_updates = perform_finalizable_unstake_transfers ctxt contract finalizable in @@ -383,7 +381,10 @@ let stake_from_unstake_for_delegate ctxt ~delegate in let updated_requests = List.rev updated_requests_rev in let* ctxt = - update ctxt sender_contract {delegate; requests = updated_requests} + update_stored_request + ctxt + sender_contract + {delegate; requests = updated_requests} in return (ctxt, balance_updates, remaining_amount_to_transfer) diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli index f69fc34e782c..c256bf7117d8 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli @@ -71,13 +71,6 @@ val prepare_finalize_unstake : Contract_repr.t -> prepared_finalize_unstake option tzresult Lwt.t -(** [update ctxt contract requests] updates unstake requests for [contract]. *) -val update : - Raw_context.t -> - Contract_repr.t -> - stored_requests -> - Raw_context.t tzresult Lwt.t - val stake_from_unstake_for_delegate : Raw_context.t -> delegate:Signature.public_key_hash -> -- GitLab From 6482793dbca20da848f218e9d977c4a7651bcc9f Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Wed, 11 Dec 2024 11:27:19 +0100 Subject: [PATCH 08/14] proto/unstake_request_storage: unexpose internals to check function --- src/proto_alpha/lib_protocol/staking.ml | 42 +++++++------ .../lib_protocol/unstake_requests_storage.ml | 61 ++++++++++--------- .../lib_protocol/unstake_requests_storage.mli | 28 +++++---- 3 files changed, 71 insertions(+), 60 deletions(-) diff --git a/src/proto_alpha/lib_protocol/staking.ml b/src/proto_alpha/lib_protocol/staking.ml index 5c75317b5021..02c29ef1b5fc 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) -> @@ -65,11 +65,10 @@ let perform_finalizable_unstake_transfers ctxt contract finalizable = let finalize_unstake ctxt contract = let open Lwt_result_syntax in - let check_unfinalizable ctxt _unfinalizable = return ctxt in - let* ctxt, balance_updates, _ = - Unstake_requests_storage.finalize_unstake_and_check - ~check_unfinalizable - ~perform_finalizable_unstake_transfers + 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 @@ -98,24 +97,29 @@ let transfer_from_unstake_request ctxt cycle delegate sender_contract 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 + let check_delegate_of_unfinalizable_requests unstake_delegate = + if Signature.Public_key_hash.(delegate <> unstake_delegate) then + tzfail + Cannot_stake_with_unfinalizable_unstake_requests_to_another_delegate + else return_unit in let sender_contract = Contract_repr.Implicit sender in - let* ctxt, finalize_balance_updates, unfinalizable_requests_opt = - Unstake_requests_storage.finalize_unstake_and_check - ~check_unfinalizable - ~perform_finalizable_unstake_transfers + let* ctxt, finalize_balance_updates = + Unstake_requests_storage.handle_finalizable_and_clear + ~check_delegate_of_unfinalizable_requests + ~handle_finalizable: + (perform_finalizable_unstake_transfers sender_contract) ctxt sender_contract in + let* unfinalizable_requests_opt = + Unstake_requests_storage.prepare_finalize_unstake ctxt sender_contract + in + let unfinalizable_requests_opt = + Option.map + (fun Unstake_requests_storage.{unfinalizable; _} -> unfinalizable) + unfinalizable_requests_opt + in (* stake from unstake for eligible delegates *) let* ctxt, stake_balance_updates1, amount_from_liquid = if Signature.Public_key_hash.(sender <> delegate) then diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml index 34b1e18c6377..d9d56efcad06 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 ctxt ~check_delegate_of_unfinalizable_requests + contract = let open Lwt_result_syntax in let slashable_deposits_period = Constants_storage.slashable_deposits_period ctxt @@ -174,6 +177,11 @@ 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}) (* Update the storage with the given requests. @@ -191,40 +199,33 @@ let update_stored_request ctxt contract updated_requests = | _ :: _ -> Storage.Contract.Unstake_requests.update ctxt contract updated_requests -(* The [check_unfinalizable] function in argument must consume its gas, if - relevant. *) -let finalize_unstake_and_check ~check_unfinalizable - ~perform_finalizable_unstake_transfers ctxt contract = +let handle_finalizable_and_clear ctxt contract + ~check_delegate_of_unfinalizable_requests ~handle_finalizable = let open Lwt_result_syntax in let*? ctxt = Raw_context.consume_gas ctxt Adaptive_issuance_costs.prepare_finalize_unstake_cost in - let* prepared_opt = prepare_finalize_unstake ctxt contract in + let* prepared_opt = + prepare_finalize_unstake + ~check_delegate_of_unfinalizable_requests + 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 = update_stored_request ctxt contract unfinalizable in - let* ctxt, balance_updates = - perform_finalizable_unstake_transfers ctxt contract finalizable - in - return (ctxt, balance_updates, Some unfinalizable)) + | 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 = update_stored_request ctxt contract unfinalizable in + return (ctxt, balance_updates_finalized) let add ctxt ~contract ~delegate cycle amount = let open Lwt_result_syntax in @@ -388,6 +389,10 @@ let stake_from_unstake_for_delegate ctxt ~delegate in return (ctxt, balance_updates, remaining_amount_to_transfer) +let prepare_finalize_unstake = + prepare_finalize_unstake ~check_delegate_of_unfinalizable_requests:(fun _ -> + return_unit) + module For_RPC = struct let apply_slash_to_unstaked_unfinalizable ctxt {requests; delegate} = let open Lwt_result_syntax in diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli index c256bf7117d8..9b5690e2f9d0 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli @@ -44,6 +44,8 @@ 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 + type stored_requests = Storage.Unstake_request.t = { delegate : Signature.Public_key_hash.t; requests : (Cycle_repr.t * Tez_repr.t) list; @@ -85,21 +87,21 @@ val stake_from_unstake_for_delegate : Tez_repr.t -> (Raw_context.t * 'a list * Tez_repr.t) tzresult Lwt.t -val finalize_unstake_and_check : - check_unfinalizable: - (Raw_context.t -> stored_requests -> Raw_context.t tzresult Lwt.t) -> - perform_finalizable_unstake_transfers: - (Raw_context.t -> - Contract_repr.t -> - (Signature.public_key_hash * Cycle_repr.t * Tez_repr.t) list -> - (Raw_context.t * Receipt_repr.balance_update_item list) tzresult Lwt.t) -> +(** [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. + + [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 handle_finalizable_and_clear : Raw_context.t -> Contract_repr.t -> - (Raw_context.t - * Receipt_repr.balance_update_item list - * stored_requests 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 type error += | Cannot_unstake_with_unfinalizable_unstake_requests_to_another_delegate -- GitLab From aa792bd32e85eaf966dc0199dbf7e60286754b12 Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Thu, 7 Nov 2024 20:59:38 +0100 Subject: [PATCH 09/14] proto/unstake_request_storage: Push carbonation in prepared_finalize_unstake --- .../lib_protocol/unstake_requests_storage.ml | 31 +++++++++++++------ .../lib_protocol/unstake_requests_storage.mli | 3 ++ 2 files changed, 24 insertions(+), 10 deletions(-) diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml index d9d56efcad06..b6956c46f526 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml @@ -114,8 +114,8 @@ let apply_slashes ~slashable_deposits_period slashing_history ~from_cycle amount amount slashing_history -let prepare_finalize_unstake ctxt ~check_delegate_of_unfinalizable_requests - 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 @@ -184,6 +184,22 @@ let prepare_finalize_unstake ctxt ~check_delegate_of_unfinalizable_requests in return_some {finalizable; unfinalizable}) +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. If the given structure contains an empty list of requests, it means that @@ -202,12 +218,7 @@ let update_stored_request 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*? ctxt = - Raw_context.consume_gas - ctxt - Adaptive_issuance_costs.prepare_finalize_unstake_cost - in - let* prepared_opt = + let* ctxt, prepared_opt = prepare_finalize_unstake ~check_delegate_of_unfinalizable_requests ctxt @@ -390,8 +401,8 @@ let stake_from_unstake_for_delegate ctxt ~delegate return (ctxt, balance_updates, remaining_amount_to_transfer) let prepare_finalize_unstake = - prepare_finalize_unstake ~check_delegate_of_unfinalizable_requests:(fun _ -> - return_unit) + prepare_finalize_unstake_uncarbonated + ~check_delegate_of_unfinalizable_requests:(fun _ -> return_unit) module For_RPC = struct let apply_slash_to_unstaked_unfinalizable ctxt {requests; delegate} = diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli index 9b5690e2f9d0..d185dd60c2cc 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli @@ -91,6 +91,9 @@ val stake_from_unstake_for_delegate : by removing all finalizable unstake request and calling [handle_finalizable] on each of them. + This operation consumes the cost of the extraction of unstake_requests: + {!Adaptive_issuance_costs.prepare_finalize_unstake_cost}. + [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. *) -- GitLab From 1952f79cb99ea17e790a4aebf20a3d3b4660b968 Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Thu, 7 Nov 2024 13:06:42 +0100 Subject: [PATCH 10/14] proto/Unstake_request_storage: move transfers from unfinalisable to Unstake_request_storage --- src/proto_alpha/lib_protocol/staking.ml | 64 ++--- .../lib_protocol/unstake_requests_storage.ml | 218 ++++++++++-------- .../lib_protocol/unstake_requests_storage.mli | 51 ++-- 3 files changed, 192 insertions(+), 141 deletions(-) diff --git a/src/proto_alpha/lib_protocol/staking.ml b/src/proto_alpha/lib_protocol/staking.ml index 02c29ef1b5fc..c38c624c02e8 100644 --- a/src/proto_alpha/lib_protocol/staking.ml +++ b/src/proto_alpha/lib_protocol/staking.ml @@ -95,42 +95,44 @@ let transfer_from_unstake_request ctxt cycle delegate sender_contract amount = in return (ctxt, balance_updates) -let stake ctxt ~(amount : Tez_repr.t) ~sender ~delegate = +(** [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. + + The conditions that allow a transfer from unfinalizable unstake requests are + defined in {!Unstake_requests_storage.remove_from_unfinalizable_requests_and_finalize}. + + 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 check_delegate_of_unfinalizable_requests unstake_delegate = - if Signature.Public_key_hash.(delegate <> unstake_delegate) then + 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_request + ~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 sender_contract = Contract_repr.Implicit sender in - let* ctxt, finalize_balance_updates = - Unstake_requests_storage.handle_finalizable_and_clear - ~check_delegate_of_unfinalizable_requests - ~handle_finalizable: - (perform_finalizable_unstake_transfers sender_contract) + let* (ctxt, stake_unstaked_and_finalize_balance_updates), amount_from_liquid = + may_stake_from_unstake_for_delegate_and_finalize ctxt - sender_contract - in - let* unfinalizable_requests_opt = - Unstake_requests_storage.prepare_finalize_unstake ctxt sender_contract - in - let unfinalizable_requests_opt = - Option.map - (fun Unstake_requests_storage.{unfinalizable; _} -> unfinalizable) - unfinalizable_requests_opt - 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 - Unstake_requests_storage.stake_from_unstake_for_delegate - ctxt - ~delegate - ~transfer_from_unstake_request - ~unfinalizable_requests_opt - amount + ~delegate + ~sender_contract + amount in (* Issue pseudotokens for delegators *) let* ctxt, stake_balance_updates2 = @@ -151,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 diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml index b6956c46f526..4ce3c08a0aaa 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml @@ -300,105 +300,131 @@ let can_stake_from_unstake ctxt ~delegate = in return @@ not (is_denounced || is_slashed) -let stake_from_unstake_for_delegate ctxt ~delegate - ~transfer_from_unstake_request ~unfinalizable_requests_opt amount = +let remove_from_unfinalizable_requests_and_finalize ctxt ~contract ~delegate + ~check_delegate_of_unfinalizable_requests + ~(transfer_from_unstake_request : + 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 - match unfinalizable_requests_opt with - | None -> return (ctxt, [], amount) - | Some {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 - | [] -> + 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_request + 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_request + 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, - 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_request - 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 = - transfer_from_unstake_request - 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 = - update_stored_request - ctxt - sender_contract - {delegate; requests = updated_requests} - in - return (ctxt, balance_updates, remaining_amount_to_transfer) + 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 = + Storage.Contract.Unstake_requests.update + 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 ) let prepare_finalize_unstake = prepare_finalize_unstake_uncarbonated diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli index d185dd60c2cc..216d23184f2f 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli @@ -73,20 +73,6 @@ val prepare_finalize_unstake : Contract_repr.t -> prepared_finalize_unstake option tzresult Lwt.t -val stake_from_unstake_for_delegate : - Raw_context.t -> - delegate:Signature.public_key_hash -> - transfer_from_unstake_request: - (Raw_context.t -> - Cycle_repr.t -> - Signature.public_key_hash -> - Contract_repr.t -> - Tez_repr.t -> - (Raw_context.t * 'a list) tzresult Lwt.t) -> - unfinalizable_requests_opt:stored_requests option -> - Tez_repr.t -> - (Raw_context.t * 'a list * Tez_repr.t) tzresult Lwt.t - (** [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. @@ -106,6 +92,43 @@ val handle_finalizable_and_clear : (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_request ~handle_finalizable] + allows to spend from unfinalizable unstake requests. + + 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_request] 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:Contract_repr.t -> + delegate:Signature.public_key_hash -> + check_delegate_of_unfinalizable_requests: + (Signature.public_key_hash -> unit tzresult Lwt.t) -> + transfer_from_unstake_request: + (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 -- GitLab From 21049493b7460247960c039fdd35098fe29da8fc Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Tue, 5 Nov 2024 11:21:07 +0100 Subject: [PATCH 11/14] Unstake_requests_storage: Move prepare_finalize_unstake to For_RPC --- .../lib_plugin/contract_services.ml | 11 ++-- .../lib_plugin/contract_services.mli | 2 +- .../lib_plugin/delegate_services.ml | 10 ++-- src/proto_alpha/lib_protocol/alpha_context.ml | 2 + .../lib_protocol/alpha_context.mli | 26 ++++----- .../lib_protocol/contract_storage.ml | 4 +- .../lib_protocol/delegate_storage.ml | 2 +- .../lib_protocol/unstake_requests_storage.ml | 22 ++++++-- .../lib_protocol/unstake_requests_storage.mli | 54 +++++++++---------- 9 files changed, 75 insertions(+), 58 deletions(-) diff --git a/src/proto_alpha/lib_plugin/contract_services.ml b/src/proto_alpha/lib_plugin/contract_services.ml index 216c72be6ec2..6970215343b2 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 70a5d42332a6..caaccc2aac59 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 1394aa53b54f..a2294cd474be 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/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index 1574be3a8b20..aba85493eabe 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 c95a50c39f7c..bb68ab42cbcb 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 2ede5839b1cc..c8d2665b57c2 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 519a31c6839b..d669c71689d6 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/unstake_requests_storage.ml b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml index 4ce3c08a0aaa..dc526c5e665f 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml @@ -426,11 +426,25 @@ let remove_from_unfinalizable_requests_and_finalize ctxt ~contract ~delegate ( (ctxt, balance_updates @ balance_updates_finalisation), remaining_amount_to_transfer ) -let prepare_finalize_unstake = - prepare_finalize_unstake_uncarbonated - ~check_delegate_of_unfinalizable_requests:(fun _ -> return_unit) - 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 216d23184f2f..3888548e3fe8 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli @@ -46,33 +46,6 @@ type finalizable = type transfer_result = Raw_context.t * Receipt_repr.balance_update_item list -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 - (** [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. @@ -147,6 +120,33 @@ val add : (** 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 -- GitLab From 6ab52c01edbabd01f958dca316f29196f6b4edcf Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Thu, 7 Nov 2024 21:19:09 +0100 Subject: [PATCH 12/14] proto/unstake_request_storage: ensure we always finalize when adding request --- src/proto_alpha/lib_protocol/staking.ml | 9 ++-- .../lib_protocol/unstake_requests_storage.ml | 41 ++++++++++--------- .../lib_protocol/unstake_requests_storage.mli | 10 +++-- 3 files changed, 33 insertions(+), 27 deletions(-) diff --git a/src/proto_alpha/lib_protocol/staking.ml b/src/proto_alpha/lib_protocol/staking.ml index c38c624c02e8..fec496880194 100644 --- a/src/proto_alpha/lib_protocol/staking.ml +++ b/src/proto_alpha/lib_protocol/staking.ml @@ -182,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/unstake_requests_storage.ml b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml index dc526c5e665f..4b804b75d6a4 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml @@ -238,32 +238,35 @@ let handle_finalizable_and_clear ctxt contract let* ctxt = update_stored_request ctxt contract unfinalizable in return (ctxt, balance_updates_finalized) -let add ctxt ~contract ~delegate cycle amount = +let finalize_and_add ctxt ~contract ~delegate ~handle_finalizable 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 -> 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:(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 in - return ctxt + handle_finalizable ctxt finalizable let can_stake_from_unstake ctxt ~delegate = let open Lwt_result_syntax in diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli index 3888548e3fe8..75723235dcce 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli @@ -105,18 +105,22 @@ val remove_from_unfinalizable_requests_and_finalize : 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 -- GitLab From cd25fc8a4078389353ec9752f8e1be5c43ed263a Mon Sep 17 00:00:00 2001 From: Julien Tesson Date: Wed, 13 Nov 2024 23:17:03 +0100 Subject: [PATCH 13/14] proto/unstake_request_storage: ensure invariants --- src/proto_alpha/lib_protocol/storage.ml | 24 ++++++++++--------- src/proto_alpha/lib_protocol/storage.mli | 9 +++++++ .../lib_protocol/unstake_requests_storage.ml | 19 ++++++--------- .../lib_protocol/unstake_requests_storage.mli | 4 ++++ 4 files changed, 33 insertions(+), 23 deletions(-) diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml index 5d35d827f747..7b50f52ec17f 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 0e7b60543e8a..5c8a6bf0ca7c 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 4b804b75d6a4..fb2a4c514f37 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml @@ -206,14 +206,11 @@ let prepare_finalize_unstake ctxt ~check_delegate_of_unfinalizable_requests there are no more funds to unstake, and thus there is no need to keep an entry for the contract. *) -let update_stored_request ctxt contract updated_requests = - let open Lwt_result_syntax in +let set_stored_requests ctxt contract updated_requests = match updated_requests.requests with - | [] -> - let*! ctxt = Storage.Contract.Unstake_requests.remove ctxt contract in - return ctxt + | [] -> Storage.Contract.Unstake_requests.remove ctxt contract | _ :: _ -> - Storage.Contract.Unstake_requests.update ctxt contract updated_requests + Storage.Contract.Unstake_requests.add ctxt contract updated_requests let handle_finalizable_and_clear ctxt contract ~check_delegate_of_unfinalizable_requests ~handle_finalizable = @@ -235,7 +232,7 @@ let handle_finalizable_and_clear ctxt contract let* ctxt, balance_updates_finalized = handle_finalizable ctxt finalizable in - let* ctxt = update_stored_request ctxt contract unfinalizable 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 = @@ -263,9 +260,7 @@ let finalize_and_add ctxt ~contract ~delegate ~handle_finalizable cycle amount = 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 + let*! ctxt = set_stored_requests ctxt contract unstake_request in handle_finalizable ctxt finalizable let can_stake_from_unstake ctxt ~delegate = @@ -416,8 +411,8 @@ let remove_from_unfinalizable_requests_and_finalize ctxt ~contract ~delegate transfer_from_all_unstake ctxt [] amount [] requests_sorted in let updated_requests = List.rev updated_requests_rev in - let* ctxt = - Storage.Contract.Unstake_requests.update + let*! ctxt = + set_stored_requests ctxt contract {delegate; requests = updated_requests} diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli index 75723235dcce..00ccadfacbbc 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli @@ -37,6 +37,10 @@ {!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. *) -- GitLab From f7762c800ba570c287cd297456e0532de2e588f1 Mon Sep 17 00:00:00 2001 From: Diane Gallois-Wong Date: Wed, 15 Jan 2025 17:28:13 +0100 Subject: [PATCH 14/14] Proto: rename transfer_from_unstake_request --- src/proto_alpha/lib_protocol/staking.ml | 4 ++-- src/proto_alpha/lib_protocol/unstake_requests_storage.ml | 6 +++--- src/proto_alpha/lib_protocol/unstake_requests_storage.mli | 6 +++--- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/proto_alpha/lib_protocol/staking.ml b/src/proto_alpha/lib_protocol/staking.ml index fec496880194..c622dbded40a 100644 --- a/src/proto_alpha/lib_protocol/staking.ml +++ b/src/proto_alpha/lib_protocol/staking.ml @@ -74,7 +74,7 @@ let finalize_unstake ctxt contract = in return (ctxt, balance_updates) -let transfer_from_unstake_request ctxt cycle delegate sender_contract amount = +let transfer_from_unstake ctxt cycle delegate sender_contract amount = let open Lwt_result_syntax in let* ctxt, balance_updates = Token.transfer @@ -119,7 +119,7 @@ let may_stake_from_unstake_for_delegate_and_finalize ctxt ~delegate ctxt ~delegate ~contract:sender_contract - ~transfer_from_unstake_request + ~transfer_from_unstake ~handle_finalizable:(perform_finalizable_unstake_transfers sender_contract) ~check_delegate_of_unfinalizable_requests amount diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml index fb2a4c514f37..4ff1186700e6 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.ml +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.ml @@ -300,7 +300,7 @@ let can_stake_from_unstake ctxt ~delegate = let remove_from_unfinalizable_requests_and_finalize ctxt ~contract ~delegate ~check_delegate_of_unfinalizable_requests - ~(transfer_from_unstake_request : + ~(transfer_from_unstake : Raw_context.t -> Cycle_repr.t -> Signature.public_key_hash -> @@ -367,7 +367,7 @@ let remove_from_unfinalizable_requests_and_finalize ctxt ~contract ~delegate if Tez_repr.(remaining_amount_to_transfer >= requested_amount) then let* ctxt, cycle_balance_updates = - transfer_from_unstake_request + transfer_from_unstake ctxt cycle delegate @@ -385,7 +385,7 @@ let remove_from_unfinalizable_requests_and_finalize ctxt ~contract ~delegate t else let* ctxt, cycle_balance_updates = - transfer_from_unstake_request + transfer_from_unstake ctxt cycle delegate diff --git a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli index 00ccadfacbbc..7aa553251b37 100644 --- a/src/proto_alpha/lib_protocol/unstake_requests_storage.mli +++ b/src/proto_alpha/lib_protocol/unstake_requests_storage.mli @@ -70,7 +70,7 @@ val handle_finalizable_and_clear : transfer_result tzresult Lwt.t (** [remove_from_unfinalizable_requests_and_finalize ctxt ~contract ~delegate - ~check_delegate_of_unfinalizable_requests ~transfer_from_unstake_request ~handle_finalizable] + ~check_delegate_of_unfinalizable_requests ~transfer_from_unstake ~handle_finalizable] allows to spend from unfinalizable unstake requests. This function ensures that the transfers from unstake request are licit. @@ -81,7 +81,7 @@ val handle_finalizable_and_clear : - the delegate has not been slashed in an unfinalizable cycle and has no pending denunciation. - Transfers are done using the provided [transfer_from_unstake_request] and + 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 @@ -94,7 +94,7 @@ val remove_from_unfinalizable_requests_and_finalize : delegate:Signature.public_key_hash -> check_delegate_of_unfinalizable_requests: (Signature.public_key_hash -> unit tzresult Lwt.t) -> - transfer_from_unstake_request: + transfer_from_unstake: (Raw_context.t -> Cycle_repr.t -> Signature.public_key_hash -> -- GitLab