implement migrate accountV3toV4

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

@@ -349,6 +349,88 @@ migratePersistentAccountStakeEnduringV2toV3 PersistentAccountStakeEnduringDelega
                     liftStakedBalanceStateTT $ retainDelegator paseDelegatorId oldStake newTarget
                     return $!! (newDelegatorInfo, emptyCooldownQueue)
 
+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
+        RemoveStake _ -> do
+            -- The baker is being removed, so we don't migrate it.
+            -- Get the old stake, updating it to 0.
+            cooldownAmount <- State.get
+            State.put 0
+            cooldown <- initialPrePreCooldownQueue cooldownAmount
+            liftStakedBalanceStateTT addAccountInPrePreCooldown
+            return (PersistentAccountStakeEnduringNone, cooldown)
+        ReduceStake newStake _ -> do
+            oldStake <- State.get
+            unless (newStake <= oldStake) $
+                error $
+                    "Stake on baker 'reduced' from "
+                        ++ show oldStake
+                        ++ " to "
+                        ++ show newStake
+            State.put newStake
+            cooldown <- initialPrePreCooldownQueue (oldStake - newStake)
+            liftStakedBalanceStateTT addAccountInPrePreCooldown
+            newPASE <- keepBakerInfo
+            return (newPASE, cooldown)
+        NoChange -> (,emptyCooldownQueue) <$> keepBakerInfo
+  where
+    keepBakerInfo = do
+        newBakerInfo <- migrateReference (return . (\BakerInfoExV1{..} -> BakerInfoExV1{_bieIsSuspended = CTrue False, ..})) paseBakerInfo
+        return
+            PersistentAccountStakeEnduringBaker
+                { paseBakerInfo = newBakerInfo,
+                  paseBakerPendingChange = NoChange,
+                  ..
+                }
+migratePersistentAccountStakeEnduringV3toV4 PersistentAccountStakeEnduringDelegator{..} =
+    case paseDelegatorPendingChange of
+        RemoveStake _ -> do
+            -- Get the old stake, updating it to 0.
+            cooldownAmount <- State.get
+            State.put 0
+            cooldown <- initialPrePreCooldownQueue cooldownAmount
+            liftStakedBalanceStateTT addAccountInPrePreCooldown
+            return (PersistentAccountStakeEnduringNone, cooldown)
+        _ -> 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
+                ReduceStake newStake _ -> do
+                    unless (newStake <= oldStake) $
+                        error $
+                            "Stake on delegator "
+                                ++ show paseDelegatorId
+                                ++ " 'reduced' from "
+                                ++ show oldStake
+                                ++ " to "
+                                ++ show newStake
+                    State.put newStake
+                    cooldown <- initialPrePreCooldownQueue (oldStake - newStake)
+                    liftStakedBalanceStateTT $ do
+                        addAccountInPrePreCooldown
+                        retainDelegator paseDelegatorId newStake newTarget
+                    return $!! (newDelegatorInfo, cooldown)
+                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 +2050,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 +2189,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.