Get AdaPots from leger events

Instead of using the ledger. This changes semantically the values of
the DB, so it's a c level breaking change. A migration is impossible to
cover these changes. Fixes #1258.

Author: kderme

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

@@ -238,6 +238,8 @@ insertLedgerEvents syncEnv currentEpochNo@(EpochNo curEpoch) =
           lift $ adjustEpochRewards tracer ntw cache e rwd creds
         LedgerTotalRewards _e rwd -> do
           lift $ validateEpochRewards tracer ntw (subFromCurrentEpoch 2) currentEpochNo rwd
+        LedgerAdaPots _ ->
+          pure () -- These are handled separately by insertBlock
         LedgerMirDist rwd -> do
           unless (Map.null rwd) $ do
             let rewards = Map.toList rwd

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

@@ -16,13 +16,16 @@ module Cardano.DbSync.LedgerEvent (
   ledgerEventName,
 ) where
 
-import Cardano.Db hiding (EpochNo, SyncState, epochNo)
+import Cardano.Db hiding (AdaPots, EpochNo, SyncState, epochNo)
 import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
 import Cardano.DbSync.Types
 import Cardano.DbSync.Util
 import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
 import qualified Cardano.Ledger.Core as Ledger
-import Cardano.Ledger.Shelley.API (InstantaneousRewards (..))
+-- 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),
   ShelleyEpochEvent (PoolReapEvent),
@@ -55,6 +58,7 @@ data LedgerEvent
   | LedgerDeltaRewards !EpochNo !Generic.Rewards
   | LedgerRestrainedRewards !EpochNo !Generic.Rewards !(Set StakeCred)
   | LedgerTotalRewards !EpochNo !(Map StakeCred (Set (Ledger.Reward StandardCrypto)))
+  | LedgerAdaPots !AdaPots
   | LedgerStartAtEpoch !EpochNo
   | LedgerNewEpoch !EpochNo !SyncState
   deriving (Eq)
@@ -70,8 +74,9 @@ toOrdering ev = case ev of
   LedgerDeltaRewards {} -> 3
   LedgerRestrainedRewards {} -> 4
   LedgerTotalRewards {} -> 5
-  LedgerStartAtEpoch {} -> 6
-  LedgerNewEpoch {} -> 7
+  LedgerAdaPots {} -> 6
+  LedgerStartAtEpoch {} -> 7
+  LedgerNewEpoch {} -> 8
 
 convertAuxLedgerEvent :: OneEraLedgerEvent (CardanoEras StandardCrypto) -> Maybe LedgerEvent
 convertAuxLedgerEvent = toLedgerEvent . wrappedAuxLedgerEvent
@@ -85,6 +90,7 @@ ledgerEventName le =
     LedgerDeltaRewards {} -> "LedgerDeltaRewards"
     LedgerRestrainedRewards {} -> "LedgerRestrainedRewards"
     LedgerTotalRewards {} -> "LedgerTotalRewards"
+    LedgerAdaPots {} -> "LedgerAdaPots"
     LedgerStartAtEpoch {} -> "LedgerStartAtEpoch"
     LedgerNewEpoch {} -> "LedgerNewEpoch"
 
@@ -140,6 +146,7 @@ toLedgerEventShelley evt =
       Just $ LedgerIncrementalRewards e (convertPoolRewards m)
     LEMirTransfer rp tp _rtt _ttr -> Just $ LedgerMirDist (convertMirRewards rp tp)
     LERetiredPools r _u en -> Just $ LedgerPoolReap en (convertPoolDepositRefunds r)
+    LEAdaPots p -> Just $ LedgerAdaPots p
     ShelleyLedgerEventBBODY {} -> Nothing
     ShelleyLedgerEventTICK {} -> Nothing
 
@@ -298,3 +305,17 @@ pattern LERetiredPools r u e <-
               )
           )
       )
+
+pattern LEAdaPots ::
+  ( EraCrypto ledgerera ~ StandardCrypto
+  , Event (Ledger.EraRule "TICK" ledgerera) ~ ShelleyTickEvent ledgerera
+  , Event (Ledger.EraRule "NEWEPOCH" ledgerera) ~ ShelleyNewEpochEvent ledgerera
+  , Event (Ledger.EraRule "MIR" ledgerera) ~ ShelleyMirEvent ledgerera
+  ) =>
+  AdaPots ->
+  AuxLedgerEvent (LedgerState (ShelleyBlock p ledgerera))
+pattern LEAdaPots pots <-
+  ShelleyLedgerEventTICK
+    ( TickNewEpochEvent
+        (TotalAdaPotsEvent pots)
+      )

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

@@ -43,9 +43,8 @@ import Cardano.DbSync.Util
 import qualified Cardano.Ledger.Alonzo.PParams as Alonzo
 import Cardano.Ledger.Alonzo.Scripts
 import qualified Cardano.Ledger.BaseTypes as Ledger
-import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Era (EraCrypto)
-import qualified Cardano.Ledger.Shelley.API.Wallet as Shelley
+import Cardano.Ledger.Shelley.AdaPots (AdaPots)
 import Cardano.Ledger.Shelley.LedgerState (EpochState (..))
 import qualified Cardano.Ledger.Shelley.LedgerState as Shelley
 import Cardano.Prelude hiding (atomically)
@@ -307,14 +306,14 @@ applyBlock env blk = do
     !ledgerDB <- readStateUnsafe env
     let oldState = ledgerDbCurrent ledgerDB
     let !result = applyBlk (ExtLedgerCfg (getTopLevelconfigHasLedger env)) blk (clsState oldState)
+    let !ledgerEvents = mapMaybe convertAuxLedgerEvent (lrEvents result)
     let !newLedgerState = lrResult result
     !details <- getSlotDetails env (ledgerState newLedgerState) time (cardanoBlockSlotNo blk)
-    let !newEpoch = mkNewEpoch (clsState oldState) newLedgerState
+    let !newEpoch = mkNewEpoch (clsState oldState) newLedgerState (findAdaPots ledgerEvents)
     let !newEpochBlockNo = applyToEpochBlockNo (isJust $ blockIsEBB blk) (isJust newEpoch) (clsEpochBlockNo oldState)
     let !newState = CardanoLedgerState newLedgerState newEpochBlockNo
     let !ledgerDB' = pushLedgerDB ledgerDB newState
     writeTVar (leStateVar env) (Strict.Just ledgerDB')
-    let !ledgerEvents = mapMaybe convertAuxLedgerEvent (lrEvents result)
     let !appResult =
           ApplyResult
             { apPrices = getPrices newState
@@ -336,16 +335,16 @@ applyBlock env blk = do
         Left err -> panic err
         Right result -> result
 
-    mkNewEpoch :: ExtLedgerState CardanoBlock -> ExtLedgerState CardanoBlock -> Maybe Generic.NewEpoch
-    mkNewEpoch oldState newState =
+    mkNewEpoch :: ExtLedgerState CardanoBlock -> ExtLedgerState CardanoBlock -> Maybe AdaPots -> Maybe Generic.NewEpoch
+    mkNewEpoch oldState newState mPots =
       if ledgerEpochNo env newState /= ledgerEpochNo env oldState + 1
         then Nothing
         else
           Just $
             Generic.NewEpoch
               { Generic.neEpoch = ledgerEpochNo env newState
               , Generic.neIsEBB = isJust $ blockIsEBB blk
-              , Generic.neAdaPots = maybeToStrict $ getAdaPots newState
+              , Generic.neAdaPots = maybeToStrict mPots
               , Generic.neEpochUpdate = Generic.epochUpdate newState
               }
 
@@ -791,19 +790,6 @@ getRegisteredPoolShelley lState =
             Shelley.nesEs $
               Consensus.shelleyLedgerState lState
 
--- We only compute 'AdaPots' for later eras. This is a time consuming
--- function and we only want to run it on epoch boundaries.
-getAdaPots :: ExtLedgerState CardanoBlock -> Maybe Shelley.AdaPots
-getAdaPots st =
-  case ledgerState st of
-    LedgerStateByron _ -> Nothing
-    LedgerStateShelley sts -> Just $ totalAdaPots sts
-    LedgerStateAllegra sta -> Just $ totalAdaPots sta
-    LedgerStateMary stm -> Just $ totalAdaPots stm
-    LedgerStateAlonzo sta -> Just $ totalAdaPots sta
-    LedgerStateBabbage stb -> Just $ totalAdaPots stb
-    LedgerStateConway _stc -> panic "TODO: Conway 3"
-
 ledgerEpochNo :: HasLedgerEnv -> ExtLedgerState CardanoBlock -> EpochNo
 ledgerEpochNo env cls =
   case ledgerTipSlot (ledgerState cls) of
@@ -840,13 +826,6 @@ tickThenReapplyCheckHash cfg block lsb =
           , "."
           ]
 
-totalAdaPots ::
-  forall p era.
-  Core.EraTxOut era =>
-  LedgerState (ShelleyBlock p era) ->
-  Shelley.AdaPots
-totalAdaPots = Shelley.totalAdaPotsES . Shelley.nesEs . Consensus.shelleyLedgerState
-
 getHeaderHash :: HeaderHash CardanoBlock -> ByteString
 getHeaderHash bh = SBS.fromShort (Consensus.getOneEraHash bh)
 
@@ -894,3 +873,10 @@ getPrices st = case ledgerState $ clsState st of
           ^. Alonzo.ppPricesL
       )
   _ -> Strict.Nothing
+
+findAdaPots :: [LedgerEvent] -> Maybe AdaPots
+findAdaPots = go
+  where
+    go [] = Nothing
+    go (LedgerAdaPots p: _) = Just p
+    go (_ : rest) = go rest