rework shelley stake address whitelist

Signed-off-by: Cmdv <[email protected]>

Author: Cmdv

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Stake.hs

@@ -412,7 +412,7 @@ registerStakeCreds = do
 
 registerStakeCredsNoShelley :: IOManager -> [(Text, Text)] -> Assertion
 registerStakeCredsNoShelley = do
-  withCustomConfig args Nothing cfgDir testLabel $ \interpreter mockServer dbSync -> do
+  withCustomConfigAndDropDB args Nothing cfgDir testLabel $ \interpreter mockServer dbSync -> do
     startDBSync dbSync
 
     -- These should not be saved when shelley is disabled

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

@@ -30,7 +30,7 @@ where
 import Cardano.BM.Trace
 import qualified Cardano.Db as DB
 import Cardano.DbSync.Api (getTrace)
-import Cardano.DbSync.Api.Types (InsertOptions (..), SyncEnv (..), SyncOptions (..))
+import Cardano.DbSync.Api.Types (SyncEnv (..))
 import Cardano.DbSync.Cache.Epoch (rollbackMapEpochInCache)
 import qualified Cardano.DbSync.Cache.LRU as LRU
 import Cardano.DbSync.Cache.Types (CacheAction (..), CacheInternal (..), CacheStatistics (..), CacheStatus (..), initCacheStatistics, isCacheActionUpdate)
@@ -39,7 +39,6 @@ import Cardano.DbSync.Era.Shelley.Query
 import Cardano.DbSync.Era.Util
 import Cardano.DbSync.Error
 import Cardano.DbSync.Types
-import Cardano.DbSync.Util.Whitelist (shelleyInsertWhitelistCheck)
 import qualified Cardano.Ledger.Address as Ledger
 import Cardano.Ledger.BaseTypes (Network)
 import Cardano.Ledger.Mary.Value
@@ -91,21 +90,12 @@ queryOrInsertRewardAccount ::
   CacheStatus ->
   CacheAction ->
   Ledger.RewardAccount StandardCrypto ->
-  ReaderT SqlBackend m (Maybe DB.StakeAddressId)
+  ReaderT SqlBackend m DB.StakeAddressId
 queryOrInsertRewardAccount syncEnv cache cacheNew rewardAddr = do
-  if shelleyInsertWhitelistCheck (ioShelley iopts) laBs
-    then do
-      eiAddrId <- queryRewardAccountWithCacheRetBs cache cacheUA rewardAddr
-      case eiAddrId of
-        Left (_err, bs) -> insertStakeAddress syncEnv rewardAddr (Just bs)
-        Right addrId -> pure $ Just addrId
-    else pure Nothing
-  where
-    -- this is the stake address of the reward account used when whitelisting
-    !laBs = Ledger.serialiseRewardAcnt (Ledger.RewardAcnt nw cred)
-    nw = Ledger.getRwdNetwork rewardAddr
-    cred = Ledger.getRwdCred rewardAddr
-    iopts = soptInsertOptions $ envOptions syncEnv
+  eiAddrId <- queryRewardAccountWithCacheRetBs cache cacheNew rewardAddr
+  case eiAddrId of
+    Left (_err, bs) -> insertStakeAddress syncEnv rewardAddr (Just bs)
+    Right addrId -> pure addrId
 
 queryOrInsertStakeAddress ::
   (MonadBaseControl IO m, MonadIO m) =>
@@ -114,7 +104,7 @@ queryOrInsertStakeAddress ::
   CacheAction ->
   Network ->
   StakeCred ->
-  ReaderT SqlBackend m (Maybe DB.StakeAddressId)
+  ReaderT SqlBackend m DB.StakeAddressId
 queryOrInsertStakeAddress syncEnv cache cacheUA nw cred =
   queryOrInsertRewardAccount syncEnv cache cacheUA $ Ledger.RewardAccount nw cred
 
@@ -125,24 +115,18 @@ insertStakeAddress ::
   SyncEnv ->
   Ledger.RewardAccount StandardCrypto ->
   Maybe ByteString ->
-  ReaderT SqlBackend m (Maybe DB.StakeAddressId)
-insertStakeAddress syncEnv rewardAddr stakeCredBs =
-  -- check if the address is in the whitelist
-  if shelleyInsertWhitelistCheck ioptsShelley addrBs
-    then do
-      stakeAddrsId <-
-        DB.insertStakeAddress $
-          DB.StakeAddress
-            { DB.stakeAddressHashRaw = addrBs
-            , DB.stakeAddressView = Generic.renderRewardAcnt rewardAddr
-            , DB.stakeAddressScriptHash = Generic.getCredentialScriptHash $ Ledger.getRwdCred rewardAddr
-            }
-      pure $ Just stakeAddrsId
-    else pure Nothing
+  ReaderT SqlBackend m DB.StakeAddressId
+insertStakeAddress _syncEnv rewardAddr stakeCredBs = do
+  DB.insertStakeAddress $
+    DB.StakeAddress
+      { DB.stakeAddressHashRaw = addrBs
+      , DB.stakeAddressView = Generic.renderRewardAcnt rewardAddr
+      , DB.stakeAddressScriptHash = Generic.getCredentialScriptHash $ Ledger.getRwdCred rewardAddr
+      }
   where
     addrBs = fromMaybe (Ledger.serialiseRewardAcnt rewardAddr) stakeCredBs
-    ioptsShelley = ioShelley . soptInsertOptions $ envOptions syncEnv
 
+------------------------------------------------------------------------------------------------
 queryRewardAccountWithCacheRetBs ::
   forall m.
   MonadIO m =>

cardano-db-sync/src/Cardano/DbSync/Config/Types.hs

@@ -44,7 +44,7 @@ module Cardano.DbSync.Config.Types (
   isTxOutEnabled,
   hasLedger,
   shouldUseLedger,
-  isShelleyEnabled,
+  isShelleyNotDisabled,
   isMultiAssetEnabled,
   isMetadataEnabled,
   isPlutusEnabled,
@@ -325,10 +325,10 @@ shouldUseLedger LedgerDisable = False
 shouldUseLedger LedgerEnable = True
 shouldUseLedger LedgerIgnore = False
 
-isShelleyEnabled :: ShelleyInsertConfig -> Bool
-isShelleyEnabled ShelleyDisable = False
-isShelleyEnabled ShelleyEnable = True
-isShelleyEnabled (ShelleyStakeAddrs _) = True
+isShelleyNotDisabled :: ShelleyInsertConfig -> Bool
+isShelleyNotDisabled ShelleyDisable = False
+isShelleyNotDisabled ShelleyEnable = True
+isShelleyNotDisabled (ShelleyStakeAddrs _) = True
 
 isMultiAssetEnabled :: MultiAssetConfig -> Bool
 isMultiAssetEnabled MultiAssetDisable = False
@@ -463,7 +463,7 @@ instance FromJSON LedgerInsertConfig where
 instance ToJSON ShelleyInsertConfig where
   toJSON cfg =
     Aeson.object
-      [ "enable" .= isShelleyEnabled cfg
+      [ "enable" .= isShelleyNotDisabled cfg
       , "stake_addresses" .= stakeAddrs cfg
       ]
     where

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

@@ -66,7 +66,7 @@ insertBlockUniversal syncEnv shouldLog withinTwoMins withinHalfHour blk details
     mPhid <- lift $ queryPoolKeyWithCache syncEnv UpdateCache $ coerceKeyRole $ Generic.blkSlotLeader blk
     let epochNo = sdEpochNo details
 
-    slid <- lift . DB.insertSlotLeader $ Generic.mkSlotLeader (isShelleyEnabled $ ioShelley iopts) (Generic.unKeyHashRaw $ Generic.blkSlotLeader blk) (eitherToMaybe mPhid)
+    slid <- lift . DB.insertSlotLeader $ Generic.mkSlotLeader (isShelleyNotDisabled $ ioShelley iopts) (Generic.unKeyHashRaw $ Generic.blkSlotLeader blk) (eitherToMaybe mPhid)
     blkId <-
       lift . insertBlockAndCache cache $
         DB.Block

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

@@ -39,7 +39,8 @@ import Cardano.DbSync.Ledger.Event
 import Cardano.DbSync.Types
 import Cardano.DbSync.Util (whenStrictJust)
 import Cardano.DbSync.Util.Constraint (constraintNameEpochStake, constraintNameReward)
-import Cardano.Ledger.Address (RewardAccount (..))
+import Cardano.DbSync.Util.Whitelist (shelleyStakeAddrWhitelistCheck)
+import qualified Cardano.Ledger.Address as Ledger
 import Cardano.Ledger.BaseTypes (Network, unEpochInterval)
 import qualified Cardano.Ledger.BaseTypes as Ledger
 import Cardano.Ledger.Binary.Version (getVersion)
@@ -215,21 +216,23 @@ insertEpochStake syncEnv nw epochNo stakeChunk = do
       CacheStatus ->
       (StakeCred, (Shelley.Coin, PoolKeyHash)) ->
       ExceptT SyncNodeError (ReaderT SqlBackend m) (Maybe DB.EpochStake)
-    mkStake cache (saddr, (coin, pool)) = do
-      mSaId <- lift $ queryOrInsertStakeAddress syncEnv cache CacheNew nw saddr
-      poolId <- lift $ queryPoolKeyOrInsert "insertEpochStake" syncEnv cache CacheNew (isShelleyEnabled $ ioShelley iopts) pool
-      case mSaId of
-        Nothing -> pure Nothing
-        Just saId ->
-          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.
-                }
-
+    mkStake cache (saddr, (coin, pool)) =
+      -- Check if the stake address is in the shelley whitelist
+      if shelleyStakeAddrWhitelistCheck syncEnv $ Ledger.RewardAcnt nw saddr
+        then
+          ( do
+              saId <- lift $ queryOrInsertStakeAddress syncEnv cache UpdateCache nw saddr
+              poolId <- lift $ queryPoolKeyOrInsert "insertEpochStake" syncEnv cache UpdateCache (isShelleyNotDisabled $ 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
     iopts = getInsertOptions syncEnv
 
 insertRewards ::
@@ -252,11 +255,13 @@ insertRewards syncEnv nw earnedEpoch spendableEpoch cache rewardsChunk = do
       (MonadBaseControl IO m, MonadIO m) =>
       (StakeCred, Set Generic.Reward) ->
       ExceptT SyncNodeError (ReaderT SqlBackend m) [DB.Reward]
-    mkRewards (saddr, rset) = do
-      mSaId <- lift $ queryOrInsertStakeAddress syncEnv cache CacheNew nw saddr
-      case mSaId of
-        Nothing -> pure []
-        Just saId -> mapM (prepareReward saId) (Set.toList rset)
+    mkRewards (saddr, rset) =
+      -- Check if the stake address is in the shelley whitelist
+      if shelleyStakeAddrWhitelistCheck syncEnv $ Ledger.RewardAcnt nw saddr
+        then do
+          saId <- lift $ queryOrInsertStakeAddress syncEnv cache UpdateCache nw saddr
+          mapM (prepareReward saId) (Set.toList rset)
+        else pure []
 
     prepareReward ::
       (MonadBaseControl IO m, MonadIO m) =>
@@ -280,8 +285,7 @@ insertRewards syncEnv nw earnedEpoch spendableEpoch cache rewardsChunk = do
       PoolKeyHash ->
       ExceptT SyncNodeError (ReaderT SqlBackend m) DB.PoolHashId
     queryPool poolHash =
-      lift (queryPoolKeyOrInsert "insertRewards" syncEnv cache CacheNew (isShelleyEnabled $ ioShelley iopts) poolHash)
-
+      lift (queryPoolKeyOrInsert "insertRewards" syncEnv cache UpdateCache (isShelleyEnabled $ ioShelley iopts) poolHash)
     iopts = getInsertOptions syncEnv
 
 insertRewardRests ::
@@ -303,11 +307,13 @@ insertInstantRewards syncEnv nw earnedEpoch spendableEpoch cache rewardsChunk =
       (MonadBaseControl IO m, MonadIO m) =>
       (StakeCred, Set Generic.RewardRest) ->
       ExceptT SyncNodeError (ReaderT SqlBackend m) [DB.RewardRest]
-    mkRewards (saddr, rset) = do
-      mSaId <- lift $ queryOrInsertStakeAddress syncEnv cache CacheNew nw saddr
-      case mSaId of
-        Nothing -> pure []
-        Just saId -> pure $ map (prepareReward saId) (Set.toList rset)
+    mkRewards (saddr, rset) =
+      -- 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
+          pure $ map (prepareReward saId) (Set.toList rset)
+        else pure []
 
     prepareReward ::
       DB.StakeAddressId ->