{-# LANGUAGE DuplicateRecordFields #-}

module Hydra.TUI.Drawing.FundsTab where

import Hydra.Prelude hiding (Down, State)

import Brick
import Brick.Forms (Form, formState, renderForm)
import Brick.Widgets.Border (borderWithLabel, hBorder, hBorderWithLabel, vBorder)
import Cardano.Api.UTxO qualified as UTxO
import Data.Map qualified as Map
import Hydra.API.ServerOutput (FanoutProgressMode)
import Hydra.Cardano.Api hiding (Active, getVerificationKey)
import Hydra.Chain.CardanoClient (CardanoClient (..))
import Hydra.Chain.Direct.State ()
import Hydra.Client (Client (..))
import Hydra.TUI.Drawing.Utils (
  drawFanningOutMessage,
  drawFanoutPossibleMessage,
  drawHeadFinalizedMessage,
  drawRemainingContestationPeriod,
  drawUTxO,
  highlightOwnAddress,
  renderTime,
  scrollableViewport,
  spinnerFrame,
 )
import Hydra.TUI.Model
import Hydra.TUI.Style
import Hydra.Tx.Crypto (getVerificationKey)
import Lens.Micro ((^.))

-- | Render the Funds tab: the L2 head state (utxo, pending commits/decommits,
-- active modal flow if any) above the L1 wallet refresh panel.
drawFundsTab :: CardanoClient -> Client Tx IO -> RootState -> Widget Name
drawFundsTab :: CardanoClient -> Client Tx IO -> RootState -> Widget Text
drawFundsTab CardanoClient{NetworkId
networkId :: NetworkId
$sel:networkId:CardanoClient :: CardanoClient -> NetworkId
networkId} Client{Secret (SigningKey PaymentKey)
sk :: Secret (SigningKey PaymentKey)
sk :: forall tx (m :: * -> *).
Client tx m -> Secret (SigningKey PaymentKey)
sk} RootState
s =
  Widget Text -> Widget Text -> Widget Text
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text -> Widget Text
forall n. Text -> Widget n
txt Text
" Funds ") (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$
    [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
      [ Widget Text -> Widget Text
forall n. Widget n -> Widget n
hBorderWithLabel (AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text -> Widget Text
forall n. Text -> Widget n
txt Text
" L2 State ")
      , Int -> Widget Text -> Widget Text
forall n. Int -> Widget n -> Widget n
vLimitPercent Int
50 (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$
          Text -> Widget Text -> Widget Text
forall n. (Ord n, Show n) => n -> Widget n -> Widget n
scrollableViewport Text
fundsL2ViewportName (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$
            Int -> Widget Text -> Widget Text
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 Widget Text
drawL2
      , Widget Text -> Widget Text
forall n. Widget n -> Widget n
hBorderWithLabel (AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text -> Widget Text
forall n. Text -> Widget n
txt Text
" L1 Wallet ")
      , [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
hBox
          [ Text -> Widget Text -> Widget Text
forall n. (Ord n, Show n) => n -> Widget n -> Widget n
scrollableViewport Text
fundsL1ViewportName (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$
              Int -> Widget Text -> Widget Text
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$
                Text
-> AddressInEra
-> Maybe (Map TxIn (TxOut CtxUTxO))
-> UTCTime
-> Widget Text
drawWalletColumn Text
"Funds" AddressInEra
ownAddress (RootState
s RootState
-> Getting
     (Maybe (Map TxIn (TxOut CtxUTxO)))
     RootState
     (Maybe (Map TxIn (TxOut CtxUTxO)))
-> Maybe (Map TxIn (TxOut CtxUTxO))
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Map TxIn (TxOut CtxUTxO)))
  RootState
  (Maybe (Map TxIn (TxOut CtxUTxO)))
Lens' RootState (Maybe (Map TxIn (TxOut CtxUTxO)))
l1UTxOL) (RootState
s RootState -> Getting UTCTime RootState UTCTime -> UTCTime
forall s a. s -> Getting a s a -> a
^. Getting UTCTime RootState UTCTime
Lens' RootState UTCTime
nowL)
          , Widget Text
forall n. Widget n
vBorder
          , Text -> Widget Text -> Widget Text
forall n. (Ord n, Show n) => n -> Widget n -> Widget n
scrollableViewport Text
fundsFuelViewportName (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$
              Int -> Widget Text -> Widget Text
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$
                NetworkId
-> Maybe (VerificationKey PaymentKey)
-> Maybe (Map TxIn (TxOut CtxUTxO))
-> UTCTime
-> Widget Text
drawFuelColumn NetworkId
networkId (RootState
s RootState
-> Getting
     (Maybe (VerificationKey PaymentKey))
     RootState
     (Maybe (VerificationKey PaymentKey))
-> Maybe (VerificationKey PaymentKey)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (VerificationKey PaymentKey))
  RootState
  (Maybe (VerificationKey PaymentKey))
Lens' RootState (Maybe (VerificationKey PaymentKey))
fuelVkL) (RootState
s RootState
-> Getting
     (Maybe (Map TxIn (TxOut CtxUTxO)))
     RootState
     (Maybe (Map TxIn (TxOut CtxUTxO)))
-> Maybe (Map TxIn (TxOut CtxUTxO))
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Map TxIn (TxOut CtxUTxO)))
  RootState
  (Maybe (Map TxIn (TxOut CtxUTxO)))
Lens' RootState (Maybe (Map TxIn (TxOut CtxUTxO)))
fuelUTxOL) (RootState
s RootState -> Getting UTCTime RootState UTCTime -> UTCTime
forall s a. s -> Getting a s a -> a
^. Getting UTCTime RootState UTCTime
Lens' RootState UTCTime
nowL)
          ]
      ]
 where
  vk :: VerificationKey PaymentKey
vk = Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey Secret (SigningKey PaymentKey)
sk
  ownAddress :: AddressInEra
ownAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk
  drawL2 :: Widget Text
drawL2 = case RootState
s RootState
-> Getting ConnectedState RootState ConnectedState
-> ConnectedState
forall s a. s -> Getting a s a -> a
^. Getting ConnectedState RootState ConnectedState
Lens' RootState ConnectedState
connectedStateL of
    ConnectedState
Disconnected -> AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Not connected."
    Connected Connection
k -> NetworkId
-> VerificationKey PaymentKey
-> UTCTime
-> Connection
-> Widget Text
drawFocusPanel NetworkId
networkId VerificationKey PaymentKey
vk (RootState
s RootState -> Getting UTCTime RootState UTCTime -> UTCTime
forall s a. s -> Getting a s a -> a
^. Getting UTCTime RootState UTCTime
Lens' RootState UTCTime
nowL) Connection
k

-- | Render one L1 wallet column under the given header: a spinner while the L1
-- query is in flight, otherwise the UTxO listing (or a placeholder when empty).
drawWalletColumn :: Text -> AddressInEra -> Maybe (Map TxIn (TxOut CtxUTxO)) -> UTCTime -> Widget Name
drawWalletColumn :: Text
-> AddressInEra
-> Maybe (Map TxIn (TxOut CtxUTxO))
-> UTCTime
-> Widget Text
drawWalletColumn Text
title AddressInEra
_ Maybe (Map TxIn (TxOut CtxUTxO))
Nothing UTCTime
now =
  [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
    [ AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text -> Widget Text
forall n. Text -> Widget n
txt Text
title
    , AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Int -> Widget Text -> Widget Text
forall n. Int -> Widget n -> Widget n
padAll Int
1 (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text -> Widget Text
forall n. Text -> Widget n
txt (UTCTime -> Text
spinnerFrame UTCTime
now Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Refreshing…")
    ]
drawWalletColumn Text
title AddressInEra
ownAddress (Just Map TxIn (TxOut CtxUTxO)
utxo) UTCTime
_ =
  [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
    [ AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text -> Widget Text
forall n. Text -> Widget n
txt Text
title
    , if Map TxIn (TxOut CtxUTxO) -> Bool
forall k a. Map k a -> Bool
Map.null Map TxIn (TxOut CtxUTxO)
utxo
        then AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Int -> Widget Text -> Widget Text
forall n. Int -> Widget n -> Widget n
padAll Int
1 (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text -> Widget Text
forall n. Text -> Widget n
txt Text
"No UTxO found."
        else (AddressInEra -> Widget Text) -> UTxO -> Widget Text
forall n. (AddressInEra -> Widget n) -> UTxO -> Widget n
drawUTxO (AddressInEra -> AddressInEra -> Widget Text
forall n. AddressInEra -> AddressInEra -> Widget n
highlightOwnAddress AddressInEra
ownAddress) (Map TxIn (TxOut CtxUTxO) -> UTxO
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
UTxO.fromMap Map TxIn (TxOut CtxUTxO)
utxo)
    ]

-- | Render the Fuel column: the node's internal-wallet UTxO usable to pay for
-- layer 1 protocol transactions. Display-only; never used to commit. Shows a
-- hint when no fuel key was configured (no @--fuel-key@).
drawFuelColumn :: NetworkId -> Maybe (VerificationKey PaymentKey) -> Maybe (Map TxIn (TxOut CtxUTxO)) -> UTCTime -> Widget Name
drawFuelColumn :: NetworkId
-> Maybe (VerificationKey PaymentKey)
-> Maybe (Map TxIn (TxOut CtxUTxO))
-> UTCTime
-> Widget Text
drawFuelColumn NetworkId
_ Maybe (VerificationKey PaymentKey)
Nothing Maybe (Map TxIn (TxOut CtxUTxO))
_ UTCTime
_ =
  [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
    [ AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Fuel"
    , AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Int -> Widget Text -> Widget Text
forall n. Int -> Widget n -> Widget n
padAll Int
1 (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text -> Widget Text
forall n. Text -> Widget n
txt Text
"No fuel key configured."
    ]
drawFuelColumn NetworkId
networkId (Just VerificationKey PaymentKey
fuelVk) Maybe (Map TxIn (TxOut CtxUTxO))
mUtxo UTCTime
now =
  Text
-> AddressInEra
-> Maybe (Map TxIn (TxOut CtxUTxO))
-> UTCTime
-> Widget Text
drawWalletColumn Text
"Fuel" (NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
fuelVk) Maybe (Map TxIn (TxOut CtxUTxO))
mUtxo UTCTime
now

-- | The focus panel shows the active head state in detail.
-- Used by both the Funds tab (L2 section) and the Modal tab.
drawFocusPanel :: NetworkId -> VerificationKey PaymentKey -> UTCTime -> Connection -> Widget Name
drawFocusPanel :: NetworkId
-> VerificationKey PaymentKey
-> UTCTime
-> Connection
-> Widget Text
drawFocusPanel NetworkId
networkId VerificationKey PaymentKey
vk UTCTime
now (Connection{HeadState
headState :: HeadState
$sel:headState:Connection :: Connection -> HeadState
headState}) = case HeadState
headState of
  HeadState
Idle -> AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Head is idle."
  Active (ActiveLink{UTxO
utxo :: UTxO
$sel:utxo:ActiveLink :: ActiveLink -> UTxO
utxo, UTxO
pendingUTxOToDecommit :: UTxO
$sel:pendingUTxOToDecommit:ActiveLink :: ActiveLink -> UTxO
pendingUTxOToDecommit, [PendingIncrement]
pendingIncrements :: [PendingIncrement]
$sel:pendingIncrements:ActiveLink :: ActiveLink -> [PendingIncrement]
pendingIncrements, ActiveHeadState
activeHeadState :: ActiveHeadState
$sel:activeHeadState:ActiveLink :: ActiveLink -> ActiveHeadState
activeHeadState}) -> case ActiveHeadState
activeHeadState of
    Open OpenScreen
x -> NetworkId
-> VerificationKey PaymentKey
-> UTxO
-> UTxO
-> [PendingIncrement]
-> UTCTime
-> OpenScreen
-> Widget Text
drawFocusPanelOpen NetworkId
networkId VerificationKey PaymentKey
vk UTxO
utxo UTxO
pendingUTxOToDecommit [PendingIncrement]
pendingIncrements UTCTime
now OpenScreen
x
    Closed ClosedState
x -> NetworkId
-> VerificationKey PaymentKey
-> UTxO
-> [PendingIncrement]
-> UTCTime
-> ClosedState
-> Widget Text
drawFocusPanelClosed NetworkId
networkId VerificationKey PaymentKey
vk UTxO
utxo [PendingIncrement]
pendingIncrements UTCTime
now ClosedState
x
    ActiveHeadState
FanoutPossible -> NetworkId
-> VerificationKey PaymentKey
-> UTxO
-> [PendingIncrement]
-> UTCTime
-> Widget Text
drawFocusPanelFanout NetworkId
networkId VerificationKey PaymentKey
vk UTxO
utxo [PendingIncrement]
pendingIncrements UTCTime
now
    FanningOut{UTxO
fanoutRemaining :: UTxO
$sel:fanoutRemaining:Open :: ActiveHeadState -> UTxO
fanoutRemaining, FanoutProgressMode
fanoutMode :: FanoutProgressMode
$sel:fanoutMode:Open :: ActiveHeadState -> FanoutProgressMode
fanoutMode} -> NetworkId
-> VerificationKey PaymentKey
-> FanoutProgressMode
-> UTxO
-> [PendingIncrement]
-> UTCTime
-> Widget Text
drawFocusPanelFanningOut NetworkId
networkId VerificationKey PaymentKey
vk FanoutProgressMode
fanoutMode UTxO
fanoutRemaining [PendingIncrement]
pendingIncrements UTCTime
now
    ActiveHeadState
Final -> NetworkId
-> VerificationKey PaymentKey
-> UTxO
-> [PendingIncrement]
-> UTCTime
-> Widget Text
drawFocusPanelFinal NetworkId
networkId VerificationKey PaymentKey
vk UTxO
utxo [PendingIncrement]
pendingIncrements UTCTime
now

-- | Focus panel for an 'Open' head: dispatches to home view or the active modal-form view.
drawFocusPanelOpen :: NetworkId -> VerificationKey PaymentKey -> UTxO -> UTxO -> [PendingIncrement] -> UTCTime -> OpenScreen -> Widget Name
drawFocusPanelOpen :: NetworkId
-> VerificationKey PaymentKey
-> UTxO
-> UTxO
-> [PendingIncrement]
-> UTCTime
-> OpenScreen
-> Widget Text
drawFocusPanelOpen NetworkId
networkId VerificationKey PaymentKey
vk UTxO
utxo UTxO
pendingUTxOToDecommit [PendingIncrement]
pendingIncrements UTCTime
now = \case
  OpenScreen
OpenHome ->
    [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
      [ AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Active UTxO")
      , (AddressInEra -> Widget Text) -> UTxO -> Widget Text
forall n. (AddressInEra -> Widget n) -> UTxO -> Widget n
drawUTxO (AddressInEra -> AddressInEra -> Widget Text
forall n. AddressInEra -> AddressInEra -> Widget n
highlightOwnAddress AddressInEra
ownAddress) UTxO
utxo
      , Widget Text
forall n. Widget n
hBorder
      , AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Pending decommit")
      , (AddressInEra -> Widget Text) -> UTxO -> Widget Text
forall n. (AddressInEra -> Widget n) -> UTxO -> Widget n
drawUTxO (AddressInEra -> AddressInEra -> Widget Text
forall n. AddressInEra -> AddressInEra -> Widget n
highlightOwnAddress AddressInEra
ownAddress) UTxO
pendingUTxOToDecommit
      , Widget Text
forall n. Widget n
hBorder
      , AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Pending commits")
      , AddressInEra -> [PendingIncrement] -> UTCTime -> Widget Text
drawPendingIncrement AddressInEra
ownAddress [PendingIncrement]
pendingIncrements UTCTime
now
      ]
  OpenScreen
LoadingUTxOForIncrement ->
    Int -> Widget Text -> Widget Text
forall n. Int -> Widget n -> Widget n
padAll Int
1 (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Refreshing L1 UTxO…"
  OpenScreen
NoUTxOToIncrement ->
    Int -> Widget Text -> Widget Text
forall n. Int -> Widget n -> Widget n
padAll Int
1 (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text -> Widget Text
forall n. Text -> Widget n
txt Text
"No known L1 funds. Press [U] to refresh."
  SelectingUTxO UTxORadioFieldForm (HydraEvent Tx) Text
x -> UTxORadioFieldForm (HydraEvent Tx) Text -> Widget Text
forall n s e. Eq n => Form s e n -> Widget n
renderForm UTxORadioFieldForm (HydraEvent Tx) Text
x
  SelectingUTxOToDecommit UTxORadioFieldForm (HydraEvent Tx) Text
x -> UTxORadioFieldForm (HydraEvent Tx) Text -> Widget Text
forall n s e. Eq n => Form s e n -> Widget n
renderForm UTxORadioFieldForm (HydraEvent Tx) Text
x
  SelectingUTxOToIncrement UTxORadioFieldForm (HydraEvent Tx) Text
x -> UTxORadioFieldForm (HydraEvent Tx) Text -> Widget Text
forall n s e. Eq n => Form s e n -> Widget n
renderForm UTxORadioFieldForm (HydraEvent Tx) Text
x
  EnteringAmount (TxIn, TxOut CtxUTxO)
_ Form Double (HydraEvent Tx) Text
x -> Form Double (HydraEvent Tx) Text -> Widget Text
forall n s e. Eq n => Form s e n -> Widget n
renderForm Form Double (HydraEvent Tx) Text
x
  SelectingRecipient (TxIn, TxOut CtxUTxO)
_ Double
_ Form SelectAddressItem (HydraEvent Tx) Text
x -> Form SelectAddressItem (HydraEvent Tx) Text -> Widget Text
forall n s e. Eq n => Form s e n -> Widget n
renderForm Form SelectAddressItem (HydraEvent Tx) Text
x
  EnteringRecipientAddress (TxIn, TxOut CtxUTxO)
_ Double
_ Form AddressInEra (HydraEvent Tx) Text
x -> Form AddressInEra (HydraEvent Tx) Text -> Widget Text
forall n s e. Eq n => Form s e n -> Widget n
renderForm Form AddressInEra (HydraEvent Tx) Text
x
  ConfirmingClose ConfirmingRadioFieldForm (HydraEvent Tx) Text
x -> [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox [Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Confirm close:", ConfirmingRadioFieldForm (HydraEvent Tx) Text -> Widget Text
forall n s e. Eq n => Form s e n -> Widget n
renderForm ConfirmingRadioFieldForm (HydraEvent Tx) Text
x]
 where
  ownAddress :: AddressInEra
ownAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk

-- | Focus panel for a 'Closed' head: contestation countdown, active UTxO, pending commits.
drawFocusPanelClosed :: NetworkId -> VerificationKey PaymentKey -> UTxO -> [PendingIncrement] -> UTCTime -> ClosedState -> Widget Name
drawFocusPanelClosed :: NetworkId
-> VerificationKey PaymentKey
-> UTxO
-> [PendingIncrement]
-> UTCTime
-> ClosedState
-> Widget Text
drawFocusPanelClosed NetworkId
networkId VerificationKey PaymentKey
vk UTxO
utxo [PendingIncrement]
pendingIncrements UTCTime
now (ClosedState{UTCTime
contestationDeadline :: UTCTime
$sel:contestationDeadline:ClosedState :: ClosedState -> UTCTime
contestationDeadline}) =
  [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox ([Widget Text] -> Widget Text) -> [Widget Text] -> Widget Text
forall a b. (a -> b) -> a -> b
$
    [ UTCTime -> UTCTime -> Widget Text
forall n. UTCTime -> UTCTime -> Widget n
drawRemainingContestationPeriod UTCTime
contestationDeadline UTCTime
now
    , AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Active UTxO")
    , (AddressInEra -> Widget Text) -> UTxO -> Widget Text
forall n. (AddressInEra -> Widget n) -> UTxO -> Widget n
drawUTxO (AddressInEra -> AddressInEra -> Widget Text
forall n. AddressInEra -> AddressInEra -> Widget n
highlightOwnAddress AddressInEra
ownAddress) UTxO
utxo
    ]
      [Widget Text] -> [Widget Text] -> [Widget Text]
forall a. Semigroup a => a -> a -> a
<> AddressInEra -> [PendingIncrement] -> UTCTime -> [Widget Text]
drawPendingCommits AddressInEra
ownAddress [PendingIncrement]
pendingIncrements UTCTime
now
 where
  ownAddress :: AddressInEra
ownAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk

-- | Focus panel when fanout is possible.
drawFocusPanelFanout :: NetworkId -> VerificationKey PaymentKey -> UTxO -> [PendingIncrement] -> UTCTime -> Widget Name
drawFocusPanelFanout :: NetworkId
-> VerificationKey PaymentKey
-> UTxO
-> [PendingIncrement]
-> UTCTime
-> Widget Text
drawFocusPanelFanout NetworkId
networkId VerificationKey PaymentKey
vk UTxO
utxo [PendingIncrement]
pendingIncrements UTCTime
now =
  [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox ([Widget Text] -> Widget Text) -> [Widget Text] -> Widget Text
forall a b. (a -> b) -> a -> b
$
    [ Widget Text
forall n. Widget n
drawFanoutPossibleMessage
    , AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Active UTxO")
    , (AddressInEra -> Widget Text) -> UTxO -> Widget Text
forall n. (AddressInEra -> Widget n) -> UTxO -> Widget n
drawUTxO (AddressInEra -> AddressInEra -> Widget Text
forall n. AddressInEra -> AddressInEra -> Widget n
highlightOwnAddress AddressInEra
ownAddress) UTxO
utxo
    ]
      [Widget Text] -> [Widget Text] -> [Widget Text]
forall a. Semigroup a => a -> a -> a
<> AddressInEra -> [PendingIncrement] -> UTCTime -> [Widget Text]
drawPendingCommits AddressInEra
ownAddress [PendingIncrement]
pendingIncrements UTCTime
now
 where
  ownAddress :: AddressInEra
ownAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk

-- | Focus panel while a selective partial fanout is in progress: shows what is
-- still to be fanned out.
drawFocusPanelFanningOut :: NetworkId -> VerificationKey PaymentKey -> FanoutProgressMode -> UTxO -> [PendingIncrement] -> UTCTime -> Widget Name
drawFocusPanelFanningOut :: NetworkId
-> VerificationKey PaymentKey
-> FanoutProgressMode
-> UTxO
-> [PendingIncrement]
-> UTCTime
-> Widget Text
drawFocusPanelFanningOut NetworkId
networkId VerificationKey PaymentKey
vk FanoutProgressMode
fanoutMode UTxO
remaining [PendingIncrement]
pendingIncrements UTCTime
now =
  [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox ([Widget Text] -> Widget Text) -> [Widget Text] -> Widget Text
forall a b. (a -> b) -> a -> b
$
    [ FanoutProgressMode -> UTxO -> Widget Text
forall n. FanoutProgressMode -> UTxO -> Widget n
drawFanningOutMessage FanoutProgressMode
fanoutMode UTxO
remaining
    , AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Remaining UTxO")
    , (AddressInEra -> Widget Text) -> UTxO -> Widget Text
forall n. (AddressInEra -> Widget n) -> UTxO -> Widget n
drawUTxO (AddressInEra -> AddressInEra -> Widget Text
forall n. AddressInEra -> AddressInEra -> Widget n
highlightOwnAddress AddressInEra
ownAddress) UTxO
remaining
    ]
      [Widget Text] -> [Widget Text] -> [Widget Text]
forall a. Semigroup a => a -> a -> a
<> AddressInEra -> [PendingIncrement] -> UTCTime -> [Widget Text]
drawPendingCommits AddressInEra
ownAddress [PendingIncrement]
pendingIncrements UTCTime
now
 where
  ownAddress :: AddressInEra
ownAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk

-- | Focus panel for a finalised head.
drawFocusPanelFinal :: NetworkId -> VerificationKey PaymentKey -> UTxO -> [PendingIncrement] -> UTCTime -> Widget Name
drawFocusPanelFinal :: NetworkId
-> VerificationKey PaymentKey
-> UTxO
-> [PendingIncrement]
-> UTCTime
-> Widget Text
drawFocusPanelFinal NetworkId
networkId VerificationKey PaymentKey
vk UTxO
utxo [PendingIncrement]
pendingIncrements UTCTime
now =
  [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox ([Widget Text] -> Widget Text) -> [Widget Text] -> Widget Text
forall a b. (a -> b) -> a -> b
$
    [ UTxO -> Widget Text
forall n. UTxO -> Widget n
drawHeadFinalizedMessage UTxO
utxo
    , Padding -> Widget Text -> Widget Text
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) ((AddressInEra -> Widget Text) -> UTxO -> Widget Text
forall n. (AddressInEra -> Widget n) -> UTxO -> Widget n
drawUTxO (AddressInEra -> AddressInEra -> Widget Text
forall n. AddressInEra -> AddressInEra -> Widget n
highlightOwnAddress AddressInEra
ownAddress) UTxO
utxo)
    ]
      [Widget Text] -> [Widget Text] -> [Widget Text]
forall a. Semigroup a => a -> a -> a
<> AddressInEra -> [PendingIncrement] -> UTCTime -> [Widget Text]
drawPendingCommits AddressInEra
ownAddress [PendingIncrement]
pendingIncrements UTCTime
now
 where
  ownAddress :: AddressInEra
ownAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk

-- | Shared "Pending commits" tail for the Funds tab's focus-panel
-- variants (Closed, FanoutPossible, Final). Returns a list of widgets to be
-- spliced into a surrounding 'vBox'.
drawPendingCommits :: AddressInEra -> [PendingIncrement] -> UTCTime -> [Widget Name]
drawPendingCommits :: AddressInEra -> [PendingIncrement] -> UTCTime -> [Widget Text]
drawPendingCommits AddressInEra
ownAddress [PendingIncrement]
pendingIncrements UTCTime
now =
  [ Widget Text
forall n. Widget n
hBorder
  , AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Pending commits")
  , AddressInEra -> [PendingIncrement] -> UTCTime -> Widget Text
drawPendingIncrement AddressInEra
ownAddress [PendingIncrement]
pendingIncrements UTCTime
now
  ]

-- | Render the remaining time before a deposit becomes recoverable, or a
-- "ready to recover" hint once the deadline has passed.
drawRemainingDepositDeadline :: UTCTime -> UTCTime -> Widget Name
drawRemainingDepositDeadline :: UTCTime -> UTCTime -> Widget Text
drawRemainingDepositDeadline UTCTime
deadline UTCTime
now =
  let remaining :: NominalDiffTime
remaining = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
deadline UTCTime
now
   in if NominalDiffTime
remaining NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> NominalDiffTime
0
        then Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Remaining time to deposit: " Widget Text -> Widget Text -> Widget Text
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Text
forall n. String -> Widget n
str (NominalDiffTime -> String
forall t. (Ord t, Num t, FormatTime t) => t -> String
renderTime NominalDiffTime
remaining)
        else AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
negative (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Deposit deadline passed, ready to recover."

-- | Render the list of pending deposit/increment entries with their status,
-- UTxO outputs, and remaining deadline.
drawPendingIncrement :: AddressInEra -> [PendingIncrement] -> UTCTime -> Widget Name
drawPendingIncrement :: AddressInEra -> [PendingIncrement] -> UTCTime -> Widget Text
drawPendingIncrement AddressInEra
ownAddress [PendingIncrement]
pendingIncrements UTCTime
now =
  [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox ([Widget Text] -> Widget Text) -> [Widget Text] -> Widget Text
forall a b. (a -> b) -> a -> b
$ ([Widget Text] -> PendingIncrement -> [Widget Text])
-> [Widget Text] -> [PendingIncrement] -> [Widget Text]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Widget Text] -> PendingIncrement -> [Widget Text]
pendingWidget [] [PendingIncrement]
pendingIncrements
 where
  pendingWidget :: [Widget Text] -> PendingIncrement -> [Widget Text]
pendingWidget [Widget Text]
acc = \case
    PendingIncrement{UTxO
utxoToCommit :: UTxO
$sel:utxoToCommit:PendingIncrement :: PendingIncrement -> UTxO
utxoToCommit, TxId
deposit :: TxId
$sel:deposit:PendingIncrement :: PendingIncrement -> TxId
deposit, UTCTime
depositDeadline :: UTCTime
$sel:depositDeadline:PendingIncrement :: PendingIncrement -> UTCTime
depositDeadline, PendingIncrementStatus
status :: PendingIncrementStatus
$sel:status:PendingIncrement :: PendingIncrement -> PendingIncrementStatus
status} ->
      [Widget Text]
acc
        [Widget Text] -> [Widget Text] -> [Widget Text]
forall a. Semigroup a => a -> a -> a
<> [ Text -> Widget Text
forall n. Text -> Widget n
txt (Text
"id: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxId -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText TxId
deposit)
           , Text -> Widget Text
forall n. Text -> Widget n
txt (Text
"status: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PendingIncrementStatus -> Text
forall b a. (Show a, IsString b) => a -> b
show PendingIncrementStatus
status)
           , (AddressInEra -> Widget Text) -> UTxO -> Widget Text
forall n. (AddressInEra -> Widget n) -> UTxO -> Widget n
drawUTxO (AddressInEra -> AddressInEra -> Widget Text
forall n. AddressInEra -> AddressInEra -> Widget n
highlightOwnAddress AddressInEra
ownAddress) UTxO
utxoToCommit
           , UTCTime -> UTCTime -> Widget Text
drawRemainingDepositDeadline UTCTime
depositDeadline UTCTime
now
           , Widget Text
forall n. Widget n
hBorder
           ]

-- | Render the recover modal: a radio list of pending deposit ids on top, and
-- a detail panel for the currently-focused deposit (status, deadline, UTxO
-- outputs) below. Keeps one selection per deposit instead of one per output.
drawRecoverFormWithDetail ::
  AddressInEra ->
  Form TxId e Name ->
  [PendingIncrement] ->
  UTCTime ->
  Widget Name
drawRecoverFormWithDetail :: forall e.
AddressInEra
-> Form TxId e Text -> [PendingIncrement] -> UTCTime -> Widget Text
drawRecoverFormWithDetail AddressInEra
ownAddress Form TxId e Text
form [PendingIncrement]
pendingIncrements UTCTime
now =
  [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
    [ AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Select a deposit to recover:")
    , Form TxId e Text -> Widget Text
forall n s e. Eq n => Form s e n -> Widget n
renderForm Form TxId e Text
form
    , Widget Text
forall n. Widget n
hBorder
    , AddressInEra
-> TxId -> [PendingIncrement] -> UTCTime -> Widget Text
drawRecoverDetail AddressInEra
ownAddress (Form TxId e Text -> TxId
forall s e n. Form s e n -> s
formState Form TxId e Text
form) [PendingIncrement]
pendingIncrements UTCTime
now
    ]

-- | Detail panel for one pending deposit: full TxId, current status,
-- remaining time to the deposit deadline, and the per-output UTxO listing.
drawRecoverDetail ::
  AddressInEra ->
  TxId ->
  [PendingIncrement] ->
  UTCTime ->
  Widget Name
drawRecoverDetail :: AddressInEra
-> TxId -> [PendingIncrement] -> UTCTime -> Widget Text
drawRecoverDetail AddressInEra
ownAddress TxId
selectedTxId [PendingIncrement]
pendingIncrements UTCTime
now =
  case (PendingIncrement -> Bool)
-> [PendingIncrement] -> Maybe PendingIncrement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\PendingIncrement{TxId
$sel:deposit:PendingIncrement :: PendingIncrement -> TxId
deposit :: TxId
deposit} -> TxId
deposit TxId -> TxId -> Bool
forall a. Eq a => a -> a -> Bool
== TxId
selectedTxId) [PendingIncrement]
pendingIncrements of
    Maybe PendingIncrement
Nothing -> AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text -> Widget Text
forall n. Text -> Widget n
txt Text
"(no deposit selected)"
    Just PendingIncrement{UTxO
$sel:utxoToCommit:PendingIncrement :: PendingIncrement -> UTxO
utxoToCommit :: UTxO
utxoToCommit, TxId
$sel:deposit:PendingIncrement :: PendingIncrement -> TxId
deposit :: TxId
deposit, UTCTime
$sel:depositDeadline:PendingIncrement :: PendingIncrement -> UTCTime
depositDeadline :: UTCTime
depositDeadline, PendingIncrementStatus
$sel:status:PendingIncrement :: PendingIncrement -> PendingIncrementStatus
status :: PendingIncrementStatus
status} ->
      [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
        [ AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Selected deposit")
        , Text -> Widget Text
forall n. Text -> Widget n
txt (Text
"id: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxId -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText TxId
deposit)
        , Text -> Widget Text
forall n. Text -> Widget n
txt (Text
"status: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PendingIncrementStatus -> Text
forall b a. (Show a, IsString b) => a -> b
show PendingIncrementStatus
status)
        , UTCTime -> UTCTime -> Widget Text
drawRemainingDepositDeadline UTCTime
depositDeadline UTCTime
now
        , AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Outputs")
        , (AddressInEra -> Widget Text) -> UTxO -> Widget Text
forall n. (AddressInEra -> Widget n) -> UTxO -> Widget n
drawUTxO (AddressInEra -> AddressInEra -> Widget Text
forall n. AddressInEra -> AddressInEra -> Widget n
highlightOwnAddress AddressInEra
ownAddress) UTxO
utxoToCommit
        ]