MA Policies Whitelist

cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs

@@ -268,7 +268,7 @@ mkSyncNodeParams staticDir mutableDir CommandLineArgs {..} = do
       , enpHasShelley = True
       , enpHasMultiAssets = claHasMultiAssets
       , enpHasMetadata = claHasMetadata
-      , enpKeepMetadataNames = []
+      , enpWhitelistMetadataNames = []
       , enpHasPlutusExtra = True
       , enpHasGov = True
       , enpHasOffChainPoolData = True

cardano-db-sync/app/cardano-db-sync.hs

@@ -90,7 +90,7 @@ pRunDbSyncNode = do
     <*> pHasShelley
     <*> pHasMultiAssets
     <*> pHasMetadata
-    <*> pKeepTxMetadata
+    <*> pWhiteListTxMetadata
     <*> pHasPlutusExtra
     <*> pHasGov
     <*> pHasOffChainPoolData
@@ -232,20 +232,20 @@ pSlotNo =
           <> Opt.metavar "WORD"
       )
 
-pKeepTxMetadata :: Parser [Word64]
-pKeepTxMetadata =
+pWhiteListTxMetadata :: Parser [Word64]
+pWhiteListTxMetadata =
   Opt.option
     (parseCommaSeparated <$> Opt.str)
-    ( Opt.long "keep-tx-metadata"
+    ( Opt.long "whitelist-tx-metadata"
         <> Opt.value []
         <> Opt.help "Insert a specific set of tx metadata, based on the tx metadata key names"
     )
-  where
-    parseCommaSeparated :: String -> [Word64]
-    parseCommaSeparated str =
-      case traverse readMaybe (splitOn "," str) of
-        Just values -> values
-        Nothing -> error "Failed to parse comma-separated values"
+
+parseCommaSeparated :: String -> [Word64]
+parseCommaSeparated str =
+  case traverse readMaybe (splitOn "," str) of
+    Just values -> values
+    Nothing -> error "Failed to parse comma-separated values"
 
 pHasInOut :: Parser Bool
 pHasInOut =

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

@@ -35,7 +35,10 @@ import Cardano.DbSync.Config.Types (
   ConfigFile (..),
   GenesisFile (..),
   LedgerStateDir (..),
+  MetadataConfig (..),
+  MultiAssetConfig (..),
   NetworkName (..),
+  PlutusConfig (..),
   SocketPath (..),
   SyncCommand (..),
   SyncNodeConfig (..),
@@ -55,7 +58,6 @@ import Cardano.Prelude hiding (Nat, (%))
 import Cardano.Slotting.Slot (EpochNo (..))
 import Control.Concurrent.Async
 import Control.Monad.Extra (whenJust)
-import qualified Data.Strict.Maybe as Strict
 import qualified Data.Text as Text
 import Data.Version (showVersion)
 import Database.Persist.Postgresql (ConnectionString, withPostgresqlConn)
@@ -232,11 +234,6 @@ extractSyncOptions snp aop =
     , snapshotEveryLagging = enpSnEveryLagging snp
     }
   where
-    maybeKeepMNames =
-      if null (enpKeepMetadataNames snp)
-        then Strict.Nothing
-        else Strict.Just (enpKeepMetadataNames snp)
-
     iopts
       | enpOnlyGov snp = onlyGovInsertOptions useLedger
       | enpOnlyUTxO snp = onlyUTxOInsertOptions
@@ -248,10 +245,9 @@ extractSyncOptions snp aop =
             , ioUseLedger = useLedger
             , ioShelley = enpHasShelley snp
             , ioRewards = True
-            , ioMultiAssets = enpHasMultiAssets snp
-            , ioMetadata = enpHasMetadata snp
-            , ioKeepMetadataNames = maybeKeepMNames
-            , ioPlutusExtra = enpHasPlutusExtra snp
+            , ioMultiAssets = MultiAssetDisable
+            , ioMetadata = MetadataDisable
+            , ioPlutusExtra = PlutusDisable
             , ioOffChainPoolData = enpHasOffChainPoolData snp
             , ioGov = enpHasGov snp
             }

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

@@ -206,10 +206,9 @@ fullInsertOptions useLedger =
     , ioUseLedger = useLedger
     , ioShelley = True
     , ioRewards = True
-    , ioMultiAssets = True
-    , ioMetadata = True
-    , ioKeepMetadataNames = Strict.Nothing
-    , ioPlutusExtra = True
+    , ioMultiAssets = MultiAssetEnable
+    , ioMetadata = MetadataEnable
+    , ioPlutusExtra = PlutusEnable
     , ioOffChainPoolData = True
     , ioGov = True
     }
@@ -221,10 +220,9 @@ onlyUTxOInsertOptions =
     , ioUseLedger = False
     , ioShelley = False
     , ioRewards = False
-    , ioMultiAssets = True
-    , ioMetadata = False
-    , ioKeepMetadataNames = Strict.Nothing
-    , ioPlutusExtra = False
+    , ioMultiAssets = MultiAssetEnable
+    , ioMetadata = MetadataDisable
+    , ioPlutusExtra = PlutusDisable
     , ioOffChainPoolData = False
     , ioGov = False
     }
@@ -239,10 +237,9 @@ disableAllInsertOptions useLedger =
     , ioUseLedger = useLedger
     , ioShelley = False
     , ioRewards = False
-    , ioMultiAssets = False
-    , ioMetadata = False
-    , ioKeepMetadataNames = Strict.Nothing
-    , ioPlutusExtra = False
+    , ioMultiAssets = MultiAssetEnable
+    , ioMetadata = MetadataDisable
+    , ioPlutusExtra = PlutusDisable
     , ioOffChainPoolData = False
     , ioGov = False
     }

cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs

@@ -142,7 +142,8 @@ storePage ::
   ExceptT SyncNodeError (ReaderT SqlBackend m) ()
 storePage syncEnv cache percQuantum (n, ls) = do
   when (n `mod` 10 == 0) $ liftIO $ logInfo trce $ "Bootstrap in progress " <> prc <> "%"
-  txOuts <- mapM (prepareTxOut syncEnv cache) ls
+  txOuts <- do
+    mapM (prepareTxOut syncEnv cache) ls
   txOutIds <- lift . DB.insertManyTxOutPlex True False $ etoTxOut . fst <$> txOuts
   let maTxOuts = concatMap mkmaTxOuts $ zip txOutIds (snd <$> txOuts)
   void . lift $ DB.insertManyMaTxOut maTxOuts
@@ -167,7 +168,7 @@ prepareTxOut syncEnv txCache (TxIn txHash (TxIx index), txOut) = do
   let txHashByteString = Generic.safeHashToByteString $ unTxId txHash
   let genTxOut = fromTxOut index txOut
   txId <- queryTxIdWithCache txCache txHashByteString
-  Insert.prepareTxOut trce cache iopts (txId, txHashByteString) genTxOut
+  Insert.prepareTxOut trce iopts cache (txId, txHashByteString) genTxOut
   where
     trce = getTrace syncEnv
     cache = envCache syncEnv

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

@@ -15,7 +15,7 @@ module Cardano.DbSync.Api.Types (
 
 import qualified Cardano.Db as DB
 import Cardano.DbSync.Cache.Types (Cache)
-import Cardano.DbSync.Config.Types (SyncNodeConfig)
+import Cardano.DbSync.Config.Types (MetadataConfig, MultiAssetConfig, PlutusConfig, SyncNodeConfig)
 import Cardano.DbSync.Ledger.Types (HasLedgerEnv)
 import Cardano.DbSync.LocalStateQuery (NoLedgerEnv)
 import Cardano.DbSync.Types (
@@ -24,7 +24,7 @@ import Cardano.DbSync.Types (
   OffChainVoteResult,
   OffChainVoteWorkQueue,
  )
-import Cardano.Prelude (Bool, Eq, IO, Show, Word64)
+import Cardano.Prelude (Bool (..), Eq, IO, Show, Word64)
 import Cardano.Slotting.Slot (EpochNo (..))
 import Control.Concurrent.Class.MonadSTM.Strict (
   StrictTVar,
@@ -78,10 +78,9 @@ data InsertOptions = InsertOptions
   , ioUseLedger :: !Bool
   , ioShelley :: !Bool
   , ioRewards :: !Bool
-  , ioMultiAssets :: !Bool
-  , ioMetadata :: !Bool
-  , ioKeepMetadataNames :: Strict.Maybe [Word64]
-  , ioPlutusExtra :: !Bool
+  , ioMultiAssets :: !MultiAssetConfig
+  , ioMetadata :: !MetadataConfig
+  , ioPlutusExtra :: !PlutusConfig
   , ioOffChainPoolData :: !Bool
   , ioGov :: !Bool
   }

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

@@ -20,17 +20,23 @@ module Cardano.DbSync.Config (
   readCardanoGenesisConfig,
   readSyncNodeConfig,
   configureLogging,
+  plutusMultiAssetWhitelistCheck,
 ) where
 
 import qualified Cardano.BM.Configuration.Model as Logging
 import qualified Cardano.BM.Setup as Logging
 import Cardano.BM.Trace (Trace)
 import qualified Cardano.BM.Trace as Logging
+import Cardano.DbSync.Api.Types (InsertOptions (..), SyncEnv, SyncOptions (..), envOptions)
 import Cardano.DbSync.Config.Cardano
 import Cardano.DbSync.Config.Node (NodeConfig (..), parseNodeConfig, parseSyncPreConfig, readByteStringFromFile)
 import Cardano.DbSync.Config.Shelley
 import Cardano.DbSync.Config.Types
+import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
+import Cardano.Ledger.Crypto (StandardCrypto)
+import Cardano.Ledger.Mary.Value (PolicyID (..))
 import Cardano.Prelude
+import Data.Map (keys)
 import System.FilePath (takeDirectory, (</>))
 
 configureLogging :: SyncNodeConfig -> Text -> IO (Trace IO Text)
@@ -88,3 +94,50 @@ coalesceConfig pcfg ncfg adjustGenesisPath = do
 
 mkAdjustPath :: SyncPreConfig -> (FilePath -> FilePath)
 mkAdjustPath cfg fp = takeDirectory (pcNodeConfigFilePath cfg) </> fp
+
+-- check both whitelist but also checking plutus Maybes first
+plutusMultiAssetWhitelistCheck :: SyncEnv -> [Generic.TxOut] -> Bool
+plutusMultiAssetWhitelistCheck syncEnv txOuts =
+  plutusWhitelistCheck syncEnv txOuts || multiAssetWhitelistCheck syncEnv txOuts
+
+plutusWhitelistCheck :: SyncEnv -> [Generic.TxOut] -> Bool
+plutusWhitelistCheck syncEnv txOuts = do
+  -- first check the config option
+  case ioPlutusExtra iopts of
+    PlutusEnable -> True
+    PlutusDisable -> True
+    PlutusWhitelistScripts plutusWhitelist -> plutuswhitelistCheck plutusWhitelist
+  where
+    iopts = soptInsertOptions $ envOptions syncEnv
+    plutuswhitelistCheck :: NonEmpty ByteString -> Bool
+    plutuswhitelistCheck whitelist =
+      any (\txOut -> isScriptHashWhitelisted whitelist txOut || isAddressWhitelisted whitelist txOut) txOuts
+    -- check if the script hash is in the whitelist
+    isScriptHashWhitelisted :: NonEmpty ByteString -> Generic.TxOut -> Bool
+    isScriptHashWhitelisted whitelist txOut =
+      maybe False ((`elem` whitelist) . Generic.txScriptHash) (Generic.txOutScript txOut)
+    -- check if the address is in the whitelist
+    isAddressWhitelisted :: NonEmpty ByteString -> Generic.TxOut -> Bool
+    isAddressWhitelisted whitelist txOut =
+      maybe False (`elem` whitelist) (Generic.maybePaymentCred $ Generic.txOutAddress txOut)
+
+multiAssetWhitelistCheck :: SyncEnv -> [Generic.TxOut] -> Bool
+multiAssetWhitelistCheck syncEnv txOuts = do
+  let iopts = soptInsertOptions $ envOptions syncEnv
+  case ioMultiAssets iopts of
+    MultiAssetEnable -> True
+    MultiAssetDisable -> True
+    MultiAssetWhitelistPolicies multiAssetWhitelist ->
+      or multiAssetwhitelistCheck
+      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
+
+        checkMAValueMap :: NonEmpty ByteString -> PolicyID StandardCrypto -> Bool
+        checkMAValueMap maWhitelist policyId =
+          Generic.unScriptHash (policyID policyId) `elem` maWhitelist

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

@@ -2,6 +2,7 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE NoImplicitPrelude #-}
@@ -18,11 +19,17 @@ module Cardano.DbSync.Config.Types (
   GenesisHashConway (..),
   SyncNodeConfig (..),
   SyncPreConfig (..),
+  MetadataConfig (..),
+  MultiAssetConfig (..),
+  PlutusConfig (..),
   LedgerStateDir (..),
   LogFileDir (..),
   NetworkName (..),
   NodeConfigFile (..),
   SocketPath (..),
+  isMetadataEnableOrWhiteList,
+  isMultiAssetEnableOrWhitelist,
+  isPlutusEnableOrWhitelist,
   adjustGenesisFilePath,
   adjustNodeConfigFilePath,
   pcNodeConfigFilePath,
@@ -72,7 +79,7 @@ data SyncNodeParams = SyncNodeParams
   , enpHasShelley :: !Bool
   , enpHasMultiAssets :: !Bool
   , enpHasMetadata :: !Bool
-  , enpKeepMetadataNames :: ![Word64]
+  , enpWhitelistMetadataNames :: ![Word64]
   , enpHasPlutusExtra :: !Bool
   , enpHasGov :: !Bool
   , enpHasOffChainPoolData :: !Bool
@@ -131,6 +138,42 @@ data SyncPreConfig = SyncPreConfig
   , pcPrometheusPort :: !Int
   }
 
+data MetadataConfig
+  = MetadataEnable
+  | MetadataDisable
+  | MetadataWhitelistKeys (NonEmpty ByteString)
+  deriving (Eq, Show)
+
+isMetadataEnableOrWhiteList :: MetadataConfig -> Bool
+isMetadataEnableOrWhiteList = \case
+  MetadataEnable -> True
+  MetadataDisable -> False
+  MetadataWhitelistKeys _ -> True
+
+data MultiAssetConfig
+  = MultiAssetEnable
+  | MultiAssetDisable
+  | MultiAssetWhitelistPolicies (NonEmpty ByteString)
+  deriving (Eq, Show)
+
+isMultiAssetEnableOrWhitelist :: MultiAssetConfig -> Bool
+isMultiAssetEnableOrWhitelist = \case
+  MultiAssetEnable -> True
+  MultiAssetDisable -> False
+  MultiAssetWhitelistPolicies _ -> True
+
+data PlutusConfig
+  = PlutusEnable
+  | PlutusDisable
+  | PlutusWhitelistScripts (NonEmpty ByteString)
+  deriving (Eq, Show)
+
+isPlutusEnableOrWhitelist :: PlutusConfig -> Bool
+isPlutusEnableOrWhitelist = \case
+  PlutusEnable -> True
+  PlutusDisable -> False
+  PlutusWhitelistScripts _ -> True
+
 newtype GenesisFile = GenesisFile
   { unGenesisFile :: FilePath
   }

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

@@ -25,6 +25,7 @@ module Cardano.DbSync.Era.Shelley.Generic.Block (
 
 import qualified Cardano.Crypto.Hash as Crypto
 import qualified Cardano.Crypto.KES.Class as KES
+import Cardano.DbSync.Config.Types (PlutusConfig)
 import Cardano.DbSync.Era.Shelley.Generic.Tx
 import Cardano.DbSync.Types
 import Cardano.DbSync.Util.Bech32 (serialiseVerKeyVrfToBech32)
@@ -120,7 +121,7 @@ fromMaryBlock blk =
     , blkTxs = map fromMaryTx (getTxs blk)
     }
 
-fromAlonzoBlock :: Bool -> Maybe Prices -> ShelleyBlock TPraosStandard StandardAlonzo -> Block
+fromAlonzoBlock :: PlutusConfig -> Maybe Prices -> ShelleyBlock TPraosStandard StandardAlonzo -> Block
 fromAlonzoBlock iope mprices blk =
   Block
     { blkEra = Alonzo
@@ -137,7 +138,7 @@ fromAlonzoBlock iope mprices blk =
     , blkTxs = map (fromAlonzoTx iope mprices) (getTxs blk)
     }
 
-fromBabbageBlock :: Bool -> Maybe Prices -> ShelleyBlock PraosStandard StandardBabbage -> Block
+fromBabbageBlock :: PlutusConfig -> Maybe Prices -> ShelleyBlock PraosStandard StandardBabbage -> Block
 fromBabbageBlock iope mprices blk =
   Block
     { blkEra = Babbage
@@ -154,7 +155,7 @@ fromBabbageBlock iope mprices blk =
     , blkTxs = map (fromBabbageTx iope mprices) (getTxs blk)
     }
 
-fromConwayBlock :: Bool -> Maybe Prices -> ShelleyBlock PraosStandard StandardConway -> Block
+fromConwayBlock :: PlutusConfig -> Maybe Prices -> ShelleyBlock PraosStandard StandardConway -> Block
 fromConwayBlock iope mprices blk =
   Block
     { blkEra = Conway