review changes to whitelists

Author: Cmdv

cardano-chain-gen/src/Cardano/Mock/Query.hs

@@ -22,7 +22,7 @@ module Cardano.Mock.Query (
 ) where
 
 import qualified Cardano.Db as Db
-import Cardano.Prelude hiding (from, isNothing)
+import Cardano.Prelude hiding (from, isNothing, on)
 import qualified Data.ByteString.Base16 as Base16
 import Data.ByteString.Short (ShortByteString, toShort)
 import Database.Esqueleto.Experimental
@@ -144,9 +144,11 @@ queryConstitutionAnchor epochNo = do
         `on` ( \(constit :& _ :& epoch) ->
                 just (constit ^. Db.ConstitutionId) ==. (epoch ^. Db.EpochStateConstitutionId)
              )
+
     where_ (epochState ^. Db.EpochStateEpochNo ==. val epochNo)
 
     pure (anchor ^. Db.VotingAnchorUrl, anchor ^. Db.VotingAnchorDataHash)
+
   pure $ bimap (Db.unVoteUrl . unValue) unValue <$> res
 
 queryRewardRests ::
@@ -156,4 +158,62 @@ queryRewardRests = do
   res <- select $ do
     reward <- from $ table @Db.RewardRest
     pure (reward ^. Db.RewardRestType, reward ^. Db.RewardRestAmount)
+
   pure $ map (bimap unValue (Db.unDbLovelace . unValue)) res
+
+queryMultiAssetMetadataPolicy :: MonadIO io => ReaderT SqlBackend io (Maybe ShortByteString)
+queryMultiAssetMetadataPolicy = do
+  res <- selectOne $ do
+    metadataPolicy <- from $ table @Db.MultiAsset
+    pure $ metadataPolicy ^. Db.MultiAssetPolicy
+  pure $ toShort . Base16.encode . unValue <$> res
+
+queryStakeAddressHashRaw :: MonadIO io => ReaderT SqlBackend io (Maybe ShortByteString)
+queryStakeAddressHashRaw = do
+  res <- selectOne $ do
+    stakeAddress <- from $ table @Db.StakeAddress
+    pure $ stakeAddress ^. Db.StakeAddressHashRaw
+  pure $ toShort . Base16.encode . unValue <$> res
+
+queryStakeAddressCount :: MonadIO io => ReaderT SqlBackend io Word
+queryStakeAddressCount = do
+  res <- selectOne $ do
+    _ <- from (table @Db.StakeAddress)
+    pure countRows
+  pure $ maybe 0 unValue res
+
+queryCollateralTxOutCount :: MonadIO io => ReaderT SqlBackend io Word
+queryCollateralTxOutCount = do
+  res <- selectOne $ do
+    _ <- from (table @Db.CollateralTxOut)
+    pure countRows
+  pure $ maybe 0 unValue res
+
+queryPoolUpdateCount :: MonadIO io => ReaderT SqlBackend io Word
+queryPoolUpdateCount = do
+  res <- selectOne $ do
+    _ <- from (table @Db.PoolUpdate)
+    pure countRows
+  pure $ maybe 0 unValue res
+
+queryStakeDeRegCount :: MonadIO io => ReaderT SqlBackend io Word
+queryStakeDeRegCount = do
+  res <- selectOne $ do
+    _ <- from (table @Db.StakeDeregistration)
+    pure countRows
+  pure $ maybe 0 unValue res
+
+queryStakeRegCount :: MonadIO io => ReaderT SqlBackend io Word
+queryStakeRegCount = do
+  res <- selectOne $ do
+    _ <- from (table @Db.StakeRegistration)
+    pure countRows
+  pure $ maybe 0 unValue res
+
+countTxOutNonNullStakeAddrIds :: (MonadIO m) => SqlPersistT m Word
+countTxOutNonNullStakeAddrIds = do
+  result <- selectOne $ do
+    txOut <- from $ table @Db.TxOut
+    where_ $ not_ (isNothing $ txOut ^. Db.TxOutStakeAddressId)
+    pure countRows
+  pure $ maybe 0 unValue result

cardano-chain-gen/test/testfiles/fingerprint/conwayConfigMetadataWhitelist

@@ -1 +1 @@
-[5,11]
+[12,16]

cardano-chain-gen/test/testfiles/fingerprint/conwayConfigMultiAssetsDisabled

@@ -1 +1 @@
-[5]
+[12]

cardano-chain-gen/test/testfiles/fingerprint/conwayConfigMultiAssetsWhitelist

@@ -1 +1 @@
-[5]
+[12]

cardano-chain-gen/test/testfiles/fingerprint/fullTxStakeAddressWhitelist

@@ -71,8 +71,8 @@ import Ouroboros.Consensus.Cardano.Block (StandardCrypto)
 -- a different id.
 -- NOTE: Other tables are not cleaned up since they are not rollbacked.
 rollbackCache :: MonadIO m => CacheStatus -> DB.BlockId -> ReaderT SqlBackend m ()
-rollbackCache UninitiatedCache _ = pure ()
-rollbackCache (Cache cache) blockId = do
+rollbackCache NoCache _ = pure ()
+rollbackCache (ActiveCache cache) blockId = do
   liftIO $ do
     atomically $ writeTVar (cPrevBlock cache) Nothing
     atomically $ modifyTVar (cDatum cache) LRU.cleanup
@@ -92,7 +92,7 @@ queryOrInsertRewardAccount ::
   Ledger.RewardAccount StandardCrypto ->
   ReaderT SqlBackend m DB.StakeAddressId
 queryOrInsertRewardAccount syncEnv cache cacheNew rewardAddr = do
-  eiAddrId <- queryRewardAccountWithCacheRetBs cache cacheNew rewardAddr
+  eiAddrId <- queryRewardAccountWithCacheRetBs syncEnv cache cacheNew rewardAddr
   case eiAddrId of
     Left (_err, bs) -> insertStakeAddress syncEnv rewardAddr (Just bs)
     Right addrId -> pure addrId
@@ -130,36 +130,37 @@ insertStakeAddress _syncEnv rewardAddr stakeCredBs = do
 queryRewardAccountWithCacheRetBs ::
   forall m.
   MonadIO m =>
-  Trace IO Text ->
+  SyncEnv ->
   CacheStatus ->
   CacheAction ->
   Ledger.RewardAccount StandardCrypto ->
   ReaderT SqlBackend m (Either (DB.LookupFail, ByteString) DB.StakeAddressId)
-queryRewardAccountWithCacheRetBs trce cache cacheUA rwdAcc =
-  queryStakeAddrWithCacheRetBs trce cache cacheUA (Ledger.raNetwork rwdAcc) (Ledger.raCredential rwdAcc)
+queryRewardAccountWithCacheRetBs syncEnv cache cacheUA rwdAcc =
+  queryStakeAddrWithCacheRetBs syncEnv cache cacheUA (Ledger.raNetwork rwdAcc) (Ledger.raCredential rwdAcc)
 
 queryStakeAddrWithCache ::
   forall m.
   MonadIO m =>
-  Trace IO Text ->
+  SyncEnv ->
   CacheStatus ->
   CacheAction ->
   Network ->
   StakeCred ->
   ReaderT SqlBackend m (Either DB.LookupFail DB.StakeAddressId)
-queryStakeAddrWithCache trce cache cacheUA nw cred =
-  mapLeft fst <$> queryStakeAddrWithCacheRetBs trce cache cacheUA nw cred
+queryStakeAddrWithCache syncEnv cache cacheUA nw cred =
+  mapLeft fst <$> queryStakeAddrWithCacheRetBs syncEnv cache cacheUA nw cred
 
 queryStakeAddrWithCacheRetBs ::
   forall m.
   MonadIO m =>
-  Trace IO Text ->
+  SyncEnv ->
   CacheStatus ->
   CacheAction ->
   Network ->
   StakeCred ->
   ReaderT SqlBackend m (Either (DB.LookupFail, ByteString) DB.StakeAddressId)
-queryStakeAddrWithCacheRetBs cache cacheUA nw cred = do
+queryStakeAddrWithCacheRetBs syncEnv cache cacheUA nw cred = do
+  let !bs = Ledger.serialiseRewardAccount (Ledger.RewardAccount nw cred)
   case cache of
     NoCache -> do
       mapLeft (,bs) <$> queryStakeAddress bs
@@ -170,10 +171,10 @@ queryStakeAddrWithCacheRetBs cache cacheUA nw cred = do
       currentCache <-
         if isNewCache
           then do
-            liftIO $ logInfo trce "Stake Raw Hashes cache is new and empty. Populating with addresses from db..."
+            liftIO $ logInfo (getTrace syncEnv) "Stake Raw Hashes cache is new and empty. Populating with addresses from db..."
             queryRes <- DB.queryAddressWithReward (fromIntegral $ LRU.getCapacity prevCache)
             liftIO $ atomically $ writeTVar (cStakeRawHashes ci) $ LRU.fromList queryRes prevCache
-            liftIO $ logInfo trce "Population of cache complete."
+            liftIO $ logInfo (getTrace syncEnv) "Population of cache complete."
             liftIO $ readTVarIO (cStakeRawHashes ci)
           else pure prevCache
 
@@ -202,12 +203,11 @@ queryStakeAddrWithCacheRetBs cache cacheUA nw cred = do
 
 queryPoolKeyWithCache ::
   MonadIO m =>
-  SyncEnv ->
   CacheStatus ->
   CacheAction ->
   PoolKeyHash ->
   ReaderT SqlBackend m (Either DB.LookupFail DB.PoolHashId)
-queryPoolKeyWithCache syncEnv cache cacheUA hsh =
+queryPoolKeyWithCache cache cacheUA hsh =
   case cache of
     NoCache -> do
       mPhId <- queryPoolHashId (Generic.unKeyHashRaw hsh)
@@ -290,13 +290,13 @@ queryPoolKeyOrInsert ::
   PoolKeyHash ->
   ReaderT SqlBackend m DB.PoolHashId
 queryPoolKeyOrInsert txt syncEnv cache cacheUA logsWarning hsh = do
-  pk <- queryPoolKeyWithCache syncEnv cache cacheUA hsh
+  pk <- queryPoolKeyWithCache cache cacheUA hsh
   case pk of
     Right poolHashId -> pure poolHashId
     Left err -> do
       when logsWarning $
         liftIO $
-          logWarning trce $
+          logWarning (getTrace syncEnv) $
             mconcat
               [ "Failed with "
               , DB.textShow err
@@ -310,7 +310,7 @@ queryPoolKeyOrInsert txt syncEnv cache cacheUA logsWarning hsh = do
 
 queryMAWithCache ::
   MonadIO m =>
-  Cache ->
+  CacheStatus ->
   PolicyID StandardCrypto ->
   AssetName ->
   ReaderT SqlBackend m (Either (ByteString, ByteString) DB.MultiAssetId)

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

@@ -8,7 +8,6 @@
 module Cardano.DbSync.Era.Shelley.Query (
   queryPoolHashId,
   queryStakeAddress,
-  queryMultipleStakeAddress,
   queryStakeRefPtr,
   resolveInputTxId,
   resolveInputTxOutId,
@@ -30,7 +29,6 @@ import Database.Esqueleto.Experimental (
   Value (..),
   desc,
   from,
-  in_,
   innerJoin,
   just,
   limit,
@@ -39,7 +37,6 @@ import Database.Esqueleto.Experimental (
   select,
   table,
   val,
-  valList,
   where_,
   (:&) ((:&)),
   (==.),
@@ -67,17 +64,6 @@ queryStakeAddress addr = do
     pure (saddr ^. StakeAddressId)
   pure $ maybeToEither (DbLookupMessage $ "StakeAddress " <> renderByteArray addr) unValue (listToMaybe res)
 
-queryMultipleStakeAddress ::
-  MonadIO m =>
-  [ByteString] ->
-  ReaderT SqlBackend m (Either LookupFail [StakeAddressId])
-queryMultipleStakeAddress addrs = do
-  res <- select $ do
-    saddr <- from $ table @StakeAddress
-    where_ (saddr ^. StakeAddressHashRaw `in_` valList addrs)
-    pure (saddr ^. StakeAddressId)
-  pure $ Right $ map unValue res
-
 resolveInputTxId :: MonadIO m => Generic.TxIn -> ReaderT SqlBackend m (Either LookupFail TxId)
 resolveInputTxId = queryTxId . Generic.txInHash
 

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Query.hs

@@ -16,7 +16,7 @@ import Cardano.DbSync.Cache (
   queryPoolKeyWithCache,
   queryStakeAddrWithCache,
  )
-import Cardano.DbSync.Cache.Types (CacheAction (..), CacheStatus)
+import Cardano.DbSync.Cache.Types (CacheAction (..))
 import qualified Cardano.DbSync.Era.Shelley.Generic.Rewards as Generic
 import Cardano.DbSync.Types (StakeCred)
 import Cardano.Ledger.BaseTypes (Network)
@@ -69,8 +69,8 @@ adjustEpochRewards syncEnv nw epochNo rwds creds = do
       ]
   forM_ eraIgnored $ \(cred, rewards) ->
     forM_ (Set.toList rewards) $ \rwd ->
-      deleteReward nw cache epochNo (cred, rwd)
-  crds <- rights <$> forM (Set.toList creds) (queryStakeAddrWithCache (envCache syncEnv) DoNotUpdateCache nw)
+      deleteReward syncEnv nw epochNo (cred, rwd)
+  crds <- rights <$> forM (Set.toList creds) (queryStakeAddrWithCache syncEnv (envCache syncEnv) DoNotUpdateCache nw)
   deleteOrphanedRewards epochNo crds
 
 deleteReward ::
@@ -81,7 +81,7 @@ deleteReward ::
   (StakeCred, Generic.Reward) ->
   ReaderT SqlBackend m ()
 deleteReward syncEnv nw epochNo (cred, rwd) = do
-  mAddrId <- queryStakeAddrWithCache cache DoNotUpdateCache nw cred
+  mAddrId <- queryStakeAddrWithCache syncEnv (envCache syncEnv) DoNotUpdateCache nw cred
   eiPoolId <- queryPoolKeyWithCache cache DoNotUpdateCache (Generic.rewardPool rwd)
   case (mAddrId, eiPoolId) of
     (Right addrId, Right poolId) -> do
@@ -91,7 +91,7 @@ deleteReward syncEnv nw epochNo (cred, rwd) = do
         where_ (rwdDb ^. Db.RewardType ==. val (Generic.rewardSource rwd))
         where_ (rwdDb ^. Db.RewardSpendableEpoch ==. val (unEpochNo epochNo))
         where_ (rwdDb ^. Db.RewardPoolId ==. val poolId)
-    _ -> pure ()
+    _other -> pure ()
   where
     cache = envCache syncEnv
 

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

@@ -17,8 +17,8 @@ import Cardano.DbSync.Api
 import Cardano.DbSync.Api.Types (InsertOptions (..), SyncEnv (..), SyncOptions (..))
 import Cardano.DbSync.Cache (insertBlockAndCache, queryPoolKeyWithCache, queryPrevBlockWithCache)
 import Cardano.DbSync.Cache.Epoch (writeEpochBlockDiffToCache)
-import Cardano.DbSync.Cache.Types (CacheStatus (..), CacheUpdateAction (..), EpochBlockDiff (..))
-import Cardano.DbSync.Config.Types (isShelleyEnabled)
+import Cardano.DbSync.Cache.Types (CacheAction (..), CacheStatus (..), EpochBlockDiff (..))
+import Cardano.DbSync.Config.Types (isShelleyModeActive)
 import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
 import Cardano.DbSync.Era.Universal.Epoch
 import Cardano.DbSync.Era.Universal.Insert.Grouped
@@ -63,7 +63,7 @@ insertBlockUniversal syncEnv shouldLog withinTwoMins withinHalfHour blk details
     pbid <- case Generic.blkPreviousHash blk of
       Nothing -> liftLookupFail (renderErrorMessage (Generic.blkEra blk)) DB.queryGenesis -- this is for networks that fork from Byron on epoch 0.
       Just pHash -> queryPrevBlockWithCache (renderErrorMessage (Generic.blkEra blk)) cache pHash
-    mPhid <- lift $ queryPoolKeyWithCache syncEnv UpdateCache $ coerceKeyRole $ Generic.blkSlotLeader blk
+    mPhid <- lift $ queryPoolKeyWithCache cache UpdateCache $ coerceKeyRole $ Generic.blkSlotLeader blk
     let epochNo = sdEpochNo details
 
     slid <- lift . DB.insertSlotLeader $ Generic.mkSlotLeader (isShelleyModeActive $ ioShelley iopts) (Generic.unKeyHashRaw $ Generic.blkSlotLeader blk) (eitherToMaybe mPhid)