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 3845ac1e6..b535daa66 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 8a6df52f4..acf6d6318 100644 --- a/cardano-db-sync/app/cardano-db-sync.hs +++ b/cardano-db-sync/app/cardano-db-sync.hs @@ -89,7 +89,6 @@ pRunDbSyncNode = <*> pHasMultiAssets <*> pHasMetadata <*> pWhiteListTxMetadata - <*> pWhiteListMAPolicies <*> pHasPlutusExtra <*> pHasGov <*> pHasOffChainPoolData @@ -240,14 +239,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 782345661..787d937fd 100644 --- a/cardano-db-sync/src/Cardano/DbSync.hs +++ b/cardano-db-sync/src/Cardano/DbSync.hs @@ -39,7 +39,7 @@ import Cardano.DbSync.Config.Types ( SocketPath (..), SyncCommand (..), SyncNodeConfig (..), - SyncNodeParams (..), + SyncNodeParams (..), MultiAssetConfig (..), MetadataConfig (..), PlutusConfig (..), ) import Cardano.DbSync.Database import Cardano.DbSync.DbAction @@ -56,7 +56,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) @@ -233,14 +232,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 @@ -252,11 +243,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 e24eec912..ed7232043 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..9648a8a31 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs @@ -142,7 +142,7 @@ 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 <- mapMaybeM (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 @@ -162,7 +162,7 @@ prepareTxOut :: SyncEnv -> TxCache -> (TxIn StandardCrypto, BabbageTxOut era) -> - ExceptT SyncNodeError (ReaderT SqlBackend m) (ExtendedTxOut, [MissingMaTxOut]) + ExceptT SyncNodeError (ReaderT SqlBackend m) (Maybe (ExtendedTxOut, [MissingMaTxOut])) prepareTxOut syncEnv txCache (TxIn txHash (TxIx index), txOut) = do let txHashByteString = Generic.safeHashToByteString $ unTxId txHash let genTxOut = fromTxOut index txOut diff --git a/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs index ce8741cf8..049100956 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs @@ -15,6 +15,7 @@ module Cardano.DbSync.Api.Types ( import qualified Cardano.Db as DB import Cardano.DbSync.Cache.Types (Cache) +import Cardano.DbSync.Config.Types (MetadataConfig, MultiAssetConfig, PlutusConfig) import Cardano.DbSync.Ledger.Types (HasLedgerEnv) import Cardano.DbSync.LocalStateQuery (NoLedgerEnv) import Cardano.DbSync.Types ( @@ -23,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, @@ -76,11 +77,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/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs index 0406168b5..69fcf59fb 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 (..), + isMetaDataConfigEnabled, + isMultiAssetConfigEnabled, + isPlutusConfigEnabled, 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) + +isMetaDataConfigEnabled :: MetadataConfig -> Bool +isMetaDataConfigEnabled = \case + MetadataEnable -> True + MetadataDisable -> False + MetadataWhitelistKeys _ -> True + +data MultiAssetConfig + = MultiAssetEnable + | MultiAssetDisable + | MultiAssetWhitelistPolicies (NonEmpty ByteString) + deriving (Eq, Show) + +isMultiAssetConfigEnabled :: MultiAssetConfig -> Bool +isMultiAssetConfigEnabled = \case + MultiAssetEnable -> True + MultiAssetDisable -> False + MultiAssetWhitelistPolicies _ -> True + +data PlutusConfig + = PlutusEnable + | PlutusDisable + | PlutusWhitelistScripts (NonEmpty ByteString) + deriving (Eq, Show) + +isPlutusConfigEnabled :: PlutusConfig -> Bool +isPlutusConfigEnabled = \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 f0d810b3b..a16b15b3f 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, isPlutusConfigEnabled) 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 @@ -178,13 +179,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 $ isPlutusConfigEnabled 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 daea9a4e3..24e310f98 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 @@ -36,7 +37,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 2a34f5b91..bf87d46c6 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs @@ -84,16 +84,16 @@ import Control.Monad.Extra (mapMaybeM, whenJust) import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Trans.Except.Extra (newExceptT) import qualified Data.Aeson as Aeson -import qualified Data.Binary as Binary 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 import Ouroboros.Consensus.Cardano.Block (StandardConway, StandardCrypto) +import Cardano.DbSync.Config.Types (MultiAssetConfig(..), isMetaDataConfigEnabled, isPlutusConfigEnabled, MetadataConfig (..), PlutusConfig (..)) {- HLINT ignore "Reduce duplication" -} @@ -321,7 +321,7 @@ 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 <- mapMaybeM (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`. @@ -330,15 +330,15 @@ 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 <- mapMaybeM (prepareTxOut syncEnv tracer cache iopts (txId, txHash)) (Generic.txOutputs tx) !redeemers <- Map.fromList <$> whenFalseMempty - (ioPlutusExtra iopts) + (isPlutusConfigEnabled $ ioPlutusExtra iopts) (mapM (insertRedeemer tracer disInOut (fst <$> groupedTxOut grouped) txId) (Generic.txRedeemer tx)) - when (ioPlutusExtra iopts) $ do + when (isPlutusConfigEnabled $ ioPlutusExtra iopts) $ do mapM_ (insertDatum tracer cache txId) (Generic.txData tx) mapM_ (insertCollateralTxIn tracer txId) (Generic.txCollateralInputs tx) @@ -348,11 +348,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 (isMetaDataConfigEnabled $ ioMetadata iopts) $ prepareTxMetadata tracer - txId iopts + txId (Generic.txMetadata tx) mapM_ (insertCertificate syncEnv isMember blkId txId epochNo slotNo redeemers) @@ -365,15 +365,15 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped Generic.txParamProposal tx maTxMint <- - whenFalseMempty (ioMetadata iopts) $ + whenFalseMempty (isMetaDataConfigEnabled $ ioMetadata iopts) $ prepareMaTxMint syncEnv tracer cache txId $ Generic.txMint tx - - when (ioPlutusExtra iopts) $ + -- TODO: cmdv + when (isPlutusConfigEnabled $ ioPlutusExtra iopts) $ mapM_ (lift . insertScript tracer txId) $ Generic.txScripts tx - when (ioPlutusExtra iopts) $ + when (isPlutusConfigEnabled $ ioPlutusExtra iopts) $ mapM_ (insertExtraKeyWitness tracer txId) $ Generic.txExtraKeyWitnesses tx @@ -396,35 +396,61 @@ prepareTxOut :: InsertOptions -> (DB.TxId, ByteString) -> Generic.TxOut -> - ExceptT SyncNodeError (ReaderT SqlBackend m) (ExtendedTxOut, [MissingMaTxOut]) + ExceptT SyncNodeError (ReaderT SqlBackend m) (Maybe (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.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 - !maTxOuts <- whenFalseMempty (ioMultiAssets iopts) $ prepareMaTxOuts syncEnv tracer cache maMap - pure (eutxo, maTxOuts) + case ioMultiAssets iopts of + -- do everything as normal returning a Just + MultiAssetDisable -> do + let maTxOuts = mempty + extendedTxOut <- buildExtendedTxOut + pure $ Just (extendedTxOut, maTxOuts) + MultiAssetEnable -> do + !maTxOuts <- prepareMaTxOuts syncEnv tracer cache maMap + extendedTxOut <- buildExtendedTxOut + pure $ Just (extendedTxOut, maTxOuts) + -- anything that isn't in the white list returns Nothing inclusive of the Nothing mScript + MultiAssetWhitelistPolicies whitelistNE -> + case mScript of + Nothing -> pure Nothing + Just script -> do + let whitelist = toList whitelistNE + if Generic.txScriptHash script `notElem` whitelist + then -- if the txScriptHash is not in the whitelist we return Nothing + pure Nothing + else do + !maTxOuts <- prepareMaTxOuts syncEnv tracer cache maMap + extendedTxOut <- buildExtendedTxOut + pure $ Just (extendedTxOut, maTxOuts) where + buildExtendedTxOut :: + (MonadBaseControl IO m, MonadIO m) => + ExceptT SyncNodeError (ReaderT SqlBackend m) ExtendedTxOut + buildExtendedTxOut = do + mSaId <- lift $ insertStakeAddressRefIfMissing tracer cache addr + mDatumId <- + whenFalseEmpty (isPlutusConfigEnabled $ ioPlutusExtra iopts) Nothing $ + Generic.whenInlineDatum dt $ + insertDatum tracer cache txId + mScriptId <- + whenFalseEmpty (isPlutusConfigEnabled $ 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.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 + } + pure $ ExtendedTxOut txHash txOut + hasScript :: Bool hasScript = maybe False Generic.hasCredScript (Generic.getPaymentCred addr) @@ -436,37 +462,45 @@ insertCollateralTxOut :: (DB.TxId, ByteString) -> Generic.TxOut -> ExceptT SyncNodeError (ReaderT SqlBackend m) () -insertCollateralTxOut 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 - _ <- - 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 () +insertCollateralTxOut tracer cache inOpts (txId, _txHash) (Generic.TxOut index addr addrRaw value maMap mScript dt) = do + case ioPlutusExtra inOpts of + PlutusDisable -> do + mDatumId <- Generic.whenInlineDatum dt $ insertDatum tracer cache txId + mScriptId <- whenMaybe mScript $ lift . insertScript tracer txId + mSaId <- lift $ insertStakeAddressRefIfMissing tracer cache addr + _ <- insertColTxOut mDatumId mScriptId mSaId + pure () + + PlutusEnable -> do + let mDatumId = Nothing + mScriptId = Nothing + mSaId <- lift $ insertStakeAddressRefIfMissing tracer cache addr + _ <- insertColTxOut mDatumId mScriptId mSaId + pure () + -- TODO: cmdv: we have a whitelist but what do we compare it to, txId? + PlutusWhitelistScripts _whitelist -> pure () where - -- TODO: Is there any reason to add new tables for collateral multi-assets/multi-asset-outputs + insertColTxOut mDatumId mScriptId mSaId = do + _ <- + 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) @@ -1208,11 +1242,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 @@ -1222,14 +1256,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) => @@ -1397,14 +1431,6 @@ prepareMaTxOuts syncEnv _tracer cache maMap = } Nothing -> pure Nothing --- concatMapMaybe :: Monad m => (Maybe a -> m [b]) -> [Maybe a] -> m [b] --- concatMapMaybe f xs = do --- ys <- traverse f' xs --- pure (concat ys) --- where --- f' (Just x) = f (Just x) --- f' Nothing = pure [] - insertMultiAsset :: (MonadBaseControl IO m, MonadIO m) => SyncEnv -> @@ -1413,28 +1439,48 @@ insertMultiAsset :: AssetName -> ReaderT SqlBackend m (Maybe DB.MultiAssetId) insertMultiAsset syncEnv cache policy aName = do - mId <- queryMAWithCache cache policy aName - case mId of - Right maId -> pure $ Just maId - Left (policyBs, assetNameBs) -> do - -- check if current policyBs matches with any values in MYPolicies whitelist given by user - case ioWhitelistMAPolicies $ soptInsertOptions $ envOptions syncEnv of - Strict.Just whiteListWord64 -> do - let whiteListBS = map (LBS.toStrict . Binary.encode) whiteListWord64 - if policyBs `elem` whiteListBS - then insertIntoDB policyBs assetNameBs - else pure Nothing - Strict.Nothing -> insertIntoDB policyBs assetNameBs + mMaId <- queryMAWithCache cache policy aName + -- check multiAssets config for how to handle the insert + case ioMultiAssets $ soptInsertOptions $ envOptions syncEnv of + MultiAssetDisable -> shouldInsertMAIntoDB mMaId Nothing + MultiAssetWhitelistPolicies whitelist -> shouldInsertMAIntoDB mMaId $ Just whitelist + MultiAssetEnable -> pure Nothing where - insertIntoDB policyBs assetNameBs = do - mid <- - DB.insertMultiAssetUnchecked $ - DB.MultiAsset - { DB.multiAssetPolicy = policyBs - , DB.multiAssetName = assetNameBs - , DB.multiAssetFingerprint = DB.unAssetFingerprint (DB.mkAssetFingerprint policyBs assetNameBs) - } - pure $ Just mid + shouldInsertMAIntoDB :: + (MonadBaseControl IO m, MonadIO m) => + Either (ByteString, ByteString) DB.MultiAssetId -> + Maybe (NonEmpty ByteString) -> + ReaderT SqlBackend m (Maybe DB.MultiAssetId) + shouldInsertMAIntoDB mId mWhitelist = do + case mId of + -- we already have a MultiAssetId in cache so just return it + Right maId -> pure $ Just maId + Left (policyBs, assetNameBs) -> + -- we check policyBs againsts the whitelist when MultiAssetWhitelistPolicies is active + case mWhitelist of + Nothing -> do + mid <- insertMA policyBs assetNameBs + pure $ Just mid + + Just whitelist -> do + if policyBs `elem` whitelist + then do + mid <- insertMA policyBs assetNameBs + pure $ Just mid + else pure Nothing + -- insert MultiAsset into the DB + insertMA :: + (MonadBaseControl IO m, MonadIO m) => + ByteString -> + ByteString -> + ReaderT SqlBackend m DB.MultiAssetId + insertMA policyBs assetNameBs = do + DB.insertMultiAssetUnchecked $ + DB.MultiAsset + { DB.multiAssetPolicy = policyBs + , DB.multiAssetName = assetNameBs + , DB.multiAssetFingerprint = DB.unAssetFingerprint (DB.mkAssetFingerprint policyBs assetNameBs) + } insertScript :: (MonadBaseControl IO m, MonadIO m) =>