Address review comments

Test filterExistingAssets

Author: v0d1ch

hydra-cluster/src/Hydra/Cluster/Faucet.hs

@@ -44,14 +44,14 @@ data FaucetLog
   deriving stock (Eq, Show, Generic)
   deriving anyclass (ToJSON)
 
--- | Create a specially marked "seed" UTXO containing requested 'Lovelace' by
+-- | Create a specially marked "seed" UTXO containing requested 'Value' by
 -- redeeming funds available to the well-known faucet.
 seedFromFaucet ::
   ChainBackend backend =>
   backend ->
   -- | Recipient of the funds
   VerificationKey PaymentKey ->
-  -- | Amount to get from faucet
+  -- | Value to get from faucet
   Value ->
   Tracer IO FaucetLog ->
   IO UTxO

hydra-cluster/src/Hydra/Cluster/Scenarios.hs

@@ -1386,6 +1386,7 @@ canDepositPartially tracer workDir blockTime backend hydraScriptsTxId =
 
           getSnapshotUTxO n1 `shouldReturn` expectedDeposit
 
+
           send n2 $ input "Close" []
 
           deadline <- waitMatch (10 * blockTime) n2 $ \v -> do

hydra-cluster/src/HydraNode.hs

@@ -192,7 +192,8 @@ requestCommitTx :: HydraClient -> UTxO -> IO Tx
 requestCommitTx client utxos =
   requestCommitTx' client utxos Nothing Nothing
 
--- | Helper to make it easy to obtain a commit tx using some wallet utxo and optional amount.
+-- | Helper to make it easy to obtain a commit tx using some wallet utxo
+-- optional amount of lovelace and optional map of assets.
 -- Create a commit tx using the hydra-node for later submission.
 requestCommitTx' :: HydraClient -> UTxO -> Maybe Coin -> Maybe (Map PolicyId PolicyAssets) -> IO Tx
 requestCommitTx' HydraClient{apiHost = Host{hostname, port}} utxos amount tokens =

hydra-tx/src/Hydra/Tx/Deposit.hs

@@ -82,18 +82,27 @@ filterExistingAssets utxoToFilter utxoToLookup =
     let assets = valueToPolicyAssets val
         originalLovelace = selectLovelace val
         filteredAssets =
-          foldMap (uncurry policyAssetsToValue) $
-            Map.assocs $
-              Map.mapWithKey
-                ( \pid (PolicyAssets x) ->
-                    let samePid = List.filter (\(pid', _) -> pid' == pid) forLookup
-                     in case List.lookup pid samePid of
-                          Nothing -> PolicyAssets x
-                          Just (PolicyAssets foundAssets) -> PolicyAssets $ x `Map.difference` foundAssets
-                )
-                assets
+         foldMap (uncurry policyAssetsToValue) $
+          filterAssets assets forLookup
      in (i, TxOut a (lovelaceToValue originalLovelace <> filteredAssets) d r)
-  forLookup = concatMap (Map.toList . valueToPolicyAssets . txOutValue . snd) $ UTxO.toList utxoToLookup
+  forLookup =
+     -- NOTE: Uses a list to store all policies, preserving multiple entries
+     -- with the same policyId but different assets. A Map would silently
+     -- overwrite duplicates.
+     concatMap (Map.toList . valueToPolicyAssets . txOutValue . snd) $ UTxO.toList utxoToLookup
+
+ -- | Filter the first argument map of assets in case any asset exists in the second argument.
+filterAssets :: Map PolicyId PolicyAssets -> [(PolicyId, PolicyAssets)] -> [(PolicyId, PolicyAssets)]
+filterAssets assets forLookup =
+     Map.assocs $
+       Map.mapWithKey
+         ( \pid (PolicyAssets x) ->
+             let samePid = List.filter (\(pid', _) -> pid' == pid) forLookup
+              in case List.lookup pid samePid of
+                   Nothing -> PolicyAssets x
+                   Just (PolicyAssets foundAssets) -> PolicyAssets $ x `Map.difference` foundAssets
+         )
+         assets
 
 -- | Merges the two 'UTxO' favoring data coming from the first argument 'UTxO'.
 -- In case the same 'TxIn' was found in the first 'UTxO' - second 'UTxO' value

hydra-tx/test/Hydra/Tx/DepositSpec.hs

@@ -172,9 +172,10 @@ spec =
           valid `shouldBe` mempty -- All assets in policy must be valid for policy to be valid
           invalid `shouldBe` tokens
         it "splits multiassets correctly" $
-          forAll (genUTxOWithAssetsSized 5 Nothing) $ \utxo ->
-            forAll (prepareAssetMap utxo) $ \assets ->
-              property $ propSplitMultiAssetCorrectly utxo assets
+          forAll arbitrary $ \policyId ->
+            forAll (genUTxOWithAssetsSized 5 (Just policyId)) $ \utxo ->
+              forAll (prepareAssetMap utxo) $ \assets ->
+                property $ propSplitMultiAssetCorrectly utxo assets
 
       describe "property tests" $ do
         prop "preserves all input tokens (completeness)" propPreservesAllTokens
@@ -424,8 +425,8 @@ propSplitMultiAssetCorrectly utxo specifiedTokens =
    in all (checkValidTokenInUTxO utxoPolicyAssets) (Map.toList depositAssets)
         & cover 10 (containsPolicies utxoPolicyAssets specifiedTokens) "PolicyId's are completely present in the UTxO"
         & cover 10 (containsAssets utxoPolicyAssets specifiedTokens) "Assets are completely present in the UTxO"
+        & cover 10 (Map.size specifiedTokens > 5) "Assets size > 5"
         & cover 1 (Map.null specifiedTokens) "Empty Assets"
-        & cover 1 (Map.size specifiedTokens > 5) "Assets size > 5"
         & counterexample ("Valid tokens: " <> show toDeposit)
         & counterexample ("UTxO policy assets: " <> show utxoPolicyAssets)
  where