add minting policies check to isMAPoliciesInWhitelist

Author: Cmdv

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

@@ -11,15 +11,15 @@
 module Cardano.DbSync.Era.Universal.Insert.Tx (
   insertTx,
   insertTxOut,
-) where
+)
+where
 
 import Cardano.BM.Trace (Trace)
 import Cardano.Db (DbLovelace (..), DbWord64 (..))
 import qualified Cardano.Db as DB
 import Cardano.DbSync.Api
 import Cardano.DbSync.Api.Types (InsertOptions (..), SyncEnv (..))
 import Cardano.DbSync.Cache.Types (CacheStatus (..))
-
 import Cardano.DbSync.Config.Types (MetadataConfig (..), MultiAssetConfig (..), PlutusConfig (..), isPlutusModeActive, isShelleyModeActive)
 import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
 import Cardano.DbSync.Era.Shelley.Generic.Metadata (TxMetadataValue (..), metadataValueToJsonNoSchema)
@@ -124,8 +124,7 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped
   if not (Generic.txValidContract tx)
     then do
       !txOutsGrouped <- do
-        let txOuts = Generic.txOutputs tx
-        if plutusMultiAssetWhitelistCheck syncEnv txOuts
+        if plutusMultiAssetWhitelistCheck syncEnv txMints txOuts
           then mapMaybeM (insertTxOut syncEnv cache iopts (txId, txHash)) txOuts
           else pure mempty
 
@@ -137,8 +136,7 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped
       -- The following operations only happen if the script passes stage 2 validation (or the tx has
       -- no script).
       !txOutsGrouped <- do
-        let txOuts = Generic.txOutputs tx
-        if plutusMultiAssetWhitelistCheck syncEnv txOuts
+        if plutusMultiAssetWhitelistCheck syncEnv txMints txOuts
           then mapMaybeM (insertTxOut syncEnv cache iopts (txId, txHash)) txOuts
           else pure mempty
 
@@ -183,6 +181,8 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped
       let !txIns = map (prepareTxIn txId redeemers) resolvedInputs
       pure (grouped <> BlockGroupedData txIns txOutsGrouped txMetadata maTxMint resolvedFees outSum)
   where
+    txOuts = Generic.txOutputs tx
+    txMints = Generic.txMint tx
     tracer = getTrace syncEnv
     cache = envCache syncEnv
     iopts = getInsertOptions syncEnv

cardano-db-sync/src/Cardano/DbSync/Util/Whitelist.hs

@@ -9,16 +9,22 @@ import Cardano.DbSync.Error (shortBsBase16Encode)
 import qualified Cardano.Ledger.Address as Ledger
 import qualified Cardano.Ledger.Credential as Ledger
 import Cardano.Ledger.Crypto (StandardCrypto)
-import Cardano.Ledger.Mary.Value (PolicyID (..))
+import Cardano.Ledger.Mary.Value (MultiAsset (..), PolicyID (..))
 import Cardano.Prelude (NonEmpty)
 import Data.ByteString (ByteString)
 import Data.ByteString.Short (ShortByteString, toShort)
 import Data.Map (keys)
 
 -- check both whitelist but also checking plutus Maybes first
-plutusMultiAssetWhitelistCheck :: SyncEnv -> [Generic.TxOut] -> Bool
-plutusMultiAssetWhitelistCheck syncEnv txOuts =
-  isPlutusScriptHashesInWhitelist syncEnv txOuts || isMAPoliciesInWhitelist syncEnv txOuts
+plutusMultiAssetWhitelistCheck ::
+  SyncEnv ->
+  -- | TxMint
+  MultiAsset StandardCrypto ->
+  -- | TxOuts
+  [Generic.TxOut] ->
+  Bool
+plutusMultiAssetWhitelistCheck syncEnv txMints txOuts =
+  isPlutusScriptHashesInWhitelist syncEnv txOuts || isMAPoliciesInWhitelist syncEnv txMints txOuts
 
 isPlutusScriptHashesInWhitelist :: SyncEnv -> [Generic.TxOut] -> Bool
 isPlutusScriptHashesInWhitelist syncEnv txOuts = do
@@ -45,32 +51,44 @@ isSimplePlutusScriptHashInWhitelist :: SyncEnv -> ByteString -> Bool
 isSimplePlutusScriptHashInWhitelist syncEnv scriptHash = do
   case ioPlutus iopts of
     PlutusEnable -> True
-    PlutusDisable -> False
+    PlutusDisable -> True
     PlutusScripts plutusWhitelist -> toShort scriptHash `elem` plutusWhitelist
   where
     iopts = soptInsertOptions $ envOptions syncEnv
 
-isMAPoliciesInWhitelist :: SyncEnv -> [Generic.TxOut] -> Bool
-isMAPoliciesInWhitelist syncEnv txOuts = do
+isMAPoliciesInWhitelist ::
+  SyncEnv ->
+  -- | TxMint
+  MultiAsset StandardCrypto ->
+  -- | TxOuts
+  [Generic.TxOut] ->
+  Bool
+isMAPoliciesInWhitelist syncEnv (MultiAsset mintMap) txOuts = do
   let iopts = soptInsertOptions $ envOptions syncEnv
   case ioMultiAssets iopts of
     MultiAssetEnable -> True
-    MultiAssetDisable -> False
+    MultiAssetDisable -> True
     MultiAssetPolicies multiAssetWhitelist ->
-      or multiAssetwhitelistCheck
+      mintPoliciesCheck || txOutPoliciesCheck
       where
-        -- txOutMaValue is a Map and we want to check if any of the keys match our whitelist
-        multiAssetwhitelistCheck :: [Bool]
-        multiAssetwhitelistCheck =
-          ( \txout ->
-              any (checkMAValueMap multiAssetWhitelist) (keys $ Generic.txOutMaValue txout)
-          )
-            <$> txOuts
+        mintPoliciesCheck :: Bool
+        mintPoliciesCheck = any (checkMAValueMap multiAssetWhitelist) mintPolicies
+
+        txOutPoliciesCheck :: Bool
+        txOutPoliciesCheck =
+          any
+            ( \txout ->
+                any (checkMAValueMap multiAssetWhitelist) (keys $ Generic.txOutMaValue txout)
+            )
+            txOuts
 
         checkMAValueMap :: NonEmpty ShortByteString -> PolicyID StandardCrypto -> Bool
         checkMAValueMap maWhitelist policyId =
           toShort (Generic.unScriptHash (policyID policyId)) `elem` maWhitelist
 
+        mintPolicies :: [PolicyID StandardCrypto]
+        mintPolicies = keys mintMap
+
 shelleyStkAddrWhitelistCheckWithAddr ::
   SyncEnv ->
   Ledger.Addr StandardCrypto ->

doc/configuration.md

@@ -427,9 +427,11 @@ Be mindfull that whitelisting policies will omit data that does not match whitel
 | table name            |
 | :-------------------- |
 | datum                 |
+| ma_tx_mint            |
+| ma_tx_out             |
+| multi_assets          |
 | script                |
 | tx_out                |
-| multi_assets          |
 
 #### Example