implement migrate accountV3toV4

concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs

@@ -349,6 +349,48 @@ migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringDelega
                     liftStakedBalanceStateTT $ retainDelegator paseDelegatorId oldStake newTarget
                     return $!! (newDelegatorInfo, emptyCooldownQueue)
 
+-- | Migrate PersistentAccountStakeEnduring from AccountV3 to AccountV4. There
+--  are no pending changes to take care of in V3, only the BakerInfoExV1 data
+--  type needs to be migrated by setting the new `_bieIsSuspended` flag to
+--  false.
+migratePersistentAccountStakeEnduringV3toV4 ::
+    (SupportMigration m t, AccountMigration 'AccountV4 (t m)) =>
+    PersistentAccountStakeEnduring 'AccountV3 ->
+    -- | Returns the new 'PersistentAccountStakeEnduring' and 'CooldownQueue'.
+    StakedBalanceStateTT t m (PersistentAccountStakeEnduring 'AccountV4, CooldownQueue 'AccountV4)
+migratePersistentAccountStakeEnduringV3toV4 PersistentAccountStakeEnduringNone =
+    return (PersistentAccountStakeEnduringNone, emptyCooldownQueue)
+migratePersistentAccountStakeEnduringV3toV4 PersistentAccountStakeEnduringBaker{..} =
+    case paseBakerPendingChange of
+        NoChange -> (,emptyCooldownQueue) <$> keepBakerInfo
+  where
+    keepBakerInfo = do
+        newBakerInfo <- migrateReference (return . (\BakerInfoExV1{..} -> BakerInfoExV1{_bieIsSuspended = CTrue False, ..})) paseBakerInfo
+        return
+            PersistentAccountStakeEnduringBaker
+                { paseBakerInfo = newBakerInfo,
+                  paseBakerPendingChange = NoChange,
+                  ..
+                }
+migratePersistentAccountStakeEnduringV3toV4 PersistentAccountStakeEnduringDelegator{..} =
+    do
+        newTarget <- case paseDelegatorTarget of
+            DelegatePassive -> return DelegatePassive
+            DelegateToBaker bid -> do
+                removed <- liftStakedBalanceStateTT $ isBakerRemoved bid
+                return $ if removed then DelegatePassive else paseDelegatorTarget
+        let newDelegatorInfo =
+                PersistentAccountStakeEnduringDelegator
+                    { paseDelegatorPendingChange = NoChange,
+                      paseDelegatorTarget = newTarget,
+                      ..
+                    }
+        oldStake <- State.get
+        case paseDelegatorPendingChange of
+            NoChange -> do
+                liftStakedBalanceStateTT $ retainDelegator paseDelegatorId oldStake newTarget
+                return $!! (newDelegatorInfo, emptyCooldownQueue)
+
 -- | This relies on the fact that the 'AccountV2' hashing of 'AccountStake' is independent of the
 --  staked amount.
 instance (MonadBlobStore m) => MHashableTo m (AccountStakeHash 'AccountV2) (PersistentAccountStakeEnduring 'AccountV2) where
@@ -1968,6 +2010,32 @@ migrateEnduringDataV2toV3 ed = do
         paedStake
         paedStakeCooldown
 
+migrateEnduringDataV3toV4 ::
+    (SupportMigration m t, AccountMigration 'AccountV4 (t m), MonadLogger (t m)) =>
+    -- | Current enduring data
+    PersistentAccountEnduringData 'AccountV3 ->
+    -- | New enduring data.
+    StakedBalanceStateTT t m (PersistentAccountEnduringData 'AccountV4)
+migrateEnduringDataV3toV4 ed = do
+    logEvent GlobalState LLTrace "Migrating persisting data"
+    paedPersistingData <- migrateEagerBufferedRef return (paedPersistingData ed)
+    paedEncryptedAmount <- forM (paedEncryptedAmount ed) $ \e -> do
+        logEvent GlobalState LLTrace "Migrating encrypted amount"
+        migrateReference migratePersistentEncryptedAmount e
+    paedReleaseSchedule <- forM (paedReleaseSchedule ed) $ \(oldRSRef, lockedAmt) -> do
+        logEvent GlobalState LLTrace "Migrating release schedule"
+        newRSRef <- migrateReference migrateAccountReleaseSchedule oldRSRef
+        return (newRSRef, lockedAmt)
+    logEvent GlobalState LLTrace "Migrating stake"
+    (paedStake, paedStakeCooldown) <- migratePersistentAccountStakeEnduringV3toV4 (paedStake ed)
+    logEvent GlobalState LLTrace "Reconstructing account enduring data"
+    makeAccountEnduringDataAV4
+        paedPersistingData
+        paedEncryptedAmount
+        paedReleaseSchedule
+        paedStake
+        paedStakeCooldown
+
 -- | Migration for 'PersistentAccountEnduringData'. Only supports 'AccountV3'.
 --  The data is unchanged in the migration.
 migrateEnduringDataV3toV3 ::
@@ -2081,11 +2149,24 @@ migrateV3ToV3 acc = do
 migrateV3ToV4 ::
     ( MonadBlobStore m,
       MonadBlobStore (t m),
-      MonadTrans t
+      AccountMigration 'AccountV4 (t m),
+      MonadTrans t,
+      MonadLogger (t m)
     ) =>
     PersistentAccount 'AccountV3 ->
     t m (PersistentAccount 'AccountV4)
-migrateV3ToV4 _acc = error "TODO(drsk) github #1221. implement migrateV3ToV4"
+migrateV3ToV4 acc = do
+    (accountEnduringData, newStakedAmount) <-
+        runStakedBalanceStateTT
+            (migrateEagerBufferedRef migrateEnduringDataV3toV4 (accountEnduringData acc))
+            (accountStakedAmount acc)
+    return $!
+        PersistentAccount
+            { accountNonce = accountNonce acc,
+              accountAmount = accountAmount acc,
+              accountStakedAmount = newStakedAmount,
+              ..
+            }
 
 -- | A trivial migration from account version 4 to account version 4.
 --  In particular the data is retained as-is.