Skip to content

Commit a28f1de

Browse files
CmdvCmdv
committed
adjust cache when tip has been reached
1 parent 9b0ea2a commit a28f1de

File tree

4 files changed

+131
-139
lines changed

4 files changed

+131
-139
lines changed

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

Lines changed: 119 additions & 128 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
@@ -389,47 +387,42 @@ queryTxIdWithCache ::
389387
queryTxIdWithCache cache txIdLedger = do
390388
case cache of
391389
-- Direct database query if no cache.
392-
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)
390+
NoCache -> qTxHash
391+
ActiveCache True _ -> qTxHash
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 <- qTxHash
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
415+
qTxHash = DB.queryTxId txHash
419416

420417
tryUpdateCacheTx ::
421418
MonadIO m =>
422419
CacheStatus ->
423420
Ledger.TxId StandardCrypto ->
424421
DB.TxId ->
425422
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
423+
tryUpdateCacheTx (ActiveCache False ci) ledgerTxId txId =
424+
liftIO $ atomically $ modifyTVar (cTxIds ci) $ FIFO.insert ledgerTxId txId
425+
tryUpdateCacheTx _ _ _ = pure ()
433426

434427
insertBlockAndCache ::
435428
(MonadIO m, MonadBaseControl IO m) =>
@@ -438,16 +431,16 @@ insertBlockAndCache ::
438431
ReaderT SqlBackend m DB.BlockId
439432
insertBlockAndCache cache block =
440433
case cache of
441-
NoCache -> DB.insertBlock block
442-
ActiveCache isCacheOptomised ci ->
443-
if isCacheOptomised
444-
then DB.insertBlock block
445-
else do
446-
bid <- DB.insertBlock block
447-
liftIO $ do
448-
missPrevBlock (cStats ci)
449-
atomically $ writeTVar (cPrevBlock ci) $ Just (bid, DB.blockHash block)
450-
pure bid
434+
NoCache -> insBlck
435+
ActiveCache True _ -> insBlck
436+
ActiveCache False ci -> do
437+
bid <- insBlck
438+
liftIO $ do
439+
missPrevBlock (cStats ci)
440+
atomically $ writeTVar (cPrevBlock ci) $ Just (bid, DB.blockHash block)
441+
pure bid
442+
where
443+
insBlck = DB.insertBlock block
451444

452445
queryDatum ::
453446
MonadIO m =>
@@ -456,21 +449,21 @@ queryDatum ::
456449
ReaderT SqlBackend m (Maybe DB.DatumId)
457450
queryDatum cache hsh = do
458451
case cache of
459-
NoCache -> DB.queryDatum $ Generic.dataHashToBytes hsh
460-
ActiveCache isCacheOptomised ci -> do
461-
if isCacheOptomised
462-
then DB.queryDatum $ Generic.dataHashToBytes hsh
463-
else do
464-
mp <- liftIO $ readTVarIO (cDatum ci)
465-
case LRU.lookup hsh mp of
466-
Just (datumId, mp') -> do
467-
liftIO $ hitDatum (cStats ci)
468-
liftIO $ atomically $ writeTVar (cDatum ci) mp'
469-
pure $ Just datumId
470-
Nothing -> do
471-
liftIO $ missDatum (cStats ci)
472-
-- miss. The lookup doesn't change the cache on a miss.
473-
DB.queryDatum $ Generic.dataHashToBytes hsh
452+
NoCache -> queryDtm
453+
ActiveCache True _ -> queryDtm
454+
ActiveCache False ci -> do
455+
mp <- liftIO $ readTVarIO (cDatum ci)
456+
case LRU.lookup hsh mp of
457+
Just (datumId, mp') -> do
458+
liftIO $ hitDatum (cStats ci)
459+
liftIO $ atomically $ writeTVar (cDatum ci) mp'
460+
pure $ Just datumId
461+
Nothing -> do
462+
liftIO $ missDatum (cStats ci)
463+
-- miss. The lookup doesn't change the cache on a miss.
464+
queryDtm
465+
where
466+
queryDtm = DB.queryDatum $ Generic.dataHashToBytes hsh
474467

475468
-- This assumes the entry is not cached.
476469
insertDatumAndCache ::
@@ -483,15 +476,13 @@ insertDatumAndCache cache hsh dt = do
483476
datumId <- DB.insertDatum dt
484477
case cache of
485478
NoCache -> pure datumId
486-
ActiveCache isCacheOptomised ci -> do
487-
if isCacheOptomised
488-
then pure datumId
489-
else do
490-
liftIO $
491-
atomically $
492-
modifyTVar (cDatum ci) $
493-
LRU.insert hsh datumId
494-
pure datumId
479+
ActiveCache True _ -> pure datumId
480+
ActiveCache False ci -> do
481+
liftIO $
482+
atomically $
483+
modifyTVar (cDatum ci) $
484+
LRU.insert hsh datumId
485+
pure datumId
495486

496487
-- Stakes
497488
hitCreds :: StrictTVar IO CacheStatistics -> IO ()

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

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -60,13 +60,14 @@ data StakeCache = StakeCache
6060
, scLruCache :: !(LRUCache StakeCred DB.StakeAddressId)
6161
}
6262

63-
-- 'CacheStatus' enables functions in this module to be called even if the cache has not been initialized.
63+
-- | '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.
6565
data CacheStatus
6666
= 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
67+
| ActiveCache
68+
!Bool
69+
-- ^ The Bool represents if we have surpassed being close to the tip of the chain.
70+
!CacheInternal
7071

7172
data CacheAction
7273
= UpdateCache
@@ -130,7 +131,7 @@ data CacheEpoch = CacheEpoch
130131

131132
textShowStats :: CacheStatus -> IO Text
132133
textShowStats NoCache = pure "NoCache"
133-
textShowStats (ActiveCache isCacheOptomised ic) = do
134+
textShowStats (ActiveCache isCacheOptimised ic) = do
134135
stats <- readTVarIO $ cStats ic
135136
stakeHashRaws <- readTVarIO (cStake ic)
136137
pools <- readTVarIO (cPools ic)
@@ -140,7 +141,7 @@ textShowStats (ActiveCache isCacheOptomised ic) = do
140141
pure $
141142
mconcat
142143
[ "\nCache Statistics:"
143-
, "\n Caches Optomised: " <> textShow isCacheOptomised
144+
, "\n Caches Optimised: " <> textShow isCacheOptimised
144145
, "\n Stake Addresses: "
145146
, "cache sizes: "
146147
, 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)