{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Hydra.TUI.Drawing where

import Hydra.Prelude hiding (Down, State, padLeft)

import Brick
import Hydra.Cardano.Api hiding (Active)

import Brick.Forms (
  renderForm,
 )
import Brick.Widgets.Border (hBorder, vBorder)
import Brick.Widgets.Border.Style (ascii)
import Cardano.Api.UTxO qualified as UTxO
import Data.Map qualified as Map
import Data.Text (chunksOf)
import Data.Time (defaultTimeLocale, formatTime)
import Data.Time.Format (FormatTime)
import Data.Version (Version, showVersion)
import Hydra.Chain.CardanoClient (CardanoClient (..))
import Hydra.Chain.Direct.State ()
import Hydra.Client (Client (..))
import Hydra.Network (NodeId)
import Hydra.TUI.Drawing.Utils (drawHex, drawShow, ellipsize, maybeWidget)
import Hydra.TUI.Logging.Types (LogMessage (..), LogVerbosity (..), logMessagesL, logVerbosityL)
import Hydra.TUI.Model
import Hydra.TUI.Style
import Hydra.Tx (HeadId, IsTx (..), Party (..))
import Lens.Micro ((^.), (^?), _head)
import Paths_hydra_tui (version)

-- | Main draw function
draw :: CardanoClient -> Client Tx IO -> RootState -> [Widget Name]
draw :: CardanoClient -> Client Tx IO -> RootState -> [Widget Text]
draw CardanoClient
cardanoClient Client Tx IO
hydraClient RootState
s =
  case RootState
s RootState
-> Getting LogVerbosity RootState LogVerbosity -> LogVerbosity
forall s a. s -> Getting a s a -> a
^. (LogState -> Const LogVerbosity LogState)
-> RootState -> Const LogVerbosity RootState
Lens' RootState LogState
logStateL ((LogState -> Const LogVerbosity LogState)
 -> RootState -> Const LogVerbosity RootState)
-> ((LogVerbosity -> Const LogVerbosity LogVerbosity)
    -> LogState -> Const LogVerbosity LogState)
-> Getting LogVerbosity RootState LogVerbosity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogVerbosity -> Const LogVerbosity LogVerbosity)
-> LogState -> Const LogVerbosity LogState
Lens' LogState LogVerbosity
logVerbosityL of
    LogVerbosity
Full -> RootState -> [Widget Text]
drawScreenFullLog RootState
s
    LogVerbosity
Short -> CardanoClient -> Client Tx IO -> RootState -> [Widget Text]
drawScreenShortLog CardanoClient
cardanoClient Client Tx IO
hydraClient RootState
s

drawScreenShortLog :: CardanoClient -> Client Tx IO -> RootState -> [Widget Name]
drawScreenShortLog :: CardanoClient -> Client Tx IO -> RootState -> [Widget Text]
drawScreenShortLog CardanoClient{NetworkId
networkId :: NetworkId
$sel:networkId:CardanoClient :: CardanoClient -> NetworkId
networkId} Client{SigningKey PaymentKey
sk :: SigningKey PaymentKey
sk :: forall tx (m :: * -> *). Client tx m -> SigningKey PaymentKey
sk} RootState
s =
  Widget Text -> [Widget Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Widget Text -> [Widget Text]) -> Widget Text -> [Widget Text]
forall a b. (a -> b) -> a -> b
$
    BorderStyle -> Widget Text -> Widget Text
forall n. BorderStyle -> Widget n -> Widget n
withBorderStyle BorderStyle
ascii (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
joinBorders (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
hBox
              [ 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
$
                  Int -> Widget Text -> Widget Text
forall n. Int -> Widget n -> Widget n
hLimit Int
40 (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
                      [ Version -> Widget Text
forall n. Version -> Widget n
drawTUIVersion Version
version Widget Text -> Widget Text -> Widget Text
forall n. Widget n -> Widget n -> Widget n
<+> Padding -> Widget Text -> Widget Text
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) (RootState -> Widget Text
forall n. RootState -> Widget n
drawConnectedStatus RootState
s)
                      , ConnectedState -> Widget Text
forall n. ConnectedState -> Widget n
drawPeersIfConnected (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)
                      , Widget Text
forall n. Widget n
hBorder
                      , (Connection -> Widget Text) -> ConnectedState -> Widget Text
forall n. (Connection -> Widget n) -> ConnectedState -> Widget n
drawIfConnected (IdentifiedState -> Widget Text
forall n. IdentifiedState -> Widget n
drawMeIfIdentified (IdentifiedState -> Widget Text)
-> (Connection -> IdentifiedState) -> Connection -> Widget Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> IdentifiedState
me) (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)
                      , AddressInEra -> Widget Text
forall n. AddressInEra -> Widget n
drawMyAddress (AddressInEra -> Widget Text) -> AddressInEra -> Widget Text
forall a b. (a -> b) -> a -> b
$ NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId (SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
sk)
                      , (Connection -> Widget Text) -> ConnectedState -> Widget Text
forall n. (Connection -> Widget n) -> ConnectedState -> Widget n
drawIfConnected (\Connection
connection -> (ActiveLink -> Widget Text) -> HeadState -> Widget Text
forall n. (ActiveLink -> Widget n) -> HeadState -> Widget n
drawIfActive (IdentifiedState -> [Party] -> Widget Text
forall n. IdentifiedState -> [Party] -> Widget n
drawHeadParticipants (Connection -> IdentifiedState
me Connection
connection) ([Party] -> Widget Text)
-> (ActiveLink -> [Party]) -> ActiveLink -> Widget Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActiveLink -> [Party]
parties) (Connection -> HeadState
headState Connection
connection)) (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)
                      ]
              , Widget Text
forall n. Widget n
vBorder
              , 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
vBox
                    [ ConnectedState -> Widget Text
forall n. ConnectedState -> Widget n
drawHeadState (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)
                    , Widget Text
forall n. Widget n
hBorder
                    , 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 -> Widget Text
forall n. Widget n
emptyWidget
                        Connected Connection
k -> NetworkId
-> VerificationKey PaymentKey
-> UTCTime
-> Connection
-> Widget Text
drawFocusPanel NetworkId
networkId (SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
sk) (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
                    ]
              , Widget Text
forall n. Widget n
vBorder
              , Int -> Widget Text -> Widget Text
forall n. Int -> Widget n -> Widget n
hLimit Int
20 (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
joinBorders (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ RootState -> Widget Text
forall n. RootState -> Widget n
drawCommandPanel RootState
s
              ]
          , Widget Text
forall n. Widget n
hBorder
          , Int -> Widget Text -> Widget Text
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$
              Text -> ViewportType -> Widget Text -> Widget Text
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Text
shortFeedbackViewportName ViewportType
Horizontal (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$
                (LogMessage -> Widget Text) -> Maybe LogMessage -> Widget Text
forall a n. (a -> Widget n) -> Maybe a -> Widget n
maybeWidget LogMessage -> Widget Text
forall n. LogMessage -> Widget n
drawUserFeedbackShort (RootState
s RootState
-> Getting (First LogMessage) RootState LogMessage
-> Maybe LogMessage
forall s a. s -> Getting (First a) s a -> Maybe a
^? (LogState -> Const (First LogMessage) LogState)
-> RootState -> Const (First LogMessage) RootState
Lens' RootState LogState
logStateL ((LogState -> Const (First LogMessage) LogState)
 -> RootState -> Const (First LogMessage) RootState)
-> ((LogMessage -> Const (First LogMessage) LogMessage)
    -> LogState -> Const (First LogMessage) LogState)
-> Getting (First LogMessage) RootState LogMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([LogMessage] -> Const (First LogMessage) [LogMessage])
-> LogState -> Const (First LogMessage) LogState
Lens' LogState [LogMessage]
logMessagesL (([LogMessage] -> Const (First LogMessage) [LogMessage])
 -> LogState -> Const (First LogMessage) LogState)
-> ((LogMessage -> Const (First LogMessage) LogMessage)
    -> [LogMessage] -> Const (First LogMessage) [LogMessage])
-> (LogMessage -> Const (First LogMessage) LogMessage)
-> LogState
-> Const (First LogMessage) LogState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMessage -> Const (First LogMessage) LogMessage)
-> [LogMessage] -> Const (First LogMessage) [LogMessage]
forall s a. Cons s s a a => Traversal' s a
Traversal' [LogMessage] LogMessage
_head)
          ]

drawCommandPanel :: RootState -> Widget n
drawCommandPanel :: forall n. RootState -> Widget n
drawCommandPanel RootState
s =
  RootState -> Widget n
forall n. RootState -> Widget n
drawCommandList RootState
s
    Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
maybeDrawLogCommandList
 where
  maybeDrawLogCommandList :: Widget n
maybeDrawLogCommandList
    | Bool -> Bool
not (RootState -> Bool
isModalOpen RootState
s) =
        [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox
          [ Widget n
forall n. Widget n
hBorder
          , LogVerbosity -> Widget n
forall n. LogVerbosity -> Widget n
drawLogCommandList (RootState
s RootState
-> Getting LogVerbosity RootState LogVerbosity -> LogVerbosity
forall s a. s -> Getting a s a -> a
^. (LogState -> Const LogVerbosity LogState)
-> RootState -> Const LogVerbosity RootState
Lens' RootState LogState
logStateL ((LogState -> Const LogVerbosity LogState)
 -> RootState -> Const LogVerbosity RootState)
-> ((LogVerbosity -> Const LogVerbosity LogVerbosity)
    -> LogState -> Const LogVerbosity LogState)
-> Getting LogVerbosity RootState LogVerbosity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogVerbosity -> Const LogVerbosity LogVerbosity)
-> LogState -> Const LogVerbosity LogState
Lens' LogState LogVerbosity
logVerbosityL)
          ]
    | Bool
otherwise = Widget n
forall n. Widget n
emptyWidget

drawScreenFullLog :: RootState -> [Widget Name]
drawScreenFullLog :: RootState -> [Widget Text]
drawScreenFullLog RootState
s =
  Widget Text -> [Widget Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Widget Text -> [Widget Text]) -> Widget Text -> [Widget Text]
forall a b. (a -> b) -> a -> b
$
    BorderStyle -> Widget Text -> Widget Text
forall n. BorderStyle -> Widget n -> Widget n
withBorderStyle BorderStyle
ascii (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
joinBorders (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
vBox
              [ ConnectedState -> Widget Text
forall n. ConnectedState -> Widget n
drawHeadState (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)
              , Widget Text
forall n. Widget n
hBorder
              , Text -> ViewportType -> Widget Text -> Widget Text
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Text
fullFeedbackViewportName ViewportType
Vertical (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ [LogMessage] -> Widget Text
forall n. [LogMessage] -> Widget n
drawUserFeedbackFull (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)
              ]
          , Widget Text
forall n. Widget n
vBorder
          , Int -> Widget Text -> Widget Text
forall n. Int -> Widget n -> Widget n
hLimit Int
20 (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
joinBorders (Widget Text -> Widget Text) -> Widget Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ RootState -> Widget Text
forall n. RootState -> Widget n
drawCommandPanel RootState
s
          ]

drawCommandList :: RootState -> Widget n
drawCommandList :: forall n. RootState -> Widget n
drawCommandList RootState
s = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n)
-> ([Text] -> [Widget n]) -> [Text] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Widget n) -> [Text] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Widget n
forall n. Text -> Widget n
txt ([Text] -> Widget n) -> [Text] -> Widget n
forall a b. (a -> b) -> a -> b
$ 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 -> [Text
"[Q]uit"]
  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 -> [Text
"[I]nit", Text
"[Q]uit"]
    Active (ActiveLink{ActiveHeadState
activeHeadState :: ActiveHeadState
$sel:activeHeadState:ActiveLink :: ActiveLink -> ActiveHeadState
activeHeadState}) -> case ActiveHeadState
activeHeadState of
      Initializing{} -> [Text
"[C]ommit", Text
"[A]bort", Text
"[Q]uit"]
      Open{} -> [Text
"[N]ew Transaction", Text
"[D]ecommit", Text
"[I]ncrement", Text
"[C]lose", Text
"[Q]uit"]
      Closed{} -> [Text
"[Q]uit"]
      FanoutPossible{} -> [Text
"[F]anout", Text
"[Q]uit"]
      Final{} -> [Text
"[I]nit", Text
"[Q]uit"]

drawLogCommandList :: LogVerbosity -> Widget n
drawLogCommandList :: forall n. LogVerbosity -> Widget n
drawLogCommandList LogVerbosity
s = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n)
-> ([Text] -> [Widget n]) -> [Text] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Widget n) -> [Text] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Widget n
forall n. Text -> Widget n
txt ([Text] -> Widget n) -> [Text] -> Widget n
forall a b. (a -> b) -> a -> b
$ case LogVerbosity
s of
  LogVerbosity
Short ->
    [ Text
"[<] Scroll Left"
    , Text
"[>] Scroll Right"
    , Text
"Full [H]istory Mode"
    ]
  LogVerbosity
Full ->
    [ Text
"[<] Scroll Up"
    , Text
"[>] Scroll Down"
    , Text
"[S]hort History Mode"
    ]

drawFocusPanelInitializing :: IdentifiedState -> InitializingState -> Widget Name
drawFocusPanelInitializing :: IdentifiedState -> InitializingState -> Widget Text
drawFocusPanelInitializing IdentifiedState
me InitializingState{[Party]
remainingParties :: [Party]
$sel:remainingParties:InitializingState :: InitializingState -> [Party]
remainingParties, InitializingScreen
initializingScreen :: InitializingScreen
$sel:initializingScreen:InitializingState :: InitializingState -> InitializingScreen
initializingScreen} = case InitializingScreen
initializingScreen of
  InitializingScreen
InitializingHome -> IdentifiedState -> [Party] -> Widget Text
forall n. IdentifiedState -> [Party] -> Widget n
drawRemainingParties IdentifiedState
me [Party]
remainingParties
  CommitMenu UTxOCheckboxForm (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
"Select UTxOs to commit:", UTxOCheckboxForm (HydraEvent Tx) Text -> Widget Text
forall n s e. Eq n => Form s e n -> Widget n
renderForm UTxOCheckboxForm (HydraEvent Tx) Text
x]
  ConfirmingAbort 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 Abort action:", ConfirmingRadioFieldForm (HydraEvent Tx) Text -> Widget Text
forall n s e. Eq n => Form s e n -> Widget n
renderForm ConfirmingRadioFieldForm (HydraEvent Tx) Text
x]

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 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
vBox [Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Remaining time to deposit: ", 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 Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Deposit deadline passed, ready to recover."

drawPendingIncrement :: AddressInEra -> Maybe PendingIncrement -> UTCTime -> Widget Name
drawPendingIncrement :: AddressInEra -> Maybe PendingIncrement -> UTCTime -> Widget Text
drawPendingIncrement AddressInEra
ownAddress Maybe PendingIncrement
pendingIncrement UTCTime
now =
  case Maybe PendingIncrement
pendingIncrement of
    Maybe PendingIncrement
Nothing -> [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox []
    Just PendingDeposit{UTxO
utxoToCommit :: UTxO
$sel:utxoToCommit:PendingDeposit :: PendingIncrement -> UTxO
utxoToCommit, TxId
deposit :: TxId
$sel:deposit:PendingDeposit :: PendingIncrement -> TxId
deposit, UTCTime
depositDeadline :: UTCTime
$sel:depositDeadline:PendingDeposit :: PendingIncrement -> UTCTime
depositDeadline} ->
      [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
        [ (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
        , Padding -> Widget Text -> Widget Text
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad 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
"Pending deposit: "
        , Text -> Widget Text
forall n. Text -> Widget n
txt (Text -> Widget Text) -> Text -> Widget Text
forall a b. (a -> b) -> a -> b
$ TxId -> Text
forall b a. (Show a, IsString b) => a -> b
show TxId
deposit
        , Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Pending deposit deadline: "
        , UTCTime -> UTCTime -> Widget Text
drawRemainingDepositDeadline UTCTime
depositDeadline UTCTime
now
        ]
    Just PendingIncrement{UTxO
$sel:utxoToCommit:PendingDeposit :: PendingIncrement -> UTxO
utxoToCommit :: UTxO
utxoToCommit} ->
      [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
        [ (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
        , Padding -> Widget Text -> Widget Text
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad 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 Pending deposit"
        ]

drawFocusPanelOpen :: NetworkId -> VerificationKey PaymentKey -> UTxO -> UTxO -> Maybe PendingIncrement -> UTCTime -> OpenScreen -> Widget Name
drawFocusPanelOpen :: NetworkId
-> VerificationKey PaymentKey
-> UTxO
-> UTxO
-> Maybe PendingIncrement
-> UTCTime
-> OpenScreen
-> Widget Text
drawFocusPanelOpen NetworkId
networkId VerificationKey PaymentKey
vk UTxO
utxo UTxO
pendingUTxOToDecommit Maybe PendingIncrement
pendingIncrement UTCTime
now = \case
  OpenScreen
OpenHome ->
    [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
      [ [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
          [ 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
      , [Widget Text] -> Widget Text
forall n. [Widget n] -> Widget n
vBox
          [ Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Pending UTxO to 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
      , Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Pending UTxO to commit: "
      , AddressInEra -> Maybe PendingIncrement -> UTCTime -> Widget Text
drawPendingIncrement AddressInEra
ownAddress Maybe PendingIncrement
pendingIncrement UTCTime
now
      ]
  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 Integer (HydraEvent Tx) Text
x -> Form Integer (HydraEvent Tx) Text -> Widget Text
forall n s e. Eq n => Form s e n -> Widget n
renderForm Form Integer (HydraEvent Tx) Text
x
  SelectingRecipient (TxIn, TxOut CtxUTxO)
_ Integer
_ 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)
_ Integer
_ 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 action:", 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

drawFocusPanelClosed :: UTCTime -> ClosedState -> Widget Name
drawFocusPanelClosed :: UTCTime -> ClosedState -> Widget Text
drawFocusPanelClosed UTCTime
now (ClosedState{UTCTime
contestationDeadline :: UTCTime
$sel:contestationDeadline:ClosedState :: ClosedState -> UTCTime
contestationDeadline}) = UTCTime -> UTCTime -> Widget Text
drawRemainingContestationPeriod UTCTime
contestationDeadline UTCTime
now

drawFocusPanelFinal :: NetworkId -> VerificationKey PaymentKey -> UTxO -> Widget Name
drawFocusPanelFinal :: NetworkId -> VerificationKey PaymentKey -> UTxO -> Widget Text
drawFocusPanelFinal NetworkId
networkId VerificationKey PaymentKey
vk UTxO
utxo =
  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 -> Widget Text
forall n. Text -> Widget n
txt (Text
"Distributed UTXO, total: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
renderValue (forall tx. IsTx tx => UTxOType tx -> ValueType tx
balance @Tx UTxO
UTxOType Tx
utxo))
      Widget Text -> Widget Text -> Widget Text
forall n. Widget n -> Widget n -> Widget n
<=> 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)
 where
  ownAddress :: AddressInEra
ownAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk

highlightOwnAddress :: AddressInEra -> AddressInEra -> Widget n
highlightOwnAddress :: forall n. AddressInEra -> AddressInEra -> Widget n
highlightOwnAddress AddressInEra
ownAddress AddressInEra
a =
  AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (if AddressInEra
a AddressInEra -> AddressInEra -> Bool
forall a. Eq a => a -> a -> Bool
== AddressInEra
ownAddress then AttrName
own else AttrName
forall a. Monoid a => a
mempty) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ AddressInEra -> Widget n
forall n. AddressInEra -> Widget n
drawAddress AddressInEra
a

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{IdentifiedState
$sel:me:Connection :: Connection -> IdentifiedState
me :: IdentifiedState
me, HeadState
$sel:headState:Connection :: Connection -> HeadState
headState :: HeadState
headState}) = case HeadState
headState of
  HeadState
Idle -> Widget Text
forall n. Widget n
emptyWidget
  Active (ActiveLink{UTxO
utxo :: UTxO
$sel:utxo:ActiveLink :: ActiveLink -> UTxO
utxo, UTxO
pendingUTxOToDecommit :: UTxO
$sel:pendingUTxOToDecommit:ActiveLink :: ActiveLink -> UTxO
pendingUTxOToDecommit, Maybe PendingIncrement
pendingIncrement :: Maybe PendingIncrement
$sel:pendingIncrement:ActiveLink :: ActiveLink -> Maybe PendingIncrement
pendingIncrement, ActiveHeadState
$sel:activeHeadState:ActiveLink :: ActiveLink -> ActiveHeadState
activeHeadState :: ActiveHeadState
activeHeadState}) -> case ActiveHeadState
activeHeadState of
    Initializing InitializingState
x -> IdentifiedState -> InitializingState -> Widget Text
drawFocusPanelInitializing IdentifiedState
me InitializingState
x
    Open OpenScreen
x -> NetworkId
-> VerificationKey PaymentKey
-> UTxO
-> UTxO
-> Maybe PendingIncrement
-> UTCTime
-> OpenScreen
-> Widget Text
drawFocusPanelOpen NetworkId
networkId VerificationKey PaymentKey
vk UTxO
utxo UTxO
pendingUTxOToDecommit Maybe PendingIncrement
pendingIncrement UTCTime
now OpenScreen
x
    Closed ClosedState
x -> UTCTime -> ClosedState -> Widget Text
drawFocusPanelClosed UTCTime
now ClosedState
x
    ActiveHeadState
FanoutPossible -> Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Ready to fanout!"
    ActiveHeadState
Final -> NetworkId -> VerificationKey PaymentKey -> UTxO -> Widget Text
drawFocusPanelFinal NetworkId
networkId VerificationKey PaymentKey
vk UTxO
utxo

drawRemainingContestationPeriod :: UTCTime -> UTCTime -> Widget Name
drawRemainingContestationPeriod :: UTCTime -> UTCTime -> Widget Text
drawRemainingContestationPeriod 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 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
vBox [Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Remaining time to contest: ", 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 Text -> Widget Text
forall n. Text -> Widget n
txt Text
"Contestation period passed, ready to fan out soon."

drawRemainingParties :: IdentifiedState -> [Party] -> Widget n
drawRemainingParties :: forall n. IdentifiedState -> [Party] -> Widget n
drawRemainingParties IdentifiedState
k [Party]
xs =
  String -> Widget n
forall n. String -> Widget n
str String
"Waiting for parties to commit:"
    Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> ( case IdentifiedState
k of
            IdentifiedState
Unidentified -> Widget n
forall n. Widget n
emptyWidget
            Identified Party
p -> Party -> [Party] -> Widget n
forall n. Party -> [Party] -> Widget n
drawPartiesWithOwnHighlighted Party
p [Party]
xs
        )

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)

drawUserFeedbackFull :: [LogMessage] -> Widget n
drawUserFeedbackFull :: forall n. [LogMessage] -> Widget n
drawUserFeedbackFull = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n)
-> ([LogMessage] -> [Widget n]) -> [LogMessage] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMessage -> Widget n) -> [LogMessage] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LogMessage -> Widget n
forall n. LogMessage -> Widget n
f
 where
  f :: LogMessage -> Widget n
  f :: forall n. LogMessage -> Widget n
f (LogMessage{Text
message :: Text
message :: LogMessage -> Text
message, Severity
severity :: Severity
severity :: LogMessage -> Severity
severity, UTCTime
time :: UTCTime
time :: LogMessage -> UTCTime
time}) =
    let feedbackText :: Text
feedbackText = UTCTime -> Text
forall b a. (Show a, IsString b) => a -> b
show UTCTime
time Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
message
        feedbackChunks :: [Text]
feedbackChunks = Int -> Text -> [Text]
chunksOf Int
150 Text
feedbackText
        feedbackDecorator :: Text -> Widget n
feedbackDecorator = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (Severity -> AttrName
severityToAttr Severity
severity) (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txtWrap
     in [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
$ (Text -> Widget n) -> [Text] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Widget n
feedbackDecorator [Text]
feedbackChunks

drawUserFeedbackShort :: LogMessage -> Widget n
drawUserFeedbackShort :: forall n. LogMessage -> Widget n
drawUserFeedbackShort (LogMessage{Text
message :: LogMessage -> Text
message :: Text
message, Severity
severity :: LogMessage -> Severity
severity :: Severity
severity, UTCTime
time :: LogMessage -> UTCTime
time :: UTCTime
time}) =
  AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (Severity -> AttrName
severityToAttr Severity
severity) (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> (Text -> String) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ (UTCTime -> Text
forall b a. (Show a, IsString b) => a -> b
show UTCTime
time Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
message)

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

drawHeadParticipants :: IdentifiedState -> [Party] -> Widget n
drawHeadParticipants :: forall n. IdentifiedState -> [Party] -> Widget n
drawHeadParticipants IdentifiedState
k [Party]
xs =
  String -> Widget n
forall n. String -> Widget n
str String
"Head participants:"
    Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> ( case IdentifiedState
k of
            IdentifiedState
Unidentified -> (Party -> Widget n) -> [Party] -> Widget n
forall n. (Party -> Widget n) -> [Party] -> Widget n
drawParties (AttrName -> Party -> Widget n
forall n. AttrName -> Party -> Widget n
drawParty AttrName
forall a. Monoid a => a
mempty) [Party]
xs
            Identified Party
p -> Party -> [Party] -> Widget n
forall n. Party -> [Party] -> Widget n
drawPartiesWithOwnHighlighted Party
p [Party]
xs
        )

drawIfConnected :: (Connection -> Widget n) -> ConnectedState -> Widget n
drawIfConnected :: forall n. (Connection -> Widget n) -> ConnectedState -> Widget n
drawIfConnected Connection -> Widget n
f = \case
  Disconnected{} -> Widget n
forall n. Widget n
emptyWidget
  Connected Connection
c -> Connection -> Widget n
f Connection
c

drawIfActive :: (ActiveLink -> Widget n) -> HeadState -> Widget n
drawIfActive :: forall n. (ActiveLink -> Widget n) -> HeadState -> Widget n
drawIfActive ActiveLink -> Widget n
f = \case
  HeadState
Idle -> Widget n
forall n. Widget n
emptyWidget
  Active ActiveLink
x -> ActiveLink -> Widget n
f ActiveLink
x

drawPeersIfConnected :: ConnectedState -> Widget n
drawPeersIfConnected :: forall n. ConnectedState -> Widget n
drawPeersIfConnected = (Connection -> Widget n) -> ConnectedState -> Widget n
forall n. (Connection -> Widget n) -> ConnectedState -> Widget n
drawIfConnected ([NodeId] -> Widget n
forall n. [NodeId] -> Widget n
drawPeers ([NodeId] -> Widget n)
-> (Connection -> [NodeId]) -> Connection -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> [NodeId]
peers)

drawHeadId :: HeadId -> Widget n
drawHeadId :: forall n. HeadId -> Widget n
drawHeadId HeadId
x = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text
"Head id: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HeadId -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText HeadId
x

drawMyAddress :: AddressInEra -> Widget n
drawMyAddress :: forall n. AddressInEra -> Widget n
drawMyAddress AddressInEra
addr = String -> Widget n
forall n. String -> Widget n
str String
"Address " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
own (AddressInEra -> Widget n
forall n. AddressInEra -> Widget n
drawAddress AddressInEra
addr)

drawAddress :: AddressInEra -> Widget n
drawAddress :: forall n. AddressInEra -> Widget n
drawAddress AddressInEra
addr = Text -> Widget n
forall n. Text -> Widget n
txt (Int -> Text -> Text
ellipsize Int
40 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ AddressInEra -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress AddressInEra
addr)

drawMeIfIdentified :: IdentifiedState -> Widget n
drawMeIfIdentified :: forall n. IdentifiedState -> Widget n
drawMeIfIdentified (Identified Party{VerificationKey HydraKey
vkey :: VerificationKey HydraKey
$sel:vkey:Party :: Party -> VerificationKey HydraKey
vkey}) = String -> Widget n
forall n. String -> Widget n
str String
"Party " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
own (Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ VerificationKey HydraKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText VerificationKey HydraKey
vkey)
drawMeIfIdentified IdentifiedState
Unidentified = Widget n
forall n. Widget n
emptyWidget

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} = 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
$ String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String
"connected 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

drawParty :: AttrName -> Party -> Widget n
drawParty :: forall n. AttrName -> Party -> Widget n
drawParty AttrName
x Party{VerificationKey HydraKey
$sel:vkey:Party :: Party -> VerificationKey HydraKey
vkey :: 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

drawPeers :: [NodeId] -> Widget n
drawPeers :: forall n. [NodeId] -> Widget n
drawPeers [NodeId]
peers = [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
$ String -> Widget n
forall n. String -> Widget n
str String
"Peers connected to our node:" Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
: (NodeId -> Widget n) -> [NodeId] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map NodeId -> Widget n
forall a n. Show a => a -> Widget n
drawShow [NodeId]
peers

drawTUIVersion :: Version -> Widget n
drawTUIVersion :: forall n. Version -> Widget n
drawTUIVersion Version
v = String -> Widget n
forall n. String -> Widget n
str String
"Hydra TUI " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget n
forall n. String -> Widget n
str (Version -> String
showVersion Version
v)

renderTime :: (Ord t, Num t, FormatTime t) => t -> String
renderTime :: forall t. (Ord t, Num t, FormatTime t) => t -> String
renderTime t
r
  | t
r t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0 = String
"-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> t -> String
forall t. (Ord t, Num t, FormatTime t) => t -> String
renderTime (t -> t
forall a. Num a => a -> a
negate t
r)
  | Bool
otherwise = TimeLocale -> String -> t -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%dd %Hh %Mm %Ss" t
r

drawHeadState :: ConnectedState -> Widget n
drawHeadState :: forall n. ConnectedState -> Widget n
drawHeadState = \case
  Disconnected{} -> Widget n
forall n. Widget n
emptyWidget
  Connected (Connection{HeadState
$sel:headState:Connection :: Connection -> HeadState
headState :: HeadState
headState}) ->
    [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox
      [ Text -> Widget n
forall n. Text -> Widget n
txt Text
"Head status: "
          Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
infoA (String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ HeadState -> String
showHeadState HeadState
headState)
      , (ActiveLink -> Widget n) -> HeadState -> Widget n
forall n. (ActiveLink -> Widget n) -> HeadState -> Widget n
drawIfActive (HeadId -> Widget n
forall n. HeadId -> Widget n
drawHeadId (HeadId -> Widget n)
-> (ActiveLink -> HeadId) -> ActiveLink -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActiveLink -> HeadId
headId) HeadState
headState
      ]

showHeadState :: HeadState -> String
showHeadState :: HeadState -> String
showHeadState = \case
  HeadState
Idle -> String
"Idle"
  Active (ActiveLink{ActiveHeadState
$sel:activeHeadState:ActiveLink :: ActiveLink -> ActiveHeadState
activeHeadState :: ActiveHeadState
activeHeadState}) -> case ActiveHeadState
activeHeadState of
    Initializing{} -> String
"Initializing"
    Open{} -> String
"Open"
    FanoutPossible{} -> String
"FanoutPossible"
    Closed{} -> String
"Closed"
    Final{} -> String
"Final"

drawUTxO :: (AddressInEra -> Widget n) -> UTxO -> Widget n
drawUTxO :: forall n. (AddressInEra -> Widget n) -> UTxO -> Widget n
drawUTxO AddressInEra -> Widget n
f UTxO
utxo =
  let byAddress :: Map AddressInEra [(TxIn, TxOut CtxUTxO)]
byAddress =
        (TxIn
 -> TxOut CtxUTxO
 -> Map AddressInEra [(TxIn, TxOut CtxUTxO)]
 -> Map AddressInEra [(TxIn, TxOut CtxUTxO)])
-> Map AddressInEra [(TxIn, TxOut CtxUTxO)]
-> Map TxIn (TxOut CtxUTxO)
-> Map AddressInEra [(TxIn, TxOut CtxUTxO)]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
          (\TxIn
k v :: TxOut CtxUTxO
v@TxOut{txOutAddress :: forall ctx. TxOut ctx -> AddressInEra
txOutAddress = AddressInEra
addr} -> ([(TxIn, TxOut CtxUTxO)]
 -> [(TxIn, TxOut CtxUTxO)] -> [(TxIn, TxOut CtxUTxO)])
-> Map AddressInEra [(TxIn, TxOut CtxUTxO)]
-> Map AddressInEra [(TxIn, TxOut CtxUTxO)]
-> Map AddressInEra [(TxIn, TxOut CtxUTxO)]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [(TxIn, TxOut CtxUTxO)]
-> [(TxIn, TxOut CtxUTxO)] -> [(TxIn, TxOut CtxUTxO)]
forall a. [a] -> [a] -> [a]
(++) (AddressInEra
-> [(TxIn, TxOut CtxUTxO)]
-> Map AddressInEra [(TxIn, TxOut CtxUTxO)]
forall k a. k -> a -> Map k a
Map.singleton AddressInEra
addr [(TxIn
k, TxOut CtxUTxO
v)]))
          Map AddressInEra [(TxIn, TxOut CtxUTxO)]
forall a. Monoid a => a
mempty
          (Map TxIn (TxOut CtxUTxO)
 -> Map AddressInEra [(TxIn, TxOut CtxUTxO)])
-> Map TxIn (TxOut CtxUTxO)
-> Map AddressInEra [(TxIn, TxOut CtxUTxO)]
forall a b. (a -> b) -> a -> b
$ UTxO -> Map TxIn (TxOut CtxUTxO)
forall out. UTxO' out -> Map TxIn out
UTxO.toMap UTxO
utxo
   in [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox
        [ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
            [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox
              [ AddressInEra -> Widget n
f AddressInEra
addr
              , Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox (String -> Widget n
forall n. String -> Widget n
str (String -> Widget n)
-> ((TxIn, TxOut CtxUTxO) -> String)
-> (TxIn, TxOut CtxUTxO)
-> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString (Text -> String)
-> ((TxIn, TxOut CtxUTxO) -> Text)
-> (TxIn, TxOut CtxUTxO)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, TxOut CtxUTxO) -> Text
forall ctx era. (TxIn, TxOut ctx era) -> Text
UTxO.render ((TxIn, TxOut CtxUTxO) -> Widget n)
-> [(TxIn, TxOut CtxUTxO)] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxIn, TxOut CtxUTxO)]
u)
              ]
        | (AddressInEra
addr, [(TxIn, TxOut CtxUTxO)]
u) <- Map AddressInEra [(TxIn, TxOut CtxUTxO)]
-> [(AddressInEra, [(TxIn, TxOut CtxUTxO)])]
forall k a. Map k a -> [(k, a)]
Map.toList Map AddressInEra [(TxIn, TxOut CtxUTxO)]
byAddress
        ]