Merge pull request #1201 from input-output-hk/enhance-ux-confirm-action

TUI - Enhance UX to request confirmation for terminating actions

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

@@ -127,13 +127,15 @@ drawFocusPanelInitializing :: IdentifiedState -> InitializingState -> Widget Nam
 drawFocusPanelInitializing me InitializingState{remainingParties, initializingScreen} = case initializingScreen of
   InitializingHome -> drawRemainingParties me remainingParties
   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
   SelectingUTxO x -> renderForm x
   EnteringAmount _ x -> renderForm x
   SelectingRecipient _ _ x -> renderForm x
+  ConfirmingClose x -> vBox [txt "Confirm Close action:", renderForm x]
  where
   ownAddress = mkVkAddress networkId vk
 

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

@@ -60,3 +60,23 @@ utxoRadioField u =
         ]
     ]
     (Prelude.head $ Map.toList u)
+
+confirmRadioField ::
+  forall s e n.
+  ( s ~ Bool
+  , n ~ Text
+  ) =>
+  Form s e n
+confirmRadioField =
+  newForm
+    [ radioField
+        id
+        [ (snd opt, fst opt, fst opt)
+        | opt <- options
+        ]
+    ]
+    True
+ where
+  options = [("yes", True), ("no", False)]
+
+  radioFields = radioField id [(opt, fst opt, show $ fst opt) | opt <- options]

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

@@ -116,7 +116,8 @@ handleVtyEventsActiveHeadState cardanoClient hydraClient utxo e = do
 handleVtyEventsInitializingScreen :: CardanoClient -> Client Tx IO -> Vty.Event -> EventM Name InitializingScreen ()
 handleVtyEventsInitializingScreen cardanoClient hydraClient e = do
   case e of
-    EvKey (KChar 'a') [] -> liftIO (sendInput hydraClient Abort)
+    EvKey (KChar 'a') [] ->
+      id .= ConfirmingAbort confirmRadioField
     _ -> pure ()
   initializingScreen <- use id
   case initializingScreen of
@@ -135,15 +136,35 @@ handleVtyEventsInitializingScreen cardanoClient hydraClient e = do
           id .= InitializingHome
         _ -> pure ()
       zoom commitMenuL $ handleFormEvent (VtyEvent e)
+    ConfirmingAbort i -> do
+      case e of
+        EvKey KEsc [] -> id .= InitializingHome
+        EvKey KEnter [] -> do
+          let selected = formState i
+          if selected
+            then liftIO $ sendInput hydraClient Abort
+            else id .= InitializingHome
+        _ -> pure ()
+      zoom confirmingAbortFormL $ handleFormEvent (VtyEvent e)
 
 handleVtyEventsOpen :: CardanoClient -> Client Tx IO -> UTxO -> Vty.Event -> EventM Name OpenScreen ()
 handleVtyEventsOpen cardanoClient hydraClient utxo e = do
   case e of
     EvKey (KChar 'c') [] ->
-      liftIO $ sendInput hydraClient Close
+      id .= ConfirmingClose confirmRadioField
     _ -> pure ()
   k <- use id
   case k of
+    ConfirmingClose i -> do
+      case e of
+        EvKey KEsc [] -> id .= OpenHome
+        EvKey KEnter [] -> do
+          let selected = formState i
+          if selected
+            then liftIO $ sendInput hydraClient Close
+            else id .= OpenHome
+        _ -> pure ()
+      zoom confirmingCloseFormL $ handleFormEvent (VtyEvent e)
     OpenHome -> do
       case e of
         EvKey (KChar 'n') [] -> do

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

@@ -42,6 +42,8 @@ type UTxOCheckboxForm e n = Form (Map TxIn (TxOut CtxUTxO, Bool)) e n
 
 type UTxORadioFieldForm e n = Form (TxIn, TxOut CtxUTxO) e n
 
+type ConfirmingRadioFieldForm e n = Form Bool e n
+
 data InitializingState = InitializingState
   { remainingParties :: [Party]
   , initializingScreen :: InitializingScreen
@@ -50,12 +52,14 @@ data InitializingState = InitializingState
 data InitializingScreen
   = InitializingHome
   | CommitMenu {commitMenu :: UTxOCheckboxForm (HydraEvent Tx) Name}
+  | ConfirmingAbort {confirmingAbortForm :: ConfirmingRadioFieldForm (HydraEvent Tx) Name}
 
 data OpenScreen
   = OpenHome
   | SelectingUTxO {selectingUTxOForm :: 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}
 
 newtype ClosedState = ClosedState {contestationDeadline :: UTCTime}
 
@@ -83,6 +87,7 @@ makeLensesFor
   [ ("selectingUTxOForm", "selectingUTxOFormL")
   , ("enteringAmountForm", "enteringAmountFormL")
   , ("selectingRecipientForm", "selectingRecipientFormL")
+  , ("confirmingCloseForm", "confirmingCloseFormL")
   ]
   ''OpenScreen
 
@@ -107,6 +112,7 @@ makeLensesFor
 
 makeLensesFor
   [ ("commitMenu", "commitMenuL")
+  , ("confirmingAbortForm", "confirmingAbortFormL")
   ]
   ''InitializingScreen
 

hydra-tui/test/Hydra/TUISpec.hs

@@ -74,6 +74,8 @@ spec = do
           shouldRender "Head id"
           sendInputEvent $ EvKey (KChar 'a') []
           threadDelay 1
+          sendInputEvent $ EvKey KEnter []
+          threadDelay 1
           shouldRender "Idle"
           sendInputEvent $ EvKey (KChar 'q') []
 
@@ -95,6 +97,8 @@ spec = do
           shouldRender "Open"
           sendInputEvent $ EvKey (KChar 'c') []
           threadDelay 1
+          sendInputEvent $ EvKey KEnter []
+          threadDelay 1
           shouldRender "Closed"
           shouldRender "Remaining time to contest"
           -- XXX: This is a hack to estimate the time it takes until we can