From 571991a3e51453c8a16aa82025442d67d2005c0e Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 7 Jun 2023 18:55:32 +0200
Subject: [PATCH 1/2] Proto/Staking: generalie finalize_unstake to take a
 contract rather than a pkh

---
 src/proto_alpha/lib_protocol/apply.ml    |  2 +-
 src/proto_alpha/lib_protocol/staking.ml  | 11 +++++------
 src/proto_alpha/lib_protocol/staking.mli | 14 ++++++--------
 3 files changed, 12 insertions(+), 15 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index c0390ff3289d..2dac9dcab3ca 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -367,7 +367,7 @@ let apply_finalize_unstake ~ctxt ~sender ~amount ~destination ~before_operation
   >>?= fun () ->
   let contract = Contract.Implicit sender in
   Contract.allocated ctxt contract >>= fun already_allocated ->
-  Staking.finalize_unstake ctxt sender >>=? fun (ctxt, balance_updates) ->
+  Staking.finalize_unstake ctxt contract >>=? fun (ctxt, balance_updates) ->
   let result =
     Transaction_to_contract_result
       {
diff --git a/src/proto_alpha/lib_protocol/staking.ml b/src/proto_alpha/lib_protocol/staking.ml
index 663c545b1290..e09dfc6ae5de 100644
--- a/src/proto_alpha/lib_protocol/staking.ml
+++ b/src/proto_alpha/lib_protocol/staking.ml
@@ -64,9 +64,8 @@ let perform_finalizable_unstake_transfers ctxt contract finalizable =
     (ctxt, [])
     finalizable
 
-let finalize_unstake_and_check ~check_unfinalizable ctxt pkh =
+let finalize_unstake_and_check ~check_unfinalizable ctxt contract =
   let open Lwt_result_syntax in
-  let contract = Contract.Implicit pkh in
   let* prepared_opt = Unstake_requests.prepare_finalize_unstake ctxt contract in
   match prepared_opt with
   | None -> return (ctxt, [])
@@ -75,9 +74,9 @@ let finalize_unstake_and_check ~check_unfinalizable ctxt pkh =
       let* ctxt = Unstake_requests.update ctxt contract unfinalizable in
       perform_finalizable_unstake_transfers ctxt contract finalizable
 
-let finalize_unstake ctxt pkh =
+let finalize_unstake ctxt contract =
   let check_unfinalizable _unfinalizable = Lwt_result_syntax.return_unit in
-  finalize_unstake_and_check ~check_unfinalizable ctxt pkh
+  finalize_unstake_and_check ~check_unfinalizable ctxt contract
 
 let punish_delegate ctxt delegate level mistake ~rewarded =
   let open Lwt_result_syntax in
@@ -119,8 +118,9 @@ let stake ctxt ~sender ~delegate amount =
           Signature.Public_key_hash.(delegate <> unstake_delegate)
           Cannot_stake_with_unfinalizable_unstake_requests_to_another_delegate
   in
+  let sender_contract = Contract.Implicit sender in
   let* ctxt, finalize_balance_updates =
-    finalize_unstake_and_check ~check_unfinalizable ctxt sender
+    finalize_unstake_and_check ~check_unfinalizable ctxt sender_contract
   in
   let* ctxt, new_pseudotokens =
     Staking_pseudotokens.credit_frozen_deposits_pseudotokens_for_tez_amount
@@ -128,7 +128,6 @@ let stake ctxt ~sender ~delegate amount =
       delegate
       amount
   in
-  let sender_contract = Contract.Implicit sender in
   let* ctxt, stake_balance_updates =
     Token.transfer
       ctxt
diff --git a/src/proto_alpha/lib_protocol/staking.mli b/src/proto_alpha/lib_protocol/staking.mli
index 5d7af413b97d..b5fe07218821 100644
--- a/src/proto_alpha/lib_protocol/staking.mli
+++ b/src/proto_alpha/lib_protocol/staking.mli
@@ -34,19 +34,17 @@ val stake :
   Tez.t ->
   (context * Receipt.balance_updates) tzresult Lwt.t
 
-(** [finalize_unstake ctxt pkh] performs the finalization of all unstake
-    requests from [pkh] that can be finalized.
+(** [finalize_unstake ctxt contract] performs the finalization of all unstake
+    requests from [contract] that can be finalized.
     An unstake request can be finalized if it is old enough, specifically the
     requested amount must not be at stake anymore and must not be slashable
     anymore, i.e. after [preserved_cycles + max_slashing_period] after the
     request.
-    Amounts are transferred from the [pkh]'s delegate (at request time) unstaked
-    frozen deposits to [pkh]'s spendable balance, minus slashing the requested
-    stake undergone in between. *)
+    Amounts are transferred from the [contract]'s delegate (at request time)
+    unstaked frozen deposits to [contract]'s spendable balance, minus slashing
+    the requested stake undergone in between. *)
 val finalize_unstake :
-  context ->
-  public_key_hash ->
-  (context * Receipt.balance_updates) tzresult Lwt.t
+  context -> Contract.t -> (context * Receipt.balance_updates) tzresult Lwt.t
 
 (** [punish_delegate ctxt delegate level mistake ~rewarded] slashes [delegate]
     for a [mistake] at [level] and rewards [rewarded]. *)
-- 
GitLab


From 8363a86ddfd6bfc3144172dfe89741f0850bf7e7 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 7 Jun 2023 20:06:06 +0200
Subject: [PATCH 2/2] Proto: unstake

---
 .../lib_protocol/alpha_context.mli            | 21 +++++
 src/proto_alpha/lib_protocol/apply.ml         | 83 ++++++++++++++++++-
 src/proto_alpha/lib_protocol/staking.ml       | 45 ++++++++++
 src/proto_alpha/lib_protocol/staking.mli      |  9 ++
 .../lib_protocol/staking_pseudotoken_repr.mli |  4 +
 .../staking_pseudotokens_storage.ml           | 67 +++++++++++++--
 .../staking_pseudotokens_storage.mli          | 37 ++++++++-
 src/proto_alpha/lib_protocol/storage.ml       | 15 ++++
 src/proto_alpha/lib_protocol/storage.mli      |  2 +
 .../lib_protocol/unstake_requests_storage.ml  | 17 ++++
 .../lib_protocol/unstake_requests_storage.mli | 13 +++
 11 files changed, 301 insertions(+), 12 deletions(-)

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