{-# LANGUAGE DuplicateRecordFields #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unused-local-binds #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}

module Hydra.TUI.Handlers where

import Hydra.Prelude hiding (Down)

import Brick
import Brick.BChan (BChan, writeBChan)
import Brick.Forms (Form (formState), allFieldsValid, editField, editShowableFieldWithValidate, handleFormEvent, newForm, updateFormState)
import Brick.Widgets.List qualified as BrickList
import Cardano.Api.UTxO qualified as UTxO
import Control.Concurrent (forkIO)
import Data.List (nub)
import Data.Map qualified as Map
import Data.Text qualified as T
import Data.Vector qualified as Vec
import Graphics.Vty (
  Event (EvKey),
  Key (..),
  Modifier (MCtrl),
 )
import Graphics.Vty qualified as Vty
import Hydra.API.ClientInput (ClientInput (..))
import Hydra.API.ServerOutput (ApiMessage (..), FanoutProgressMode (..), NetworkInfo (..), TimedServerOutput (..))
import Hydra.API.ServerOutput qualified as API
import Hydra.Cardano.Api hiding (Active, getVerificationKey)
import Hydra.Cardano.Api.Prelude ()
import Hydra.Chain.CardanoClient (CardanoClient (..))
import Hydra.Chain.Direct.State ()
import Hydra.Client (Client (..), HydraEvent (..))
import Hydra.Ledger.Cardano (mkSimpleTx)
import Hydra.Network (Host, readHost)
import Hydra.Node.Environment (Environment (..))
import Hydra.Node.State qualified as NodeState
import Hydra.TUI.Config (TuiConfig (..), toggleTheme, writeConfig)
import Hydra.TUI.Forms
import Hydra.TUI.Logging.Types (EventHistoryFilter (..), LogMessage (..), Severity (..), logMessagesL)
import Hydra.TUI.Model
import Hydra.TUI.RenderMessage (renderMessage, toLogMessage)
import Hydra.TUI.Style (own)
import Hydra.Tx (IsTx (..), Snapshot (..))
import Hydra.Tx.Crypto (getVerificationKey)
import Lens.Micro ((^.), (^?), _Just)
import Lens.Micro.Mtl (use, (%=), (.=))

handleEvent ::
  CardanoClient ->
  Client Tx IO ->
  BChan (TUIEvent Tx) ->
  BrickEvent Name (TUIEvent Tx) ->
  EventM Name RootState ()
handleEvent :: CardanoClient
-> Client Tx IO
-> BChan (TUIEvent Tx)
-> BrickEvent Text (TUIEvent Tx)
-> EventM Text RootState ()
handleEvent CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan = \case
  AppEvent (NodeEvent HydraEvent Tx
e) -> do
    HydraEvent Tx -> EventM Text RootState ()
handleTick HydraEvent Tx
e
    UTCTime
now <- Getting UTCTime RootState UTCTime -> EventM Text RootState UTCTime
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting UTCTime RootState UTCTime
Lens' RootState UTCTime
nowL
    LensLike'
  (Zoomed (EventM Text ConnectedState) ()) RootState ConnectedState
-> EventM Text ConnectedState () -> EventM Text RootState ()
forall c.
LensLike'
  (Zoomed (EventM Text ConnectedState) c) RootState ConnectedState
-> EventM Text ConnectedState c -> EventM Text RootState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (EventM Text ConnectedState) ()) RootState ConnectedState
(ConnectedState
 -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> RootState -> Focusing (StateT (EventState Text) IO) () RootState
Lens' RootState ConnectedState
connectedStateL (EventM Text ConnectedState () -> EventM Text RootState ())
-> EventM Text ConnectedState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ do
      HydraEvent Tx -> EventM Text ConnectedState ()
handleHydraEventsConnectedState HydraEvent Tx
e
      LensLike'
  (Zoomed (EventM Text Connection) ()) ConnectedState Connection
-> EventM Text Connection () -> EventM Text ConnectedState ()
forall c.
LensLike'
  (Zoomed (EventM Text Connection) c) ConnectedState Connection
-> EventM Text Connection c -> EventM Text ConnectedState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (EventM Text Connection) ()) ConnectedState Connection
(Connection
 -> Focusing (StateT (EventState Text) IO) () Connection)
-> ConnectedState
-> Focusing (StateT (EventState Text) IO) () ConnectedState
Traversal' ConnectedState Connection
connectionL (EventM Text Connection () -> EventM Text ConnectedState ())
-> EventM Text Connection () -> EventM Text ConnectedState ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> HydraEvent Tx -> EventM Text Connection ()
handleHydraEventsConnection UTCTime
now HydraEvent Tx
e
    Int
beforeLen <- [LogMessage] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([LogMessage] -> Int)
-> EventM Text RootState [LogMessage] -> EventM Text RootState Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting [LogMessage] RootState [LogMessage]
-> EventM Text RootState [LogMessage]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((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)
    LensLike'
  (Zoomed (EventM Text [LogMessage]) ()) RootState [LogMessage]
-> EventM Text [LogMessage] () -> EventM Text RootState ()
forall c.
LensLike'
  (Zoomed (EventM Text [LogMessage]) c) RootState [LogMessage]
-> EventM Text [LogMessage] c -> EventM Text RootState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((LogState -> Focusing (StateT (EventState Text) IO) () LogState)
-> RootState -> Focusing (StateT (EventState Text) IO) () RootState
Lens' RootState LogState
logStateL ((LogState -> Focusing (StateT (EventState Text) IO) () LogState)
 -> RootState
 -> Focusing (StateT (EventState Text) IO) () RootState)
-> (([LogMessage]
     -> Focusing (StateT (EventState Text) IO) () [LogMessage])
    -> LogState -> Focusing (StateT (EventState Text) IO) () LogState)
-> ([LogMessage]
    -> Focusing (StateT (EventState Text) IO) () [LogMessage])
-> RootState
-> Focusing (StateT (EventState Text) IO) () RootState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([LogMessage]
 -> Focusing (StateT (EventState Text) IO) () [LogMessage])
-> LogState -> Focusing (StateT (EventState Text) IO) () LogState
Lens' LogState [LogMessage]
logMessagesL) (EventM Text [LogMessage] () -> EventM Text RootState ())
-> EventM Text [LogMessage] () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$
      UTCTime -> HydraEvent Tx -> EventM Text [LogMessage] ()
handleHydraEventsLog UTCTime
now HydraEvent Tx
e
    Int
afterLen <- [LogMessage] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([LogMessage] -> Int)
-> EventM Text RootState [LogMessage] -> EventM Text RootState Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting [LogMessage] RootState [LogMessage]
-> EventM Text RootState [LogMessage]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((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)
    Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
afterLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
beforeLen) (EventM Text RootState () -> EventM Text RootState ())
-> EventM Text RootState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$
      (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Text
forall a. Maybe a
Nothing
    EventM Text RootState ()
syncEventHistoryList
    EventM Text RootState ()
refreshRecoveryForm
    EventM Text RootState ()
refreshFanoutForm
    case HydraEvent Tx
e of
      HydraEvent Tx
ClientConnected ->
        CardanoClient
-> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Text RootState ()
triggerL1Query CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan
      Update (ApiTimedServerOutput TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.HeadIsOpen{}}) ->
        CardanoClient
-> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Text RootState ()
triggerL1Query CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan
      Update (ApiTimedServerOutput TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.CommitRecorded{}}) ->
        CardanoClient
-> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Text RootState ()
triggerL1Query CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan
      Update (ApiTimedServerOutput TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.CommitFinalized{}}) ->
        CardanoClient
-> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Text RootState ()
triggerL1Query CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan
      Update (ApiTimedServerOutput TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.CommitRecovered{}}) ->
        CardanoClient
-> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Text RootState ()
triggerL1Query CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan
      Update (ApiTimedServerOutput TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.DecommitFinalized{}}) ->
        CardanoClient
-> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Text RootState ()
triggerL1Query CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan
      Update (ApiTimedServerOutput TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.HeadIsFinalized{}}) ->
        CardanoClient
-> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Text RootState ()
triggerL1Query CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan
      HydraEvent Tx
ClientDisconnected -> do
        (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
 -> Identity (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)))
-> RootState -> Identity RootState
Lens' RootState (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
recoveryFormL ((Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
  -> Identity (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)))
 -> RootState -> Identity RootState)
-> Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
forall a. Maybe a
Nothing
        (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
 -> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
-> RootState -> Identity RootState
Lens' RootState (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
fanoutSelectionFormL ((Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
  -> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
 -> RootState -> Identity RootState)
-> Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
forall a. Maybe a
Nothing
        (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Text
forall a. Maybe a
Nothing
        (Maybe (Map TxIn (TxOut CtxUTxO Era))
 -> Identity (Maybe (Map TxIn (TxOut CtxUTxO Era))))
-> RootState -> Identity RootState
Lens' RootState (Maybe (Map TxIn (TxOut CtxUTxO Era)))
l1UTxOL ((Maybe (Map TxIn (TxOut CtxUTxO Era))
  -> Identity (Maybe (Map TxIn (TxOut CtxUTxO Era))))
 -> RootState -> Identity RootState)
-> Maybe (Map TxIn (TxOut CtxUTxO Era)) -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Map TxIn (TxOut CtxUTxO Era))
forall a. Maybe a
Nothing
        (Maybe (Map TxIn (TxOut CtxUTxO Era))
 -> Identity (Maybe (Map TxIn (TxOut CtxUTxO Era))))
-> RootState -> Identity RootState
Lens' RootState (Maybe (Map TxIn (TxOut CtxUTxO Era)))
fuelUTxOL ((Maybe (Map TxIn (TxOut CtxUTxO Era))
  -> Identity (Maybe (Map TxIn (TxOut CtxUTxO Era))))
 -> RootState -> Identity RootState)
-> Maybe (Map TxIn (TxOut CtxUTxO Era)) -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Map TxIn (TxOut CtxUTxO Era))
forall a. Maybe a
Nothing
        ActiveTab
tab <- Getting ActiveTab RootState ActiveTab
-> EventM Text RootState ActiveTab
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ActiveTab RootState ActiveTab
Lens' RootState ActiveTab
activeTabL
        Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActiveTab
tab ActiveTab -> ActiveTab -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveTab
ModalTab) EventM Text RootState ()
leaveModal
      HydraEvent Tx
_ -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  AppEvent (L1UTxORefresh Map TxIn (TxOut CtxUTxO Era)
utxo) -> do
    (Maybe (Map TxIn (TxOut CtxUTxO Era))
 -> Identity (Maybe (Map TxIn (TxOut CtxUTxO Era))))
-> RootState -> Identity RootState
Lens' RootState (Maybe (Map TxIn (TxOut CtxUTxO Era)))
l1UTxOL ((Maybe (Map TxIn (TxOut CtxUTxO Era))
  -> Identity (Maybe (Map TxIn (TxOut CtxUTxO Era))))
 -> RootState -> Identity RootState)
-> Maybe (Map TxIn (TxOut CtxUTxO Era)) -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Map TxIn (TxOut CtxUTxO Era)
-> Maybe (Map TxIn (TxOut CtxUTxO Era))
forall a. a -> Maybe a
Just Map TxIn (TxOut CtxUTxO Era)
utxo
    (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Update complete"
  AppEvent (FuelUTxORefresh Map TxIn (TxOut CtxUTxO Era)
utxo) ->
    (Maybe (Map TxIn (TxOut CtxUTxO Era))
 -> Identity (Maybe (Map TxIn (TxOut CtxUTxO Era))))
-> RootState -> Identity RootState
Lens' RootState (Maybe (Map TxIn (TxOut CtxUTxO Era)))
fuelUTxOL ((Maybe (Map TxIn (TxOut CtxUTxO Era))
  -> Identity (Maybe (Map TxIn (TxOut CtxUTxO Era))))
 -> RootState -> Identity RootState)
-> Maybe (Map TxIn (TxOut CtxUTxO Era)) -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Map TxIn (TxOut CtxUTxO Era)
-> Maybe (Map TxIn (TxOut CtxUTxO Era))
forall a. a -> Maybe a
Just Map TxIn (TxOut CtxUTxO Era)
utxo
  AppEvent (TxBuildError Text
msg) -> (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
msg
  AppEvent (UTxOQueryResult Map TxIn (TxOut CtxUTxO Era)
utxo) -> do
    (Maybe (Map TxIn (TxOut CtxUTxO Era))
 -> Identity (Maybe (Map TxIn (TxOut CtxUTxO Era))))
-> RootState -> Identity RootState
Lens' RootState (Maybe (Map TxIn (TxOut CtxUTxO Era)))
l1UTxOL ((Maybe (Map TxIn (TxOut CtxUTxO Era))
  -> Identity (Maybe (Map TxIn (TxOut CtxUTxO Era))))
 -> RootState -> Identity RootState)
-> Maybe (Map TxIn (TxOut CtxUTxO Era)) -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Map TxIn (TxOut CtxUTxO Era)
-> Maybe (Map TxIn (TxOut CtxUTxO Era))
forall a. a -> Maybe a
Just Map TxIn (TxOut CtxUTxO Era)
utxo
    (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Text
forall a. Maybe a
Nothing
    Maybe OpenScreen
openScreen <- EventM Text RootState (Maybe OpenScreen)
useOpenScreen
    case Maybe OpenScreen
openScreen of
      Just OpenScreen
LoadingUTxOForIncrement -> case Map TxIn (TxOut CtxUTxO Era)
-> Maybe (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
forall s e n.
(s ~ (TxIn, TxOut CtxUTxO Era), n ~ Text) =>
Map TxIn (TxOut CtxUTxO Era) -> Maybe (Form s e n)
utxoRadioField Map TxIn (TxOut CtxUTxO Era)
utxo of
        Just Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
form ->
          EventM Text OpenScreen () -> EventM Text RootState ()
zoomOpenScreen (EventM Text OpenScreen () -> EventM Text RootState ())
-> EventM Text OpenScreen () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (OpenScreen -> EventM Text OpenScreen ())
-> OpenScreen -> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text -> OpenScreen
SelectingUTxOToIncrement Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
form
        Maybe (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
Nothing ->
          -- Still no L1 funds; keep the modal open offering another refresh.
          EventM Text OpenScreen () -> EventM Text RootState ()
zoomOpenScreen (EventM Text OpenScreen () -> EventM Text RootState ())
-> EventM Text OpenScreen () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
NoUTxOToIncrement
      Maybe OpenScreen
Nothing -> do
        -- Head is no longer Open (e.g. it closed mid-query). If we're still
        -- stuck on the loading modal, return the user to their previous tab.
        -- Without this, the result would be silently dropped and the modal
        -- would be stranded showing a stale loading panel.
        ActiveTab
tab <- Getting ActiveTab RootState ActiveTab
-> EventM Text RootState ActiveTab
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ActiveTab RootState ActiveTab
Lens' RootState ActiveTab
activeTabL
        Bool
hasRecoveryForm <- Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text) -> Bool)
-> EventM
     Text RootState (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
-> EventM Text RootState Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
  RootState
  (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
-> EventM
     Text RootState (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
  RootState
  (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
Lens' RootState (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
recoveryFormL
        Bool
hasFanoutForm <- Maybe (UTxOCheckboxForm (HydraEvent Tx) Text) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text) -> Bool)
-> EventM
     Text RootState (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
-> EventM Text RootState Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
  RootState
  (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
-> EventM
     Text RootState (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
  RootState
  (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
Lens' RootState (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
fanoutSelectionFormL
        Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActiveTab
tab ActiveTab -> ActiveTab -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveTab
ModalTab Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasRecoveryForm Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasFanoutForm) EventM Text RootState ()
leaveModal
      Maybe OpenScreen
_ -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- User navigated away (Esc, started a different flow) — drop silently.
  MouseDown Text
name Button
Vty.BScrollUp [Modifier]
_ Location
_ ->
    ViewportScroll Text -> forall s. Int -> EventM Text s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (Text -> ViewportScroll Text
forall n. n -> ViewportScroll n
viewportScroll Text
name) (-Int
3)
  MouseDown Text
name Button
Vty.BScrollDown [Modifier]
_ Location
_ ->
    ViewportScroll Text -> forall s. Int -> EventM Text s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (Text -> ViewportScroll Text
forall n. n -> ViewportScroll n
viewportScroll Text
name) Int
3
  MouseDown{} -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  MouseUp{} -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  VtyEvent Event
e -> do
    (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Text
forall a. Maybe a
Nothing
    Bool
modalOpen <- (RootState -> Bool) -> EventM Text RootState Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RootState -> Bool
isModalOpen
    case Event
e of
      EvKey (KChar Char
'c') [Modifier
MCtrl] -> EventM Text RootState ()
forall n s. EventM n s ()
halt
      EvKey (KChar Char
'd') [Modifier
MCtrl] -> EventM Text RootState ()
forall n s. EventM n s ()
halt
      EvKey (KFun Int
3) [] -> do
        Theme
newTheme <- Theme -> Theme
toggleTheme (Theme -> Theme)
-> EventM Text RootState Theme -> EventM Text RootState Theme
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Theme RootState Theme -> EventM Text RootState Theme
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Theme RootState Theme
Lens' RootState Theme
themeL
        (Theme -> Identity Theme) -> RootState -> Identity RootState
Lens' RootState Theme
themeL ((Theme -> Identity Theme) -> RootState -> Identity RootState)
-> Theme -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Theme
newTheme
        IO () -> EventM Text RootState ()
forall a. IO a -> EventM Text RootState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text RootState ())
-> IO () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ TuiConfig -> IO ()
writeConfig TuiConfig{theme :: Theme
theme = Theme
newTheme}
      EvKey (KChar Char
'q') []
        | Bool -> Bool
not Bool
modalOpen -> EventM Text RootState ()
forall n s. EventM n s ()
halt
      EvKey (KChar Char
'Q') []
        | Bool -> Bool
not Bool
modalOpen -> EventM Text RootState ()
forall n s. EventM n s ()
halt
      EvKey (KChar Char
'1') []
        | Bool -> Bool
not Bool
modalOpen -> (ActiveTab -> Identity ActiveTab)
-> RootState -> Identity RootState
Lens' RootState ActiveTab
activeTabL ((ActiveTab -> Identity ActiveTab)
 -> RootState -> Identity RootState)
-> ActiveTab -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ActiveTab
MainTab
      EvKey (KChar Char
'2') []
        | Bool -> Bool
not Bool
modalOpen -> do
            (ActiveTab -> Identity ActiveTab)
-> RootState -> Identity RootState
Lens' RootState ActiveTab
activeTabL ((ActiveTab -> Identity ActiveTab)
 -> RootState -> Identity RootState)
-> ActiveTab -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ActiveTab
FundsTab
            CardanoClient
-> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Text RootState ()
triggerL1IfNeeded CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan
      EvKey (KChar Char
'3') []
        | Bool -> Bool
not Bool
modalOpen -> do
            (ActiveTab -> Identity ActiveTab)
-> RootState -> Identity RootState
Lens' RootState ActiveTab
activeTabL ((ActiveTab -> Identity ActiveTab)
 -> RootState -> Identity RootState)
-> ActiveTab -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ActiveTab
EventHistoryTab
            (GenericList Text Vector LogMessage
 -> Identity (GenericList Text Vector LogMessage))
-> RootState -> Identity RootState
Lens' RootState (GenericList Text Vector LogMessage)
eventHistoryListL ((GenericList Text Vector LogMessage
  -> Identity (GenericList Text Vector LogMessage))
 -> RootState -> Identity RootState)
-> (GenericList Text Vector LogMessage
    -> GenericList Text Vector LogMessage)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Int
-> GenericList Text Vector LogMessage
-> GenericList Text Vector LogMessage
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BrickList.listMoveTo Int
0
      EvKey (KChar Char
'c') [] | Bool -> Bool
not Bool
modalOpen -> do
        LensLike' (Zoomed (EventM Text HeadState) ()) RootState HeadState
-> EventM Text HeadState () -> EventM Text RootState ()
forall c.
LensLike' (Zoomed (EventM Text HeadState) c) RootState HeadState
-> EventM Text HeadState c -> EventM Text RootState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((ConnectedState
 -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> RootState -> Focusing (StateT (EventState Text) IO) () RootState
Lens' RootState ConnectedState
connectedStateL ((ConnectedState
  -> Focusing (StateT (EventState Text) IO) () ConnectedState)
 -> RootState
 -> Focusing (StateT (EventState Text) IO) () RootState)
-> ((HeadState
     -> Focusing (StateT (EventState Text) IO) () HeadState)
    -> ConnectedState
    -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> (HeadState
    -> Focusing (StateT (EventState Text) IO) () HeadState)
-> RootState
-> Focusing (StateT (EventState Text) IO) () RootState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection
 -> Focusing (StateT (EventState Text) IO) () Connection)
-> ConnectedState
-> Focusing (StateT (EventState Text) IO) () ConnectedState
Traversal' ConnectedState Connection
connectionL ((Connection
  -> Focusing (StateT (EventState Text) IO) () Connection)
 -> ConnectedState
 -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> ((HeadState
     -> Focusing (StateT (EventState Text) IO) () HeadState)
    -> Connection
    -> Focusing (StateT (EventState Text) IO) () Connection)
-> (HeadState
    -> Focusing (StateT (EventState Text) IO) () HeadState)
-> ConnectedState
-> Focusing (StateT (EventState Text) IO) () ConnectedState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeadState -> Focusing (StateT (EventState Text) IO) () HeadState)
-> Connection
-> Focusing (StateT (EventState Text) IO) () Connection
Lens' Connection HeadState
headStateL) (EventM Text HeadState () -> EventM Text RootState ())
-> EventM Text HeadState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$
          CardanoClient
-> Client Tx IO
-> BChan (TUIEvent Tx)
-> Event
-> EventM Text HeadState ()
handleVtyEventsHeadState CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan Event
e
        Maybe OpenScreen
newOpenScreen <- EventM Text RootState (Maybe OpenScreen)
useOpenScreen
        case Maybe OpenScreen
newOpenScreen of
          Just (ConfirmingClose Form Bool (HydraEvent Tx) Text
_) -> EventM Text RootState ()
enterModal
          Maybe OpenScreen
_ -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      EvKey (KChar Char
'e') []
        | Bool -> Bool
not Bool
modalOpen -> do
            ActiveTab
tab <- Getting ActiveTab RootState ActiveTab
-> EventM Text RootState ActiveTab
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ActiveTab RootState ActiveTab
Lens' RootState ActiveTab
activeTabL
            case ActiveTab
tab of
              ActiveTab
EventHistoryTab -> do
                (EventHistoryFilter -> Identity EventHistoryFilter)
-> RootState -> Identity RootState
Lens' RootState EventHistoryFilter
eventHistoryFilterL ((EventHistoryFilter -> Identity EventHistoryFilter)
 -> RootState -> Identity RootState)
-> (EventHistoryFilter -> EventHistoryFilter)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= EventHistoryFilter -> EventHistoryFilter
toggleEventHistoryFilter
                (GenericList Text Vector LogMessage
 -> Identity (GenericList Text Vector LogMessage))
-> RootState -> Identity RootState
Lens' RootState (GenericList Text Vector LogMessage)
eventHistoryListL ((GenericList Text Vector LogMessage
  -> Identity (GenericList Text Vector LogMessage))
 -> RootState -> Identity RootState)
-> (GenericList Text Vector LogMessage
    -> GenericList Text Vector LogMessage)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Int
-> GenericList Text Vector LogMessage
-> GenericList Text Vector LogMessage
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BrickList.listMoveTo Int
0
                EventM Text RootState ()
syncEventHistoryList
              ActiveTab
_ -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      EvKey (KChar Char
'd') [] | Bool -> Bool
not Bool
modalOpen -> do
        ActiveTab
tab <- Getting ActiveTab RootState ActiveTab
-> EventM Text RootState ActiveTab
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ActiveTab RootState ActiveTab
Lens' RootState ActiveTab
activeTabL
        case ActiveTab
tab of
          ActiveTab
EventHistoryTab -> (Bool -> Identity Bool) -> RootState -> Identity RootState
Lens' RootState Bool
eventDetailRawL ((Bool -> Identity Bool) -> RootState -> Identity RootState)
-> (Bool -> Bool) -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
          ActiveTab
_ -> do
            Event -> EventM Text RootState ()
setPendingAction Event
e
            LensLike' (Zoomed (EventM Text HeadState) ()) RootState HeadState
-> EventM Text HeadState () -> EventM Text RootState ()
forall c.
LensLike' (Zoomed (EventM Text HeadState) c) RootState HeadState
-> EventM Text HeadState c -> EventM Text RootState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((ConnectedState
 -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> RootState -> Focusing (StateT (EventState Text) IO) () RootState
Lens' RootState ConnectedState
connectedStateL ((ConnectedState
  -> Focusing (StateT (EventState Text) IO) () ConnectedState)
 -> RootState
 -> Focusing (StateT (EventState Text) IO) () RootState)
-> ((HeadState
     -> Focusing (StateT (EventState Text) IO) () HeadState)
    -> ConnectedState
    -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> (HeadState
    -> Focusing (StateT (EventState Text) IO) () HeadState)
-> RootState
-> Focusing (StateT (EventState Text) IO) () RootState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection
 -> Focusing (StateT (EventState Text) IO) () Connection)
-> ConnectedState
-> Focusing (StateT (EventState Text) IO) () ConnectedState
Traversal' ConnectedState Connection
connectionL ((Connection
  -> Focusing (StateT (EventState Text) IO) () Connection)
 -> ConnectedState
 -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> ((HeadState
     -> Focusing (StateT (EventState Text) IO) () HeadState)
    -> Connection
    -> Focusing (StateT (EventState Text) IO) () Connection)
-> (HeadState
    -> Focusing (StateT (EventState Text) IO) () HeadState)
-> ConnectedState
-> Focusing (StateT (EventState Text) IO) () ConnectedState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeadState -> Focusing (StateT (EventState Text) IO) () HeadState)
-> Connection
-> Focusing (StateT (EventState Text) IO) () Connection
Lens' Connection HeadState
headStateL) (EventM Text HeadState () -> EventM Text RootState ())
-> EventM Text HeadState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$
              CardanoClient
-> Client Tx IO
-> BChan (TUIEvent Tx)
-> Event
-> EventM Text HeadState ()
handleVtyEventsHeadState CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan Event
e
            Maybe OpenScreen
newOpenScreen <- EventM Text RootState (Maybe OpenScreen)
useOpenScreen
            case Maybe OpenScreen
newOpenScreen of
              Just (SelectingUTxOToDecommit Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
_) -> EventM Text RootState ()
enterModal
              Just OpenScreen
OpenHome ->
                (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"No L2 UTxO available to decommit."
              Maybe OpenScreen
_ -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      EvKey (KChar Char
'u') [] | Bool -> Bool
not Bool
modalOpen -> do
        ActiveTab
tab <- Getting ActiveTab RootState ActiveTab
-> EventM Text RootState ActiveTab
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ActiveTab RootState ActiveTab
Lens' RootState ActiveTab
activeTabL
        case ActiveTab
tab of
          ActiveTab
FundsTab -> do
            (Maybe (Map TxIn (TxOut CtxUTxO Era))
 -> Identity (Maybe (Map TxIn (TxOut CtxUTxO Era))))
-> RootState -> Identity RootState
Lens' RootState (Maybe (Map TxIn (TxOut CtxUTxO Era)))
l1UTxOL ((Maybe (Map TxIn (TxOut CtxUTxO Era))
  -> Identity (Maybe (Map TxIn (TxOut CtxUTxO Era))))
 -> RootState -> Identity RootState)
-> Maybe (Map TxIn (TxOut CtxUTxO Era)) -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Map TxIn (TxOut CtxUTxO Era))
forall a. Maybe a
Nothing
            (Maybe (Map TxIn (TxOut CtxUTxO Era))
 -> Identity (Maybe (Map TxIn (TxOut CtxUTxO Era))))
-> RootState -> Identity RootState
Lens' RootState (Maybe (Map TxIn (TxOut CtxUTxO Era)))
fuelUTxOL ((Maybe (Map TxIn (TxOut CtxUTxO Era))
  -> Identity (Maybe (Map TxIn (TxOut CtxUTxO Era))))
 -> RootState -> Identity RootState)
-> Maybe (Map TxIn (TxOut CtxUTxO Era)) -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Map TxIn (TxOut CtxUTxO Era))
forall a. Maybe a
Nothing
            (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Updating L1 wallet…"
            CardanoClient
-> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Text RootState ()
triggerL1Query CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan
          ActiveTab
_ -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      EvKey (KChar Char
'f') [] | Bool -> Bool
not Bool
modalOpen -> do
        Event -> EventM Text RootState ()
setPendingAction Event
e
        LensLike' (Zoomed (EventM Text HeadState) ()) RootState HeadState
-> EventM Text HeadState () -> EventM Text RootState ()
forall c.
LensLike' (Zoomed (EventM Text HeadState) c) RootState HeadState
-> EventM Text HeadState c -> EventM Text RootState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((ConnectedState
 -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> RootState -> Focusing (StateT (EventState Text) IO) () RootState
Lens' RootState ConnectedState
connectedStateL ((ConnectedState
  -> Focusing (StateT (EventState Text) IO) () ConnectedState)
 -> RootState
 -> Focusing (StateT (EventState Text) IO) () RootState)
-> ((HeadState
     -> Focusing (StateT (EventState Text) IO) () HeadState)
    -> ConnectedState
    -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> (HeadState
    -> Focusing (StateT (EventState Text) IO) () HeadState)
-> RootState
-> Focusing (StateT (EventState Text) IO) () RootState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection
 -> Focusing (StateT (EventState Text) IO) () Connection)
-> ConnectedState
-> Focusing (StateT (EventState Text) IO) () ConnectedState
Traversal' ConnectedState Connection
connectionL ((Connection
  -> Focusing (StateT (EventState Text) IO) () Connection)
 -> ConnectedState
 -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> ((HeadState
     -> Focusing (StateT (EventState Text) IO) () HeadState)
    -> Connection
    -> Focusing (StateT (EventState Text) IO) () Connection)
-> (HeadState
    -> Focusing (StateT (EventState Text) IO) () HeadState)
-> ConnectedState
-> Focusing (StateT (EventState Text) IO) () ConnectedState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeadState -> Focusing (StateT (EventState Text) IO) () HeadState)
-> Connection
-> Focusing (StateT (EventState Text) IO) () Connection
Lens' Connection HeadState
headStateL) (EventM Text HeadState () -> EventM Text RootState ())
-> EventM Text HeadState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$
          CardanoClient
-> Client Tx IO
-> BChan (TUIEvent Tx)
-> Event
-> EventM Text HeadState ()
handleVtyEventsHeadState CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan Event
e
      EvKey (KChar Char
'p') [] | Bool -> Bool
not Bool
modalOpen -> do
        -- Selective partial fanout: pick one or more UTxOs to fan out, then send
        -- 'PartialFanout'. Only available once fanout is possible. This is a
        -- top-level modal flow (uses 'fanoutSelectionFormL'), like recovery.
        Maybe ActiveLink
mLink <- (RootState -> Maybe ActiveLink)
-> EventM Text RootState (Maybe ActiveLink)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (RootState
-> Getting (First ActiveLink) RootState ActiveLink
-> Maybe ActiveLink
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ConnectedState -> Const (First ActiveLink) ConnectedState)
-> RootState -> Const (First ActiveLink) RootState
Lens' RootState ConnectedState
connectedStateL ((ConnectedState -> Const (First ActiveLink) ConnectedState)
 -> RootState -> Const (First ActiveLink) RootState)
-> ((ActiveLink -> Const (First ActiveLink) ActiveLink)
    -> ConnectedState -> Const (First ActiveLink) ConnectedState)
-> Getting (First ActiveLink) RootState ActiveLink
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection -> Const (First ActiveLink) Connection)
-> ConnectedState -> Const (First ActiveLink) ConnectedState
Traversal' ConnectedState Connection
connectionL ((Connection -> Const (First ActiveLink) Connection)
 -> ConnectedState -> Const (First ActiveLink) ConnectedState)
-> ((ActiveLink -> Const (First ActiveLink) ActiveLink)
    -> Connection -> Const (First ActiveLink) Connection)
-> (ActiveLink -> Const (First ActiveLink) ActiveLink)
-> ConnectedState
-> Const (First ActiveLink) ConnectedState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeadState -> Const (First ActiveLink) HeadState)
-> Connection -> Const (First ActiveLink) Connection
Lens' Connection HeadState
headStateL ((HeadState -> Const (First ActiveLink) HeadState)
 -> Connection -> Const (First ActiveLink) Connection)
-> ((ActiveLink -> Const (First ActiveLink) ActiveLink)
    -> HeadState -> Const (First ActiveLink) HeadState)
-> (ActiveLink -> Const (First ActiveLink) ActiveLink)
-> Connection
-> Const (First ActiveLink) Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActiveLink -> Const (First ActiveLink) ActiveLink)
-> HeadState -> Const (First ActiveLink) HeadState
Traversal' HeadState ActiveLink
activeLinkL)
        -- Offer partial fanout only when the node is actually waiting for a
        -- selection: from 'FanoutPossible', or mid-fanout when the node reports
        -- it is awaiting the next selection (not while it auto-drains).
        let canPartialFanout :: ActiveHeadState -> Bool
canPartialFanout = \case
              ActiveHeadState
FanoutPossible -> Bool
True
              FanningOut{FanoutProgressMode
fanoutMode :: FanoutProgressMode
$sel:fanoutMode:Open :: ActiveHeadState -> FanoutProgressMode
fanoutMode} -> FanoutProgressMode
fanoutMode FanoutProgressMode -> FanoutProgressMode -> Bool
forall a. Eq a => a -> a -> Bool
== FanoutProgressMode
AwaitingFanoutSelection
              ActiveHeadState
_ -> Bool
False
        case Maybe ActiveLink
mLink of
          Just ActiveLink{$sel:utxo:ActiveLink :: ActiveLink -> UTxO
utxo = UTxO Map TxIn (TxOut CtxUTxO Era)
m, ActiveHeadState
activeHeadState :: ActiveHeadState
$sel:activeHeadState:ActiveLink :: ActiveLink -> ActiveHeadState
activeHeadState}
            | ActiveHeadState -> Bool
canPartialFanout ActiveHeadState
activeHeadState ->
                case Map TxIn (TxOut CtxUTxO Era)
-> Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
forall e n.
(n ~ Text) =>
Map TxIn (TxOut CtxUTxO Era)
-> Maybe (Form (Map TxIn (TxOut CtxUTxO Era, Bool)) e n)
utxoCheckboxField Map TxIn (TxOut CtxUTxO Era)
m of
                  Just UTxOCheckboxForm (HydraEvent Tx) Text
form -> do
                    (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
 -> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
-> RootState -> Identity RootState
Lens' RootState (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
fanoutSelectionFormL ((Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
  -> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
 -> RootState -> Identity RootState)
-> Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTxOCheckboxForm (HydraEvent Tx) Text
-> Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
forall a. a -> Maybe a
Just UTxOCheckboxForm (HydraEvent Tx) Text
form
                    EventM Text RootState ()
enterModal
                  Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
Nothing -> IO () -> EventM Text RootState ()
forall a. IO a -> EventM Text RootState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text RootState ())
-> IO () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ BChan (TUIEvent Tx) -> TUIEvent Tx -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (TUIEvent Tx)
chan (Text -> TUIEvent Tx
forall tx. Text -> TUIEvent tx
TxBuildError Text
"No UTxO available to fan out.")
          Maybe ActiveLink
_ -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      EvKey (KChar Char
'i') [] | Bool -> Bool
not Bool
modalOpen -> do
        -- Increment reads the cached L1 UTxO ('l1UTxOL') for a snappy modal
        -- rather than querying the cardano-node. With an empty/unloaded cache
        -- we show 'NoUTxOToIncrement', which offers a manual refresh. 'i' is
        -- overloaded: when the head is Idle it inits the head, so delegate any
        -- non-'OpenHome' state to the per-head handler.
        Maybe OpenScreen
screen <- EventM Text RootState (Maybe OpenScreen)
useOpenScreen
        case Maybe OpenScreen
screen of
          Just OpenScreen
OpenHome -> do
            Maybe (Map TxIn (TxOut CtxUTxO Era))
l1 <- Getting
  (Maybe (Map TxIn (TxOut CtxUTxO Era)))
  RootState
  (Maybe (Map TxIn (TxOut CtxUTxO Era)))
-> EventM Text RootState (Maybe (Map TxIn (TxOut CtxUTxO Era)))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Maybe (Map TxIn (TxOut CtxUTxO Era)))
  RootState
  (Maybe (Map TxIn (TxOut CtxUTxO Era)))
Lens' RootState (Maybe (Map TxIn (TxOut CtxUTxO Era)))
l1UTxOL
            case Maybe (Map TxIn (TxOut CtxUTxO Era))
l1 Maybe (Map TxIn (TxOut CtxUTxO Era))
-> (Map TxIn (TxOut CtxUTxO Era)
    -> Maybe (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text))
-> Maybe (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Map TxIn (TxOut CtxUTxO Era)
m -> if Map TxIn (TxOut CtxUTxO Era) -> Bool
forall k a. Map k a -> Bool
Map.null Map TxIn (TxOut CtxUTxO Era)
m then Maybe (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
forall a. Maybe a
Nothing else Map TxIn (TxOut CtxUTxO Era)
-> Maybe (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
forall s e n.
(s ~ (TxIn, TxOut CtxUTxO Era), n ~ Text) =>
Map TxIn (TxOut CtxUTxO Era) -> Maybe (Form s e n)
utxoRadioField Map TxIn (TxOut CtxUTxO Era)
m of
              Just Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
form -> EventM Text OpenScreen () -> EventM Text RootState ()
zoomOpenScreen (EventM Text OpenScreen () -> EventM Text RootState ())
-> EventM Text OpenScreen () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (OpenScreen -> EventM Text OpenScreen ())
-> OpenScreen -> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text -> OpenScreen
SelectingUTxOToIncrement Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
form
              Maybe (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
Nothing -> EventM Text OpenScreen () -> EventM Text RootState ()
zoomOpenScreen (EventM Text OpenScreen () -> EventM Text RootState ())
-> EventM Text OpenScreen () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
NoUTxOToIncrement
            EventM Text RootState ()
enterModal
          Maybe OpenScreen
_ -> do
            Event -> EventM Text RootState ()
setPendingAction Event
e
            LensLike' (Zoomed (EventM Text HeadState) ()) RootState HeadState
-> EventM Text HeadState () -> EventM Text RootState ()
forall c.
LensLike' (Zoomed (EventM Text HeadState) c) RootState HeadState
-> EventM Text HeadState c -> EventM Text RootState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((ConnectedState
 -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> RootState -> Focusing (StateT (EventState Text) IO) () RootState
Lens' RootState ConnectedState
connectedStateL ((ConnectedState
  -> Focusing (StateT (EventState Text) IO) () ConnectedState)
 -> RootState
 -> Focusing (StateT (EventState Text) IO) () RootState)
-> ((HeadState
     -> Focusing (StateT (EventState Text) IO) () HeadState)
    -> ConnectedState
    -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> (HeadState
    -> Focusing (StateT (EventState Text) IO) () HeadState)
-> RootState
-> Focusing (StateT (EventState Text) IO) () RootState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection
 -> Focusing (StateT (EventState Text) IO) () Connection)
-> ConnectedState
-> Focusing (StateT (EventState Text) IO) () ConnectedState
Traversal' ConnectedState Connection
connectionL ((Connection
  -> Focusing (StateT (EventState Text) IO) () Connection)
 -> ConnectedState
 -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> ((HeadState
     -> Focusing (StateT (EventState Text) IO) () HeadState)
    -> Connection
    -> Focusing (StateT (EventState Text) IO) () Connection)
-> (HeadState
    -> Focusing (StateT (EventState Text) IO) () HeadState)
-> ConnectedState
-> Focusing (StateT (EventState Text) IO) () ConnectedState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeadState -> Focusing (StateT (EventState Text) IO) () HeadState)
-> Connection
-> Focusing (StateT (EventState Text) IO) () Connection
Lens' Connection HeadState
headStateL) (EventM Text HeadState () -> EventM Text RootState ())
-> EventM Text HeadState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$
              CardanoClient
-> Client Tx IO
-> BChan (TUIEvent Tx)
-> Event
-> EventM Text HeadState ()
handleVtyEventsHeadState CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan Event
e
      EvKey (KChar Char
'r') [] | Bool -> Bool
not Bool
modalOpen -> do
        -- Recovery is a single modal flow regardless of head state. The form
        -- is stored in 'recoveryFormL' (not the per-head 'openState') so the
        -- same code path works whether the head is Open, Closed, or Final.
        Maybe [PendingIncrement]
mPending <- (RootState -> Maybe [PendingIncrement])
-> EventM Text RootState (Maybe [PendingIncrement])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (RootState
-> Getting (First [PendingIncrement]) RootState [PendingIncrement]
-> Maybe [PendingIncrement]
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ConnectedState -> Const (First [PendingIncrement]) ConnectedState)
-> RootState -> Const (First [PendingIncrement]) RootState
Lens' RootState ConnectedState
connectedStateL ((ConnectedState
  -> Const (First [PendingIncrement]) ConnectedState)
 -> RootState -> Const (First [PendingIncrement]) RootState)
-> (([PendingIncrement]
     -> Const (First [PendingIncrement]) [PendingIncrement])
    -> ConnectedState
    -> Const (First [PendingIncrement]) ConnectedState)
-> Getting (First [PendingIncrement]) RootState [PendingIncrement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection -> Const (First [PendingIncrement]) Connection)
-> ConnectedState
-> Const (First [PendingIncrement]) ConnectedState
Traversal' ConnectedState Connection
connectionL ((Connection -> Const (First [PendingIncrement]) Connection)
 -> ConnectedState
 -> Const (First [PendingIncrement]) ConnectedState)
-> (([PendingIncrement]
     -> Const (First [PendingIncrement]) [PendingIncrement])
    -> Connection -> Const (First [PendingIncrement]) Connection)
-> ([PendingIncrement]
    -> Const (First [PendingIncrement]) [PendingIncrement])
-> ConnectedState
-> Const (First [PendingIncrement]) ConnectedState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeadState -> Const (First [PendingIncrement]) HeadState)
-> Connection -> Const (First [PendingIncrement]) Connection
Lens' Connection HeadState
headStateL ((HeadState -> Const (First [PendingIncrement]) HeadState)
 -> Connection -> Const (First [PendingIncrement]) Connection)
-> (([PendingIncrement]
     -> Const (First [PendingIncrement]) [PendingIncrement])
    -> HeadState -> Const (First [PendingIncrement]) HeadState)
-> ([PendingIncrement]
    -> Const (First [PendingIncrement]) [PendingIncrement])
-> Connection
-> Const (First [PendingIncrement]) Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActiveLink -> Const (First [PendingIncrement]) ActiveLink)
-> HeadState -> Const (First [PendingIncrement]) HeadState
Traversal' HeadState ActiveLink
activeLinkL ((ActiveLink -> Const (First [PendingIncrement]) ActiveLink)
 -> HeadState -> Const (First [PendingIncrement]) HeadState)
-> (([PendingIncrement]
     -> Const (First [PendingIncrement]) [PendingIncrement])
    -> ActiveLink -> Const (First [PendingIncrement]) ActiveLink)
-> ([PendingIncrement]
    -> Const (First [PendingIncrement]) [PendingIncrement])
-> HeadState
-> Const (First [PendingIncrement]) HeadState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([PendingIncrement]
 -> Const (First [PendingIncrement]) [PendingIncrement])
-> ActiveLink -> Const (First [PendingIncrement]) ActiveLink
Lens' ActiveLink [PendingIncrement]
pendingIncrementsL)
        let noDeposits :: EventM Text RootState ()
noDeposits = IO () -> EventM Text RootState ()
forall a. IO a -> EventM Text RootState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text RootState ())
-> IO () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ BChan (TUIEvent Tx) -> TUIEvent Tx -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (TUIEvent Tx)
chan (Text -> TUIEvent Tx
forall tx. Text -> TUIEvent tx
TxBuildError Text
"No pending deposits to recover.")
        case Maybe [PendingIncrement]
mPending of
          Maybe [PendingIncrement]
Nothing -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- Idle or Disconnected: no head, nothing to recover.
          Just [] -> EventM Text RootState ()
noDeposits
          Just [PendingIncrement]
pis -> do
            let pendingDepositIds :: [(TxId, UTxO)]
pendingDepositIds = (\PendingIncrement{TxId
deposit :: TxId
$sel:deposit:PendingIncrement :: PendingIncrement -> TxId
deposit, UTxO
utxoToCommit :: UTxO
$sel:utxoToCommit:PendingIncrement :: PendingIncrement -> UTxO
utxoToCommit} -> (TxId
deposit, UTxO
utxoToCommit)) (PendingIncrement -> (TxId, UTxO))
-> [PendingIncrement] -> [(TxId, UTxO)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PendingIncrement]
pis
            case [(TxId, UTxO)] -> Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
forall s e n.
(s ~ TxId, n ~ Text) =>
[(TxId, UTxO)] -> Maybe (Form s e n)
depositIdRadioField [(TxId, UTxO)]
pendingDepositIds of
              Just TxIdRadioFieldForm (HydraEvent Tx) Text
form -> do
                (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
 -> Identity (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)))
-> RootState -> Identity RootState
Lens' RootState (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
recoveryFormL ((Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
  -> Identity (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)))
 -> RootState -> Identity RootState)
-> Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TxIdRadioFieldForm (HydraEvent Tx) Text
-> Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
forall a. a -> Maybe a
Just TxIdRadioFieldForm (HydraEvent Tx) Text
form
                EventM Text RootState ()
enterModal
              Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
Nothing -> EventM Text RootState ()
noDeposits
      EvKey Key
KRight []
        | Bool -> Bool
not Bool
modalOpen -> do
            (ActiveTab -> Identity ActiveTab)
-> RootState -> Identity RootState
Lens' RootState ActiveTab
activeTabL ((ActiveTab -> Identity ActiveTab)
 -> RootState -> Identity RootState)
-> (ActiveTab -> ActiveTab) -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ActiveTab -> ActiveTab
cycleTab
            ActiveTab
newTab <- Getting ActiveTab RootState ActiveTab
-> EventM Text RootState ActiveTab
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ActiveTab RootState ActiveTab
Lens' RootState ActiveTab
activeTabL
            Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActiveTab
newTab ActiveTab -> ActiveTab -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveTab
FundsTab) (EventM Text RootState () -> EventM Text RootState ())
-> EventM Text RootState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ CardanoClient
-> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Text RootState ()
triggerL1IfNeeded CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan
            Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActiveTab
newTab ActiveTab -> ActiveTab -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveTab
EventHistoryTab) (EventM Text RootState () -> EventM Text RootState ())
-> EventM Text RootState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ (GenericList Text Vector LogMessage
 -> Identity (GenericList Text Vector LogMessage))
-> RootState -> Identity RootState
Lens' RootState (GenericList Text Vector LogMessage)
eventHistoryListL ((GenericList Text Vector LogMessage
  -> Identity (GenericList Text Vector LogMessage))
 -> RootState -> Identity RootState)
-> (GenericList Text Vector LogMessage
    -> GenericList Text Vector LogMessage)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Int
-> GenericList Text Vector LogMessage
-> GenericList Text Vector LogMessage
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BrickList.listMoveTo Int
0
      EvKey Key
KLeft []
        | Bool -> Bool
not Bool
modalOpen -> do
            (ActiveTab -> Identity ActiveTab)
-> RootState -> Identity RootState
Lens' RootState ActiveTab
activeTabL ((ActiveTab -> Identity ActiveTab)
 -> RootState -> Identity RootState)
-> (ActiveTab -> ActiveTab) -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ActiveTab -> ActiveTab
prevTab
            ActiveTab
newTab <- Getting ActiveTab RootState ActiveTab
-> EventM Text RootState ActiveTab
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ActiveTab RootState ActiveTab
Lens' RootState ActiveTab
activeTabL
            Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActiveTab
newTab ActiveTab -> ActiveTab -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveTab
FundsTab) (EventM Text RootState () -> EventM Text RootState ())
-> EventM Text RootState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ CardanoClient
-> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Text RootState ()
triggerL1IfNeeded CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan
            Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActiveTab
newTab ActiveTab -> ActiveTab -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveTab
EventHistoryTab) (EventM Text RootState () -> EventM Text RootState ())
-> EventM Text RootState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ (GenericList Text Vector LogMessage
 -> Identity (GenericList Text Vector LogMessage))
-> RootState -> Identity RootState
Lens' RootState (GenericList Text Vector LogMessage)
eventHistoryListL ((GenericList Text Vector LogMessage
  -> Identity (GenericList Text Vector LogMessage))
 -> RootState -> Identity RootState)
-> (GenericList Text Vector LogMessage
    -> GenericList Text Vector LogMessage)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Int
-> GenericList Text Vector LogMessage
-> GenericList Text Vector LogMessage
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BrickList.listMoveTo Int
0
      Event
_ -> do
        ActiveTab
tab <- Getting ActiveTab RootState ActiveTab
-> EventM Text RootState ActiveTab
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ActiveTab RootState ActiveTab
Lens' RootState ActiveTab
activeTabL
        case ActiveTab
tab of
          ActiveTab
ModalTab -> do
            let closeModal :: EventM Text RootState ()
closeModal = do
                  EventM Text RootState ()
leaveModal
                  (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
 -> Identity (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)))
-> RootState -> Identity RootState
Lens' RootState (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
recoveryFormL ((Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
  -> Identity (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)))
 -> RootState -> Identity RootState)
-> Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
forall a. Maybe a
Nothing
                  (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
 -> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
-> RootState -> Identity RootState
Lens' RootState (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
fanoutSelectionFormL ((Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
  -> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
 -> RootState -> Identity RootState)
-> Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
forall a. Maybe a
Nothing
                  EventM Text OpenScreen () -> EventM Text RootState ()
zoomOpenScreen (EventM Text OpenScreen () -> EventM Text RootState ())
-> EventM Text OpenScreen () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
            Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
currentRecoveryForm <- Getting
  (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
  RootState
  (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
-> EventM
     Text RootState (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
  RootState
  (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
Lens' RootState (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
recoveryFormL
            Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
currentFanoutForm <- Getting
  (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
  RootState
  (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
-> EventM
     Text RootState (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
  RootState
  (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
Lens' RootState (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
fanoutSelectionFormL
            -- 'c' cancels modals, except while a text field is focused:
            -- addresses regularly contain 'c' (bech32), so typing or raw-pasting
            -- one must not abort the entry. Esc still cancels there.
            Bool
textEntryFocused <-
              EventM Text RootState (Maybe OpenScreen)
useOpenScreen EventM Text RootState (Maybe OpenScreen)
-> (Maybe OpenScreen -> Bool) -> EventM Text RootState Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
                Just EnteringAmount{} -> Bool
True
                Just EnteringRecipientAddress{} -> Bool
True
                Maybe OpenScreen
_ -> Bool
False
            case (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
currentRecoveryForm, Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
currentFanoutForm, Event
e) of
              (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
_, Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
_, EvKey Key
KEsc []) -> EventM Text RootState ()
closeModal
              (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
_, Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
_, EvKey (KChar Char
'c') []) | Bool -> Bool
not Bool
textEntryFocused -> EventM Text RootState ()
closeModal
              (Just TxIdRadioFieldForm (HydraEvent Tx) Text
form, Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
_, EvKey Key
KEnter []) -> do
                let selectedTxId :: TxId
selectedTxId = TxIdRadioFieldForm (HydraEvent Tx) Text -> TxId
forall s e n. Form s e n -> s
formState TxIdRadioFieldForm (HydraEvent Tx) Text
form
                (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Sending recovery…"
                IO () -> EventM Text RootState ()
forall a. IO a -> EventM Text RootState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text RootState ())
-> IO () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ Client Tx IO -> BChan (TUIEvent Tx) -> TxId -> IO ()
recoverCommitAsync Client Tx IO
client BChan (TUIEvent Tx)
chan TxId
selectedTxId
                EventM Text RootState ()
closeModal
              (Just TxIdRadioFieldForm (HydraEvent Tx) Text
_, Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
_, Event
_) -> LensLike'
  (Zoomed (EventM Text (TxIdRadioFieldForm (HydraEvent Tx) Text)) ())
  RootState
  (TxIdRadioFieldForm (HydraEvent Tx) Text)
-> EventM Text (TxIdRadioFieldForm (HydraEvent Tx) Text) ()
-> EventM Text RootState ()
forall c.
LensLike'
  (Zoomed (EventM Text (TxIdRadioFieldForm (HydraEvent Tx) Text)) c)
  RootState
  (TxIdRadioFieldForm (HydraEvent Tx) Text)
-> EventM Text (TxIdRadioFieldForm (HydraEvent Tx) Text) c
-> EventM Text RootState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
 -> Focusing
      (StateT (EventState Text) IO)
      ()
      (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)))
-> RootState -> Focusing (StateT (EventState Text) IO) () RootState
Lens' RootState (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
recoveryFormL ((Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
  -> Focusing
       (StateT (EventState Text) IO)
       ()
       (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)))
 -> RootState
 -> Focusing (StateT (EventState Text) IO) () RootState)
-> ((TxIdRadioFieldForm (HydraEvent Tx) Text
     -> Focusing
          (StateT (EventState Text) IO)
          ()
          (TxIdRadioFieldForm (HydraEvent Tx) Text))
    -> Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
    -> Focusing
         (StateT (EventState Text) IO)
         ()
         (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)))
-> (TxIdRadioFieldForm (HydraEvent Tx) Text
    -> Focusing
         (StateT (EventState Text) IO)
         ()
         (TxIdRadioFieldForm (HydraEvent Tx) Text))
-> RootState
-> Focusing (StateT (EventState Text) IO) () RootState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIdRadioFieldForm (HydraEvent Tx) Text
 -> Focusing
      (StateT (EventState Text) IO)
      ()
      (TxIdRadioFieldForm (HydraEvent Tx) Text))
-> Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
-> Focusing
     (StateT (EventState Text) IO)
     ()
     (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
forall a a' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe a')
_Just) (EventM Text (TxIdRadioFieldForm (HydraEvent Tx) Text) ()
 -> EventM Text RootState ())
-> EventM Text (TxIdRadioFieldForm (HydraEvent Tx) Text) ()
-> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Text (HydraEvent Tx)
-> EventM Text (TxIdRadioFieldForm (HydraEvent Tx) Text) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (Event -> BrickEvent Text (HydraEvent Tx)
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
              (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
_, Just UTxOCheckboxForm (HydraEvent Tx) Text
form, EvKey Key
KEnter []) -> do
                -- Fan out all the UTxOs the operator ticked. The node distributes
                -- them (chunking as needed) and reports 'HeadPartiallyFannedOut'
                -- with the remaining set; repeat to fan out more, or tick the rest
                -- to finish (the final step burns the head tokens).
                let selected :: UTxO
selected = [(TxIn, TxOut CtxUTxO Era)] -> UTxO
forall era. [(TxIn, TxOut CtxUTxO era)] -> UTxO era
UTxO.fromList [(TxIn
txin, TxOut CtxUTxO Era
txout) | (TxIn
txin, (TxOut CtxUTxO Era
txout, Bool
True)) <- Map TxIn (TxOut CtxUTxO Era, Bool)
-> [(TxIn, (TxOut CtxUTxO Era, Bool))]
forall k a. Map k a -> [(k, a)]
Map.toList (UTxOCheckboxForm (HydraEvent Tx) Text
-> Map TxIn (TxOut CtxUTxO Era, Bool)
forall s e n. Form s e n -> s
formState UTxOCheckboxForm (HydraEvent Tx) Text
form)]
                if UTxO -> Bool
forall era. UTxO era -> Bool
UTxO.null UTxO
selected
                  then (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Select at least one UTxO to fan out (Space to toggle)."
                  else do
                    (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Sending partial fanout…"
                    IO () -> EventM Text RootState ()
forall a. IO a -> EventM Text RootState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text RootState ())
-> IO () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ Client Tx IO -> ClientInput Tx -> IO ()
forall tx (m :: * -> *). Client tx m -> ClientInput tx -> m ()
sendInput Client Tx IO
client (UTxOType Tx -> ClientInput Tx
forall tx. UTxOType tx -> ClientInput tx
PartialFanout UTxO
UTxOType Tx
selected)
                    EventM Text RootState ()
closeModal
              (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
_, Just UTxOCheckboxForm (HydraEvent Tx) Text
form, EvKey (KChar Char
'a') []) ->
                -- Select-all toggle: if every UTxO is already ticked, clear them
                -- all; otherwise tick them all.
                let allTicked :: Bool
allTicked = ((TxIn, (TxOut CtxUTxO Era, Bool)) -> Bool)
-> [(TxIn, (TxOut CtxUTxO Era, Bool))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((TxOut CtxUTxO Era, Bool) -> Bool
forall a b. (a, b) -> b
snd ((TxOut CtxUTxO Era, Bool) -> Bool)
-> ((TxIn, (TxOut CtxUTxO Era, Bool)) -> (TxOut CtxUTxO Era, Bool))
-> (TxIn, (TxOut CtxUTxO Era, Bool))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, (TxOut CtxUTxO Era, Bool)) -> (TxOut CtxUTxO Era, Bool)
forall a b. (a, b) -> b
snd) (Map TxIn (TxOut CtxUTxO Era, Bool)
-> [(TxIn, (TxOut CtxUTxO Era, Bool))]
forall k a. Map k a -> [(k, a)]
Map.toList (UTxOCheckboxForm (HydraEvent Tx) Text
-> Map TxIn (TxOut CtxUTxO Era, Bool)
forall s e n. Form s e n -> s
formState UTxOCheckboxForm (HydraEvent Tx) Text
form))
                    setAll :: Bool -> Map TxIn (TxOut CtxUTxO Era, Bool)
setAll Bool
b = ((TxOut CtxUTxO Era, Bool) -> (TxOut CtxUTxO Era, Bool))
-> Map TxIn (TxOut CtxUTxO Era, Bool)
-> Map TxIn (TxOut CtxUTxO Era, Bool)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(TxOut CtxUTxO Era
o, Bool
_) -> (TxOut CtxUTxO Era
o, Bool
b)) (UTxOCheckboxForm (HydraEvent Tx) Text
-> Map TxIn (TxOut CtxUTxO Era, Bool)
forall s e n. Form s e n -> s
formState UTxOCheckboxForm (HydraEvent Tx) Text
form)
                 in (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
 -> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
-> RootState -> Identity RootState
Lens' RootState (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
fanoutSelectionFormL ((Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
  -> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
 -> RootState -> Identity RootState)
-> ((UTxOCheckboxForm (HydraEvent Tx) Text
     -> Identity (UTxOCheckboxForm (HydraEvent Tx) Text))
    -> Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
    -> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
-> (UTxOCheckboxForm (HydraEvent Tx) Text
    -> Identity (UTxOCheckboxForm (HydraEvent Tx) Text))
-> RootState
-> Identity RootState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOCheckboxForm (HydraEvent Tx) Text
 -> Identity (UTxOCheckboxForm (HydraEvent Tx) Text))
-> Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
-> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
forall a a' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe a')
_Just ((UTxOCheckboxForm (HydraEvent Tx) Text
  -> Identity (UTxOCheckboxForm (HydraEvent Tx) Text))
 -> RootState -> Identity RootState)
-> (UTxOCheckboxForm (HydraEvent Tx) Text
    -> UTxOCheckboxForm (HydraEvent Tx) Text)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Map TxIn (TxOut CtxUTxO Era, Bool)
-> UTxOCheckboxForm (HydraEvent Tx) Text
-> UTxOCheckboxForm (HydraEvent Tx) Text
forall s e n. s -> Form s e n -> Form s e n
updateFormState (Bool -> Map TxIn (TxOut CtxUTxO Era, Bool)
setAll (Bool -> Bool
not Bool
allTicked))
              -- Scroll the (possibly long) UTxO list with PageUp/PageDown, matching
              -- the main/funds UTxO viewports.
              (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
_, Just UTxOCheckboxForm (HydraEvent Tx) Text
_, EvKey Key
KPageUp []) -> ViewportScroll Text -> forall s. Int -> EventM Text s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (Text -> ViewportScroll Text
forall n. n -> ViewportScroll n
viewportScroll Text
fanoutSelectionViewportName) (-Int
10)
              (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
_, Just UTxOCheckboxForm (HydraEvent Tx) Text
_, EvKey Key
KPageDown []) -> ViewportScroll Text -> forall s. Int -> EventM Text s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (Text -> ViewportScroll Text
forall n. n -> ViewportScroll n
viewportScroll Text
fanoutSelectionViewportName) Int
10
              (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
_, Just UTxOCheckboxForm (HydraEvent Tx) Text
_, Event
_) ->
                -- The multi-select is several separate checkbox fields, so brick
                -- moves focus with Tab/BackTab. Map ↑/↓ to those so the arrow
                -- keys navigate the list as users expect (Space still toggles).
                let e' :: Event
e' = case Event
e of
                      EvKey Key
KDown [] -> Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'\t') []
                      EvKey Key
KUp [] -> Key -> [Modifier] -> Event
EvKey Key
KBackTab []
                      Event
_ -> Event
e
                 in LensLike'
  (Zoomed (EventM Text (UTxOCheckboxForm (HydraEvent Tx) Text)) ())
  RootState
  (UTxOCheckboxForm (HydraEvent Tx) Text)
-> EventM Text (UTxOCheckboxForm (HydraEvent Tx) Text) ()
-> EventM Text RootState ()
forall c.
LensLike'
  (Zoomed (EventM Text (UTxOCheckboxForm (HydraEvent Tx) Text)) c)
  RootState
  (UTxOCheckboxForm (HydraEvent Tx) Text)
-> EventM Text (UTxOCheckboxForm (HydraEvent Tx) Text) c
-> EventM Text RootState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
 -> Focusing
      (StateT (EventState Text) IO)
      ()
      (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
-> RootState -> Focusing (StateT (EventState Text) IO) () RootState
Lens' RootState (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
fanoutSelectionFormL ((Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
  -> Focusing
       (StateT (EventState Text) IO)
       ()
       (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
 -> RootState
 -> Focusing (StateT (EventState Text) IO) () RootState)
-> ((UTxOCheckboxForm (HydraEvent Tx) Text
     -> Focusing
          (StateT (EventState Text) IO)
          ()
          (UTxOCheckboxForm (HydraEvent Tx) Text))
    -> Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
    -> Focusing
         (StateT (EventState Text) IO)
         ()
         (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
-> (UTxOCheckboxForm (HydraEvent Tx) Text
    -> Focusing
         (StateT (EventState Text) IO)
         ()
         (UTxOCheckboxForm (HydraEvent Tx) Text))
-> RootState
-> Focusing (StateT (EventState Text) IO) () RootState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOCheckboxForm (HydraEvent Tx) Text
 -> Focusing
      (StateT (EventState Text) IO)
      ()
      (UTxOCheckboxForm (HydraEvent Tx) Text))
-> Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
-> Focusing
     (StateT (EventState Text) IO)
     ()
     (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
forall a a' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe a')
_Just) (EventM Text (UTxOCheckboxForm (HydraEvent Tx) Text) ()
 -> EventM Text RootState ())
-> EventM Text (UTxOCheckboxForm (HydraEvent Tx) Text) ()
-> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Text (HydraEvent Tx)
-> EventM Text (UTxOCheckboxForm (HydraEvent Tx) Text) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (Event -> BrickEvent Text (HydraEvent Tx)
forall n e. Event -> BrickEvent n e
VtyEvent Event
e')
              (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
Nothing, Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
Nothing, Event
_) -> do
                -- Show "Sending …" status for in-modal Enter actions
                -- (decommit / increment / recover / close confirm). Done
                -- before handleVtyEventsHeadState so the read of openState
                -- sees the action being submitted, not the post-action
                -- 'OpenHome'.
                Event -> EventM Text RootState ()
setPendingAction Event
e
                LensLike' (Zoomed (EventM Text HeadState) ()) RootState HeadState
-> EventM Text HeadState () -> EventM Text RootState ()
forall c.
LensLike' (Zoomed (EventM Text HeadState) c) RootState HeadState
-> EventM Text HeadState c -> EventM Text RootState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((ConnectedState
 -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> RootState -> Focusing (StateT (EventState Text) IO) () RootState
Lens' RootState ConnectedState
connectedStateL ((ConnectedState
  -> Focusing (StateT (EventState Text) IO) () ConnectedState)
 -> RootState
 -> Focusing (StateT (EventState Text) IO) () RootState)
-> ((HeadState
     -> Focusing (StateT (EventState Text) IO) () HeadState)
    -> ConnectedState
    -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> (HeadState
    -> Focusing (StateT (EventState Text) IO) () HeadState)
-> RootState
-> Focusing (StateT (EventState Text) IO) () RootState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection
 -> Focusing (StateT (EventState Text) IO) () Connection)
-> ConnectedState
-> Focusing (StateT (EventState Text) IO) () ConnectedState
Traversal' ConnectedState Connection
connectionL ((Connection
  -> Focusing (StateT (EventState Text) IO) () Connection)
 -> ConnectedState
 -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> ((HeadState
     -> Focusing (StateT (EventState Text) IO) () HeadState)
    -> Connection
    -> Focusing (StateT (EventState Text) IO) () Connection)
-> (HeadState
    -> Focusing (StateT (EventState Text) IO) () HeadState)
-> ConnectedState
-> Focusing (StateT (EventState Text) IO) () ConnectedState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeadState -> Focusing (StateT (EventState Text) IO) () HeadState)
-> Connection
-> Focusing (StateT (EventState Text) IO) () Connection
Lens' Connection HeadState
headStateL) (EventM Text HeadState () -> EventM Text RootState ())
-> EventM Text HeadState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$
                  CardanoClient
-> Client Tx IO
-> BChan (TUIEvent Tx)
-> Event
-> EventM Text HeadState ()
handleVtyEventsHeadState CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan Event
e
                -- Auto-close modal if action completed and we returned to OpenHome
                Maybe OpenScreen
newOpenScreen <- EventM Text RootState (Maybe OpenScreen)
useOpenScreen
                case Maybe OpenScreen
newOpenScreen of
                  Just OpenScreen
OpenHome -> EventM Text RootState ()
leaveModal
                  Maybe OpenScreen
_ -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          ActiveTab
_ -> do
            Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
modalOpen (EventM Text RootState () -> EventM Text RootState ())
-> EventM Text RootState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ Event -> EventM Text RootState ()
setPendingAction Event
e
            LensLike' (Zoomed (EventM Text HeadState) ()) RootState HeadState
-> EventM Text HeadState () -> EventM Text RootState ()
forall c.
LensLike' (Zoomed (EventM Text HeadState) c) RootState HeadState
-> EventM Text HeadState c -> EventM Text RootState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((ConnectedState
 -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> RootState -> Focusing (StateT (EventState Text) IO) () RootState
Lens' RootState ConnectedState
connectedStateL ((ConnectedState
  -> Focusing (StateT (EventState Text) IO) () ConnectedState)
 -> RootState
 -> Focusing (StateT (EventState Text) IO) () RootState)
-> ((HeadState
     -> Focusing (StateT (EventState Text) IO) () HeadState)
    -> ConnectedState
    -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> (HeadState
    -> Focusing (StateT (EventState Text) IO) () HeadState)
-> RootState
-> Focusing (StateT (EventState Text) IO) () RootState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection
 -> Focusing (StateT (EventState Text) IO) () Connection)
-> ConnectedState
-> Focusing (StateT (EventState Text) IO) () ConnectedState
Traversal' ConnectedState Connection
connectionL ((Connection
  -> Focusing (StateT (EventState Text) IO) () Connection)
 -> ConnectedState
 -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> ((HeadState
     -> Focusing (StateT (EventState Text) IO) () HeadState)
    -> Connection
    -> Focusing (StateT (EventState Text) IO) () Connection)
-> (HeadState
    -> Focusing (StateT (EventState Text) IO) () HeadState)
-> ConnectedState
-> Focusing (StateT (EventState Text) IO) () ConnectedState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeadState -> Focusing (StateT (EventState Text) IO) () HeadState)
-> Connection
-> Focusing (StateT (EventState Text) IO) () Connection
Lens' Connection HeadState
headStateL) (EventM Text HeadState () -> EventM Text RootState ())
-> EventM Text HeadState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$
              CardanoClient
-> Client Tx IO
-> BChan (TUIEvent Tx)
-> Event
-> EventM Text HeadState ()
handleVtyEventsHeadState CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan Event
e
            -- Switch to ModalTab when a modal flow starts
            Maybe OpenScreen
newOpenScreen <- EventM Text RootState (Maybe OpenScreen)
useOpenScreen
            case Maybe OpenScreen
newOpenScreen of
              Just OpenScreen
LoadingUTxOForIncrement -> EventM Text RootState ()
enterModal
              Just (SelectingUTxO Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
_) -> EventM Text RootState ()
enterModal
              Maybe OpenScreen
_ -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
modalOpen (EventM Text RootState () -> EventM Text RootState ())
-> EventM Text RootState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$
              Event -> EventM Text RootState ()
handleVtyEventsScrollable Event
e

-- * AppEvent handlers

handleTick :: HydraEvent Tx -> EventM Name RootState ()
handleTick :: HydraEvent Tx -> EventM Text RootState ()
handleTick = \case
  Tick UTCTime
now -> (UTCTime -> Identity UTCTime) -> RootState -> Identity RootState
Lens' RootState UTCTime
nowL ((UTCTime -> Identity UTCTime) -> RootState -> Identity RootState)
-> UTCTime -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTCTime
now
  HydraEvent Tx
_ -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

handleHydraEventsConnectedState :: HydraEvent Tx -> EventM Name ConnectedState ()
handleHydraEventsConnectedState :: HydraEvent Tx -> EventM Text ConnectedState ()
handleHydraEventsConnectedState = \case
  HydraEvent Tx
ClientConnected -> ConnectedState -> EventM Text ConnectedState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ConnectedState -> EventM Text ConnectedState ())
-> ConnectedState -> EventM Text ConnectedState ()
forall a b. (a -> b) -> a -> b
$ Connection -> ConnectedState
Connected Connection
emptyConnection
  HydraEvent Tx
ClientDisconnected -> ConnectedState -> EventM Text ConnectedState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ConnectedState
Disconnected
  HydraEvent Tx
_ -> () -> EventM Text ConnectedState ()
forall a. a -> EventM Text ConnectedState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

handleHydraEventsConnection :: UTCTime -> HydraEvent Tx -> EventM Name Connection ()
handleHydraEventsConnection :: UTCTime -> HydraEvent Tx -> EventM Text Connection ()
handleHydraEventsConnection UTCTime
now = \case
  -- Note: Greetings is the last event seen after restart.
  Update
    ( ApiGreetings
        API.Greetings
          { Party
me :: Party
$sel:me:Greetings :: forall tx. Greetings tx -> Party
me
          , $sel:env:Greetings :: forall tx. Greetings tx -> Environment
env = Environment{Text
configuredPeers :: Text
$sel:configuredPeers:Environment :: Environment -> Text
configuredPeers}
          , $sel:networkInfo:Greetings :: forall tx. Greetings tx -> NetworkInfo
networkInfo = NetworkInfo{Bool
networkConnected :: Bool
$sel:networkConnected:NetworkInfo :: NetworkInfo -> Bool
networkConnected, Map Host Bool
peersInfo :: Map Host Bool
$sel:peersInfo:NetworkInfo :: NetworkInfo -> Map Host Bool
peersInfo}
          , SyncedStatus
chainSyncedStatus :: SyncedStatus
$sel:chainSyncedStatus:Greetings :: forall tx. Greetings tx -> SyncedStatus
chainSyncedStatus
          }
      ) -> do
      (IdentifiedState -> Identity IdentifiedState)
-> Connection -> Identity Connection
Lens' Connection IdentifiedState
meL ((IdentifiedState -> Identity IdentifiedState)
 -> Connection -> Identity Connection)
-> IdentifiedState -> EventM Text Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Party -> IdentifiedState
Identified Party
me
      (Maybe NetworkState -> Identity (Maybe NetworkState))
-> Connection -> Identity Connection
Lens' Connection (Maybe NetworkState)
networkStateL ((Maybe NetworkState -> Identity (Maybe NetworkState))
 -> Connection -> Identity Connection)
-> Maybe NetworkState -> EventM Text Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= if Bool
networkConnected then NetworkState -> Maybe NetworkState
forall a. a -> Maybe a
Just NetworkState
NetworkConnected else NetworkState -> Maybe NetworkState
forall a. a -> Maybe a
Just NetworkState
NetworkDisconnected
      (ChainSyncedStatus -> Identity ChainSyncedStatus)
-> Connection -> Identity Connection
Lens' Connection ChainSyncedStatus
chainSyncedStatusL
        ((ChainSyncedStatus -> Identity ChainSyncedStatus)
 -> Connection -> Identity Connection)
-> ChainSyncedStatus -> EventM Text Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= case SyncedStatus
chainSyncedStatus of
          SyncedStatus
NodeState.InSync -> ChainSyncedStatus
InSync
          SyncedStatus
NodeState.CatchingUp -> ChainSyncedStatus
CatchingUp

      if Text -> Bool
T.null Text
configuredPeers
        then
          ([(Host, PeerStatus)] -> Identity [(Host, PeerStatus)])
-> Connection -> Identity Connection
Lens' Connection [(Host, PeerStatus)]
peersL (([(Host, PeerStatus)] -> Identity [(Host, PeerStatus)])
 -> Connection -> Identity Connection)
-> [(Host, PeerStatus)] -> EventM Text Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [(Host, PeerStatus)]
forall a. Monoid a => a
mempty
        else do
          let peerStrs :: [String]
peerStrs = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"," Text
configuredPeers)
              peerAddrs :: [String]
peerAddrs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=')) [String]
peerStrs
          case ((String -> Either String Host) -> [String] -> Either String [Host]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse String -> Either String Host
forall (m :: * -> *). MonadFail m => String -> m Host
readHost [String]
peerAddrs :: Either String [Host]) of
            Left String
_ -> do
              ([(Host, PeerStatus)] -> Identity [(Host, PeerStatus)])
-> Connection -> Identity Connection
Lens' Connection [(Host, PeerStatus)]
peersL (([(Host, PeerStatus)] -> Identity [(Host, PeerStatus)])
 -> Connection -> Identity Connection)
-> [(Host, PeerStatus)] -> EventM Text Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [(Host, PeerStatus)]
forall a. Monoid a => a
mempty
            Right [Host]
parsedPeers -> do
              [(Host, PeerStatus)]
existing <- Getting [(Host, PeerStatus)] Connection [(Host, PeerStatus)]
-> EventM Text Connection [(Host, PeerStatus)]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [(Host, PeerStatus)] Connection [(Host, PeerStatus)]
Lens' Connection [(Host, PeerStatus)]
peersL
              let existingMap :: Map Host PeerStatus
existingMap = [(Host, PeerStatus)] -> Map Host PeerStatus
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Host, PeerStatus)]
existing

                  statusFor :: Host -> PeerStatus
statusFor Host
p =
                    case Host -> Map Host Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Host
p Map Host Bool
peersInfo of
                      Just Bool
True -> PeerStatus
PeerIsConnected
                      Just Bool
False -> PeerStatus
PeerIsDisconnected
                      Maybe Bool
Nothing -> PeerStatus -> Host -> Map Host PeerStatus -> PeerStatus
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault PeerStatus
PeerIsUnknown Host
p Map Host PeerStatus
existingMap

              ([(Host, PeerStatus)] -> Identity [(Host, PeerStatus)])
-> Connection -> Identity Connection
Lens' Connection [(Host, PeerStatus)]
peersL (([(Host, PeerStatus)] -> Identity [(Host, PeerStatus)])
 -> Connection -> Identity Connection)
-> [(Host, PeerStatus)] -> EventM Text Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [(Host
p, Host -> PeerStatus
statusFor Host
p) | Host
p <- [Host]
parsedPeers]
  Update (ApiTimedServerOutput TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.PeerConnected Host
p}) ->
    ([(Host, PeerStatus)] -> Identity [(Host, PeerStatus)])
-> Connection -> Identity Connection
Lens' Connection [(Host, PeerStatus)]
peersL (([(Host, PeerStatus)] -> Identity [(Host, PeerStatus)])
 -> Connection -> Identity Connection)
-> ([(Host, PeerStatus)] -> [(Host, PeerStatus)])
-> EventM Text Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Host -> PeerStatus -> [(Host, PeerStatus)] -> [(Host, PeerStatus)]
updatePeerStatus Host
p PeerStatus
PeerIsConnected
  Update (ApiTimedServerOutput TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.PeerDisconnected Host
p}) ->
    ([(Host, PeerStatus)] -> Identity [(Host, PeerStatus)])
-> Connection -> Identity Connection
Lens' Connection [(Host, PeerStatus)]
peersL (([(Host, PeerStatus)] -> Identity [(Host, PeerStatus)])
 -> Connection -> Identity Connection)
-> ([(Host, PeerStatus)] -> [(Host, PeerStatus)])
-> EventM Text Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Host -> PeerStatus -> [(Host, PeerStatus)] -> [(Host, PeerStatus)]
updatePeerStatus Host
p PeerStatus
PeerIsDisconnected
  Update (ApiTimedServerOutput TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = ServerOutput Tx
API.NetworkConnected}) -> do
    (Maybe NetworkState -> Identity (Maybe NetworkState))
-> Connection -> Identity Connection
Lens' Connection (Maybe NetworkState)
networkStateL ((Maybe NetworkState -> Identity (Maybe NetworkState))
 -> Connection -> Identity Connection)
-> Maybe NetworkState -> EventM Text Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NetworkState -> Maybe NetworkState
forall a. a -> Maybe a
Just NetworkState
NetworkConnected
    ([(Host, PeerStatus)] -> Identity [(Host, PeerStatus)])
-> Connection -> Identity Connection
Lens' Connection [(Host, PeerStatus)]
peersL (([(Host, PeerStatus)] -> Identity [(Host, PeerStatus)])
 -> Connection -> Identity Connection)
-> ([(Host, PeerStatus)] -> [(Host, PeerStatus)])
-> EventM Text Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((Host, PeerStatus) -> (Host, PeerStatus))
-> [(Host, PeerStatus)] -> [(Host, PeerStatus)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Host
h, PeerStatus
_) -> (Host
h, PeerStatus
PeerIsUnknown))
  Update (ApiTimedServerOutput TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = ServerOutput Tx
API.NetworkDisconnected}) -> do
    (Maybe NetworkState -> Identity (Maybe NetworkState))
-> Connection -> Identity Connection
Lens' Connection (Maybe NetworkState)
networkStateL ((Maybe NetworkState -> Identity (Maybe NetworkState))
 -> Connection -> Identity Connection)
-> Maybe NetworkState -> EventM Text Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NetworkState -> Maybe NetworkState
forall a. a -> Maybe a
Just NetworkState
NetworkDisconnected
    ([(Host, PeerStatus)] -> Identity [(Host, PeerStatus)])
-> Connection -> Identity Connection
Lens' Connection [(Host, PeerStatus)]
peersL (([(Host, PeerStatus)] -> Identity [(Host, PeerStatus)])
 -> Connection -> Identity Connection)
-> ([(Host, PeerStatus)] -> [(Host, PeerStatus)])
-> EventM Text Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((Host, PeerStatus) -> (Host, PeerStatus))
-> [(Host, PeerStatus)] -> [(Host, PeerStatus)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Host
h, PeerStatus
_) -> (Host
h, PeerStatus
PeerIsUnknown))
  Update (ApiTimedServerOutput TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.NodeUnsynced{}}) -> do
    (ChainSyncedStatus -> Identity ChainSyncedStatus)
-> Connection -> Identity Connection
Lens' Connection ChainSyncedStatus
chainSyncedStatusL ((ChainSyncedStatus -> Identity ChainSyncedStatus)
 -> Connection -> Identity Connection)
-> ChainSyncedStatus -> EventM Text Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ChainSyncedStatus
CatchingUp
  Update (ApiTimedServerOutput TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.NodeSynced{}}) -> do
    (ChainSyncedStatus -> Identity ChainSyncedStatus)
-> Connection -> Identity Connection
Lens' Connection ChainSyncedStatus
chainSyncedStatusL ((ChainSyncedStatus -> Identity ChainSyncedStatus)
 -> Connection -> Identity Connection)
-> ChainSyncedStatus -> EventM Text Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ChainSyncedStatus
InSync
  HydraEvent Tx
e -> LensLike' (Zoomed (EventM Text HeadState) ()) Connection HeadState
-> EventM Text HeadState () -> EventM Text Connection ()
forall c.
LensLike' (Zoomed (EventM Text HeadState) c) Connection HeadState
-> EventM Text HeadState c -> EventM Text Connection c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (EventM Text HeadState) ()) Connection HeadState
(HeadState -> Focusing (StateT (EventState Text) IO) () HeadState)
-> Connection
-> Focusing (StateT (EventState Text) IO) () Connection
Lens' Connection HeadState
headStateL (EventM Text HeadState () -> EventM Text Connection ())
-> EventM Text HeadState () -> EventM Text Connection ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> HydraEvent Tx -> EventM Text HeadState ()
handleHydraEventsHeadState UTCTime
now HydraEvent Tx
e
 where
  updatePeerStatus :: Host -> PeerStatus -> [(Host, PeerStatus)] -> [(Host, PeerStatus)]
  updatePeerStatus :: Host -> PeerStatus -> [(Host, PeerStatus)] -> [(Host, PeerStatus)]
updatePeerStatus Host
host PeerStatus
status [(Host, PeerStatus)]
peers =
    (Host
host, PeerStatus
status) (Host, PeerStatus) -> [(Host, PeerStatus)] -> [(Host, PeerStatus)]
forall a. a -> [a] -> [a]
: ((Host, PeerStatus) -> Bool)
-> [(Host, PeerStatus)] -> [(Host, PeerStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Host -> Host -> Bool
forall a. Eq a => a -> a -> Bool
/= Host
host) (Host -> Bool)
-> ((Host, PeerStatus) -> Host) -> (Host, PeerStatus) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Host, PeerStatus) -> Host
forall a b. (a, b) -> a
fst) [(Host, PeerStatus)]
peers

handleHydraEventsHeadState :: UTCTime -> HydraEvent Tx -> EventM Name HeadState ()
handleHydraEventsHeadState :: UTCTime -> HydraEvent Tx -> EventM Text HeadState ()
handleHydraEventsHeadState UTCTime
now HydraEvent Tx
e = do
  HeadState
st <- EventM Text HeadState HeadState
forall s (m :: * -> *). MonadState s m => m s
get
  case HydraEvent Tx
e of
    Update (ApiTimedServerOutput TimedServerOutput{UTCTime
time :: UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.HeadIsOpen{[Party]
parties :: [Party]
$sel:parties:NetworkConnected :: forall tx. ServerOutput tx -> [Party]
parties, HeadId
headId :: HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId}}) ->
      HeadState -> EventM Text HeadState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (HeadState -> EventM Text HeadState ())
-> HeadState -> EventM Text HeadState ()
forall a b. (a -> b) -> a -> b
$ ActiveLink -> HeadState
Active ([Party] -> HeadId -> ActiveLink
newActiveLink ([Party] -> [Party]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Party]
parties) HeadId
headId)
    Update (ApiTimedServerOutput TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.EventLogRotated{NodeState Tx
checkpoint :: NodeState Tx
$sel:checkpoint:NetworkConnected :: forall tx. ServerOutput tx -> NodeState tx
checkpoint}}) -> do
      (HeadState -> HeadState) -> EventM Text HeadState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((HeadState -> HeadState) -> EventM Text HeadState ())
-> (HeadState -> HeadState) -> EventM Text HeadState ()
forall a b. (a -> b) -> a -> b
$ \HeadState
current -> UTCTime -> HeadState -> NodeState Tx -> HeadState
recoverHeadState UTCTime
now HeadState
current NodeState Tx
checkpoint
    HydraEvent Tx
_ -> () -> EventM Text HeadState ()
forall a. a -> EventM Text HeadState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  LensLike' (Zoomed (EventM Text ActiveLink) ()) HeadState ActiveLink
-> EventM Text ActiveLink () -> EventM Text HeadState ()
forall c.
LensLike' (Zoomed (EventM Text ActiveLink) c) HeadState ActiveLink
-> EventM Text ActiveLink c -> EventM Text HeadState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (EventM Text ActiveLink) ()) HeadState ActiveLink
(ActiveLink
 -> Focusing (StateT (EventState Text) IO) () ActiveLink)
-> HeadState -> Focusing (StateT (EventState Text) IO) () HeadState
Traversal' HeadState ActiveLink
activeLinkL (EventM Text ActiveLink () -> EventM Text HeadState ())
-> EventM Text ActiveLink () -> EventM Text HeadState ()
forall a b. (a -> b) -> a -> b
$ HydraEvent Tx -> EventM Text ActiveLink ()
handleHydraEventsActiveLink HydraEvent Tx
e

handleHydraEventsActiveLink :: HydraEvent Tx -> EventM Name ActiveLink ()
handleHydraEventsActiveLink :: HydraEvent Tx -> EventM Text ActiveLink ()
handleHydraEventsActiveLink HydraEvent Tx
e = do
  case HydraEvent Tx
e of
    Update (ApiTimedServerOutput TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.HeadIsOpen{}}) -> do
      (ActiveHeadState -> Identity ActiveHeadState)
-> ActiveLink -> Identity ActiveLink
Lens' ActiveLink ActiveHeadState
activeHeadStateL ((ActiveHeadState -> Identity ActiveHeadState)
 -> ActiveLink -> Identity ActiveLink)
-> ActiveHeadState -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= OpenScreen -> ActiveHeadState
Open OpenScreen
OpenHome
    Update (ApiTimedServerOutput TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{UTxOType Tx
utxo :: UTxOType Tx
$sel:utxo:Snapshot :: forall tx. Snapshot tx -> UTxOType tx
utxo}}}) ->
      (UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink
Lens' ActiveLink UTxO
utxoL ((UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink)
-> UTxO -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTxO
UTxOType Tx
utxo
    Update (ApiTimedServerOutput TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.HeadIsClosed{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, SnapshotNumber
snapshotNumber :: SnapshotNumber
$sel:snapshotNumber:NetworkConnected :: forall tx. ServerOutput tx -> SnapshotNumber
snapshotNumber, UTCTime
contestationDeadline :: UTCTime
$sel:contestationDeadline:NetworkConnected :: forall tx. ServerOutput tx -> UTCTime
contestationDeadline}}) -> do
      (ActiveHeadState -> Identity ActiveHeadState)
-> ActiveLink -> Identity ActiveLink
Lens' ActiveLink ActiveHeadState
activeHeadStateL ((ActiveHeadState -> Identity ActiveHeadState)
 -> ActiveLink -> Identity ActiveLink)
-> ActiveHeadState -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Closed{$sel:closedState:Open :: ClosedState
closedState = ClosedState{UTCTime
contestationDeadline :: UTCTime
$sel:contestationDeadline:ClosedState :: UTCTime
contestationDeadline}}
    Update (ApiTimedServerOutput TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.ReadyToFanout{}}) ->
      (ActiveHeadState -> Identity ActiveHeadState)
-> ActiveLink -> Identity ActiveLink
Lens' ActiveLink ActiveHeadState
activeHeadStateL ((ActiveHeadState -> Identity ActiveHeadState)
 -> ActiveLink -> Identity ActiveLink)
-> ActiveHeadState -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ActiveHeadState
FanoutPossible
    Update (ApiTimedServerOutput TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.HeadPartiallyFannedOut{UTxOType Tx
remainingUTxO :: UTxOType Tx
$sel:remainingUTxO:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
remainingUTxO, FanoutProgressMode
fanoutMode :: FanoutProgressMode
$sel:fanoutMode:NetworkConnected :: forall tx. ServerOutput tx -> FanoutProgressMode
fanoutMode}}) -> do
      -- A fanout step landed: move into the in-progress 'FanningOut' state and
      -- reflect what is left. 'fanoutMode' (from the node) decides whether we
      -- prompt for the next selection or just report auto-draining progress.
      -- Full 'Fanout' is no longer offered either way.
      (UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink
Lens' ActiveLink UTxO
utxoL ((UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink)
-> UTxO -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTxO
UTxOType Tx
remainingUTxO
      (ActiveHeadState -> Identity ActiveHeadState)
-> ActiveLink -> Identity ActiveLink
Lens' ActiveLink ActiveHeadState
activeHeadStateL ((ActiveHeadState -> Identity ActiveHeadState)
 -> ActiveLink -> Identity ActiveLink)
-> ActiveHeadState -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= FanningOut{$sel:fanoutRemaining:Open :: UTxO
fanoutRemaining = UTxO
UTxOType Tx
remainingUTxO, FanoutProgressMode
$sel:fanoutMode:Open :: FanoutProgressMode
fanoutMode :: FanoutProgressMode
fanoutMode}
    Update (ApiTimedServerOutput TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.HeadIsFinalized{UTxOType Tx
finalizedUTxO :: UTxOType Tx
$sel:finalizedUTxO:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
finalizedUTxO}}) -> do
      -- Show the full cumulative set that was fanned out across all (partial)
      -- fanout steps, not just the last batch that happened to be left in 'utxoL'.
      (UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink
Lens' ActiveLink UTxO
utxoL ((UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink)
-> UTxO -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTxO
UTxOType Tx
finalizedUTxO
      (ActiveHeadState -> Identity ActiveHeadState)
-> ActiveLink -> Identity ActiveLink
Lens' ActiveLink ActiveHeadState
activeHeadStateL ((ActiveHeadState -> Identity ActiveHeadState)
 -> ActiveLink -> Identity ActiveLink)
-> ActiveHeadState -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ActiveHeadState
Final
    Update (ApiTimedServerOutput TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.DecommitRequested{UTxOType Tx
utxoToDecommit :: UTxOType Tx
$sel:utxoToDecommit:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxoToDecommit}}) -> do
      ActiveLink{UTxO
$sel:utxo:ActiveLink :: ActiveLink -> UTxO
utxo :: UTxO
utxo} <- EventM Text ActiveLink ActiveLink
forall s (m :: * -> *). MonadState s m => m s
get
      (UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink
Lens' ActiveLink UTxO
pendingUTxOToDecommitL ((UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink)
-> UTxO -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTxO
UTxOType Tx
utxoToDecommit
      (UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink
Lens' ActiveLink UTxO
utxoL ((UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink)
-> UTxO -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTxO -> UTxO -> UTxO
forall era. UTxO era -> UTxO era -> UTxO era
UTxO.difference UTxO
utxo UTxO
UTxOType Tx
utxoToDecommit
    Update (ApiTimedServerOutput TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.DecommitFinalized{}}) -> do
      ActiveLink{UTxO
$sel:utxo:ActiveLink :: ActiveLink -> UTxO
utxo :: UTxO
utxo, UTxO
pendingUTxOToDecommit :: UTxO
$sel:pendingUTxOToDecommit:ActiveLink :: ActiveLink -> UTxO
pendingUTxOToDecommit} <- EventM Text ActiveLink ActiveLink
forall s (m :: * -> *). MonadState s m => m s
get
      (UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink
Lens' ActiveLink UTxO
pendingUTxOToDecommitL ((UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink)
-> UTxO -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTxO
forall a. Monoid a => a
mempty
      (UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink
Lens' ActiveLink UTxO
utxoL ((UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink)
-> UTxO -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTxO
utxo
    Update (ApiTimedServerOutput TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.CommitRecorded{UTxOType Tx
utxoToCommit :: UTxOType Tx
$sel:utxoToCommit:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxoToCommit, TxIdType Tx
pendingDeposit :: TxIdType Tx
$sel:pendingDeposit:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
pendingDeposit, UTCTime
deadline :: UTCTime
$sel:deadline:NetworkConnected :: forall tx. ServerOutput tx -> UTCTime
deadline}}) -> do
      ActiveLink{[PendingIncrement]
pendingIncrements :: [PendingIncrement]
$sel:pendingIncrements:ActiveLink :: ActiveLink -> [PendingIncrement]
pendingIncrements} <- EventM Text ActiveLink ActiveLink
forall s (m :: * -> *). MonadState s m => m s
get
      ([PendingIncrement] -> Identity [PendingIncrement])
-> ActiveLink -> Identity ActiveLink
Lens' ActiveLink [PendingIncrement]
pendingIncrementsL (([PendingIncrement] -> Identity [PendingIncrement])
 -> ActiveLink -> Identity ActiveLink)
-> [PendingIncrement] -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [PendingIncrement]
pendingIncrements [PendingIncrement] -> [PendingIncrement] -> [PendingIncrement]
forall a. Semigroup a => a -> a -> a
<> [UTxO
-> TxId -> UTCTime -> PendingIncrementStatus -> PendingIncrement
PendingIncrement UTxO
UTxOType Tx
utxoToCommit TxId
TxIdType Tx
pendingDeposit UTCTime
deadline PendingIncrementStatus
PendingDeposit]
    Update (ApiTimedServerOutput TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.CommitApproved{$sel:utxoToCommit:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxoToCommit = UTxOType Tx
approvedUtxoToCommit}}) -> do
      ActiveLink{[PendingIncrement]
$sel:pendingIncrements:ActiveLink :: ActiveLink -> [PendingIncrement]
pendingIncrements :: [PendingIncrement]
pendingIncrements} <- EventM Text ActiveLink ActiveLink
forall s (m :: * -> *). MonadState s m => m s
get
      ([PendingIncrement] -> Identity [PendingIncrement])
-> ActiveLink -> Identity ActiveLink
Lens' ActiveLink [PendingIncrement]
pendingIncrementsL
        (([PendingIncrement] -> Identity [PendingIncrement])
 -> ActiveLink -> Identity ActiveLink)
-> [PendingIncrement] -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (PendingIncrement -> PendingIncrement)
-> [PendingIncrement] -> [PendingIncrement]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          ( \inc :: PendingIncrement
inc@PendingIncrement{$sel:utxoToCommit:PendingIncrement :: PendingIncrement -> UTxO
utxoToCommit = UTxO
pendingUtxoToCommit, TxId
$sel:deposit:PendingIncrement :: PendingIncrement -> TxId
deposit :: TxId
deposit, UTCTime
depositDeadline :: UTCTime
$sel:depositDeadline:PendingIncrement :: PendingIncrement -> UTCTime
depositDeadline} ->
              if UTxOType Tx -> ByteString
forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO UTxO
UTxOType Tx
pendingUtxoToCommit ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== UTxOType Tx -> ByteString
forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO UTxOType Tx
approvedUtxoToCommit
                then UTxO
-> TxId -> UTCTime -> PendingIncrementStatus -> PendingIncrement
PendingIncrement UTxO
pendingUtxoToCommit TxId
deposit UTCTime
depositDeadline PendingIncrementStatus
FinalizingDeposit
                else PendingIncrement
inc
          )
          [PendingIncrement]
pendingIncrements
    Update (ApiTimedServerOutput TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.CommitFinalized{TxIdType Tx
depositTxId :: TxIdType Tx
$sel:depositTxId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
depositTxId}}) -> do
      ActiveLink{UTxO
$sel:utxo:ActiveLink :: ActiveLink -> UTxO
utxo :: UTxO
utxo, [PendingIncrement]
$sel:pendingIncrements:ActiveLink :: ActiveLink -> [PendingIncrement]
pendingIncrements :: [PendingIncrement]
pendingIncrements} <- EventM Text ActiveLink ActiveLink
forall s (m :: * -> *). MonadState s m => m s
get
      let activePendingIncrements :: [PendingIncrement]
activePendingIncrements = (PendingIncrement -> Bool)
-> [PendingIncrement] -> [PendingIncrement]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PendingIncrement{TxId
$sel:deposit:PendingIncrement :: PendingIncrement -> TxId
deposit :: TxId
deposit} -> TxId
deposit TxId -> TxId -> Bool
forall a. Eq a => a -> a -> Bool
/= TxId
TxIdType Tx
depositTxId) [PendingIncrement]
pendingIncrements
      let approvedIncrement :: Maybe PendingIncrement
approvedIncrement = (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
TxIdType Tx
depositTxId) [PendingIncrement]
pendingIncrements
      let activeUtxoToCommit :: UTxO
activeUtxoToCommit = UTxO
-> (PendingIncrement -> UTxO) -> Maybe PendingIncrement -> UTxO
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UTxO
forall a. Monoid a => a
mempty (\PendingIncrement{UTxO
$sel:utxoToCommit:PendingIncrement :: PendingIncrement -> UTxO
utxoToCommit :: UTxO
utxoToCommit} -> UTxO
utxoToCommit) Maybe PendingIncrement
approvedIncrement
      ([PendingIncrement] -> Identity [PendingIncrement])
-> ActiveLink -> Identity ActiveLink
Lens' ActiveLink [PendingIncrement]
pendingIncrementsL (([PendingIncrement] -> Identity [PendingIncrement])
 -> ActiveLink -> Identity ActiveLink)
-> [PendingIncrement] -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [PendingIncrement]
activePendingIncrements
      (UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink
Lens' ActiveLink UTxO
utxoL ((UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink)
-> UTxO -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTxO
utxo UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> UTxO
activeUtxoToCommit
    Update (ApiTimedServerOutput TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = API.CommitRecovered{TxIdType Tx
recoveredTxId :: TxIdType Tx
$sel:recoveredTxId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
recoveredTxId}}) -> do
      ActiveLink{[PendingIncrement]
$sel:pendingIncrements:ActiveLink :: ActiveLink -> [PendingIncrement]
pendingIncrements :: [PendingIncrement]
pendingIncrements} <- EventM Text ActiveLink ActiveLink
forall s (m :: * -> *). MonadState s m => m s
get
      let activePendingIncrements :: [PendingIncrement]
activePendingIncrements = (PendingIncrement -> Bool)
-> [PendingIncrement] -> [PendingIncrement]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PendingIncrement{TxId
$sel:deposit:PendingIncrement :: PendingIncrement -> TxId
deposit :: TxId
deposit} -> TxId
deposit TxId -> TxId -> Bool
forall a. Eq a => a -> a -> Bool
/= TxId
TxIdType Tx
recoveredTxId) [PendingIncrement]
pendingIncrements
      ([PendingIncrement] -> Identity [PendingIncrement])
-> ActiveLink -> Identity ActiveLink
Lens' ActiveLink [PendingIncrement]
pendingIncrementsL (([PendingIncrement] -> Identity [PendingIncrement])
 -> ActiveLink -> Identity ActiveLink)
-> [PendingIncrement] -> EventM Text ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [PendingIncrement]
activePendingIncrements
    HydraEvent Tx
_ -> () -> EventM Text ActiveLink ()
forall a. a -> EventM Text ActiveLink a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

handleHydraEventsLog :: UTCTime -> HydraEvent Tx -> EventM Name [LogMessage] ()
handleHydraEventsLog :: UTCTime -> HydraEvent Tx -> EventM Text [LogMessage] ()
handleHydraEventsLog UTCTime
now = \case
  Update ApiMessage Tx
msg -> ([LogMessage] -> Identity [LogMessage])
-> [LogMessage] -> Identity [LogMessage]
forall a. a -> a
id (([LogMessage] -> Identity [LogMessage])
 -> [LogMessage] -> Identity [LogMessage])
-> ([LogMessage] -> [LogMessage]) -> EventM Text [LogMessage] ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (RenderedMessage -> LogMessage
toLogMessage (UTCTime -> ApiMessage Tx -> RenderedMessage
renderMessage UTCTime
now ApiMessage Tx
msg) :)
  HydraEvent Tx
_ -> () -> EventM Text [LogMessage] ()
forall a. a -> EventM Text [LogMessage] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- * VtyEvent handlers

handleVtyEventsHeadState :: CardanoClient -> Client Tx IO -> BChan (TUIEvent Tx) -> Vty.Event -> EventM Name HeadState ()
handleVtyEventsHeadState :: CardanoClient
-> Client Tx IO
-> BChan (TUIEvent Tx)
-> Event
-> EventM Text HeadState ()
handleVtyEventsHeadState CardanoClient
cardanoClient Client Tx IO
hydraClient BChan (TUIEvent Tx)
chan Event
e = do
  HeadState
h <- Getting HeadState HeadState HeadState
-> EventM Text HeadState HeadState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting HeadState HeadState HeadState
forall a. a -> a
id
  case HeadState
h of
    HeadState
Idle -> case Event
e of
      EvKey (KChar Char
'i') [] -> IO () -> EventM Text HeadState ()
forall a. IO a -> EventM Text HeadState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Client Tx IO -> ClientInput Tx -> IO ()
forall tx (m :: * -> *). Client tx m -> ClientInput tx -> m ()
sendInput Client Tx IO
hydraClient ClientInput Tx
forall tx. ClientInput tx
Init)
      Event
_ -> () -> EventM Text HeadState ()
forall a. a -> EventM Text HeadState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    HeadState
_ -> () -> EventM Text HeadState ()
forall a. a -> EventM Text HeadState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  LensLike' (Zoomed (EventM Text ActiveLink) ()) HeadState ActiveLink
-> EventM Text ActiveLink () -> EventM Text HeadState ()
forall c.
LensLike' (Zoomed (EventM Text ActiveLink) c) HeadState ActiveLink
-> EventM Text ActiveLink c -> EventM Text HeadState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (EventM Text ActiveLink) ()) HeadState ActiveLink
(ActiveLink
 -> Focusing (StateT (EventState Text) IO) () ActiveLink)
-> HeadState -> Focusing (StateT (EventState Text) IO) () HeadState
Traversal' HeadState ActiveLink
activeLinkL (EventM Text ActiveLink () -> EventM Text HeadState ())
-> EventM Text ActiveLink () -> EventM Text HeadState ()
forall a b. (a -> b) -> a -> b
$ CardanoClient
-> Client Tx IO
-> BChan (TUIEvent Tx)
-> Event
-> EventM Text ActiveLink ()
handleVtyEventsActiveLink CardanoClient
cardanoClient Client Tx IO
hydraClient BChan (TUIEvent Tx)
chan Event
e

handleVtyEventsActiveLink :: CardanoClient -> Client Tx IO -> BChan (TUIEvent Tx) -> Vty.Event -> EventM Name ActiveLink ()
handleVtyEventsActiveLink :: CardanoClient
-> Client Tx IO
-> BChan (TUIEvent Tx)
-> Event
-> EventM Text ActiveLink ()
handleVtyEventsActiveLink CardanoClient
cardanoClient Client Tx IO
hydraClient BChan (TUIEvent Tx)
chan Event
e = do
  UTxO
utxo <- Getting UTxO ActiveLink UTxO -> EventM Text ActiveLink UTxO
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting UTxO ActiveLink UTxO
Lens' ActiveLink UTxO
utxoL
  [PendingIncrement]
pendingIncrements <- Getting [PendingIncrement] ActiveLink [PendingIncrement]
-> EventM Text ActiveLink [PendingIncrement]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [PendingIncrement] ActiveLink [PendingIncrement]
Lens' ActiveLink [PendingIncrement]
pendingIncrementsL
  LensLike'
  (Zoomed (EventM Text ActiveHeadState) ())
  ActiveLink
  ActiveHeadState
-> EventM Text ActiveHeadState () -> EventM Text ActiveLink ()
forall c.
LensLike'
  (Zoomed (EventM Text ActiveHeadState) c) ActiveLink ActiveHeadState
-> EventM Text ActiveHeadState c -> EventM Text ActiveLink c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (EventM Text ActiveHeadState) ())
  ActiveLink
  ActiveHeadState
(ActiveHeadState
 -> Focusing (StateT (EventState Text) IO) () ActiveHeadState)
-> ActiveLink
-> Focusing (StateT (EventState Text) IO) () ActiveLink
Lens' ActiveLink ActiveHeadState
activeHeadStateL (EventM Text ActiveHeadState () -> EventM Text ActiveLink ())
-> EventM Text ActiveHeadState () -> EventM Text ActiveLink ()
forall a b. (a -> b) -> a -> b
$ CardanoClient
-> Client Tx IO
-> BChan (TUIEvent Tx)
-> UTxO
-> [PendingIncrement]
-> Event
-> EventM Text ActiveHeadState ()
handleVtyEventsActiveHeadState CardanoClient
cardanoClient Client Tx IO
hydraClient BChan (TUIEvent Tx)
chan UTxO
utxo [PendingIncrement]
pendingIncrements Event
e

handleVtyEventsActiveHeadState :: CardanoClient -> Client Tx IO -> BChan (TUIEvent Tx) -> UTxO -> [PendingIncrement] -> Vty.Event -> EventM Name ActiveHeadState ()
handleVtyEventsActiveHeadState :: CardanoClient
-> Client Tx IO
-> BChan (TUIEvent Tx)
-> UTxO
-> [PendingIncrement]
-> Event
-> EventM Text ActiveHeadState ()
handleVtyEventsActiveHeadState CardanoClient
cardanoClient Client Tx IO
hydraClient BChan (TUIEvent Tx)
chan UTxO
utxo [PendingIncrement]
pendingIncrements Event
e = do
  LensLike'
  (Zoomed (EventM Text OpenScreen) ()) ActiveHeadState OpenScreen
-> EventM Text OpenScreen () -> EventM Text ActiveHeadState ()
forall c.
LensLike'
  (Zoomed (EventM Text OpenScreen) c) ActiveHeadState OpenScreen
-> EventM Text OpenScreen c -> EventM Text ActiveHeadState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (EventM Text OpenScreen) ()) ActiveHeadState OpenScreen
(OpenScreen
 -> Focusing (StateT (EventState Text) IO) () OpenScreen)
-> ActiveHeadState
-> Focusing (StateT (EventState Text) IO) () ActiveHeadState
Traversal' ActiveHeadState OpenScreen
openStateL (EventM Text OpenScreen () -> EventM Text ActiveHeadState ())
-> EventM Text OpenScreen () -> EventM Text ActiveHeadState ()
forall a b. (a -> b) -> a -> b
$ CardanoClient
-> Client Tx IO
-> BChan (TUIEvent Tx)
-> UTxO
-> [PendingIncrement]
-> Event
-> EventM Text OpenScreen ()
handleVtyEventsOpen CardanoClient
cardanoClient Client Tx IO
hydraClient BChan (TUIEvent Tx)
chan UTxO
utxo [PendingIncrement]
pendingIncrements Event
e
  ActiveHeadState
s <- Getting ActiveHeadState ActiveHeadState ActiveHeadState
-> EventM Text ActiveHeadState ActiveHeadState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ActiveHeadState ActiveHeadState ActiveHeadState
forall a. a -> a
id
  case ActiveHeadState
s of
    ActiveHeadState
FanoutPossible -> Client Tx IO -> Event -> EventM Text ActiveHeadState ()
forall s. Client Tx IO -> Event -> EventM Text s ()
handleVtyEventsFanoutPossible Client Tx IO
hydraClient Event
e
    -- Mid partial fanout: full 'Fanout' is no longer valid; only the 'P' partial
    -- fanout flow (handled in the outer event loop) applies here.
    FanningOut{} -> () -> EventM Text ActiveHeadState ()
forall a. a -> EventM Text ActiveHeadState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ActiveHeadState
Final -> Client Tx IO -> Event -> EventM Text ActiveHeadState ()
forall s. Client Tx IO -> Event -> EventM Text s ()
handleVtyEventsFinal Client Tx IO
hydraClient Event
e
    ActiveHeadState
_ -> () -> EventM Text ActiveHeadState ()
forall a. a -> EventM Text ActiveHeadState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

handleVtyEventsOpen :: CardanoClient -> Client Tx IO -> BChan (TUIEvent Tx) -> UTxO -> [PendingIncrement] -> Vty.Event -> EventM Name OpenScreen ()
handleVtyEventsOpen :: CardanoClient
-> Client Tx IO
-> BChan (TUIEvent Tx)
-> UTxO
-> [PendingIncrement]
-> Event
-> EventM Text OpenScreen ()
handleVtyEventsOpen CardanoClient
cardanoClient Client Tx IO
hydraClient BChan (TUIEvent Tx)
chan UTxO
utxo [PendingIncrement]
pendingIncrements Event
e =
  EventM Text OpenScreen OpenScreen
forall s (m :: * -> *). MonadState s m => m s
get EventM Text OpenScreen OpenScreen
-> (OpenScreen -> EventM Text OpenScreen ())
-> EventM Text OpenScreen ()
forall a b.
EventM Text OpenScreen a
-> (a -> EventM Text OpenScreen b) -> EventM Text OpenScreen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    OpenScreen
OpenHome -> do
      case Event
e of
        EvKey (KChar Char
'n') [] -> do
          let utxo' :: Map TxIn (TxOut CtxUTxO Era)
utxo' = NetworkId
-> VerificationKey PaymentKey
-> UTxO
-> Map TxIn (TxOut CtxUTxO Era)
myAvailableUTxO (CardanoClient -> NetworkId
networkId CardanoClient
cardanoClient) (Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey (Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey)
-> Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall a b. (a -> b) -> a -> b
$ Client Tx IO -> Secret (SigningKey PaymentKey)
forall tx (m :: * -> *).
Client tx m -> Secret (SigningKey PaymentKey)
sk Client Tx IO
hydraClient) UTxO
utxo
          case Map TxIn (TxOut CtxUTxO Era)
-> Maybe (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
forall s e n.
(s ~ (TxIn, TxOut CtxUTxO Era), n ~ Text) =>
Map TxIn (TxOut CtxUTxO Era) -> Maybe (Form s e n)
utxoRadioField Map TxIn (TxOut CtxUTxO Era)
utxo' of
            Just Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
form -> OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text -> OpenScreen
SelectingUTxO Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
form)
            Maybe (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
Nothing -> IO () -> EventM Text OpenScreen ()
forall a. IO a -> EventM Text OpenScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text OpenScreen ())
-> IO () -> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BChan (TUIEvent Tx) -> TUIEvent Tx -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (TUIEvent Tx)
chan (Text -> TUIEvent Tx
forall tx. Text -> TUIEvent tx
TxBuildError Text
"No UTxO available to send from.")
        EvKey (KChar Char
'd') [] -> do
          let utxo' :: Map TxIn (TxOut CtxUTxO Era)
utxo' = NetworkId
-> VerificationKey PaymentKey
-> UTxO
-> Map TxIn (TxOut CtxUTxO Era)
myAvailableUTxO (CardanoClient -> NetworkId
networkId CardanoClient
cardanoClient) (Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey (Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey)
-> Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall a b. (a -> b) -> a -> b
$ Client Tx IO -> Secret (SigningKey PaymentKey)
forall tx (m :: * -> *).
Client tx m -> Secret (SigningKey PaymentKey)
sk Client Tx IO
hydraClient) UTxO
utxo
          case Map TxIn (TxOut CtxUTxO Era)
-> Maybe (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
forall s e n.
(s ~ (TxIn, TxOut CtxUTxO Era), n ~ Text) =>
Map TxIn (TxOut CtxUTxO Era) -> Maybe (Form s e n)
utxoRadioField Map TxIn (TxOut CtxUTxO Era)
utxo' of
            Just Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
form -> OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text -> OpenScreen
SelectingUTxOToDecommit Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
form)
            Maybe (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
Nothing -> IO () -> EventM Text OpenScreen ()
forall a. IO a -> EventM Text OpenScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text OpenScreen ())
-> IO () -> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BChan (TUIEvent Tx) -> TUIEvent Tx -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (TUIEvent Tx)
chan (Text -> TUIEvent Tx
forall tx. Text -> TUIEvent tx
TxBuildError Text
"No L2 UTxO available to decommit.")
        -- 'i' (increment) is handled at the outer event loop so it can read the
        -- cached L1 UTxO from 'RootState' (see 'EvKey (KChar 'i')' in handleEvent).
        -- 'r' (recover) is handled at the outer event loop as a top-level
        -- modal flow (see 'EvKey (KChar 'r')' in handleEvent), not as an
        -- 'OpenScreen' transition.
        EvKey (KChar Char
'c') [] ->
          OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (OpenScreen -> EventM Text OpenScreen ())
-> OpenScreen -> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ Form Bool (HydraEvent Tx) Text -> OpenScreen
ConfirmingClose Form Bool (HydraEvent Tx) Text
forall s e n. (s ~ Bool, n ~ Text) => Form s e n
confirmRadioField
        Event
_ -> () -> EventM Text OpenScreen ()
forall a. a -> EventM Text OpenScreen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    OpenScreen
LoadingUTxOForIncrement ->
      case Event
e of
        EvKey Key
KEsc [] -> OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
        Event
_ -> () -> EventM Text OpenScreen ()
forall a. a -> EventM Text OpenScreen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    OpenScreen
NoUTxOToIncrement ->
      case Event
e of
        EvKey Key
KEsc [] -> OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
        EvKey (KChar Char
'u') [] -> EventM Text OpenScreen ()
refreshUTxOForIncrement
        Event
_ -> () -> EventM Text OpenScreen ()
forall a. a -> EventM Text OpenScreen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ConfirmingClose Form Bool (HydraEvent Tx) Text
i ->
      case Event
e of
        EvKey Key
KEsc [] -> OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
        EvKey Key
KEnter [] -> do
          let selected :: Bool
selected = Form Bool (HydraEvent Tx) Text -> Bool
forall s e n. Form s e n -> s
formState Form Bool (HydraEvent Tx) Text
i
          if Bool
selected
            then do
              IO () -> EventM Text OpenScreen ()
forall a. IO a -> EventM Text OpenScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text OpenScreen ())
-> IO () -> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ Client Tx IO -> ClientInput Tx -> IO ()
forall tx (m :: * -> *). Client tx m -> ClientInput tx -> m ()
sendInput Client Tx IO
hydraClient ClientInput Tx
forall tx. ClientInput tx
Close
              OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
            else OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
        Event
_ -> LensLike'
  (Zoomed (EventM Text (Form Bool (HydraEvent Tx) Text)) ())
  OpenScreen
  (Form Bool (HydraEvent Tx) Text)
-> EventM Text (Form Bool (HydraEvent Tx) Text) ()
-> EventM Text OpenScreen ()
forall c.
LensLike'
  (Zoomed (EventM Text (Form Bool (HydraEvent Tx) Text)) c)
  OpenScreen
  (Form Bool (HydraEvent Tx) Text)
-> EventM Text (Form Bool (HydraEvent Tx) Text) c
-> EventM Text OpenScreen c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (EventM Text (Form Bool (HydraEvent Tx) Text)) ())
  OpenScreen
  (Form Bool (HydraEvent Tx) Text)
(Form Bool (HydraEvent Tx) Text
 -> Focusing
      (StateT (EventState Text) IO) () (Form Bool (HydraEvent Tx) Text))
-> OpenScreen
-> Focusing (StateT (EventState Text) IO) () OpenScreen
Traversal' OpenScreen (Form Bool (HydraEvent Tx) Text)
confirmingCloseFormL (EventM Text (Form Bool (HydraEvent Tx) Text) ()
 -> EventM Text OpenScreen ())
-> EventM Text (Form Bool (HydraEvent Tx) Text) ()
-> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Text (HydraEvent Tx)
-> EventM Text (Form Bool (HydraEvent Tx) Text) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (Event -> BrickEvent Text (HydraEvent Tx)
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
    SelectingUTxO Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
i ->
      case Event
e of
        EvKey Key
KEsc [] -> OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
        EvKey Key
KEnter [] -> do
          let utxoSelected :: (TxIn, TxOut CtxUTxO Era)
utxoSelected@(TxIn
_, TxOut{txOutValue :: forall ctx. TxOut ctx -> Value
txOutValue = Value
v}) = Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
-> (TxIn, TxOut CtxUTxO Era)
forall s e n. Form s e n -> s
formState Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
i
          let Coin Integer
lovelaceLimit = Value -> Coin
selectLovelace Value
v
          let limitAda :: Double
limitAda = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
lovelaceLimit Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1_000_000 :: Double
          let enteringAmountForm :: Form Double (HydraEvent Tx) Text
enteringAmountForm =
                let field :: Double -> FormFieldState Double (HydraEvent Tx) Text
field = Lens' Double Double
-> Text
-> (Double -> Bool)
-> Double
-> FormFieldState Double (HydraEvent Tx) Text
forall n a s e.
(Ord n, Show n, Read a, Show a) =>
Lens' s a -> n -> (a -> Bool) -> s -> FormFieldState s e n
editShowableFieldWithValidate (Double -> f Double) -> Double -> f Double
forall a. a -> a
Lens' Double Double
id Text
"amount (ADA)" (\Double
n -> Double
n Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
n Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
limitAda)
                 in [Double -> FormFieldState Double (HydraEvent Tx) Text]
-> Double -> Form Double (HydraEvent Tx) Text
forall s e n. [s -> FormFieldState s e n] -> s -> Form s e n
newForm [Double -> FormFieldState Double (HydraEvent Tx) Text
field] Double
limitAda
          OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put EnteringAmount{(TxIn, TxOut CtxUTxO Era)
utxoSelected :: (TxIn, TxOut CtxUTxO Era)
$sel:utxoSelected:OpenHome :: (TxIn, TxOut CtxUTxO Era)
utxoSelected, Form Double (HydraEvent Tx) Text
enteringAmountForm :: Form Double (HydraEvent Tx) Text
$sel:enteringAmountForm:OpenHome :: Form Double (HydraEvent Tx) Text
enteringAmountForm}
        Event
_ -> LensLike'
  (Zoomed
     (EventM Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text))
     ())
  OpenScreen
  (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
-> EventM
     Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text) ()
-> EventM Text OpenScreen ()
forall c.
LensLike'
  (Zoomed
     (EventM Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text))
     c)
  OpenScreen
  (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
-> EventM
     Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text) c
-> EventM Text OpenScreen c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (EventM Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text))
     ())
  OpenScreen
  (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
(Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
 -> Focusing
      (StateT (EventState Text) IO)
      ()
      (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text))
-> OpenScreen
-> Focusing (StateT (EventState Text) IO) () OpenScreen
Traversal'
  OpenScreen (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
selectingUTxOFormL (EventM
   Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text) ()
 -> EventM Text OpenScreen ())
-> EventM
     Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text) ()
-> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Text (HydraEvent Tx)
-> EventM
     Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (Event -> BrickEvent Text (HydraEvent Tx)
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
    SelectingUTxOToDecommit Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
i ->
      case Event
e of
        EvKey Key
KEsc [] -> OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
        EvKey Key
KEnter [] -> do
          let utxoSelected :: (TxIn, TxOut CtxUTxO Era)
utxoSelected@(TxIn
_, TxOut{txOutValue :: forall ctx. TxOut ctx -> Value
txOutValue = Value
v}) = Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
-> (TxIn, TxOut CtxUTxO Era)
forall s e n. Form s e n -> s
formState Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
i
          let recipient :: AddressInEra
recipient = forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress @Era (CardanoClient -> NetworkId
networkId CardanoClient
cardanoClient) (Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey (Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey)
-> Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall a b. (a -> b) -> a -> b
$ Client Tx IO -> Secret (SigningKey PaymentKey)
forall tx (m :: * -> *).
Client tx m -> Secret (SigningKey PaymentKey)
sk Client Tx IO
hydraClient)
          case (TxIn, TxOut CtxUTxO Era)
-> (AddressInEra, Value)
-> Secret (SigningKey PaymentKey)
-> Either TxBodyError Tx
mkSimpleTx (TxIn, TxOut CtxUTxO Era)
utxoSelected (AddressInEra
recipient, Value
v) (Client Tx IO -> Secret (SigningKey PaymentKey)
forall tx (m :: * -> *).
Client tx m -> Secret (SigningKey PaymentKey)
sk Client Tx IO
hydraClient) of
            Left TxBodyError
err -> IO () -> EventM Text OpenScreen ()
forall a. IO a -> EventM Text OpenScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text OpenScreen ())
-> IO () -> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BChan (TUIEvent Tx) -> TUIEvent Tx -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (TUIEvent Tx)
chan (Text -> TUIEvent Tx
forall tx. Text -> TUIEvent tx
TxBuildError (Text -> TUIEvent Tx) -> Text -> TUIEvent Tx
forall a b. (a -> b) -> a -> b
$ Text
"Could not build decommit transaction: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxBodyError -> Text
forall b a. (Show a, IsString b) => a -> b
show TxBodyError
err)
            Right Tx
tx -> do
              IO () -> EventM Text OpenScreen ()
forall a. IO a -> EventM Text OpenScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Client Tx IO -> ClientInput Tx -> IO ()
forall tx (m :: * -> *). Client tx m -> ClientInput tx -> m ()
sendInput Client Tx IO
hydraClient (Tx -> ClientInput Tx
forall tx. tx -> ClientInput tx
Decommit Tx
tx))
              OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
        Event
_ -> LensLike'
  (Zoomed
     (EventM Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text))
     ())
  OpenScreen
  (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
-> EventM
     Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text) ()
-> EventM Text OpenScreen ()
forall c.
LensLike'
  (Zoomed
     (EventM Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text))
     c)
  OpenScreen
  (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
-> EventM
     Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text) c
-> EventM Text OpenScreen c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (EventM Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text))
     ())
  OpenScreen
  (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
(Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
 -> Focusing
      (StateT (EventState Text) IO)
      ()
      (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text))
-> OpenScreen
-> Focusing (StateT (EventState Text) IO) () OpenScreen
Traversal'
  OpenScreen (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
selectingUTxOToDecommitFormL (EventM
   Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text) ()
 -> EventM Text OpenScreen ())
-> EventM
     Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text) ()
-> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Text (HydraEvent Tx)
-> EventM
     Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (Event -> BrickEvent Text (HydraEvent Tx)
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
    SelectingUTxOToIncrement Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
i -> do
      case Event
e of
        EvKey Key
KEsc [] -> OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
        EvKey Key
KEnter [] -> do
          let utxoSelected :: (TxIn, TxOut CtxUTxO Era)
utxoSelected = Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
-> (TxIn, TxOut CtxUTxO Era)
forall s e n. Form s e n -> s
formState Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
i
          let commitUTxO :: UTxO
commitUTxO = (TxIn -> TxOut CtxUTxO Era -> UTxO)
-> (TxIn, TxOut CtxUTxO Era) -> UTxO
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxIn -> TxOut CtxUTxO Era -> UTxO
forall era. TxIn -> TxOut CtxUTxO era -> UTxO era
UTxO.singleton (TxIn, TxOut CtxUTxO Era)
utxoSelected
          IO () -> EventM Text OpenScreen ()
forall a. IO a -> EventM Text OpenScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text OpenScreen ())
-> IO () -> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ Client Tx IO -> BChan (TUIEvent Tx) -> UTxO -> IO ()
externalCommitAsync Client Tx IO
hydraClient BChan (TUIEvent Tx)
chan UTxO
commitUTxO
          OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
        EvKey (KChar Char
'u') [] -> EventM Text OpenScreen ()
refreshUTxOForIncrement
        Event
_ -> LensLike'
  (Zoomed
     (EventM Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text))
     ())
  OpenScreen
  (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
-> EventM
     Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text) ()
-> EventM Text OpenScreen ()
forall c.
LensLike'
  (Zoomed
     (EventM Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text))
     c)
  OpenScreen
  (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
-> EventM
     Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text) c
-> EventM Text OpenScreen c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (EventM Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text))
     ())
  OpenScreen
  (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
(Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
 -> Focusing
      (StateT (EventState Text) IO)
      ()
      (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text))
-> OpenScreen
-> Focusing (StateT (EventState Text) IO) () OpenScreen
Traversal'
  OpenScreen (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text)
selectingUTxOToIncrementFormL (EventM
   Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text) ()
 -> EventM Text OpenScreen ())
-> EventM
     Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text) ()
-> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Text (HydraEvent Tx)
-> EventM
     Text (Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (Event -> BrickEvent Text (HydraEvent Tx)
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
    EnteringAmount (TxIn, TxOut CtxUTxO Era)
utxoSelected Form Double (HydraEvent Tx) Text
i ->
      case Event
e of
        EvKey Key
KEsc [] -> OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
        -- 'formState' keeps the last valid value when the field content fails
        -- validation, so a submit here would silently use a stale amount.
        EvKey Key
KEnter []
          | Bool -> Bool
not (Form Double (HydraEvent Tx) Text -> Bool
forall s e n. Form s e n -> Bool
allFieldsValid Form Double (HydraEvent Tx) Text
i) ->
              IO () -> EventM Text OpenScreen ()
forall a. IO a -> EventM Text OpenScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text OpenScreen ())
-> IO () -> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BChan (TUIEvent Tx) -> TUIEvent Tx -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (TUIEvent Tx)
chan (Text -> TUIEvent Tx
forall tx. Text -> TUIEvent tx
TxBuildError Text
"Invalid amount.")
        EvKey Key
KEnter [] -> do
          let
            field :: FormFieldRenderHelper SelectAddressItem Text
-> SelectAddressItem
-> FormFieldState SelectAddressItem (HydraEvent Tx) Text
field =
              Char
-> Char
-> Char
-> Lens' SelectAddressItem SelectAddressItem
-> [(SelectAddressItem, Text, Text)]
-> FormFieldRenderHelper SelectAddressItem Text
-> SelectAddressItem
-> FormFieldState SelectAddressItem (HydraEvent Tx) Text
forall n a s e.
(Ord n, Eq a) =>
Char
-> Char
-> Char
-> Lens' s a
-> [(a, n, Text)]
-> FormFieldRenderHelper a n
-> s
-> FormFieldState s e n
customRadioField Char
'[' Char
'X' Char
']' (SelectAddressItem -> f SelectAddressItem)
-> SelectAddressItem -> f SelectAddressItem
forall a. a -> a
Lens' SelectAddressItem SelectAddressItem
id ([(SelectAddressItem, Text, Text)]
 -> FormFieldRenderHelper SelectAddressItem Text
 -> SelectAddressItem
 -> FormFieldState SelectAddressItem (HydraEvent Tx) Text)
-> [(SelectAddressItem, Text, Text)]
-> FormFieldRenderHelper SelectAddressItem Text
-> SelectAddressItem
-> FormFieldState SelectAddressItem (HydraEvent Tx) Text
forall a b. (a -> b) -> a -> b
$
                [ (SelectAddressItem
u, SelectAddressItem -> Text
forall b a. (Show a, IsString b) => a -> b
show SelectAddressItem
u, Doc Any -> Text
forall b a. (Show a, IsString b) => a -> b
show (Doc Any -> Text) -> Doc Any -> Text
forall a b. (a -> b) -> a -> b
$ SelectAddressItem -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. SelectAddressItem -> Doc ann
pretty SelectAddressItem
u)
                | SelectAddressItem
u <- [SelectAddressItem] -> [SelectAddressItem]
forall a. Eq a => [a] -> [a]
nub ([SelectAddressItem] -> [SelectAddressItem])
-> [SelectAddressItem] -> [SelectAddressItem]
forall a b. (a -> b) -> a -> b
$ NonEmpty SelectAddressItem -> [SelectAddressItem]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty SelectAddressItem
addresses
                ]
            decorator :: FormFieldRenderHelper SelectAddressItem Text
decorator SelectAddressItem
a Text
_ Bool
_ =
              if SelectAddressItem
a SelectAddressItem -> SelectAddressItem -> Bool
forall a. Eq a => a -> a -> Bool
== AddressInEra -> SelectAddressItem
SelectAddress AddressInEra
ownAddress
                then AttrName -> Widget Text -> Widget Text
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
own
                else Widget Text -> Widget Text
forall a. a -> a
id
            addresses :: NonEmpty SelectAddressItem
addresses =
              SelectAddressItem
ManualEntry
                SelectAddressItem
-> [SelectAddressItem] -> NonEmpty SelectAddressItem
forall a. a -> [a] -> NonEmpty a
:| (AddressInEra -> SelectAddressItem
SelectAddress (AddressInEra -> SelectAddressItem)
-> (TxOut CtxUTxO Era -> AddressInEra)
-> TxOut CtxUTxO Era
-> SelectAddressItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxUTxO Era -> AddressInEra
forall ctx. TxOut ctx -> AddressInEra
txOutAddress (TxOut CtxUTxO Era -> SelectAddressItem)
-> [TxOut CtxUTxO Era] -> [SelectAddressItem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxO -> [TxOut CtxUTxO Era]
forall era. UTxO era -> [TxOut CtxUTxO era]
UTxO.txOutputs UTxO
utxo)
          OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
            SelectingRecipient
              { (TxIn, TxOut CtxUTxO Era)
$sel:utxoSelected:OpenHome :: (TxIn, TxOut CtxUTxO Era)
utxoSelected :: (TxIn, TxOut CtxUTxO Era)
utxoSelected
              , $sel:amountEntered:OpenHome :: Double
amountEntered = Form Double (HydraEvent Tx) Text -> Double
forall s e n. Form s e n -> s
formState Form Double (HydraEvent Tx) Text
i
              , $sel:selectingRecipientForm:OpenHome :: Form SelectAddressItem (HydraEvent Tx) Text
selectingRecipientForm = [SelectAddressItem
 -> FormFieldState SelectAddressItem (HydraEvent Tx) Text]
-> SelectAddressItem -> Form SelectAddressItem (HydraEvent Tx) Text
forall s e n. [s -> FormFieldState s e n] -> s -> Form s e n
newForm [FormFieldRenderHelper SelectAddressItem Text
-> SelectAddressItem
-> FormFieldState SelectAddressItem (HydraEvent Tx) Text
field FormFieldRenderHelper SelectAddressItem Text
decorator] SelectAddressItem
ManualEntry
              }
        Event
_ -> LensLike'
  (Zoomed (EventM Text (Form Double (HydraEvent Tx) Text)) ())
  OpenScreen
  (Form Double (HydraEvent Tx) Text)
-> EventM Text (Form Double (HydraEvent Tx) Text) ()
-> EventM Text OpenScreen ()
forall c.
LensLike'
  (Zoomed (EventM Text (Form Double (HydraEvent Tx) Text)) c)
  OpenScreen
  (Form Double (HydraEvent Tx) Text)
-> EventM Text (Form Double (HydraEvent Tx) Text) c
-> EventM Text OpenScreen c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (EventM Text (Form Double (HydraEvent Tx) Text)) ())
  OpenScreen
  (Form Double (HydraEvent Tx) Text)
(Form Double (HydraEvent Tx) Text
 -> Focusing
      (StateT (EventState Text) IO)
      ()
      (Form Double (HydraEvent Tx) Text))
-> OpenScreen
-> Focusing (StateT (EventState Text) IO) () OpenScreen
Traversal' OpenScreen (Form Double (HydraEvent Tx) Text)
enteringAmountFormL (EventM Text (Form Double (HydraEvent Tx) Text) ()
 -> EventM Text OpenScreen ())
-> EventM Text (Form Double (HydraEvent Tx) Text) ()
-> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Text (HydraEvent Tx)
-> EventM Text (Form Double (HydraEvent Tx) Text) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (Event -> BrickEvent Text (HydraEvent Tx)
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
    SelectingRecipient (TxIn, TxOut CtxUTxO Era)
utxoSelected Double
amountEntered Form SelectAddressItem (HydraEvent Tx) Text
i ->
      case Event
e of
        EvKey Key
KEsc [] -> OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
        EvKey Key
KEnter [] -> do
          case Form SelectAddressItem (HydraEvent Tx) Text -> SelectAddressItem
forall s e n. Form s e n -> s
formState Form SelectAddressItem (HydraEvent Tx) Text
i of
            SelectAddress AddressInEra
recipient -> do
              let Coin Integer
lovelaceLimit = Value -> Coin
selectLovelace (TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue ((TxIn, TxOut CtxUTxO Era) -> TxOut CtxUTxO Era
forall a b. (a, b) -> b
snd (TxIn, TxOut CtxUTxO Era)
utxoSelected))
              let lovelaceAmount :: Integer
lovelaceAmount = Double -> Integer -> Integer
adaToLovelace Double
amountEntered Integer
lovelaceLimit
              case (TxIn, TxOut CtxUTxO Era)
-> (AddressInEra, Value)
-> Secret (SigningKey PaymentKey)
-> Either TxBodyError Tx
mkSimpleTx (TxIn, TxOut CtxUTxO Era)
utxoSelected (AddressInEra
recipient, Coin -> Value
lovelaceToValue (Coin -> Value) -> Coin -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
lovelaceAmount) (Client Tx IO -> Secret (SigningKey PaymentKey)
forall tx (m :: * -> *).
Client tx m -> Secret (SigningKey PaymentKey)
sk Client Tx IO
hydraClient) of
                Left TxBodyError
err -> IO () -> EventM Text OpenScreen ()
forall a. IO a -> EventM Text OpenScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text OpenScreen ())
-> IO () -> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BChan (TUIEvent Tx) -> TUIEvent Tx -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (TUIEvent Tx)
chan (Text -> TUIEvent Tx
forall tx. Text -> TUIEvent tx
TxBuildError (Text -> TUIEvent Tx) -> Text -> TUIEvent Tx
forall a b. (a -> b) -> a -> b
$ Text
"Could not build transaction: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxBodyError -> Text
forall b a. (Show a, IsString b) => a -> b
show TxBodyError
err)
                Right Tx
tx -> do
                  IO () -> EventM Text OpenScreen ()
forall a. IO a -> EventM Text OpenScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Client Tx IO -> ClientInput Tx -> IO ()
forall tx (m :: * -> *). Client tx m -> ClientInput tx -> m ()
sendInput Client Tx IO
hydraClient (Tx -> ClientInput Tx
forall tx. tx -> ClientInput tx
NewTx Tx
tx))
                  OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
            SelectAddressItem
ManualEntry ->
              OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (OpenScreen -> EventM Text OpenScreen ())
-> OpenScreen -> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$
                EnteringRecipientAddress
                  { (TxIn, TxOut CtxUTxO Era)
$sel:utxoSelected:OpenHome :: (TxIn, TxOut CtxUTxO Era)
utxoSelected :: (TxIn, TxOut CtxUTxO Era)
utxoSelected
                  , Double
$sel:amountEntered:OpenHome :: Double
amountEntered :: Double
amountEntered
                  , $sel:enteringRecipientAddressForm:OpenHome :: Form AddressInEra (HydraEvent Tx) Text
enteringRecipientAddressForm =
                      [AddressInEra -> FormFieldState AddressInEra (HydraEvent Tx) Text]
-> AddressInEra -> Form AddressInEra (HydraEvent Tx) Text
forall s e n. [s -> FormFieldState s e n] -> s -> Form s e n
newForm
                        [ Lens' AddressInEra AddressInEra
-> Text
-> Maybe Int
-> (AddressInEra -> Text)
-> ([Text] -> Maybe AddressInEra)
-> ([Text] -> Widget Text)
-> (Widget Text -> Widget Text)
-> AddressInEra
-> FormFieldState AddressInEra (HydraEvent Tx) Text
forall n s a e.
(Ord n, Show n) =>
Lens' s a
-> n
-> Maybe Int
-> (a -> Text)
-> ([Text] -> Maybe a)
-> ([Text] -> Widget n)
-> (Widget n -> Widget n)
-> s
-> FormFieldState s e n
editField
                            (AddressInEra -> f AddressInEra) -> AddressInEra -> f AddressInEra
forall a. a -> a
Lens' AddressInEra AddressInEra
id
                            Text
"manual address entry"
                            (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
                            AddressInEra -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress
                            ([Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Text] -> Maybe (NonEmpty Text))
-> (NonEmpty Text -> Maybe AddressInEra)
-> [Text]
-> Maybe AddressInEra
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Maybe AddressInEra
parseAddress (Text -> Maybe AddressInEra)
-> (NonEmpty Text -> Text) -> NonEmpty Text -> Maybe AddressInEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> Text
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head)
                            (Text -> Widget Text
forall n. Text -> Widget n
txt (Text -> Widget Text) -> ([Text] -> Text) -> [Text] -> Widget Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold)
                            Widget Text -> Widget Text
forall a. a -> a
id
                        ]
                        AddressInEra
ownAddress
                  }
        Event
_ -> LensLike'
  (Zoomed
     (EventM Text (Form SelectAddressItem (HydraEvent Tx) Text)) ())
  OpenScreen
  (Form SelectAddressItem (HydraEvent Tx) Text)
-> EventM Text (Form SelectAddressItem (HydraEvent Tx) Text) ()
-> EventM Text OpenScreen ()
forall c.
LensLike'
  (Zoomed
     (EventM Text (Form SelectAddressItem (HydraEvent Tx) Text)) c)
  OpenScreen
  (Form SelectAddressItem (HydraEvent Tx) Text)
-> EventM Text (Form SelectAddressItem (HydraEvent Tx) Text) c
-> EventM Text OpenScreen c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (EventM Text (Form SelectAddressItem (HydraEvent Tx) Text)) ())
  OpenScreen
  (Form SelectAddressItem (HydraEvent Tx) Text)
(Form SelectAddressItem (HydraEvent Tx) Text
 -> Focusing
      (StateT (EventState Text) IO)
      ()
      (Form SelectAddressItem (HydraEvent Tx) Text))
-> OpenScreen
-> Focusing (StateT (EventState Text) IO) () OpenScreen
Traversal' OpenScreen (Form SelectAddressItem (HydraEvent Tx) Text)
selectingRecipientFormL (EventM Text (Form SelectAddressItem (HydraEvent Tx) Text) ()
 -> EventM Text OpenScreen ())
-> EventM Text (Form SelectAddressItem (HydraEvent Tx) Text) ()
-> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Text (HydraEvent Tx)
-> EventM Text (Form SelectAddressItem (HydraEvent Tx) Text) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (Event -> BrickEvent Text (HydraEvent Tx)
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
    EnteringRecipientAddress (TxIn, TxOut CtxUTxO Era)
utxoSelected Double
amountEntered Form AddressInEra (HydraEvent Tx) Text
i ->
      case Event
e of
        EvKey Key
KEsc [] -> OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
        -- Same as the amount screen: an unparsable address leaves 'formState'
        -- at the last valid value (initially the own address), so submitting
        -- would silently send the funds there instead of erroring.
        EvKey Key
KEnter []
          | Bool -> Bool
not (Form AddressInEra (HydraEvent Tx) Text -> Bool
forall s e n. Form s e n -> Bool
allFieldsValid Form AddressInEra (HydraEvent Tx) Text
i) ->
              IO () -> EventM Text OpenScreen ()
forall a. IO a -> EventM Text OpenScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text OpenScreen ())
-> IO () -> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BChan (TUIEvent Tx) -> TUIEvent Tx -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (TUIEvent Tx)
chan (Text -> TUIEvent Tx
forall tx. Text -> TUIEvent tx
TxBuildError Text
"Invalid address.")
        EvKey Key
KEnter [] -> do
          let recipient :: AddressInEra
recipient = Form AddressInEra (HydraEvent Tx) Text -> AddressInEra
forall s e n. Form s e n -> s
formState Form AddressInEra (HydraEvent Tx) Text
i
          let Coin Integer
lovelaceLimit = Value -> Coin
selectLovelace (TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue ((TxIn, TxOut CtxUTxO Era) -> TxOut CtxUTxO Era
forall a b. (a, b) -> b
snd (TxIn, TxOut CtxUTxO Era)
utxoSelected))
          let lovelaceAmount :: Integer
lovelaceAmount = Double -> Integer -> Integer
adaToLovelace Double
amountEntered Integer
lovelaceLimit
          case (TxIn, TxOut CtxUTxO Era)
-> (AddressInEra, Value)
-> Secret (SigningKey PaymentKey)
-> Either TxBodyError Tx
mkSimpleTx (TxIn, TxOut CtxUTxO Era)
utxoSelected (AddressInEra
recipient, Coin -> Value
lovelaceToValue (Coin -> Value) -> Coin -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
lovelaceAmount) (Client Tx IO -> Secret (SigningKey PaymentKey)
forall tx (m :: * -> *).
Client tx m -> Secret (SigningKey PaymentKey)
sk Client Tx IO
hydraClient) of
            Left TxBodyError
err -> IO () -> EventM Text OpenScreen ()
forall a. IO a -> EventM Text OpenScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text OpenScreen ())
-> IO () -> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BChan (TUIEvent Tx) -> TUIEvent Tx -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (TUIEvent Tx)
chan (Text -> TUIEvent Tx
forall tx. Text -> TUIEvent tx
TxBuildError (Text -> TUIEvent Tx) -> Text -> TUIEvent Tx
forall a b. (a -> b) -> a -> b
$ Text
"Could not build transaction: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxBodyError -> Text
forall b a. (Show a, IsString b) => a -> b
show TxBodyError
err)
            Right Tx
tx -> do
              IO () -> EventM Text OpenScreen ()
forall a. IO a -> EventM Text OpenScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Client Tx IO -> ClientInput Tx -> IO ()
forall tx (m :: * -> *). Client tx m -> ClientInput tx -> m ()
sendInput Client Tx IO
hydraClient (Tx -> ClientInput Tx
forall tx. tx -> ClientInput tx
NewTx Tx
tx))
              OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
OpenHome
        Event
_ -> LensLike'
  (Zoomed (EventM Text (Form AddressInEra (HydraEvent Tx) Text)) ())
  OpenScreen
  (Form AddressInEra (HydraEvent Tx) Text)
-> EventM Text (Form AddressInEra (HydraEvent Tx) Text) ()
-> EventM Text OpenScreen ()
forall c.
LensLike'
  (Zoomed (EventM Text (Form AddressInEra (HydraEvent Tx) Text)) c)
  OpenScreen
  (Form AddressInEra (HydraEvent Tx) Text)
-> EventM Text (Form AddressInEra (HydraEvent Tx) Text) c
-> EventM Text OpenScreen c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (EventM Text (Form AddressInEra (HydraEvent Tx) Text)) ())
  OpenScreen
  (Form AddressInEra (HydraEvent Tx) Text)
(Form AddressInEra (HydraEvent Tx) Text
 -> Focusing
      (StateT (EventState Text) IO)
      ()
      (Form AddressInEra (HydraEvent Tx) Text))
-> OpenScreen
-> Focusing (StateT (EventState Text) IO) () OpenScreen
Traversal' OpenScreen (Form AddressInEra (HydraEvent Tx) Text)
enteringRecipientAddressFormL (EventM Text (Form AddressInEra (HydraEvent Tx) Text) ()
 -> EventM Text OpenScreen ())
-> EventM Text (Form AddressInEra (HydraEvent Tx) Text) ()
-> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Text (HydraEvent Tx)
-> EventM Text (Form AddressInEra (HydraEvent Tx) Text) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (Event -> BrickEvent Text (HydraEvent Tx)
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
 where
  ownAddress :: AddressInEra
ownAddress = forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress @Era (CardanoClient -> NetworkId
networkId CardanoClient
cardanoClient) (Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey (Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey)
-> Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall a b. (a -> b) -> a -> b
$ Client Tx IO -> Secret (SigningKey PaymentKey)
forall tx (m :: * -> *).
Client tx m -> Secret (SigningKey PaymentKey)
sk Client Tx IO
hydraClient)

  parseAddress :: Text -> Maybe AddressInEra
parseAddress =
    (Address ShelleyAddr -> AddressInEra)
-> Maybe (Address ShelleyAddr) -> Maybe AddressInEra
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Address ShelleyAddr -> AddressInEra
ShelleyAddressInEra (Maybe (Address ShelleyAddr) -> Maybe AddressInEra)
-> (Text -> Maybe (Address ShelleyAddr))
-> Text
-> Maybe AddressInEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType (Address ShelleyAddr) -> Text -> Maybe (Address ShelleyAddr)
forall addr.
SerialiseAddress addr =>
AsType addr -> Text -> Maybe addr
deserialiseAddress (AsType ShelleyAddr -> AsType (Address ShelleyAddr)
forall addrtype. AsType addrtype -> AsType (Address addrtype)
AsAddress AsType ShelleyAddr
AsShelleyAddr)

  -- Re-query the L1 UTxO for the increment modal, showing the loading spinner
  -- meanwhile. The result is delivered as a 'UTxOQueryResult' event, which
  -- rebuilds the selection form (or 'NoUTxOToIncrement' when still empty).
  refreshUTxOForIncrement :: EventM Text OpenScreen ()
refreshUTxOForIncrement = do
    OpenScreen -> EventM Text OpenScreen ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put OpenScreen
LoadingUTxOForIncrement
    let myAddr :: Address ShelleyAddr
myAddr = CardanoClient -> Client Tx IO -> Address ShelleyAddr
mkMyAddress CardanoClient
cardanoClient Client Tx IO
hydraClient
    IO () -> EventM Text OpenScreen ()
forall a. IO a -> EventM Text OpenScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text OpenScreen ())
-> IO () -> EventM Text OpenScreen ()
forall a b. (a -> b) -> a -> b
$ CardanoClient
-> Address ShelleyAddr
-> BChan (TUIEvent Tx)
-> (Map TxIn (TxOut CtxUTxO Era) -> TUIEvent Tx)
-> Text
-> IO ()
queryL1UTxOAsync CardanoClient
cardanoClient Address ShelleyAddr
myAddr BChan (TUIEvent Tx)
chan Map TxIn (TxOut CtxUTxO Era) -> TUIEvent Tx
forall tx. Map TxIn (TxOut CtxUTxO Era) -> TUIEvent tx
UTxOQueryResult Text
"L1 UTxO query failed"

handleVtyEventsFanoutPossible :: Client Tx IO -> Vty.Event -> EventM Name s ()
handleVtyEventsFanoutPossible :: forall s. Client Tx IO -> Event -> EventM Text s ()
handleVtyEventsFanoutPossible Client Tx IO
hydraClient Event
e = do
  case Event
e of
    EvKey (KChar Char
'f') [] ->
      IO () -> EventM Text s ()
forall a. IO a -> EventM Text s a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Client Tx IO -> ClientInput Tx -> IO ()
forall tx (m :: * -> *). Client tx m -> ClientInput tx -> m ()
sendInput Client Tx IO
hydraClient ClientInput Tx
forall tx. ClientInput tx
Fanout)
    Event
_ -> () -> EventM Text s ()
forall a. a -> EventM Text s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

handleVtyEventsFinal :: Client Tx IO -> Vty.Event -> EventM Name s ()
handleVtyEventsFinal :: forall s. Client Tx IO -> Event -> EventM Text s ()
handleVtyEventsFinal Client Tx IO
hydraClient Event
e = do
  case Event
e of
    EvKey (KChar Char
'i') [] ->
      IO () -> EventM Text s ()
forall a. IO a -> EventM Text s a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Client Tx IO -> ClientInput Tx -> IO ()
forall tx (m :: * -> *). Client tx m -> ClientInput tx -> m ()
sendInput Client Tx IO
hydraClient ClientInput Tx
forall tx. ClientInput tx
Init)
    Event
_ -> () -> EventM Text s ()
forall a. a -> EventM Text s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

handleVtyEventsScrollable :: Vty.Event -> EventM Name RootState ()
handleVtyEventsScrollable :: Event -> EventM Text RootState ()
handleVtyEventsScrollable Event
e = do
  ActiveTab
tab <- Getting ActiveTab RootState ActiveTab
-> EventM Text RootState ActiveTab
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ActiveTab RootState ActiveTab
Lens' RootState ActiveTab
activeTabL
  case ActiveTab
tab of
    ActiveTab
EventHistoryTab -> case Event
e of
      EvKey Key
KPageUp [] -> ViewportScroll Text -> forall s. Int -> EventM Text s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (Text -> ViewportScroll Text
forall n. n -> ViewportScroll n
viewportScroll Text
"event-detail") (-Int
10)
      EvKey Key
KPageDown [] -> ViewportScroll Text -> forall s. Int -> EventM Text s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (Text -> ViewportScroll Text
forall n. n -> ViewportScroll n
viewportScroll Text
"event-detail") Int
10
      Vty.EvMouseDown Int
_ Int
_ Button
Vty.BScrollUp [Modifier]
_ ->
        LensLike'
  (Zoomed (EventM Text (GenericList Text Vector LogMessage)) ())
  RootState
  (GenericList Text Vector LogMessage)
-> EventM Text (GenericList Text Vector LogMessage) ()
-> EventM Text RootState ()
forall c.
LensLike'
  (Zoomed (EventM Text (GenericList Text Vector LogMessage)) c)
  RootState
  (GenericList Text Vector LogMessage)
-> EventM Text (GenericList Text Vector LogMessage) c
-> EventM Text RootState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (EventM Text (GenericList Text Vector LogMessage)) ())
  RootState
  (GenericList Text Vector LogMessage)
(GenericList Text Vector LogMessage
 -> Focusing
      (StateT (EventState Text) IO)
      ()
      (GenericList Text Vector LogMessage))
-> RootState -> Focusing (StateT (EventState Text) IO) () RootState
Lens' RootState (GenericList Text Vector LogMessage)
eventHistoryListL (EventM Text (GenericList Text Vector LogMessage) ()
 -> EventM Text RootState ())
-> EventM Text (GenericList Text Vector LogMessage) ()
-> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ Event -> EventM Text (GenericList Text Vector LogMessage) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
BrickList.handleListEvent (Key -> [Modifier] -> Event
EvKey Key
KUp [])
      Vty.EvMouseDown Int
_ Int
_ Button
Vty.BScrollDown [Modifier]
_ ->
        LensLike'
  (Zoomed (EventM Text (GenericList Text Vector LogMessage)) ())
  RootState
  (GenericList Text Vector LogMessage)
-> EventM Text (GenericList Text Vector LogMessage) ()
-> EventM Text RootState ()
forall c.
LensLike'
  (Zoomed (EventM Text (GenericList Text Vector LogMessage)) c)
  RootState
  (GenericList Text Vector LogMessage)
-> EventM Text (GenericList Text Vector LogMessage) c
-> EventM Text RootState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (EventM Text (GenericList Text Vector LogMessage)) ())
  RootState
  (GenericList Text Vector LogMessage)
(GenericList Text Vector LogMessage
 -> Focusing
      (StateT (EventState Text) IO)
      ()
      (GenericList Text Vector LogMessage))
-> RootState -> Focusing (StateT (EventState Text) IO) () RootState
Lens' RootState (GenericList Text Vector LogMessage)
eventHistoryListL (EventM Text (GenericList Text Vector LogMessage) ()
 -> EventM Text RootState ())
-> EventM Text (GenericList Text Vector LogMessage) ()
-> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ Event -> EventM Text (GenericList Text Vector LogMessage) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
BrickList.handleListEvent (Key -> [Modifier] -> Event
EvKey Key
KDown [])
      Event
_ -> LensLike'
  (Zoomed (EventM Text (GenericList Text Vector LogMessage)) ())
  RootState
  (GenericList Text Vector LogMessage)
-> EventM Text (GenericList Text Vector LogMessage) ()
-> EventM Text RootState ()
forall c.
LensLike'
  (Zoomed (EventM Text (GenericList Text Vector LogMessage)) c)
  RootState
  (GenericList Text Vector LogMessage)
-> EventM Text (GenericList Text Vector LogMessage) c
-> EventM Text RootState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (EventM Text (GenericList Text Vector LogMessage)) ())
  RootState
  (GenericList Text Vector LogMessage)
(GenericList Text Vector LogMessage
 -> Focusing
      (StateT (EventState Text) IO)
      ()
      (GenericList Text Vector LogMessage))
-> RootState -> Focusing (StateT (EventState Text) IO) () RootState
Lens' RootState (GenericList Text Vector LogMessage)
eventHistoryListL (EventM Text (GenericList Text Vector LogMessage) ()
 -> EventM Text RootState ())
-> EventM Text (GenericList Text Vector LogMessage) ()
-> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ Event -> EventM Text (GenericList Text Vector LogMessage) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
BrickList.handleListEvent Event
e
    ActiveTab
MainTab -> case Event
e of
      EvKey Key
KPageUp [] -> ViewportScroll Text -> forall s. Int -> EventM Text s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (Text -> ViewportScroll Text
forall n. n -> ViewportScroll n
viewportScroll Text
mainUTxOViewportName) (-Int
10)
      EvKey Key
KPageDown [] -> ViewportScroll Text -> forall s. Int -> EventM Text s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (Text -> ViewportScroll Text
forall n. n -> ViewportScroll n
viewportScroll Text
mainUTxOViewportName) Int
10
      Event
_ -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ActiveTab
FundsTab -> case Event
e of
      EvKey Key
KPageUp [] -> ViewportScroll Text -> forall s. Int -> EventM Text s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (Text -> ViewportScroll Text
forall n. n -> ViewportScroll n
viewportScroll Text
fundsL2ViewportName) (-Int
10)
      EvKey Key
KPageDown [] -> ViewportScroll Text -> forall s. Int -> EventM Text s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (Text -> ViewportScroll Text
forall n. n -> ViewportScroll n
viewportScroll Text
fundsL2ViewportName) Int
10
      Event
_ -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ActiveTab
_ -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

syncEventHistoryList :: EventM Name RootState ()
syncEventHistoryList :: EventM Text RootState ()
syncEventHistoryList = do
  [LogMessage]
msgs <- Getting [LogMessage] RootState [LogMessage]
-> EventM Text RootState [LogMessage]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((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)
  EventHistoryFilter
flt <- Getting EventHistoryFilter RootState EventHistoryFilter
-> EventM Text RootState EventHistoryFilter
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting EventHistoryFilter RootState EventHistoryFilter
Lens' RootState EventHistoryFilter
eventHistoryFilterL
  let filteredMsgs :: [LogMessage]
filteredMsgs = EventHistoryFilter -> [LogMessage] -> [LogMessage]
applyEventHistoryFilter EventHistoryFilter
flt [LogMessage]
msgs
  (GenericList Text Vector LogMessage
 -> Identity (GenericList Text Vector LogMessage))
-> RootState -> Identity RootState
Lens' RootState (GenericList Text Vector LogMessage)
eventHistoryListL ((GenericList Text Vector LogMessage
  -> Identity (GenericList Text Vector LogMessage))
 -> RootState -> Identity RootState)
-> (GenericList Text Vector LogMessage
    -> GenericList Text Vector LogMessage)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \GenericList Text Vector LogMessage
l ->
    let oldLen :: Int
oldLen = Vector LogMessage -> Int
forall a. Vector a -> Int
Vec.length (GenericList Text Vector LogMessage -> Vector LogMessage
forall n (t :: * -> *) e. GenericList n t e -> t e
BrickList.listElements GenericList Text Vector LogMessage
l)
        newVec :: Vector LogMessage
newVec = [LogMessage] -> Vector LogMessage
forall a. [a] -> Vector a
Vec.fromList [LogMessage]
filteredMsgs
        newLen :: Int
newLen = Vector LogMessage -> Int
forall a. Vector a -> Int
Vec.length Vector LogMessage
newVec
        added :: Int
added = Int
newLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
oldLen
        newList :: GenericList Text Vector LogMessage
newList = Vector LogMessage
-> Maybe Int
-> GenericList Text Vector LogMessage
-> GenericList Text Vector LogMessage
forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
t e -> Maybe Int -> GenericList n t e -> GenericList n t e
BrickList.listReplace Vector LogMessage
newVec (GenericList Text Vector LogMessage -> Maybe Int
forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
BrickList.listSelected GenericList Text Vector LogMessage
l) GenericList Text Vector LogMessage
l
     in if Int
added Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
          then Int
-> GenericList Text Vector LogMessage
-> GenericList Text Vector LogMessage
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BrickList.listMoveTo (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
added) (GenericList Text Vector LogMessage -> Maybe Int
forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
BrickList.listSelected GenericList Text Vector LogMessage
l)) GenericList Text Vector LogMessage
newList
          else GenericList Text Vector LogMessage
newList

applyEventHistoryFilter :: EventHistoryFilter -> [LogMessage] -> [LogMessage]
applyEventHistoryFilter :: EventHistoryFilter -> [LogMessage] -> [LogMessage]
applyEventHistoryFilter = \case
  EventHistoryFilter
ShowAll -> [LogMessage] -> [LogMessage]
forall a. a -> a
id
  EventHistoryFilter
ErrorsOnly -> (LogMessage -> Bool) -> [LogMessage] -> [LogMessage]
forall a. (a -> Bool) -> [a] -> [a]
filter (\LogMessage{Severity
severity :: Severity
severity :: LogMessage -> Severity
severity} -> Severity
severity Severity -> Severity -> Bool
forall a. Eq a => a -> a -> Bool
== Severity
Error)

toggleEventHistoryFilter :: EventHistoryFilter -> EventHistoryFilter
toggleEventHistoryFilter :: EventHistoryFilter -> EventHistoryFilter
toggleEventHistoryFilter = \case
  EventHistoryFilter
ShowAll -> EventHistoryFilter
ErrorsOnly
  EventHistoryFilter
ErrorsOnly -> EventHistoryFilter
ShowAll

myAvailableUTxO :: NetworkId -> VerificationKey PaymentKey -> UTxO -> Map TxIn (TxOut CtxUTxO)
myAvailableUTxO :: NetworkId
-> VerificationKey PaymentKey
-> UTxO
-> Map TxIn (TxOut CtxUTxO Era)
myAvailableUTxO NetworkId
networkId VerificationKey PaymentKey
vk (UTxO Map TxIn (TxOut CtxUTxO Era)
u) =
  let myAddress :: AddressInEra
myAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk
   in (TxOut CtxUTxO Era -> Bool)
-> Map TxIn (TxOut CtxUTxO Era) -> Map TxIn (TxOut CtxUTxO Era)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\TxOut{txOutAddress :: forall ctx. TxOut ctx -> AddressInEra
txOutAddress = AddressInEra
addr} -> AddressInEra
addr AddressInEra -> AddressInEra -> Bool
forall a. Eq a => a -> a -> Bool
== AddressInEra
myAddress) Map TxIn (TxOut CtxUTxO Era)
u

mkMyAddress :: CardanoClient -> Client Tx IO -> Address ShelleyAddr
mkMyAddress :: CardanoClient -> Client Tx IO -> Address ShelleyAddr
mkMyAddress CardanoClient
cardanoClient Client Tx IO
hydraClient =
  NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
makeShelleyAddress
    (CardanoClient -> NetworkId
networkId CardanoClient
cardanoClient)
    (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey (Hash PaymentKey -> PaymentCredential)
-> (VerificationKey PaymentKey -> Hash PaymentKey)
-> VerificationKey PaymentKey
-> PaymentCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey PaymentKey -> PaymentCredential)
-> VerificationKey PaymentKey -> PaymentCredential
forall a b. (a -> b) -> a -> b
$ Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey (Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey)
-> Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall a b. (a -> b) -> a -> b
$ Client Tx IO -> Secret (SigningKey PaymentKey)
forall tx (m :: * -> *).
Client tx m -> Secret (SigningKey PaymentKey)
sk Client Tx IO
hydraClient)
    StakeAddressReference
NoStakeAddress

-- | Derive the node's internal-wallet (fuel) address from its verification key.
mkFuelAddress :: CardanoClient -> VerificationKey PaymentKey -> Address ShelleyAddr
mkFuelAddress :: CardanoClient -> VerificationKey PaymentKey -> Address ShelleyAddr
mkFuelAddress CardanoClient
cardanoClient VerificationKey PaymentKey
fuelVk =
  NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
makeShelleyAddress
    (CardanoClient -> NetworkId
networkId CardanoClient
cardanoClient)
    (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey (Hash PaymentKey -> PaymentCredential)
-> Hash PaymentKey -> PaymentCredential
forall a b. (a -> b) -> a -> b
$ VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
fuelVk)
    StakeAddressReference
NoStakeAddress

-- | Convert a user-entered ADA amount to lovelace. The TUI accepts amounts
-- as 'Double' for usability (typing decimals), so any precision finer than
-- one lovelace is silently rounded. 'Double' represents integers exactly up
-- to 2^53 lovelace (~9e15), well above any realistic UTxO value, so the
-- only practical loss is sub-lovelace fractional input from the user. The
-- 'min' clamp defends against floating-point overshoot of the form
-- validator's upper bound.
adaToLovelace :: Double -> Integer -> Integer
adaToLovelace :: Double -> Integer -> Integer
adaToLovelace Double
ada Integer
lovelaceLimit =
  Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
lovelaceLimit (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
ada Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1_000_000))

setPendingAction :: Vty.Event -> EventM Name RootState ()
setPendingAction :: Event -> EventM Text RootState ()
setPendingAction Event
e = do
  ConnectedState
connState <- Getting ConnectedState RootState ConnectedState
-> EventM Text RootState ConnectedState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ConnectedState RootState ConnectedState
Lens' RootState ConnectedState
connectedStateL
  case ConnectedState
connState of
    ConnectedState
Disconnected -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    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, Event
e) of
      (HeadState
Idle, EvKey (KChar Char
'i') []) ->
        (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Sending Init…"
      (Active (ActiveLink{$sel:activeHeadState:ActiveLink :: ActiveLink -> ActiveHeadState
activeHeadState = ActiveHeadState
Final}), EvKey (KChar Char
'i') []) ->
        (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Sending Init…"
      (Active (ActiveLink{$sel:activeHeadState:ActiveLink :: ActiveLink -> ActiveHeadState
activeHeadState = ActiveHeadState
FanoutPossible}), EvKey (KChar Char
'f') []) ->
        (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Sending Fanout…"
      -- Note: 'i' on Open OpenHome is handled at the outer event loop (it reads
      -- the cached L1 UTxO) and does not flow through here.
      (Active (ActiveLink{$sel:activeHeadState:ActiveLink :: ActiveLink -> ActiveHeadState
activeHeadState = Open{OpenScreen
openState :: OpenScreen
$sel:openState:Open :: ActiveHeadState -> OpenScreen
openState}}), EvKey Key
KEnter []) ->
        case OpenScreen
openState of
          SelectingUTxOToDecommit Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
_ ->
            (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Sending decommit…"
          SelectingUTxOToIncrement Form (TxIn, TxOut CtxUTxO Era) (HydraEvent Tx) Text
_ ->
            (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Sending increment…"
          EnteringRecipientAddress{$sel:enteringRecipientAddressForm:OpenHome :: OpenScreen -> Form AddressInEra (HydraEvent Tx) Text
enteringRecipientAddressForm = Form AddressInEra (HydraEvent Tx) Text
form} ->
            Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Form AddressInEra (HydraEvent Tx) Text -> Bool
forall s e n. Form s e n -> Bool
allFieldsValid Form AddressInEra (HydraEvent Tx) Text
form) (EventM Text RootState () -> EventM Text RootState ())
-> EventM Text RootState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$
              (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Sending transaction…"
          SelectingRecipient{$sel:selectingRecipientForm:OpenHome :: OpenScreen -> Form SelectAddressItem (HydraEvent Tx) Text
selectingRecipientForm = Form SelectAddressItem (HydraEvent Tx) Text
form} ->
            case Form SelectAddressItem (HydraEvent Tx) Text -> SelectAddressItem
forall s e n. Form s e n -> s
formState Form SelectAddressItem (HydraEvent Tx) Text
form of
              SelectAddress AddressInEra
_ -> (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Sending transaction…"
              SelectAddressItem
ManualEntry -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          ConfirmingClose{$sel:confirmingCloseForm:OpenHome :: OpenScreen -> Form Bool (HydraEvent Tx) Text
confirmingCloseForm = Form Bool (HydraEvent Tx) Text
form} ->
            Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Form Bool (HydraEvent Tx) Text -> Bool
forall s e n. Form s e n -> s
formState Form Bool (HydraEvent Tx) Text
form) (EventM Text RootState () -> EventM Text RootState ())
-> EventM Text RootState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$
              (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Sending Close…"
          OpenScreen
_ -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      (HeadState, Event)
_ -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Read the current 'OpenScreen', if the head is currently 'Open'.
useOpenScreen :: EventM Name RootState (Maybe OpenScreen)
useOpenScreen :: EventM Text RootState (Maybe OpenScreen)
useOpenScreen = (RootState -> Maybe OpenScreen)
-> EventM Text RootState (Maybe OpenScreen)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (RootState
-> Getting (First OpenScreen) RootState OpenScreen
-> Maybe OpenScreen
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ConnectedState -> Const (First OpenScreen) ConnectedState)
-> RootState -> Const (First OpenScreen) RootState
Lens' RootState ConnectedState
connectedStateL ((ConnectedState -> Const (First OpenScreen) ConnectedState)
 -> RootState -> Const (First OpenScreen) RootState)
-> ((OpenScreen -> Const (First OpenScreen) OpenScreen)
    -> ConnectedState -> Const (First OpenScreen) ConnectedState)
-> Getting (First OpenScreen) RootState OpenScreen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection -> Const (First OpenScreen) Connection)
-> ConnectedState -> Const (First OpenScreen) ConnectedState
Traversal' ConnectedState Connection
connectionL ((Connection -> Const (First OpenScreen) Connection)
 -> ConnectedState -> Const (First OpenScreen) ConnectedState)
-> ((OpenScreen -> Const (First OpenScreen) OpenScreen)
    -> Connection -> Const (First OpenScreen) Connection)
-> (OpenScreen -> Const (First OpenScreen) OpenScreen)
-> ConnectedState
-> Const (First OpenScreen) ConnectedState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeadState -> Const (First OpenScreen) HeadState)
-> Connection -> Const (First OpenScreen) Connection
Lens' Connection HeadState
headStateL ((HeadState -> Const (First OpenScreen) HeadState)
 -> Connection -> Const (First OpenScreen) Connection)
-> ((OpenScreen -> Const (First OpenScreen) OpenScreen)
    -> HeadState -> Const (First OpenScreen) HeadState)
-> (OpenScreen -> Const (First OpenScreen) OpenScreen)
-> Connection
-> Const (First OpenScreen) Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActiveLink -> Const (First OpenScreen) ActiveLink)
-> HeadState -> Const (First OpenScreen) HeadState
Traversal' HeadState ActiveLink
activeLinkL ((ActiveLink -> Const (First OpenScreen) ActiveLink)
 -> HeadState -> Const (First OpenScreen) HeadState)
-> ((OpenScreen -> Const (First OpenScreen) OpenScreen)
    -> ActiveLink -> Const (First OpenScreen) ActiveLink)
-> (OpenScreen -> Const (First OpenScreen) OpenScreen)
-> HeadState
-> Const (First OpenScreen) HeadState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActiveHeadState -> Const (First OpenScreen) ActiveHeadState)
-> ActiveLink -> Const (First OpenScreen) ActiveLink
Lens' ActiveLink ActiveHeadState
activeHeadStateL ((ActiveHeadState -> Const (First OpenScreen) ActiveHeadState)
 -> ActiveLink -> Const (First OpenScreen) ActiveLink)
-> ((OpenScreen -> Const (First OpenScreen) OpenScreen)
    -> ActiveHeadState -> Const (First OpenScreen) ActiveHeadState)
-> (OpenScreen -> Const (First OpenScreen) OpenScreen)
-> ActiveLink
-> Const (First OpenScreen) ActiveLink
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OpenScreen -> Const (First OpenScreen) OpenScreen)
-> ActiveHeadState -> Const (First OpenScreen) ActiveHeadState
Traversal' ActiveHeadState OpenScreen
openStateL)

-- | Mutate the current 'OpenScreen'. No-op if the head isn't 'Open'.
zoomOpenScreen :: EventM Name OpenScreen () -> EventM Name RootState ()
zoomOpenScreen :: EventM Text OpenScreen () -> EventM Text RootState ()
zoomOpenScreen = LensLike' (Zoomed (EventM Text OpenScreen) ()) RootState OpenScreen
-> EventM Text OpenScreen () -> EventM Text RootState ()
forall c.
LensLike' (Zoomed (EventM Text OpenScreen) c) RootState OpenScreen
-> EventM Text OpenScreen c -> EventM Text RootState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((ConnectedState
 -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> RootState -> Focusing (StateT (EventState Text) IO) () RootState
Lens' RootState ConnectedState
connectedStateL ((ConnectedState
  -> Focusing (StateT (EventState Text) IO) () ConnectedState)
 -> RootState
 -> Focusing (StateT (EventState Text) IO) () RootState)
-> ((OpenScreen
     -> Focusing (StateT (EventState Text) IO) () OpenScreen)
    -> ConnectedState
    -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> (OpenScreen
    -> Focusing (StateT (EventState Text) IO) () OpenScreen)
-> RootState
-> Focusing (StateT (EventState Text) IO) () RootState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection
 -> Focusing (StateT (EventState Text) IO) () Connection)
-> ConnectedState
-> Focusing (StateT (EventState Text) IO) () ConnectedState
Traversal' ConnectedState Connection
connectionL ((Connection
  -> Focusing (StateT (EventState Text) IO) () Connection)
 -> ConnectedState
 -> Focusing (StateT (EventState Text) IO) () ConnectedState)
-> ((OpenScreen
     -> Focusing (StateT (EventState Text) IO) () OpenScreen)
    -> Connection
    -> Focusing (StateT (EventState Text) IO) () Connection)
-> (OpenScreen
    -> Focusing (StateT (EventState Text) IO) () OpenScreen)
-> ConnectedState
-> Focusing (StateT (EventState Text) IO) () ConnectedState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeadState -> Focusing (StateT (EventState Text) IO) () HeadState)
-> Connection
-> Focusing (StateT (EventState Text) IO) () Connection
Lens' Connection HeadState
headStateL ((HeadState -> Focusing (StateT (EventState Text) IO) () HeadState)
 -> Connection
 -> Focusing (StateT (EventState Text) IO) () Connection)
-> ((OpenScreen
     -> Focusing (StateT (EventState Text) IO) () OpenScreen)
    -> HeadState
    -> Focusing (StateT (EventState Text) IO) () HeadState)
-> (OpenScreen
    -> Focusing (StateT (EventState Text) IO) () OpenScreen)
-> Connection
-> Focusing (StateT (EventState Text) IO) () Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActiveLink
 -> Focusing (StateT (EventState Text) IO) () ActiveLink)
-> HeadState -> Focusing (StateT (EventState Text) IO) () HeadState
Traversal' HeadState ActiveLink
activeLinkL ((ActiveLink
  -> Focusing (StateT (EventState Text) IO) () ActiveLink)
 -> HeadState
 -> Focusing (StateT (EventState Text) IO) () HeadState)
-> ((OpenScreen
     -> Focusing (StateT (EventState Text) IO) () OpenScreen)
    -> ActiveLink
    -> Focusing (StateT (EventState Text) IO) () ActiveLink)
-> (OpenScreen
    -> Focusing (StateT (EventState Text) IO) () OpenScreen)
-> HeadState
-> Focusing (StateT (EventState Text) IO) () HeadState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActiveHeadState
 -> Focusing (StateT (EventState Text) IO) () ActiveHeadState)
-> ActiveLink
-> Focusing (StateT (EventState Text) IO) () ActiveLink
Lens' ActiveLink ActiveHeadState
activeHeadStateL ((ActiveHeadState
  -> Focusing (StateT (EventState Text) IO) () ActiveHeadState)
 -> ActiveLink
 -> Focusing (StateT (EventState Text) IO) () ActiveLink)
-> ((OpenScreen
     -> Focusing (StateT (EventState Text) IO) () OpenScreen)
    -> ActiveHeadState
    -> Focusing (StateT (EventState Text) IO) () ActiveHeadState)
-> (OpenScreen
    -> Focusing (StateT (EventState Text) IO) () OpenScreen)
-> ActiveLink
-> Focusing (StateT (EventState Text) IO) () ActiveLink
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OpenScreen
 -> Focusing (StateT (EventState Text) IO) () OpenScreen)
-> ActiveHeadState
-> Focusing (StateT (EventState Text) IO) () ActiveHeadState
Traversal' ActiveHeadState OpenScreen
openStateL)

-- | Switch to the modal tab, remembering the currently-active tab so we can
-- return to it later via 'leaveModal'.
enterModal :: EventM Name RootState ()
enterModal :: EventM Text RootState ()
enterModal = do
  ActiveTab
tab <- Getting ActiveTab RootState ActiveTab
-> EventM Text RootState ActiveTab
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ActiveTab RootState ActiveTab
Lens' RootState ActiveTab
activeTabL
  (ActiveTab -> Identity ActiveTab)
-> RootState -> Identity RootState
Lens' RootState ActiveTab
previousTabL ((ActiveTab -> Identity ActiveTab)
 -> RootState -> Identity RootState)
-> ActiveTab -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ActiveTab
tab
  (ActiveTab -> Identity ActiveTab)
-> RootState -> Identity RootState
Lens' RootState ActiveTab
activeTabL ((ActiveTab -> Identity ActiveTab)
 -> RootState -> Identity RootState)
-> ActiveTab -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ActiveTab
ModalTab

-- | Return from the modal tab to whichever tab was active before.
leaveModal :: EventM Name RootState ()
leaveModal :: EventM Text RootState ()
leaveModal = do
  ActiveTab
prev <- Getting ActiveTab RootState ActiveTab
-> EventM Text RootState ActiveTab
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ActiveTab RootState ActiveTab
Lens' RootState ActiveTab
previousTabL
  (ActiveTab -> Identity ActiveTab)
-> RootState -> Identity RootState
Lens' RootState ActiveTab
activeTabL ((ActiveTab -> Identity ActiveTab)
 -> RootState -> Identity RootState)
-> ActiveTab -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ActiveTab
prev

-- | If the recovery modal is open, rebuild its form from the current
-- 'pendingIncrements'. Keeps the user's selection if that deposit is still
-- pending, otherwise falls back to the first entry. If the list is now
-- empty (e.g. the selected deposit was finalized or recovered), close the
-- modal and surface a message in the pending-action slot. Should be called
-- after any node event that may mutate 'pendingIncrements'.
refreshRecoveryForm :: EventM Name RootState ()
refreshRecoveryForm :: EventM Text RootState ()
refreshRecoveryForm = do
  Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
mForm <- Getting
  (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
  RootState
  (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
-> EventM
     Text RootState (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
  RootState
  (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
Lens' RootState (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
recoveryFormL
  case Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
mForm of
    Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
Nothing -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just TxIdRadioFieldForm (HydraEvent Tx) Text
form -> do
      let prevSelection :: TxId
prevSelection = TxIdRadioFieldForm (HydraEvent Tx) Text -> TxId
forall s e n. Form s e n -> s
formState TxIdRadioFieldForm (HydraEvent Tx) Text
form
      Maybe [PendingIncrement]
mPending <- (RootState -> Maybe [PendingIncrement])
-> EventM Text RootState (Maybe [PendingIncrement])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (RootState
-> Getting (First [PendingIncrement]) RootState [PendingIncrement]
-> Maybe [PendingIncrement]
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ConnectedState -> Const (First [PendingIncrement]) ConnectedState)
-> RootState -> Const (First [PendingIncrement]) RootState
Lens' RootState ConnectedState
connectedStateL ((ConnectedState
  -> Const (First [PendingIncrement]) ConnectedState)
 -> RootState -> Const (First [PendingIncrement]) RootState)
-> (([PendingIncrement]
     -> Const (First [PendingIncrement]) [PendingIncrement])
    -> ConnectedState
    -> Const (First [PendingIncrement]) ConnectedState)
-> Getting (First [PendingIncrement]) RootState [PendingIncrement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection -> Const (First [PendingIncrement]) Connection)
-> ConnectedState
-> Const (First [PendingIncrement]) ConnectedState
Traversal' ConnectedState Connection
connectionL ((Connection -> Const (First [PendingIncrement]) Connection)
 -> ConnectedState
 -> Const (First [PendingIncrement]) ConnectedState)
-> (([PendingIncrement]
     -> Const (First [PendingIncrement]) [PendingIncrement])
    -> Connection -> Const (First [PendingIncrement]) Connection)
-> ([PendingIncrement]
    -> Const (First [PendingIncrement]) [PendingIncrement])
-> ConnectedState
-> Const (First [PendingIncrement]) ConnectedState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeadState -> Const (First [PendingIncrement]) HeadState)
-> Connection -> Const (First [PendingIncrement]) Connection
Lens' Connection HeadState
headStateL ((HeadState -> Const (First [PendingIncrement]) HeadState)
 -> Connection -> Const (First [PendingIncrement]) Connection)
-> (([PendingIncrement]
     -> Const (First [PendingIncrement]) [PendingIncrement])
    -> HeadState -> Const (First [PendingIncrement]) HeadState)
-> ([PendingIncrement]
    -> Const (First [PendingIncrement]) [PendingIncrement])
-> Connection
-> Const (First [PendingIncrement]) Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActiveLink -> Const (First [PendingIncrement]) ActiveLink)
-> HeadState -> Const (First [PendingIncrement]) HeadState
Traversal' HeadState ActiveLink
activeLinkL ((ActiveLink -> Const (First [PendingIncrement]) ActiveLink)
 -> HeadState -> Const (First [PendingIncrement]) HeadState)
-> (([PendingIncrement]
     -> Const (First [PendingIncrement]) [PendingIncrement])
    -> ActiveLink -> Const (First [PendingIncrement]) ActiveLink)
-> ([PendingIncrement]
    -> Const (First [PendingIncrement]) [PendingIncrement])
-> HeadState
-> Const (First [PendingIncrement]) HeadState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([PendingIncrement]
 -> Const (First [PendingIncrement]) [PendingIncrement])
-> ActiveLink -> Const (First [PendingIncrement]) ActiveLink
Lens' ActiveLink [PendingIncrement]
pendingIncrementsL)
      let pis :: [PendingIncrement]
pis = [PendingIncrement]
-> Maybe [PendingIncrement] -> [PendingIncrement]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [PendingIncrement]
mPending
      let pendingDepositIds :: [(TxId, UTxO)]
pendingDepositIds = (\PendingIncrement{TxId
$sel:deposit:PendingIncrement :: PendingIncrement -> TxId
deposit :: TxId
deposit, UTxO
$sel:utxoToCommit:PendingIncrement :: PendingIncrement -> UTxO
utxoToCommit :: UTxO
utxoToCommit} -> (TxId
deposit, UTxO
utxoToCommit)) (PendingIncrement -> (TxId, UTxO))
-> [PendingIncrement] -> [(TxId, UTxO)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PendingIncrement]
pis
      case Maybe TxId
-> [(TxId, UTxO)]
-> Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
forall s e n.
(s ~ TxId, n ~ Text) =>
Maybe TxId -> [(TxId, UTxO)] -> Maybe (Form s e n)
depositIdRadioFieldWith (TxId -> Maybe TxId
forall a. a -> Maybe a
Just TxId
prevSelection) [(TxId, UTxO)]
pendingDepositIds of
        Just TxIdRadioFieldForm (HydraEvent Tx) Text
refreshed -> (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
 -> Identity (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)))
-> RootState -> Identity RootState
Lens' RootState (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
recoveryFormL ((Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
  -> Identity (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)))
 -> RootState -> Identity RootState)
-> Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TxIdRadioFieldForm (HydraEvent Tx) Text
-> Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
forall a. a -> Maybe a
Just TxIdRadioFieldForm (HydraEvent Tx) Text
refreshed
        Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
Nothing -> do
          (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
 -> Identity (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)))
-> RootState -> Identity RootState
Lens' RootState (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text))
recoveryFormL ((Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
  -> Identity (Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)))
 -> RootState -> Identity RootState)
-> Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (TxIdRadioFieldForm (HydraEvent Tx) Text)
forall a. Maybe a
Nothing
          ActiveTab
tab <- Getting ActiveTab RootState ActiveTab
-> EventM Text RootState ActiveTab
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ActiveTab RootState ActiveTab
Lens' RootState ActiveTab
activeTabL
          Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActiveTab
tab ActiveTab -> ActiveTab -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveTab
ModalTab) (EventM Text RootState () -> EventM Text RootState ())
-> EventM Text RootState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ do
            EventM Text RootState ()
leaveModal
            (Maybe Text -> Identity (Maybe Text))
-> RootState -> Identity RootState
Lens' RootState (Maybe Text)
pendingActionL ((Maybe Text -> Identity (Maybe Text))
 -> RootState -> Identity RootState)
-> Maybe Text -> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"No pending deposits left to recover."

-- | Keep an open partial-fanout selection modal in sync with the head's
-- remaining UTxO. When a 'HeadPartiallyFannedOut' step lands, the displayed
-- 'utxoL' shrinks; rebuild the form against it so the user cannot tick (and
-- submit) UTxOs that were already fanned out. Still-valid ticks are preserved.
-- If the head is no longer fanning out (finalized, or otherwise left a
-- fanout-capable state), close the modal.
refreshFanoutForm :: EventM Name RootState ()
refreshFanoutForm :: EventM Text RootState ()
refreshFanoutForm = do
  Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
mForm <- Getting
  (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
  RootState
  (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
-> EventM
     Text RootState (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
  RootState
  (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
Lens' RootState (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
fanoutSelectionFormL
  case Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
mForm of
    Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
Nothing -> () -> EventM Text RootState ()
forall a. a -> EventM Text RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just UTxOCheckboxForm (HydraEvent Tx) Text
form -> do
      Maybe ActiveHeadState
mActiveHeadState <- (RootState -> Maybe ActiveHeadState)
-> EventM Text RootState (Maybe ActiveHeadState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (RootState
-> Getting (First ActiveHeadState) RootState ActiveHeadState
-> Maybe ActiveHeadState
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ConnectedState -> Const (First ActiveHeadState) ConnectedState)
-> RootState -> Const (First ActiveHeadState) RootState
Lens' RootState ConnectedState
connectedStateL ((ConnectedState -> Const (First ActiveHeadState) ConnectedState)
 -> RootState -> Const (First ActiveHeadState) RootState)
-> ((ActiveHeadState
     -> Const (First ActiveHeadState) ActiveHeadState)
    -> ConnectedState -> Const (First ActiveHeadState) ConnectedState)
-> Getting (First ActiveHeadState) RootState ActiveHeadState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection -> Const (First ActiveHeadState) Connection)
-> ConnectedState -> Const (First ActiveHeadState) ConnectedState
Traversal' ConnectedState Connection
connectionL ((Connection -> Const (First ActiveHeadState) Connection)
 -> ConnectedState -> Const (First ActiveHeadState) ConnectedState)
-> ((ActiveHeadState
     -> Const (First ActiveHeadState) ActiveHeadState)
    -> Connection -> Const (First ActiveHeadState) Connection)
-> (ActiveHeadState
    -> Const (First ActiveHeadState) ActiveHeadState)
-> ConnectedState
-> Const (First ActiveHeadState) ConnectedState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeadState -> Const (First ActiveHeadState) HeadState)
-> Connection -> Const (First ActiveHeadState) Connection
Lens' Connection HeadState
headStateL ((HeadState -> Const (First ActiveHeadState) HeadState)
 -> Connection -> Const (First ActiveHeadState) Connection)
-> ((ActiveHeadState
     -> Const (First ActiveHeadState) ActiveHeadState)
    -> HeadState -> Const (First ActiveHeadState) HeadState)
-> (ActiveHeadState
    -> Const (First ActiveHeadState) ActiveHeadState)
-> Connection
-> Const (First ActiveHeadState) Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActiveLink -> Const (First ActiveHeadState) ActiveLink)
-> HeadState -> Const (First ActiveHeadState) HeadState
Traversal' HeadState ActiveLink
activeLinkL ((ActiveLink -> Const (First ActiveHeadState) ActiveLink)
 -> HeadState -> Const (First ActiveHeadState) HeadState)
-> ((ActiveHeadState
     -> Const (First ActiveHeadState) ActiveHeadState)
    -> ActiveLink -> Const (First ActiveHeadState) ActiveLink)
-> (ActiveHeadState
    -> Const (First ActiveHeadState) ActiveHeadState)
-> HeadState
-> Const (First ActiveHeadState) HeadState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActiveHeadState -> Const (First ActiveHeadState) ActiveHeadState)
-> ActiveLink -> Const (First ActiveHeadState) ActiveLink
Lens' ActiveLink ActiveHeadState
activeHeadStateL)
      let stillFanningOut :: Bool
stillFanningOut = case Maybe ActiveHeadState
mActiveHeadState of
            Just ActiveHeadState
FanoutPossible -> Bool
True
            Just FanningOut{} -> Bool
True
            Maybe ActiveHeadState
_ -> Bool
False
      Maybe UTxO
mUTxO <- (RootState -> Maybe UTxO) -> EventM Text RootState (Maybe UTxO)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (RootState -> Getting (First UTxO) RootState UTxO -> Maybe UTxO
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ConnectedState -> Const (First UTxO) ConnectedState)
-> RootState -> Const (First UTxO) RootState
Lens' RootState ConnectedState
connectedStateL ((ConnectedState -> Const (First UTxO) ConnectedState)
 -> RootState -> Const (First UTxO) RootState)
-> ((UTxO -> Const (First UTxO) UTxO)
    -> ConnectedState -> Const (First UTxO) ConnectedState)
-> Getting (First UTxO) RootState UTxO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection -> Const (First UTxO) Connection)
-> ConnectedState -> Const (First UTxO) ConnectedState
Traversal' ConnectedState Connection
connectionL ((Connection -> Const (First UTxO) Connection)
 -> ConnectedState -> Const (First UTxO) ConnectedState)
-> ((UTxO -> Const (First UTxO) UTxO)
    -> Connection -> Const (First UTxO) Connection)
-> (UTxO -> Const (First UTxO) UTxO)
-> ConnectedState
-> Const (First UTxO) ConnectedState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeadState -> Const (First UTxO) HeadState)
-> Connection -> Const (First UTxO) Connection
Lens' Connection HeadState
headStateL ((HeadState -> Const (First UTxO) HeadState)
 -> Connection -> Const (First UTxO) Connection)
-> ((UTxO -> Const (First UTxO) UTxO)
    -> HeadState -> Const (First UTxO) HeadState)
-> (UTxO -> Const (First UTxO) UTxO)
-> Connection
-> Const (First UTxO) Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActiveLink -> Const (First UTxO) ActiveLink)
-> HeadState -> Const (First UTxO) HeadState
Traversal' HeadState ActiveLink
activeLinkL ((ActiveLink -> Const (First UTxO) ActiveLink)
 -> HeadState -> Const (First UTxO) HeadState)
-> ((UTxO -> Const (First UTxO) UTxO)
    -> ActiveLink -> Const (First UTxO) ActiveLink)
-> (UTxO -> Const (First UTxO) UTxO)
-> HeadState
-> Const (First UTxO) HeadState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxO -> Const (First UTxO) UTxO)
-> ActiveLink -> Const (First UTxO) ActiveLink
Lens' ActiveLink UTxO
utxoL)
      let u :: Map TxIn (TxOut CtxUTxO Era)
u = Map TxIn (TxOut CtxUTxO Era)
-> (UTxO -> Map TxIn (TxOut CtxUTxO Era))
-> Maybe UTxO
-> Map TxIn (TxOut CtxUTxO Era)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map TxIn (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty UTxO -> Map TxIn (TxOut CtxUTxO Era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
UTxO.toMap Maybe UTxO
mUTxO
          prevSelection :: Map TxIn (TxOut CtxUTxO Era, Bool)
prevSelection = UTxOCheckboxForm (HydraEvent Tx) Text
-> Map TxIn (TxOut CtxUTxO Era, Bool)
forall s e n. Form s e n -> s
formState UTxOCheckboxForm (HydraEvent Tx) Text
form
      if Bool -> Bool
not Bool
stillFanningOut Bool -> Bool -> Bool
|| Map TxIn (TxOut CtxUTxO Era) -> Bool
forall k a. Map k a -> Bool
Map.null Map TxIn (TxOut CtxUTxO Era)
u
        then do
          -- Head finalized or left a fanout-capable state, or nothing remains:
          -- close the modal so the user cannot submit against a stale UTxO set.
          (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
 -> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
-> RootState -> Identity RootState
Lens' RootState (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
fanoutSelectionFormL ((Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
  -> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
 -> RootState -> Identity RootState)
-> Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
forall a. Maybe a
Nothing
          ActiveTab
tab <- Getting ActiveTab RootState ActiveTab
-> EventM Text RootState ActiveTab
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ActiveTab RootState ActiveTab
Lens' RootState ActiveTab
activeTabL
          Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActiveTab
tab ActiveTab -> ActiveTab -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveTab
ModalTab) EventM Text RootState ()
leaveModal
        else
          -- Only rebuild the form when the underlying UTxO set actually changed
          -- (e.g. a 'HeadPartiallyFannedOut' step shrank it). 'newForm' resets the
          -- focus to the first field, so rebuilding on every tick would make the
          -- selection jump back to the top and the list unusable.
          Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Map TxIn (TxOut CtxUTxO Era) -> Set TxIn
forall k a. Map k a -> Set k
Map.keysSet Map TxIn (TxOut CtxUTxO Era)
u Set TxIn -> Set TxIn -> Bool
forall a. Eq a => a -> a -> Bool
/= Map TxIn (TxOut CtxUTxO Era, Bool) -> Set TxIn
forall k a. Map k a -> Set k
Map.keysSet Map TxIn (TxOut CtxUTxO Era, Bool)
prevSelection) (EventM Text RootState () -> EventM Text RootState ())
-> EventM Text RootState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$
            case Maybe (Map TxIn (TxOut CtxUTxO Era, Bool))
-> Map TxIn (TxOut CtxUTxO Era)
-> Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
forall e n.
(n ~ Text) =>
Maybe (Map TxIn (TxOut CtxUTxO Era, Bool))
-> Map TxIn (TxOut CtxUTxO Era)
-> Maybe (Form (Map TxIn (TxOut CtxUTxO Era, Bool)) e n)
utxoCheckboxFieldWith (Map TxIn (TxOut CtxUTxO Era, Bool)
-> Maybe (Map TxIn (TxOut CtxUTxO Era, Bool))
forall a. a -> Maybe a
Just Map TxIn (TxOut CtxUTxO Era, Bool)
prevSelection) Map TxIn (TxOut CtxUTxO Era)
u of
              Just UTxOCheckboxForm (HydraEvent Tx) Text
refreshed -> (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
 -> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
-> RootState -> Identity RootState
Lens' RootState (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
fanoutSelectionFormL ((Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
  -> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
 -> RootState -> Identity RootState)
-> Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTxOCheckboxForm (HydraEvent Tx) Text
-> Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
forall a. a -> Maybe a
Just UTxOCheckboxForm (HydraEvent Tx) Text
refreshed
              Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
Nothing -> do
                (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
 -> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
-> RootState -> Identity RootState
Lens' RootState (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text))
fanoutSelectionFormL ((Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
  -> Identity (Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)))
 -> RootState -> Identity RootState)
-> Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
-> EventM Text RootState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (UTxOCheckboxForm (HydraEvent Tx) Text)
forall a. Maybe a
Nothing
                ActiveTab
tab <- Getting ActiveTab RootState ActiveTab
-> EventM Text RootState ActiveTab
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ActiveTab RootState ActiveTab
Lens' RootState ActiveTab
activeTabL
                Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActiveTab
tab ActiveTab -> ActiveTab -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveTab
ModalTab) EventM Text RootState ()
leaveModal

-- | Run an IO action in a background thread, reporting any exception through
-- the TUI's event channel as a 'TxBuildError' (visible in the pending-action
-- slot). 'cleanup' events, if any, are written before the error so the TUI
-- can reset transient loading state. Order matters — 'TxBuildError' is
-- written last so its message wins over anything 'cleanup' might display.
--
-- Forking is essential for any blocking call against the hydra-node or
-- cardano-node: if the remote is unresponsive a synchronous call would block
-- the brick event loop, leaving no way to press Esc or Ctrl-C.
forkWithErrorReport ::
  BChan (TUIEvent Tx) ->
  Text ->
  [TUIEvent Tx] ->
  IO () ->
  IO ()
forkWithErrorReport :: BChan (TUIEvent Tx) -> Text -> [TUIEvent Tx] -> IO () -> IO ()
forkWithErrorReport BChan (TUIEvent Tx)
chan Text
errorPrefix [TUIEvent Tx]
cleanup IO ()
action =
  IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$
    IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$
      (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle
        ( \(SomeException
ex :: SomeException) -> do
            (TUIEvent Tx -> IO ()) -> [TUIEvent Tx] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (BChan (TUIEvent Tx) -> TUIEvent Tx -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (TUIEvent Tx)
chan) [TUIEvent Tx]
cleanup
            BChan (TUIEvent Tx) -> TUIEvent Tx -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (TUIEvent Tx)
chan (Text -> TUIEvent Tx
forall tx. Text -> TUIEvent tx
TxBuildError (Text
errorPrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeException -> Text
forall b a. (Show a, IsString b) => a -> b
show SomeException
ex))
        )
        IO ()
action

-- | Query L1 UTxO at the given address in a background thread. On success,
-- the result is wrapped via 'mkResult' and written to the channel. On
-- exception, an empty result is written first (so the TUI clears any
-- loading-state spinner) followed by a 'TxBuildError' with the real cause.
queryL1UTxOAsync ::
  CardanoClient ->
  Address ShelleyAddr ->
  BChan (TUIEvent Tx) ->
  (Map TxIn (TxOut CtxUTxO) -> TUIEvent Tx) ->
  Text ->
  IO ()
queryL1UTxOAsync :: CardanoClient
-> Address ShelleyAddr
-> BChan (TUIEvent Tx)
-> (Map TxIn (TxOut CtxUTxO Era) -> TUIEvent Tx)
-> Text
-> IO ()
queryL1UTxOAsync CardanoClient
cardanoClient Address ShelleyAddr
myAddr BChan (TUIEvent Tx)
chan Map TxIn (TxOut CtxUTxO Era) -> TUIEvent Tx
mkResult Text
errorPrefix =
  BChan (TUIEvent Tx) -> Text -> [TUIEvent Tx] -> IO () -> IO ()
forkWithErrorReport BChan (TUIEvent Tx)
chan Text
errorPrefix [Map TxIn (TxOut CtxUTxO Era) -> TUIEvent Tx
mkResult Map TxIn (TxOut CtxUTxO Era)
forall k a. Map k a
Map.empty] (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    UTxO
utxo' <- CardanoClient -> [Address ShelleyAddr] -> IO UTxO
queryUTxOByAddress CardanoClient
cardanoClient [Address ShelleyAddr
myAddr]
    BChan (TUIEvent Tx) -> TUIEvent Tx -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan (TUIEvent Tx)
chan (Map TxIn (TxOut CtxUTxO Era) -> TUIEvent Tx
mkResult (UTxO -> Map TxIn (TxOut CtxUTxO Era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
UTxO.toMap UTxO
utxo'))

recoverCommitAsync :: Client Tx IO -> BChan (TUIEvent Tx) -> TxId -> IO ()
recoverCommitAsync :: Client Tx IO -> BChan (TUIEvent Tx) -> TxId -> IO ()
recoverCommitAsync Client Tx IO
client BChan (TUIEvent Tx)
chan TxId
depositTxId =
  BChan (TUIEvent Tx) -> Text -> [TUIEvent Tx] -> IO () -> IO ()
forkWithErrorReport BChan (TUIEvent Tx)
chan Text
"Recovery request failed" [] (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Client Tx IO -> TxId -> IO ()
forall tx (m :: * -> *). Client tx m -> TxId -> m ()
recoverCommit Client Tx IO
client TxId
depositTxId

externalCommitAsync :: Client Tx IO -> BChan (TUIEvent Tx) -> UTxO -> IO ()
externalCommitAsync :: Client Tx IO -> BChan (TUIEvent Tx) -> UTxO -> IO ()
externalCommitAsync Client Tx IO
client BChan (TUIEvent Tx)
chan UTxO
commitUTxO =
  BChan (TUIEvent Tx) -> Text -> [TUIEvent Tx] -> IO () -> IO ()
forkWithErrorReport BChan (TUIEvent Tx)
chan Text
"Increment request failed" [] (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Client Tx IO -> UTxO -> IO ()
forall tx (m :: * -> *). Client tx m -> UTxO -> m ()
externalCommit Client Tx IO
client UTxO
commitUTxO

triggerL1Query :: CardanoClient -> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Name RootState ()
triggerL1Query :: CardanoClient
-> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Text RootState ()
triggerL1Query CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan = do
  let myAddr :: Address ShelleyAddr
myAddr = CardanoClient -> Client Tx IO -> Address ShelleyAddr
mkMyAddress CardanoClient
cardanoClient Client Tx IO
client
  IO () -> EventM Text RootState ()
forall a. IO a -> EventM Text RootState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text RootState ())
-> IO () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ CardanoClient
-> Address ShelleyAddr
-> BChan (TUIEvent Tx)
-> (Map TxIn (TxOut CtxUTxO Era) -> TUIEvent Tx)
-> Text
-> IO ()
queryL1UTxOAsync CardanoClient
cardanoClient Address ShelleyAddr
myAddr BChan (TUIEvent Tx)
chan Map TxIn (TxOut CtxUTxO Era) -> TUIEvent Tx
forall tx. Map TxIn (TxOut CtxUTxO Era) -> TUIEvent tx
L1UTxORefresh Text
"L1 wallet refresh failed"
  -- When a fuel key is configured, also refresh the node's internal-wallet
  -- UTxO. This is display-only and is never used for committing.
  Maybe (VerificationKey PaymentKey)
mFuelVk <- Getting
  (Maybe (VerificationKey PaymentKey))
  RootState
  (Maybe (VerificationKey PaymentKey))
-> EventM Text RootState (Maybe (VerificationKey PaymentKey))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Maybe (VerificationKey PaymentKey))
  RootState
  (Maybe (VerificationKey PaymentKey))
Lens' RootState (Maybe (VerificationKey PaymentKey))
fuelVkL
  Maybe (VerificationKey PaymentKey)
-> (VerificationKey PaymentKey -> EventM Text RootState ())
-> EventM Text RootState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (VerificationKey PaymentKey)
mFuelVk ((VerificationKey PaymentKey -> EventM Text RootState ())
 -> EventM Text RootState ())
-> (VerificationKey PaymentKey -> EventM Text RootState ())
-> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ \VerificationKey PaymentKey
fuelVk ->
    IO () -> EventM Text RootState ()
forall a. IO a -> EventM Text RootState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Text RootState ())
-> IO () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ CardanoClient
-> Address ShelleyAddr
-> BChan (TUIEvent Tx)
-> (Map TxIn (TxOut CtxUTxO Era) -> TUIEvent Tx)
-> Text
-> IO ()
queryL1UTxOAsync CardanoClient
cardanoClient (CardanoClient -> VerificationKey PaymentKey -> Address ShelleyAddr
mkFuelAddress CardanoClient
cardanoClient VerificationKey PaymentKey
fuelVk) BChan (TUIEvent Tx)
chan Map TxIn (TxOut CtxUTxO Era) -> TUIEvent Tx
forall tx. Map TxIn (TxOut CtxUTxO Era) -> TUIEvent tx
FuelUTxORefresh Text
"Fuel wallet refresh failed"

triggerL1IfNeeded :: CardanoClient -> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Name RootState ()
triggerL1IfNeeded :: CardanoClient
-> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Text RootState ()
triggerL1IfNeeded CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan = do
  Maybe (Map TxIn (TxOut CtxUTxO Era))
l1 <- Getting
  (Maybe (Map TxIn (TxOut CtxUTxO Era)))
  RootState
  (Maybe (Map TxIn (TxOut CtxUTxO Era)))
-> EventM Text RootState (Maybe (Map TxIn (TxOut CtxUTxO Era)))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Maybe (Map TxIn (TxOut CtxUTxO Era)))
  RootState
  (Maybe (Map TxIn (TxOut CtxUTxO Era)))
Lens' RootState (Maybe (Map TxIn (TxOut CtxUTxO Era)))
l1UTxOL
  Bool -> EventM Text RootState () -> EventM Text RootState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Map TxIn (TxOut CtxUTxO Era)) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Map TxIn (TxOut CtxUTxO Era))
l1) (EventM Text RootState () -> EventM Text RootState ())
-> EventM Text RootState () -> EventM Text RootState ()
forall a b. (a -> b) -> a -> b
$ CardanoClient
-> Client Tx IO -> BChan (TUIEvent Tx) -> EventM Text RootState ()
triggerL1Query CardanoClient
cardanoClient Client Tx IO
client BChan (TUIEvent Tx)
chan

cycleTab :: ActiveTab -> ActiveTab
cycleTab :: ActiveTab -> ActiveTab
cycleTab ActiveTab
MainTab = ActiveTab
FundsTab
cycleTab ActiveTab
FundsTab = ActiveTab
EventHistoryTab
cycleTab ActiveTab
EventHistoryTab = ActiveTab
MainTab
cycleTab ActiveTab
ModalTab = ActiveTab
MainTab

prevTab :: ActiveTab -> ActiveTab
prevTab :: ActiveTab -> ActiveTab
prevTab ActiveTab
MainTab = ActiveTab
EventHistoryTab
prevTab ActiveTab
FundsTab = ActiveTab
MainTab
prevTab ActiveTab
EventHistoryTab = ActiveTab
FundsTab
prevTab ActiveTab
ModalTab = ActiveTab
MainTab