Update TUI to handle Incremental Commits (#1747)

<!-- Describe your change here -->

Fixes #1737

![image](https://github.com/user-attachments/assets/a1287c25-7d6f-40a2-8a75-479f4807ec20)

---

<!-- 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

CHANGELOG.md

@@ -50,6 +50,8 @@ changes.
 
 - New websocket URL parameter `?address=...` to filter `SnapshotConfirmed`, `TxValid` and `TxInvalid` server outputs by address.
 
+- Updated `hydra-tui` to handle `incremental commits`.
+
 ## [0.19.0] - 2024-09-13
 
 - Tested with `cardano-node 9.1.1` and `cardano-cli 9.2.1.0`

hydra-tui/src/Hydra/TUI/Drawing.hs

@@ -110,7 +110,7 @@ drawCommandList s = vBox . fmap txt $ case s ^. connectedStateL of
     Idle -> ["[I]nit", "[Q]uit"]
     Active (ActiveLink{activeHeadState}) -> case activeHeadState of
       Initializing{} -> ["[C]ommit", "[A]bort", "[Q]uit"]
-      Open{} -> ["[N]ew Transaction", "[D]ecommit", "[C]lose", "[Q]uit"]
+      Open{} -> ["[N]ew Transaction", "[D]ecommit", "[I]ncrement", "[C]lose", "[Q]uit"]
       Closed{} -> ["[Q]uit"]
       FanoutPossible{} -> ["[F]anout", "[Q]uit"]
       Final{} -> ["[I]nit", "[Q]uit"]
@@ -134,18 +134,51 @@ drawFocusPanelInitializing me InitializingState{remainingParties, initializingSc
   CommitMenu x -> vBox [txt "Select UTxOs to commit:", renderForm x]
   ConfirmingAbort x -> vBox [txt "Confirm Abort action:", renderForm x]
 
-drawFocusPanelOpen :: NetworkId -> VerificationKey PaymentKey -> UTxO -> UTxO -> OpenScreen -> Widget Name
-drawFocusPanelOpen networkId vk utxo pendingUTxOToDecommit = \case
+drawRemainingDepositDeadline :: UTCTime -> UTCTime -> Widget Name
+drawRemainingDepositDeadline deadline now =
+  let remaining = diffUTCTime deadline now
+   in if remaining > 0
+        then padLeftRight 1 $ vBox [txt "Remaining time to deposit: ", str (renderTime remaining)]
+        else txt "Deposit deadline passed, ready to recover."
+
+drawPendingIncrement :: AddressInEra -> Maybe PendingIncrement -> UTCTime -> Widget Name
+drawPendingIncrement ownAddress pendingIncrement now =
+  case pendingIncrement of
+    Nothing -> vBox []
+    Just PendingDeposit{utxoToCommit, deposit, depositDeadline} ->
+      vBox
+        [ drawUTxO (highlightOwnAddress ownAddress) utxoToCommit
+        , padTop (Pad 1) $ txt "Pending deposit: "
+        , txt $ show deposit
+        , txt "Pending deposit deadline: "
+        , drawRemainingDepositDeadline depositDeadline now
+        ]
+    Just PendingIncrement{utxoToCommit} ->
+      vBox
+        [ drawUTxO (highlightOwnAddress ownAddress) utxoToCommit
+        , padTop (Pad 1) $ txt "NO Pending deposit"
+        ]
+
+drawFocusPanelOpen :: NetworkId -> VerificationKey PaymentKey -> UTxO -> UTxO -> Maybe PendingIncrement -> UTCTime -> OpenScreen -> Widget Name
+drawFocusPanelOpen networkId vk utxo pendingUTxOToDecommit pendingIncrement now = \case
   OpenHome ->
     vBox
-      [ txt "Active UTxO: "
-      , drawUTxO (highlightOwnAddress ownAddress) utxo
+      [ vBox
+          [ txt "Active UTxO: "
+          , drawUTxO (highlightOwnAddress ownAddress) utxo
+          ]
+      , hBorder
+      , vBox
+          [ txt "Pending UTxO to decommit: "
+          , drawUTxO (highlightOwnAddress ownAddress) pendingUTxOToDecommit
+          ]
       , hBorder
-      , txt "Pending UTxO to decommit: "
-      , drawUTxO (highlightOwnAddress ownAddress) pendingUTxOToDecommit
+      , txt "Pending UTxO to commit: "
+      , drawPendingIncrement ownAddress pendingIncrement now
       ]
   SelectingUTxO x -> renderForm x
   SelectingUTxOToDecommit x -> renderForm x
+  SelectingUTxOToIncrement x -> renderForm x
   EnteringAmount _ x -> renderForm x
   SelectingRecipient _ _ x -> renderForm x
   EnteringRecipientAddress _ _ x -> renderForm x
@@ -173,9 +206,9 @@ highlightOwnAddress ownAddress a =
 drawFocusPanel :: NetworkId -> VerificationKey PaymentKey -> UTCTime -> Connection -> Widget Name
 drawFocusPanel networkId vk now (Connection{me, headState}) = case headState of
   Idle -> emptyWidget
-  Active (ActiveLink{utxo, pendingUTxOToDecommit, activeHeadState}) -> case activeHeadState of
+  Active (ActiveLink{utxo, pendingUTxOToDecommit, pendingIncrement, activeHeadState}) -> case activeHeadState of
     Initializing x -> drawFocusPanelInitializing me x
-    Open x -> drawFocusPanelOpen networkId vk utxo pendingUTxOToDecommit x
+    Open x -> drawFocusPanelOpen networkId vk utxo pendingUTxOToDecommit pendingIncrement now x
     Closed x -> drawFocusPanelClosed now x
     FanoutPossible -> txt "Ready to fanout!"
     Final -> drawFocusPanelFinal networkId vk utxo

hydra-tui/src/Hydra/TUI/Handlers.hs

@@ -117,6 +117,12 @@ handleHydraEventsActiveLink e = do
       pendingUTxOToDecommitL .= utxoToDecommit
     Update TimedServerOutput{time, output = DecommitFinalized{}} ->
       pendingUTxOToDecommitL .= mempty
+    Update TimedServerOutput{time, output = CommitRecorded{utxoToCommit, pendingDeposit, deadline}} -> do
+      pendingIncrementL .= Just (PendingDeposit utxoToCommit pendingDeposit deadline)
+    Update TimedServerOutput{time, output = CommitApproved{utxoToCommit}} -> do
+      pendingIncrementL .= Just (PendingIncrement utxoToCommit)
+    Update TimedServerOutput{time, output = CommitFinalized{}} -> do
+      pendingIncrementL .= Nothing
     _ -> pure ()
 
 handleHydraEventsInfo :: HydraEvent Tx -> EventM Name [LogMessage] ()
@@ -145,6 +151,10 @@ handleHydraEventsInfo = \case
     report Success time "Decommit approved and submitted to Cardano"
   Update TimedServerOutput{time, output = DecommitInvalid{decommitTx, decommitInvalidReason}} ->
     warn time ("Decommit Transaction with id " <> show (txId decommitTx) <> " is not applicable: " <> show decommitInvalidReason)
+  Update TimedServerOutput{time, output = CommitRecorded{}} ->
+    report Success time "Commit deposit recorded and pending for approval"
+  Update TimedServerOutput{time, output = CommitApproved{}} ->
+    report Success time "Commit approved and submitted to Cardano"
   Update TimedServerOutput{time, output = HeadIsFinalized{utxo}} -> do
     info time "Head is finalized"
   Update TimedServerOutput{time, output = InvalidInput{reason}} ->
@@ -236,6 +246,9 @@ handleVtyEventsOpen cardanoClient hydraClient utxo e =
         EvKey (KChar 'd') [] -> do
           let utxo' = myAvailableUTxO (networkId cardanoClient) (getVerificationKey $ sk hydraClient) utxo
           put $ SelectingUTxOToDecommit (utxoRadioField utxo')
+        EvKey (KChar 'i') [] -> do
+          utxo' <- liftIO $ queryUTxOByAddress cardanoClient [mkMyAddress cardanoClient hydraClient]
+          put $ SelectingUTxOToIncrement (utxoRadioField $ UTxO.toMap utxo')
         EvKey (KChar 'c') [] ->
           put $ ConfirmingClose confirmRadioField
         _ -> pure ()
@@ -271,6 +284,15 @@ handleVtyEventsOpen cardanoClient hydraClient utxo e =
               liftIO (sendInput hydraClient (Decommit tx))
           put OpenHome
         _ -> zoom selectingUTxOToDecommitFormL $ handleFormEvent (VtyEvent e)
+    SelectingUTxOToIncrement i -> do
+      case e of
+        EvKey KEsc [] -> put OpenHome
+        EvKey KEnter [] -> do
+          let utxoSelected = formState i
+          let commitUTxO = UTxO.singleton utxoSelected
+          liftIO $ externalCommit hydraClient commitUTxO
+          put OpenHome
+        _ -> zoom selectingUTxOToIncrementFormL $ handleFormEvent (VtyEvent e)
     EnteringAmount utxoSelected i ->
       case e of
         EvKey KEsc [] -> put OpenHome

hydra-tui/src/Hydra/TUI/Model.hs

@@ -58,6 +58,7 @@ data OpenScreen
   = OpenHome
   | SelectingUTxO {selectingUTxOForm :: UTxORadioFieldForm (HydraEvent Tx) Name}
   | SelectingUTxOToDecommit {selectingUTxOToDecommitForm :: UTxORadioFieldForm (HydraEvent Tx) Name}
+  | SelectingUTxOToIncrement {selectingUTxOToIncrementForm :: UTxORadioFieldForm (HydraEvent Tx) Name}
   | EnteringAmount {utxoSelected :: (TxIn, TxOut CtxUTxO), enteringAmountForm :: Form Integer (HydraEvent Tx) Name}
   | SelectingRecipient
       { utxoSelected :: (TxIn, TxOut CtxUTxO)
@@ -87,9 +88,20 @@ data HeadState
   = Idle
   | Active {activeLink :: ActiveLink}
 
+data PendingIncrement
+  = PendingDeposit
+      { utxoToCommit :: UTxO
+      , deposit :: TxId
+      , depositDeadline :: UTCTime
+      }
+  | PendingIncrement
+      { utxoToCommit :: UTxO
+      }
+
 data ActiveLink = ActiveLink
   { utxo :: UTxO
   , pendingUTxOToDecommit :: UTxO
+  , pendingIncrement :: Maybe PendingIncrement
   , parties :: [Party]
   , headId :: HeadId
   , activeHeadState :: ActiveHeadState
@@ -107,6 +119,7 @@ type Name = Text
 makeLensesFor
   [ ("selectingUTxOForm", "selectingUTxOFormL")
   , ("selectingUTxOToDecommitForm", "selectingUTxOToDecommitFormL")
+  , ("selectingUTxOToIncrementForm", "selectingUTxOToIncrementFormL")
   , ("enteringAmountForm", "enteringAmountFormL")
   , ("selectingRecipientForm", "selectingRecipientFormL")
   , ("enteringRecipientAddressForm", "enteringRecipientAddressFormL")
@@ -161,6 +174,7 @@ makeLensesFor
 makeLensesFor
   [ ("utxo", "utxoL")
   , ("pendingUTxOToDecommit", "pendingUTxOToDecommitL")
+  , ("pendingIncrement", "pendingIncrementL")
   , ("parties", "partiesL")
   , ("activeHeadState", "activeHeadStateL")
   , ("headId", "headIdL")
@@ -195,6 +209,7 @@ newActiveLink parties headId =
           }
     , utxo = mempty
     , pendingUTxOToDecommit = mempty
+    , pendingIncrement = Nothing
     , headId
     }