Don't use separate handle field to check deposits

Signed-off-by: Sasha Bogicevic <[email protected]>

Author: v0d1ch

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

@@ -13,7 +13,10 @@ import Data.Text (pack)
 import Hydra.API.APIServerLog (APIServerLog (..), Method (..), PathInfo (..))
 import Hydra.API.ClientInput (ClientInput (..))
 import Hydra.API.ServerOutput (CommitInfo (..), getConfirmedSnapshot, getSeenSnapshot, getSnapshotUtxo)
-import Hydra.Cardano.Api (LedgerEra, Tx)
+import Hydra.Cardano.Api (
+  LedgerEra,
+  Tx,
+ )
 import Hydra.Chain (Chain (..), PostTxError (..), draftCommitTx)
 import Hydra.Chain.ChainState (
   IsChainState,
@@ -236,29 +239,20 @@ handleDraftCommitUtxo env pparams directChain getCommitInfo body = do
             SimpleCommitRequest{utxoToCommit} -> do
               let blueprintTx = txSpendingUTxO utxoToCommit
               draftCommit headId utxoToCommit blueprintTx
-        IncrementalCommit headId ->
+        IncrementalCommit headId -> do
           case someCommitRequest of
-            FullCommitRequest{blueprintTx, utxo} ->
-              checkDeposit' utxo $
-                deposit headId CommitBlueprintTx{blueprintTx, lookupUTxO = utxo}
+            FullCommitRequest{blueprintTx, utxo} -> do
+              deposit headId CommitBlueprintTx{blueprintTx, lookupUTxO = utxo}
             SimpleCommitRequest{utxoToCommit} ->
-              checkDeposit' utxoToCommit $
-                deposit headId CommitBlueprintTx{blueprintTx = txSpendingUTxO utxoToCommit, lookupUTxO = utxoToCommit}
+              deposit headId CommitBlueprintTx{blueprintTx = txSpendingUTxO utxoToCommit, lookupUTxO = utxoToCommit}
         CannotCommit -> pure $ responseLBS status500 [] (Aeson.encode (FailedToDraftTxNotInitializing :: PostTxError tx))
  where
-  checkDeposit' utxo cont = do
-    depositCheck <- checkDeposit pparams utxo
-    case depositCheck of
-      Left e -> pure $ responseLBS status400 jsonContent (Aeson.encode $ toJSON e)
-      Right _ -> cont
-
   deposit headId commitBlueprint = do
     -- NOTE: Three times deposit period means we have one deposit period time to
     -- 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
 
@@ -271,12 +265,11 @@ handleDraftCommitUtxo env pparams 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
 
-  Chain{draftCommitTx, draftDepositTx, checkDeposit} = directChain
+  Chain{draftCommitTx, draftDepositTx} = directChain
 
   Environment{depositPeriod} = env
 

hydra-node/src/Hydra/Chain.hs

@@ -271,6 +271,7 @@ data Chain tx m = Chain
   , draftDepositTx ::
       MonadThrow m =>
       HeadId ->
+      PParams LedgerEra ->
       CommitBlueprintTx tx ->
       UTCTime ->
       m (Either (PostTxError tx) tx)
@@ -284,7 +285,6 @@ data Chain tx m = Chain
   --
   -- XXX: While technically they could be any of 'PostTxError tx', only
   -- `FailedToPostTx` errors are expected here.
-  , checkDeposit :: MonadThrow m => PParams LedgerEra -> UTxOType tx -> m (Either (PostTxError tx) ())
   }
 
 data ChainEvent tx

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

@@ -27,6 +27,7 @@ import Hydra.Cardano.Api (
   getChainPoint,
   getTxBody,
   getTxId,
+  liftEither,
   shelleyBasedEra,
   throwError,
  )
@@ -178,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)
@@ -200,12 +202,10 @@ mkChain tracer queryTimeHandle wallet ctx LocalChainState{getLatest} submitTx =
     , -- Submit a cardano transaction to the cardano-node using the
       -- LocalTxSubmission protocol.
       submitTx
-    , -- Check if deposit value is higher than 'minUTxOValue'. Throw 'DepositTooLow' if
-      -- the provided UTxO value is too low.
-      checkDeposit = \pparams userUTxO -> pure $ rejectLowDeposits pparams userUTxO
     }
 
 -- 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

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

@@ -86,9 +86,8 @@ 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 ()
-      , checkDeposit = \_ _ -> pure $ Right ()
       }
 
   initializeOfflineHead = do

hydra-node/test/Hydra/API/HTTPServerSpec.hs

@@ -25,7 +25,7 @@ import Hydra.Cardano.Api (
   renderTxIn,
   serialiseToTextEnvelope,
  )
-import Hydra.Chain (Chain (draftCommitTx), PostTxError (..), checkDeposit, draftDepositTx)
+import Hydra.Chain (Chain (draftCommitTx), PostTxError (..), draftDepositTx)
 import Hydra.Chain.Direct.Handlers (rejectLowDeposits)
 import Hydra.HeadLogic.State (ClosedState (..), HeadState (..), SeenSnapshot (..))
 import Hydra.HeadLogicSpec (inIdleState)
@@ -463,8 +463,7 @@ apiServerSpec = do
       let failingChainHandle postTxError =
             dummyChainHandle
               { draftCommitTx = \_ _ -> pure $ Left postTxError
-              , draftDepositTx = \_ _ _ -> pure $ Left postTxError
-              , checkDeposit = \_ _ -> pure $ Left postTxError
+              , draftDepositTx = \_ _ _ _ -> pure $ Left postTxError
               }
 
       prop "reject deposits with less than min ADA" $ do

hydra-node/test/Hydra/API/ServerSpec.hs

@@ -31,7 +31,6 @@ import Hydra.API.ServerOutput (InvalidInput (..), input)
 import Hydra.API.ServerOutputFilter (ServerOutputFilter (..))
 import Hydra.Chain (
   Chain (Chain),
-  checkDeposit,
   draftCommitTx,
   draftDepositTx,
   mkChainState,
@@ -381,7 +380,6 @@ dummyChainHandle =
     , draftCommitTx = \_ -> error "unexpected call to draftCommitTx"
     , draftDepositTx = \_ -> error "unexpected call to draftDepositTx"
     , submitTx = \_ -> error "unexpected call to submitTx"
-    , checkDeposit = \_ -> error "unexpected call to checkDeposit"
     }
 
 allowEverythingServerOutputFilter :: ServerOutputFilter tx

hydra-node/test/Hydra/BehaviorSpec.hs

@@ -1085,7 +1085,6 @@ simulatedChainAndNetwork initialChainState = do
                   , draftCommitTx = \_ -> error "unexpected call to draftCommitTx"
                   , draftDepositTx = \_ -> error "unexpected call to draftDepositTx"
                   , submitTx = \_ -> error "unexpected call to submitTx"
-                  , checkDeposit = \_ -> error "unexpected call to checkDeposit"
                   }
               mockNetwork = createMockNetwork draftNode nodes
               mockServer = Server{sendMessage = const $ pure ()}

hydra-node/test/Hydra/Model/MockChain.hs

@@ -82,7 +82,7 @@ import Hydra.Tx.Party (Party (..), deriveParty, getParty)
 import Hydra.Tx.ScriptRegistry (registryUTxO)
 import Hydra.Tx.Snapshot (ConfirmedSnapshot (..))
 import Hydra.Tx.Utils (verificationKeyToOnChainId)
-import Test.Hydra.Tx.Fixture (testNetworkId)
+import Test.Hydra.Tx.Fixture (defaultPParams, testNetworkId)
 import Test.Hydra.Tx.Gen (genScriptRegistry, genTxOutAdaOnly)
 import Test.QuickCheck (getPositive)
 
@@ -215,7 +215,7 @@ mockChainAndNetwork tr seedKeys commits = do
     readTVarIO nodes >>= \case
       [] -> error "simulateDeposit: no MockHydraNode"
       (MockHydraNode{node = HydraNode{oc = Chain{submitTx, draftDepositTx}}} : _) ->
-        draftDepositTx headId (mkSimpleBlueprintTx utxoToDeposit) deadline >>= \case
+        draftDepositTx headId defaultPParams (mkSimpleBlueprintTx utxoToDeposit) deadline >>= \case
           Left e -> throwIO e
           Right tx -> submitTx tx $> txId tx
 

hydra-node/test/Hydra/NodeSpec.hs

@@ -345,9 +345,8 @@ mockChain =
     { mkChainState = error "mockChain: unexpected mkChainState"
     , postTx = \_ -> pure ()
     , draftCommitTx = \_ _ -> failure "mockChain: unexpected draftCommitTx"
-    , draftDepositTx = \_ _ _ -> failure "mockChain: unexpected draftDepositTx"
+    , draftDepositTx = \_ _ _ _ -> failure "mockChain: unexpected draftDepositTx"
     , submitTx = \_ -> failure "mockChain: unexpected submitTx"
-    , checkDeposit = \_ _ -> failure "mockChain: unexpected checkDeposit"
     }
 
 mockSink :: Monad m => EventSink a m
@@ -503,6 +502,5 @@ throwExceptionOnPostTx exception node =
             , draftCommitTx = \_ -> error "draftCommitTx not implemented"
             , draftDepositTx = \_ -> error "draftDepositTx not implemented"
             , submitTx = \_ -> error "submitTx not implemented"
-            , checkDeposit = \_ _ -> error "checkDeposit not implemented"
             }
       }