From 74b4c0b00fd418c1ff210b109c953e43b1ab6183 Mon Sep 17 00:00:00 2001 From: Cmdv Date: Tue, 20 Feb 2024 11:40:41 +0000 Subject: [PATCH 1/4] rename keepMetadaNames to whitelistMetadataNames --- .../test/Test/Cardano/Db/Mock/Config.hs | 3 +- cardano-db-sync/app/cardano-db-sync.hs | 29 ++++++++++++------- cardano-db-sync/src/Cardano/DbSync.hs | 12 +++++--- cardano-db-sync/src/Cardano/DbSync/Api.hs | 9 ++++-- .../src/Cardano/DbSync/Api/Ledger.hs | 2 +- .../src/Cardano/DbSync/Api/Types.hs | 3 +- .../src/Cardano/DbSync/Config/Types.hs | 3 +- .../src/Cardano/DbSync/Era/Shelley/Insert.hs | 27 ++++++++++------- doc/configuration.md | 6 ++-- 9 files changed, 59 insertions(+), 35 deletions(-) diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs index 7089c4d50..69fbfa349 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs @@ -268,7 +268,8 @@ mkSyncNodeParams staticDir mutableDir CommandLineArgs {..} = do , enpHasShelley = True , enpHasMultiAssets = claHasMultiAssets , enpHasMetadata = claHasMetadata - , enpKeepMetadataNames = [] + , enpWhitelistMetadataNames = [] + , enpWhitelistMAPolicies = [] , enpHasPlutusExtra = True , enpHasGov = True , enpHasOffChainPoolData = True diff --git a/cardano-db-sync/app/cardano-db-sync.hs b/cardano-db-sync/app/cardano-db-sync.hs index 7c9780c7f..1ba20c55c 100644 --- a/cardano-db-sync/app/cardano-db-sync.hs +++ b/cardano-db-sync/app/cardano-db-sync.hs @@ -90,7 +90,8 @@ pRunDbSyncNode = do <*> pHasShelley <*> pHasMultiAssets <*> pHasMetadata - <*> pKeepTxMetadata + <*> pWhiteListTxMetadata + <*> pWhiteListMAPolicies <*> pHasPlutusExtra <*> pHasGov <*> pHasOffChainPoolData @@ -232,20 +233,28 @@ 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" + +pWhiteListMAPolicies :: Parser [Word64] +pWhiteListMAPolicies = + Opt.option + (parseCommaSeparated <$> Opt.str) + ( Opt.long "whitelist-multi-asset-policy" + <> Opt.help "Only insert a specific sellected list of multi-assets, based on the multi-asset's policy name" + ) + +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 = diff --git a/cardano-db-sync/src/Cardano/DbSync.hs b/cardano-db-sync/src/Cardano/DbSync.hs index a31cc80d5..e661350eb 100644 --- a/cardano-db-sync/src/Cardano/DbSync.hs +++ b/cardano-db-sync/src/Cardano/DbSync.hs @@ -232,10 +232,13 @@ extractSyncOptions snp aop = , snapshotEveryLagging = enpSnEveryLagging snp } where - maybeKeepMNames = - if null (enpKeepMetadataNames snp) + maybeWhitelistMDNames = whitelistToMaybe (enpWhitelistMetadataNames snp) + maybeWhitelistMAPolicies = whitelistToMaybe (enpWhitelistMAPolicies snp) + + whitelistToMaybe wList = + if null wList then Strict.Nothing - else Strict.Just (enpKeepMetadataNames snp) + else Strict.Just wList iopts | enpOnlyGov snp = onlyGovInsertOptions useLedger @@ -250,7 +253,8 @@ extractSyncOptions snp aop = , ioRewards = True , ioMultiAssets = enpHasMultiAssets snp , ioMetadata = enpHasMetadata snp - , ioKeepMetadataNames = maybeKeepMNames + , ioWhitelistMetadataNames = maybeWhitelistMDNames + , ioWhitelistMAPolicies = maybeWhitelistMAPolicies , ioPlutusExtra = enpHasPlutusExtra snp , ioOffChainPoolData = enpHasOffChainPoolData snp , ioGov = enpHasGov snp diff --git a/cardano-db-sync/src/Cardano/DbSync/Api.hs b/cardano-db-sync/src/Cardano/DbSync/Api.hs index 50648cd09..c287e741a 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Api.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Api.hs @@ -208,7 +208,8 @@ fullInsertOptions useLedger = , ioRewards = True , ioMultiAssets = True , ioMetadata = True - , ioKeepMetadataNames = Strict.Nothing + , ioWhitelistMetadataNames = Strict.Nothing + , ioWhitelistMAPolicies = Strict.Nothing , ioPlutusExtra = True , ioOffChainPoolData = True , ioGov = True @@ -223,7 +224,8 @@ onlyUTxOInsertOptions = , ioRewards = False , ioMultiAssets = True , ioMetadata = False - , ioKeepMetadataNames = Strict.Nothing + , ioWhitelistMetadataNames = Strict.Nothing + , ioWhitelistMAPolicies = Strict.Nothing , ioPlutusExtra = False , ioOffChainPoolData = False , ioGov = False @@ -241,7 +243,8 @@ disableAllInsertOptions useLedger = , ioRewards = False , ioMultiAssets = False , ioMetadata = False - , ioKeepMetadataNames = Strict.Nothing + , ioWhitelistMetadataNames = Strict.Nothing + , ioWhitelistMAPolicies = Strict.Nothing , ioPlutusExtra = False , ioOffChainPoolData = False , ioGov = False diff --git a/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs b/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs index 396663e71..4cfad3731 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs @@ -167,7 +167,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 syncEnv trce cache iopts (txId, txHashByteString) genTxOut where trce = getTrace syncEnv cache = envCache syncEnv diff --git a/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs index 87ff8a101..d96ea2e13 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs @@ -80,7 +80,8 @@ data InsertOptions = InsertOptions , ioRewards :: !Bool , ioMultiAssets :: !Bool , ioMetadata :: !Bool - , ioKeepMetadataNames :: Strict.Maybe [Word64] + , ioWhitelistMetadataNames :: Strict.Maybe [Word64] + , ioWhitelistMAPolicies :: Strict.Maybe [Word64] , ioPlutusExtra :: !Bool , ioOffChainPoolData :: !Bool , ioGov :: !Bool diff --git a/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs index 63c578986..0406168b5 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs @@ -72,7 +72,8 @@ data SyncNodeParams = SyncNodeParams , enpHasShelley :: !Bool , enpHasMultiAssets :: !Bool , enpHasMetadata :: !Bool - , enpKeepMetadataNames :: ![Word64] + , enpWhitelistMetadataNames :: ![Word64] + , enpWhitelistMAPolicies :: ![Word64] , enpHasPlutusExtra :: !Bool , enpHasGov :: !Bool , enpHasOffChainPoolData :: !Bool diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs index 01e99c265..f08eb109d 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs @@ -320,7 +320,7 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped if not (Generic.txValidContract tx) then do - !txOutsGrouped <- mapM (prepareTxOut tracer cache iopts (txId, txHash)) (Generic.txOutputs tx) + !txOutsGrouped <- mapM (prepareTxOut syncEnv tracer cache iopts (txId, txHash)) (Generic.txOutputs tx) let !txIns = map (prepareTxIn txId Map.empty) resolvedInputs -- There is a custom semigroup instance for BlockGroupedData which uses addition for the values `fees` and `outSum`. @@ -329,7 +329,7 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped else do -- The following operations only happen if the script passes stage 2 validation (or the tx has -- no script). - !txOutsGrouped <- mapM (prepareTxOut tracer cache iopts (txId, txHash)) (Generic.txOutputs tx) + !txOutsGrouped <- mapM (prepareTxOut syncEnv tracer cache iopts (txId, txHash)) (Generic.txOutputs tx) !redeemers <- Map.fromList @@ -365,7 +365,7 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped maTxMint <- whenFalseMempty (ioMetadata iopts) $ - prepareMaTxMint tracer cache txId $ + prepareMaTxMint syncEnv tracer cache txId $ Generic.txMint tx when (ioPlutusExtra iopts) $ @@ -389,13 +389,14 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped prepareTxOut :: (MonadBaseControl IO m, MonadIO m) => + SyncEnv -> Trace IO Text -> Cache -> InsertOptions -> (DB.TxId, ByteString) -> Generic.TxOut -> ExceptT SyncNodeError (ReaderT SqlBackend m) (ExtendedTxOut, [MissingMaTxOut]) -prepareTxOut tracer cache iopts (txId, txHash) (Generic.TxOut index addr value maMap mScript dt) = do +prepareTxOut syncEnv tracer cache iopts (txId, txHash) (Generic.TxOut index addr addrRaw value maMap mScript dt) = do mSaId <- lift $ insertStakeAddressRefIfMissing tracer cache addr mDatumId <- whenFalseEmpty (ioPlutusExtra iopts) Nothing $ @@ -419,7 +420,7 @@ prepareTxOut tracer cache iopts (txId, txHash) (Generic.TxOut index addr value m , DB.txOutReferenceScriptId = mScriptId } let !eutxo = ExtendedTxOut txHash txOut - !maTxOuts <- whenFalseMempty (ioMultiAssets iopts) $ prepareMaTxOuts tracer cache maMap + !maTxOuts <- whenFalseMempty (ioMultiAssets iopts) $ prepareMaTxOuts syncEnv tracer cache maMap pure (eutxo, maTxOuts) where hasScript :: Bool @@ -1228,7 +1229,7 @@ prepareTxMetadata tracer txId inOpts mmetadata = do (Word64, TxMetadataValue) -> ExceptT SyncNodeError (ReaderT SqlBackend m) (Maybe DB.TxMetadata) prepare (key, md) = do - case ioKeepMetadataNames inOpts of + case ioWhitelistMetadataNames inOpts of Strict.Just metadataNames -> do let isMatchingKey = key `elem` metadataNames if isMatchingKey @@ -1335,12 +1336,14 @@ insertEpochParam _tracer blkId (EpochNo epoch) params nonce = do prepareMaTxMint :: (MonadBaseControl IO m, MonadIO m) => + SyncEnv -> Trace IO Text -> Cache -> DB.TxId -> MultiAsset StandardCrypto -> ExceptT SyncNodeError (ReaderT SqlBackend m) [DB.MaTxMint] -prepareMaTxMint _tracer cache txId (MultiAsset mintMap) = +prepareMaTxMint syncEnv _tracer cache txId (MultiAsset mintMap) = + -- TODO: VINCE HERE concatMapM (lift . prepareOuter) $ Map.toList mintMap where prepareOuter :: @@ -1356,7 +1359,7 @@ prepareMaTxMint _tracer cache txId (MultiAsset mintMap) = (AssetName, Integer) -> ReaderT SqlBackend m DB.MaTxMint prepareInner policy (aname, amount) = do - maId <- insertMultiAsset cache policy aname + maId <- insertMultiAsset syncEnv cache policy aname pure $ DB.MaTxMint { DB.maTxMintIdent = maId @@ -1366,11 +1369,12 @@ prepareMaTxMint _tracer cache txId (MultiAsset mintMap) = prepareMaTxOuts :: (MonadBaseControl IO m, MonadIO m) => + SyncEnv -> Trace IO Text -> Cache -> Map (PolicyID StandardCrypto) (Map AssetName Integer) -> ExceptT SyncNodeError (ReaderT SqlBackend m) [MissingMaTxOut] -prepareMaTxOuts _tracer cache maMap = +prepareMaTxOuts syncEnv _tracer cache maMap = concatMapM (lift . prepareOuter) $ Map.toList maMap where prepareOuter :: @@ -1386,7 +1390,7 @@ prepareMaTxOuts _tracer cache maMap = (AssetName, Integer) -> ReaderT SqlBackend m MissingMaTxOut prepareInner policy (aname, amount) = do - maId <- insertMultiAsset cache policy aname + maId <- insertMultiAsset syncEnv cache policy aname pure $ MissingMaTxOut { mmtoIdent = maId @@ -1395,11 +1399,12 @@ prepareMaTxOuts _tracer cache maMap = insertMultiAsset :: (MonadBaseControl IO m, MonadIO m) => + SyncEnv -> Cache -> PolicyID StandardCrypto -> AssetName -> ReaderT SqlBackend m DB.MultiAssetId -insertMultiAsset cache policy aName = do +insertMultiAsset _syncEnv cache policy aName = do mId <- queryMAWithCache cache policy aName case mId of Right maId -> pure maId diff --git a/doc/configuration.md b/doc/configuration.md index 4bd187f53..9e767c02d 100644 --- a/doc/configuration.md +++ b/doc/configuration.md @@ -155,7 +155,7 @@ Some field are left empty when using this flag, like Until the ledger state migration happens any restart requires reusing the `--bootstrap-tx-out` flag. After it's completed the flag can be omitted on restarts. -### --keep-tx-metadata +### --whitelist-tx-metadata -It keeps only metadata with the specified keys. -You can pass multiple values to the flag eg: `--keep-tx-metadata 1,2,3` make sure you are using commas between each key. +To help improved database insert thoughput, user can chose to filter specific tx metadata they would like to keep and insert, ignore everything else. +You can pass multiple values to the flag eg: `--whitelist-tx-metadata 1,2,3` make sure you are using commas between each key. From fe0a3d4a657daef7f7b098320dcbc2e94180be63 Mon Sep 17 00:00:00 2001 From: Cmdv Date: Mon, 22 Jan 2024 12:10:47 +0000 Subject: [PATCH 2/4] allow whitelist for insertMultiAsset --- .../test/Test/Cardano/Db/Mock/Config.hs | 1 - cardano-db-sync/app/cardano-db-sync.hs | 9 - cardano-db-sync/src/Cardano/DbSync.hs | 21 +- cardano-db-sync/src/Cardano/DbSync/Api.hs | 24 +- .../src/Cardano/DbSync/Api/Ledger.hs | 5 +- .../src/Cardano/DbSync/Api/Types.hs | 12 +- cardano-db-sync/src/Cardano/DbSync/Config.hs | 28 ++ .../src/Cardano/DbSync/Config/Types.hs | 44 ++- .../DbSync/Era/Shelley/Generic/Block.hs | 7 +- .../DbSync/Era/Shelley/Generic/Tx/Alonzo.hs | 7 +- .../DbSync/Era/Shelley/Generic/Tx/Babbage.hs | 3 +- .../DbSync/Era/Shelley/Generic/Tx/Conway.hs | 3 +- .../src/Cardano/DbSync/Era/Shelley/Insert.hs | 270 +++++++++++------- 13 files changed, 274 insertions(+), 160 deletions(-) diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs index 69fbfa349..03b16d31a 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs @@ -269,7 +269,6 @@ mkSyncNodeParams staticDir mutableDir CommandLineArgs {..} = do , enpHasMultiAssets = claHasMultiAssets , enpHasMetadata = claHasMetadata , enpWhitelistMetadataNames = [] - , enpWhitelistMAPolicies = [] , enpHasPlutusExtra = True , enpHasGov = True , enpHasOffChainPoolData = True diff --git a/cardano-db-sync/app/cardano-db-sync.hs b/cardano-db-sync/app/cardano-db-sync.hs index 1ba20c55c..c0f827b4b 100644 --- a/cardano-db-sync/app/cardano-db-sync.hs +++ b/cardano-db-sync/app/cardano-db-sync.hs @@ -91,7 +91,6 @@ pRunDbSyncNode = do <*> pHasMultiAssets <*> pHasMetadata <*> pWhiteListTxMetadata - <*> pWhiteListMAPolicies <*> pHasPlutusExtra <*> pHasGov <*> pHasOffChainPoolData @@ -242,14 +241,6 @@ pWhiteListTxMetadata = <> Opt.help "Insert a specific set of tx metadata, based on the tx metadata key names" ) -pWhiteListMAPolicies :: Parser [Word64] -pWhiteListMAPolicies = - Opt.option - (parseCommaSeparated <$> Opt.str) - ( Opt.long "whitelist-multi-asset-policy" - <> Opt.help "Only insert a specific sellected list of multi-assets, based on the multi-asset's policy name" - ) - parseCommaSeparated :: String -> [Word64] parseCommaSeparated str = case traverse readMaybe (splitOn "," str) of diff --git a/cardano-db-sync/src/Cardano/DbSync.hs b/cardano-db-sync/src/Cardano/DbSync.hs index e661350eb..0fc1e62f4 100644 --- a/cardano-db-sync/src/Cardano/DbSync.hs +++ b/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,14 +234,6 @@ extractSyncOptions snp aop = , snapshotEveryLagging = enpSnEveryLagging snp } where - maybeWhitelistMDNames = whitelistToMaybe (enpWhitelistMetadataNames snp) - maybeWhitelistMAPolicies = whitelistToMaybe (enpWhitelistMAPolicies snp) - - whitelistToMaybe wList = - if null wList - then Strict.Nothing - else Strict.Just wList - iopts | enpOnlyGov snp = onlyGovInsertOptions useLedger | enpOnlyUTxO snp = onlyUTxOInsertOptions @@ -251,11 +245,10 @@ extractSyncOptions snp aop = , ioUseLedger = useLedger , ioShelley = enpHasShelley snp , ioRewards = True - , ioMultiAssets = enpHasMultiAssets snp - , ioMetadata = enpHasMetadata snp - , ioWhitelistMetadataNames = maybeWhitelistMDNames - , ioWhitelistMAPolicies = maybeWhitelistMAPolicies - , ioPlutusExtra = enpHasPlutusExtra snp + , -- TODO: cmdv: this is where we plug configs + ioMultiAssets = MultiAssetDisable + , ioMetadata = MetadataDisable + , ioPlutusExtra = PlutusDisable , ioOffChainPoolData = enpHasOffChainPoolData snp , ioGov = enpHasGov snp } diff --git a/cardano-db-sync/src/Cardano/DbSync/Api.hs b/cardano-db-sync/src/Cardano/DbSync/Api.hs index c287e741a..4a0c5696a 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Api.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Api.hs @@ -206,11 +206,9 @@ fullInsertOptions useLedger = , ioUseLedger = useLedger , ioShelley = True , ioRewards = True - , ioMultiAssets = True - , ioMetadata = True - , ioWhitelistMetadataNames = Strict.Nothing - , ioWhitelistMAPolicies = Strict.Nothing - , ioPlutusExtra = True + , ioMultiAssets = MultiAssetEnable + , ioMetadata = MetadataEnable + , ioPlutusExtra = PlutusEnable , ioOffChainPoolData = True , ioGov = True } @@ -222,11 +220,9 @@ onlyUTxOInsertOptions = , ioUseLedger = False , ioShelley = False , ioRewards = False - , ioMultiAssets = True - , ioMetadata = False - , ioWhitelistMetadataNames = Strict.Nothing - , ioWhitelistMAPolicies = Strict.Nothing - , ioPlutusExtra = False + , ioMultiAssets = MultiAssetEnable + , ioMetadata = MetadataDisable + , ioPlutusExtra = PlutusDisable , ioOffChainPoolData = False , ioGov = False } @@ -241,11 +237,9 @@ disableAllInsertOptions useLedger = , ioUseLedger = useLedger , ioShelley = False , ioRewards = False - , ioMultiAssets = False - , ioMetadata = False - , ioWhitelistMetadataNames = Strict.Nothing - , ioWhitelistMAPolicies = Strict.Nothing - , ioPlutusExtra = False + , ioMultiAssets = MultiAssetEnable + , ioMetadata = MetadataDisable + , ioPlutusExtra = PlutusDisable , ioOffChainPoolData = False , ioGov = False } diff --git a/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs b/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs index 4cfad3731..e7aae8627 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs +++ b/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 syncEnv trce cache iopts (txId, txHashByteString) genTxOut + Insert.prepareTxOut trce iopts cache (txId, txHashByteString) genTxOut where trce = getTrace syncEnv cache = envCache syncEnv diff --git a/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs index d96ea2e13..6e6d9bab8 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs +++ b/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 (SyncNodeConfig, MetadataConfig, MultiAssetConfig, PlutusConfig) 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,11 +78,9 @@ data InsertOptions = InsertOptions , ioUseLedger :: !Bool , ioShelley :: !Bool , ioRewards :: !Bool - , ioMultiAssets :: !Bool - , ioMetadata :: !Bool - , ioWhitelistMetadataNames :: Strict.Maybe [Word64] - , ioWhitelistMAPolicies :: Strict.Maybe [Word64] - , ioPlutusExtra :: !Bool + , ioMultiAssets :: !MultiAssetConfig + , ioMetadata :: !MetadataConfig + , ioPlutusExtra :: !PlutusConfig , ioOffChainPoolData :: !Bool , ioGov :: !Bool } diff --git a/cardano-db-sync/src/Cardano/DbSync/Config.hs b/cardano-db-sync/src/Cardano/DbSync/Config.hs index 4628dc313..07767934f 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Config.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Config.hs @@ -20,16 +20,19 @@ module Cardano.DbSync.Config ( readCardanoGenesisConfig, readSyncNodeConfig, configureLogging, + plutusWhitelistCheckTxOut, ) 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.Prelude import System.FilePath (takeDirectory, ()) @@ -88,3 +91,28 @@ coalesceConfig pcfg ncfg adjustGenesisPath = do mkAdjustPath :: SyncPreConfig -> (FilePath -> FilePath) mkAdjustPath cfg fp = takeDirectory (pcNodeConfigFilePath cfg) fp + +-- do a whitelist check against a list of TxOut and if one matches we keep them all +plutusWhitelistCheckTxOut :: SyncEnv -> [Generic.TxOut] -> Bool +plutusWhitelistCheckTxOut syncEnv txOuts = do + let iopts = soptInsertOptions $ envOptions syncEnv + case ioPlutusExtra iopts of + PlutusEnable -> True + PlutusDisable -> False + PlutusWhitelistScripts whitelist -> do + -- we map over our txOuts and check if txOutAddress OR txOutScript are in the whitelist + let whitelistCheck = + ( \txOut -> + case (Generic.txOutScript txOut, Generic.maybePaymentCred $ Generic.txOutAddress txOut) of + (Just script, _) -> + if Generic.txScriptHash script `elem` whitelist + then Just txOut + else Nothing + (_, Just address) -> + if address `elem` whitelist + then Just txOut + else Nothing + (Nothing, Nothing) -> Nothing + ) + <$> txOuts + any isJust whitelistCheck diff --git a/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs index 0406168b5..707bd5e2b 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs +++ b/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, @@ -73,7 +80,6 @@ data SyncNodeParams = SyncNodeParams , enpHasMultiAssets :: !Bool , enpHasMetadata :: !Bool , enpWhitelistMetadataNames :: ![Word64] - , enpWhitelistMAPolicies :: ![Word64] , enpHasPlutusExtra :: !Bool , enpHasGov :: !Bool , enpHasOffChainPoolData :: !Bool @@ -132,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 } diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Block.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Block.hs index e74620297..28c0a69ed 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Block.hs +++ b/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 diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Alonzo.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Alonzo.hs index be17923c0..d5cece36f 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Alonzo.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Alonzo.hs @@ -26,6 +26,7 @@ module Cardano.DbSync.Era.Shelley.Generic.Tx.Alonzo ( import qualified Cardano.Crypto.Hash as Crypto import Cardano.Db (ScriptType (..)) +import Cardano.DbSync.Config.Types (PlutusConfig, isPlutusEnableOrWhitelist) import Cardano.DbSync.Era.Shelley.Generic.Metadata import Cardano.DbSync.Era.Shelley.Generic.Script (fromTimelock) import Cardano.DbSync.Era.Shelley.Generic.ScriptData (ScriptData (..)) @@ -65,7 +66,7 @@ import qualified Data.Set as Set import Lens.Micro import Ouroboros.Consensus.Cardano.Block (EraCrypto, StandardAlonzo, StandardCrypto) -fromAlonzoTx :: Bool -> Maybe Alonzo.Prices -> (Word64, Core.Tx StandardAlonzo) -> Tx +fromAlonzoTx :: PlutusConfig -> Maybe Alonzo.Prices -> (Word64, Core.Tx StandardAlonzo) -> Tx fromAlonzoTx ioExtraPlutus mprices (blkIndex, tx) = Tx { txHash = txHashId tx @@ -176,13 +177,13 @@ resolveRedeemers :: , Core.EraTx era , Alonzo.MaryEraTxBody era ) => - Bool -> + PlutusConfig -> Maybe Alonzo.Prices -> Core.Tx era -> (TxCert era -> Cert) -> (RedeemerMaps, [(Word64, TxRedeemer)]) resolveRedeemers ioExtraPlutus mprices tx toCert = - if not ioExtraPlutus + if not $ isPlutusEnableOrWhitelist ioExtraPlutus then (initRedeemersMaps, []) else mkRdmrAndUpdateRec (initRedeemersMaps, []) $ diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Babbage.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Babbage.hs index 03115436e..e9588814b 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Babbage.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Babbage.hs @@ -13,6 +13,7 @@ module Cardano.DbSync.Era.Shelley.Generic.Tx.Babbage ( fromTxOut, ) where +import Cardano.DbSync.Config.Types (PlutusConfig) import Cardano.DbSync.Era.Shelley.Generic.Metadata import Cardano.DbSync.Era.Shelley.Generic.Tx.Allegra (getInterval) import Cardano.DbSync.Era.Shelley.Generic.Tx.Alonzo @@ -34,7 +35,7 @@ import qualified Data.Map.Strict as Map import Lens.Micro import Ouroboros.Consensus.Shelley.Eras (StandardBabbage, StandardCrypto) -fromBabbageTx :: Bool -> Maybe Alonzo.Prices -> (Word64, Core.Tx StandardBabbage) -> Tx +fromBabbageTx :: PlutusConfig -> Maybe Alonzo.Prices -> (Word64, Core.Tx StandardBabbage) -> Tx fromBabbageTx ioExtraPlutus mprices (blkIndex, tx) = Tx { txHash = txHashId tx diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Conway.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Conway.hs index c45525b7f..3e6701a70 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Conway.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Conway.hs @@ -8,6 +8,7 @@ module Cardano.DbSync.Era.Shelley.Generic.Tx.Conway ( fromConwayTx, ) where +import Cardano.DbSync.Config.Types (PlutusConfig) import Cardano.DbSync.Era.Shelley.Generic.Metadata import Cardano.DbSync.Era.Shelley.Generic.Tx.Allegra (getInterval) import Cardano.DbSync.Era.Shelley.Generic.Tx.Alonzo @@ -26,7 +27,7 @@ import qualified Data.Map.Strict as Map import Lens.Micro import Ouroboros.Consensus.Cardano.Block (StandardConway) -fromConwayTx :: Bool -> Maybe Alonzo.Prices -> (Word64, Core.Tx StandardConway) -> Tx +fromConwayTx :: PlutusConfig -> Maybe Alonzo.Prices -> (Word64, Core.Tx StandardConway) -> Tx fromConwayTx ioExtraPlutus mprices (blkIndex, tx) = Tx { txHash = txHashId tx diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs index f08eb109d..919de9962 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs @@ -43,6 +43,8 @@ import Cardano.DbSync.Cache ( import Cardano.DbSync.Cache.Epoch (writeEpochBlockDiffToCache) import Cardano.DbSync.Cache.Types (Cache (..), CacheNew (..), EpochBlockDiff (..)) +import Cardano.DbSync.Config (plutusWhitelistCheckTxOut) +import Cardano.DbSync.Config.Types (MetadataConfig (..), MultiAssetConfig (..), PlutusConfig (..), isMetadataEnableOrWhiteList, isPlutusEnableOrWhitelist) import qualified Cardano.DbSync.Era.Shelley.Generic as Generic import Cardano.DbSync.Era.Shelley.Generic.Metadata ( TxMetadataValue (..), @@ -88,7 +90,7 @@ import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Either.Extra (eitherToMaybe) import Data.Group (invert) import qualified Data.Map.Strict as Map -import qualified Data.Strict.Maybe as Strict +import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Database.Persist.Sql (SqlBackend) import Lens.Micro @@ -320,7 +322,12 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped if not (Generic.txValidContract tx) then do - !txOutsGrouped <- mapM (prepareTxOut syncEnv tracer cache iopts (txId, txHash)) (Generic.txOutputs tx) + !txOutsGrouped <- do + let txOuts = Generic.txOutputs tx + -- we do a plutus whitelist check + if plutusWhitelistCheckTxOut syncEnv txOuts + then mapM (prepareTxOut tracer iopts cache (txId, txHash)) txOuts + else pure mempty let !txIns = map (prepareTxIn txId Map.empty) resolvedInputs -- There is a custom semigroup instance for BlockGroupedData which uses addition for the values `fees` and `outSum`. @@ -329,15 +336,20 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped else do -- The following operations only happen if the script passes stage 2 validation (or the tx has -- no script). - !txOutsGrouped <- mapM (prepareTxOut syncEnv tracer cache iopts (txId, txHash)) (Generic.txOutputs tx) + !txOutsGrouped <- do + let txOuts = Generic.txOutputs tx + -- we do a plutus whitelist check + if plutusWhitelistCheckTxOut syncEnv txOuts + then mapM (prepareTxOut tracer iopts cache (txId, txHash)) txOuts + else pure mempty !redeemers <- Map.fromList <$> whenFalseMempty - (ioPlutusExtra iopts) + (isPlutusEnableOrWhitelist $ ioPlutusExtra iopts) (mapM (insertRedeemer tracer disInOut (fst <$> groupedTxOut grouped) txId) (Generic.txRedeemer tx)) - when (ioPlutusExtra iopts) $ do + when (isPlutusEnableOrWhitelist $ ioPlutusExtra iopts) $ do mapM_ (insertDatum tracer cache txId) (Generic.txData tx) mapM_ (insertCollateralTxIn tracer txId) (Generic.txCollateralInputs tx) @@ -347,11 +359,11 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped mapM_ (insertCollateralTxOut tracer cache iopts (txId, txHash)) (Generic.txCollateralOutputs tx) txMetadata <- - whenFalseMempty (ioMetadata iopts) $ + whenFalseMempty (isMetadataEnableOrWhiteList $ ioMetadata iopts) $ prepareTxMetadata tracer - txId iopts + txId (Generic.txMetadata tx) mapM_ (insertCertificate syncEnv isMember blkId txId epochNo slotNo redeemers) @@ -364,15 +376,16 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped Generic.txParamProposal tx maTxMint <- - whenFalseMempty (ioMetadata iopts) $ - prepareMaTxMint syncEnv tracer cache txId $ - Generic.txMint tx - - when (ioPlutusExtra iopts) $ + case ioMetadata iopts of + MetadataDisable -> pure mempty + MetadataEnable -> prepareMaTxMint tracer cache Nothing txId $ Generic.txMint tx + MetadataWhitelistKeys whitelist -> prepareMaTxMint tracer cache (Just whitelist) txId $ Generic.txMint tx + -- TODO: cmdv do whitelist check here maybe? + when (isPlutusEnableOrWhitelist $ ioPlutusExtra iopts) $ mapM_ (lift . insertScript tracer txId) $ Generic.txScripts tx - when (ioPlutusExtra iopts) $ + when (isPlutusEnableOrWhitelist $ ioPlutusExtra iopts) $ mapM_ (insertExtraKeyWitness tracer txId) $ Generic.txExtraKeyWitnesses tx @@ -389,40 +402,60 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped prepareTxOut :: (MonadBaseControl IO m, MonadIO m) => - SyncEnv -> Trace IO Text -> - Cache -> InsertOptions -> + Cache -> (DB.TxId, ByteString) -> Generic.TxOut -> ExceptT SyncNodeError (ReaderT SqlBackend m) (ExtendedTxOut, [MissingMaTxOut]) -prepareTxOut syncEnv tracer cache iopts (txId, txHash) (Generic.TxOut index addr addrRaw value maMap mScript dt) = do - mSaId <- lift $ insertStakeAddressRefIfMissing tracer cache addr - mDatumId <- - whenFalseEmpty (ioPlutusExtra iopts) Nothing $ - Generic.whenInlineDatum dt $ - insertDatum tracer cache txId - mScriptId <- - whenFalseEmpty (ioPlutusExtra iopts) Nothing $ - whenMaybe mScript $ - lift . insertScript tracer txId - let !txOut = - DB.TxOut - { DB.txOutTxId = txId - , DB.txOutIndex = index - , DB.txOutAddress = Generic.renderAddress addr - , DB.txOutAddressHasScript = hasScript - , DB.txOutPaymentCred = Generic.maybePaymentCred addr - , DB.txOutStakeAddressId = mSaId - , DB.txOutValue = Generic.coinToDbLovelace value - , DB.txOutDataHash = Generic.dataHashToBytes <$> Generic.getTxOutDatumHash dt - , DB.txOutInlineDatumId = mDatumId - , DB.txOutReferenceScriptId = mScriptId - } - let !eutxo = ExtendedTxOut txHash txOut - !maTxOuts <- whenFalseMempty (ioMultiAssets iopts) $ prepareMaTxOuts syncEnv tracer cache maMap - pure (eutxo, maTxOuts) +prepareTxOut tracer iopts cache (txId, txHash) (Generic.TxOut index addr addrRaw value maMap mScript dt) = do + case ioPlutusExtra iopts of + -- can skip to part2 as mDatumId & mScriptId aren't needed + PlutusDisable -> buildExtendedTxOutPart2 Nothing Nothing + -- we've already done the plutus whitelist check in prepareTxOut + _ -> buildExtendedTxOutPart1 where + buildExtendedTxOutPart1 :: + (MonadBaseControl IO m, MonadIO m) => + ExceptT SyncNodeError (ReaderT SqlBackend m) (ExtendedTxOut, [MissingMaTxOut]) + buildExtendedTxOutPart1 = do + mDatumId <- whenFalseEmpty (ioPlutusExtra iopts) Nothing $ Generic.whenInlineDatum dt $ insertDatum tracer cache txId + mScriptId <- whenFalseEmpty (ioPlutusExtra iopts) Nothing $ whenMaybe mScript $ lift . insertScript tracer txId + buildExtendedTxOutPart2 mDatumId mScriptId + + buildExtendedTxOutPart2 :: + (MonadBaseControl IO m, MonadIO m) => + Maybe DB.DatumId -> + Maybe DB.ScriptId -> + ExceptT SyncNodeError (ReaderT SqlBackend m) (ExtendedTxOut, [MissingMaTxOut]) + buildExtendedTxOutPart2 mDatumId mScriptId = do + mSaId <- lift $ insertStakeAddressRefIfMissing tracer cache addr + let !txOut = + DB.TxOut + { DB.txOutTxId = txId + , DB.txOutIndex = index + , DB.txOutAddress = Generic.renderAddress addr + , DB.txOutAddressRaw = addrRaw + , DB.txOutAddressHasScript = hasScript + , DB.txOutPaymentCred = Generic.maybePaymentCred addr + , DB.txOutStakeAddressId = mSaId + , DB.txOutValue = Generic.coinToDbLovelace value + , DB.txOutDataHash = Generic.dataHashToBytes <$> Generic.getTxOutDatumHash dt + , DB.txOutInlineDatumId = mDatumId + , DB.txOutReferenceScriptId = mScriptId + } + let !eutxo = ExtendedTxOut txHash txOut + case ioMultiAssets iopts of + MultiAssetDisable -> pure (eutxo, mempty) + -- prepareMaTxOuts with NO multi asset whitelist check + MultiAssetEnable -> do + !maTxOuts <- prepareMaTxOuts tracer cache Nothing maMap + pure (eutxo, maTxOuts) + -- prepareMaTxOuts with a multiasset whitelist check + MultiAssetWhitelistPolicies whitelist -> do + !maTxOuts <- prepareMaTxOuts tracer cache (Just whitelist) maMap + pure (eutxo, maTxOuts) + hasScript :: Bool hasScript = maybe False Generic.hasCredScript (Generic.getPaymentCred addr) @@ -434,36 +467,53 @@ insertCollateralTxOut :: (DB.TxId, ByteString) -> Generic.TxOut -> ExceptT SyncNodeError (ReaderT SqlBackend m) () -insertCollateralTxOut tracer cache iopts (txId, _txHash) (Generic.TxOut index addr value maMap mScript dt) = do - mSaId <- lift $ insertStakeAddressRefIfMissing tracer cache addr - mDatumId <- - whenFalseEmpty (ioPlutusExtra iopts) Nothing $ - Generic.whenInlineDatum dt $ - insertDatum tracer cache txId - mScriptId <- - whenFalseEmpty (ioPlutusExtra iopts) Nothing $ - whenMaybe mScript $ - lift . insertScript tracer txId - _ <- - lift - . DB.insertCollateralTxOut - $ DB.CollateralTxOut - { DB.collateralTxOutTxId = txId - , DB.collateralTxOutIndex = index - , DB.collateralTxOutAddress = Generic.renderAddress addr - , DB.collateralTxOutAddressHasScript = hasScript - , DB.collateralTxOutPaymentCred = Generic.maybePaymentCred addr - , DB.collateralTxOutStakeAddressId = mSaId - , DB.collateralTxOutValue = Generic.coinToDbLovelace value - , DB.collateralTxOutDataHash = Generic.dataHashToBytes <$> Generic.getTxOutDatumHash dt - , DB.collateralTxOutMultiAssetsDescr = textShow maMap - , DB.collateralTxOutInlineDatumId = mDatumId - , DB.collateralTxOutReferenceScriptId = mScriptId - } - pure () +insertCollateralTxOut tracer cache inOpts (txId, _txHash) (Generic.TxOut index addr addrRaw value maMap mScript dt) = do + case ioPlutusExtra inOpts of + PlutusDisable -> do + _ <- insertColTxOutPart2 Nothing Nothing + pure () + PlutusEnable -> insertColTxOutPart1 + -- if we have a whitelist we need to check both txOutAddress OR txOutScript are in the whitelist + PlutusWhitelistScripts whitelist -> + case (mScript, Generic.maybePaymentCred addr) of + (Just script, _) -> + if Generic.txScriptHash script `elem` whitelist + then insertColTxOutPart1 + else void $ insertColTxOutPart2 Nothing Nothing + (_, Just address) -> + if address `elem` whitelist + then insertColTxOutPart1 + else void $ insertColTxOutPart2 Nothing Nothing + (Nothing, Nothing) -> void $ insertColTxOutPart2 Nothing Nothing where - -- TODO: Is there any reason to add new tables for collateral multi-assets/multi-asset-outputs + insertColTxOutPart1 = do + mDatumId <- whenFalseEmpty (isPlutusEnableOrWhitelist iopts) Nothing $ Generic.whenInlineDatum dt $ insertDatum tracer cache txId + mScriptId <- whenFalseEmpty (isPlutusEnableOrWhitelist iopts) Nothing $ whenMaybe mScript $ lift . insertScript tracer txId + insertColTxOutPart2 mDatumId mScriptId + pure () + + insertColTxOutPart2 mDatumId mScriptId = do + mSaId <- lift $ insertStakeAddressRefIfMissing tracer cache addr + _ <- + lift + . DB.insertCollateralTxOut + $ DB.CollateralTxOut + { DB.collateralTxOutTxId = txId + , DB.collateralTxOutIndex = index + , DB.collateralTxOutAddress = Generic.renderAddress addr + , DB.collateralTxOutAddressRaw = addrRaw + , DB.collateralTxOutAddressHasScript = hasScript + , DB.collateralTxOutPaymentCred = Generic.maybePaymentCred addr + , DB.collateralTxOutStakeAddressId = mSaId + , DB.collateralTxOutValue = Generic.coinToDbLovelace value + , DB.collateralTxOutDataHash = Generic.dataHashToBytes <$> Generic.getTxOutDatumHash dt + , DB.collateralTxOutMultiAssetsDescr = textShow maMap + , DB.collateralTxOutInlineDatumId = mDatumId + , DB.collateralTxOutReferenceScriptId = mScriptId + } + pure () + -- TODO: Is there any reason to add new tables for collateral multi-assets/multi-asset-outputs hasScript :: Bool hasScript = maybe False Generic.hasCredScript (Generic.getPaymentCred addr) @@ -1215,11 +1265,11 @@ insertRedeemerData tracer txId txd = do prepareTxMetadata :: (MonadBaseControl IO m, MonadIO m) => Trace IO Text -> - DB.TxId -> InsertOptions -> + DB.TxId -> Maybe (Map Word64 TxMetadataValue) -> ExceptT SyncNodeError (ReaderT SqlBackend m) [DB.TxMetadata] -prepareTxMetadata tracer txId inOpts mmetadata = do +prepareTxMetadata tracer inOpts txId mmetadata = do case mmetadata of Nothing -> pure [] Just metadata -> mapMaybeM prepare $ Map.toList metadata @@ -1229,14 +1279,14 @@ prepareTxMetadata tracer txId inOpts mmetadata = do (Word64, TxMetadataValue) -> ExceptT SyncNodeError (ReaderT SqlBackend m) (Maybe DB.TxMetadata) prepare (key, md) = do - case ioWhitelistMetadataNames inOpts of - Strict.Just metadataNames -> do - let isMatchingKey = key `elem` metadataNames - if isMatchingKey + case ioMetadata inOpts of + MetadataDisable -> mkDbTxMetadata (key, md) + MetadataEnable -> pure Nothing + MetadataWhitelistKeys whitelist -> do + -- only keep the metadata in the whitelist + if encodeUtf8 (Text.pack $ show key) `elem` whitelist then mkDbTxMetadata (key, md) else pure Nothing - -- if we have TxMetadata and keepMetadataNames is Nothing then we want to keep all metadata - Strict.Nothing -> mkDbTxMetadata (key, md) mkDbTxMetadata :: (MonadBaseControl IO m, MonadIO m) => @@ -1336,14 +1386,13 @@ insertEpochParam _tracer blkId (EpochNo epoch) params nonce = do prepareMaTxMint :: (MonadBaseControl IO m, MonadIO m) => - SyncEnv -> Trace IO Text -> Cache -> + Maybe (NonEmpty ByteString) -> DB.TxId -> MultiAsset StandardCrypto -> ExceptT SyncNodeError (ReaderT SqlBackend m) [DB.MaTxMint] -prepareMaTxMint syncEnv _tracer cache txId (MultiAsset mintMap) = - -- TODO: VINCE HERE +prepareMaTxMint _tracer cache mWhitelist txId (MultiAsset mintMap) = concatMapM (lift . prepareOuter) $ Map.toList mintMap where prepareOuter :: @@ -1351,30 +1400,33 @@ prepareMaTxMint syncEnv _tracer cache txId (MultiAsset mintMap) = (PolicyID StandardCrypto, Map AssetName Integer) -> ReaderT SqlBackend m [DB.MaTxMint] prepareOuter (policy, aMap) = - mapM (prepareInner policy) $ Map.toList aMap + mapMaybeM (prepareInner policy) $ Map.toList aMap prepareInner :: (MonadBaseControl IO m, MonadIO m) => PolicyID StandardCrypto -> (AssetName, Integer) -> - ReaderT SqlBackend m DB.MaTxMint + ReaderT SqlBackend m (Maybe DB.MaTxMint) prepareInner policy (aname, amount) = do - maId <- insertMultiAsset syncEnv cache policy aname - pure $ - DB.MaTxMint - { DB.maTxMintIdent = maId - , DB.maTxMintQuantity = DB.integerToDbInt65 amount - , DB.maTxMintTxId = txId - } + mMaId <- insertMultiAsset cache mWhitelist policy aname + pure $ case mMaId of + Just maId -> + Just $ + DB.MaTxMint + { DB.maTxMintIdent = maId + , DB.maTxMintQuantity = DB.integerToDbInt65 amount + , DB.maTxMintTxId = txId + } + Nothing -> Nothing prepareMaTxOuts :: (MonadBaseControl IO m, MonadIO m) => - SyncEnv -> Trace IO Text -> Cache -> + Maybe (NonEmpty ByteString) -> Map (PolicyID StandardCrypto) (Map AssetName Integer) -> ExceptT SyncNodeError (ReaderT SqlBackend m) [MissingMaTxOut] -prepareMaTxOuts syncEnv _tracer cache maMap = +prepareMaTxOuts _tracer cache mWhitelist maMap = concatMapM (lift . prepareOuter) $ Map.toList maMap where prepareOuter :: @@ -1382,33 +1434,45 @@ prepareMaTxOuts syncEnv _tracer cache maMap = (PolicyID StandardCrypto, Map AssetName Integer) -> ReaderT SqlBackend m [MissingMaTxOut] prepareOuter (policy, aMap) = - mapM (prepareInner policy) $ Map.toList aMap + mapMaybeM (prepareInner policy) $ Map.toList aMap prepareInner :: (MonadBaseControl IO m, MonadIO m) => PolicyID StandardCrypto -> (AssetName, Integer) -> - ReaderT SqlBackend m MissingMaTxOut + ReaderT SqlBackend m (Maybe MissingMaTxOut) prepareInner policy (aname, amount) = do - maId <- insertMultiAsset syncEnv cache policy aname - pure $ - MissingMaTxOut - { mmtoIdent = maId - , mmtoQuantity = DbWord64 (fromIntegral amount) - } + mMaId <- insertMultiAsset cache mWhitelist policy aname + pure $ case mMaId of + Just maId -> + Just $ + MissingMaTxOut + { mmtoIdent = maId + , mmtoQuantity = DbWord64 (fromIntegral amount) + } + Nothing -> Nothing insertMultiAsset :: (MonadBaseControl IO m, MonadIO m) => - SyncEnv -> Cache -> + Maybe (NonEmpty ByteString) -> PolicyID StandardCrypto -> AssetName -> - ReaderT SqlBackend m DB.MultiAssetId -insertMultiAsset _syncEnv cache policy aName = do + ReaderT SqlBackend m (Maybe DB.MultiAssetId) +insertMultiAsset cache mWhitelist policy aName = do mId <- queryMAWithCache cache policy aName case mId of - Right maId -> pure maId + Right maId -> pure $ Just maId Left (policyBs, assetNameBs) -> + case mWhitelist of + Just whitelist -> + -- + if policyBs `elem` whitelist + then Just <$> insertAssettIntoDB policyBs assetNameBs + else pure Nothing + Nothing -> Just <$> insertAssettIntoDB policyBs assetNameBs + where + insertAssettIntoDB policyBs assetNameBs = DB.insertMultiAssetUnchecked $ DB.MultiAsset { DB.multiAssetPolicy = policyBs From d4e3660f04c8591a7ec52d59dfde581360f94c61 Mon Sep 17 00:00:00 2001 From: Cmdv Date: Wed, 7 Feb 2024 11:25:59 +0000 Subject: [PATCH 3/4] refine the whitelist logic --- .../src/Cardano/DbSync/Api/Types.hs | 2 +- cardano-db-sync/src/Cardano/DbSync/Config.hs | 80 ++++++++++++++----- .../src/Cardano/DbSync/Era/Shelley/Insert.hs | 32 +++----- 3 files changed, 71 insertions(+), 43 deletions(-) diff --git a/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs index 6e6d9bab8..b5ec9a2e7 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs +++ b/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, MetadataConfig, MultiAssetConfig, PlutusConfig) +import Cardano.DbSync.Config.Types (MetadataConfig, MultiAssetConfig, PlutusConfig, SyncNodeConfig) import Cardano.DbSync.Ledger.Types (HasLedgerEnv) import Cardano.DbSync.LocalStateQuery (NoLedgerEnv) import Cardano.DbSync.Types ( diff --git a/cardano-db-sync/src/Cardano/DbSync/Config.hs b/cardano-db-sync/src/Cardano/DbSync/Config.hs index 07767934f..5cb53e933 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Config.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Config.hs @@ -20,7 +20,7 @@ module Cardano.DbSync.Config ( readCardanoGenesisConfig, readSyncNodeConfig, configureLogging, - plutusWhitelistCheckTxOut, + plutusMultiAssetWhitelistCheck, ) where import qualified Cardano.BM.Configuration.Model as Logging @@ -33,7 +33,10 @@ import Cardano.DbSync.Config.Node (NodeConfig (..), parseNodeConfig, parseSyncPr 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) @@ -92,27 +95,60 @@ coalesceConfig pcfg ncfg adjustGenesisPath = do mkAdjustPath :: SyncPreConfig -> (FilePath -> FilePath) mkAdjustPath cfg fp = takeDirectory (pcNodeConfigFilePath cfg) fp --- do a whitelist check against a list of TxOut and if one matches we keep them all -plutusWhitelistCheckTxOut :: SyncEnv -> [Generic.TxOut] -> Bool -plutusWhitelistCheckTxOut syncEnv txOuts = do - let iopts = soptInsertOptions $ envOptions syncEnv +-- check both whitelist but also checking plutus Maybes first +-- TODO: cmdv: unsure if this is correct because if plutusMaybeCheck fails then no multiasset whitelist is not checked +plutusMultiAssetWhitelistCheck :: SyncEnv -> [Generic.TxOut] -> Bool +plutusMultiAssetWhitelistCheck syncEnv txOuts = + plutusMaybeCheck txOuts && (plutusWhitelistCheck syncEnv txOuts || multiAssetWhitelistCheck syncEnv txOuts) + +plutusMaybeCheck :: [Generic.TxOut] -> Bool +plutusMaybeCheck = + any (\txOut -> isJust (Generic.txOutScript txOut) || isJust (Generic.maybePaymentCred $ Generic.txOutAddress txOut)) + +plutusWhitelistCheck :: SyncEnv -> [Generic.TxOut] -> Bool +plutusWhitelistCheck syncEnv txOuts = do + -- first check the config option case ioPlutusExtra iopts of PlutusEnable -> True PlutusDisable -> False - PlutusWhitelistScripts whitelist -> do - -- we map over our txOuts and check if txOutAddress OR txOutScript are in the whitelist - let whitelistCheck = - ( \txOut -> - case (Generic.txOutScript txOut, Generic.maybePaymentCred $ Generic.txOutAddress txOut) of - (Just script, _) -> - if Generic.txScriptHash script `elem` whitelist - then Just txOut - else Nothing - (_, Just address) -> - if address `elem` whitelist - then Just txOut - else Nothing - (Nothing, Nothing) -> Nothing - ) - <$> txOuts - any isJust whitelistCheck + PlutusWhitelistScripts plutusWhitelist -> plutuswhitelistCheck plutusWhitelist + where + iopts = soptInsertOptions $ envOptions syncEnv + plutuswhitelistCheck whitelist = do + any + ( isJust + . ( \txOut -> do + case (Generic.txOutScript txOut, Generic.maybePaymentCred $ Generic.txOutAddress txOut) of + (Just script, _) -> + if Generic.txScriptHash script `elem` whitelist + then Just txOut + else Nothing + (_, Just address) -> + if address `elem` whitelist + then Just txOut + else Nothing + (Nothing, Nothing) -> Nothing + ) + ) + txOuts + +multiAssetWhitelistCheck :: SyncEnv -> [Generic.TxOut] -> Bool +multiAssetWhitelistCheck syncEnv txOuts = do + let iopts = soptInsertOptions $ envOptions syncEnv + case ioMultiAssets iopts of + MultiAssetEnable -> True + MultiAssetDisable -> False + 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 diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs index 919de9962..d213a50ba 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs @@ -43,7 +43,7 @@ import Cardano.DbSync.Cache ( import Cardano.DbSync.Cache.Epoch (writeEpochBlockDiffToCache) import Cardano.DbSync.Cache.Types (Cache (..), CacheNew (..), EpochBlockDiff (..)) -import Cardano.DbSync.Config (plutusWhitelistCheckTxOut) +import Cardano.DbSync.Config (plutusMultiAssetWhitelistCheck) import Cardano.DbSync.Config.Types (MetadataConfig (..), MultiAssetConfig (..), PlutusConfig (..), isMetadataEnableOrWhiteList, isPlutusEnableOrWhitelist) import qualified Cardano.DbSync.Era.Shelley.Generic as Generic import Cardano.DbSync.Era.Shelley.Generic.Metadata ( @@ -324,8 +324,7 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped then do !txOutsGrouped <- do let txOuts = Generic.txOutputs tx - -- we do a plutus whitelist check - if plutusWhitelistCheckTxOut syncEnv txOuts + if plutusMultiAssetWhitelistCheck syncEnv txOuts then mapM (prepareTxOut tracer iopts cache (txId, txHash)) txOuts else pure mempty @@ -339,7 +338,7 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped !txOutsGrouped <- do let txOuts = Generic.txOutputs tx -- we do a plutus whitelist check - if plutusWhitelistCheckTxOut syncEnv txOuts + if plutusMultiAssetWhitelistCheck syncEnv txOuts then mapM (prepareTxOut tracer iopts cache (txId, txHash)) txOuts else pure mempty @@ -380,7 +379,7 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped MetadataDisable -> pure mempty MetadataEnable -> prepareMaTxMint tracer cache Nothing txId $ Generic.txMint tx MetadataWhitelistKeys whitelist -> prepareMaTxMint tracer cache (Just whitelist) txId $ Generic.txMint tx - -- TODO: cmdv do whitelist check here maybe? + when (isPlutusEnableOrWhitelist $ ioPlutusExtra iopts) $ mapM_ (lift . insertScript tracer txId) $ Generic.txScripts tx @@ -408,7 +407,7 @@ prepareTxOut :: (DB.TxId, ByteString) -> Generic.TxOut -> ExceptT SyncNodeError (ReaderT SqlBackend m) (ExtendedTxOut, [MissingMaTxOut]) -prepareTxOut tracer iopts cache (txId, txHash) (Generic.TxOut index addr addrRaw value maMap mScript dt) = do +prepareTxOut tracer iopts cache (txId, txHash) (Generic.TxOut index addr value maMap mScript dt) = do case ioPlutusExtra iopts of -- can skip to part2 as mDatumId & mScriptId aren't needed PlutusDisable -> buildExtendedTxOutPart2 Nothing Nothing @@ -419,8 +418,8 @@ prepareTxOut tracer iopts cache (txId, txHash) (Generic.TxOut index addr addrRaw (MonadBaseControl IO m, MonadIO m) => ExceptT SyncNodeError (ReaderT SqlBackend m) (ExtendedTxOut, [MissingMaTxOut]) buildExtendedTxOutPart1 = do - mDatumId <- whenFalseEmpty (ioPlutusExtra iopts) Nothing $ Generic.whenInlineDatum dt $ insertDatum tracer cache txId - mScriptId <- whenFalseEmpty (ioPlutusExtra iopts) Nothing $ whenMaybe mScript $ lift . insertScript tracer txId + mDatumId <- Generic.whenInlineDatum dt $ insertDatum tracer cache txId + mScriptId <- whenMaybe mScript $ lift . insertScript tracer txId buildExtendedTxOutPart2 mDatumId mScriptId buildExtendedTxOutPart2 :: @@ -435,7 +434,6 @@ prepareTxOut tracer iopts cache (txId, txHash) (Generic.TxOut index addr addrRaw { DB.txOutTxId = txId , DB.txOutIndex = index , DB.txOutAddress = Generic.renderAddress addr - , DB.txOutAddressRaw = addrRaw , DB.txOutAddressHasScript = hasScript , DB.txOutPaymentCred = Generic.maybePaymentCred addr , DB.txOutStakeAddressId = mSaId @@ -447,14 +445,9 @@ prepareTxOut tracer iopts cache (txId, txHash) (Generic.TxOut index addr addrRaw let !eutxo = ExtendedTxOut txHash txOut case ioMultiAssets iopts of MultiAssetDisable -> pure (eutxo, mempty) - -- prepareMaTxOuts with NO multi asset whitelist check - MultiAssetEnable -> do + _ -> do !maTxOuts <- prepareMaTxOuts tracer cache Nothing maMap pure (eutxo, maTxOuts) - -- prepareMaTxOuts with a multiasset whitelist check - MultiAssetWhitelistPolicies whitelist -> do - !maTxOuts <- prepareMaTxOuts tracer cache (Just whitelist) maMap - pure (eutxo, maTxOuts) hasScript :: Bool hasScript = maybe False Generic.hasCredScript (Generic.getPaymentCred addr) @@ -467,7 +460,7 @@ insertCollateralTxOut :: (DB.TxId, ByteString) -> Generic.TxOut -> ExceptT SyncNodeError (ReaderT SqlBackend m) () -insertCollateralTxOut tracer cache inOpts (txId, _txHash) (Generic.TxOut index addr addrRaw value maMap mScript dt) = do +insertCollateralTxOut tracer cache inOpts (txId, _txHash) (Generic.TxOut index addr value maMap mScript dt) = do case ioPlutusExtra inOpts of PlutusDisable -> do _ <- insertColTxOutPart2 Nothing Nothing @@ -487,8 +480,8 @@ insertCollateralTxOut tracer cache inOpts (txId, _txHash) (Generic.TxOut index a (Nothing, Nothing) -> void $ insertColTxOutPart2 Nothing Nothing where insertColTxOutPart1 = do - mDatumId <- whenFalseEmpty (isPlutusEnableOrWhitelist iopts) Nothing $ Generic.whenInlineDatum dt $ insertDatum tracer cache txId - mScriptId <- whenFalseEmpty (isPlutusEnableOrWhitelist iopts) Nothing $ whenMaybe mScript $ lift . insertScript tracer txId + mDatumId <- Generic.whenInlineDatum dt $ insertDatum tracer cache txId + mScriptId <- whenMaybe mScript $ lift . insertScript tracer txId insertColTxOutPart2 mDatumId mScriptId pure () @@ -501,7 +494,6 @@ insertCollateralTxOut tracer cache inOpts (txId, _txHash) (Generic.TxOut index a { DB.collateralTxOutTxId = txId , DB.collateralTxOutIndex = index , DB.collateralTxOutAddress = Generic.renderAddress addr - , DB.collateralTxOutAddressRaw = addrRaw , DB.collateralTxOutAddressHasScript = hasScript , DB.collateralTxOutPaymentCred = Generic.maybePaymentCred addr , DB.collateralTxOutStakeAddressId = mSaId @@ -1465,8 +1457,8 @@ insertMultiAsset cache mWhitelist policy aName = do Right maId -> pure $ Just maId Left (policyBs, assetNameBs) -> case mWhitelist of + -- we want to check the whitelist at the begining Just whitelist -> - -- if policyBs `elem` whitelist then Just <$> insertAssettIntoDB policyBs assetNameBs else pure Nothing From 41a1fcee8ed971cb725a507f6af1de180a16ad7b Mon Sep 17 00:00:00 2001 From: Cmdv Date: Wed, 14 Feb 2024 15:20:53 +0000 Subject: [PATCH 4/4] remove case logic and make code more idiomatic --- cardano-db-sync/src/Cardano/DbSync.hs | 3 +- cardano-db-sync/src/Cardano/DbSync/Config.hs | 39 +++++++------------- 2 files changed, 15 insertions(+), 27 deletions(-) diff --git a/cardano-db-sync/src/Cardano/DbSync.hs b/cardano-db-sync/src/Cardano/DbSync.hs index 0fc1e62f4..f3dfb7dc1 100644 --- a/cardano-db-sync/src/Cardano/DbSync.hs +++ b/cardano-db-sync/src/Cardano/DbSync.hs @@ -245,8 +245,7 @@ extractSyncOptions snp aop = , ioUseLedger = useLedger , ioShelley = enpHasShelley snp , ioRewards = True - , -- TODO: cmdv: this is where we plug configs - ioMultiAssets = MultiAssetDisable + , ioMultiAssets = MultiAssetDisable , ioMetadata = MetadataDisable , ioPlutusExtra = PlutusDisable , ioOffChainPoolData = enpHasOffChainPoolData snp diff --git a/cardano-db-sync/src/Cardano/DbSync/Config.hs b/cardano-db-sync/src/Cardano/DbSync/Config.hs index 5cb53e933..4b2704530 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Config.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Config.hs @@ -96,48 +96,37 @@ mkAdjustPath :: SyncPreConfig -> (FilePath -> FilePath) mkAdjustPath cfg fp = takeDirectory (pcNodeConfigFilePath cfg) fp -- check both whitelist but also checking plutus Maybes first --- TODO: cmdv: unsure if this is correct because if plutusMaybeCheck fails then no multiasset whitelist is not checked plutusMultiAssetWhitelistCheck :: SyncEnv -> [Generic.TxOut] -> Bool plutusMultiAssetWhitelistCheck syncEnv txOuts = - plutusMaybeCheck txOuts && (plutusWhitelistCheck syncEnv txOuts || multiAssetWhitelistCheck syncEnv txOuts) - -plutusMaybeCheck :: [Generic.TxOut] -> Bool -plutusMaybeCheck = - any (\txOut -> isJust (Generic.txOutScript txOut) || isJust (Generic.maybePaymentCred $ Generic.txOutAddress txOut)) + 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 -> False + PlutusDisable -> True PlutusWhitelistScripts plutusWhitelist -> plutuswhitelistCheck plutusWhitelist where iopts = soptInsertOptions $ envOptions syncEnv - plutuswhitelistCheck whitelist = do - any - ( isJust - . ( \txOut -> do - case (Generic.txOutScript txOut, Generic.maybePaymentCred $ Generic.txOutAddress txOut) of - (Just script, _) -> - if Generic.txScriptHash script `elem` whitelist - then Just txOut - else Nothing - (_, Just address) -> - if address `elem` whitelist - then Just txOut - else Nothing - (Nothing, Nothing) -> Nothing - ) - ) - txOuts + 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 -> False + MultiAssetDisable -> True MultiAssetWhitelistPolicies multiAssetWhitelist -> or multiAssetwhitelistCheck where