Fix after the rebase

Author: v0d1ch

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

@@ -1342,14 +1342,15 @@ canDepositPartially tracer workDir blockTime backend hydraScriptsTxId =
           (walletVk, walletSk) <- generate genKeyPair
 
           tokensUTxO <- generate (genUTxOWithAssetsSized 2 (Just $ PolicyId $ CAPI.hashScript $ CAPI.PlutusScript dummyMintingScript))
-          let tokenValue = UTxO.totalValue tokensUTxO
-          let tokenAssets = valueToPolicyAssets tokenValue
+          let totalTokenValue = UTxO.totalValue tokensUTxO
+          let tokenAssets = valueToPolicyAssets totalTokenValue
+          let tokenAssetValue = foldMap ((mempty <>) . uncurry policyAssetsToValue) (Map.toList tokenAssets)
           let seedAmount = 5_000_000
           -- NOTE: We (and also the users) need to make sure we give enough ADA when committing. If deposit tx ADA amount is too low
           -- and some ADA is added to it after balancing in the wallet, then we have problems matching on the 'CommitApproved' etc.
           let commitAmount = 3_000_000
           commitUTxOWithoutTokens <- seedFromFaucet backend walletVk (lovelaceToValue seedAmount) (contramap FromFaucet tracer)
-          commitUTxOWithTokens <- seedFromFaucet backend walletVk (lovelaceToValue seedAmount <> tokenValue) (contramap FromFaucet tracer)
+          commitUTxOWithTokens <- seedFromFaucet backend walletVk (lovelaceToValue seedAmount <> totalTokenValue) (contramap FromFaucet tracer)
           -- This one is expected to fail since there is 5 ADA at the wallet address but we specified 6 ADA to commit
           (requestCommitTx' n1 commitUTxOWithoutTokens (Just 8_000_000) Nothing <&> toJSON)
             `shouldThrow` expectErrorStatus 400 (Just "AmountTooLow")
@@ -1383,7 +1384,7 @@ canDepositPartially tracer workDir blockTime backend hydraScriptsTxId =
           getSnapshotUTxO n1 `shouldReturn` expectedDeposit
           -- check that user balance contains the change from the commit tx + commitAmount in the UTxO we didn't commit
           (balance <$> Backend.queryUTxOFor backend QueryTip walletVk)
-            `shouldReturn` lovelaceToValue commitAmount
+            `shouldReturn` lovelaceToValue seedAmount
 
           send n2 $ input "Close" []
 
@@ -1401,7 +1402,8 @@ canDepositPartially tracer workDir blockTime backend hydraScriptsTxId =
 
           -- Assert final wallet balance
           (balance <$> Backend.queryUTxOFor backend QueryTip walletVk)
-            `shouldReturn` balance (commitUTxOWithoutTokens <> commitUTxOWithTokens)
+            `shouldReturn` lovelaceToValue (seedAmount + commitAmount)
+            <> tokenAssetValue
  where
   hydraTracer = contramap FromHydraNode tracer
 
@@ -1573,9 +1575,9 @@ canRecoverDepositInAnyState tracer workDir backend hydraScriptsTxId =
       -- Get some L1 funds
       (walletVk, walletSk) <- generate genKeyPair
       let commitAmount = 5_000_000
-      commitUTxO1 <- seedFromFaucet backend walletVk commitAmount (contramap FromFaucet tracer)
-      commitUTxO2 <- seedFromFaucet backend walletVk commitAmount (contramap FromFaucet tracer)
-      commitUTxO3 <- seedFromFaucet backend walletVk commitAmount (contramap FromFaucet tracer)
+      commitUTxO1 <- seedFromFaucet backend walletVk (lovelaceToValue commitAmount) (contramap FromFaucet tracer)
+      commitUTxO2 <- seedFromFaucet backend walletVk (lovelaceToValue commitAmount) (contramap FromFaucet tracer)
+      commitUTxO3 <- seedFromFaucet backend walletVk (lovelaceToValue commitAmount) (contramap FromFaucet tracer)
 
       queryWalletBalance walletVk `shouldReturn` lovelaceToValue (commitAmount * 3)
 

hydra-plutus/src/Hydra/Contract/Head.hs

@@ -298,7 +298,11 @@ checkIncrement ctx@ScriptContext{scriptContextTxInfo = txInfo} openBefore redeem
 
   mustIncreaseValue =
     traceIfFalse $(errorCode HeadValueIsNotPreserved) $
-      headInValue <> depositValue === headOutValue
+      -- NOTE: Strict equality (===) in presence of non ADA assets here
+      -- seem to make this check not work. Since we don't want to sort on-chain (inefficient)
+      -- and it is hard/impossible to sort in the off-chain code we just use PlutusTx equality which should
+      -- be enough in this case.
+      headInValue <> depositValue == headOutValue
 
   OpenDatum
     { parties = prevParties

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

@@ -74,8 +74,8 @@ depositTx networkId headId commitBlueprintTx upperSlot deadline amount tokens =
 
 -- | 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
--- will be apended to the input.
--- NOTE: We need this since mappend on 'UTxO' is happy to accept the first 'Value' it encounteres
+-- will be appended to the input.
+-- NOTE: We need this since mappend on 'UTxO' is happy to accept the first 'Value' it encounters
 -- in case 'TxId'/s are the same.
 mergeUTxO :: UTxO -> UTxO -> UTxO
 mergeUTxO utxo utxoToMerge =
@@ -126,9 +126,6 @@ pickTokensToDeposit leftoverUTxO depositTokens
       Just availQty | reqQty <= availQty -> Map.insert name reqQty matched
       _ -> matched
 
-bumpIndices :: UTxO -> UTxO
-bumpIndices utxo = UTxO.fromList $ (\(TxIn hash (TxIx n), txOut) -> (TxIn hash (TxIx $ n + 1), txOut)) <$> UTxO.toList utxo
-
 -- Helper to create TxOut with original lovelace + new value (unchanged from original).
 mkTxOutValueNotKeepingLovelace :: TxOut ctx -> Value -> TxOut ctx
 mkTxOutValueNotKeepingLovelace (TxOut addr _ datum refScript) newValue =