Reject too low deposits (#2106)

fix #1902 

Following deposit workflow leads to failing deposits:
- User requests a decommit providing the UTxO with less than
`minADAUTxO` value
- Deposit utxo get's recorded (with this small value)
- Hydra node autobalances the transaction so the locked UTxO has
increased value but otherwise looks the same
- When trying to post increment transaction we experience `H4` because
of value mismatch between the UTxO we recorded and used for posting an
increment and what was actually locked in the deposit script

As a simple workaround we want to calculate `minADAUTxO` when receiving
the deposit UTxO and reject the request in case the provided value is
_too small_.

---

<!-- Consider each and tick it off one way or the other -->
* [x] CHANGELOG updated or not needed
* [x] Documentation updated or not needed
* [x] Haddocks updated or not needed
* [x] No new TODOs introduced or explained herafter

Author: v0d1ch

CHANGELOG.md

@@ -16,6 +16,8 @@ changes.
 
 - Bugfix for incorrect logic around fanning out with decommit/commit in progress
 
+- Hydra node now rejects requests for incremental commits if provided UTxO is below the limit.
+
 ## [0.22.2] - 2025.06.30
 
 * Fix wrong hydra-script-tx-ids in networks.json

hydra-cardano-api/src/Hydra/Cardano/Api/Value.hs

@@ -22,6 +22,8 @@ containsValue a b =
   positive (_, q) = q >= 0
 
 -- | Calculate minimum ada as 'Value' for a 'TxOut'.
+-- NOTE: This function can throw although you can't tell from the signature.
+-- 'toLedgerValue' can error out with _Illegal Value in TxOut_
 minUTxOValue ::
   PParams LedgerEra ->
   TxOut CtxTx Era ->

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

@@ -91,6 +91,7 @@ import Hydra.Cardano.Api (
   pattern TxOut,
   pattern TxOutDatumNone,
  )
+import Hydra.Chain (PostTxError (..))
 import Hydra.Chain.Backend (ChainBackend, buildTransaction, buildTransactionWithPParams, buildTransactionWithPParams')
 import Hydra.Chain.Backend qualified as Backend
 import Hydra.Cluster.Faucet (FaucetLog, createOutputAtAddress, seedFromFaucet, seedFromFaucet_)
@@ -150,7 +151,7 @@ import Network.HTTP.Types (urlEncode)
 import System.FilePath ((</>))
 import System.Process (callProcess)
 import Test.Hydra.Tx.Fixture (testNetworkId)
-import Test.Hydra.Tx.Gen (genKeyPair)
+import Test.Hydra.Tx.Gen (genDatum, genKeyPair, genTxOutWithReferenceScript)
 import Test.QuickCheck (choose, elements, generate)
 
 data EndToEndLog
@@ -1292,6 +1293,54 @@ canCommit tracer workDir blockTime backend hydraScriptsTxId =
 
   hydraNodeBaseUrl HydraClient{hydraNodeId} = "http://127.0.0.1:" <> show (4000 + hydraNodeId)
 
+rejectCommit :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> NominalDiffTime -> backend -> [TxId] -> IO ()
+rejectCommit tracer workDir blockTime backend hydraScriptsTxId =
+  (`finally` returnFundsToFaucet tracer backend Alice) $ do
+    refuelIfNeeded tracer backend Alice 30_000_000
+    -- NOTE: Adapt periods to block times
+    let contestationPeriod = truncate $ 10 * blockTime
+        depositPeriod = truncate $ 100 * blockTime
+    networkId <- Backend.queryNetworkId backend
+    aliceChainConfig <-
+      chainConfigFor Alice workDir backend hydraScriptsTxId [] contestationPeriod
+        <&> setNetworkId networkId . modifyConfig (\c -> c{depositPeriod})
+
+    let pparamsDecorator = atKey "utxoCostPerByte" ?~ toJSON (Aeson.Number 4310)
+    optionsWithUTxOCostPerByte <- prepareHydraNode aliceChainConfig workDir 1 aliceSk [] [] pparamsDecorator
+
+    withPreparedHydraNode hydraTracer workDir 1 optionsWithUTxOCostPerByte $ \n1 -> do
+      send n1 $ input "Init" []
+      headId <- waitMatch (10 * blockTime) n1 $ headIsInitializingWith (Set.fromList [alice])
+
+      -- Commit nothing
+      requestCommitTx n1 mempty >>= Backend.submitTransaction backend
+      waitFor hydraTracer (20 * blockTime) [n1] $
+        output "HeadIsOpen" ["utxo" .= object mempty, "headId" .= headId]
+
+      -- Get some L1 funds
+      (walletVk, _) <- generate genKeyPair
+      commitUTxO' <- seedFromFaucet backend walletVk 1_000_000 (contramap FromFaucet tracer)
+      TxOut _ _ _ refScript <- generate genTxOutWithReferenceScript
+      datum <- generate genDatum
+      let commitUTxO :: UTxO.UTxO =
+            UTxO.fromList $
+              (\(i, TxOut addr _ _ _) -> (i, TxOut addr (lovelaceToValue 0) datum refScript))
+                <$> UTxO.toList commitUTxO'
+      response <-
+        L.parseRequest ("POST " <> hydraNodeBaseUrl n1 <> "/commit")
+          <&> setRequestBodyJSON (commitUTxO :: UTxO.UTxO)
+            >>= httpJSON
+
+      let expectedError = getResponseBody response :: PostTxError Tx
+
+      expectedError `shouldSatisfy` \case
+        DepositTooLow{minimumValue, providedValue} -> providedValue < minimumValue
+        _ -> False
+ where
+  hydraTracer = contramap FromHydraNode tracer
+
+  hydraNodeBaseUrl HydraClient{hydraNodeId} = "http://127.0.0.1:" <> show (4000 + hydraNodeId)
+
 -- | Open a a single participant head, deposit and then recover it.
 canRecoverDeposit :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> backend -> [TxId] -> IO ()
 canRecoverDeposit tracer workDir backend hydraScriptsTxId =

hydra-cluster/src/HydraNode.hs

@@ -357,14 +357,15 @@ preparePParams chainConfig stateDir paramsDecorator = do
           prj <- Blockfrost.projectFromFile projectPath
           toJSON <$> Blockfrost.runBlockfrostM prj Blockfrost.queryProtocolParameters
       Aeson.encodeFile cardanoLedgerProtocolParametersFile $
-        paramsDecorator protocolParameters
+        protocolParameters
           & atKey "txFeeFixed" ?~ toJSON (Number 0)
           & atKey "txFeePerByte" ?~ toJSON (Number 0)
           & key "executionUnitPrices" . atKey "priceMemory" ?~ toJSON (Number 0)
           & key "executionUnitPrices" . atKey "priceSteps" ?~ toJSON (Number 0)
           & atKey "utxoCostPerByte" ?~ toJSON (Number 0)
           & atKey "treasuryCut" ?~ toJSON (Number 0)
           & atKey "minFeeRefScriptCostPerByte" ?~ toJSON (Number 0)
+          & paramsDecorator
   pure cardanoLedgerProtocolParametersFile
 
 -- | Prepare 'RunOptions' to run a hydra-node with given 'ChainConfig' and using the config from

hydra-cluster/test/Test/EndToEndSpec.hs

@@ -63,6 +63,7 @@ import Hydra.Cluster.Scenarios (
   oneOfThreeNodesStopsForAWhile,
   persistenceCanLoadWithEmptyCommit,
   refuelIfNeeded,
+  rejectCommit,
   restartedNodeCanAbort,
   restartedNodeCanObserveCommitTx,
   singlePartyCommitsFromExternal,
@@ -294,6 +295,11 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do
           withBackend (contramap FromCardanoNode tracer) tmpDir $ \blockTime backend -> do
             publishHydraScriptsAs backend Faucet
               >>= canCommit tracer tmpDir blockTime backend
+      it "reject commits with too low value" $ \tracer -> do
+        withClusterTempDir $ \tmpDir -> do
+          withBackend (contramap FromCardanoNode tracer) tmpDir $ \blockTime backend -> do
+            publishHydraScriptsAs backend Faucet
+              >>= rejectCommit tracer tmpDir blockTime backend
       it "can recover deposit" $ \tracer -> do
         withClusterTempDir $ \tmpDir -> do
           withBackend (contramap FromCardanoNode tracer) tmpDir $ \_ backend -> do

hydra-node/json-schemas/api.yaml

@@ -118,7 +118,7 @@ channels:
           - $ref: "api.yaml#/components/messages/Contest"
           - $ref: "api.yaml#/components/messages/Fanout"
           - $ref: "api.yaml#/components/messages/SideLoadSnapshot"
-  
+
   /head:
     servers:
       - localhost-http
@@ -2605,6 +2605,25 @@ components:
             tag:
               type: string
               enum: ["FailedToConstructFanoutTx"]
+        - title: DepositTooLow
+          description: |
+            Raised if the user requests a deposit using too small UTxO.
+          type: object
+          additionalProperties: false
+          required:
+          - tag
+          - minimumValue
+          - providedValue
+          properties:
+            tag:
+              type: string
+              enum: ["DepositTooLow"]
+            minimumValue:
+               type: integer
+               minimum: 0
+            providedValue:
+               type: integer
+               minimum: 0
 
     Signature:
       type: string

hydra-node/src/Hydra/API/HTTPServer.hs

@@ -189,7 +189,7 @@ httpApp tracer directChain env pparams getHeadState getCommitInfo getPendingDepo
         >>= respond
     ("POST", ["commit"]) ->
       consumeRequestBodyStrict request
-        >>= handleDraftCommitUtxo env directChain getCommitInfo
+        >>= handleDraftCommitUtxo env pparams directChain getCommitInfo
         >>= respond
     ("DELETE", ["commits", _]) ->
       consumeRequestBodyStrict request
@@ -219,13 +219,14 @@ handleDraftCommitUtxo ::
   forall tx.
   IsChainState tx =>
   Environment ->
+  PParams LedgerEra ->
   Chain tx IO ->
   -- | A means to get commit info.
   IO CommitInfo ->
   -- | Request body.
   LBS.ByteString ->
   IO Response
-handleDraftCommitUtxo env directChain getCommitInfo body = do
+handleDraftCommitUtxo env pparams directChain getCommitInfo body = do
   case Aeson.eitherDecode' body :: Either String (DraftCommitTxRequest tx) of
     Left err ->
       pure $ responseLBS status400 jsonContent (Aeson.encode $ Aeson.String $ pack err)
@@ -251,7 +252,7 @@ handleDraftCommitUtxo env directChain getCommitInfo body = do
     -- increment because a deposit only activates after one deposit period and
     -- expires one deposit period before deadline.
     deadline <- addUTCTime (3 * toNominalDiffTime depositPeriod) <$> getCurrentTime
-    draftDepositTx headId commitBlueprint deadline <&> \case
+    draftDepositTx headId pparams commitBlueprint deadline <&> \case
       Left e -> responseLBS status400 jsonContent (Aeson.encode $ toJSON e)
       Right depositTx -> okJSON $ DraftCommitTxResponse depositTx
 
@@ -264,6 +265,7 @@ handleDraftCommitUtxo env directChain getCommitInfo body = do
           CommittedTooMuchADAForMainnet _ _ -> badRequest e
           UnsupportedLegacyOutput _ -> badRequest e
           CannotFindOwnInitial _ -> badRequest e
+          DepositTooLow _ _ -> badRequest e
           _ -> responseLBS status500 [] (Aeson.encode $ toJSON e)
       Right commitTx ->
         okJSON $ DraftCommitTxResponse commitTx

hydra-node/src/Hydra/Chain.hs

@@ -13,11 +13,13 @@ module Hydra.Chain where
 
 import Hydra.Prelude
 
+import Cardano.Ledger.Core (PParams)
 import Data.List.NonEmpty ((<|))
 import Hydra.Cardano.Api (
   Address,
   ByronAddr,
   Coin (..),
+  LedgerEra,
  )
 import Hydra.Chain.ChainState (ChainSlot, IsChainState (..))
 import Hydra.Tx (
@@ -200,6 +202,7 @@ data PostTxError tx
   | FailedToConstructIncrementTx {failureReason :: Text}
   | FailedToConstructDecrementTx {failureReason :: Text}
   | FailedToConstructFanoutTx
+  | DepositTooLow {providedValue :: Coin, minimumValue :: Coin}
   deriving stock (Generic)
 
 deriving stock instance IsChainState tx => Eq (PostTxError tx)
@@ -268,6 +271,7 @@ data Chain tx m = Chain
   , draftDepositTx ::
       MonadThrow m =>
       HeadId ->
+      PParams LedgerEra ->
       CommitBlueprintTx tx ->
       UTCTime ->
       m (Either (PostTxError tx) tx)

hydra-node/src/Hydra/Chain/Direct/Handlers.hs

@@ -10,18 +10,25 @@ module Hydra.Chain.Direct.Handlers where
 import Hydra.Prelude
 
 import Cardano.Api.UTxO qualified as UTxO
+import Cardano.Ledger.Core (PParams)
 import Cardano.Slotting.Slot (SlotNo (..))
 import Control.Concurrent.Class.MonadSTM (modifyTVar, newTVarIO, writeTVar)
 import Control.Monad.Class.MonadSTM (throwSTM)
+import Data.List qualified as List
 import Hydra.Cardano.Api (
   BlockHeader,
   ChainPoint (..),
+  LedgerEra,
   Tx,
   TxId,
+  calculateMinimumUTxO,
   chainPointToSlotNo,
+  fromCtxUTxOTxOut,
   getChainPoint,
   getTxBody,
   getTxId,
+  liftEither,
+  shelleyBasedEra,
   throwError,
  )
 import Hydra.Chain (
@@ -69,6 +76,7 @@ import Hydra.Logging (Tracer, traceWith)
 import Hydra.Tx (
   CommitBlueprintTx (..),
   HeadParameters (..),
+  IsTx (..),
   UTxOType,
   headSeedToTxIn,
  )
@@ -171,12 +179,13 @@ mkChain tracer queryTimeHandle wallet ctx LocalChainState{getLatest} submitTx =
         let CommitBlueprintTx{lookupUTxO} = commitBlueprintTx
         traverse (finalizeTx wallet ctx spendableUTxO lookupUTxO) $
           commit' ctx headId spendableUTxO commitBlueprintTx
-    , draftDepositTx = \headId commitBlueprintTx deadline -> do
+    , draftDepositTx = \headId pparams commitBlueprintTx deadline -> do
         let CommitBlueprintTx{lookupUTxO} = commitBlueprintTx
         ChainStateAt{spendableUTxO} <- atomically getLatest
         TimeHandle{currentPointInTime} <- queryTimeHandle
         -- XXX: What an error handling mess
         runExceptT $ do
+          liftEither $ rejectLowDeposits pparams lookupUTxO
           (currentSlot, currentTime) <- case currentPointInTime of
             Left failureReason -> throwError FailedToConstructDepositTx{failureReason}
             Right (s, t) -> pure (s, t)
@@ -195,6 +204,25 @@ mkChain tracer queryTimeHandle wallet ctx LocalChainState{getLatest} submitTx =
       submitTx
     }
 
+-- Check each UTxO entry against the minADAUTxO value.
+-- Throws 'DepositTooLow' exception.
+rejectLowDeposits :: PParams LedgerEra -> UTxO.UTxO -> Either (PostTxError Tx) ()
+rejectLowDeposits pparams utxo = do
+  let insAndOuts = UTxO.toList utxo
+  let providedValues = (\(i, o) -> (i, UTxO.totalLovelace $ UTxO.singleton i o)) <$> insAndOuts
+  let minimumValues = (\(i, o) -> (i, calculateMinimumUTxO shelleyBasedEra pparams $ fromCtxUTxOTxOut o)) <$> insAndOuts
+  let results =
+        ( \(i, minVal) ->
+            case List.find (\(ix, providedVal) -> i == ix && providedVal < minVal) providedValues of
+              Nothing -> Right ()
+              Just (_, tooLowValue) ->
+                Left (DepositTooLow{providedValue = tooLowValue, minimumValue = minVal} :: PostTxError Tx)
+        )
+          <$> minimumValues
+  case lefts results of
+    [] -> pure ()
+    (e : _) -> Left e
+
 -- | Balance and sign the given partial transaction.
 finalizeTx ::
   MonadThrow m =>

hydra-node/src/Hydra/Chain/Offline.hs

@@ -86,7 +86,7 @@ withOfflineChain config party otherParties chainStateHistory callback action = d
       { mkChainState = initialChainState
       , submitTx = const $ pure ()
       , draftCommitTx = \_ _ -> pure $ Left FailedToDraftTxNotInitializing
-      , draftDepositTx = \_ _ _ -> pure $ Left FailedToConstructDepositTx{failureReason = "not implemented"}
+      , draftDepositTx = \_ _ _ _ -> pure $ Left FailedToConstructDepositTx{failureReason = "not implemented"}
       , postTx = const $ pure ()
       }