Merge pull request #1176 from input-output-hk/calculate-min-utxo-value

ch1bo · web-flow · commit 8f4aedc3b318 · 2023-11-23T12:05:14.000+01:00
Calculate min utxo value
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -10,6 +10,10 @@ changes.
 
 ## [0.14.0] - UNRELEASED
 
+- Remove hard-coded deposit of 2₳ from internal wallet. Now the wallet does only
+  use as much deposit for script outputs as minimally needed and reduces the Ada
+  locked throughout a head life-cycle.
+
 - Increase maximum number of parties to 5
 
 - **BREAKING** Sign the head identifier as part of snapshot signature
diff --git a/hydra-cardano-api/hydra-cardano-api.cabal b/hydra-cardano-api/hydra-cardano-api.cabal
@@ -92,6 +92,7 @@ library
     , cardano-crypto-class    >=2.1.1  && <2.2
     , cardano-ledger-allegra  >=1.2.1  && <1.3
     , cardano-ledger-alonzo   >=1.4    && <1.5
+    , cardano-ledger-api      >=1.5    && <1.6
     , cardano-ledger-babbage  >=1.4.2  && <1.5
     , cardano-ledger-binary   >=1.1.1  && <1.2
     , cardano-ledger-byron    >=1.0.0  && <1.1
diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/TxOut.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/TxOut.hs
@@ -6,8 +6,8 @@ import Hydra.Cardano.Api.TxIn (mkTxIn)
 import Hydra.Cardano.Api.TxOutValue (mkTxOutValue)
 
 import Cardano.Api.UTxO qualified as UTxO
+import Cardano.Ledger.Api qualified as Ledger
 import Cardano.Ledger.Babbage.TxInfo qualified as Ledger
-import Cardano.Ledger.Core qualified as Ledger
 import Cardano.Ledger.Credential qualified as Ledger
 import Data.List qualified as List
 import Hydra.Cardano.Api.AddressInEra (fromPlutusAddress)
@@ -27,6 +27,14 @@ txOuts' (getTxBody -> txBody) =
   let TxBody TxBodyContent{txOuts} = txBody
    in txOuts
 
+-- | Modify a 'TxOut' to set the minimum ada on the value.
+setMinUTxOValue ::
+  Ledger.PParams LedgerEra ->
+  TxOut CtxUTxO Era ->
+  TxOut ctx Era
+setMinUTxOValue pparams =
+  fromLedgerTxOut . Ledger.setMinCoinTxOut pparams . toLedgerTxOut
+
 -- | Automatically balance a given output with the minimum required amount.
 -- Number of assets, presence of datum and/or reference scripts may affect this
 -- minimum value.
diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Value.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/Value.hs
@@ -16,10 +16,7 @@ import PlutusLedgerApi.V2 qualified as Plutus
 
 -- * Extras
 
--- | Calculate minimum value for a UTxO. Note that cardano-api defines a
--- 'calculateMinimumUTxO' function but it is flawed (see NOTE below) and has an
--- unsatisfactory API because it works across multiple era.
--- XXX: Check if this is still true ^^^ and use it if not.
+-- | Calculate minimum ada as 'Value' for a 'TxOut'.
 minUTxOValue ::
   PParams LedgerEra ->
   TxOut CtxTx Era ->
diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal
@@ -303,6 +303,7 @@ test-suite tests
     , cardano-binary
     , cardano-crypto-class
     , cardano-ledger-alonzo
+    , cardano-ledger-api
     , cardano-ledger-babbage:{cardano-ledger-babbage, testlib}
     , cardano-ledger-binary
     , cardano-ledger-core
diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs
@@ -101,10 +101,6 @@ data ClosedThreadOutput = ClosedThreadOutput
 hydraHeadV1AssetName :: AssetName
 hydraHeadV1AssetName = AssetName (fromBuiltin hydraHeadV1)
 
--- FIXME: sould not be hardcoded
-headValue :: Value
-headValue = lovelaceToValue (Lovelace 2_000_000)
-
 -- * Create Hydra Head transactions
 
 -- | Create the init transaction from some 'HeadParameters' and a single TxIn
@@ -133,7 +129,7 @@ mkHeadOutput :: NetworkId -> PolicyId -> TxOutDatum ctx -> TxOut ctx
 mkHeadOutput networkId tokenPolicyId datum =
   TxOut
     (mkScriptAddress @PlutusScriptV2 networkId headScript)
-    (headValue <> valueFromList [(AssetId tokenPolicyId hydraHeadV1AssetName, 1)])
+    (valueFromList [(AssetId tokenPolicyId hydraHeadV1AssetName, 1)])
     datum
     ReferenceScriptNone
  where
@@ -159,7 +155,7 @@ mkInitialOutput networkId seedTxIn (verificationKeyHash -> pkh) =
  where
   tokenPolicyId = HeadTokens.headPolicyId seedTxIn
   initialValue =
-    headValue <> valueFromList [(AssetId tokenPolicyId (AssetName $ serialiseToRawBytes pkh), 1)]
+    valueFromList [(AssetId tokenPolicyId (AssetName $ serialiseToRawBytes pkh), 1)]
   initialAddress =
     mkScriptAddress @PlutusScriptV2 networkId initialScript
   initialScript =
diff --git a/hydra-node/src/Hydra/Chain/Direct/Wallet.hs b/hydra-node/src/Hydra/Chain/Direct/Wallet.hs
@@ -14,7 +14,7 @@ import Cardano.Ledger.Alonzo.PlutusScriptApi (language)
 import Cardano.Ledger.Alonzo.Scripts (ExUnits (ExUnits), Tag (Spend), txscriptfee)
 import Cardano.Ledger.Alonzo.TxInfo (TranslationError)
 import Cardano.Ledger.Alonzo.TxWits (AlonzoTxWits (..), RdmrPtr (RdmrPtr), Redeemers (..), txdats, txscripts)
-import Cardano.Ledger.Api (TransactionScriptFailure, evalTxExUnits, ppMaxTxExUnitsL, ppPricesL)
+import Cardano.Ledger.Api (TransactionScriptFailure, ensureMinCoinTxOut, evalTxExUnits, outputsTxBodyL, ppMaxTxExUnitsL, ppPricesL)
 import Cardano.Ledger.Babbage.Tx (body, getLanguageView, hashScriptIntegrity, refScripts, wits)
 import Cardano.Ledger.Babbage.Tx qualified as Babbage
 import Cardano.Ledger.Babbage.TxBody (BabbageTxBody (..), outputs', spendInputs')
@@ -252,15 +252,21 @@ coverFee_ pparams systemStart epochInfo lookupUTxO walletUTxO partialTx@Babbage.
           (txrdmrs wits)
       needlesslyHighFee = calculateNeedlesslyHighFee adjustedRedeemers
 
+  -- Ensure we have at least the minimum amount of ada. NOTE: setMinCointTxOut
+  -- would invalidate most Hydra protocol transactions.
+  let txOuts = body ^. outputsTxBodyL <&> ensureMinCoinTxOut pparams
+
+  -- Add a change output
   change <-
     first ErrNotEnoughFunds $
       mkChange
         output
         resolvedInputs
-        (toList $ outputs' body)
+        (toList txOuts)
         needlesslyHighFee
+  let newOutputs = txOuts <> StrictSeq.singleton change
+
   let referenceScripts = refScripts @LedgerEra (Babbage.referenceInputs' body) (Ledger.UTxO utxo)
-      newOutputs = outputs' body <> StrictSeq.singleton change
       langs =
         [ getLanguageView pparams l
         | (_hash, script) <- Map.toList $ Map.union (txscripts wits) referenceScripts
diff --git a/hydra-node/src/Hydra/Ledger/Cardano/Evaluate.hs b/hydra-node/src/Hydra/Ledger/Cardano/Evaluate.hs
@@ -18,7 +18,7 @@ import Cardano.Ledger.Alonzo.PlutusScriptApi qualified as Ledger
 import Cardano.Ledger.Alonzo.Scripts (CostModel, Prices (..), costModelsValid, emptyCostModels, mkCostModel, txscriptfee)
 import Cardano.Ledger.Alonzo.Scripts.Data qualified as Ledger
 import Cardano.Ledger.Alonzo.TxInfo (PlutusWithContext (PlutusWithContext), slotToPOSIXTime)
-import Cardano.Ledger.Api (ppCostModelsL, ppMaxBlockExUnitsL, ppMaxTxExUnitsL, ppMaxValSizeL, ppMinFeeAL, ppMinFeeBL, ppPricesL, ppProtocolVersionL)
+import Cardano.Ledger.Api (CoinPerByte (..), ppCoinsPerUTxOByteL, ppCostModelsL, ppMaxBlockExUnitsL, ppMaxTxExUnitsL, ppMaxValSizeL, ppMinFeeAL, ppMinFeeBL, ppPricesL, ppProtocolVersionL)
 import Cardano.Ledger.BaseTypes (BoundedRational (boundRational), ProtVer (..), natVersion)
 import Cardano.Ledger.Binary (getVersion)
 import Cardano.Ledger.Coin (Coin (Coin))
@@ -252,6 +252,7 @@ pparams =
     & ppMaxValSizeL .~ 1000000000
     & ppMinFeeAL .~ Coin 44
     & ppMinFeeBL .~ Coin 155381
+    & ppCoinsPerUTxOByteL .~ CoinPerByte (Coin 4310)
     & ppMaxTxExUnitsL .~ toLedgerExUnits maxTxExecutionUnits
     & ppMaxBlockExUnitsL
       .~ toLedgerExUnits
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/CollectCom.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/CollectCom.hs
@@ -28,7 +28,6 @@ import Hydra.Chain.Direct.Tx (
   InitialThreadOutput (..),
   assetNameFromVerificationKey,
   collectComTx,
-  headValue,
   hydraHeadV1AssetName,
   mkCommitDatum,
   mkHeadId,
@@ -170,8 +169,7 @@ healthyCommitOutput party committed =
   commitAddress =
     mkScriptAddress @PlutusScriptV2 testNetworkId commitScript
   commitValue =
-    headValue
-      <> foldMap txOutValue committed
+    foldMap txOutValue committed
       <> valueFromList
         [ (AssetId testPolicyId (assetNameFromVerificationKey cardanoKey), 1)
         ]
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Commit.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Commit.hs
@@ -9,6 +9,9 @@ import Hydra.Prelude
 import Hydra.Chain.Direct.TxSpec ()
 
 import Cardano.Api.UTxO qualified as UTxO
+import Cardano.Ledger.Api (bodyTxL)
+import Cardano.Ledger.Api.Tx.Body (EraTxBody (outputsTxBodyL), setMinCoinTxOut)
+import Control.Lens (mapped, (%~), (.~), (^.))
 import Data.List qualified as List
 import Data.Maybe (fromJust)
 import Hydra.Chain.Direct.Contract.Gen (genMintedOrBurnedValue)
@@ -42,12 +45,18 @@ import Test.QuickCheck (elements, oneof, scale, suchThat)
 
 healthyCommitTx :: (Tx, UTxO)
 healthyCommitTx =
-  (tx, lookupUTxO)
+  (tx', lookupUTxO)
  where
   lookupUTxO =
     UTxO.singleton (healthyIntialTxIn, toUTxOContext healthyInitialTxOut)
       <> healthyCommittedUTxO
       <> registryUTxO scriptRegistry
+
+  tx' = fromLedgerTx . setOutputsMinValue $ toLedgerTx tx
+
+  setOutputsMinValue =
+    bodyTxL . outputsTxBodyL . mapped %~ setMinCoinTxOut Fixture.pparams
+
   tx =
     commitTx
       Fixture.testNetworkId
@@ -71,7 +80,9 @@ healthyIntialTxIn :: TxIn
 healthyIntialTxIn = generateWith arbitrary 42
 
 healthyInitialTxOut :: TxOut CtxTx
-healthyInitialTxOut = mkInitialOutput Fixture.testNetworkId Fixture.testSeedInput commitVerificationKey
+healthyInitialTxOut =
+  setMinUTxOValue Fixture.pparams . toUTxOContext $
+    mkInitialOutput Fixture.testNetworkId Fixture.testSeedInput commitVerificationKey
 
 -- NOTE: A UTxO of length 2 is picked to mutate it into cases where committing a
 -- single and empty UTxO.
diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs
@@ -255,11 +255,7 @@ genAbortableOutputs parties =
     toUTxOContext $
       TxOut
         (mkScriptAddress @PlutusScriptV2 testNetworkId initialScript)
-        ( headValue
-            <> valueFromList
-              [ (AssetId testPolicyId (assetNameFromVerificationKey vk), 1)
-              ]
-        )
+        (valueFromList [(AssetId testPolicyId (assetNameFromVerificationKey vk), 1)])
         (mkTxOutDatumInline initialDatum)
         ReferenceScriptNone
 
diff --git a/hydra-node/test/Hydra/Chain/Direct/WalletSpec.hs b/hydra-node/test/Hydra/Chain/Direct/WalletSpec.hs
@@ -2,9 +2,10 @@
 
 module Hydra.Chain.Direct.WalletSpec where
 
-import Hydra.Prelude hiding (label)
+import Hydra.Prelude
 import Test.Hydra.Prelude
 
+import Cardano.Ledger.Api (bodyTxL, coinTxOutL, outputsTxBodyL)
 import Cardano.Ledger.Babbage.Tx (AlonzoTx (..))
 import Cardano.Ledger.Babbage.TxBody (BabbageTxBody (..), BabbageTxOut (..), outputs')
 import Cardano.Ledger.BaseTypes qualified as Ledger
@@ -15,6 +16,7 @@ import Cardano.Ledger.SafeHash qualified as SafeHash
 import Cardano.Ledger.Shelley.API qualified as Ledger
 import Cardano.Ledger.Val (Val (..), invert)
 import Control.Concurrent (newEmptyMVar, putMVar, takeMVar)
+import Control.Lens ((.~), (<>~), (^.))
 import Control.Tracer (nullTracer)
 import Data.Map.Strict qualified as Map
 import Data.Sequence.Strict qualified as StrictSeq
@@ -84,7 +86,9 @@ spec = parallel $ do
     prop "Seen inputs are consumed and not in the resulting UTXO" prop_seenInputsAreConsumed
 
   describe "coverFee" $ do
+    prop "sets min utxo values" prop_setsMinUTxOValue
     prop "balances transaction with fees" prop_balanceTransaction
+    prop "prefers largest utxo" prop_picksLargestUTxOToPayTheFees
 
   describe "newTinyWallet" $ do
     prop "initialises wallet by querying UTxO" $
@@ -101,8 +105,6 @@ spec = parallel $ do
         reset wallet
         assertQueryPoint QueryTip
 
-    prop "prefers largest utxo" prop_picksLargestUTxOToPayTheFees
-
 setupQuery ::
   VerificationKey PaymentKey ->
   IO (ChainQuery IO, QueryPoint -> Expectation)
@@ -196,6 +198,25 @@ prop_seenInputsAreConsumed =
 -- coverFee
 --
 
+prop_setsMinUTxOValue :: Property
+prop_setsMinUTxOValue =
+  forAllBlind (resize 0 genLedgerTx) $ \tx ->
+    forAllBlind (reasonablySized $ genOutputsForInputs tx) $ \lookupUTxO ->
+      forAllBlind (reasonablySized genUTxO) $ \walletUTxO ->
+        forAll genTxOutWithoutADA $ \txOutWithoutADA -> do
+          let newTx = tx & bodyTxL . outputsTxBodyL <>~ StrictSeq.singleton txOutWithoutADA
+          case coverFee_ Fixture.pparams Fixture.systemStart Fixture.epochInfo lookupUTxO walletUTxO newTx of
+            Left err ->
+              property False
+                & counterexample ("Error: " <> show err)
+            Right balancedTx -> do
+              let outs = toList $ balancedTx ^. bodyTxL . outputsTxBodyL
+              not (any (\o -> o ^. coinTxOutL == mempty) outs)
+                & counterexample ("No 0 ADA outputs expected:\n" <> show outs)
+ where
+  -- Generate a deliberately "under-valued" TxOut
+  genTxOutWithoutADA = arbitrary <&> coinTxOutL .~ mempty
+
 prop_balanceTransaction :: Property
 prop_balanceTransaction =
   forAllBlind (resize 0 genLedgerTx) $ \tx ->
diff --git a/hydra-plutus/scripts/mHead.plutus b/hydra-plutus/scripts/mHead.plutus
diff --git a/hydra-plutus/scripts/vInitial.plutus b/hydra-plutus/scripts/vInitial.plutus
diff --git a/hydra-plutus/src/Hydra/Contract/Initial.hs b/hydra-plutus/src/Hydra/Contract/Initial.hs
@@ -29,7 +29,7 @@ import Hydra.ScriptContext (
  )
 import PlutusCore.Core (plcVersion100)
 import PlutusLedgerApi.Common (SerialisedScript, serialiseCompiledCode)
-import PlutusLedgerApi.V1.Value (isZero)
+import PlutusLedgerApi.V1.Value (geq, isZero)
 import PlutusLedgerApi.V2 (
   CurrencySymbol,
   Datum (..),
@@ -106,7 +106,9 @@ checkCommit commitValidator headId committedRefs context =
  where
   checkCommittedValue =
     traceIfFalse $(errorCode LockedValueDoesNotMatch) $
-      lockedValue == initialValue + committedValue
+      -- NOTE: Ada in initialValue is usually lower than in the locked ADA due
+      -- to higher deposit needed for commit output than for initial output
+      lockedValue `geq` (initialValue + committedValue)
 
   checkLockedCommit =
     traceIfFalse $(errorCode MismatchCommittedTxOutInDatum) $
diff --git a/spec/onchain.tex b/spec/onchain.tex
@@ -145,7 +145,10 @@ \subsection{Commit Transaction}\label{sec:commit-tx}
 $\redeemerInitial{} = \underline{\txOutRef}_{\mathsf{committed}}$ ensures that:
 \begin{menumerate}
 	\item All committed value is in the output
-	$\valCommit{i} = \valInitial{i} \cup (\bigcup_{j=1}^{m} \val_{\mathsf{committed}_{j}})$
+	$\valCommit{i} \supseteq \valInitial{i} \cup (\bigcup_{j=1}^{m} \val_{\mathsf{committed}_{j}})$
+	\footnote{The $\supseteq$ is important for real world situations where the values
+		might not be exactly equal due to ledger constraints (i.e. to ensure a
+		minimum value on outputs).}
 	\item Currency id and committed outputs are recorded in the output datum
 	$\datumCommit{} = (\cid, C_{i})$, where
 	$C_{i} = \forall j \in \{1 \dots m\} : [(\txOutRef_{\mathsf{committed}_{j}},\bytes(o_{\mathsf{committed}_{j}}))]$
