From 8fcd1aaee6e0739ed9659ea66b7f17d4ea5b4fdc Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Fri, 2 Jun 2023 22:08:23 +0200
Subject: [PATCH 01/10] Proto: move most of punish_delegate from Apply to
 Staking

---
 src/proto_alpha/lib_protocol/apply.ml    | 22 +++-------------------
 src/proto_alpha/lib_protocol/staking.ml  | 20 ++++++++++++++++++++
 src/proto_alpha/lib_protocol/staking.mli | 10 ++++++++++
 3 files changed, 33 insertions(+), 19 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index e73bc5ddf7bb..6fb2d793b294 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1942,25 +1942,9 @@ let apply_manager_operations ctxt ~payload_producer chain_id ~mempool_mode
   return (ctxt, contents_result_list)
 
 let punish_delegate ctxt delegate level mistake mk_result ~payload_producer =
-  let punish =
-    match mistake with
-    | `Double_baking -> Delegate.punish_double_baking
-    | `Double_endorsing -> Delegate.punish_double_endorsing
-  in
-  punish ctxt delegate level >>=? fun (ctxt, {reward; amount_to_burn}) ->
-  Token.transfer
-    ctxt
-    (`Frozen_deposits delegate)
-    `Double_signing_punishments
-    amount_to_burn
-  >>=? fun (ctxt, punish_balance_updates) ->
-  Token.transfer
-    ctxt
-    (`Frozen_deposits delegate)
-    (`Contract (Contract.Implicit payload_producer.Consensus_key.delegate))
-    reward
-  >|=? fun (ctxt, reward_balance_updates) ->
-  let balance_updates = reward_balance_updates @ punish_balance_updates in
+  let rewarded = Contract.Implicit payload_producer.Consensus_key.delegate in
+  Staking.punish_delegate ctxt delegate level mistake ~rewarded
+  >|=? fun (ctxt, balance_updates) ->
   (ctxt, Single_result (mk_result balance_updates))
 
 let punish_double_endorsement_or_preendorsement (type kind) ctxt
diff --git a/src/proto_alpha/lib_protocol/staking.ml b/src/proto_alpha/lib_protocol/staking.ml
index b87e9afe5609..bc626ba1775a 100644
--- a/src/proto_alpha/lib_protocol/staking.ml
+++ b/src/proto_alpha/lib_protocol/staking.ml
@@ -45,3 +45,23 @@ let finalize_unstake ctxt pkh =
       (ctxt, new_balance_updates @ balance_updates))
     (ctxt, [])
     finalizable
+
+let punish_delegate ctxt delegate level mistake ~rewarded =
+  let open Lwt_result_syntax in
+  let punish =
+    match mistake with
+    | `Double_baking -> Delegate.punish_double_baking
+    | `Double_endorsing -> Delegate.punish_double_endorsing
+  in
+  let* ctxt, {reward; amount_to_burn} = punish ctxt delegate level in
+  let* ctxt, punish_balance_updates =
+    Token.transfer
+      ctxt
+      (`Frozen_deposits delegate)
+      `Double_signing_punishments
+      amount_to_burn
+  in
+  let+ ctxt, reward_balance_updates =
+    Token.transfer ctxt (`Frozen_deposits delegate) (`Contract rewarded) reward
+  in
+  (ctxt, reward_balance_updates @ punish_balance_updates)
diff --git a/src/proto_alpha/lib_protocol/staking.mli b/src/proto_alpha/lib_protocol/staking.mli
index 4be8b752f8e2..bf9b986201c0 100644
--- a/src/proto_alpha/lib_protocol/staking.mli
+++ b/src/proto_alpha/lib_protocol/staking.mli
@@ -38,3 +38,13 @@ val finalize_unstake :
   context ->
   public_key_hash ->
   (context * Receipt.balance_updates) tzresult Lwt.t
+
+(** [punish_delegate ctxt delegate level mistake ~rewarded] slashes [delegate]
+    for a [mistake] at [level] and rewards [rewarded]. *)
+val punish_delegate :
+  context ->
+  public_key_hash ->
+  Level.t ->
+  [`Double_baking | `Double_endorsing] ->
+  rewarded:Contract.t ->
+  (context * Receipt.balance_updates) tzresult Lwt.t
-- 
GitLab


From 84e5a1c1629c8fa0549c045f71c82385c8a63fd7 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Fri, 2 Jun 2023 22:19:13 +0200
Subject: [PATCH 02/10] Proto/Slashing: split type punishing_amounts (part 1)

---
 src/proto_alpha/lib_protocol/alpha_context.mli              | 4 +++-
 .../lib_protocol/delegate_slashed_deposits_storage.ml       | 4 +++-
 .../lib_protocol/delegate_slashed_deposits_storage.mli      | 6 +++++-
 3 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index b3e21f213771..efd820f6f29f 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -2138,7 +2138,9 @@ module Delegate : sig
   val already_slashed_for_double_baking :
     context -> public_key_hash -> Level.t -> bool tzresult Lwt.t
 
-  type punishing_amounts = {reward : Tez.t; amount_to_burn : Tez.t}
+  type reward_and_burn = {reward : Tez.t; amount_to_burn : Tez.t}
+
+  type punishing_amounts = reward_and_burn
 
   val punish_double_endorsing :
     context ->
diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
index e0bce8b3a522..208cdae1a872 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -37,7 +37,9 @@ let already_slashed_for_double_baking ctxt delegate (level : Level_repr.t) =
   | None -> return_false
   | Some slashed -> return slashed.for_double_baking
 
-type punishing_amounts = {reward : Tez_repr.t; amount_to_burn : Tez_repr.t}
+type reward_and_burn = {reward : Tez_repr.t; amount_to_burn : Tez_repr.t}
+
+type punishing_amounts = reward_and_burn
 
 (** [punish_double_signing ~get ~set ~get_percentage ctxt delegate level] record
     in the context that the given [delegate] has now been slashed for the
diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
index 5275afdfa55e..ec557dbe4e90 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
@@ -46,9 +46,13 @@ val already_slashed_for_double_endorsing :
   Level_repr.t ->
   bool tzresult Lwt.t
 
+(** The [reward_and_burn] type embeds amounts involved when slashing a
+    delegate for double endorsing or double baking. *)
+type reward_and_burn = {reward : Tez_repr.t; amount_to_burn : Tez_repr.t}
+
 (** The [punishing_amounts] type embeds amounts involved when slashing a
     delegate for double endorsing or double baking. *)
-type punishing_amounts = {reward : Tez_repr.t; amount_to_burn : Tez_repr.t}
+type punishing_amounts = reward_and_burn
 
 (** Record in the context that the given delegate has now been slashed
     for double endorsing for the given level and return the amounts to
-- 
GitLab


From 514337aabc5a245c4b713ca6b80eb4a861172fe1 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Fri, 2 Jun 2023 22:21:38 +0200
Subject: [PATCH 03/10] Proto/Slashing: split type punishing_amounts (part 2)

---
 src/proto_alpha/lib_protocol/alpha_context.mli             | 5 ++++-
 .../lib_protocol/delegate_slashed_deposits_storage.ml      | 7 +++++--
 .../lib_protocol/delegate_slashed_deposits_storage.mli     | 5 ++++-
 src/proto_alpha/lib_protocol/staking.ml                    | 4 +++-
 4 files changed, 16 insertions(+), 5 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index efd820f6f29f..7fc26862eea3 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -2140,7 +2140,10 @@ module Delegate : sig
 
   type reward_and_burn = {reward : Tez.t; amount_to_burn : Tez.t}
 
-  type punishing_amounts = reward_and_burn
+  type punishing_amounts = {
+    staked : reward_and_burn;
+    unstaked : (Cycle.t * reward_and_burn) list;
+  }
 
   val punish_double_endorsing :
     context ->
diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
index 208cdae1a872..a8e8c5e13af5 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -39,7 +39,10 @@ let already_slashed_for_double_baking ctxt delegate (level : Level_repr.t) =
 
 type reward_and_burn = {reward : Tez_repr.t; amount_to_burn : Tez_repr.t}
 
-type punishing_amounts = reward_and_burn
+type punishing_amounts = {
+  staked : reward_and_burn;
+  unstaked : (Cycle_repr.t * reward_and_burn) list;
+}
 
 (** [punish_double_signing ~get ~set ~get_percentage ctxt delegate level] record
     in the context that the given [delegate] has now been slashed for the
@@ -108,7 +111,7 @@ let punish_double_signing ~get ~set ~get_percentage ctxt delegate
   let*! ctxt =
     Storage.Contract.Slashed_deposits.add ctxt delegate_contract slash_history
   in
-  return (ctxt, {reward; amount_to_burn})
+  return (ctxt, {staked = {reward; amount_to_burn}; unstaked = []})
 
 let punish_double_endorsing =
   let get Storage.{for_double_endorsing; _} = for_double_endorsing in
diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
index ec557dbe4e90..9f2166a871dc 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
@@ -52,7 +52,10 @@ type reward_and_burn = {reward : Tez_repr.t; amount_to_burn : Tez_repr.t}
 
 (** The [punishing_amounts] type embeds amounts involved when slashing a
     delegate for double endorsing or double baking. *)
-type punishing_amounts = reward_and_burn
+type punishing_amounts = {
+  staked : reward_and_burn;
+  unstaked : (Cycle_repr.t * reward_and_burn) list;
+}
 
 (** Record in the context that the given delegate has now been slashed
     for double endorsing for the given level and return the amounts to
diff --git a/src/proto_alpha/lib_protocol/staking.ml b/src/proto_alpha/lib_protocol/staking.ml
index bc626ba1775a..8d68338c8f96 100644
--- a/src/proto_alpha/lib_protocol/staking.ml
+++ b/src/proto_alpha/lib_protocol/staking.ml
@@ -53,7 +53,9 @@ let punish_delegate ctxt delegate level mistake ~rewarded =
     | `Double_baking -> Delegate.punish_double_baking
     | `Double_endorsing -> Delegate.punish_double_endorsing
   in
-  let* ctxt, {reward; amount_to_burn} = punish ctxt delegate level in
+  let* ctxt, {staked = {reward; amount_to_burn}; unstaked = _} =
+    punish ctxt delegate level
+  in
   let* ctxt, punish_balance_updates =
     Token.transfer
       ctxt
-- 
GitLab


From 9514163822a0eeaee3ace951be06507f6bfbeaab Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Fri, 2 Jun 2023 22:30:55 +0200
Subject: [PATCH 04/10] Proto/Staking: punish_delegate can burn/reward from
 unstaked frozen deposits

---
 src/proto_alpha/lib_protocol/staking.ml | 23 +++++++++++++++--------
 1 file changed, 15 insertions(+), 8 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/staking.ml b/src/proto_alpha/lib_protocol/staking.ml
index 8d68338c8f96..9ed8e30864e9 100644
--- a/src/proto_alpha/lib_protocol/staking.ml
+++ b/src/proto_alpha/lib_protocol/staking.ml
@@ -53,17 +53,24 @@ let punish_delegate ctxt delegate level mistake ~rewarded =
     | `Double_baking -> Delegate.punish_double_baking
     | `Double_endorsing -> Delegate.punish_double_endorsing
   in
-  let* ctxt, {staked = {reward; amount_to_burn}; unstaked = _} =
-    punish ctxt delegate level
+  let* ctxt, {staked; unstaked} = punish ctxt delegate level in
+  let init_to_burn_to_reward =
+    let Delegate.{amount_to_burn; reward} = staked in
+    let giver = `Frozen_deposits delegate in
+    ([(giver, amount_to_burn)], [(giver, reward)])
+  in
+  let to_burn, to_reward =
+    List.fold_left
+      (fun (to_burn, to_reward) (cycle, Delegate.{amount_to_burn; reward}) ->
+        let giver = `Unstaked_frozen_deposits (delegate, cycle) in
+        ((giver, amount_to_burn) :: to_burn, (giver, reward) :: to_reward))
+      init_to_burn_to_reward
+      unstaked
   in
   let* ctxt, punish_balance_updates =
-    Token.transfer
-      ctxt
-      (`Frozen_deposits delegate)
-      `Double_signing_punishments
-      amount_to_burn
+    Token.transfer_n ctxt to_burn `Double_signing_punishments
   in
   let+ ctxt, reward_balance_updates =
-    Token.transfer ctxt (`Frozen_deposits delegate) (`Contract rewarded) reward
+    Token.transfer_n ctxt to_reward (`Contract rewarded)
   in
   (ctxt, reward_balance_updates @ punish_balance_updates)
-- 
GitLab


From efe48c66209bce376cc9970836dee28702e9299a Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Fri, 2 Jun 2023 22:37:32 +0200
Subject: [PATCH 05/10] Proto/Slashing: minor rewrite (1)

---
 .../delegate_slashed_deposits_storage.ml           | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
index a8e8c5e13af5..52e9c20812af 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -66,8 +66,14 @@ let punish_double_signing ~get ~set ~get_percentage ctxt delegate
   assert (Compare.Bool.(get slashed = false)) ;
   let updated_slashed = set slashed in
   let delegate_contract = Contract_repr.Implicit delegate in
-  let* frozen_deposits = Frozen_deposits_storage.get ctxt delegate_contract in
   let slashing_percentage = get_percentage ctxt in
+  let staking_over_baking_limit =
+    Constants_storage.adaptive_inflation_staking_over_baking_limit ctxt
+  in
+  let staking_over_baking_limit_plus_two =
+    Int64.add (Int64.of_int staking_over_baking_limit) 2L
+  in
+  let* frozen_deposits = Frozen_deposits_storage.get ctxt delegate_contract in
   let punish_value =
     Tez_repr.(
       div_exn (mul_exn frozen_deposits.initial_amount slashing_percentage) 100)
@@ -75,12 +81,6 @@ let punish_double_signing ~get ~set ~get_percentage ctxt delegate
   let punishing_amount =
     Tez_repr.(min frozen_deposits.current_amount punish_value)
   in
-  let staking_over_baking_limit =
-    Constants_storage.adaptive_inflation_staking_over_baking_limit ctxt
-  in
-  let staking_over_baking_limit_plus_two =
-    Int64.add (Int64.of_int staking_over_baking_limit) 2L
-  in
   let*? reward =
     Tez_repr.(punishing_amount /? staking_over_baking_limit_plus_two)
   in
-- 
GitLab


From 933dd390c394b4929e7436a665bbcdc9b6e502cf Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Fri, 2 Jun 2023 22:43:37 +0200
Subject: [PATCH 06/10] Proto/Slashing: minor rewrite (2)

---
 .../lib_protocol/delegate_slashed_deposits_storage.ml    | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
index 52e9c20812af..e875a77d47dc 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -78,16 +78,15 @@ let punish_double_signing ~get ~set ~get_percentage ctxt delegate
     Tez_repr.(
       div_exn (mul_exn frozen_deposits.initial_amount slashing_percentage) 100)
   in
-  let punishing_amount =
-    Tez_repr.(min frozen_deposits.current_amount punish_value)
+  let should_forbid, punishing_amount =
+    if Tez_repr.(punish_value >= frozen_deposits.current_amount) then
+      (true, frozen_deposits.current_amount)
+    else (false, punish_value)
   in
   let*? reward =
     Tez_repr.(punishing_amount /? staking_over_baking_limit_plus_two)
   in
   let*? amount_to_burn = Tez_repr.(punishing_amount -? reward) in
-  let should_forbid =
-    Tez_repr.(punishing_amount = frozen_deposits.current_amount)
-  in
   let*! ctxt =
     if should_forbid then Delegate_storage.forbid_delegate ctxt delegate
     else Lwt.return ctxt
-- 
GitLab


From 2352ad4681496f72700c8657796d0cdc028fedf5 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Fri, 2 Jun 2023 22:45:42 +0200
Subject: [PATCH 07/10] Proto/Slashing: minor rewrite (3)

---
 .../delegate_slashed_deposits_storage.ml      | 31 +++++++++++--------
 1 file changed, 18 insertions(+), 13 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
index e875a77d47dc..1539793b8fab 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -74,19 +74,24 @@ let punish_double_signing ~get ~set ~get_percentage ctxt delegate
     Int64.add (Int64.of_int staking_over_baking_limit) 2L
   in
   let* frozen_deposits = Frozen_deposits_storage.get ctxt delegate_contract in
-  let punish_value =
-    Tez_repr.(
-      div_exn (mul_exn frozen_deposits.initial_amount slashing_percentage) 100)
+  let compute_reward_and_burn (frozen_deposits : Deposits_repr.t) =
+    let open Result_syntax in
+    let punish_value =
+      Tez_repr.(
+        div_exn (mul_exn frozen_deposits.initial_amount slashing_percentage) 100)
+    in
+    let should_forbid, punishing_amount =
+      if Tez_repr.(punish_value >= frozen_deposits.current_amount) then
+        (true, frozen_deposits.current_amount)
+      else (false, punish_value)
+    in
+    let* reward =
+      Tez_repr.(punishing_amount /? staking_over_baking_limit_plus_two)
+    in
+    let+ amount_to_burn = Tez_repr.(punishing_amount -? reward) in
+    (should_forbid, {reward; amount_to_burn})
   in
-  let should_forbid, punishing_amount =
-    if Tez_repr.(punish_value >= frozen_deposits.current_amount) then
-      (true, frozen_deposits.current_amount)
-    else (false, punish_value)
-  in
-  let*? reward =
-    Tez_repr.(punishing_amount /? staking_over_baking_limit_plus_two)
-  in
-  let*? amount_to_burn = Tez_repr.(punishing_amount -? reward) in
+  let*? should_forbid, staked = compute_reward_and_burn frozen_deposits in
   let*! ctxt =
     if should_forbid then Delegate_storage.forbid_delegate ctxt delegate
     else Lwt.return ctxt
@@ -110,7 +115,7 @@ let punish_double_signing ~get ~set ~get_percentage ctxt delegate
   let*! ctxt =
     Storage.Contract.Slashed_deposits.add ctxt delegate_contract slash_history
   in
-  return (ctxt, {staked = {reward; amount_to_burn}; unstaked = []})
+  return (ctxt, {staked; unstaked = []})
 
 let punish_double_endorsing =
   let get Storage.{for_double_endorsing; _} = for_double_endorsing in
-- 
GitLab


From 34a9b9a478219f11eecfd246ffb97e2fe0dd513f Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Fri, 2 Jun 2023 22:46:17 +0200
Subject: [PATCH 08/10] Proto/Slashing: minor rewrite (4)

---
 .../lib_protocol/delegate_slashed_deposits_storage.ml           | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
index 1539793b8fab..347e1d3c533d 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -73,7 +73,6 @@ let punish_double_signing ~get ~set ~get_percentage ctxt delegate
   let staking_over_baking_limit_plus_two =
     Int64.add (Int64.of_int staking_over_baking_limit) 2L
   in
-  let* frozen_deposits = Frozen_deposits_storage.get ctxt delegate_contract in
   let compute_reward_and_burn (frozen_deposits : Deposits_repr.t) =
     let open Result_syntax in
     let punish_value =
@@ -91,6 +90,7 @@ let punish_double_signing ~get ~set ~get_percentage ctxt delegate
     let+ amount_to_burn = Tez_repr.(punishing_amount -? reward) in
     (should_forbid, {reward; amount_to_burn})
   in
+  let* frozen_deposits = Frozen_deposits_storage.get ctxt delegate_contract in
   let*? should_forbid, staked = compute_reward_and_burn frozen_deposits in
   let*! ctxt =
     if should_forbid then Delegate_storage.forbid_delegate ctxt delegate
-- 
GitLab


From 476467f45c0310f5de2b7aa121059c5d25504570 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Fri, 2 Jun 2023 23:48:52 +0200
Subject: [PATCH 09/10] Proto/Unstaked_frozen_deposits_storage: get

---
 .../lib_protocol/unstaked_frozen_deposits_storage.ml     | 9 ++++++---
 .../lib_protocol/unstaked_frozen_deposits_storage.mli    | 8 ++++++++
 2 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.ml b/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.ml
index 5248e8d70139..388fd6e443d8 100644
--- a/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.ml
@@ -58,11 +58,14 @@ let normalized_cycle ctxt ~cycle =
   | None -> cycle
   | Some unslashable_cycle -> Cycle_repr.max cycle unslashable_cycle
 
-let balance ctxt delegate cycle =
-  let open Lwt_result_syntax in
+let get ctxt delegate cycle =
   let contract = Contract_repr.Implicit delegate in
   let normalized_cycle = normalized_cycle ctxt ~cycle in
-  let+ frozen_deposits = Internal.get ctxt contract ~normalized_cycle in
+  Internal.get ctxt contract ~normalized_cycle
+
+let balance ctxt delegate cycle =
+  let open Lwt_result_syntax in
+  let+ frozen_deposits = get ctxt delegate cycle in
   frozen_deposits.current_amount
 
 let credit_only_call_from_token ctxt delegate cycle amount =
diff --git a/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.mli b/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.mli
index 62ae2c3677c9..888f046686bf 100644
--- a/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.mli
+++ b/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.mli
@@ -38,6 +38,14 @@ val balance :
   Cycle_repr.t ->
   Tez_repr.t tzresult Lwt.t
 
+(** [get] acts like [balance] but returns both the initial amount and the
+    current amount. *)
+val get :
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Cycle_repr.t ->
+  Deposits_repr.t tzresult Lwt.t
+
 (** [credit_only_call_from_token ctxt delegate cycle amount] credits the
     unstaked frozen deposits for [delegate] at [cycle] by [amount].
     If [cycle] is an unslashable cycle, the credited cycle is the last
-- 
GitLab


From d3c85aa397ad9bdfc5576c46e521a582243652db Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Fri, 2 Jun 2023 22:56:42 +0200
Subject: [PATCH 10/10] Proto/Slashing: also slash slashable unstaked frozen
 deposits

---
 .../delegate_slashed_deposits_storage.ml      | 22 ++++++++++++++++++-
 1 file changed, 21 insertions(+), 1 deletion(-)

diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
index 347e1d3c533d..daabd57deb90 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -67,6 +67,7 @@ let punish_double_signing ~get ~set ~get_percentage ctxt delegate
   let updated_slashed = set slashed in
   let delegate_contract = Contract_repr.Implicit delegate in
   let slashing_percentage = get_percentage ctxt in
+  let preserved_cycles = Constants_storage.preserved_cycles ctxt in
   let staking_over_baking_limit =
     Constants_storage.adaptive_inflation_staking_over_baking_limit ctxt
   in
@@ -96,6 +97,25 @@ let punish_double_signing ~get ~set ~get_percentage ctxt delegate
     if should_forbid then Delegate_storage.forbid_delegate ctxt delegate
     else Lwt.return ctxt
   in
+  let* unstaked =
+    let oldest_slashable_cycle =
+      Cycle_repr.sub level.cycle preserved_cycles
+      |> Option.value ~default:Cycle_repr.root
+    in
+    let slashable_cycles =
+      Cycle_repr.(oldest_slashable_cycle ---> level.cycle)
+    in
+    List.rev_map_es
+      (fun cycle ->
+        let* frozen_deposits =
+          Unstaked_frozen_deposits_storage.get ctxt delegate cycle
+        in
+        let*? _should_forbid, reward_and_burn =
+          compute_reward_and_burn frozen_deposits
+        in
+        return (cycle, reward_and_burn))
+      slashable_cycles
+  in
   let*! ctxt =
     Storage.Slashed_deposits.add
       (ctxt, level.cycle)
@@ -115,7 +135,7 @@ let punish_double_signing ~get ~set ~get_percentage ctxt delegate
   let*! ctxt =
     Storage.Contract.Slashed_deposits.add ctxt delegate_contract slash_history
   in
-  return (ctxt, {staked; unstaked = []})
+  return (ctxt, {staked; unstaked})
 
 let punish_double_endorsing =
   let get Storage.{for_double_endorsing; _} = for_double_endorsing in
-- 
GitLab