tx metadata insert custom 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

@@ -87,6 +87,7 @@ pRunDbSyncNode =
     <*> pHasShelley
     <*> pHasMultiAssets
     <*> pHasMetadata
+    <*> pKeepTxMetadata
     <*> pHasPlutusExtra
     <*> pHasGov
     <*> pHasOffChainPoolData
@@ -228,6 +229,15 @@ pSlotNo =
           <> Opt.metavar "WORD"
       )
 
+pKeepTxMetadata :: Parser [Text]
+pKeepTxMetadata =
+  Opt.many
+    ( Opt.strOption
+        ( Opt.long "keep-tx-metadata"
+            <> Opt.help "Insert a specific set of tx metadata, based on the tx metadata key names"
+        )
+    )
+
 pHasInOut :: Parser Bool
 pHasInOut =
   Opt.flag

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

@@ -235,7 +235,7 @@ extractSyncOptions snp aop =
     iopts
       | enpOnlyGov snp = onlyGovInsertOptions useLedger
       | enpOnlyUTxO snp = onlyUTxOInsertOptions
-      | enpFullMode snp = fullInsertOptions useLedger
+      | enpFullMode snp = fullInsertOptions useLedger (enpKeepMetadataNames snp)
       | enpDisableAllMode snp = disableAllInsertOptions useLedger
       | otherwise =
           InsertOptions
@@ -245,6 +245,7 @@ extractSyncOptions snp aop =
             , ioRewards = True
             , ioMultiAssets = enpHasMultiAssets snp
             , ioMetadata = enpHasMetadata snp
+            , ioKeepMetadataNames = enpKeepMetadataNames snp
             , ioPlutusExtra = enpHasPlutusExtra snp
             , ioOffChainPoolData = enpHasOffChainPoolData snp
             , ioGov = enpHasGov snp

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

@@ -199,8 +199,8 @@ getPrunes :: SyncEnv -> Bool
 getPrunes = do
   DB.pcmPruneTxOut . getPruneConsume
 
-fullInsertOptions :: Bool -> InsertOptions
-fullInsertOptions useLedger = InsertOptions True useLedger True True True True True True True
+fullInsertOptions :: Bool -> [Text] -> InsertOptions
+fullInsertOptions useLedger keepTxMDNames = InsertOptions True useLedger True True True True keepTxMDNames True True True
 
 onlyUTxOInsertOptions :: InsertOptions
 onlyUTxOInsertOptions =
@@ -211,6 +211,7 @@ onlyUTxOInsertOptions =
     , ioRewards = False
     , ioMultiAssets = True
     , ioMetadata = False
+    , ioKeepMetadataNames = []
     , ioPlutusExtra = False
     , ioOffChainPoolData = False
     , ioGov = False
@@ -220,7 +221,7 @@ 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 False useLedger False False False False [] False False False
 
 initEpochState :: EpochState
 initEpochState =

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

@@ -23,7 +23,7 @@ import Cardano.DbSync.Types (
   OffChainVoteResult,
   OffChainVoteWorkQueue,
  )
-import Cardano.Prelude (Bool, Eq, IO, Show, Word64)
+import Cardano.Prelude (Bool, Eq, IO, Show, Text, Word64)
 import Cardano.Slotting.Slot (EpochNo (..))
 import Control.Concurrent.Class.MonadSTM.Strict (
   StrictTVar,
@@ -78,6 +78,7 @@ data InsertOptions = InsertOptions
   , ioRewards :: !Bool
   , ioMultiAssets :: !Bool
   , ioMetadata :: !Bool
+  , ioKeepMetadataNames :: ![Text]
   , 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 :: ![Text]
   , enpHasPlutusExtra :: !Bool
   , enpHasGov :: !Bool
   , enpHasOffChainPoolData :: !Bool

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

@@ -80,18 +80,20 @@ 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.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 Prelude (read)
 
 {- HLINT ignore "Reduce duplication" -}
 
@@ -350,6 +352,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 +1208,38 @@ 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
-      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
-          }
+      let metadataNames = ioKeepMetadataNames inOpts
+          isMatchingKey = key `elem` map (read . Text.unpack) metadataNames
+          isMetadataNamesEmpty = null metadataNames
+      -- if the metadata names list is empty then nothing was passed to the command line flag
+      -- so we just return all metadata as normal overiding isMatchingKey.
+      if isMetadataNamesEmpty || isMatchingKey
+        then do
+          let jsonbs = LBS.toStrict $ Aeson.encode (metadataValueToJsonNoSchema md)
+              singleKeyCBORMetadata = serialiseTxMetadataToCbor $ Map.singleton key md
+          mjson <- safeDecodeToJson tracer "prepareTxMetadata" jsonbs
+          pure $
+            Just $
+              DB.TxMetadata
+                { DB.txMetadataKey = DbWord64 key
+                , DB.txMetadataJson = mjson
+                , DB.txMetadataBytes = singleKeyCBORMetadata
+                , DB.txMetadataTxId = txId
+                }
+        else pure Nothing
 
 insertCostModel ::
   (MonadBaseControl IO m, MonadIO m) =>