From 89c008145fbe80558cd743e54d964780590eeb95 Mon Sep 17 00:00:00 2001 From: Kostas Dermentzis Date: Thu, 16 Mar 2023 15:35:56 +0200 Subject: [PATCH] Allow to turn off parts of DBSync schema These parts are multi assets, metadata, plutus extra --- cardano-db-sync/src/Cardano/DbSync/Api.hs | 16 +++++++ cardano-db-sync/src/Cardano/DbSync/Default.hs | 5 ++- .../DbSync/Era/Shelley/Generic/Block.hs | 12 +++--- .../DbSync/Era/Shelley/Generic/Tx/Alonzo.hs | 12 +++--- .../DbSync/Era/Shelley/Generic/Tx/Babbage.hs | 6 +-- .../src/Cardano/DbSync/Era/Shelley/Insert.hs | 43 ++++++++++++------- cardano-db-sync/src/Cardano/DbSync/Sync.hs | 7 ++- cardano-db-sync/src/Cardano/DbSync/Util.hs | 10 +++++ 8 files changed, 77 insertions(+), 34 deletions(-) diff --git a/cardano-db-sync/src/Cardano/DbSync/Api.hs b/cardano-db-sync/src/Cardano/DbSync/Api.hs index 8e30f0ead..8c2d88bce 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Api.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Api.hs @@ -9,8 +9,10 @@ module Cardano.DbSync.Api ( SyncEnv (..), LedgerEnv (..), SyncOptions (..), + InsertOptions (..), ConsistentLevel (..), RunMigration, + defaultInsertOptions, setConsistentLevel, getConsistentLevel, isConsistent, @@ -22,6 +24,7 @@ module Cardano.DbSync.Api ( replaceConnection, verifySnapshotPoint, getTrace, + getInsertOptions, getBackend, hasLedgerState, getLatestPoints, @@ -142,10 +145,20 @@ data SyncOptions = SyncOptions , soptLedger :: !Bool , soptSkipFix :: !Bool , soptOnlyFix :: !Bool + , soptInsertOptions :: !InsertOptions , snapshotEveryFollowing :: !Word64 , snapshotEveryLagging :: !Word64 } +data InsertOptions = InsertOptions + { ioMultiAssets :: !Bool + , ioMetadata :: !Bool + , ioPlutusExtra :: !Bool + } + +defaultInsertOptions :: InsertOptions +defaultInsertOptions = InsertOptions True True True + replaceConnection :: SyncEnv -> SqlBackend -> IO () replaceConnection env sqlBackend = do atomically $ writeTVar (envBackend env) $ Strict.Just sqlBackend @@ -190,6 +203,9 @@ generateNewEpochEvents env details = do getTrace :: SyncEnv -> Trace IO Text getTrace = leTrace . envLedger +getInsertOptions :: SyncEnv -> InsertOptions +getInsertOptions = soptInsertOptions . envOptions + getSlotHash :: SqlBackend -> SlotNo -> IO [(SlotNo, ByteString)] getSlotHash backend = DB.runDbIohkNoLogging backend . DB.querySlotHash diff --git a/cardano-db-sync/src/Cardano/DbSync/Default.hs b/cardano-db-sync/src/Cardano/DbSync/Default.hs index 484a153bf..a874a2fc4 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Default.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Default.hs @@ -139,15 +139,16 @@ insertBlock env cblk applyRes firstAfterRollback tookSnapshot = do BlockAlonzo blk -> newExceptT $ insertShelley $ - Generic.fromAlonzoBlock (getPrices applyResult) blk + Generic.fromAlonzoBlock (ioPlutusExtra iopts) (getPrices applyResult) blk BlockBabbage blk -> newExceptT $ insertShelley $ - Generic.fromBabbageBlock (getPrices applyResult) blk + Generic.fromBabbageBlock (ioPlutusExtra iopts) (getPrices applyResult) blk insertEpoch details lift $ commitOrIndexes withinTwoMin withinHalfHour where tracer = getTrace env + iopts = getInsertOptions env insertEpoch details = when (soptExtended $ envOptions env) 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 e66195476..63206731a 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 @@ -118,8 +118,8 @@ fromMaryBlock blk = , blkTxs = map fromMaryTx (blockTxs blk) } -fromAlonzoBlock :: Maybe Prices -> ShelleyBlock TPraosStandard StandardAlonzo -> Block -fromAlonzoBlock mprices blk = +fromAlonzoBlock :: Bool -> Maybe Prices -> ShelleyBlock TPraosStandard StandardAlonzo -> Block +fromAlonzoBlock iope mprices blk = Block { blkEra = Alonzo , blkHash = blockHash blk @@ -132,11 +132,11 @@ fromAlonzoBlock mprices blk = , blkVrfKey = blockVrfKeyView $ blockVrfVkTPraos blk , blkOpCert = blockOpCertKeyTPraos blk , blkOpCertCounter = blockOpCertCounterTPraos blk - , blkTxs = map (fromAlonzoTx mprices) (alonzoBlockTxs blk) + , blkTxs = map (fromAlonzoTx iope mprices) (alonzoBlockTxs blk) } -fromBabbageBlock :: Maybe Prices -> ShelleyBlock PraosStandard StandardBabbage -> Block -fromBabbageBlock mprices blk = +fromBabbageBlock :: Bool -> Maybe Prices -> ShelleyBlock PraosStandard StandardBabbage -> Block +fromBabbageBlock iope mprices blk = Block { blkEra = Babbage , blkHash = blockHash blk @@ -149,7 +149,7 @@ fromBabbageBlock mprices blk = , blkVrfKey = blockVrfKeyView $ blockVrfVkPraos blk , blkOpCert = blockOpCertKeyPraos blk , blkOpCertCounter = blockOpCertCounterPraos blk - , blkTxs = map (fromBabbageTx mprices) (babbageBlockTxs blk) + , blkTxs = map (fromBabbageTx iope mprices) (babbageBlockTxs blk) } -- ------------------------------------------------------------------------------------------------- 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 051c294eb..4d840c8cb 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 @@ -62,8 +62,8 @@ import qualified Data.Set as Set import Lens.Micro import Ouroboros.Consensus.Cardano.Block (StandardAlonzo, StandardCrypto) -fromAlonzoTx :: Maybe Alonzo.Prices -> (Word64, Core.Tx StandardAlonzo) -> Tx -fromAlonzoTx mprices (blkIndex, tx) = +fromAlonzoTx :: Bool -> Maybe Alonzo.Prices -> (Word64, Core.Tx StandardAlonzo) -> Tx +fromAlonzoTx ioExtraPlutus mprices (blkIndex, tx) = Tx { txHash = txHashId tx , txBlockIndex = blkIndex @@ -125,7 +125,7 @@ fromAlonzoTx mprices (blkIndex, tx) = MaryValue ada maMap = txOut ^. Core.valueTxOutL mDataHash = txOut ^. Alonzo.dataHashTxOutL - (finalMaps, redeemers) = resolveRedeemers mprices tx + (finalMaps, redeemers) = resolveRedeemers ioExtraPlutus mprices tx -- This is true if second stage contract validation passes or there are no contracts. isValid2 :: Bool @@ -172,11 +172,13 @@ resolveRedeemers :: , Shelley.ShelleyEraTxBody era , Core.EraTx era ) => + Bool -> Maybe Alonzo.Prices -> Core.Tx era -> (RedeemerMaps, [(Word64, TxRedeemer)]) -resolveRedeemers mprices tx = - mkRdmrAndUpdateRec (initRedeemersMaps, []) $ +resolveRedeemers ioExtraPlutus mprices tx = + if not ioExtraPlutus then (initRedeemersMaps, []) + else mkRdmrAndUpdateRec (initRedeemersMaps, []) $ zip [0 ..] $ Map.toList (Alonzo.unRedeemers (tx ^. (Core.witsTxL . Alonzo.rdmrsWitsL))) where 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 022900b2e..ae4f7ebbf 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 @@ -32,8 +32,8 @@ import qualified Data.Map.Strict as Map import Lens.Micro import Ouroboros.Consensus.Shelley.Eras (StandardBabbage, StandardCrypto) -fromBabbageTx :: Maybe Alonzo.Prices -> (Word64, Core.Tx StandardBabbage) -> Tx -fromBabbageTx mprices (blkIndex, tx) = +fromBabbageTx :: Bool -> Maybe Alonzo.Prices -> (Word64, Core.Tx StandardBabbage) -> Tx +fromBabbageTx ioExtraPlutus mprices (blkIndex, tx) = Tx { txHash = txHashId tx , txBlockIndex = blkIndex @@ -114,7 +114,7 @@ fromBabbageTx mprices (blkIndex, tx) = case Alonzo.isValid tx of Alonzo.IsValid x -> x - (finalMaps, redeemers) = resolveRedeemers mprices tx + (finalMaps, redeemers) = resolveRedeemers ioExtraPlutus mprices tx (invalidBefore, invalidAfter) = getInterval $ Babbage.vldt' txBody collInputs = mkCollTxIn txBody 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 9333c714f..13f9f46ab 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs @@ -113,7 +113,7 @@ insertShelleyBlock env shouldLog withinTwoMins withinHalfHour blk details isMemb } let zippedTx = zip [0 ..] (Generic.blkTxs blk) - let txInserter = insertTx tracer cache (leNetwork lenv) isMember blkId (sdEpochNo details) (Generic.blkSlotNo blk) + let txInserter = insertTx tracer cache (getInsertOptions env) (leNetwork lenv) isMember blkId (sdEpochNo details) (Generic.blkSlotNo blk) grouped <- foldM (\grouped (idx, tx) -> txInserter idx tx grouped) mempty zippedTx minIds <- insertBlockGroupedData tracer grouped when withinHalfHour $ @@ -213,6 +213,7 @@ insertTx :: (MonadBaseControl IO m, MonadIO m) => Trace IO Text -> Cache -> + InsertOptions -> Ledger.Network -> IsPoolMember -> DB.BlockId -> @@ -222,7 +223,7 @@ insertTx :: Generic.Tx -> BlockGroupedData -> ExceptT SyncNodeError (ReaderT SqlBackend m) BlockGroupedData -insertTx tracer cache network isMember blkId epochNo slotNo blockIndex tx grouped = do +insertTx tracer cache iopts network isMember blkId epochNo slotNo blockIndex tx grouped = do let !outSum = fromIntegral $ unCoin $ Generic.txOutSum tx !withdrawalSum = fromIntegral $ unCoin $ Generic.txWithdrawalSum tx !resolvedInputs <- mapM (resolveTxInputs (fst <$> groupedTxOut grouped)) (Generic.txInputs tx) @@ -252,35 +253,39 @@ insertTx tracer cache network isMember blkId epochNo slotNo blockIndex tx groupe if not (Generic.txValidContract tx) then do - !txOutsGrouped <- mapM (prepareTxOut tracer cache (txId, txHash)) (Generic.txOutputs tx) + !txOutsGrouped <- mapM (prepareTxOut tracer cache iopts (txId, txHash)) (Generic.txOutputs tx) let !txIns = map (prepareTxIn txId Map.empty) resolvedInputs pure $ grouped <> BlockGroupedData txIns txOutsGrouped [] [] 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 (txId, txHash)) (Generic.txOutputs tx) + !txOutsGrouped <- mapM (prepareTxOut tracer cache iopts (txId, txHash)) (Generic.txOutputs tx) !redeemers <- Map.fromList <$> mapM (insertRedeemer tracer (fst <$> groupedTxOut grouped) txId) (Generic.txRedeemer tx) - mapM_ (insertDatum tracer cache txId) (Generic.txData tx) + when (ioPlutusExtra iopts) $ + mapM_ (insertDatum tracer cache txId) (Generic.txData tx) mapM_ (insertCollateralTxIn tracer txId) (Generic.txCollateralInputs tx) mapM_ (insertReferenceTxIn tracer txId) (Generic.txReferenceInputs tx) - mapM_ (insertCollateralTxOut tracer cache (txId, txHash)) (Generic.txCollateralOutputs tx) + mapM_ (insertCollateralTxOut tracer cache iopts (txId, txHash)) (Generic.txCollateralOutputs tx) - txMetadata <- prepareTxMetadata tracer txId (Generic.txMetadata tx) + txMetadata <- whenFalseMempty (ioMetadata iopts) + $ prepareTxMetadata tracer txId (Generic.txMetadata tx) mapM_ (insertCertificate tracer cache isMember network blkId txId epochNo slotNo redeemers) $ Generic.txCertificates tx mapM_ (insertWithdrawals tracer cache txId redeemers) $ Generic.txWithdrawals tx mapM_ (insertParamProposal tracer blkId txId) $ Generic.txParamProposal tx - maTxMint <- prepareMaTxMint tracer cache txId $ Generic.txMint tx + maTxMint <- whenFalseMempty (ioMetadata iopts) + $ prepareMaTxMint tracer cache txId $ Generic.txMint tx - mapM_ (insertScript tracer txId) $ Generic.txScripts tx + when (ioPlutusExtra iopts) $ + mapM_ (insertScript tracer txId) $ Generic.txScripts tx mapM_ (insertExtraKeyWitness tracer txId) $ Generic.txExtraKeyWitnesses tx @@ -291,13 +296,16 @@ prepareTxOut :: (MonadBaseControl IO m, MonadIO m) => Trace IO Text -> Cache -> + InsertOptions -> (DB.TxId, ByteString) -> Generic.TxOut -> ExceptT SyncNodeError (ReaderT SqlBackend m) (ExtendedTxOut, [MissingMaTxOut]) -prepareTxOut tracer cache (txId, txHash) (Generic.TxOut index addr addrRaw value maMap mScript dt) = do +prepareTxOut tracer cache iopts (txId, txHash) (Generic.TxOut index addr addrRaw value maMap mScript dt) = do mSaId <- lift $ insertStakeAddressRefIfMissing tracer cache txId addr - mDatumId <- Generic.whenInlineDatum dt $ insertDatum tracer cache txId - mScriptId <- whenMaybe mScript $ insertScript tracer txId + mDatumId <- whenFalseEmpty (ioPlutusExtra iopts) Nothing + $ Generic.whenInlineDatum dt $ insertDatum tracer cache txId + mScriptId <- whenFalseEmpty (ioPlutusExtra iopts) Nothing + $ whenMaybe mScript $ insertScript tracer txId let !txOut = DB.TxOut { DB.txOutTxId = txId @@ -313,7 +321,7 @@ prepareTxOut tracer cache (txId, txHash) (Generic.TxOut index addr addrRaw value , DB.txOutReferenceScriptId = mScriptId } let !eutxo = ExtendedTxOut txHash txOut - !maTxOuts <- prepareMaTxOuts tracer cache maMap + !maTxOuts <- whenFalseMempty (ioMultiAssets iopts) $ prepareMaTxOuts tracer cache maMap pure (eutxo, maTxOuts) where hasScript :: Bool @@ -323,13 +331,16 @@ insertCollateralTxOut :: (MonadBaseControl IO m, MonadIO m) => Trace IO Text -> Cache -> + InsertOptions -> (DB.TxId, ByteString) -> Generic.TxOut -> ExceptT SyncNodeError (ReaderT SqlBackend m) () -insertCollateralTxOut tracer cache (txId, _txHash) (Generic.TxOut index addr addrRaw value maMap mScript dt) = do +insertCollateralTxOut tracer cache iopts (txId, _txHash) (Generic.TxOut index addr addrRaw value maMap mScript dt) = do mSaId <- lift $ insertStakeAddressRefIfMissing tracer cache txId addr - mDatumId <- Generic.whenInlineDatum dt $ insertDatum tracer cache txId - mScriptId <- whenMaybe mScript $ insertScript tracer txId + mDatumId <- whenFalseEmpty (ioPlutusExtra iopts) Nothing + $ Generic.whenInlineDatum dt $ insertDatum tracer cache txId + mScriptId <- whenFalseEmpty (ioPlutusExtra iopts) Nothing + $ whenMaybe mScript $ insertScript tracer txId _ <- lift . DB.insertCollateralTxOut $ DB.CollateralTxOut diff --git a/cardano-db-sync/src/Cardano/DbSync/Sync.hs b/cardano-db-sync/src/Cardano/DbSync/Sync.hs index 27e2fc012..313a5cd79 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Sync.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Sync.hs @@ -155,7 +155,7 @@ runSyncNode metricsSetters trce iomgr aop snEveryFollowing snEveryLagging dbConn mkSyncEnvFromConfig trce dbConnString - (SyncOptions (enpExtended enp) aop (enpHasCache enp) (enpHasLedger enp) (enpSkipFix enp) (enpOnlyFix enp) snEveryFollowing snEveryLagging) + syncOptions (enpLedgerStateDir enp) genCfg ranAll @@ -181,7 +181,10 @@ runSyncNode metricsSetters trce iomgr aop snEveryFollowing snEveryLagging dbConn HardFork.TriggerHardForkAtEpoch (EpochNo 0) -> True _ -> False ---- ------------------------------------------------------------------------------------------------- + insertOptions = defaultInsertOptions + syncOptions = + SyncOptions (enpExtended enp) aop (enpHasCache enp) (enpHasLedger enp) (enpSkipFix enp) (enpOnlyFix enp) insertOptions snEveryFollowing snEveryLagging + runSyncNodeClient :: MetricSetters -> SyncEnv -> diff --git a/cardano-db-sync/src/Cardano/DbSync/Util.hs b/cardano-db-sync/src/Cardano/DbSync/Util.hs index 8ad1e8ad0..f118b9def 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Util.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Util.hs @@ -31,6 +31,8 @@ module Cardano.DbSync.Util ( whenMaybe, mlookup, whenRight, + whenFalseEmpty, + whenFalseMempty, ) where import Cardano.BM.Trace (Trace, logError, logInfo) @@ -217,3 +219,11 @@ whenRight ma f = case ma of Right a -> f a Left _ -> pure () + +whenFalseEmpty :: Applicative m => Bool -> a -> m a -> m a +whenFalseEmpty flag a mkAs = + if flag then mkAs else pure a + +whenFalseMempty :: (Monoid a, Applicative m) => Bool -> m a -> m a +whenFalseMempty flag mkAs = + if flag then mkAs else pure mempty