Add double cache for stake address

Author: kderme

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

@@ -403,7 +403,7 @@ mkSyncEnv trce backend connectionString syncOptions protoInfo nw nwMagic systemS
       then
         newEmptyCache
           CacheCapacity
-            { cacheCapacityStakeHashRaw = 1600000
+            { cacheCapacityStake = 1600000
             , cacheCapacityDatum = 250000
             , cacheCapacityMultiAsset = 250000
             , cacheCapacityTx = 350000

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 (..), initCacheStatistics, isCacheActionUpdate)
+import Cardano.DbSync.Cache.Types (CacheAction (..), CacheInternal (..), CacheStatistics (..), CacheStatus (..), StakeCache (..), initCacheStatistics)
 import qualified Cardano.DbSync.Era.Shelley.Generic.Util as Generic
 import Cardano.DbSync.Era.Shelley.Query
 import Cardano.DbSync.Era.Util
@@ -165,30 +165,44 @@ queryStakeAddrWithCacheRetBs _trce cache cacheUA nw cred = do
     NoCache -> do
       mapLeft (,bs) <$> resolveStakeAddress bs
     ActiveCache ci -> do
-      currentCache <- liftIO $ readTVarIO (cStakeRawHashes ci)
-      case LRU.lookup cred currentCache of
-        Just (addrId, lruCache) -> do
+      stakeCache <- liftIO $ readTVarIO (cStake ci)
+      case queryStakeCache cred stakeCache of
+        Just (addrId, stakeCache', _) -> do
           liftIO $ hitCreds (cStats ci)
           case cacheUA of
             EvictAndUpdateCache -> do
-              liftIO $ atomically $ writeTVar (cStakeRawHashes ci) $ LRU.delete cred lruCache
+              liftIO $ atomically $ writeTVar (cStake ci) $ deleteStakeCache cred stakeCache'
               pure $ Right addrId
             _other -> do
-              liftIO $ atomically $ writeTVar (cStakeRawHashes ci) lruCache
+              liftIO $ atomically $ writeTVar (cStake ci) stakeCache'
               pure $ Right addrId
         Nothing -> do
           queryRes <- mapLeft (,bs) <$> resolveStakeAddress bs
           liftIO $ missCreds (cStats ci)
           case queryRes of
             Left _ -> pure queryRes
             Right stakeAddrsId -> do
-              when (isCacheActionUpdate cacheUA) $
-                liftIO $
-                  atomically $
-                    modifyTVar (cStakeRawHashes ci) $
-                      LRU.insert cred stakeAddrsId
+              let !stakeCache' = case cacheUA of
+                    UpdateCache -> stakeCache {scLruCache = LRU.insert cred stakeAddrsId (scLruCache stakeCache)}
+                    UpdateCacheStrong -> stakeCache {scStableCache = Map.insert cred stakeAddrsId (scStableCache stakeCache)}
+                    _ -> stakeCache
+              liftIO $
+                atomically $
+                  writeTVar (cStake ci) stakeCache'
               pure $ Right stakeAddrsId
 
+-- | True if it was found in LRU
+queryStakeCache :: StakeCred -> StakeCache -> Maybe (DB.StakeAddressId, StakeCache, Bool)
+queryStakeCache scred scache = case Map.lookup scred (scStableCache scache) of
+  Just addrId -> Just (addrId, scache, False)
+  Nothing -> case LRU.lookup scred (scLruCache scache) of
+    Just (addrId, lru') -> Just (addrId, scache {scLruCache = lru'}, True)
+    Nothing -> Nothing
+
+deleteStakeCache :: StakeCred -> StakeCache -> StakeCache
+deleteStakeCache scred scache =
+  scache {scStableCache = Map.delete scred (scStableCache scache)}
+
 queryPoolKeyWithCache ::
   MonadIO m =>
   CacheStatus ->

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

@@ -13,16 +13,14 @@ module Cardano.DbSync.Cache.Types (
   CacheEpoch (..),
   CacheInternal (..),
   EpochBlockDiff (..),
+  StakeCache (..),
   StakePoolCache,
 
   -- * Inits
   useNoCache,
   initCacheStatistics,
   newEmptyCache,
 
-  -- * Helpers
-  isCacheActionUpdate,
-
   -- * CacheStatistics
   CacheStatistics (..),
   textShowStats,
@@ -49,6 +47,11 @@ import Ouroboros.Consensus.Cardano.Block (StandardCrypto)
 
 type StakePoolCache = Map PoolKeyHash DB.PoolHashId
 
+data StakeCache = StakeCache
+  { scStableCache :: !(Map StakeCred DB.StakeAddressId)
+  , scLruCache :: !(LRUCache StakeCred DB.StakeAddressId)
+  }
+
 -- 'CacheStatus' enables functions in this module to be called even if the cache has not been initialized.
 -- This is used during genesis insertions, where the cache is not yet initiated, and when the user has disabled the cache functionality.
 data CacheStatus
@@ -57,12 +60,13 @@ data CacheStatus
 
 data CacheAction
   = UpdateCache
+  | UpdateCacheStrong
   | DoNotUpdateCache
   | EvictAndUpdateCache
   deriving (Eq)
 
 data CacheInternal = CacheInternal
-  { cStakeRawHashes :: !(StrictTVar IO (LRUCache StakeCred DB.StakeAddressId))
+  { cStake :: !(StrictTVar IO StakeCache)
   , cPools :: !(StrictTVar IO StakePoolCache)
   , cDatum :: !(StrictTVar IO (LRUCache DataHash DB.DatumId))
   , cMultiAssets :: !(StrictTVar IO (LRUCache (PolicyID StandardCrypto, AssetName) DB.MultiAssetId))
@@ -89,7 +93,7 @@ data CacheStatistics = CacheStatistics
 
 -- CacheCapacity is used to define capacities for different types of cache entries.
 data CacheCapacity = CacheCapacity
-  { cacheCapacityStakeHashRaw :: !Word64
+  { cacheCapacityStake :: !Word64
   , cacheCapacityDatum :: !Word64
   , cacheCapacityMultiAsset :: !Word64
   , cacheCapacityTx :: !Word64
@@ -118,7 +122,7 @@ textShowStats :: CacheStatus -> IO Text
 textShowStats NoCache = pure "NoCache"
 textShowStats (ActiveCache ic) = do
   stats <- readTVarIO $ cStats ic
-  stakeHashRaws <- readTVarIO (cStakeRawHashes ic)
+  stakeHashRaws <- readTVarIO (cStake ic)
   pools <- readTVarIO (cPools ic)
   datums <- readTVarIO (cDatum ic)
   mAssets <- readTVarIO (cMultiAssets ic)
@@ -127,8 +131,10 @@ textShowStats (ActiveCache ic) = do
     mconcat
       [ "\nCache Statistics:"
       , "\n  Stake Addresses: "
-      , "cache size: "
-      , textShow (LRU.getCapacity stakeHashRaws)
+      , "cache sizes: "
+      , textShow (Map.size $ scStableCache stakeHashRaws)
+      , " and "
+      , textShow (LRU.getSize $ scLruCache stakeHashRaws)
       , if credsQueries stats == 0
           then ""
           else ", hit rate: " <> textShow (100 * credsHits stats `div` credsQueries stats) <> "%"
@@ -197,7 +203,7 @@ useNoCache = NoCache
 
 newEmptyCache :: MonadIO m => CacheCapacity -> m CacheStatus
 newEmptyCache CacheCapacity {..} = liftIO $ do
-  cStakeRawHashes <- newTVarIO (LRU.empty cacheCapacityStakeHashRaw)
+  cStake <- newTVarIO (StakeCache Map.empty (LRU.empty cacheCapacityStake))
   cPools <- newTVarIO Map.empty
   cDatum <- newTVarIO (LRU.empty cacheCapacityDatum)
   cMultiAssets <- newTVarIO (LRU.empty cacheCapacityMultiAsset)
@@ -208,7 +214,7 @@ newEmptyCache CacheCapacity {..} = liftIO $ do
 
   pure . ActiveCache $
     CacheInternal
-      { cStakeRawHashes = cStakeRawHashes
+      { cStake = cStake
       , cPools = cPools
       , cDatum = cDatum
       , cMultiAssets = cMultiAssets
@@ -223,7 +229,3 @@ initCacheStatistics = CacheStatistics 0 0 0 0 0 0 0 0 0 0 0 0
 
 initCacheEpoch :: CacheEpoch
 initCacheEpoch = CacheEpoch mempty Nothing
-
-isCacheActionUpdate :: CacheAction -> Bool
-isCacheActionUpdate UpdateCache = True
-isCacheActionUpdate _other = False

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

@@ -504,7 +504,7 @@ queryLatestPoints = do
     pure (blk ^. BlockSlotNo, blk ^. BlockHash)
   pure $ fmap unValue2 res
 
--- This is an expensive query, but it is only used once when initiating the cStakeRawHashes LRU cache.
+-- This is an expensive query, but it is only used once when initiating the cStake LRU cache.
 -- The idea being to get a list of current registered stake addresses using rewards.
 queryAddressWithReward :: MonadIO m => Int -> ReaderT SqlBackend m [(ByteString, StakeAddressId)]
 queryAddressWithReward limitNumber = do