From b2eca7fd1e2a9e5644a6ac1695373673e52b01b7 Mon Sep 17 00:00:00 2001
From: Lucas Randazzo <lucas@nomadic-labs.com>
Date: Fri, 9 Jun 2023 16:56:07 +0200
Subject: [PATCH 1/7] Proto/AI: init self pseudotokens for delegate

---
 .../lib_protocol/staking_pseudotokens_storage.ml          | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml
index 20ecf2b68043..4f4d77611322 100644
--- a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml
+++ b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml
@@ -30,12 +30,18 @@ let init_frozen_deposits_pseudotokens_from_frozen_deposits_tez ctxt contract
     Staking_pseudotoken_repr.of_int64_exn
       (Tez_repr.to_mutez frozen_deposits_tez)
   in
-  let+ ctxt =
+  let* ctxt =
     Storage.Contract.Frozen_deposits_pseudotokens.init
       ctxt
       contract
       initial_pseudotokens
   in
+  let+ ctxt =
+    Storage.Contract.Costaking_pseudotokens.init
+      ctxt
+      contract
+      initial_pseudotokens
+  in
   (ctxt, initial_pseudotokens)
 
 let init_frozen_deposits_pseudotokens_from_frozen_deposits_balance ctxt contract
-- 
GitLab


From 822c2fafac300768552c0518e029c0aecc897174 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Fri, 9 Jun 2023 19:30:31 +0200
Subject: [PATCH 2/7] Proto/Pseudotokens: invariant on frozen deposits
 pseudotokens initialization

---
 .../lib_protocol/bootstrap_storage.ml         |  2 +-
 src/proto_alpha/lib_protocol/init_storage.ml  | 10 ++--
 .../staking_pseudotokens_storage.ml           | 58 +++++--------------
 .../staking_pseudotokens_storage.mli          | 24 ++++++--
 4 files changed, 38 insertions(+), 56 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/bootstrap_storage.ml b/src/proto_alpha/lib_protocol/bootstrap_storage.ml
index 2fa101d4d61b..c95d7f027e2d 100644
--- a/src/proto_alpha/lib_protocol/bootstrap_storage.ml
+++ b/src/proto_alpha/lib_protocol/bootstrap_storage.ml
@@ -93,7 +93,7 @@ let init_account (ctxt, balance_updates)
             amount_to_freeze
           >>=? fun (ctxt, balance_updates) ->
           Staking_pseudotokens_storage
-          .init_frozen_deposits_pseudotokens_from_frozen_deposits_balance
+          .init_delegate_pseudotokens_from_frozen_deposits_balance
             ctxt
             contract
           >|=? fun ctxt -> (ctxt, balance_updates))
diff --git a/src/proto_alpha/lib_protocol/init_storage.ml b/src/proto_alpha/lib_protocol/init_storage.ml
index 260d12c87088..d7a81782b198 100644
--- a/src/proto_alpha/lib_protocol/init_storage.ml
+++ b/src/proto_alpha/lib_protocol/init_storage.ml
@@ -151,8 +151,9 @@ let initialize_total_supply_for_o ctxt =
     ctxt
     (Tez_repr.of_mutez_exn 940_000_000_000_000L)
 
-(** Initializes frozen deposits pseudotokens for all existing delegates. *)
-let init_delegates_frozen_deposits_pseudotokens_for_o ctxt =
+(** Initializes frozen deposits pseudotokens and costaking pseudotokens for all
+    existing delegates. *)
+let init_delegates_pseudotokens_for_o ctxt =
   Delegate_storage.fold
     ctxt
     ~order:`Undefined
@@ -161,7 +162,7 @@ let init_delegates_frozen_deposits_pseudotokens_for_o ctxt =
       let open Lwt_result_syntax in
       let*? ctxt in
       Staking_pseudotokens_storage
-      .init_frozen_deposits_pseudotokens_from_frozen_deposits_balance
+      .init_delegate_pseudotokens_from_frozen_deposits_balance
         ctxt
         (Contract_repr.Implicit delegate))
 
@@ -284,8 +285,7 @@ let prepare_first_block _chain_id ctxt ~typecheck_smart_contract
       >>= fun ctxt ->
       migrate_liquidity_baking_ema ctxt >>=? fun ctxt ->
       Adaptive_inflation_storage.init_ema ctxt >>=? fun ctxt ->
-      init_delegates_frozen_deposits_pseudotokens_for_o ctxt >>=? fun ctxt ->
-      return (ctxt, []))
+      init_delegates_pseudotokens_for_o ctxt >>=? fun ctxt -> return (ctxt, []))
   >>=? fun (ctxt, balance_updates) ->
   List.fold_left_es patch_script ctxt Legacy_script_patches.addresses_to_patch
   >>=? fun ctxt ->
diff --git a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml
index 4f4d77611322..88bd2aa8b7d0 100644
--- a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml
+++ b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml
@@ -23,9 +23,11 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-let init_frozen_deposits_pseudotokens_from_frozen_deposits_tez ctxt contract
-    ~frozen_deposits_tez =
+let init_delegate_pseudotokens_from_frozen_deposits_balance ctxt contract =
   let open Lwt_result_syntax in
+  let* {current_amount = frozen_deposits_tez; initial_amount = _} =
+    Frozen_deposits_storage.get ctxt contract
+  in
   let initial_pseudotokens =
     Staking_pseudotoken_repr.of_int64_exn
       (Tez_repr.to_mutez frozen_deposits_tez)
@@ -36,44 +38,10 @@ let init_frozen_deposits_pseudotokens_from_frozen_deposits_tez ctxt contract
       contract
       initial_pseudotokens
   in
-  let+ ctxt =
-    Storage.Contract.Costaking_pseudotokens.init
-      ctxt
-      contract
-      initial_pseudotokens
-  in
-  (ctxt, initial_pseudotokens)
-
-let init_frozen_deposits_pseudotokens_from_frozen_deposits_balance ctxt contract
-    =
-  let open Lwt_result_syntax in
-  let* {current_amount = frozen_deposits_tez; initial_amount = _} =
-    Frozen_deposits_storage.get ctxt contract
-  in
-  let+ ctxt, _pseudotokens =
-    init_frozen_deposits_pseudotokens_from_frozen_deposits_tez
-      ctxt
-      contract
-      ~frozen_deposits_tez
-  in
-  ctxt
-
-(** Avoids a stitching.
-    Initializes contract's pseudotokens so that 1 pseudotoken = 1 mutez. *)
-let get_or_init_frozen_deposits_pseudotokens ctxt contract ~frozen_deposits_tez
-    =
-  let open Lwt_result_syntax in
-  let* frozen_deposits_pseudotokens_opt =
-    Storage.Contract.Frozen_deposits_pseudotokens.find ctxt contract
-  in
-  match frozen_deposits_pseudotokens_opt with
-  | None ->
-      init_frozen_deposits_pseudotokens_from_frozen_deposits_tez
-        ctxt
-        contract
-        ~frozen_deposits_tez
-  | Some frozen_deposits_pseudotokens ->
-      return (ctxt, frozen_deposits_pseudotokens)
+  Storage.Contract.Costaking_pseudotokens.init
+    ctxt
+    contract
+    initial_pseudotokens
 
 let pseudotokens_of ~frozen_deposits_pseudotokens ~frozen_deposits_tez
     ~tez_amount =
@@ -147,19 +115,19 @@ let update_frozen_deposits_pseudotokens ~f ctxt delegate =
   let* {current_amount = frozen_deposits_tez; initial_amount = _} =
     Frozen_deposits_storage.get ctxt contract
   in
-  let* ctxt, frozen_deposits_pseudotokens =
-    get_or_init_frozen_deposits_pseudotokens ctxt contract ~frozen_deposits_tez
+  let* frozen_deposits_pseudotokens =
+    get_frozen_deposits_pseudotokens ctxt contract ~frozen_deposits_tez
   in
   let*? new_frozen_deposits_pseudotokens, x =
     f ~frozen_deposits_pseudotokens ~frozen_deposits_tez
   in
-  let+ ctxt =
-    Storage.Contract.Frozen_deposits_pseudotokens.update
+  let*! ctxt =
+    Storage.Contract.Frozen_deposits_pseudotokens.add
       ctxt
       contract
       new_frozen_deposits_pseudotokens
   in
-  (ctxt, x)
+  return (ctxt, x)
 
 let credit_frozen_deposits_pseudotokens_for_tez_amount ctxt delegate tez_amount
     =
diff --git a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli
index d272ba9b10c7..1d0d853d5c33 100644
--- a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli
+++ b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli
@@ -27,12 +27,26 @@
     {!Storage.Contract.Frozen_deposits_pseudotokens} and
     {!Storage.Contract.Costaking_pseudotokens} tables. *)
 
-(** [init_frozen_deposits_pseudotokens_from_frozen_deposits_balance ctxt contract]
-    initializes [contract]'s frozen deposits pseudotokens usings [contract]'s
-    current frozen deposits tez.
+(* Invariant: all delegates with non-zero frozen deposits tez have their
+   frozen deposits pseudotokens initialized.
+
+   It is ensured by:
+     - [init_delegate_pseudotokens_from_frozen_deposits_balance] called
+       for bootstrap accounts and at stitching to protocol O;
+     - stake correctly handles missing pseudotokens and offers a 1:1
+       tez/pseudotoken rate fallback;
+     - frozen deposits can be initialized only by:
+       - stake,
+       - rewards, but rewards can be paid only if a delegate has a non-zero
+         stake, hence has staked before. *)
+
+(** [init_delegate_pseudotokens_from_frozen_deposits_balance ctxt contract]
+    initializes [contract]'s frozen deposits pseudotokens and costaking
+    pseudotokens usings [contract]'s current frozen deposits tez.
+
     This function must be called whenever a contract's frozen deposits tez are
-    initialized. *)
-val init_frozen_deposits_pseudotokens_from_frozen_deposits_balance :
+    initialized (see invariant above). *)
+val init_delegate_pseudotokens_from_frozen_deposits_balance :
   Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t
 
 (** [frozen_deposits_pseudotokens_for_tez_amount ctxt delegate tez_amount]
-- 
GitLab


From f9333ebfedb315915f6ee608ddbc27375c1945b0 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 8 Jun 2023 12:42:17 +0200
Subject: [PATCH 3/7] Proto/Tez: mul_ratio

---
 src/proto_alpha/lib_protocol/tez_repr.ml  | 10 ++++++++++
 src/proto_alpha/lib_protocol/tez_repr.mli |  4 ++++
 2 files changed, 14 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/tez_repr.ml b/src/proto_alpha/lib_protocol/tez_repr.ml
index cb766c84258e..16de8176f24c 100644
--- a/src/proto_alpha/lib_protocol/tez_repr.ml
+++ b/src/proto_alpha/lib_protocol/tez_repr.ml
@@ -167,6 +167,16 @@ let div_exn t d =
   | Ok v -> v
   | Error _ -> invalid_arg "div_exn"
 
+let mul_ratio tez ~num ~den =
+  let (Tez_tag t) = tez in
+  if num < 0L then error (Negative_multiplicator (tez, num))
+  else if den <= 0L then error (Invalid_divisor (tez, den))
+  else if num = 0L then ok zero
+  else
+    let z = Z.(div (mul (of_int64 t) (of_int64 num)) (of_int64 den)) in
+    if Z.fits_int64 z then ok (Tez_tag (Z.to_int64 z))
+    else error (Multiplication_overflow (tez, num))
+
 let of_mutez t = if t < 0L then None else Some (Tez_tag t)
 
 let of_mutez_exn x =
diff --git a/src/proto_alpha/lib_protocol/tez_repr.mli b/src/proto_alpha/lib_protocol/tez_repr.mli
index d4c3d39679bc..bf829dd81592 100644
--- a/src/proto_alpha/lib_protocol/tez_repr.mli
+++ b/src/proto_alpha/lib_protocol/tez_repr.mli
@@ -70,6 +70,10 @@ val div2 : t -> t
 (** [div2_sub tez] returns [(⌊tez / 2⌋, tez - ⌊tez / 2⌋)]. *)
 val div2_sub : t -> t * t
 
+(** [mul_ratio tez ~num ~den] returns [tez * num / den] without failing
+    when [tez * num] overflows. *)
+val mul_ratio : t -> num:int64 -> den:int64 -> t tzresult
+
 val to_mutez : t -> int64
 
 (** [of_mutez n] (micro tez) is None if n is negative *)
-- 
GitLab


From d42defa96c40533e013c50912814c3bc5c5d995a Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 8 Jun 2023 12:14:24 +0200
Subject: [PATCH 4/7] Proto/Staking_pseudotokens_storage:
 tez_of_frozen_deposits_pseudotokens

---
 .../staking_pseudotokens_storage.ml           | 22 +++++++++++++++++++
 .../staking_pseudotokens_storage.mli          |  9 ++++++++
 2 files changed, 31 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml
index 88bd2aa8b7d0..41f6ae457f39 100644
--- a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml
+++ b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.ml
@@ -43,6 +43,17 @@ let init_delegate_pseudotokens_from_frozen_deposits_balance ctxt contract =
     contract
     initial_pseudotokens
 
+let get_frozen_deposits_pseudotokens ctxt contract ~frozen_deposits_tez =
+  let open Lwt_result_syntax in
+  let+ frozen_deposits_pseudotokens_opt =
+    Storage.Contract.Frozen_deposits_pseudotokens.find ctxt contract
+  in
+  match frozen_deposits_pseudotokens_opt with
+  | None ->
+      Staking_pseudotoken_repr.of_int64_exn
+        (Tez_repr.to_mutez frozen_deposits_tez)
+  | Some frozen_deposits_pseudotokens -> frozen_deposits_pseudotokens
+
 let pseudotokens_of ~frozen_deposits_pseudotokens ~frozen_deposits_tez
     ~tez_amount =
   if Tez_repr.(frozen_deposits_tez = zero) then (
@@ -89,6 +100,17 @@ let tez_of ~frozen_deposits_pseudotokens ~frozen_deposits_tez
     in
     Tez_repr.of_mutez_exn (Z.to_int64 res_z)
 
+let tez_of_frozen_deposits_pseudotokens ctxt delegate pseudotoken_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 =
+    get_frozen_deposits_pseudotokens ctxt contract ~frozen_deposits_tez
+  in
+  tez_of ~frozen_deposits_pseudotokens ~frozen_deposits_tez ~pseudotoken_amount
+
 let frozen_deposits_pseudotokens_for_tez_amount ctxt delegate tez_amount =
   let open Lwt_result_syntax in
   let contract = Contract_repr.Implicit delegate in
diff --git a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli
index 1d0d853d5c33..d30075848162 100644
--- a/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli
+++ b/src/proto_alpha/lib_protocol/staking_pseudotokens_storage.mli
@@ -60,6 +60,15 @@ val frozen_deposits_pseudotokens_for_tez_amount :
   Tez_repr.t ->
   Staking_pseudotoken_repr.t tzresult Lwt.t
 
+(** [tez_of_frozen_deposits_pseudotokens ctxt delegate p_amount] returns the
+    number of tez [p_amount] pseudotokens are currently worth in [delegate]'s
+    frozen deposits. *)
+val tez_of_frozen_deposits_pseudotokens :
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Staking_pseudotoken_repr.t ->
+  Tez_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
-- 
GitLab


From 458ad3811d4f7d374779c032a01e5a6ae2723aa2 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 8 Jun 2023 12:52:01 +0200
Subject: [PATCH 5/7] Proto/Delegate_sampler: use staking_over_baking_limit

Fix #5819
---
 .../lib_protocol/delegate_sampler.ml          | 46 ++++++++++++++++++-
 1 file changed, 45 insertions(+), 1 deletion(-)

diff --git a/src/proto_alpha/lib_protocol/delegate_sampler.ml b/src/proto_alpha/lib_protocol/delegate_sampler.ml
index 461ac0ced35d..800a64f84b01 100644
--- a/src/proto_alpha/lib_protocol/delegate_sampler.ml
+++ b/src/proto_alpha/lib_protocol/delegate_sampler.ml
@@ -156,15 +156,59 @@ let get_stakes_for_selected_index ctxt index =
   let delegation_over_baking_limit =
     Int64.of_int (Constants_storage.delegation_over_baking_limit ctxt)
   in
+  let global_staking_over_baking_limit_millionth =
+    Int64.(
+      mul
+        1_000_000L
+        (of_int
+           (Constants_storage.adaptive_inflation_staking_over_baking_limit ctxt)))
+  in
   Stake_storage.fold_snapshot
     ctxt
     ~index
     ~f:(fun (delegate, staking_balance) (acc, total_stake) ->
       let delegate_contract = Contract_repr.Implicit delegate in
+      let* delegate_own_pseudotokens =
+        Staking_pseudotokens_storage.costaking_pseudotokens_balance
+          ctxt
+          delegate_contract
+      in
+      let* delegate_own_frozen_deposits =
+        Staking_pseudotokens_storage.tez_of_frozen_deposits_pseudotokens
+          ctxt
+          delegate
+          delegate_own_pseudotokens
+      in
+      let* {staking_over_baking_limit; _} =
+        Delegate_staking_parameters.of_delegate ctxt delegate
+      in
+      let staking_over_baking_limit_millionth =
+        let delegate_staking_over_baking_limit_millionth =
+          Int64.of_int32 staking_over_baking_limit
+        in
+        Compare.Int64.min
+          global_staking_over_baking_limit_millionth
+          delegate_staking_over_baking_limit_millionth
+      in
+      let staking_over_baking_limit_plus_1_millionth =
+        Int64.add 1_000_000L staking_over_baking_limit_millionth
+      in
       let open Tez_repr in
-      let* {current_amount = frozen; initial_amount = _} =
+      let* {current_amount = all_frozen_deposits; initial_amount = _} =
         Frozen_deposits_storage.get ctxt delegate_contract
       in
+      let frozen =
+        match
+          mul_ratio
+            delegate_own_frozen_deposits
+            ~num:staking_over_baking_limit_plus_1_millionth
+            ~den:1_000_000L
+        with
+        | Ok max_allowed_frozen_deposits ->
+            min all_frozen_deposits max_allowed_frozen_deposits
+            (* Over-co-staked frozen deposits counts towards delegated stake. *)
+        | Error _max_allowed_frozen_deposits_overflows -> all_frozen_deposits
+      in
       (* This subtraction may result in a negative value if tez were frozen
          after the snapshot. This is fine, they are then taken into account as
          frozen stake rather than delegated. *)
-- 
GitLab


From 98667e9c6190b498441699d038f37515f2ff21f9 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Fri, 9 Jun 2023 20:07:31 +0200
Subject: [PATCH 6/7] Proto/Apply: do not request a full unstake when delegate
 re-activates

---
 src/proto_alpha/lib_protocol/apply.ml | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 2831cc9d7055..f17100492235 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -317,10 +317,19 @@ let update_script_storage_and_ticket_balances ctxt ~self_contract storage
     ~ticket_diffs
     operations
 
-let apply_delegation ~ctxt ~sender ~delegate ~before_operation =
+let apply_delegation ~ctxt ~(sender : Contract.t) ~delegate ~before_operation =
   let open Lwt_result_syntax in
   let* ctxt, balance_updates =
-    Staking.request_full_unstake ctxt ~sender_contract:sender
+    match sender with
+    | Originated _ ->
+        (* Originated contracts have no costake (yet). *)
+        return (ctxt, [])
+    | Implicit sender_pkh ->
+        let* sender_is_delegate = Contract.is_delegate ctxt sender_pkh in
+        if sender_is_delegate then
+          (* This is just a re-activation, do not unstake. *)
+          Staking.finalize_unstake ctxt sender
+        else Staking.request_full_unstake ctxt ~sender_contract:sender
   in
   let+ ctxt = Contract.Delegate.set ctxt sender delegate in
   (ctxt, Gas.consumed ~since:before_operation ~until:ctxt, balance_updates, [])
-- 
GitLab


From 528b66a090d13b54e559876b847b851cedb3b1fc Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 8 Jun 2023 12:52:01 +0200
Subject: [PATCH 7/7] Proto/Delegate_sampler: use staking_over_baking_limit

Fix #5819
---
 src/proto_alpha/lib_protocol/delegate_sampler.ml             | 2 +-
 src/proto_alpha/lib_protocol/delegate_staking_parameters.ml  | 5 +++++
 src/proto_alpha/lib_protocol/delegate_staking_parameters.mli | 5 +++++
 3 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/proto_alpha/lib_protocol/delegate_sampler.ml b/src/proto_alpha/lib_protocol/delegate_sampler.ml
index 800a64f84b01..3e5fb4b75b1d 100644
--- a/src/proto_alpha/lib_protocol/delegate_sampler.ml
+++ b/src/proto_alpha/lib_protocol/delegate_sampler.ml
@@ -216,7 +216,7 @@ let get_stakes_for_selected_index ctxt index =
         sub_opt staking_balance frozen |> Option.value ~default:zero
       in
       let delegated =
-        match frozen *? delegation_over_baking_limit with
+        match delegate_own_frozen_deposits *? delegation_over_baking_limit with
         | Ok max_allowed_delegated ->
             min max_allowed_delegated available_delegated
         | Error _max_allowed_delegated_overflows -> available_delegated
diff --git a/src/proto_alpha/lib_protocol/delegate_staking_parameters.ml b/src/proto_alpha/lib_protocol/delegate_staking_parameters.ml
index 2a933b5814dd..f5db49c5c3b9 100644
--- a/src/proto_alpha/lib_protocol/delegate_staking_parameters.ml
+++ b/src/proto_alpha/lib_protocol/delegate_staking_parameters.ml
@@ -34,6 +34,11 @@ let of_delegate ctxt delegate =
   | None -> return Staking_parameters_repr.default
   | Some t -> return t
 
+let find ctxt delegate =
+  Storage.Contract.Staking_parameters.find
+    ctxt
+    (Contract_repr.Implicit delegate)
+
 let raw_pending_updates ctxt delegate =
   Storage.Contract.Pending_staking_parameters.bindings
     (ctxt, Contract_repr.Implicit delegate)
diff --git a/src/proto_alpha/lib_protocol/delegate_staking_parameters.mli b/src/proto_alpha/lib_protocol/delegate_staking_parameters.mli
index 8e08af9ff6b1..f82931051299 100644
--- a/src/proto_alpha/lib_protocol/delegate_staking_parameters.mli
+++ b/src/proto_alpha/lib_protocol/delegate_staking_parameters.mli
@@ -28,6 +28,11 @@ val of_delegate :
   Signature.Public_key_hash.t ->
   Staking_parameters_repr.t tzresult Lwt.t
 
+val find :
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Staking_parameters_repr.t option tzresult Lwt.t
+
 val of_delegate_for_cycle :
   Raw_context.t ->
   Signature.Public_key_hash.t ->
-- 
GitLab