Merge pull request #1590 from IntersectMBO/1574-txmetadata-cmdline

Flag to keep specified Tx Metadata by key names

Author: Cmdv

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

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

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

@@ -7,6 +7,7 @@ import Cardano.DbSync.Config
 import Cardano.DbSync.Metrics (withMetricSetters)
 import Cardano.Prelude
 import Cardano.Slotting.Slot (SlotNo (..))
+import Data.List.Split (splitOn)
 import Data.String (String)
 import qualified Data.Text as Text
 import Data.Version (showVersion)
@@ -87,6 +88,7 @@ pRunDbSyncNode =
     <*> pHasShelley
     <*> pHasMultiAssets
     <*> pHasMetadata
+    <*> pKeepTxMetadata
     <*> pHasPlutusExtra
     <*> pHasGov
     <*> pHasOffChainPoolData
@@ -228,6 +230,20 @@ pSlotNo =
           <> Opt.metavar "WORD"
       )
 
+pKeepTxMetadata :: Parser [Word64]
+pKeepTxMetadata =
+  Opt.option
+    (parseCommaSeparated <$> Opt.str)
+    ( Opt.long "keep-tx-metadata"
+        <> 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"
+
 pHasInOut :: Parser Bool
 pHasInOut =
   Opt.flag

cardano-db-sync/cardano-db-sync.cabal

@@ -254,6 +254,7 @@ executable cardano-db-sync
                       , cardano-prelude
                       , cardano-slotting
                       , optparse-applicative
+                      , split
                       , text
 
 executable http-get-json-metadata

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

@@ -56,6 +56,7 @@ 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,6 +233,11 @@ extractSyncOptions snp aop =
     , snapshotEveryLagging = enpSnEveryLagging snp
     }
   where
+    maybeKeepMNames =
+      if null (enpKeepMetadataNames snp)
+        then Strict.Nothing
+        else Strict.Just (enpKeepMetadataNames snp)
+
     iopts
       | enpOnlyGov snp = onlyGovInsertOptions useLedger
       | enpOnlyUTxO snp = onlyUTxOInsertOptions
@@ -245,6 +251,7 @@ extractSyncOptions snp aop =
             , ioRewards = True
             , ioMultiAssets = enpHasMultiAssets snp
             , ioMetadata = enpHasMetadata snp
+            , ioKeepMetadataNames = maybeKeepMNames
             , ioPlutusExtra = enpHasPlutusExtra snp
             , ioOffChainPoolData = enpHasOffChainPoolData snp
             , ioGov = enpHasGov snp

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

@@ -200,7 +200,19 @@ getPrunes = do
   DB.pcmPruneTxOut . getPruneConsume
 
 fullInsertOptions :: Bool -> InsertOptions
-fullInsertOptions useLedger = InsertOptions True useLedger True True True True True True True
+fullInsertOptions useLedger =
+  InsertOptions
+    { ioInOut = True
+    , ioUseLedger = useLedger
+    , ioShelley = True
+    , ioRewards = True
+    , ioMultiAssets = True
+    , ioMetadata = True
+    , ioKeepMetadataNames = Strict.Nothing
+    , ioPlutusExtra = True
+    , ioOffChainPoolData = True
+    , ioGov = True
+    }
 
 onlyUTxOInsertOptions :: InsertOptions
 onlyUTxOInsertOptions =
@@ -211,6 +223,7 @@ onlyUTxOInsertOptions =
     , ioRewards = False
     , ioMultiAssets = True
     , ioMetadata = False
+    , ioKeepMetadataNames = Strict.Nothing
     , ioPlutusExtra = False
     , ioOffChainPoolData = False
     , ioGov = False
@@ -220,7 +233,19 @@ onlyGovInsertOptions :: Bool -> InsertOptions
 onlyGovInsertOptions useLedger = (disableAllInsertOptions useLedger) {ioGov = True}
 
 disableAllInsertOptions :: Bool -> InsertOptions
-disableAllInsertOptions useLedger = InsertOptions False useLedger False False False False False False False
+disableAllInsertOptions useLedger =
+  InsertOptions
+    { ioInOut = False
+    , ioUseLedger = useLedger
+    , ioShelley = False
+    , ioRewards = False
+    , ioMultiAssets = False
+    , ioMetadata = False
+    , ioKeepMetadataNames = Strict.Nothing
+    , ioPlutusExtra = False
+    , ioOffChainPoolData = False
+    , ioGov = False
+    }
 
 initEpochState :: EpochState
 initEpochState =

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

@@ -78,6 +78,7 @@ data InsertOptions = InsertOptions
   , ioRewards :: !Bool
   , ioMultiAssets :: !Bool
   , ioMetadata :: !Bool
+  , ioKeepMetadataNames :: Strict.Maybe [Word64]
   , ioPlutusExtra :: !Bool
   , ioOffChainPoolData :: !Bool
   , ioGov :: !Bool

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

@@ -72,6 +72,7 @@ data SyncNodeParams = SyncNodeParams
   , enpHasShelley :: !Bool
   , enpHasMultiAssets :: !Bool
   , enpHasMetadata :: !Bool
+  , enpKeepMetadataNames :: ![Word64]
   , enpHasPlutusExtra :: !Bool
   , enpHasGov :: !Bool
   , enpHasOffChainPoolData :: !Bool

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

@@ -80,14 +80,15 @@ import qualified Cardano.Ledger.Shelley.API.Wallet as Shelley
 import qualified Cardano.Ledger.Shelley.TxBody as Shelley
 import Cardano.Ledger.Shelley.TxCert
 import Cardano.Prelude
-import Control.Monad.Extra (whenJust)
+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.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.Encoding as Text
 import Database.Persist.Sql (SqlBackend)
 import Lens.Micro
@@ -350,6 +351,7 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped
           prepareTxMetadata
             tracer
             txId
+            iopts
             (Generic.txMetadata tx)
       mapM_
         (insertCertificate syncEnv isMember blkId txId epochNo slotNo redeemers)
@@ -1205,28 +1207,44 @@ prepareTxMetadata ::
   (MonadBaseControl IO m, MonadIO m) =>
   Trace IO Text ->
   DB.TxId ->
+  InsertOptions ->
   Maybe (Map Word64 TxMetadataValue) ->
   ExceptT SyncNodeError (ReaderT SqlBackend m) [DB.TxMetadata]
-prepareTxMetadata tracer txId mmetadata =
+prepareTxMetadata tracer txId inOpts mmetadata = do
   case mmetadata of
     Nothing -> pure []
-    Just metadata -> mapM prepare $ Map.toList metadata
+    Just metadata -> mapMaybeM prepare $ Map.toList metadata
   where
     prepare ::
       (MonadBaseControl IO m, MonadIO m) =>
       (Word64, TxMetadataValue) ->
-      ExceptT SyncNodeError (ReaderT SqlBackend m) DB.TxMetadata
+      ExceptT SyncNodeError (ReaderT SqlBackend m) (Maybe DB.TxMetadata)
     prepare (key, md) = do
+      case ioKeepMetadataNames inOpts of
+        Strict.Just metadataNames -> do
+          let isMatchingKey = key `elem` metadataNames
+          if isMatchingKey
+            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) =>
+      (Word64, TxMetadataValue) ->
+      ExceptT SyncNodeError (ReaderT SqlBackend m) (Maybe DB.TxMetadata)
+    mkDbTxMetadata (key, md) = do
       let jsonbs = LBS.toStrict $ Aeson.encode (metadataValueToJsonNoSchema md)
           singleKeyCBORMetadata = serialiseTxMetadataToCbor $ Map.singleton key md
       mjson <- safeDecodeToJson tracer "prepareTxMetadata" jsonbs
-      pure
-        DB.TxMetadata
-          { DB.txMetadataKey = DbWord64 key
-          , DB.txMetadataJson = mjson
-          , DB.txMetadataBytes = singleKeyCBORMetadata
-          , DB.txMetadataTxId = txId
-          }
+      pure $
+        Just $
+          DB.TxMetadata
+            { DB.txMetadataKey = DbWord64 key
+            , DB.txMetadataJson = mjson
+            , DB.txMetadataBytes = singleKeyCBORMetadata
+            , DB.txMetadataTxId = txId
+            }
 
 insertCostModel ::
   (MonadBaseControl IO m, MonadIO m) =>

doc/configuration.md

@@ -154,3 +154,9 @@ Some field are left empty when using this flag, like
 - `redeemer.script_hash` is left Null
 
 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
+
+This flag was introduced in v.13.2.0.0 as all postgres field with the type jsonb were removed to improve insertion performance.
+If they are required and you have database queries against jsonb then activate this flag to re-introduce the type jsonb.
+You can pass multiple values to the flag eg: `--keep-tx-metadata 1,2,3` make sure you are using commas between each key.