WIP: Add multi-asset metadata to tx_out

cardano-chain-gen/src/Cardano/Mock/Query.hs

@@ -1,12 +1,18 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Cardano.Mock.Query (
   queryVersionMajorFromEpoch,
   queryParamProposalFromEpoch,
   queryParamFromEpoch,
   queryNullTxDepositExists,
   queryMultiAssetCount,
+  queryTxOutMultiAssets,
   queryTxMetadataCount,
   queryDRepDistrAmount,
   queryGovActionCounts,
@@ -80,6 +86,35 @@ queryMultiAssetCount = do
 
   pure $ maybe 0 unValue (listToMaybe res)
 
+queryTxOutMultiAssets ::
+  MonadIO io =>
+  Db.TxOutTableType ->
+  ByteString ->
+  Word64 ->
+  ReaderT SqlBackend io (Maybe Text)
+queryTxOutMultiAssets txOutVariant txHash index =
+  case txOutVariant of
+    Db.TxOutCore -> queryMultiAssetsValue @'Db.TxOutCore
+    Db.TxOutVariantAddress -> queryMultiAssetsValue @'Db.TxOutVariantAddress
+  where
+    queryMultiAssetsValue ::
+      forall (t :: Db.TxOutTableType) io.
+      (MonadIO io, Db.TxOutFields t) =>
+      ReaderT SqlBackend io (Maybe Text)
+    queryMultiAssetsValue = do
+      res <- selectOne $ do
+        (tx :& txOut) <-
+          from
+            $ table @Db.Tx
+              `innerJoin` table
+            `on` (\(tx :& txOut) -> tx ^. Db.TxId ==. txOut ^. Db.txOutTxIdField @t)
+        where_ $
+          tx ^. Db.TxHash ==. val txHash
+            &&. txOut ^. Db.txOutIndexField @t ==. val index
+        pure (txOut ^. Db.txOutMaTxOutField @t)
+
+      pure (unValue =<< res)
+
 queryTxMetadataCount :: MonadIO io => ReaderT SqlBackend io Word
 queryTxMetadataCount = do
   res <- selectOne $ do

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

@@ -196,6 +196,7 @@ unitTests iom knownMigrations =
         , test "mint many multi assets" Plutus.mintMultiAssets
         , test "swap many multi assets" Plutus.swapMultiAssets
         , test "swap with multi assets disabled" Plutus.swapMultiAssetsDisabled
+        , test "multi assets tx out" Plutus.multiAssetsTxOut
         ]
     , testGroup
         "Pools and smash"

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Plutus.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
 
 #if __GLASGOW_HASKELL__ >= 908
@@ -33,14 +34,17 @@ module Test.Cardano.Db.Mock.Unit.Conway.Plutus (
   mintMultiAssets,
   swapMultiAssets,
   swapMultiAssetsDisabled,
+  multiAssetsTxOut,
 ) where
 
 import Cardano.Crypto.Hash.Class (hashToBytes)
 import qualified Cardano.Db as DB
 import qualified Cardano.Db.Schema.Core.TxOut as C
 import qualified Cardano.Db.Schema.Variant.TxOut as V
-import Cardano.DbSync.Era.Shelley.Generic.Util (renderAddress)
+import Cardano.DbSync.Era.Shelley.Generic (TxOutMultiAsset (..))
+import Cardano.DbSync.Era.Shelley.Generic.Util (renderAddress, unTxHash)
 import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Core (txIdTx)
 import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..), PolicyID (..))
 import Cardano.Ledger.Plutus.Data
 import Cardano.Ledger.SafeHash (extractHash)
@@ -49,8 +53,10 @@ import Cardano.Mock.Forging.Interpreter (withConwayLedgerState)
 import qualified Cardano.Mock.Forging.Tx.Alonzo.ScriptsExamples as Examples
 import qualified Cardano.Mock.Forging.Tx.Conway as Conway
 import Cardano.Mock.Forging.Types
-import Cardano.Mock.Query (queryMultiAssetCount)
+import Cardano.Mock.Query (queryMultiAssetCount, queryTxOutMultiAssets)
 import Cardano.Prelude hiding (head)
+import qualified Data.Aeson as Aeson
+import Data.ByteString.Lazy (fromStrict)
 import qualified Data.Map as Map
 import Data.Maybe.Strict (StrictMaybe (..))
 import GHC.Base (error)
@@ -70,7 +76,7 @@ import Test.Cardano.Db.Mock.Config (
  )
 import qualified Test.Cardano.Db.Mock.UnifiedApi as Api
 import Test.Cardano.Db.Mock.Validate
-import Test.Tasty.HUnit (Assertion ())
+import Test.Tasty.HUnit (Assertion)
 import Prelude (head, tail, (!!))
 
 ------------------------------------------------------------------------------
@@ -834,3 +840,59 @@ swapMultiAssetsDisabled =
 
     testLabel = "conwayConfigMultiAssetsDisabled"
     cfgDir = conwayConfigDir
+
+multiAssetsTxOut :: IOManager -> [(Text, Text)] -> Assertion
+multiAssetsTxOut =
+  withFullConfig conwayConfigDir testLabel $ \interpreter server dbSync -> do
+    let txOutVariant = txOutTableTypeFromConfig dbSync
+
+    startDBSync dbSync
+
+    -- Forge a multi-asset transaction
+    let assetName = head Examples.assetNames
+        policy = PolicyID Examples.alwaysMintScriptHash
+        assets = Map.singleton (head Examples.assetNames) 5
+        outValue = MaryValue (Coin 20) (MultiAsset $ Map.singleton policy assets)
+        mintValue = MultiAsset $ Map.singleton policy assets
+
+    tx <- withConwayLedgerState interpreter $ \state' ->
+      Conway.mkMultiAssetsScriptTx
+        [UTxOIndex 0]
+        (UTxOIndex 1)
+        [(UTxOAddress Examples.alwaysMintScriptAddr, outValue)]
+        []
+        mintValue
+        True
+        100
+        state'
+
+    -- Submit it
+    void $
+      Api.withConwayFindLeaderAndSubmitTx interpreter server $
+        const (Right tx)
+
+    let txHash = unTxHash (txIdTx tx)
+        txIndex = 0
+        expectedMultiAssets =
+          Just
+            [ TxOutMultiAsset
+                { txOutMaPolicyId = policy
+                , txOutMaAssetName = assetName
+                , txOutMaAmount = 5
+                }
+            ]
+
+    -- Wait for it to sync
+    assertBlockNoBackoff dbSync 1
+
+    -- Should now have tx_out.ma_tx_out
+    assertEqBackoff dbSync queryMultiAssetCount 1 [] "Expected multi-assets"
+    assertBackoff
+      dbSync
+      (queryTxOutMultiAssets txOutVariant txHash txIndex)
+      []
+      ((== expectedMultiAssets) . parseMultiAsset)
+      (const "Unexpected multi-assets")
+  where
+    testLabel = "conwayMultiAssetsTxOut"
+    parseMultiAsset = join . fmap (Aeson.decode . fromStrict . encodeUtf8)

cardano-chain-gen/test/testfiles/fingerprint/conwayMultiAssetsTxOut

@@ -0,0 +1 @@
+[12]

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

@@ -349,6 +349,7 @@ test-suite test
                         Cardano.DbSync.Config.TypesTest
                         Cardano.DbSync.Era.Shelley.Generic.ScriptDataTest
                         Cardano.DbSync.Era.Shelley.Generic.ScriptTest
+                        Cardano.DbSync.Era.Shelley.Generic.Tx.TypesTest
                         Cardano.DbSync.Gen
                         Cardano.DbSync.Util.AddressTest
                         Cardano.DbSync.Util.Bech32Test
@@ -372,6 +373,7 @@ test-suite test
                       , cardano-ledger-allegra:{cardano-ledger-allegra,testlib}
                       , cardano-ledger-alonzo:{testlib}
                       , cardano-ledger-byron
+                      , cardano-ledger-mary:{cardano-ledger-mary,testlib}
                       , cardano-ledger-shelley:{cardano-ledger-shelley,testlib} >= 1.12.3.0
                       , cardano-db
                       , cardano-db-sync

cardano-db-sync/src/Cardano/DbSync/Era/Byron/Genesis.hs

@@ -224,6 +224,7 @@ insertTxOutsByron syncEnv disInOut blkId (address, value) = do
                   , C.txOutInlineDatumId = Nothing
                   , C.txOutReferenceScriptId = Nothing
                   , C.txOutConsumedByTxId = Nothing
+                  , C.txOutMaTxOut = Nothing
                   }
           DB.TxOutVariantAddress -> do
             let addrRaw = serialize' address
@@ -244,6 +245,7 @@ insertTxOutsByron syncEnv disInOut blkId (address, value) = do
         , V.txOutAddressId = addrDetailId
         , V.txOutConsumedByTxId = Nothing
         , V.txOutStakeAddressId = Nothing
+        , V.txOutMaTxOut = Nothing
         }
 
     mkVAddress :: ByteString -> V.Address

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

@@ -363,6 +363,7 @@ insertTxOutByron syncEnv _hasConsumed bootStrap txId index txout =
               , C.txOutReferenceScriptId = Nothing
               , C.txOutStakeAddressId = Nothing -- Byron does not have a stake address.
               , C.txOutTxId = txId
+              , C.txOutMaTxOut = Nothing
               , C.txOutValue = DbLovelace (Byron.unsafeGetLovelace $ Byron.txOutValue txout)
               }
       DB.TxOutVariantAddress -> do
@@ -382,6 +383,7 @@ insertTxOutByron syncEnv _hasConsumed bootStrap txId index txout =
         , V.txOutInlineDatumId = Nothing
         , V.txOutReferenceScriptId = Nothing
         , V.txOutTxId = txId
+        , V.txOutMaTxOut = Nothing
         , V.txOutValue = DbLovelace (Byron.unsafeGetLovelace $ Byron.txOutValue txout)
         , V.txOutStakeAddressId = Nothing
         }

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Types.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
@@ -13,6 +15,7 @@ module Cardano.DbSync.Era.Shelley.Generic.Tx.Types (
   TxWithdrawal (..),
   TxIn (..),
   TxOut (..),
+  TxOutMultiAsset (..),
   TxRedeemer (..),
   TxScript (..),
   PlutusData (..),
@@ -26,6 +29,7 @@ module Cardano.DbSync.Era.Shelley.Generic.Tx.Types (
   getMaybeDatumHash,
   sumTxOutCoin,
   toTxHash,
+  fromMultiAssetMap,
 ) where
 
 import qualified Cardano.Db as DB
@@ -42,12 +46,17 @@ import Cardano.Ledger.Conway.Governance
 import Cardano.Ledger.Conway.Scripts
 import Cardano.Ledger.Conway.TxCert (ConwayTxCert)
 import Cardano.Ledger.Core (TxBody)
-import Cardano.Ledger.Mary.Value (AssetName, MultiAsset, PolicyID)
+import Cardano.Ledger.Mary.Value (AssetName (..), MultiAsset, PolicyID)
 import qualified Cardano.Ledger.Shelley.TxBody as Shelley
 import Cardano.Ledger.Shelley.TxCert
 import qualified Cardano.Ledger.TxIn as Ledger
 import Cardano.Prelude
 import Cardano.Slotting.Slot (SlotNo (..))
+import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=))
+import Data.Aeson.Types (object, withObject)
+import qualified Data.ByteString.Base16 as Base16
+import Data.ByteString.Short (fromShort, toShort)
+import qualified Data.Map as Map
 import Ouroboros.Consensus.Cardano.Block (StandardAlonzo, StandardBabbage, StandardConway, StandardCrypto, StandardShelley)
 
 data Tx = Tx
@@ -114,6 +123,13 @@ data TxOut = TxOut
   , txOutDatum :: !TxOutDatum
   }
 
+data TxOutMultiAsset = TxOutMultiAsset
+  { txOutMaPolicyId :: !(PolicyID StandardCrypto)
+  , txOutMaAssetName :: !AssetName
+  , txOutMaAmount :: !Integer
+  }
+  deriving (Eq, Show)
+
 data TxRedeemer = TxRedeemer
   { txRedeemerMem :: !Word64
   , txRedeemerSteps :: !Word64
@@ -151,6 +167,25 @@ data PoolStats = PoolStats
   , votingPower :: Maybe Coin
   }
 
+instance ToJSON TxOutMultiAsset where
+  toJSON TxOutMultiAsset {..} =
+    object
+      [ "policyId" .= txOutMaPolicyId
+      , "assetName" .= txOutMaAssetName
+      , "amount" .= txOutMaAmount
+      ]
+
+instance FromJSON TxOutMultiAsset where
+  parseJSON = withObject "MultiAsset" $ \o ->
+    TxOutMultiAsset
+      <$> o .: "policyId"
+      <*> (parseAssetName <$> o .: "assetName")
+      <*> o .: "amount"
+    where
+      parseAssetName :: Text -> AssetName
+      parseAssetName =
+        AssetName . toShort . Base16.decodeLenient . encodeUtf8
+
 toTxCert :: Word16 -> Cert -> TxCertificate
 toTxCert idx dcert =
   TxCertificate
@@ -172,6 +207,17 @@ getMaybeDatumHash :: Maybe DataHash -> TxOutDatum
 getMaybeDatumHash Nothing = NoDatum
 getMaybeDatumHash (Just hsh) = DatumHash hsh
 
+fromMultiAssetMap ::
+  Map (PolicyID StandardCrypto) (Map AssetName Integer) ->
+  [TxOutMultiAsset]
+fromMultiAssetMap = concat . toListBy foldAssets
+  where
+    foldAssets :: PolicyID StandardCrypto -> Map AssetName Integer -> [TxOutMultiAsset]
+    foldAssets policy = toListBy (TxOutMultiAsset policy)
+
+    toListBy :: (k -> a -> b) -> Map k a -> [b]
+    toListBy f = Map.foldrWithKey (\k a xs -> f k a : xs) []
+
 sumTxOutCoin :: [TxOut] -> Coin
 sumTxOutCoin = Coin . sum . map (unCoin . txOutAdaValue)
 

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

@@ -264,6 +264,7 @@ insertTxOuts syncEnv trce blkId (TxIn txInId _, txOut) = do
             , C.txOutStakeAddressId = Nothing -- No stake addresses in Shelley Genesis
             , C.txOutTxId = txId
             , C.txOutValue = Generic.coinToDbLovelace (txOut ^. Core.valueTxOutL)
+            , C.txOutMaTxOut = Nothing
             , C.txOutConsumedByTxId = Nothing
             }
     DB.TxOutVariantAddress -> do
@@ -284,6 +285,7 @@ insertTxOuts syncEnv trce blkId (TxIn txInId _, txOut) = do
         , V.txOutInlineDatumId = Nothing
         , V.txOutReferenceScriptId = Nothing
         , V.txOutTxId = txId
+        , V.txOutMaTxOut = Nothing
         , V.txOutValue = Generic.coinToDbLovelace (txOut ^. Core.valueTxOutL)
         , V.txOutStakeAddressId = Nothing -- No stake addresses in Shelley Genesis
         }

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

@@ -24,7 +24,7 @@ import Cardano.DbSync.Cache (queryTxIdWithCache, tryUpdateCacheTx)
 import Cardano.DbSync.Cache.Types (CacheStatus (..))
 import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
 import Cardano.DbSync.Era.Shelley.Generic.Metadata (TxMetadataValue (..), metadataValueToJsonNoSchema)
-import Cardano.DbSync.Era.Shelley.Generic.Tx.Types (TxIn (..))
+import Cardano.DbSync.Era.Shelley.Generic.Tx.Types (TxIn (..), fromMultiAssetMap)
 import Cardano.DbSync.Era.Universal.Insert.Certificate (insertCertificate)
 import Cardano.DbSync.Era.Universal.Insert.GovAction (
   insertGovActionProposal,
@@ -240,6 +240,7 @@ insertTxOut tracer cache iopts (txId, txHash) (Generic.TxOut index addr value ma
               , C.txOutReferenceScriptId = mScriptId
               , C.txOutStakeAddressId = mSaId
               , C.txOutTxId = txId
+              , C.txOutMaTxOut = Just multiAssetsJson
               , C.txOutValue = Generic.coinToDbLovelace value
               }
       DB.TxOutVariantAddress -> do
@@ -261,7 +262,9 @@ insertTxOut tracer cache iopts (txId, txHash) (Generic.TxOut index addr value ma
         case ioTxOutTableType iopts of
           DB.TxOutCore -> ExtendedTxOut txHash txOut
           DB.TxOutVariantAddress -> ExtendedTxOut txHash txOut
-  !maTxOuts <- whenFalseMempty (ioMultiAssets iopts) $ insertMaTxOuts tracer cache maMap
+  !maTxOuts <-
+    whenFalseMempty (ioMultiAssets iopts) $
+      insertMaTxOuts tracer cache maMap
   pure (eutxo, maTxOuts)
   where
     hasScript :: Bool
@@ -270,6 +273,10 @@ insertTxOut tracer cache iopts (txId, txHash) (Generic.TxOut index addr value ma
     addrText :: Text
     addrText = Generic.renderAddress addr
 
+    multiAssetsJson :: Text
+    multiAssetsJson =
+      decodeUtf8 . LBS.toStrict . Aeson.encode . fromMultiAssetMap $ maMap
+
     mkTxOutVariant :: Maybe DB.StakeAddressId -> V.AddressId -> Maybe DB.DatumId -> Maybe DB.ScriptId -> V.TxOut
     mkTxOutVariant mSaId addrId mDatumId mScriptId =
       V.TxOut
@@ -281,6 +288,7 @@ insertTxOut tracer cache iopts (txId, txHash) (Generic.TxOut index addr value ma
         , V.txOutReferenceScriptId = mScriptId
         , V.txOutTxId = txId
         , V.txOutValue = Generic.coinToDbLovelace value
+        , V.txOutMaTxOut = Just multiAssetsJson
         , V.txOutStakeAddressId = mSaId
         }