Merge pull request #1455 from Plutonomicon/klntsky/1441-too-many-asse…

…ts-error

Add a repropducible test for #1441 (tooManyAssets error)

examples/ManyAssets.purs

@@ -0,0 +1,68 @@
+-- | Mints many assets at once. A reproduction for https://github.com/Plutonomicon/cardano-transaction-lib/issues/1441
+module Ctl.Examples.ManyAssets
+  ( contract
+  , example
+  , main
+  , mkContractWithAssertions
+  ) where
+
+import Contract.Prelude
+
+import Contract.Config (ContractParams, testnetNamiConfig)
+import Contract.Log (logInfo')
+import Contract.Monad
+  ( Contract
+  , launchAff_
+  , liftContractM
+  , liftedM
+  , runContract
+  )
+import Contract.ScriptLookups as Lookups
+import Contract.Transaction (awaitTxConfirmed, submitTxFromConstraints)
+import Contract.TxConstraints as Constraints
+import Contract.Value (singleton) as Value
+import Contract.Wallet (getWalletUtxos)
+import Ctl.Examples.Helpers (mkCurrencySymbol, mkTokenName) as Helpers
+import Ctl.Examples.PlutusV2.Scripts.AlwaysMints (alwaysMintsPolicyV2)
+import Data.Array (head, range) as Array
+import Data.Map (toUnfoldable) as Map
+
+main :: Effect Unit
+main = example testnetNamiConfig
+
+example :: ContractParams -> Effect Unit
+example cfg = launchAff_ do
+  runContract cfg contract
+
+contract :: Contract Unit
+contract =
+  mkContractWithAssertions "Examples.ManyAssets"
+
+mkContractWithAssertions
+  :: String
+  -> Contract Unit
+mkContractWithAssertions exampleName = do
+  logInfo' ("Running " <> exampleName)
+  utxos <- liftedM "Failed to get UTxOs from wallet" getWalletUtxos
+  oref <-
+    liftContractM "Utxo set is empty"
+      (fst <$> Array.head (Map.toUnfoldable utxos :: Array _))
+
+  mp /\ cs <- Helpers.mkCurrencySymbol (alwaysMintsPolicyV2)
+  tns <- for (Array.range 0 600) \i -> Helpers.mkTokenName $ "CTLNFT" <> show i
+
+  let
+    constraints :: Constraints.TxConstraints Void Void
+    constraints =
+      fold
+        (tns <#> \tn -> Constraints.mustMintValue (Value.singleton cs tn one))
+        <> Constraints.mustSpendPubKeyOutput oref
+
+    lookups :: Lookups.ScriptLookups Void
+    lookups = Lookups.mintingPolicy mp
+      <> Lookups.unspentOutputs utxos
+
+  txHash <- submitTxFromConstraints lookups constraints
+  logInfo' $ "Tx ID: " <> show txHash
+  awaitTxConfirmed txHash
+  logInfo' "Tx submitted successfully!"

test/Plutip/Contract.purs

@@ -102,6 +102,7 @@ import Ctl.Examples.Helpers
   )
 import Ctl.Examples.IncludeDatum as IncludeDatum
 import Ctl.Examples.Lose7Ada as AlwaysFails
+import Ctl.Examples.ManyAssets as ManyAssets
 import Ctl.Examples.MintsMultipleTokens
   ( mintingPolicyRdmrInt1
   , mintingPolicyRdmrInt2
@@ -156,7 +157,7 @@ import Data.Tuple.Nested (type (/\), (/\))
 import Data.UInt (UInt)
 import Effect.Class (liftEffect)
 import Effect.Exception (throw)
-import Mote (group, test)
+import Mote (group, skip, test)
 import Safe.Coerce (coerce)
 import Test.Ctl.Fixtures
   ( cip25MetadataFixture1
@@ -178,6 +179,17 @@ import Test.Spec.Assertions (shouldEqual, shouldNotEqual, shouldSatisfy)
 
 suite :: TestPlanM ContractTest Unit
 suite = do
+  skip $ group "TooManyAssetsInOutput regression - #1441" do
+    test "Mint many assets at once" do
+      let
+        distribution :: InitialUTxOs
+        distribution =
+          [ BigInt.fromInt 1000_000_000
+          , BigInt.fromInt 2000_000_000
+          ]
+      withWallets distribution \alice -> do
+        withKeyWallet alice ManyAssets.contract
+
   group "Contract interface" do
     test "Collateral selection: UTxO with lower amount is selected" do
       let