test: Add a tx out multi-assets test

Author: sgillespie

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/src/Cardano/Db/Operations/Types.hs

@@ -47,6 +47,7 @@ class (PersistEntity (TxOutTable a), PersistField (TxOutIdFor a)) => TxOutFields
   txOutInlineDatumIdField :: EntityField (TxOutTable a) (Maybe DatumId)
   txOutReferenceScriptIdField :: EntityField (TxOutTable a) (Maybe ScriptId)
   txOutConsumedByTxIdField :: EntityField (TxOutTable a) (Maybe TxId)
+  txOutMaTxOutField :: EntityField (TxOutTable a) (Maybe Text)
 
 -- TxOutCore fields
 instance TxOutFields 'TxOutCore where
@@ -60,6 +61,7 @@ instance TxOutFields 'TxOutCore where
   txOutInlineDatumIdField = C.TxOutInlineDatumId
   txOutReferenceScriptIdField = C.TxOutReferenceScriptId
   txOutConsumedByTxIdField = C.TxOutConsumedByTxId
+  txOutMaTxOutField = C.TxOutMaTxOut
 
 -- TxOutVariantAddress fields
 instance TxOutFields 'TxOutVariantAddress where
@@ -73,6 +75,7 @@ instance TxOutFields 'TxOutVariantAddress where
   txOutInlineDatumIdField = V.TxOutInlineDatumId
   txOutReferenceScriptIdField = V.TxOutReferenceScriptId
   txOutConsumedByTxIdField = V.TxOutConsumedByTxId
+  txOutMaTxOutField = V.TxOutMaTxOut
 
 --------------------------------------------------------------------------------
 -- Address