Fix AdaPots during ledger replay

This fixes #1258

cardano-db-sync/src/Cardano/DbSync/Default.hs

@@ -17,7 +17,7 @@ import Cardano.DbSync.Era.Byron.Insert (insertByronBlock)
 import Cardano.DbSync.Era.Cardano.Insert (insertEpochSyncTime)
 import Cardano.DbSync.Era.Shelley.Adjust (adjustEpochRewards)
 import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
-import Cardano.DbSync.Era.Shelley.Insert (insertShelleyBlock)
+import Cardano.DbSync.Era.Shelley.Insert (insertShelleyBlock, mkAdaPots)
 import Cardano.DbSync.Era.Shelley.Insert.Epoch (insertPoolDepositRefunds, insertRewards)
 import Cardano.DbSync.Era.Shelley.Validate (validateEpochRewards)
 import Cardano.DbSync.Error
@@ -32,8 +32,9 @@ import Cardano.DbSync.Rollback
 import Cardano.DbSync.Types
 import Cardano.DbSync.Util
 import qualified Cardano.Ledger.Alonzo.Scripts as Ledger
+import Cardano.Ledger.Shelley.AdaPots as Shelley
 import Cardano.Prelude
-import Cardano.Slotting.Slot (EpochNo (..))
+import Cardano.Slotting.Slot (EpochNo (..), SlotNo)
 import Control.Monad.Logger (LoggingT)
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Control.Monad.Trans.Except.Extra (newExceptT)
@@ -69,19 +70,26 @@ applyAndInsertBlockMaybe syncEnv cblk = do
     then -- In the usual case it will be consistent so we don't need to do any queries. Just insert the block
       insertBlock syncEnv cblk applyRes False tookSnapshot
     else do
-      blockIsInDbAlready <- lift (isRight <$> DB.queryBlockId (SBS.fromShort . Consensus.getOneEraHash $ blockHash cblk))
+      eiBlockInDbAlreadyId <- lift (DB.queryBlockId (SBS.fromShort . Consensus.getOneEraHash $ blockHash cblk))
       -- If the block is already in db, do nothing. If not, delete all blocks with greater 'BlockNo' or
       -- equal, insert the block and restore consistency between ledger and db.
-      unless blockIsInDbAlready $ do
-        liftIO . logInfo tracer $
-          mconcat
-            [ "Received block which is not in the db with "
-            , textShow (getHeaderFields cblk)
-            , ". Time to restore consistency."
-            ]
-        rollbackFromBlockNo syncEnv (blockNo cblk)
-        insertBlock syncEnv cblk applyRes True tookSnapshot
-        liftIO $ setConsistentLevel syncEnv Consistent
+      case eiBlockInDbAlreadyId of
+        Left _ -> do
+          liftIO . logInfo tracer $
+            mconcat
+              [ "Received block which is not in the db with "
+              , textShow (getHeaderFields cblk)
+              , ". Time to restore consistency."
+              ]
+          rollbackFromBlockNo syncEnv (blockNo cblk)
+          insertBlock syncEnv cblk applyRes True tookSnapshot
+          liftIO $ setConsistentLevel syncEnv Consistent
+        Right blockId | Just (adaPots, slotNo, epochNo) <- getAdaPots applyRes -> do
+          replaced <- lift $ DB.replaceAdaPots blockId $ mkAdaPots blockId slotNo epochNo adaPots
+          if replaced
+            then liftIO $ logInfo tracer $ "Fixed AdaPots for " <> textShow epochNo
+            else liftIO $ logInfo tracer $ "Reached " <> textShow epochNo
+        _ -> pure ()
   where
     tracer = getTrace syncEnv
 
@@ -93,6 +101,12 @@ applyAndInsertBlockMaybe syncEnv cblk = do
           slotDetails <- getSlotDetailsNode nle (cardanoBlockSlotNo cblk)
           pure (defaultApplyResult slotDetails, False)
 
+    getAdaPots :: ApplyResult -> Maybe (Shelley.AdaPots, SlotNo, EpochNo)
+    getAdaPots appRes = do
+      newEpoch <- maybeFromStrict $ apNewEpoch appRes
+      adaPots <- maybeFromStrict $ Generic.neAdaPots newEpoch
+      pure (adaPots, sdSlotNo $ apSlotDetails appRes, sdEpochNo $ apSlotDetails appRes)
+
 insertBlock ::
   SyncEnv ->
   CardanoBlock ->

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs

@@ -15,6 +15,7 @@ module Cardano.DbSync.Era.Shelley.Insert (
   insertStakeRegistration,
   insertDelegation,
   insertStakeAddressRefIfMissing,
+  mkAdaPots,
 ) where
 
 import Cardano.Api (SerialiseAsCBOR (..))
@@ -1160,14 +1161,23 @@ insertPots ::
 insertPots blockId slotNo epochNo pots =
   void . lift $
     DB.insertAdaPots $
-      DB.AdaPots
-        { DB.adaPotsSlotNo = unSlotNo slotNo
-        , DB.adaPotsEpochNo = unEpochNo epochNo
-        , DB.adaPotsTreasury = Generic.coinToDbLovelace $ Shelley.treasuryAdaPot pots
-        , DB.adaPotsReserves = Generic.coinToDbLovelace $ Shelley.reservesAdaPot pots
-        , DB.adaPotsRewards = Generic.coinToDbLovelace $ Shelley.rewardsAdaPot pots
-        , DB.adaPotsUtxo = Generic.coinToDbLovelace $ Shelley.utxoAdaPot pots
-        , DB.adaPotsDeposits = Generic.coinToDbLovelace $ Shelley.depositsAdaPot pots
-        , DB.adaPotsFees = Generic.coinToDbLovelace $ Shelley.feesAdaPot pots
-        , DB.adaPotsBlockId = blockId
-        }
+      mkAdaPots blockId slotNo epochNo pots
+
+mkAdaPots ::
+  DB.BlockId ->
+  SlotNo ->
+  EpochNo ->
+  Shelley.AdaPots ->
+  DB.AdaPots
+mkAdaPots blockId slotNo epochNo pots =
+  DB.AdaPots
+    { DB.adaPotsSlotNo = unSlotNo slotNo
+    , DB.adaPotsEpochNo = unEpochNo epochNo
+    , DB.adaPotsTreasury = Generic.coinToDbLovelace $ Shelley.treasuryAdaPot pots
+    , DB.adaPotsReserves = Generic.coinToDbLovelace $ Shelley.reservesAdaPot pots
+    , DB.adaPotsRewards = Generic.coinToDbLovelace $ Shelley.rewardsAdaPot pots
+    , DB.adaPotsUtxo = Generic.coinToDbLovelace $ Shelley.utxoAdaPot pots
+    , DB.adaPotsDeposits = Generic.coinToDbLovelace $ Shelley.depositsAdaPot pots
+    , DB.adaPotsFees = Generic.coinToDbLovelace $ Shelley.feesAdaPot pots
+    , DB.adaPotsBlockId = blockId
+    }

cardano-db-sync/src/Cardano/DbSync/LedgerEvent.hs

@@ -22,9 +22,6 @@ import Cardano.DbSync.Types
 import Cardano.DbSync.Util
 import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
 import qualified Cardano.Ledger.Core as Ledger
--- import Cardano.Ledger.Crypto (StandardCrypto)
--- import Cardano.Ledger.Era (Crypto)
--- import Cardano.Ledger.Shelley.AdaPots
 import Cardano.Ledger.Shelley.API (AdaPots, InstantaneousRewards (..))
 import Cardano.Ledger.Shelley.Rules (
   RupdEvent (RupdEvent),

cardano-db-sync/src/Cardano/DbSync/LedgerState.hs

@@ -878,5 +878,5 @@ findAdaPots :: [LedgerEvent] -> Maybe AdaPots
 findAdaPots = go
   where
     go [] = Nothing
-    go (LedgerAdaPots p: _) = Just p
+    go (LedgerAdaPots p : _) = Just p
     go (_ : rest) = go rest

cardano-db/src/Cardano/Db/Delete.hs

@@ -13,6 +13,7 @@ module Cardano.Db.Delete (
   deleteBlocksBlockIdNotrace,
   deleteBlock,
   deleteEpochRows,
+  deleteAdaPots,
   -- for testing
   queryFirstAndDeleteAfter,
 ) where
@@ -180,3 +181,7 @@ deleteBlock block = do
 deleteEpochRows :: MonadIO m => Word64 -> ReaderT SqlBackend m ()
 deleteEpochRows epochNum =
   deleteWhere [EpochNo >=. epochNum]
+
+deleteAdaPots :: MonadIO m => BlockId -> ReaderT SqlBackend m ()
+deleteAdaPots blkId = do
+  deleteWhere [AdaPotsBlockId ==. blkId]

cardano-db/src/Cardano/Db/Insert.hs

@@ -54,6 +54,7 @@ module Cardano.Db.Insert (
   insertCheckPoolOfflineFetchError,
   insertReservedPoolTicker,
   insertDelistedPool,
+  replaceAdaPots,
   -- Export mainly for testing.
   insertBlockChecked,
 ) where
@@ -90,6 +91,7 @@ import Database.Persist.Sql (
   insertMany,
   rawExecute,
   rawSql,
+  replace,
   toPersistFields,
   toPersistValue,
   uniqueDBName,
@@ -98,6 +100,7 @@ import Database.Persist.Sql (
 import qualified Database.Persist.Sql.Util as Util
 import Database.Persist.Types (
   ConstraintNameDB (..),
+  Entity (..),
   EntityNameDB (..),
   FieldNameDB (..),
   PersistValue,
@@ -275,6 +278,18 @@ insertReservedPoolTicker ticker = do
 insertDelistedPool :: (MonadBaseControl IO m, MonadIO m) => DelistedPool -> ReaderT SqlBackend m DelistedPoolId
 insertDelistedPool = insertCheckUnique "DelistedPool"
 
+replaceAdaPots :: (MonadBaseControl IO m, MonadIO m) => BlockId -> AdaPots -> ReaderT SqlBackend m Bool
+replaceAdaPots blockId adapots = do
+  mAdaPotsId <- queryAdaPotsId blockId
+  case mAdaPotsId of
+    Nothing -> pure False
+    Just adaPotsDB
+      | entityVal adaPotsDB == adapots ->
+          pure False
+    Just adaPotsDB -> do
+      replace (entityKey adaPotsDB) adapots
+      pure True
+
 -- -----------------------------------------------------------------------------
 
 data DbInsertException

cardano-db/src/Cardano/Db/Query.hs

@@ -47,6 +47,7 @@ module Cardano.Db.Query (
   queryMinRefId,
   existsPoolHashId,
   existsPoolMetadataRefId,
+  queryAdaPotsId,
   -- queries used in smash
   queryPoolOfflineData,
   queryPoolRegister,
@@ -637,6 +638,14 @@ existsPoolMetadataRefId pmrid = do
     pure (pmr ^. PoolMetadataRefId)
   pure $ not (null res)
 
+queryAdaPotsId :: MonadIO m => BlockId -> ReaderT SqlBackend m (Maybe (Entity AdaPots))
+queryAdaPotsId blkId = do
+  res <- select $ do
+    adaPots <- from $ table @AdaPots
+    where_ (adaPots ^. AdaPotsBlockId ==. val blkId)
+    pure adaPots
+  pure $ listToMaybe res
+
 {--------------------------------------------
   Queries use in SMASH
 ----------------------------------------------}