Skip to content

Commit 46a3f01

Browse files
CmdvCmdv
committed
adjust cache when tip has been reached
1 parent 34bceb6 commit 46a3f01

File tree

4 files changed

+103
-109
lines changed

4 files changed

+103
-109
lines changed

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

Lines changed: 91 additions & 99 deletions
Original file line numberDiff line numberDiff line change
@@ -81,22 +81,24 @@ rollbackCache (ActiveCache _ cache) blockId = do
8181
atomically $ modifyTVar (cTxIds cache) FIFO.cleanupCache
8282
void $ rollbackMapEpochInCache cache blockId
8383

84-
-- When syncing and we're close to the tip, we can optimise the caches.
84+
-- When syncing and we get within 2 minutes of the tip, we can optimise the caches
85+
-- and set the flag to True on ActiveCache.
8586
optimiseCaches :: MonadIO m => CacheStatus -> ReaderT SqlBackend m CacheStatus
86-
optimiseCaches c@(ActiveCache isCacheOptomised cache) = do
87-
if isCacheOptomised
88-
then liftIO $ do
89-
-- empty caches not to be used anymore
90-
atomically $ modifyTVar (cTxIds cache) FIFO.cleanupCache
91-
atomically $ writeTVar (cStake cache) (StakeCache Map.empty (LRU.empty 0))
92-
atomically $ modifyTVar (cDatum cache) (LRU.optimise 0)
93-
-- empty then limit the capacity of the cache
94-
atomically $ writeTVar (cMultiAssets cache) (LRU.empty 50000)
95-
-- leaving the following caches as they are:
96-
-- cPools, cPrevBlock, Cstats, cEpoch
97-
pure c
98-
else pure c
99-
optimiseCaches c = pure c
87+
optimiseCaches cache =
88+
case cache of
89+
NoCache -> pure cache
90+
ActiveCache True _ -> pure cache
91+
ActiveCache False c -> do
92+
liftIO $ do
93+
-- empty caches not to be used anymore
94+
atomically $ modifyTVar (cTxIds c) FIFO.cleanupCache
95+
atomically $ writeTVar (cStake c) (StakeCache Map.empty (LRU.empty 0))
96+
atomically $ modifyTVar (cDatum c) (LRU.optimise 0)
97+
-- empty then limit the capacity of the cache
98+
atomically $ writeTVar (cMultiAssets c) (LRU.empty 50000)
99+
-- leaving the following caches as they are:
100+
-- cPools, cPrevBlock, Cstats, cEpoch
101+
pure $ ActiveCache True c
100102

101103
getCacheStatistics :: CacheStatus -> IO CacheStatistics
102104
getCacheStatistics cs =
@@ -169,35 +171,33 @@ queryStakeAddrWithCacheRetBs _trce cache cacheUA ra@(Ledger.RewardAccount _ cred
169171
let bs = Ledger.serialiseRewardAccount ra
170172
case cache of
171173
NoCache -> mapLeft (,bs) <$> resolveStakeAddress bs
172-
ActiveCache shouldOptomiseCache ci -> do
173-
if shouldOptomiseCache
174-
then mapLeft (,bs) <$> resolveStakeAddress bs
175-
else do
176-
stakeCache <- liftIO $ readTVarIO (cStake ci)
177-
case queryStakeCache cred stakeCache of
178-
Just (addrId, stakeCache') -> do
179-
liftIO $ hitCreds (cStats ci)
180-
case cacheUA of
181-
EvictAndUpdateCache -> do
182-
liftIO $ atomically $ writeTVar (cStake ci) $ deleteStakeCache cred stakeCache'
183-
pure $ Right addrId
184-
_other -> do
185-
liftIO $ atomically $ writeTVar (cStake ci) stakeCache'
186-
pure $ Right addrId
187-
Nothing -> do
188-
queryRes <- mapLeft (,bs) <$> resolveStakeAddress bs
189-
liftIO $ missCreds (cStats ci)
190-
case queryRes of
191-
Left _ -> pure queryRes
192-
Right stakeAddrsId -> do
193-
let !stakeCache' = case cacheUA of
194-
UpdateCache -> stakeCache {scLruCache = LRU.insert cred stakeAddrsId (scLruCache stakeCache)}
195-
UpdateCacheStrong -> stakeCache {scStableCache = Map.insert cred stakeAddrsId (scStableCache stakeCache)}
196-
_ -> stakeCache
197-
liftIO $
198-
atomically $
199-
writeTVar (cStake ci) stakeCache'
200-
pure $ Right stakeAddrsId
174+
ActiveCache True _ -> mapLeft (,bs) <$> resolveStakeAddress bs
175+
ActiveCache False ci -> do
176+
stakeCache <- liftIO $ readTVarIO (cStake ci)
177+
case queryStakeCache cred stakeCache of
178+
Just (addrId, stakeCache') -> do
179+
liftIO $ hitCreds (cStats ci)
180+
case cacheUA of
181+
EvictAndUpdateCache -> do
182+
liftIO $ atomically $ writeTVar (cStake ci) $ deleteStakeCache cred stakeCache'
183+
pure $ Right addrId
184+
_other -> do
185+
liftIO $ atomically $ writeTVar (cStake ci) stakeCache'
186+
pure $ Right addrId
187+
Nothing -> do
188+
queryRes <- mapLeft (,bs) <$> resolveStakeAddress bs
189+
liftIO $ missCreds (cStats ci)
190+
case queryRes of
191+
Left _ -> pure queryRes
192+
Right stakeAddrsId -> do
193+
let !stakeCache' = case cacheUA of
194+
UpdateCache -> stakeCache {scLruCache = LRU.insert cred stakeAddrsId (scLruCache stakeCache)}
195+
UpdateCacheStrong -> stakeCache {scStableCache = Map.insert cred stakeAddrsId (scStableCache stakeCache)}
196+
_ -> stakeCache
197+
liftIO $
198+
atomically $
199+
writeTVar (cStake ci) stakeCache'
200+
pure $ Right stakeAddrsId
201201

202202
-- | True if it was found in LRU
203203
queryStakeCache :: StakeCred -> StakeCache -> Maybe (DB.StakeAddressId, StakeCache)
@@ -327,25 +327,23 @@ queryMAWithCache ::
327327
queryMAWithCache cache policyId asset =
328328
case cache of
329329
NoCache -> queryDb
330-
ActiveCache isCacheOptomised ci -> do
331-
if isCacheOptomised
332-
then queryDb
333-
else do
334-
mp <- liftIO $ readTVarIO (cMultiAssets ci)
335-
case LRU.lookup (policyId, asset) mp of
336-
Just (maId, mp') -> do
337-
liftIO $ hitMAssets (cStats ci)
338-
liftIO $ atomically $ writeTVar (cMultiAssets ci) mp'
339-
pure $ Right maId
340-
Nothing -> do
341-
liftIO $ missMAssets (cStats ci)
342-
-- miss. The lookup doesn't change the cache on a miss.
343-
let !policyBs = Generic.unScriptHash $ policyID policyId
344-
let !assetNameBs = Generic.unAssetName asset
345-
maId <- maybe (Left (policyBs, assetNameBs)) Right <$> DB.queryMultiAssetId policyBs assetNameBs
346-
whenRight maId $
347-
liftIO . atomically . modifyTVar (cMultiAssets ci) . LRU.insert (policyId, asset)
348-
pure maId
330+
ActiveCache True _ -> queryDb
331+
ActiveCache False ci -> do
332+
mp <- liftIO $ readTVarIO (cMultiAssets ci)
333+
case LRU.lookup (policyId, asset) mp of
334+
Just (maId, mp') -> do
335+
liftIO $ hitMAssets (cStats ci)
336+
liftIO $ atomically $ writeTVar (cMultiAssets ci) mp'
337+
pure $ Right maId
338+
Nothing -> do
339+
liftIO $ missMAssets (cStats ci)
340+
-- miss. The lookup doesn't change the cache on a miss.
341+
let !policyBs = Generic.unScriptHash $ policyID policyId
342+
let !assetNameBs = Generic.unAssetName asset
343+
maId <- maybe (Left (policyBs, assetNameBs)) Right <$> DB.queryMultiAssetId policyBs assetNameBs
344+
whenRight maId $
345+
liftIO . atomically . modifyTVar (cMultiAssets ci) . LRU.insert (policyId, asset)
346+
pure maId
349347
where
350348
queryDb = do
351349
let !policyBs = Generic.unScriptHash $ policyID policyId
@@ -390,30 +388,28 @@ queryTxIdWithCache cache txIdLedger = do
390388
case cache of
391389
-- Direct database query if no cache.
392390
NoCache -> DB.queryTxId txHash
393-
ActiveCache isCacheOptomised cacheInternal -> do
394-
if isCacheOptomised
395-
then DB.queryTxId txHash
396-
else do
397-
-- Read current cache state.
398-
cacheTx <- liftIO $ readTVarIO (cTxIds cacheInternal)
399-
400-
case FIFO.lookup txIdLedger cacheTx of
401-
-- Cache hit, return the transaction ID.
402-
Just txId -> do
403-
liftIO $ hitTxIds (cStats cacheInternal)
391+
ActiveCache True _ -> DB.queryTxId txHash
392+
ActiveCache False cacheInternal -> do
393+
-- Read current cache state.
394+
cacheTx <- liftIO $ readTVarIO (cTxIds cacheInternal)
395+
396+
case FIFO.lookup txIdLedger cacheTx of
397+
-- Cache hit, return the transaction ID.
398+
Just txId -> do
399+
liftIO $ hitTxIds (cStats cacheInternal)
400+
pure $ Right txId
401+
-- Cache miss.
402+
Nothing -> do
403+
eTxId <- DB.queryTxId txHash
404+
liftIO $ missTxIds (cStats cacheInternal)
405+
case eTxId of
406+
Right txId -> do
407+
-- Update cache.
408+
liftIO $ atomically $ modifyTVar (cTxIds cacheInternal) $ FIFO.insert txIdLedger txId
409+
-- Return ID after updating cache.
404410
pure $ Right txId
405-
-- Cache miss.
406-
Nothing -> do
407-
eTxId <- DB.queryTxId txHash
408-
liftIO $ missTxIds (cStats cacheInternal)
409-
case eTxId of
410-
Right txId -> do
411-
-- Update cache.
412-
liftIO $ atomically $ modifyTVar (cTxIds cacheInternal) $ FIFO.insert txIdLedger txId
413-
-- Return ID after updating cache.
414-
pure $ Right txId
415-
-- Return lookup failure.
416-
Left _ -> pure $ Left $ DB.DbLookupTxHash txHash
411+
-- Return lookup failure.
412+
Left _ -> pure $ Left $ DB.DbLookupTxHash txHash
417413
where
418414
txHash = Generic.unTxHash txIdLedger
419415

@@ -423,13 +419,9 @@ tryUpdateCacheTx ::
423419
Ledger.TxId StandardCrypto ->
424420
DB.TxId ->
425421
m ()
426-
tryUpdateCacheTx cache ledgerTxId txId = do
427-
case cache of
428-
NoCache -> pure ()
429-
ActiveCache isCacheOptomised ci -> do
430-
if isCacheOptomised
431-
then pure ()
432-
else liftIO $ atomically $ modifyTVar (cTxIds ci) $ FIFO.insert ledgerTxId txId
422+
tryUpdateCacheTx (ActiveCache False ci) ledgerTxId txId =
423+
liftIO $ atomically $ modifyTVar (cTxIds ci) $ FIFO.insert ledgerTxId txId
424+
tryUpdateCacheTx _ _ _ = pure ()
433425

434426
insertBlockAndCache ::
435427
(MonadIO m, MonadBaseControl IO m) =>
@@ -439,8 +431,8 @@ insertBlockAndCache ::
439431
insertBlockAndCache cache block =
440432
case cache of
441433
NoCache -> DB.insertBlock block
442-
ActiveCache isCacheOptomised ci ->
443-
if isCacheOptomised
434+
ActiveCache isCacheOptimised ci ->
435+
if isCacheOptimised
444436
then DB.insertBlock block
445437
else do
446438
bid <- DB.insertBlock block
@@ -457,8 +449,8 @@ queryDatum ::
457449
queryDatum cache hsh = do
458450
case cache of
459451
NoCache -> DB.queryDatum $ Generic.dataHashToBytes hsh
460-
ActiveCache isCacheOptomised ci -> do
461-
if isCacheOptomised
452+
ActiveCache isCacheOptimised ci -> do
453+
if isCacheOptimised
462454
then DB.queryDatum $ Generic.dataHashToBytes hsh
463455
else do
464456
mp <- liftIO $ readTVarIO (cDatum ci)
@@ -483,8 +475,8 @@ insertDatumAndCache cache hsh dt = do
483475
datumId <- DB.insertDatum dt
484476
case cache of
485477
NoCache -> pure datumId
486-
ActiveCache isCacheOptomised ci -> do
487-
if isCacheOptomised
478+
ActiveCache isCacheOptimised ci -> do
479+
if isCacheOptimised
488480
then pure datumId
489481
else do
490482
liftIO $

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

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -62,11 +62,13 @@ data StakeCache = StakeCache
6262

6363
-- 'CacheStatus' enables functions in this module to be called even if the cache has not been initialized.
6464
-- This is used during genesis insertions, where the cache is not yet initiated, and when the user has disabled the cache functionality.
65+
6566
data CacheStatus
6667
= NoCache
67-
| -- | The Bool represents if we have surpassed being close to the tip of the chain.
68-
-- this is used to optimise the caches from that point onwards.
69-
ActiveCache !Bool !CacheInternal
68+
| ActiveCache
69+
!Bool
70+
-- ^ The Bool represents if we have surpassed being close to the tip of the chain.
71+
!CacheInternal
7072

7173
data CacheAction
7274
= UpdateCache
@@ -130,7 +132,7 @@ data CacheEpoch = CacheEpoch
130132

131133
textShowStats :: CacheStatus -> IO Text
132134
textShowStats NoCache = pure "NoCache"
133-
textShowStats (ActiveCache isCacheOptomised ic) = do
135+
textShowStats (ActiveCache isCacheOptimised ic) = do
134136
stats <- readTVarIO $ cStats ic
135137
stakeHashRaws <- readTVarIO (cStake ic)
136138
pools <- readTVarIO (cPools ic)
@@ -140,7 +142,7 @@ textShowStats (ActiveCache isCacheOptomised ic) = do
140142
pure $
141143
mconcat
142144
[ "\nCache Statistics:"
143-
, "\n Caches Optomised: " <> textShow isCacheOptomised
145+
, "\n Caches Optimised: " <> textShow isCacheOptimised
144146
, "\n Stake Addresses: "
145147
, "cache sizes: "
146148
, textShow (Map.size $ scStableCache stakeHashRaws)

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -65,8 +65,8 @@ insertBlockUniversal ::
6565
ApplyResult ->
6666
ReaderT SqlBackend m (Either SyncNodeError ())
6767
insertBlockUniversal syncEnv shouldLog withinTwoMins withinHalfHour blk details isMember applyResult = do
68-
-- if we're syncing within 30 mins of the tip, we optomise the caches.
69-
newCache <- if isSyncedWithinHalfHour details then optimiseCaches cache else pure cache
68+
-- if we're syncing within 2 mins of the tip, we optimise the caches.
69+
newCache <- if isSyncedWithintwoMinutes details then optimiseCaches cache else pure cache
7070
runExceptT $ do
7171
pbid <- case Generic.blkPreviousHash blk of
7272
Nothing -> liftLookupFail (renderErrorMessage (Generic.blkEra blk)) DB.queryGenesis -- this is for networks that fork from Byron on epoch 0.

‎cardano-db-sync/src/Cardano/DbSync/Util.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ module Cardano.DbSync.Util (
1414
fmap3,
1515
getSyncStatus,
1616
isSyncedWithinSeconds,
17-
isSyncedWithinHalfHour,
17+
isSyncedWithintwoMinutes,
1818
liftedLogException,
1919
logActionDuration,
2020
logException,
@@ -87,8 +87,8 @@ isSyncedWithinSeconds sd target =
8787
getSyncStatus :: SlotDetails -> SyncState
8888
getSyncStatus sd = isSyncedWithinSeconds sd 120
8989

90-
isSyncedWithinHalfHour :: SlotDetails -> Bool
91-
isSyncedWithinHalfHour sd = isSyncedWithinSeconds sd 1800 == SyncFollowing
90+
isSyncedWithintwoMinutes :: SlotDetails -> Bool
91+
isSyncedWithintwoMinutes sd = isSyncedWithinSeconds sd 120 == SyncFollowing
9292

9393
textPrettyShow :: Show a => a -> Text
9494
textPrettyShow = Text.pack . ppShow

0 commit comments

Comments
 (0)