add more tests for multiAsset whitelist

cardano-chain-gen/cardano-chain-gen.cabal

@@ -61,6 +61,7 @@ library
   build-depends:        base                            >= 4.14         && < 5
                       , async
                       , aeson
+                      , base16-bytestring
                       , bytestring
                       , cardano-binary
                       , cardano-crypto-class

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Alonzo/ScriptsExamples.hs

@@ -23,6 +23,7 @@ module Cardano.Mock.Forging.Tx.Alonzo.ScriptsExamples (
   alwaysMintScriptHash,
   alwaysMintScriptAddr,
   alwaysMintScriptStake,
+  alwaysMintScriptHashRandomPolicyVal,
   scriptHash,
   assetNames,
   plutusData2,
@@ -47,6 +48,7 @@ import Codec.Serialise
 import Codec.Serialise.Encoding
 import Data.ByteString.Short
 import Data.Maybe
+import Numeric.Natural (Natural)
 import Ouroboros.Consensus.Cardano.Block (StandardAlonzo)
 import qualified PlutusCore.Data as Plutus
 import qualified PlutusLedgerApi.Test.Examples as Plutus
@@ -103,6 +105,15 @@ alwaysMintScriptStake = ScriptHashObj alwaysMintScriptHash
 mkPlutusScriptEra :: AlonzoEraScript era => PlutusBinary -> AlonzoScript era
 mkPlutusScriptEra sh = PlutusScript $ fromJust $ mkBinaryPlutusScript PlutusV1 sh
 
+alwaysMintScriptHashRandomPolicyVal :: Natural -> ScriptHash StandardCrypto
+alwaysMintScriptHashRandomPolicyVal n = scriptHash @StandardAlonzo $ alwaysMintRandomScript n
+
+alwaysMintRandomScript :: AlonzoEraScript era => Natural -> AlonzoScript era
+alwaysMintRandomScript n = mkPlutusScriptEra $ alwaysMintRandomPlutusBinary n
+
+alwaysMintRandomPlutusBinary :: Natural -> PlutusBinary
+alwaysMintRandomPlutusBinary n = PlutusBinary $ Plutus.alwaysFailingNAryFunction n
+
 scriptHash ::
   forall era.
   ( EraCrypto era ~ StandardCrypto

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

@@ -6,10 +6,13 @@ module Cardano.Mock.Query (
   queryNullTxDepositExists,
   queryMultiAssetCount,
   queryTxMetadataCount,
+  queryMultiAssetMetadataPolicy,
 ) where
 
 import qualified Cardano.Db as Db
 import Cardano.Prelude hiding (from)
+import qualified Data.ByteString.Base16 as Base16
+import Data.ByteString.Short (ShortByteString, toShort)
 import Database.Esqueleto.Experimental
 import Prelude ()
 
@@ -68,3 +71,10 @@ queryTxMetadataCount = do
     pure countRows
 
   pure $ maybe 0 unValue res
+
+queryMultiAssetMetadataPolicy :: MonadIO io => ReaderT SqlBackend io (Maybe ShortByteString)
+queryMultiAssetMetadataPolicy = do
+  res <- selectOne $ do
+    metadataPolicy <- from $ table @Db.MultiAsset
+    pure $ metadataPolicy ^. Db.MultiAssetPolicy
+  pure $ toShort . Base16.encode . unValue <$> res

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

@@ -174,6 +174,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 "add multi assets with whitelist" Plutus.addTxMultiAssetsWhitelist
         ]
     , testGroup
         "Pools and smash"

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Test.Cardano.Db.Mock.Unit.Conway.Plutus (
@@ -28,10 +29,13 @@ module Test.Cardano.Db.Mock.Unit.Conway.Plutus (
   mintMultiAssets,
   swapMultiAssets,
   swapMultiAssetsDisabled,
+  addTxMultiAssetsWhitelist,
 ) where
 
 import Cardano.Crypto.Hash.Class (hashToBytes)
 import qualified Cardano.Db as DB
+import Cardano.DbSync.Config (SyncNodeConfig (..))
+import Cardano.DbSync.Config.Types (MultiAssetConfig (..), SyncInsertOptions (..))
 import Cardano.DbSync.Era.Shelley.Generic.Util (renderAddress)
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..), PolicyID (..))
@@ -42,8 +46,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, queryMultiAssetMetadataPolicy)
 import Cardano.Prelude hiding (head)
+import Data.ByteString.Short (toShort)
+import Data.List.NonEmpty (fromList)
 import qualified Data.Map as Map
 import Data.Maybe.Strict (StrictMaybe (..))
 import Ouroboros.Consensus.Shelley.Eras (StandardConway ())
@@ -763,41 +769,133 @@ swapMultiAssets =
     testLabel = "conwaySwapMultiAssets"
 
 swapMultiAssetsDisabled :: IOManager -> [(Text, Text)] -> Assertion
-swapMultiAssetsDisabled =
-  withCustomConfig args Nothing cfgDir testLabel $ \interpreter mockServer dbSync -> do
-    startDBSync dbSync
+swapMultiAssetsDisabled ioManager metadata = do
+  syncNodeConfig <- mksNodeConfig
+  withCustomConfig cmdlArgs (Just syncNodeConfig) cfgDir testLabel action ioManager metadata
+  where
+    action = \interpreter mockServer dbSync -> do
+      startDBSync dbSync
+
+      -- Forge a block with multiple multi-asset scripts
+      void $ Api.withConwayFindLeaderAndSubmit interpreter mockServer $ \state' -> do
+        let policy = PolicyID Examples.alwaysMintScriptHash
+            assets = Map.singleton (Prelude.head Examples.assetNames) 1
+            mintedValue = MultiAsset $ Map.singleton policy assets
+            outValue = MaryValue (Coin 20) (MultiAsset $ Map.singleton policy assets)
+
+        -- Forge a multi-asset script
+        tx0 <-
+          Conway.mkMultiAssetsScriptTx
+            [UTxOIndex 0]
+            (UTxOIndex 1)
+            [(UTxOAddress Examples.alwaysSucceedsScriptAddr, outValue)]
+            []
+            mintedValue
+            True
+            100
+            state'
 
-    -- Forge a block with multiple multi-asset scripts
-    void $ Api.withConwayFindLeaderAndSubmit interpreter mockServer $ \state' -> do
-      let policy = PolicyID Examples.alwaysMintScriptHash
-          assets = Map.singleton (Prelude.head Examples.assetNames) 1
-          mintedValue = MultiAsset $ Map.singleton policy assets
-          outValue = MaryValue (Coin 20) (MultiAsset $ Map.singleton policy assets)
+        pure [tx0]
 
-      -- Forge a multi-asset script
-      tx0 <-
-        Conway.mkMultiAssetsScriptTx
-          [UTxOIndex 0]
-          (UTxOIndex 1)
-          [(UTxOAddress Examples.alwaysSucceedsScriptAddr, outValue)]
-          []
-          mintedValue
-          True
-          100
-          state'
+      -- Wait for it to sync
+      assertBlockNoBackoff dbSync 1
+      -- Verify multi-assets
+      assertEqBackoff dbSync queryMultiAssetCount 0 [] "Unexpected multi-assets"
 
-      pure [tx0]
+    cmdlArgs = initCommandLineArgs {claFullMode = False}
 
-    -- Wait for it to sync
-    assertBlockNoBackoff dbSync 1
-    -- Verify multi-assets
-    assertEqBackoff dbSync queryMultiAssetCount 0 [] "Unexpected multi-assets"
-  where
-    args =
-      initCommandLineArgs
-        { claConfigFilename = "test-db-sync-config-no-multi-assets.json"
-        , claFullMode = False
-        }
+    mksNodeConfig :: IO SyncNodeConfig
+    mksNodeConfig = do
+      initConfigFile <- mkSyncNodeConfig cfgDir cmdlArgs
+      let dncInsertOptions' = dncInsertOptions initConfigFile
+      pure $
+        initConfigFile
+          { dncInsertOptions = dncInsertOptions' {sioMultiAsset = MultiAssetDisable}
+          }
 
     testLabel = "conwayConfigMultiAssetsDisabled"
     cfgDir = conwayConfigDir
+
+addTxMultiAssetsWhitelist :: IOManager -> [(Text, Text)] -> Assertion
+addTxMultiAssetsWhitelist ioManager metadata = do
+  syncNodeConfig <- mksNodeConfig
+  withCustomConfig args (Just syncNodeConfig) cfgDir testLabel action ioManager metadata
+  where
+    action = \interpreter mockServer dbSync -> do
+      startDBSync dbSync
+      -- Forge a block with multiple multi-asset scripts
+      void $ Api.withConwayFindLeaderAndSubmit interpreter mockServer $ \state' -> do
+        let assetsMinted =
+              Map.fromList [(head Examples.assetNames, 10), (Examples.assetNames !! 1, 4)]
+            policy0 = PolicyID $ Examples.alwaysMintScriptHashRandomPolicyVal 1
+            policy1 = PolicyID $ Examples.alwaysMintScriptHashRandomPolicyVal 2
+            mintValue =
+              MultiAsset $
+                Map.fromList [(policy0, assetsMinted), (policy1, assetsMinted)]
+            assets =
+              Map.fromList [(head Examples.assetNames, 5), (Examples.assetNames !! 1, 2)]
+            outValue =
+              MaryValue (Coin 20) $
+                MultiAsset $
+                  Map.fromList [(policy0, assets), (policy1, assets)]
+
+        -- Forge a multi-asset script
+        tx0 <-
+          Conway.mkMultiAssetsScriptTx
+            [UTxOIndex 0]
+            (UTxOIndex 1)
+            [ (UTxOAddress Examples.alwaysSucceedsScriptAddr, outValue)
+            , (UTxOAddress Examples.alwaysMintScriptAddr, outValue)
+            ]
+            []
+            mintValue
+            True
+            100
+            state'
+
+        -- Consume the outputs from tx0
+        let utxos = Conway.mkUTxOConway tx0
+        tx1 <-
+          Conway.mkMultiAssetsScriptTx
+            [UTxOPair (head utxos), UTxOPair (utxos !! 1), UTxOIndex 2]
+            (UTxOIndex 3)
+            [ (UTxOAddress Examples.alwaysSucceedsScriptAddr, outValue)
+            , (UTxOAddress Examples.alwaysMintScriptAddr, outValue)
+            , (UTxOAddressNew 0, outValue)
+            , (UTxOAddressNew 0, outValue)
+            ]
+            []
+            mintValue
+            True
+            200
+            state'
+        pure [tx0, tx1]
+
+      -- Verify script counts
+      assertBlockNoBackoff dbSync 1
+      assertAlonzoCounts dbSync (2, 4, 1, 2, 4, 2, 0, 0)
+      -- create 4 multi-assets but only 2 should be added due to the whitelist
+      assertEqBackoff dbSync queryMultiAssetCount 2 [] "Expected 2 multi-assets"
+      -- do the policy match the whitelist
+      assertEqBackoff dbSync queryMultiAssetMetadataPolicy (Just policyShortBs) [] "Expected correct policy in db"
+
+    args = initCommandLineArgs {claFullMode = False}
+    testLabel = "conwayConfigMultiAssetsWhitelist"
+
+    cfgDir = conwayConfigDir
+
+    policyShortBs = toShort "4509cdddad21412c22c9164e10bc6071340ba235562f1575a35ded4d"
+
+    mksNodeConfig :: IO SyncNodeConfig
+    mksNodeConfig = do
+      initConfigFile <- mkSyncNodeConfig cfgDir args
+      let dncInsertOptions' = dncInsertOptions initConfigFile
+      pure $
+        initConfigFile
+          { dncInsertOptions =
+              dncInsertOptions'
+                { sioMultiAsset =
+                    MultiAssetPolicies $
+                      fromList [policyShortBs]
+                }
+          }

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

@@ -11,6 +11,7 @@ module Test.Cardano.Db.Mock.Unit.Conway.Tx (
   addTxMetadataWhitelistMultiple,
 ) where
 
+import Cardano.Api.Ledger (Coin (..))
 import Cardano.DbSync.Config (SyncNodeConfig (..))
 import Cardano.DbSync.Config.Types (MetadataConfig (..), SyncInsertOptions (..))
 import Cardano.Ledger.Shelley.TxAuxData (Metadatum (..))
@@ -27,7 +28,6 @@ import qualified Test.Cardano.Db.Mock.UnifiedApi as UnifiedApi
 import Test.Cardano.Db.Mock.Validate
 import Test.Tasty.HUnit (Assertion ())
 import Prelude (head)
-import Cardano.Api.Ledger (Coin(..))
 
 addSimpleTx :: IOManager -> [(Text, Text)] -> Assertion
 addSimpleTx =
@@ -135,7 +135,6 @@ addTxMetadata ioManager metadata = do
           { dncInsertOptions = dncInsertOptions' {sioMetadata = MetadataEnable}
           }
 
-
 addTxMetadataDisabled :: IOManager -> [(Text, Text)] -> Assertion
 addTxMetadataDisabled ioManager metadata = do
   syncNodeConfig <- mksNodeConfig
@@ -248,6 +247,5 @@ addTxMetadataWhitelistMultiple ioManager metadata = do
       let dncInsertOptions' = dncInsertOptions initConfigFile
       pure $
         initConfigFile
-          { dncInsertOptions = dncInsertOptions' {sioMetadata = MetadataKeys $ fromList [1,6]}
+          { dncInsertOptions = dncInsertOptions' {sioMetadata = MetadataKeys $ fromList [1, 6]}
           }
-