diff --git a/CHANGELOG.md b/CHANGELOG.md index 1a6971ab100..abb149edfef 100644 --- a/CHANGELOG.md +++ b/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` diff --git a/hydra-tui/src/Hydra/TUI/Drawing.hs b/hydra-tui/src/Hydra/TUI/Drawing.hs index d4b5e60ed97..babda36e0ee 100644 --- a/hydra-tui/src/Hydra/TUI/Drawing.hs +++ b/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 diff --git a/hydra-tui/src/Hydra/TUI/Handlers.hs b/hydra-tui/src/Hydra/TUI/Handlers.hs index cd8781508fb..74c325d994d 100644 --- a/hydra-tui/src/Hydra/TUI/Handlers.hs +++ b/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 diff --git a/hydra-tui/src/Hydra/TUI/Model.hs b/hydra-tui/src/Hydra/TUI/Model.hs index 0e4ffb0bbab..b0b397a7a41 100644 --- a/hydra-tui/src/Hydra/TUI/Model.hs +++ b/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 }