review changes to whitelists

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

@@ -20,7 +20,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

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

@@ -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
@@ -193,12 +193,11 @@ queryStakeAddrAux cacheUA mp sts nw cred =
 
 queryPoolKeyWithCache ::
   MonadIO m =>
-  SyncEnv ->
   CacheStatus ->
   CacheUpdateAction ->
   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)
@@ -281,13 +280,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
@@ -301,7 +300,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/Era/Shelley/Query.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/Universal/Adjust.hs

@@ -16,7 +16,7 @@ import Cardano.DbSync.Cache (
   queryPoolKeyWithCache,
   queryStakeAddrWithCache,
  )
-import Cardano.DbSync.Cache.Types (CacheStatus, CacheUpdateAction (..))
+import Cardano.DbSync.Cache.Types (CacheUpdateAction (..))
 import qualified Cardano.DbSync.Era.Shelley.Generic.Rewards as Generic
 import Cardano.DbSync.Types (StakeCred)
 import Cardano.Ledger.BaseTypes (Network)
@@ -69,7 +69,7 @@ adjustEpochRewards syncEnv nw epochNo rwds creds = do
       ]
   forM_ eraIgnored $ \(cred, rewards) ->
     forM_ (Set.toList rewards) $ \rwd ->
-      deleteReward nw cache epochNo (cred, rwd)
+      deleteReward syncEnv nw epochNo (cred, rwd)
   crds <- rights <$> forM (Set.toList creds) (queryStakeAddrWithCache (envCache syncEnv) DoNotUpdateCache nw)
   deleteOrphanedRewards epochNo crds
 

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

@@ -18,7 +18,7 @@ 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.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,12 +63,12 @@ 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)
     blkId <-
-      lift . insertBlockAndCache cacheStatus $
+      lift . insertBlockAndCache cache $
         DB.Block
           { DB.blockHash = Generic.blkHash blk
           , DB.blockEpochNo = Just $ unEpochNo epochNo
@@ -99,7 +99,7 @@ insertBlockUniversal syncEnv shouldLog withinTwoMins withinHalfHour blk details
     when (soptEpochAndCacheEnabled $ envOptions syncEnv)
       . newExceptT
       $ writeEpochBlockDiffToCache
-        cacheStatus
+        cache
         EpochBlockDiff
           { ebdBlockId = blkId
           , ebdTime = sdSlotTime details
@@ -176,5 +176,5 @@ insertBlockUniversal syncEnv shouldLog withinTwoMins withinHalfHour blk details
     tracer :: Trace IO Text
     tracer = getTrace syncEnv
 
-    cacheStatus :: CacheStatus
-    cacheStatus = envCache syncEnv
+    cache :: CacheStatus
+    cache = envCache syncEnv

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

@@ -28,7 +28,6 @@ import Cardano.DbSync.Api
 import Cardano.DbSync.Api.Types (InsertOptions (..), SyncEnv (..))
 import Cardano.DbSync.Cache (queryOrInsertStakeAddress, queryPoolKeyOrInsert)
 import Cardano.DbSync.Cache.Types (CacheStatus, CacheUpdateAction (..))
-import Cardano.DbSync.Era.Conway.Insert.GovAction (insertCostModel, insertDrepDistr, updateEnacted)
 import Cardano.DbSync.Config.Types (isShelleyModeActive)
 import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
 import Cardano.DbSync.Era.Universal.Insert.Certificate (insertPots)
@@ -37,7 +36,7 @@ import Cardano.DbSync.Era.Universal.Insert.Other (toDouble)
 import Cardano.DbSync.Error
 import Cardano.DbSync.Ledger.Event
 import Cardano.DbSync.Types
-import Cardano.DbSync.Util (whenStrictJust)
+import Cardano.DbSync.Util (whenFalseEmpty, whenStrictJust)
 import Cardano.DbSync.Util.Constraint (constraintNameEpochStake, constraintNameReward)
 import Cardano.DbSync.Util.Whitelist (shelleyStakeAddrWhitelistCheck)
 import qualified Cardano.Ledger.Address as Ledger
@@ -63,6 +62,7 @@ import Database.Persist.Sql (SqlBackend)
 --------------------------------------------------------------------------------------------
 insertOnNewEpoch ::
   (MonadBaseControl IO m, MonadIO m) =>
+  SyncEnv ->
   DB.BlockId ->
   SlotNo ->
   EpochNo ->
@@ -78,12 +78,12 @@ insertOnNewEpoch syncEnv blkId slotNo epochNo newEpoch = do
     lift $ insertDrepDistr epochNo drepSnapshot
     updateRatified syncEnv epochNo (toList $ rsEnacted ratifyState)
     updateExpired syncEnv epochNo (toList $ rsExpired ratifyState)
-  whenStrictJust (Generic.neEnacted newEpoch) $ \enactedSt ->
-    when (ioGov iopts) $
-      updateEnacted syncEnv epochNo enactedSt
+  whenStrictJust (Generic.neEnacted newEpoch) $ \enactedSt -> do
+    when (ioGov iopts) $ do
+      insertUpdateEnacted syncEnv blkId epochNo enactedSt
   where
     epochUpdate :: Generic.EpochUpdate
-    epochUpdate = Generic.neEpochUpdate newEpoc
+    epochUpdate = Generic.neEpochUpdate newEpoch
     tracer = getTrace syncEnv
     iopts = getInsertOptions syncEnv
 
@@ -204,7 +204,7 @@ insertEpochStake ::
   [(StakeCred, (Shelley.Coin, PoolKeyHash))] ->
   ExceptT SyncNodeError (ReaderT SqlBackend m) ()
 insertEpochStake syncEnv nw epochNo stakeChunk = do
-  let cacheStatus = envCache syncEnv
+  let cache = envCache syncEnv
   DB.ManualDbConstraints {..} <- liftIO $ readTVarIO $ envDbConstraints syncEnv
   dbStakes <- mapMaybeM (mkStake cache) stakeChunk
   let chunckDbStakes = splittRecordsEvery 100000 dbStakes
@@ -217,22 +217,21 @@ insertEpochStake syncEnv nw epochNo stakeChunk = do
       (StakeCred, (Shelley.Coin, PoolKeyHash)) ->
       ExceptT SyncNodeError (ReaderT SqlBackend m) (Maybe DB.EpochStake)
     mkStake cache (saddr, (coin, pool)) =
-      -- Check if the stake address is in the shelley whitelist
-      if shelleyStakeAddrWhitelistCheck syncEnv $ Ledger.RewardAccount nw saddr
-        then
-          ( do
-              saId <- lift $ queryOrInsertStakeAddress syncEnv cache UpdateCache nw saddr
-              poolId <- lift $ queryPoolKeyOrInsert "insertEpochStake" syncEnv cache UpdateCache (isShelleyModeActive $ ioShelley iopts) pool
-              pure $
-                Just $
-                  DB.EpochStake
-                    { DB.epochStakeAddrId = saId
-                    , DB.epochStakePoolId = poolId
-                    , DB.epochStakeAmount = Generic.coinToDbLovelace coin
-                    , DB.epochStakeEpochNo = unEpochNo epochNo -- The epoch where this delegation becomes valid.
-                    }
-          )
-        else pure Nothing
+      whenFalseEmpty
+        (shelleyStakeAddrWhitelistCheck syncEnv $ Ledger.RewardAccount nw saddr)
+        Nothing
+        ( do
+            saId <- lift $ queryOrInsertStakeAddress syncEnv cache UpdateCache nw saddr
+            poolId <- lift $ queryPoolKeyOrInsert "insertEpochStake" syncEnv cache UpdateCache (isShelleyModeActive $ ioShelley iopts) pool
+            pure $
+              Just $
+                DB.EpochStake
+                  { DB.epochStakeAddrId = saId
+                  , DB.epochStakePoolId = poolId
+                  , DB.epochStakeAmount = Generic.coinToDbLovelace coin
+                  , DB.epochStakeEpochNo = unEpochNo epochNo -- The epoch where this delegation becomes valid.
+                  }
+        )
     iopts = getInsertOptions syncEnv
 
 insertRewards ::
@@ -244,7 +243,7 @@ insertRewards ::
   CacheStatus ->
   [(StakeCred, Set Generic.Reward)] ->
   ExceptT SyncNodeError (ReaderT SqlBackend m) ()
-insertRewards syncEnv nw earnedEpoch spendableEpoch cacheStatus rewardsChunk = do
+insertRewards syncEnv nw earnedEpoch spendableEpoch cache rewardsChunk = do
   DB.ManualDbConstraints {..} <- liftIO $ readTVarIO $ envDbConstraints syncEnv
   dbRewards <- concatMapM mkRewards rewardsChunk
   let chunckDbRewards = splittRecordsEvery 100000 dbRewards
@@ -255,7 +254,7 @@ insertRewards syncEnv nw earnedEpoch spendableEpoch cacheStatus rewardsChunk = d
       (MonadBaseControl IO m, MonadIO m) =>
       (StakeCred, Set Generic.Reward) ->
       ExceptT SyncNodeError (ReaderT SqlBackend m) [DB.Reward]
-    mkRewards (saddr, rset) =
+    mkRewards (saddr, rset) = do
       -- Check if the stake address is in the shelley whitelist
       if shelleyStakeAddrWhitelistCheck syncEnv $ Ledger.RewardAccount nw saddr
         then do
@@ -308,7 +307,7 @@ insertRewardRests syncEnv nw earnedEpoch spendableEpoch cache rewardsChunk = do
       (MonadBaseControl IO m, MonadIO m) =>
       (StakeCred, Set Generic.RewardRest) ->
       ExceptT SyncNodeError (ReaderT SqlBackend m) [DB.RewardRest]
-    mkRewards (saddr, rset) =
+    mkRewards (saddr, rset) = do
       -- Check if the stake address is in the shelley whitelist
       if shelleyStakeAddrWhitelistCheck syncEnv $ Ledger.RewardAccount nw saddr
         then do

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

@@ -15,7 +15,7 @@ import Cardano.BM.Trace (Trace, logError, logInfo)
 import qualified Cardano.Db as DB
 import Cardano.DbSync.Api
 import Cardano.DbSync.Api.Types (SyncEnv (envBackend))
-import Cardano.DbSync.Cache.Types (CacheStatus (..), useNoCache)
+import Cardano.DbSync.Cache.Types (useNoCache)
 import qualified Cardano.DbSync.Era.Shelley.Generic.Util as Generic
 import Cardano.DbSync.Era.Universal.Insert.Certificate (
   insertDelegation,
@@ -157,7 +157,7 @@ insertValidateGenesisDist syncEnv networkName cfg shelleyInitiation = do
                 "Initial genesis distribution populated. Hash "
                   <> renderByteArray (configGenesisHash cfg)
               when hasStakes $
-                insertStaking syncEnv useNoCache bid cfg
+                insertStaking syncEnv bid cfg
               supply <- lift DB.queryTotalSupply
               liftIO $ logInfo tracer ("Total genesis supply of Ada: " <> DB.renderAda supply)
 
@@ -297,7 +297,7 @@ insertStaking syncEnv blkId genesis = do
   forM_ stakes $ \(n, (keyStaking, keyPool)) -> do
     -- TODO: add initial deposits for genesis stake keys.
     insertStakeRegistration syncEnv (EpochNo 0) Nothing txId (2 * n) (Generic.annotateStakingCred network (KeyHashObj keyStaking))
-    insertDelegation syncEnv UninitiatedCache network (EpochNo 0) 0 txId (2 * n + 1) Nothing (KeyHashObj keyStaking) keyPool
+    insertDelegation syncEnv useNoCache network (EpochNo 0) 0 txId (2 * n + 1) Nothing (KeyHashObj keyStaking) keyPool
 
 -- -----------------------------------------------------------------------------
 

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

@@ -203,7 +203,7 @@ insertMirCert syncEnv network txId idx mcert = do
     insertMirReserves (cred, dcoin) =
       -- Check if the stake address is in the shelley whitelist
       when (shelleyStakeAddrWhitelistCheck syncEnv $ Ledger.RewardAccount network cred) $ do
-        addrId <- lift $ queryOrInsertStakeAddress syncEnv (envCache syncEnv) CacheNew network cred
+        addrId <- lift $ queryOrInsertStakeAddress syncEnv (envCache syncEnv) UpdateCache network cred
         void . lift . DB.insertReserve $
           DB.Reserve
             { DB.reserveAddrId = addrId
@@ -219,7 +219,7 @@ insertMirCert syncEnv network txId idx mcert = do
     insertMirTreasury (cred, dcoin) =
       -- Check if the stake address is in the shelley whitelist
       when (shelleyStakeAddrWhitelistCheck syncEnv $ Ledger.RewardAccount network cred) $ do
-        addrId <- lift $ queryOrInsertStakeAddress syncEnv (envCache syncEnv) CacheNew network cred
+        addrId <- lift $ queryOrInsertStakeAddress syncEnv (envCache syncEnv) UpdateCache network cred
         void . lift . DB.insertTreasury $
           DB.Treasury
             { DB.treasuryAddrId = addrId
@@ -339,7 +339,7 @@ insertStakeDeregistration ::
 insertStakeDeregistration syncEnv network epochNo txId idx mRedeemerId cred = do
   -- Check if the stake address is in the  shelley whitelist
   when (shelleyCustomStakeWhitelistCheck syncEnv $ Ledger.RewardAccount network cred) $ do
-    scId <- lift $ queryOrInsertStakeAddress syncEnv (envCache syncEnv) EvictAndReturn network cred
+    scId <- lift $ queryOrInsertStakeAddress syncEnv (envCache syncEnv) EvictAndUpdateCache network cred
     void . lift . DB.insertStakeDeregistration $
       DB.StakeDeregistration
         { DB.stakeDeregistrationAddrId = scId
@@ -432,8 +432,8 @@ insertDelegation ::
 insertDelegation syncEnv cache network (EpochNo epoch) slotNo txId idx mRedeemerId cred poolkh =
   -- Check if the stake address is in the shelley whitelist
   when (shelleyCustomStakeWhitelistCheck syncEnv $ Ledger.RewardAccount network cred) $ do
-    addrId <- lift $ queryOrInsertStakeAddress syncEnv cache CacheNew network cred
-    poolHashId <- lift $ queryPoolKeyOrInsert "insertDelegation" syncEnv cache CacheNew True poolkh
+    addrId <- lift $ queryOrInsertStakeAddress syncEnv cache UpdateCache network cred
+    poolHashId <- lift $ queryPoolKeyOrInsert "insertDelegation" syncEnv cache UpdateCache True poolkh
     void . lift . DB.insertDelegation $
       DB.Delegation
         { DB.delegationAddrId = addrId