From c9f19d66db27d777d63970757b25c41116fb10a3 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 20 Nov 2024 13:12:48 +0100 Subject: [PATCH 1/5] add pending utxo to commit to active link model --- hydra-tui/src/Hydra/TUI/Model.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/hydra-tui/src/Hydra/TUI/Model.hs b/hydra-tui/src/Hydra/TUI/Model.hs index 0e4ffb0bbab..b5a79488279 100644 --- a/hydra-tui/src/Hydra/TUI/Model.hs +++ b/hydra-tui/src/Hydra/TUI/Model.hs @@ -90,6 +90,7 @@ data HeadState data ActiveLink = ActiveLink { utxo :: UTxO , pendingUTxOToDecommit :: UTxO + , pendingUTxOToCommit :: UTxO , parties :: [Party] , headId :: HeadId , activeHeadState :: ActiveHeadState @@ -161,6 +162,7 @@ makeLensesFor makeLensesFor [ ("utxo", "utxoL") , ("pendingUTxOToDecommit", "pendingUTxOToDecommitL") + , ("pendingUTxOToCommit", "pendingUTxOToCommitL") , ("parties", "partiesL") , ("activeHeadState", "activeHeadStateL") , ("headId", "headIdL") @@ -195,6 +197,7 @@ newActiveLink parties headId = } , utxo = mempty , pendingUTxOToDecommit = mempty + , pendingUTxOToCommit = mempty , headId } From 060c0ae9362c9bf32eea9fd78ea896524310115c Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Wed, 20 Nov 2024 22:02:19 +0100 Subject: [PATCH 2/5] add initial draft --- hydra-tui/src/Hydra/TUI/Drawing.hs | 26 +++++++++++++++++++------- hydra-tui/src/Hydra/TUI/Handlers.hs | 20 ++++++++++++++++++++ hydra-tui/src/Hydra/TUI/Model.hs | 2 ++ 3 files changed, 41 insertions(+), 7 deletions(-) diff --git a/hydra-tui/src/Hydra/TUI/Drawing.hs b/hydra-tui/src/Hydra/TUI/Drawing.hs index d4b5e60ed97..919e0fc16fc 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,30 @@ 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 +drawFocusPanelOpen :: NetworkId -> VerificationKey PaymentKey -> UTxO -> UTxO -> UTxO -> OpenScreen -> Widget Name +drawFocusPanelOpen networkId vk utxo pendingUTxOToDecommit pendingUTxOToCommit = \case OpenHome -> vBox [ txt "Active UTxO: " , drawUTxO (highlightOwnAddress ownAddress) utxo , hBorder - , txt "Pending UTxO to decommit: " - , drawUTxO (highlightOwnAddress ownAddress) pendingUTxOToDecommit + , hBox + [ vBox + [ txt "Pending UTxO to decommit: " + , drawUTxO (highlightOwnAddress ownAddress) pendingUTxOToDecommit + ] + , vBorder + , vBox + [ txt "Pending UTxO to commit: " + , drawUTxO (highlightOwnAddress ownAddress) pendingUTxOToCommit + , -- TODO! handle pending deposit + txt "Pending deposit: " + ] + ] ] 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 +185,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, pendingUTxOToCommit, activeHeadState}) -> case activeHeadState of Initializing x -> drawFocusPanelInitializing me x - Open x -> drawFocusPanelOpen networkId vk utxo pendingUTxOToDecommit x + Open x -> drawFocusPanelOpen networkId vk utxo pendingUTxOToDecommit pendingUTxOToCommit 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..128f338eee1 100644 --- a/hydra-tui/src/Hydra/TUI/Handlers.hs +++ b/hydra-tui/src/Hydra/TUI/Handlers.hs @@ -117,6 +117,11 @@ handleHydraEventsActiveLink e = do pendingUTxOToDecommitL .= utxoToDecommit Update TimedServerOutput{time, output = DecommitFinalized{}} -> pendingUTxOToDecommitL .= mempty + -- TODO! handle pendingDeposit + deadline + Update TimedServerOutput{time, output = CommitRecorded{utxoToCommit}} -> + pendingUTxOToCommitL .= utxoToCommit + Update TimedServerOutput{time, output = CommitFinalized{}} -> + pendingUTxOToCommitL .= mempty _ -> pure () handleHydraEventsInfo :: HydraEvent Tx -> EventM Name [LogMessage] () @@ -145,6 +150,9 @@ 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 = CommitApproved{}} -> + report Success time "Commit approved and submitted to Cardano" + -- TODO! handle CommitRecovered Update TimedServerOutput{time, output = HeadIsFinalized{utxo}} -> do info time "Head is finalized" Update TimedServerOutput{time, output = InvalidInput{reason}} -> @@ -236,6 +244,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 +282,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 b5a79488279..21d1707d58d 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) @@ -108,6 +109,7 @@ type Name = Text makeLensesFor [ ("selectingUTxOForm", "selectingUTxOFormL") , ("selectingUTxOToDecommitForm", "selectingUTxOToDecommitFormL") + , ("selectingUTxOToIncrementForm", "selectingUTxOToIncrementFormL") , ("enteringAmountForm", "enteringAmountFormL") , ("selectingRecipientForm", "selectingRecipientFormL") , ("enteringRecipientAddressForm", "enteringRecipientAddressFormL") From c97379949b687435213ec37f7b27436ca70503cb Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Thu, 21 Nov 2024 20:08:53 +0100 Subject: [PATCH 3/5] break down increment into pending deposit and commit --- hydra-tui/src/Hydra/TUI/Drawing.hs | 40 ++++++++++++++++++++--------- hydra-tui/src/Hydra/TUI/Handlers.hs | 14 +++++----- hydra-tui/src/Hydra/TUI/Model.hs | 16 +++++++++--- 3 files changed, 49 insertions(+), 21 deletions(-) diff --git a/hydra-tui/src/Hydra/TUI/Drawing.hs b/hydra-tui/src/Hydra/TUI/Drawing.hs index 919e0fc16fc..a85f9e8b8e5 100644 --- a/hydra-tui/src/Hydra/TUI/Drawing.hs +++ b/hydra-tui/src/Hydra/TUI/Drawing.hs @@ -134,8 +134,15 @@ 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 -> UTxO -> OpenScreen -> Widget Name -drawFocusPanelOpen networkId vk utxo pendingUTxOToDecommit pendingUTxOToCommit = \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." + +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: " @@ -143,16 +150,25 @@ drawFocusPanelOpen networkId vk utxo pendingUTxOToDecommit pendingUTxOToCommit = , hBorder , hBox [ vBox - [ txt "Pending UTxO to decommit: " - , drawUTxO (highlightOwnAddress ownAddress) pendingUTxOToDecommit + [ txt "Pending UTxO to decommit: " <+> drawUTxO (highlightOwnAddress ownAddress) pendingUTxOToDecommit ] , vBorder - , vBox - [ txt "Pending UTxO to commit: " - , drawUTxO (highlightOwnAddress ownAddress) pendingUTxOToCommit - , -- TODO! handle pending deposit - txt "Pending deposit: " - ] + , case pendingIncrement of + Nothing -> + vBox + [ txt "NO Pending UTxO to commit" + ] + Just PendingDeposit{utxoToCommit, deposit, depositDeadline} -> + vBox + [ txt "Pending UTxO to commit: " <+> drawUTxO (highlightOwnAddress ownAddress) utxoToCommit + , txt $ "Pending deposit: " <> show deposit + , txt "Pending deposit deadline: " <+> drawRemainingDepositDeadline depositDeadline now + ] + Just PendingIncrement{utxoToCommit} -> + vBox + [ txt "Pending UTxO to commit: " <+> drawUTxO (highlightOwnAddress ownAddress) utxoToCommit + , txt "NO Pending deposit: " + ] ] ] SelectingUTxO x -> renderForm x @@ -185,9 +201,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, pendingUTxOToCommit, 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 pendingUTxOToCommit 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 128f338eee1..74c325d994d 100644 --- a/hydra-tui/src/Hydra/TUI/Handlers.hs +++ b/hydra-tui/src/Hydra/TUI/Handlers.hs @@ -117,11 +117,12 @@ handleHydraEventsActiveLink e = do pendingUTxOToDecommitL .= utxoToDecommit Update TimedServerOutput{time, output = DecommitFinalized{}} -> pendingUTxOToDecommitL .= mempty - -- TODO! handle pendingDeposit + deadline - Update TimedServerOutput{time, output = CommitRecorded{utxoToCommit}} -> - pendingUTxOToCommitL .= utxoToCommit - Update TimedServerOutput{time, output = CommitFinalized{}} -> - pendingUTxOToCommitL .= 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] () @@ -150,9 +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" - -- TODO! handle CommitRecovered Update TimedServerOutput{time, output = HeadIsFinalized{utxo}} -> do info time "Head is finalized" Update TimedServerOutput{time, output = InvalidInput{reason}} -> diff --git a/hydra-tui/src/Hydra/TUI/Model.hs b/hydra-tui/src/Hydra/TUI/Model.hs index 21d1707d58d..b0b397a7a41 100644 --- a/hydra-tui/src/Hydra/TUI/Model.hs +++ b/hydra-tui/src/Hydra/TUI/Model.hs @@ -88,10 +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 - , pendingUTxOToCommit :: UTxO + , pendingIncrement :: Maybe PendingIncrement , parties :: [Party] , headId :: HeadId , activeHeadState :: ActiveHeadState @@ -164,7 +174,7 @@ makeLensesFor makeLensesFor [ ("utxo", "utxoL") , ("pendingUTxOToDecommit", "pendingUTxOToDecommitL") - , ("pendingUTxOToCommit", "pendingUTxOToCommitL") + , ("pendingIncrement", "pendingIncrementL") , ("parties", "partiesL") , ("activeHeadState", "activeHeadStateL") , ("headId", "headIdL") @@ -199,7 +209,7 @@ newActiveLink parties headId = } , utxo = mempty , pendingUTxOToDecommit = mempty - , pendingUTxOToCommit = mempty + , pendingIncrement = Nothing , headId } From 22b275d86accc1a80c0b293735b32b5265878a6f Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Thu, 21 Nov 2024 20:17:34 +0100 Subject: [PATCH 4/5] split the view horizontally to enhace visibility --- hydra-tui/src/Hydra/TUI/Drawing.hs | 51 ++++++++++++++++-------------- 1 file changed, 28 insertions(+), 23 deletions(-) diff --git a/hydra-tui/src/Hydra/TUI/Drawing.hs b/hydra-tui/src/Hydra/TUI/Drawing.hs index a85f9e8b8e5..babda36e0ee 100644 --- a/hydra-tui/src/Hydra/TUI/Drawing.hs +++ b/hydra-tui/src/Hydra/TUI/Drawing.hs @@ -141,35 +141,40 @@ drawRemainingDepositDeadline deadline now = 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 - , hBox - [ vBox - [ txt "Pending UTxO to decommit: " <+> drawUTxO (highlightOwnAddress ownAddress) pendingUTxOToDecommit - ] - , vBorder - , case pendingIncrement of - Nothing -> - vBox - [ txt "NO Pending UTxO to commit" - ] - Just PendingDeposit{utxoToCommit, deposit, depositDeadline} -> - vBox - [ txt "Pending UTxO to commit: " <+> drawUTxO (highlightOwnAddress ownAddress) utxoToCommit - , txt $ "Pending deposit: " <> show deposit - , txt "Pending deposit deadline: " <+> drawRemainingDepositDeadline depositDeadline now - ] - Just PendingIncrement{utxoToCommit} -> - vBox - [ txt "Pending UTxO to commit: " <+> drawUTxO (highlightOwnAddress ownAddress) utxoToCommit - , txt "NO Pending deposit: " - ] + , vBox + [ txt "Pending UTxO to decommit: " + , drawUTxO (highlightOwnAddress ownAddress) pendingUTxOToDecommit ] + , hBorder + , txt "Pending UTxO to commit: " + , drawPendingIncrement ownAddress pendingIncrement now ] SelectingUTxO x -> renderForm x SelectingUTxOToDecommit x -> renderForm x From f73721b41f3f5fe2b2598f2c47d72af812372253 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Thu, 21 Nov 2024 20:53:15 +0100 Subject: [PATCH 5/5] Update CHANGELOG --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) 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`