{-# LANGUAGE DuplicateRecordFields #-}

module Hydra.TUI.Drawing.MainTab where

import Hydra.Prelude hiding (Down, State)

import Brick
import Brick.Widgets.Border (borderWithLabel, hBorderWithLabel)
import Cardano.Api.UTxO qualified as UTxO
import Data.Map qualified as Map
import Hydra.Cardano.Api hiding (Active, getVerificationKey)
import Hydra.Chain.CardanoClient (CardanoClient (..))
import Hydra.Chain.Direct.State ()
import Hydra.Client (Client (..))
import Hydra.Network (Host)
import Hydra.TUI.Drawing.EventHistoryTab (drawEventListItem)
import Hydra.TUI.Drawing.Utils (
  drawFanningOutMessage,
  drawFanoutPossibleMessage,
  drawHeadFinalizedMessage,
  drawHex,
  drawRemainingContestationPeriod,
  drawShow,
  drawUTxO,
  highlightOwnAddress,
  prettyHeadId,
  scrollableViewport,
 )
import Hydra.TUI.Logging.Types (logMessagesL)
import Hydra.TUI.Model
import Hydra.TUI.Style
import Hydra.Tx (Party (..))
import Hydra.Tx.Crypto (getVerificationKey)
import Lens.Micro ((^.))

-- | Render the Main tab: connection/network/chain status, peers, head parties,
-- head state with UTxOs, and a strip of recent events.
drawMainTab :: CardanoClient -> Client Tx IO -> RootState -> Widget Name
drawMainTab :: CardanoClient -> Client Tx IO -> RootState -> Widget Text
drawMainTab 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 Widget Text
panelLabel (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
      [ -- Status strip: plain text, no border characters so junctions don't misalign.
        -- Connection/network/chain status sit on the left; the user's address is
        -- right-aligned via padLeft Max.
        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
$
          [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
hBox
            [ [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
hBox ([Widget Text] -> Widget Text)
-> ([Widget Text] -> [Widget Text]) -> [Widget Text] -> Widget Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Text -> [Widget Text] -> [Widget Text]
forall a. a -> [a] -> [a]
intersperse (Text -> Widget Text
forall n. Text -> Widget n
txt Text
"   ") ([Widget Text] -> Widget Text) -> [Widget Text] -> Widget Text
forall a b. (a -> b) -> a -> b
$
                [ RootState -> Widget Text
forall n. RootState -> Widget n
drawConnectedStatus RootState
s
                , ConnectedState -> Widget Text
forall n. ConnectedState -> Widget n
drawNetworkState ConnectedState
connState
                , ConnectedState -> Widget Text
forall n. ConnectedState -> Widget n
drawChainSyncedState ConnectedState
connState
                ]
            , Padding -> Widget Text -> Widget Text
forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max (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 (Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Address: ")
                  Widget Text -> Widget Text -> Widget Text
forall n. Widget n -> Widget n -> Widget n
<+> AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
infoA (Text -> Widget Text
forall n. Text -> Widget n
txt (AddressInEra Era -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress AddressInEra Era
ownAddress))
            ]
      , 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
$
          [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
hBox
            [ Int -> Widget Text -> Widget Text
forall n. Int -> Widget n -> Widget n
hLimit Int
32 (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 -> 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
" Peers ") (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
drawPeersSection
                  , 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
" Head parties ") (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
drawHeadPartiesSection
                  ]
            , Padding -> Widget Text -> Widget Text
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$
                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
" Head state ") (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
drawHeadStateSection
            ]
      , 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
" Recent events ")
      , Text -> ViewportType -> Widget Text -> Widget Text
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Text
"recent-events" ViewportType
Vertical (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) -> [Widget Text] -> Widget Text
forall a b. (a -> b) -> a -> b
$
            (LogMessage -> Widget Text) -> [LogMessage] -> [Widget Text]
forall a b. (a -> b) -> [a] -> [b]
map (TimeZone -> Bool -> LogMessage -> Widget Text
drawEventListItem (RootState
s RootState -> Getting TimeZone RootState TimeZone -> TimeZone
forall s a. s -> Getting a s a -> a
^. Getting TimeZone RootState TimeZone
Lens' RootState TimeZone
timeZoneL) Bool
False) (RootState
s RootState
-> Getting [LogMessage] RootState [LogMessage] -> [LogMessage]
forall s a. s -> Getting a s a -> a
^. (LogState -> Const [LogMessage] LogState)
-> RootState -> Const [LogMessage] RootState
Lens' RootState LogState
logStateL ((LogState -> Const [LogMessage] LogState)
 -> RootState -> Const [LogMessage] RootState)
-> (([LogMessage] -> Const [LogMessage] [LogMessage])
    -> LogState -> Const [LogMessage] LogState)
-> Getting [LogMessage] RootState [LogMessage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([LogMessage] -> Const [LogMessage] [LogMessage])
-> LogState -> Const [LogMessage] LogState
Lens' LogState [LogMessage]
logMessagesL)
      ]
 where
  connState :: ConnectedState
connState = 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
  ownAddress :: AddressInEra Era
ownAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId (Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey Secret (SigningKey PaymentKey)
sk)

  panelLabel :: Widget Name
  panelLabel :: Widget Text
panelLabel = case ConnectedState
connState 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
" Status "
    Connected (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
" Idle "
      Active (ActiveLink{HeadId
headId :: HeadId
$sel:headId:ActiveLink :: ActiveLink -> HeadId
headId, ActiveHeadState
activeHeadState :: ActiveHeadState
$sel:activeHeadState:ActiveLink :: ActiveLink -> ActiveHeadState
activeHeadState}) ->
        let stateStr :: Text
stateStr = case ActiveHeadState
activeHeadState of
              Open{} -> Text
"Open"
              Closed{} -> Text
"Closed"
              ActiveHeadState
FanoutPossible -> Text
"Ready to Fanout"
              FanningOut{} -> Text
"Fanning out"
              ActiveHeadState
Final -> Text
"Finalized"
            hid :: Text
hid = HeadId -> Text
prettyHeadId HeadId
headId
         in 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
" ")
              Widget Text -> Widget Text -> Widget Text
forall n. Widget n -> Widget n -> Widget n
<+> AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
headStateA (Text -> Widget Text
forall n. Text -> Widget n
txt Text
stateStr)
              Widget Text -> Widget Text -> Widget Text
forall n. Widget n -> Widget n -> Widget n
<+> 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
" · Head id: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "))

  drawPeersSection :: Widget Name
  drawPeersSection :: Widget Text
drawPeersSection = case ConnectedState
connState 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
"Peers"
    Connected Connection
c -> ConnectedState -> [(Host, PeerStatus)] -> Widget Text
forall n. ConnectedState -> [(Host, PeerStatus)] -> Widget n
drawPeers ConnectedState
connState (Connection
c Connection
-> Getting [(Host, PeerStatus)] Connection [(Host, PeerStatus)]
-> [(Host, PeerStatus)]
forall s a. s -> Getting a s a -> a
^. Getting [(Host, PeerStatus)] Connection [(Host, PeerStatus)]
Lens' Connection [(Host, PeerStatus)]
peersL)

  drawHeadPartiesSection :: Widget Name
  drawHeadPartiesSection :: Widget Text
drawHeadPartiesSection = case ConnectedState
connState of
    ConnectedState
Disconnected -> Widget Text
forall n. Widget n
emptyWidget
    Connected Connection
c -> case Connection
c Connection -> Getting HeadState Connection HeadState -> HeadState
forall s a. s -> Getting a s a -> a
^. Getting HeadState Connection HeadState
Lens' Connection HeadState
headStateL 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
"none"
      Active (ActiveLink{[Party]
parties :: [Party]
$sel:parties:ActiveLink :: ActiveLink -> [Party]
parties}) ->
        case Connection
c Connection
-> Getting IdentifiedState Connection IdentifiedState
-> IdentifiedState
forall s a. s -> Getting a s a -> a
^. Getting IdentifiedState Connection IdentifiedState
Lens' Connection IdentifiedState
meL of
          IdentifiedState
Unidentified -> [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
$ (Party -> Widget Text) -> [Party] -> [Widget Text]
forall a b. (a -> b) -> [a] -> [b]
map (AttrName -> Party -> Widget Text
forall n. AttrName -> Party -> Widget n
drawParty AttrName
forall a. Monoid a => a
mempty) [Party]
parties
          Identified Party
ownParty -> Party -> [Party] -> Widget Text
forall n. Party -> [Party] -> Widget n
drawPartiesWithOwnHighlighted Party
ownParty [Party]
parties

  drawHeadStateSection :: Widget Name
  drawHeadStateSection :: Widget Text
drawHeadStateSection = case ConnectedState
connState 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
c -> case Connection
c Connection -> Getting HeadState Connection HeadState -> HeadState
forall s a. s -> Getting a s a -> a
^. Getting HeadState Connection HeadState
Lens' Connection HeadState
headStateL 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, [PendingIncrement]
pendingIncrements :: [PendingIncrement]
$sel:pendingIncrements:ActiveLink :: ActiveLink -> [PendingIncrement]
pendingIncrements, UTxO
pendingUTxOToDecommit :: UTxO
$sel:pendingUTxOToDecommit:ActiveLink :: ActiveLink -> UTxO
pendingUTxOToDecommit, ActiveHeadState
$sel:activeHeadState:ActiveLink :: ActiveLink -> ActiveHeadState
activeHeadState :: ActiveHeadState
activeHeadState}) ->
        case ActiveHeadState
activeHeadState of
          Open{} ->
            [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
utxoBlock UTxO
utxo
              ]
                [Widget Text] -> [Widget Text] -> [Widget Text]
forall a. Semigroup a => a -> a -> a
<> [ AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
infoA (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 -> Widget Text) -> Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ Text
"  ↑ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show ([PendingIncrement] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PendingIncrement]
pendingIncrements) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" pending commit(s)"
                   | Bool -> Bool
not ([PendingIncrement] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PendingIncrement]
pendingIncrements)
                   ]
                [Widget Text] -> [Widget Text] -> [Widget Text]
forall a. Semigroup a => a -> a -> a
<> [ AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
infoA (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
"  ↓ pending decommit"
                   | UTxO
pendingUTxOToDecommit UTxO -> UTxO -> Bool
forall a. Eq a => a -> a -> Bool
/= UTxO
forall a. Monoid a => a
mempty
                   ]
          Closed (ClosedState{UTCTime
contestationDeadline :: UTCTime
$sel:contestationDeadline:ClosedState :: ClosedState -> UTCTime
contestationDeadline}) ->
            [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
              [ UTCTime -> UTCTime -> Widget Text
forall n. UTCTime -> UTCTime -> Widget n
drawRemainingContestationPeriod UTCTime
contestationDeadline (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)
              , UTxO -> Widget Text
utxoBlock UTxO
utxo
              ]
          ActiveHeadState
FanoutPossible ->
            [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
              [ Widget Text
forall n. Widget n
drawFanoutPossibleMessage
              , UTxO -> Widget Text
utxoBlock UTxO
utxo
              ]
          FanningOut{UTxO
fanoutRemaining :: UTxO
$sel:fanoutRemaining:Open :: ActiveHeadState -> UTxO
fanoutRemaining, FanoutProgressMode
fanoutMode :: FanoutProgressMode
$sel:fanoutMode:Open :: ActiveHeadState -> FanoutProgressMode
fanoutMode} ->
            [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
              [ FanoutProgressMode -> UTxO -> Widget Text
forall n. FanoutProgressMode -> UTxO -> Widget n
drawFanningOutMessage FanoutProgressMode
fanoutMode UTxO
fanoutRemaining
              , UTxO -> Widget Text
utxoBlock UTxO
fanoutRemaining
              ]
          ActiveHeadState
Final ->
            [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
              [ UTxO -> Widget Text
forall n. UTxO -> Widget n
drawHeadFinalizedMessage UTxO
utxo
              , UTxO -> Widget Text
utxoBlock UTxO
utxo
              ]

  utxoBlock :: UTxO -> Widget Name
  utxoBlock :: UTxO -> Widget Text
utxoBlock UTxO
utxo =
    [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
"UTxO (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (Map TxIn (TxOut CtxUTxO Era) -> Int
forall k a. Map k a -> Int
Map.size (UTxO -> Map TxIn (TxOut CtxUTxO Era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
UTxO.toMap UTxO
utxo)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
      , 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
mainUTxOViewportName (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$
            (AddressInEra Era -> Widget Text) -> UTxO -> Widget Text
forall n. (AddressInEra Era -> Widget n) -> UTxO -> Widget n
drawUTxO (AddressInEra Era -> AddressInEra Era -> Widget Text
forall n. AddressInEra Era -> AddressInEra Era -> Widget n
highlightOwnAddress AddressInEra Era
ownAddress) UTxO
utxo
      ]

-- | Render the API-connection status line ("Connected" / "Connecting to …").
drawConnectedStatus :: RootState -> Widget n
drawConnectedStatus :: forall n. RootState -> Widget n
drawConnectedStatus RootState{Host
nodeHost :: Host
$sel:nodeHost:RootState :: RootState -> Host
nodeHost, ConnectedState
connectedState :: ConnectedState
$sel:connectedState:RootState :: RootState -> ConnectedState
connectedState} =
  Text -> Widget n
forall n. Text -> Widget n
txt Text
"API: " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> case ConnectedState
connectedState of
    ConnectedState
Disconnected -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
negative (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String
"Connecting to " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Host -> String
forall b a. (Show a, IsString b) => a -> b
show Host
nodeHost
    Connected Connection
_ -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
positive (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"Connected"

-- | Render the Hydra-network status line.
drawNetworkState :: ConnectedState -> Widget n
drawNetworkState :: forall n. ConnectedState -> Widget n
drawNetworkState ConnectedState
s =
  Text -> Widget n
forall n. Text -> Widget n
txt Text
"Network: " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> case ConnectedState
s of
    Disconnected{} -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
negative (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"Unknown"
    Connected{$sel:connection:Disconnected :: ConnectedState -> Connection
connection = Connection{Maybe NetworkState
networkState :: Maybe NetworkState
$sel:networkState:Connection :: Connection -> Maybe NetworkState
networkState}} ->
      case Maybe NetworkState
networkState of
        Maybe NetworkState
Nothing -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
negative (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"Unknown"
        Just NetworkState
NetworkConnected -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
positive (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"Connected"
        Just NetworkState
NetworkDisconnected -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
negative (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"Disconnected"

-- | Render the chain-sync status line ("In sync" / "Catching up").
drawChainSyncedState :: ConnectedState -> Widget n
drawChainSyncedState :: forall n. ConnectedState -> Widget n
drawChainSyncedState ConnectedState
s =
  Text -> Widget n
forall n. Text -> Widget n
txt Text
"Chain: " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> case ConnectedState
s of
    Disconnected{} -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
negative (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"Unknown"
    Connected{$sel:connection:Disconnected :: ConnectedState -> Connection
connection = Connection{ChainSyncedStatus
chainSyncedStatus :: ChainSyncedStatus
$sel:chainSyncedStatus:Connection :: Connection -> ChainSyncedStatus
chainSyncedStatus}} ->
      case ChainSyncedStatus
chainSyncedStatus of
        ChainSyncedStatus
InSync -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
positive (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"In sync"
        ChainSyncedStatus
CatchingUp -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
negative (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"Catching up"

-- | Render the peer list with per-peer connection state.
drawPeers :: ConnectedState -> [(Host, PeerStatus)] -> Widget n
drawPeers :: forall n. ConnectedState -> [(Host, PeerStatus)] -> Widget n
drawPeers ConnectedState
s [(Host, PeerStatus)]
peers = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox [Widget n]
rest
 where
  rest :: [Widget n]
rest = case ConnectedState
s of
    Connected{$sel:connection:Disconnected :: ConnectedState -> Connection
connection = Connection{$sel:networkState:Connection :: Connection -> Maybe NetworkState
networkState = Just NetworkState
NetworkConnected}} ->
      if [(Host, PeerStatus)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Host, PeerStatus)]
peers
        then [AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"none"]
        else ((Host, PeerStatus) -> Widget n)
-> [(Host, PeerStatus)] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map (Host, PeerStatus) -> Widget n
forall n. (Host, PeerStatus) -> Widget n
drawPeer [(Host, PeerStatus)]
peers
    ConnectedState
_ -> [AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
neutral (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"unknown"]

  drawPeer :: (Host, PeerStatus) -> Widget n
  drawPeer :: forall n. (Host, PeerStatus) -> Widget n
drawPeer (Host
host, PeerStatus
status) =
    AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (PeerStatus -> AttrName
statusAttr PeerStatus
status) (Text -> Widget n
forall n. Text -> Widget n
txt Text
"●") Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget n
forall n. Text -> Widget n
txt Text
" " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Host -> Widget n
forall a n. Show a => a -> Widget n
drawShow Host
host

  statusAttr :: PeerStatus -> AttrName
statusAttr = \case
    PeerStatus
PeerIsConnected -> AttrName
infoA
    PeerStatus
PeerIsDisconnected -> AttrName
negative
    PeerStatus
PeerIsUnknown -> AttrName
neutral

-- | Render a single 'Party' as its hex-encoded verification key with the given attribute.
drawParty :: AttrName -> Party -> Widget n
drawParty :: forall n. AttrName -> Party -> Widget n
drawParty AttrName
x Party{VerificationKey HydraKey
vkey :: VerificationKey HydraKey
$sel:vkey:Party :: Party -> VerificationKey HydraKey
vkey} = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
x (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ VerificationKey HydraKey -> Widget n
forall a n. SerialiseAsRawBytes a => a -> Widget n
drawHex VerificationKey HydraKey
vkey

-- | Vertically stack a list of parties using the given renderer.
drawParties :: (Party -> Widget n) -> [Party] -> Widget n
drawParties :: forall n. (Party -> Widget n) -> [Party] -> Widget n
drawParties Party -> Widget n
f [Party]
xs = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (Party -> Widget n) -> [Party] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map Party -> Widget n
f [Party]
xs

-- | Render parties with the local party highlighted.
drawPartiesWithOwnHighlighted :: Party -> [Party] -> Widget n
drawPartiesWithOwnHighlighted :: forall n. Party -> [Party] -> Widget n
drawPartiesWithOwnHighlighted Party
k = (Party -> Widget n) -> [Party] -> Widget n
forall n. (Party -> Widget n) -> [Party] -> Widget n
drawParties (\Party
p -> AttrName -> Party -> Widget n
forall n. AttrName -> Party -> Widget n
drawParty (if Party
k Party -> Party -> Bool
forall a. Eq a => a -> a -> Bool
== Party
p then AttrName
own else AttrName
forall a. Monoid a => a
mempty) Party
p)