Use doublew cache for stake address

One small LRU and one bigger where addrs are only explicitely evicted

Author: kderme

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

@@ -403,10 +403,10 @@ mkSyncEnv trce backend connectionString syncOptions protoInfo nw nwMagic systemS
       then
         newEmptyCache
           CacheCapacity
-            { cacheCapacityStake = 1600000
+            { cacheCapacityStake = 100000
             , cacheCapacityDatum = 250000
             , cacheCapacityMultiAsset = 250000
-            , cacheCapacityTx = 350000
+            , cacheCapacityTx = 100000
             }
       else pure useNoCache
   consistentLevelVar <- newTVarIO Unchecked

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

@@ -33,7 +33,7 @@ import qualified Cardano.Db as DB
 import Cardano.DbSync.Cache.Epoch (rollbackMapEpochInCache)
 import qualified Cardano.DbSync.Cache.FIFO as FIFO
 import qualified Cardano.DbSync.Cache.LRU as LRU
-import Cardano.DbSync.Cache.Types (CacheAction (..), CacheInternal (..), CacheStatistics (..), CacheStatus (..), StakeCache (..), initCacheStatistics)
+import Cardano.DbSync.Cache.Types (CacheAction (..), CacheInternal (..), CacheStatistics (..), CacheStatus (..), StakeCache (..), initCacheStatistics, shouldCache)
 import qualified Cardano.DbSync.Era.Shelley.Generic.Util as Generic
 import Cardano.DbSync.Era.Shelley.Query
 import Cardano.DbSync.Era.Util
@@ -94,7 +94,7 @@ queryOrInsertRewardAccount ::
   Ledger.RewardAccount StandardCrypto ->
   ReaderT SqlBackend m DB.StakeAddressId
 queryOrInsertRewardAccount trce cache cacheUA rewardAddr = do
-  eiAddrId <- queryRewardAccountWithCacheRetBs trce cache cacheUA rewardAddr
+  eiAddrId <- queryStakeAddrWithCacheRetBs trce cache cacheUA rewardAddr
   case eiAddrId of
     Left (_err, bs) -> insertStakeAddress rewardAddr (Just bs)
     Right addrId -> pure addrId
@@ -127,17 +127,6 @@ insertStakeAddress rewardAddr stakeCredBs = do
   where
     addrBs = fromMaybe (Ledger.serialiseRewardAccount rewardAddr) stakeCredBs
 
-queryRewardAccountWithCacheRetBs ::
-  forall m.
-  MonadIO m =>
-  Trace IO Text ->
-  CacheStatus ->
-  CacheAction ->
-  Ledger.RewardAccount StandardCrypto ->
-  ReaderT SqlBackend m (Either (DB.LookupFail, ByteString) DB.StakeAddressId)
-queryRewardAccountWithCacheRetBs trce cache cacheUA rwdAcc =
-  queryStakeAddrWithCacheRetBs trce cache cacheUA (Ledger.raNetwork rwdAcc) (Ledger.raCredential rwdAcc)
-
 queryStakeAddrWithCache ::
   forall m.
   MonadIO m =>
@@ -148,26 +137,25 @@ queryStakeAddrWithCache ::
   StakeCred ->
   ReaderT SqlBackend m (Either DB.LookupFail DB.StakeAddressId)
 queryStakeAddrWithCache trce cache cacheUA nw cred =
-  mapLeft fst <$> queryStakeAddrWithCacheRetBs trce cache cacheUA nw cred
+  mapLeft fst <$> queryStakeAddrWithCacheRetBs trce cache cacheUA (Ledger.RewardAccount nw cred)
 
 queryStakeAddrWithCacheRetBs ::
   forall m.
   MonadIO m =>
   Trace IO Text ->
   CacheStatus ->
   CacheAction ->
-  Network ->
-  StakeCred ->
+  Ledger.RewardAccount StandardCrypto ->
   ReaderT SqlBackend m (Either (DB.LookupFail, ByteString) DB.StakeAddressId)
-queryStakeAddrWithCacheRetBs _trce cache cacheUA nw cred = do
-  let bs = Ledger.serialiseRewardAccount (Ledger.RewardAccount nw cred)
+queryStakeAddrWithCacheRetBs _trce cache cacheUA ra@(Ledger.RewardAccount _ cred) = do
+  let bs = Ledger.serialiseRewardAccount ra
   case cache of
     NoCache -> do
       mapLeft (,bs) <$> resolveStakeAddress bs
     ActiveCache ci -> do
       stakeCache <- liftIO $ readTVarIO (cStake ci)
       case queryStakeCache cred stakeCache of
-        Just (addrId, stakeCache', _) -> do
+        Just (addrId, stakeCache') -> do
           liftIO $ hitCreds (cStats ci)
           case cacheUA of
             EvictAndUpdateCache -> do
@@ -192,11 +180,11 @@ queryStakeAddrWithCacheRetBs _trce cache cacheUA nw cred = do
               pure $ Right stakeAddrsId
 
 -- | True if it was found in LRU
-queryStakeCache :: StakeCred -> StakeCache -> Maybe (DB.StakeAddressId, StakeCache, Bool)
+queryStakeCache :: StakeCred -> StakeCache -> Maybe (DB.StakeAddressId, StakeCache)
 queryStakeCache scred scache = case Map.lookup scred (scStableCache scache) of
-  Just addrId -> Just (addrId, scache, False)
+  Just addrId -> Just (addrId, scache)
   Nothing -> case LRU.lookup scred (scLruCache scache) of
-    Just (addrId, lru') -> Just (addrId, scache {scLruCache = lru'}, True)
+    Just (addrId, lru') -> Just (addrId, scache {scLruCache = lru'})
     Nothing -> Nothing
 
 deleteStakeCache :: StakeCred -> StakeCache -> StakeCache
@@ -235,7 +223,7 @@ queryPoolKeyWithCache cache cacheUA hsh =
             Nothing -> pure $ Left (DB.DbLookupMessage "PoolKeyHash")
             Just phId -> do
               -- missed so we can't evict even with 'EvictAndReturn'
-              when (cacheUA == UpdateCache) $
+              when (shouldCache cacheUA) $
                 liftIO $
                   atomically $
                     modifyTVar (cPools ci) $
@@ -275,7 +263,7 @@ insertPoolKeyWithCache cache cacheUA pHash =
                 { DB.poolHashHashRaw = Generic.unKeyHashRaw pHash
                 , DB.poolHashView = Generic.unKeyHashView pHash
                 }
-          when (cacheUA == UpdateCache) $
+          when (shouldCache cacheUA) $
             liftIO $
               atomically $
                 modifyTVar (cPools ci) $

cardano-db-sync/src/Cardano/DbSync/Cache/Types.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -21,6 +22,9 @@ module Cardano.DbSync.Cache.Types (
   initCacheStatistics,
   newEmptyCache,
 
+  -- * Utils
+  shouldCache,
+
   -- * CacheStatistics
   CacheStatistics (..),
   textShowStats,
@@ -47,6 +51,10 @@ import Ouroboros.Consensus.Cardano.Block (StandardCrypto)
 
 type StakePoolCache = Map PoolKeyHash DB.PoolHashId
 
+-- | We use a stable cache for entries that are expected to be reused frequentyl.
+-- These are stake addresses that have rewards, delegations etc.
+-- They are never removed unless manually eg when it's deregistered
+-- The LRU cache is much smaller for the rest stake addresses.
 data StakeCache = StakeCache
   { scStableCache :: !(Map StakeCred DB.StakeAddressId)
   , scLruCache :: !(LRUCache StakeCred DB.StakeAddressId)
@@ -229,3 +237,9 @@ initCacheStatistics = CacheStatistics 0 0 0 0 0 0 0 0 0 0 0 0
 
 initCacheEpoch :: CacheEpoch
 initCacheEpoch = CacheEpoch mempty Nothing
+
+shouldCache :: CacheAction -> Bool
+shouldCache = \case
+  UpdateCache -> True
+  UpdateCacheStrong -> True
+  _ -> False

cardano-db-sync/src/Cardano/DbSync/Era/Universal/Epoch.hs

@@ -215,7 +215,7 @@ insertEpochStake syncEnv nw epochNo stakeChunk = do
       (StakeCred, (Shelley.Coin, PoolKeyHash)) ->
       ExceptT SyncNodeError (ReaderT SqlBackend m) DB.EpochStake
     mkStake cache (saddr, (coin, pool)) = do
-      saId <- lift $ queryOrInsertStakeAddress trce cache UpdateCache nw saddr
+      saId <- lift $ queryOrInsertStakeAddress trce cache UpdateCacheStrong nw saddr
       poolId <- lift $ queryPoolKeyOrInsert "insertEpochStake" trce cache UpdateCache (ioShelley iopts) pool
       pure $
         DB.EpochStake
@@ -249,7 +249,7 @@ insertRewards syncEnv nw earnedEpoch spendableEpoch cache rewardsChunk = do
       (StakeCred, Set Generic.Reward) ->
       ExceptT SyncNodeError (ReaderT SqlBackend m) [DB.Reward]
     mkRewards (saddr, rset) = do
-      saId <- lift $ queryOrInsertStakeAddress trce cache UpdateCache nw saddr
+      saId <- lift $ queryOrInsertStakeAddress trce cache UpdateCacheStrong nw saddr
       mapM (prepareReward saId) (Set.toList rset)
 
     prepareReward ::
@@ -299,7 +299,7 @@ insertRewardRests trce nw earnedEpoch spendableEpoch cache rewardsChunk = do
       (StakeCred, Set Generic.RewardRest) ->
       ExceptT SyncNodeError (ReaderT SqlBackend m) [DB.RewardRest]
     mkRewards (saddr, rset) = do
-      saId <- lift $ queryOrInsertStakeAddress trce cache UpdateCache nw saddr
+      saId <- lift $ queryOrInsertStakeAddress trce cache UpdateCacheStrong nw saddr
       pure $ map (prepareReward saId) (Set.toList rset)
 
     prepareReward ::
@@ -333,7 +333,7 @@ insertProposalRefunds trce nw earnedEpoch spendableEpoch cache refunds = do
       GovActionRefunded ->
       ExceptT SyncNodeError (ReaderT SqlBackend m) DB.RewardRest
     mkReward refund = do
-      saId <- lift $ queryOrInsertStakeAddress trce cache UpdateCache nw (raCredential $ garReturnAddr refund)
+      saId <- lift $ queryOrInsertStakeAddress trce cache UpdateCacheStrong nw (raCredential $ garReturnAddr refund)
       pure $
         DB.RewardRest
           { DB.rewardRestAddrId = saId

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

@@ -193,7 +193,7 @@ insertMirCert tracer cache network txId idx mcert = do
       (StakeCred, Ledger.DeltaCoin) ->
       ExceptT SyncNodeError (ReaderT SqlBackend m) ()
     insertMirReserves (cred, dcoin) = do
-      addrId <- lift $ queryOrInsertStakeAddress tracer cache UpdateCache network cred
+      addrId <- lift $ queryOrInsertStakeAddress tracer cache UpdateCacheStrong network cred
       void . lift . DB.insertReserve $
         DB.Reserve
           { DB.reserveAddrId = addrId
@@ -207,7 +207,7 @@ insertMirCert tracer cache network txId idx mcert = do
       (StakeCred, Ledger.DeltaCoin) ->
       ExceptT SyncNodeError (ReaderT SqlBackend m) ()
     insertMirTreasury (cred, dcoin) = do
-      addrId <- lift $ queryOrInsertStakeAddress tracer cache UpdateCache network cred
+      addrId <- lift $ queryOrInsertStakeAddress tracer cache UpdateCacheStrong network cred
       void . lift . DB.insertTreasury $
         DB.Treasury
           { DB.treasuryAddrId = addrId
@@ -413,7 +413,7 @@ insertDelegation ::
   Ledger.KeyHash 'Ledger.StakePool StandardCrypto ->
   ExceptT SyncNodeError (ReaderT SqlBackend m) ()
 insertDelegation trce cache network (EpochNo epoch) slotNo txId idx mRedeemerId cred poolkh = do
-  addrId <- lift $ queryOrInsertStakeAddress trce cache UpdateCache network cred
+  addrId <- lift $ queryOrInsertStakeAddress trce cache UpdateCacheStrong network cred
   poolHashId <- lift $ queryPoolKeyOrInsert "insertDelegation" trce cache UpdateCache True poolkh
   void . lift . DB.insertDelegation $
     DB.Delegation
@@ -437,7 +437,7 @@ insertDelegationVote ::
   DRep StandardCrypto ->
   ExceptT SyncNodeError (ReaderT SqlBackend m) ()
 insertDelegationVote trce cache network txId idx cred drep = do
-  addrId <- lift $ queryOrInsertStakeAddress trce cache UpdateCache network cred
+  addrId <- lift $ queryOrInsertStakeAddress trce cache UpdateCacheStrong network cred
   drepId <- lift $ insertDrep drep
   void
     . lift

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

@@ -155,7 +155,7 @@ insertStakeAddressRefIfMissing trce cache addr =
     Ledger.Addr nw _pcred sref ->
       case sref of
         Ledger.StakeRefBase cred -> do
-          Just <$> queryOrInsertStakeAddress trce cache DoNotUpdateCache nw cred
+          Just <$> queryOrInsertStakeAddress trce cache UpdateCache nw cred
         Ledger.StakeRefPtr ptr -> do
           DB.queryStakeRefPtr ptr
         Ledger.StakeRefNull -> pure Nothing

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

@@ -150,7 +150,7 @@ insertPoolOwner ::
   Ledger.KeyHash 'Ledger.Staking StandardCrypto ->
   ExceptT SyncNodeError (ReaderT SqlBackend m) ()
 insertPoolOwner trce cache network poolUpdateId skh = do
-  saId <- lift $ queryOrInsertStakeAddress trce cache UpdateCache network (Ledger.KeyHashObj skh)
+  saId <- lift $ queryOrInsertStakeAddress trce cache UpdateCacheStrong network (Ledger.KeyHashObj skh)
   void . lift . DB.insertPoolOwner $
     DB.PoolOwner
       { DB.poolOwnerAddrId = saId