Add bieAccountIsSuspended field to BakerInfoEx (#553)

Add `bieAccountIsSuspended` field to `BakerInfoEx` We add the `bieAccountIsSuspended` field to `BakerInfoEx` to make the field persistent together with the account.
Concordium · Sep 5, 2024 · f2db8a0 · f2db8a0
1 parent 834a777
commit f2db8a0
Show file tree

Hide file tree

Showing 3 changed files with 41 additions and 3 deletions.
diff --git a/haskell-src/Concordium/Types/Accounts.hs b/haskell-src/Concordium/Types/Accounts.hs
@@ -47,6 +47,7 @@ module Concordium.Types.Accounts (
     BakerInfoEx (..),
     bieBakerInfo,
     bieBakerPoolInfo,
+    bieAccountIsSuspended,
     coerceBakerInfoExV1,
     PendingChangeEffective (..),
     pendingChangeEffectiveTimestamp,
@@ -96,6 +97,7 @@ import qualified Concordium.Crypto.SHA256 as Hash
 import Concordium.ID.Types
 import Concordium.Types
 import Concordium.Types.Accounts.Releases
+import Concordium.Types.Conditionally
 import Concordium.Types.Execution (DelegationTarget, OpenStatus)
 import Concordium.Types.HashableTo
 
@@ -207,11 +209,13 @@ instance FromJSON BakerPoolInfo where
 data BakerInfoEx (av :: AccountVersion) where
     BakerInfoExV0 :: !BakerInfo -> BakerInfoEx 'AccountV0
     BakerInfoExV1 ::
+        forall av.
         (AVSupportsDelegation av) =>
         { -- | The baker ID and keys.
           _bieBakerInfo :: !BakerInfo,
           -- | The baker pool info.
-          _bieBakerPoolInfo :: !BakerPoolInfo
+          _bieBakerPoolInfo :: !BakerPoolInfo,
+          _bieAccountIsSuspended :: !(Conditionally (SupportsValidatorSuspension av) Bool)
         } ->
         BakerInfoEx av
 
@@ -230,9 +234,20 @@ bieBakerPoolInfo :: (AVSupportsDelegation av) => Lens' (BakerInfoEx av) BakerPoo
 bieBakerPoolInfo =
     lens _bieBakerPoolInfo (\bie x -> bie{_bieBakerPoolInfo = x})
 
+-- | Lens for '_bieBakerIsSuspended'
+{-# INLINE bieAccountIsSuspended #-}
+bieAccountIsSuspended ::
+    (AVSupportsDelegation av, AVSupportsValidatorSuspension av) =>
+    Lens' (BakerInfoEx av) Bool
+bieAccountIsSuspended =
+    lens (uncond . _bieAccountIsSuspended) (\bie x -> bie{_bieAccountIsSuspended = CTrue x})
+
 -- | Coerce a 'BakerInfoEx' between two account versions that support delegation.
 coerceBakerInfoExV1 ::
-    (AVSupportsDelegation av1, AVSupportsDelegation av2) =>
+    ( AVSupportsDelegation av1,
+      AVSupportsDelegation av2,
+      AVSupportsValidatorSuspension av1 ~ AVSupportsValidatorSuspension av2
+    ) =>
     BakerInfoEx av1 ->
     BakerInfoEx av2
 coerceBakerInfoExV1 BakerInfoExV1{..} = BakerInfoExV1{..}
@@ -243,12 +258,17 @@ coerceBakerInfoExV1 BakerInfoExV1{..} = BakerInfoExV1{..}
 --  'BakerInfo' was used.
 instance forall av. (IsAccountVersion av) => Serialize (BakerInfoEx av) where
     put (BakerInfoExV0 bi) = put bi
-    put BakerInfoExV1{..} = put _bieBakerInfo >> put _bieBakerPoolInfo
+    put BakerInfoExV1{..} = do
+        put _bieBakerInfo
+        put _bieBakerPoolInfo
+        mapM_ put _bieAccountIsSuspended
     get = case delegationSupport @av of
         SAVDelegationNotSupported -> BakerInfoExV0 <$> get
         SAVDelegationSupported -> do
             _bieBakerInfo <- get
             _bieBakerPoolInfo <- get
+            _bieAccountIsSuspended <-
+                conditionallyA (sSupportsValidatorSuspension (accountVersion @av)) get
             return BakerInfoExV1{..}
 
 instance HasBakerInfo (BakerInfoEx av) where

diff --git a/haskell-src/Concordium/Types/Conditionally.hs b/haskell-src/Concordium/Types/Conditionally.hs
@@ -77,3 +77,7 @@ unconditionally f (CTrue a) = CTrue <$> f a
 -- | Unwrap a conditionally when the guard is 'True'.
 uncond :: Conditionally 'True a -> a
 uncond (CTrue a) = a
+
+fromCondDef :: Conditionally b a -> a -> a
+fromCondDef (CTrue a) _def = a
+fromCondDef CFalse def = def
diff --git a/haskell-src/Concordium/Types/ProtocolVersion.hs b/haskell-src/Concordium/Types/ProtocolVersion.hs
@@ -179,9 +179,15 @@ module Concordium.Types.ProtocolVersion (
     -- | Determine whether validators can be suspended/resumed. A validator with
     --   a suspended account is in essence not participating in the consensus.
     --   Its stake and delegators stay unchanged.
+    SupportsValidatorSuspension,
     supportsValidatorSuspension,
+    sSupportsValidatorSuspension,
     -- | Determine whether the protocol supports suspending/resuming of validators.
     protocolSupportsSuspend,
+    -- | Deterimne whether a specific account version supports suspending/
+    -- resuming of validators.
+    AVSupportsValidatorSuspension,
+    PVSupportsValidatorSuspension,
 
     -- * Block hash version
 
@@ -567,6 +573,14 @@ protocolSupportsSuspend spv = case sSupportsValidatorSuspension (sAccountVersion
     STrue -> True
     SFalse -> False
 
+-- | Constraint that an account version supports validator suspension.
+type AVSupportsValidatorSuspension (av :: AccountVersion) =
+    SupportsValidatorSuspension av ~ 'True
+
+-- | Constraint that a protocol version supports validator suspension.
+type PVSupportsValidatorSuspension (pv :: ProtocolVersion) =
+    AVSupportsValidatorSuspension (AccountVersionFor pv)
+
 -- | Constraint that an account version supports flexible cooldown.
 --
 -- Note, we do not use 'Assert' here, since that results in a weaker constraint that requires