Skip to content

Commit 37b3270

Browse files
CmdvCmdv
committed
review changes to whitelists
1 parent 92ab49f commit 37b3270

File tree

14 files changed

+217
-164
lines changed

14 files changed

+217
-164
lines changed

Diff for: ‎cardano-chain-gen/src/Cardano/Mock/Query.hs

+61-1
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ module Cardano.Mock.Query (
2222
) where
2323

2424
import qualified Cardano.Db as Db
25-
import Cardano.Prelude hiding (from, isNothing)
25+
import Cardano.Prelude hiding (from, isNothing, on)
2626
import qualified Data.ByteString.Base16 as Base16
2727
import Data.ByteString.Short (ShortByteString, toShort)
2828
import Database.Esqueleto.Experimental
@@ -144,9 +144,11 @@ queryConstitutionAnchor epochNo = do
144144
`on` ( \(constit :& _ :& epoch) ->
145145
just (constit ^. Db.ConstitutionId) ==. (epoch ^. Db.EpochStateConstitutionId)
146146
)
147+
147148
where_ (epochState ^. Db.EpochStateEpochNo ==. val epochNo)
148149

149150
pure (anchor ^. Db.VotingAnchorUrl, anchor ^. Db.VotingAnchorDataHash)
151+
150152
pure $ bimap (Db.unVoteUrl . unValue) unValue <$> res
151153

152154
queryRewardRests ::
@@ -156,4 +158,62 @@ queryRewardRests = do
156158
res <- select $ do
157159
reward <- from $ table @Db.RewardRest
158160
pure (reward ^. Db.RewardRestType, reward ^. Db.RewardRestAmount)
161+
159162
pure $ map (bimap unValue (Db.unDbLovelace . unValue)) res
163+
164+
queryMultiAssetMetadataPolicy :: MonadIO io => ReaderT SqlBackend io (Maybe ShortByteString)
165+
queryMultiAssetMetadataPolicy = do
166+
res <- selectOne $ do
167+
metadataPolicy <- from $ table @Db.MultiAsset
168+
pure $ metadataPolicy ^. Db.MultiAssetPolicy
169+
pure $ toShort . Base16.encode . unValue <$> res
170+
171+
queryStakeAddressHashRaw :: MonadIO io => ReaderT SqlBackend io (Maybe ShortByteString)
172+
queryStakeAddressHashRaw = do
173+
res <- selectOne $ do
174+
stakeAddress <- from $ table @Db.StakeAddress
175+
pure $ stakeAddress ^. Db.StakeAddressHashRaw
176+
pure $ toShort . Base16.encode . unValue <$> res
177+
178+
queryStakeAddressCount :: MonadIO io => ReaderT SqlBackend io Word
179+
queryStakeAddressCount = do
180+
res <- selectOne $ do
181+
_ <- from (table @Db.StakeAddress)
182+
pure countRows
183+
pure $ maybe 0 unValue res
184+
185+
queryCollateralTxOutCount :: MonadIO io => ReaderT SqlBackend io Word
186+
queryCollateralTxOutCount = do
187+
res <- selectOne $ do
188+
_ <- from (table @Db.CollateralTxOut)
189+
pure countRows
190+
pure $ maybe 0 unValue res
191+
192+
queryPoolUpdateCount :: MonadIO io => ReaderT SqlBackend io Word
193+
queryPoolUpdateCount = do
194+
res <- selectOne $ do
195+
_ <- from (table @Db.PoolUpdate)
196+
pure countRows
197+
pure $ maybe 0 unValue res
198+
199+
queryStakeDeRegCount :: MonadIO io => ReaderT SqlBackend io Word
200+
queryStakeDeRegCount = do
201+
res <- selectOne $ do
202+
_ <- from (table @Db.StakeDeregistration)
203+
pure countRows
204+
pure $ maybe 0 unValue res
205+
206+
queryStakeRegCount :: MonadIO io => ReaderT SqlBackend io Word
207+
queryStakeRegCount = do
208+
res <- selectOne $ do
209+
_ <- from (table @Db.StakeRegistration)
210+
pure countRows
211+
pure $ maybe 0 unValue res
212+
213+
countTxOutNonNullStakeAddrIds :: (MonadIO m) => SqlPersistT m Word
214+
countTxOutNonNullStakeAddrIds = do
215+
result <- selectOne $ do
216+
txOut <- from $ table @Db.TxOut
217+
where_ $ not_ (isNothing $ txOut ^. Db.TxOutStakeAddressId)
218+
pure countRows
219+
pure $ maybe 0 unValue result

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

+18-18
Original file line numberDiff line numberDiff line change
@@ -71,8 +71,8 @@ import Ouroboros.Consensus.Cardano.Block (StandardCrypto)
7171
-- a different id.
7272
-- NOTE: Other tables are not cleaned up since they are not rollbacked.
7373
rollbackCache :: MonadIO m => CacheStatus -> DB.BlockId -> ReaderT SqlBackend m ()
74-
rollbackCache UninitiatedCache _ = pure ()
75-
rollbackCache (Cache cache) blockId = do
74+
rollbackCache NoCache _ = pure ()
75+
rollbackCache (ActiveCache cache) blockId = do
7676
liftIO $ do
7777
atomically $ writeTVar (cPrevBlock cache) Nothing
7878
atomically $ modifyTVar (cDatum cache) LRU.cleanup
@@ -92,7 +92,7 @@ queryOrInsertRewardAccount ::
9292
Ledger.RewardAccount StandardCrypto ->
9393
ReaderT SqlBackend m DB.StakeAddressId
9494
queryOrInsertRewardAccount syncEnv cache cacheNew rewardAddr = do
95-
eiAddrId <- queryRewardAccountWithCacheRetBs cache cacheNew rewardAddr
95+
eiAddrId <- queryRewardAccountWithCacheRetBs syncEnv cache cacheNew rewardAddr
9696
case eiAddrId of
9797
Left (_err, bs) -> insertStakeAddress syncEnv rewardAddr (Just bs)
9898
Right addrId -> pure addrId
@@ -130,36 +130,37 @@ insertStakeAddress _syncEnv rewardAddr stakeCredBs = do
130130
queryRewardAccountWithCacheRetBs ::
131131
forall m.
132132
MonadIO m =>
133-
Trace IO Text ->
133+
SyncEnv ->
134134
CacheStatus ->
135135
CacheAction ->
136136
Ledger.RewardAccount StandardCrypto ->
137137
ReaderT SqlBackend m (Either (DB.LookupFail, ByteString) DB.StakeAddressId)
138-
queryRewardAccountWithCacheRetBs trce cache cacheUA rwdAcc =
139-
queryStakeAddrWithCacheRetBs trce cache cacheUA (Ledger.raNetwork rwdAcc) (Ledger.raCredential rwdAcc)
138+
queryRewardAccountWithCacheRetBs syncEnv cache cacheUA rwdAcc =
139+
queryStakeAddrWithCacheRetBs syncEnv cache cacheUA (Ledger.raNetwork rwdAcc) (Ledger.raCredential rwdAcc)
140140

141141
queryStakeAddrWithCache ::
142142
forall m.
143143
MonadIO m =>
144-
Trace IO Text ->
144+
SyncEnv ->
145145
CacheStatus ->
146146
CacheAction ->
147147
Network ->
148148
StakeCred ->
149149
ReaderT SqlBackend m (Either DB.LookupFail DB.StakeAddressId)
150-
queryStakeAddrWithCache trce cache cacheUA nw cred =
151-
mapLeft fst <$> queryStakeAddrWithCacheRetBs trce cache cacheUA nw cred
150+
queryStakeAddrWithCache syncEnv cache cacheUA nw cred =
151+
mapLeft fst <$> queryStakeAddrWithCacheRetBs syncEnv cache cacheUA nw cred
152152

153153
queryStakeAddrWithCacheRetBs ::
154154
forall m.
155155
MonadIO m =>
156-
Trace IO Text ->
156+
SyncEnv ->
157157
CacheStatus ->
158158
CacheAction ->
159159
Network ->
160160
StakeCred ->
161161
ReaderT SqlBackend m (Either (DB.LookupFail, ByteString) DB.StakeAddressId)
162-
queryStakeAddrWithCacheRetBs cache cacheUA nw cred = do
162+
queryStakeAddrWithCacheRetBs syncEnv cache cacheUA nw cred = do
163+
let !bs = Ledger.serialiseRewardAccount (Ledger.RewardAccount nw cred)
163164
case cache of
164165
NoCache -> do
165166
mapLeft (,bs) <$> queryStakeAddress bs
@@ -170,10 +171,10 @@ queryStakeAddrWithCacheRetBs cache cacheUA nw cred = do
170171
currentCache <-
171172
if isNewCache
172173
then do
173-
liftIO $ logInfo trce "Stake Raw Hashes cache is new and empty. Populating with addresses from db..."
174+
liftIO $ logInfo (getTrace syncEnv) "Stake Raw Hashes cache is new and empty. Populating with addresses from db..."
174175
queryRes <- DB.queryAddressWithReward (fromIntegral $ LRU.getCapacity prevCache)
175176
liftIO $ atomically $ writeTVar (cStakeRawHashes ci) $ LRU.fromList queryRes prevCache
176-
liftIO $ logInfo trce "Population of cache complete."
177+
liftIO $ logInfo (getTrace syncEnv) "Population of cache complete."
177178
liftIO $ readTVarIO (cStakeRawHashes ci)
178179
else pure prevCache
179180

@@ -202,12 +203,11 @@ queryStakeAddrWithCacheRetBs cache cacheUA nw cred = do
202203

203204
queryPoolKeyWithCache ::
204205
MonadIO m =>
205-
SyncEnv ->
206206
CacheStatus ->
207207
CacheAction ->
208208
PoolKeyHash ->
209209
ReaderT SqlBackend m (Either DB.LookupFail DB.PoolHashId)
210-
queryPoolKeyWithCache syncEnv cache cacheUA hsh =
210+
queryPoolKeyWithCache cache cacheUA hsh =
211211
case cache of
212212
NoCache -> do
213213
mPhId <- queryPoolHashId (Generic.unKeyHashRaw hsh)
@@ -290,13 +290,13 @@ queryPoolKeyOrInsert ::
290290
PoolKeyHash ->
291291
ReaderT SqlBackend m DB.PoolHashId
292292
queryPoolKeyOrInsert txt syncEnv cache cacheUA logsWarning hsh = do
293-
pk <- queryPoolKeyWithCache syncEnv cache cacheUA hsh
293+
pk <- queryPoolKeyWithCache cache cacheUA hsh
294294
case pk of
295295
Right poolHashId -> pure poolHashId
296296
Left err -> do
297297
when logsWarning $
298298
liftIO $
299-
logWarning trce $
299+
logWarning (getTrace syncEnv) $
300300
mconcat
301301
[ "Failed with "
302302
, DB.textShow err
@@ -310,7 +310,7 @@ queryPoolKeyOrInsert txt syncEnv cache cacheUA logsWarning hsh = do
310310

311311
queryMAWithCache ::
312312
MonadIO m =>
313-
Cache ->
313+
CacheStatus ->
314314
PolicyID StandardCrypto ->
315315
AssetName ->
316316
ReaderT SqlBackend m (Either (ByteString, ByteString) DB.MultiAssetId)

Diff for: ‎cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Query.hs

-14
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,6 @@
88
module Cardano.DbSync.Era.Shelley.Query (
99
queryPoolHashId,
1010
queryStakeAddress,
11-
queryMultipleStakeAddress,
1211
queryStakeRefPtr,
1312
resolveInputTxId,
1413
resolveInputTxOutId,
@@ -30,7 +29,6 @@ import Database.Esqueleto.Experimental (
3029
Value (..),
3130
desc,
3231
from,
33-
in_,
3432
innerJoin,
3533
just,
3634
limit,
@@ -39,7 +37,6 @@ import Database.Esqueleto.Experimental (
3937
select,
4038
table,
4139
val,
42-
valList,
4340
where_,
4441
(:&) ((:&)),
4542
(==.),
@@ -67,17 +64,6 @@ queryStakeAddress addr = do
6764
pure (saddr ^. StakeAddressId)
6865
pure $ maybeToEither (DbLookupMessage $ "StakeAddress " <> renderByteArray addr) unValue (listToMaybe res)
6966

70-
queryMultipleStakeAddress ::
71-
MonadIO m =>
72-
[ByteString] ->
73-
ReaderT SqlBackend m (Either LookupFail [StakeAddressId])
74-
queryMultipleStakeAddress addrs = do
75-
res <- select $ do
76-
saddr <- from $ table @StakeAddress
77-
where_ (saddr ^. StakeAddressHashRaw `in_` valList addrs)
78-
pure (saddr ^. StakeAddressId)
79-
pure $ Right $ map unValue res
80-
8167
resolveInputTxId :: MonadIO m => Generic.TxIn -> ReaderT SqlBackend m (Either LookupFail TxId)
8268
resolveInputTxId = queryTxId . Generic.txInHash
8369

Diff for: ‎cardano-db-sync/src/Cardano/DbSync/Era/Universal/Adjust.hs

+5-5
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@ import Cardano.DbSync.Cache (
1616
queryPoolKeyWithCache,
1717
queryStakeAddrWithCache,
1818
)
19-
import Cardano.DbSync.Cache.Types (CacheAction (..), CacheStatus)
19+
import Cardano.DbSync.Cache.Types (CacheAction (..))
2020
import qualified Cardano.DbSync.Era.Shelley.Generic.Rewards as Generic
2121
import Cardano.DbSync.Types (StakeCred)
2222
import Cardano.Ledger.BaseTypes (Network)
@@ -69,8 +69,8 @@ adjustEpochRewards syncEnv nw epochNo rwds creds = do
6969
]
7070
forM_ eraIgnored $ \(cred, rewards) ->
7171
forM_ (Set.toList rewards) $ \rwd ->
72-
deleteReward nw cache epochNo (cred, rwd)
73-
crds <- rights <$> forM (Set.toList creds) (queryStakeAddrWithCache (envCache syncEnv) DoNotUpdateCache nw)
72+
deleteReward syncEnv nw epochNo (cred, rwd)
73+
crds <- rights <$> forM (Set.toList creds) (queryStakeAddrWithCache syncEnv (envCache syncEnv) DoNotUpdateCache nw)
7474
deleteOrphanedRewards epochNo crds
7575

7676
deleteReward ::
@@ -81,7 +81,7 @@ deleteReward ::
8181
(StakeCred, Generic.Reward) ->
8282
ReaderT SqlBackend m ()
8383
deleteReward syncEnv nw epochNo (cred, rwd) = do
84-
mAddrId <- queryStakeAddrWithCache cache DoNotUpdateCache nw cred
84+
mAddrId <- queryStakeAddrWithCache syncEnv (envCache syncEnv) DoNotUpdateCache nw cred
8585
eiPoolId <- queryPoolKeyWithCache cache DoNotUpdateCache (Generic.rewardPool rwd)
8686
case (mAddrId, eiPoolId) of
8787
(Right addrId, Right poolId) -> do
@@ -91,7 +91,7 @@ deleteReward syncEnv nw epochNo (cred, rwd) = do
9191
where_ (rwdDb ^. Db.RewardType ==. val (Generic.rewardSource rwd))
9292
where_ (rwdDb ^. Db.RewardSpendableEpoch ==. val (unEpochNo epochNo))
9393
where_ (rwdDb ^. Db.RewardPoolId ==. val poolId)
94-
_ -> pure ()
94+
_other -> pure ()
9595
where
9696
cache = envCache syncEnv
9797

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

+3-3
Original file line numberDiff line numberDiff line change
@@ -17,8 +17,8 @@ import Cardano.DbSync.Api
1717
import Cardano.DbSync.Api.Types (InsertOptions (..), SyncEnv (..), SyncOptions (..))
1818
import Cardano.DbSync.Cache (insertBlockAndCache, queryPoolKeyWithCache, queryPrevBlockWithCache)
1919
import Cardano.DbSync.Cache.Epoch (writeEpochBlockDiffToCache)
20-
import Cardano.DbSync.Cache.Types (CacheStatus (..), CacheUpdateAction (..), EpochBlockDiff (..))
21-
import Cardano.DbSync.Config.Types (isShelleyEnabled)
20+
import Cardano.DbSync.Cache.Types (CacheAction (..), CacheStatus (..), EpochBlockDiff (..))
21+
import Cardano.DbSync.Config.Types (isShelleyModeActive)
2222
import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
2323
import Cardano.DbSync.Era.Universal.Epoch
2424
import Cardano.DbSync.Era.Universal.Insert.Grouped
@@ -63,7 +63,7 @@ insertBlockUniversal syncEnv shouldLog withinTwoMins withinHalfHour blk details
6363
pbid <- case Generic.blkPreviousHash blk of
6464
Nothing -> liftLookupFail (renderErrorMessage (Generic.blkEra blk)) DB.queryGenesis -- this is for networks that fork from Byron on epoch 0.
6565
Just pHash -> queryPrevBlockWithCache (renderErrorMessage (Generic.blkEra blk)) cache pHash
66-
mPhid <- lift $ queryPoolKeyWithCache syncEnv UpdateCache $ coerceKeyRole $ Generic.blkSlotLeader blk
66+
mPhid <- lift $ queryPoolKeyWithCache cache UpdateCache $ coerceKeyRole $ Generic.blkSlotLeader blk
6767
let epochNo = sdEpochNo details
6868

6969
slid <- lift . DB.insertSlotLeader $ Generic.mkSlotLeader (isShelleyModeActive $ ioShelley iopts) (Generic.unKeyHashRaw $ Generic.blkSlotLeader blk) (eitherToMaybe mPhid)

0 commit comments

Comments
 (0)