break down increment into pending deposit and commit

cardano-scaling · Nov 22, 2024 · c973799 · c973799
1 parent 060c0ae
commit c973799
Show file tree

Hide file tree

Showing 3 changed files with 49 additions and 21 deletions.
diff --git a/hydra-tui/src/Hydra/TUI/Drawing.hs b/hydra-tui/src/Hydra/TUI/Drawing.hs
@@ -134,25 +134,41 @@ 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: "
       , drawUTxO (highlightOwnAddress ownAddress) utxo
       , 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
@@ -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
@@ -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
     }