Add decommit command to TUI

cardano-scaling · Jul 19, 2024 · 63ebc2a · 63ebc2a
1 parent b21215d
commit 63ebc2a
Show file tree

Hide file tree

Showing 3 changed files with 43 additions and 6 deletions.
diff --git 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
@@ -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
@@ -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
     }