@@ -30,7 +30,7 @@ import Cardano.BM.Trace
30
30
import qualified Cardano.Db as DB
31
31
import Cardano.DbSync.Cache.Epoch (rollbackMapEpochInCache )
32
32
import qualified Cardano.DbSync.Cache.LRU as LRU
33
- import Cardano.DbSync.Cache.Types (Cache (.. ), CacheInternal (.. ), CacheNew (.. ), CacheStatistics (.. ), StakeAddrCache , initCacheStatistics )
33
+ import Cardano.DbSync.Cache.Types (CacheInternal (.. ), CacheNew (.. ), CacheStatistics (.. ), CacheStatus (.. ), StakeAddrCache , initCacheStatistics )
34
34
import qualified Cardano.DbSync.Era.Shelley.Generic.Util as Generic
35
35
import Cardano.DbSync.Era.Shelley.Query
36
36
import Cardano.DbSync.Era.Util
@@ -67,41 +67,41 @@ import Ouroboros.Consensus.Cardano.Block (StandardCrypto)
67
67
-- NOTE: BlockId is cleaned up on rollbacks, since it may get reinserted on
68
68
-- a different id.
69
69
-- NOTE: Other tables are not cleaned up since they are not rollbacked.
70
- rollbackCache :: MonadIO m => Cache -> DB. BlockId -> ReaderT SqlBackend m ()
71
- rollbackCache UninitiatedCache _ = pure ()
72
- rollbackCache (Cache cache) blockId = do
70
+ rollbackCache :: MonadIO m => CacheStatus -> DB. BlockId -> ReaderT SqlBackend m ()
71
+ rollbackCache NoCache _ = pure ()
72
+ rollbackCache (ActiveCache cache) blockId = do
73
73
liftIO $ do
74
74
atomically $ writeTVar (cPrevBlock cache) Nothing
75
75
atomically $ modifyTVar (cDatum cache) LRU. cleanup
76
76
void $ rollbackMapEpochInCache cache blockId
77
77
78
- getCacheStatistics :: Cache -> IO CacheStatistics
78
+ getCacheStatistics :: CacheStatus -> IO CacheStatistics
79
79
getCacheStatistics cs =
80
80
case cs of
81
- UninitiatedCache -> pure initCacheStatistics
82
- Cache ci -> readTVarIO (cStats ci)
81
+ NoCache -> pure initCacheStatistics
82
+ ActiveCache ci -> readTVarIO (cStats ci)
83
83
84
84
queryOrInsertRewardAccount ::
85
85
(MonadBaseControl IO m , MonadIO m ) =>
86
- Cache ->
86
+ CacheStatus ->
87
87
CacheNew ->
88
88
Ledger. RewardAccount StandardCrypto ->
89
89
ReaderT SqlBackend m DB. StakeAddressId
90
- queryOrInsertRewardAccount cache cacheNew rewardAddr = do
91
- eiAddrId <- queryRewardAccountWithCacheRetBs cache cacheNew rewardAddr
90
+ queryOrInsertRewardAccount cacheStatus cacheNew rewardAddr = do
91
+ eiAddrId <- queryRewardAccountWithCacheRetBs cacheStatus cacheNew rewardAddr
92
92
case eiAddrId of
93
93
Left (_err, bs) -> insertStakeAddress rewardAddr (Just bs)
94
94
Right addrId -> pure addrId
95
95
96
96
queryOrInsertStakeAddress ::
97
97
(MonadBaseControl IO m , MonadIO m ) =>
98
- Cache ->
98
+ CacheStatus ->
99
99
CacheNew ->
100
100
Network ->
101
101
StakeCred ->
102
102
ReaderT SqlBackend m DB. StakeAddressId
103
- queryOrInsertStakeAddress cache cacheNew nw cred =
104
- queryOrInsertRewardAccount cache cacheNew $ Ledger. RewardAccount nw cred
103
+ queryOrInsertStakeAddress cacheStatus cacheNew nw cred =
104
+ queryOrInsertRewardAccount cacheStatus cacheNew $ Ledger. RewardAccount nw cred
105
105
106
106
-- If the address already exists in the table, it will not be inserted again (due to
107
107
-- the uniqueness constraint) but the function will return the 'StakeAddressId'.
@@ -123,38 +123,38 @@ insertStakeAddress rewardAddr stakeCredBs =
123
123
queryRewardAccountWithCacheRetBs ::
124
124
forall m .
125
125
MonadIO m =>
126
- Cache ->
126
+ CacheStatus ->
127
127
CacheNew ->
128
128
Ledger. RewardAccount StandardCrypto ->
129
129
ReaderT SqlBackend m (Either (DB. LookupFail , ByteString ) DB. StakeAddressId )
130
- queryRewardAccountWithCacheRetBs cache cacheNew rwdAcc =
131
- queryStakeAddrWithCacheRetBs cache cacheNew (Ledger. raNetwork rwdAcc) (Ledger. raCredential rwdAcc)
130
+ queryRewardAccountWithCacheRetBs cacheStatus cacheNew rwdAcc =
131
+ queryStakeAddrWithCacheRetBs cacheStatus cacheNew (Ledger. raNetwork rwdAcc) (Ledger. raCredential rwdAcc)
132
132
133
133
queryStakeAddrWithCache ::
134
134
forall m .
135
135
MonadIO m =>
136
- Cache ->
136
+ CacheStatus ->
137
137
CacheNew ->
138
138
Network ->
139
139
StakeCred ->
140
140
ReaderT SqlBackend m (Either DB. LookupFail DB. StakeAddressId )
141
- queryStakeAddrWithCache cache cacheNew nw cred =
142
- mapLeft fst <$> queryStakeAddrWithCacheRetBs cache cacheNew nw cred
141
+ queryStakeAddrWithCache cacheStatus cacheNew nw cred =
142
+ mapLeft fst <$> queryStakeAddrWithCacheRetBs cacheStatus cacheNew nw cred
143
143
144
144
queryStakeAddrWithCacheRetBs ::
145
145
forall m .
146
146
MonadIO m =>
147
- Cache ->
147
+ CacheStatus ->
148
148
CacheNew ->
149
149
Network ->
150
150
StakeCred ->
151
151
ReaderT SqlBackend m (Either (DB. LookupFail , ByteString ) DB. StakeAddressId )
152
- queryStakeAddrWithCacheRetBs cache cacheNew nw cred = do
153
- case cache of
154
- UninitiatedCache -> do
152
+ queryStakeAddrWithCacheRetBs cacheStatus cacheNew nw cred = do
153
+ case cacheStatus of
154
+ NoCache -> do
155
155
let ! bs = Ledger. serialiseRewardAccount (Ledger. RewardAccount nw cred)
156
156
mapLeft (,bs) <$> queryStakeAddress bs
157
- Cache ci -> do
157
+ ActiveCache ci -> do
158
158
mp <- liftIO $ readTVarIO (cStakeCreds ci)
159
159
(mAddrId, mp') <- queryStakeAddrAux cacheNew mp (cStats ci) nw cred
160
160
liftIO $ atomically $ writeTVar (cStakeCreds ci) mp'
@@ -186,18 +186,18 @@ queryStakeAddrAux cacheNew mp sts nw cred =
186
186
187
187
queryPoolKeyWithCache ::
188
188
MonadIO m =>
189
- Cache ->
189
+ CacheStatus ->
190
190
CacheNew ->
191
191
PoolKeyHash ->
192
192
ReaderT SqlBackend m (Either DB. LookupFail DB. PoolHashId )
193
- queryPoolKeyWithCache cache cacheNew hsh =
194
- case cache of
195
- UninitiatedCache -> do
193
+ queryPoolKeyWithCache cacheStatus cacheNew hsh =
194
+ case cacheStatus of
195
+ NoCache -> do
196
196
mPhId <- queryPoolHashId (Generic. unKeyHashRaw hsh)
197
197
case mPhId of
198
198
Nothing -> pure $ Left (DB. DbLookupMessage " PoolKeyHash" )
199
199
Just phId -> pure $ Right phId
200
- Cache ci -> do
200
+ ActiveCache ci -> do
201
201
mp <- liftIO $ readTVarIO (cPools ci)
202
202
case Map. lookup hsh mp of
203
203
Just phId -> do
@@ -225,19 +225,19 @@ queryPoolKeyWithCache cache cacheNew hsh =
225
225
226
226
insertPoolKeyWithCache ::
227
227
(MonadBaseControl IO m , MonadIO m ) =>
228
- Cache ->
228
+ CacheStatus ->
229
229
CacheNew ->
230
230
PoolKeyHash ->
231
231
ReaderT SqlBackend m DB. PoolHashId
232
- insertPoolKeyWithCache cache cacheNew pHash =
233
- case cache of
234
- UninitiatedCache ->
232
+ insertPoolKeyWithCache cacheStatus cacheNew pHash =
233
+ case cacheStatus of
234
+ NoCache ->
235
235
DB. insertPoolHash $
236
236
DB. PoolHash
237
237
{ DB. poolHashHashRaw = Generic. unKeyHashRaw pHash
238
238
, DB. poolHashView = Generic. unKeyHashView pHash
239
239
}
240
- Cache ci -> do
240
+ ActiveCache ci -> do
241
241
mp <- liftIO $ readTVarIO (cPools ci)
242
242
case Map. lookup pHash mp of
243
243
Just phId -> do
@@ -267,13 +267,13 @@ queryPoolKeyOrInsert ::
267
267
(MonadBaseControl IO m , MonadIO m ) =>
268
268
Text ->
269
269
Trace IO Text ->
270
- Cache ->
270
+ CacheStatus ->
271
271
CacheNew ->
272
272
Bool ->
273
273
PoolKeyHash ->
274
274
ReaderT SqlBackend m DB. PoolHashId
275
- queryPoolKeyOrInsert txt trce cache cacheNew logsWarning hsh = do
276
- pk <- queryPoolKeyWithCache cache cacheNew hsh
275
+ queryPoolKeyOrInsert txt trce cacheStatus cacheNew logsWarning hsh = do
276
+ pk <- queryPoolKeyWithCache cacheStatus cacheNew hsh
277
277
case pk of
278
278
Right poolHashId -> pure poolHashId
279
279
Left err -> do
@@ -289,21 +289,21 @@ queryPoolKeyOrInsert txt trce cache cacheNew logsWarning hsh = do
289
289
, txt
290
290
, " . We will assume that the pool exists and move on."
291
291
]
292
- insertPoolKeyWithCache cache cacheNew hsh
292
+ insertPoolKeyWithCache cacheStatus cacheNew hsh
293
293
294
294
queryMAWithCache ::
295
295
MonadIO m =>
296
- Cache ->
296
+ CacheStatus ->
297
297
PolicyID StandardCrypto ->
298
298
AssetName ->
299
299
ReaderT SqlBackend m (Either (ByteString , ByteString ) DB. MultiAssetId )
300
- queryMAWithCache cache policyId asset =
301
- case cache of
302
- UninitiatedCache -> do
300
+ queryMAWithCache cacheStatus policyId asset =
301
+ case cacheStatus of
302
+ NoCache -> do
303
303
let ! policyBs = Generic. unScriptHash $ policyID policyId
304
304
let ! assetNameBs = Generic. unAssetName asset
305
305
maybe (Left (policyBs, assetNameBs)) Right <$> DB. queryMultiAssetId policyBs assetNameBs
306
- Cache ci -> do
306
+ ActiveCache ci -> do
307
307
mp <- liftIO $ readTVarIO (cMultiAssets ci)
308
308
case LRU. lookup (policyId, asset) mp of
309
309
Just (maId, mp') -> do
@@ -323,13 +323,13 @@ queryMAWithCache cache policyId asset =
323
323
queryPrevBlockWithCache ::
324
324
MonadIO m =>
325
325
Text ->
326
- Cache ->
326
+ CacheStatus ->
327
327
ByteString ->
328
328
ExceptT SyncNodeError (ReaderT SqlBackend m ) DB. BlockId
329
- queryPrevBlockWithCache msg cache hsh =
330
- case cache of
331
- UninitiatedCache -> liftLookupFail msg $ DB. queryBlockId hsh
332
- Cache ci -> do
329
+ queryPrevBlockWithCache msg cacheStatus hsh =
330
+ case cacheStatus of
331
+ NoCache -> liftLookupFail msg $ DB. queryBlockId hsh
332
+ ActiveCache ci -> do
333
333
mCachedPrev <- liftIO $ readTVarIO (cPrevBlock ci)
334
334
case mCachedPrev of
335
335
-- if the cached block matches the requested hash, we return its db id.
@@ -351,13 +351,13 @@ queryPrevBlockWithCache msg cache hsh =
351
351
352
352
insertBlockAndCache ::
353
353
(MonadIO m , MonadBaseControl IO m ) =>
354
- Cache ->
354
+ CacheStatus ->
355
355
DB. Block ->
356
356
ReaderT SqlBackend m DB. BlockId
357
- insertBlockAndCache cache block =
358
- case cache of
359
- UninitiatedCache -> DB. insertBlock block
360
- Cache ci -> do
357
+ insertBlockAndCache cacheStatus block =
358
+ case cacheStatus of
359
+ NoCache -> DB. insertBlock block
360
+ ActiveCache ci -> do
361
361
bid <- DB. insertBlock block
362
362
liftIO $ do
363
363
missPrevBlock (cStats ci)
@@ -366,13 +366,13 @@ insertBlockAndCache cache block =
366
366
367
367
queryDatum ::
368
368
MonadIO m =>
369
- Cache ->
369
+ CacheStatus ->
370
370
DataHash ->
371
371
ReaderT SqlBackend m (Maybe DB. DatumId )
372
- queryDatum cache hsh = do
373
- case cache of
374
- UninitiatedCache -> DB. queryDatum $ Generic. dataHashToBytes hsh
375
- Cache ci -> do
372
+ queryDatum cacheStatus hsh = do
373
+ case cacheStatus of
374
+ NoCache -> DB. queryDatum $ Generic. dataHashToBytes hsh
375
+ ActiveCache ci -> do
376
376
mp <- liftIO $ readTVarIO (cDatum ci)
377
377
case LRU. lookup hsh mp of
378
378
Just (datumId, mp') -> do
@@ -387,15 +387,15 @@ queryDatum cache hsh = do
387
387
-- This assumes the entry is not cached.
388
388
insertDatumAndCache ::
389
389
(MonadIO m , MonadBaseControl IO m ) =>
390
- Cache ->
390
+ CacheStatus ->
391
391
DataHash ->
392
392
DB. Datum ->
393
393
ReaderT SqlBackend m DB. DatumId
394
- insertDatumAndCache cache hsh dt = do
394
+ insertDatumAndCache cacheStatus hsh dt = do
395
395
datumId <- DB. insertDatum dt
396
- case cache of
397
- UninitiatedCache -> pure datumId
398
- Cache ci -> do
396
+ case cacheStatus of
397
+ NoCache -> pure datumId
398
+ ActiveCache ci -> do
399
399
liftIO $
400
400
atomically $
401
401
modifyTVar (cDatum ci) $
0 commit comments