Allow to turn off parts of DBSync schema

These parts are multi assets, metadata, plutus extra

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
 

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)

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)
     }
 
 -- -------------------------------------------------------------------------------------------------

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

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

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

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 ->

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