From 63ebc2a0e5969de8f6c60df951fd55563f54e1e0 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Fri, 19 Jul 2024 11:41:34 +0200 Subject: [PATCH] Add decommit command to TUI --- hydra-tui/src/Hydra/TUI/Drawing.hs | 20 ++++++++++++++------ hydra-tui/src/Hydra/TUI/Handlers.hs | 24 ++++++++++++++++++++++++ hydra-tui/src/Hydra/TUI/Model.hs | 5 +++++ 3 files changed, 43 insertions(+), 6 deletions(-) diff --git a/hydra-tui/src/Hydra/TUI/Drawing.hs b/hydra-tui/src/Hydra/TUI/Drawing.hs index 55dfa4d1845..0f3528bc6af 100644 --- a/hydra-tui/src/Hydra/TUI/Drawing.hs +++ b/hydra-tui/src/Hydra/TUI/Drawing.hs @@ -105,7 +105,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", "[C]lose", "[Q]uit"] + Open{} -> ["[N]ew Transaction", "[D]ecommit", "[C]lose", "[Q]uit"] Closed{} -> ["[Q]uit"] FanoutPossible{} -> ["[F]anout", "[Q]uit"] Final{} -> ["[I]nit", "[Q]uit"] @@ -129,10 +129,18 @@ 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 -> OpenScreen -> Widget Name -drawFocusPanelOpen networkId vk utxo = \case - OpenHome -> drawUTxO (highlightOwnAddress ownAddress) utxo +drawFocusPanelOpen :: NetworkId -> VerificationKey PaymentKey -> UTxO -> UTxO -> OpenScreen -> Widget Name +drawFocusPanelOpen networkId vk utxo pendingUTxOToDecrement = \case + OpenHome -> + vBox + [ txt "Active UTxO: " + , drawUTxO (highlightOwnAddress ownAddress) utxo + , hBorder + , txt "Pending UTxO to decrement: " + , drawUTxO (highlightOwnAddress ownAddress) pendingUTxOToDecrement + ] SelectingUTxO x -> renderForm x + SelectingUTxOToDecrement x -> renderForm x EnteringAmount _ x -> renderForm x SelectingRecipient _ _ x -> renderForm x ConfirmingClose x -> vBox [txt "Confirm Close action:", renderForm x] @@ -159,9 +167,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, activeHeadState}) -> case activeHeadState of + Active (ActiveLink{utxo, pendingUTxOToDecrement, activeHeadState}) -> case activeHeadState of Initializing x -> drawFocusPanelInitializing me x - Open x -> drawFocusPanelOpen networkId vk utxo x + Open x -> drawFocusPanelOpen networkId vk utxo pendingUTxOToDecrement 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 7d2c73ccbb8..be42179ae7a 100644 --- a/hydra-tui/src/Hydra/TUI/Handlers.hs +++ b/hydra-tui/src/Hydra/TUI/Handlers.hs @@ -164,6 +164,9 @@ handleVtyEventsOpen cardanoClient hydraClient utxo e = do EvKey (KChar 'n') [] -> do let utxo' = myAvailableUTxO (networkId cardanoClient) (getVerificationKey $ sk hydraClient) utxo id .= SelectingUTxO (utxoRadioField utxo') + EvKey (KChar 'd') [] -> do + let utxo' = myAvailableUTxO (networkId cardanoClient) (getVerificationKey $ sk hydraClient) utxo + id .= SelectingUTxOToDecrement (utxoRadioField utxo') _ -> pure () SelectingUTxO i -> do case e of @@ -177,6 +180,19 @@ handleVtyEventsOpen cardanoClient hydraClient utxo e = do id .= EnteringAmount{utxoSelected, enteringAmountForm} _ -> pure () zoom selectingUTxOFormL $ handleFormEvent (VtyEvent e) + SelectingUTxOToDecrement i -> do + case e of + EvKey KEsc [] -> id .= OpenHome + EvKey KEnter [] -> do + let utxoSelected@(_, TxOut{txOutValue = v}) = formState i + let recipient = mkVkAddress @Era (networkId cardanoClient) (getVerificationKey $ sk hydraClient) + case mkSimpleTx utxoSelected (recipient, v) (sk hydraClient) of + Left _ -> pure () + Right tx -> do + liftIO (sendInput hydraClient (Decommit tx)) + id .= OpenHome + _ -> pure () + zoom selectingUTxOToDecrementFormL $ handleFormEvent (VtyEvent e) EnteringAmount utxoSelected i -> do case e of EvKey KEsc [] -> id .= OpenHome @@ -258,6 +274,10 @@ handleHydraEventsActiveLink e = do Update TimedServerOutput{time, output = HeadIsFinalized{utxo}} -> do utxoL .= utxo activeHeadStateL .= Final + Update TimedServerOutput{time, output = DecommitRequested{utxoToDecommit}} -> + pendingUTxOToDecrementL .= utxoToDecommit + Update TimedServerOutput{time, output = DecommitFinalized{}} -> + pendingUTxOToDecrementL .= mempty _ -> pure () handleHydraEventsInfo :: HydraEvent Tx -> EventM Name [LogMessage] () @@ -282,6 +302,10 @@ handleHydraEventsInfo = \case report Success time "Transaction submitted successfully!" Update TimedServerOutput{time, output = TxInvalid{transaction, validationError}} -> warn time ("Transaction with id " <> show (txId transaction) <> " is not applicable: " <> show validationError) + Update TimedServerOutput{time, output = DecommitApproved{}} -> + report Success time "Decrement Transaction submitted successfully!" + Update TimedServerOutput{time, output = DecommitInvalid{decommitTx, decommitInvalidReason}} -> + warn time ("Decrement Transaction with id " <> show (txId decommitTx) <> " is not applicable: " <> show decommitInvalidReason) 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 a61ca6585a9..781b9e1b9c6 100644 --- a/hydra-tui/src/Hydra/TUI/Model.hs +++ b/hydra-tui/src/Hydra/TUI/Model.hs @@ -57,6 +57,7 @@ data InitializingScreen data OpenScreen = OpenHome | SelectingUTxO {selectingUTxOForm :: UTxORadioFieldForm (HydraEvent Tx) Name} + | SelectingUTxOToDecrement {selectingUTxOToDecrementForm :: UTxORadioFieldForm (HydraEvent Tx) Name} | EnteringAmount {utxoSelected :: (TxIn, TxOut CtxUTxO), enteringAmountForm :: Form Integer (HydraEvent Tx) Name} | SelectingRecipient {utxoSelected :: (TxIn, TxOut CtxUTxO), amountEntered :: Integer, selectingRecipientForm :: Form AddressInEra (HydraEvent Tx) Name} | ConfirmingClose {confirmingCloseForm :: ConfirmingRadioFieldForm (HydraEvent Tx) Name} @@ -69,6 +70,7 @@ data HeadState data ActiveLink = ActiveLink { utxo :: UTxO + , pendingUTxOToDecrement :: UTxO , parties :: [Party] , headId :: HeadId , activeHeadState :: ActiveHeadState @@ -85,6 +87,7 @@ type Name = Text makeLensesFor [ ("selectingUTxOForm", "selectingUTxOFormL") + , ("selectingUTxOToDecrementForm", "selectingUTxOToDecrementFormL") , ("enteringAmountForm", "enteringAmountFormL") , ("selectingRecipientForm", "selectingRecipientFormL") , ("confirmingCloseForm", "confirmingCloseFormL") @@ -137,6 +140,7 @@ makeLensesFor makeLensesFor [ ("utxo", "utxoL") + , ("pendingUTxOToDecrement", "pendingUTxOToDecrementL") , ("parties", "partiesL") , ("activeHeadState", "activeHeadStateL") , ("headId", "headIdL") @@ -170,5 +174,6 @@ newActiveLink parties headId = } } , utxo = mempty + , pendingUTxOToDecrement = mempty , headId }