{-# 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, padLeft)

import Brick
import Hydra.Cardano.Api hiding (Active)
import Hydra.Chain (PostTxError (InternalWalletError, NotEnoughFuel), reason)

import Brick.Forms (Form (formState), editShowableFieldWithValidate, handleFormEvent, newForm)
import Cardano.Api.UTxO qualified as UTxO
import Data.List (nub, (\\))
import Data.Map qualified as Map
import Graphics.Vty (
  Event (EvKey),
  Key (..),
 )
import Graphics.Vty qualified as Vty
import Hydra.API.ClientInput (ClientInput (..))
import Hydra.API.ServerOutput (ServerOutput (..), TimedServerOutput (..))
import Hydra.Chain.CardanoClient (CardanoClient (..))
import Hydra.Chain.Direct.State ()
import Hydra.Client (Client (..), HydraEvent (..))
import Hydra.Ledger (IsTx (..), balance)
import Hydra.Ledger.Cardano (mkSimpleTx)
import Hydra.Party (Party)
import Hydra.Snapshot (Snapshot (..))
import Hydra.TUI.Forms
import Hydra.TUI.Handlers.Global (handleVtyGlobalEvents)
import Hydra.TUI.Logging.Handlers (info, report, warn)
import Hydra.TUI.Logging.Types (LogMessage, LogState, LogVerbosity (..), Severity (..), logMessagesL, logVerbosityL)
import Hydra.TUI.Model
import Hydra.TUI.Style (own)
import Lens.Micro.Mtl (use, (%=), (.=))
import Prelude qualified

handleEvent ::
  CardanoClient ->
  Client Tx IO ->
  BrickEvent Name (HydraEvent Tx) ->
  EventM Name RootState ()
handleEvent :: CardanoClient
-> Client Tx IO
-> BrickEvent Name (HydraEvent Tx)
-> EventM Name RootState ()
handleEvent CardanoClient
cardanoClient Client Tx IO
client BrickEvent Name (HydraEvent Tx)
e = do
  LensLike' (Zoomed (EventM Name LogState) ()) RootState LogState
-> EventM Name LogState () -> EventM Name RootState ()
forall c.
LensLike' (Zoomed (EventM Name LogState) c) RootState LogState
-> EventM Name LogState c -> EventM Name 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 Name LogState) ()) RootState LogState
(LogState -> Focusing (StateT (EventState Name) IO) () LogState)
-> RootState -> Focusing (StateT (EventState Name) IO) () RootState
Lens' RootState LogState
logStateL (EventM Name LogState () -> EventM Name RootState ())
-> EventM Name LogState () -> EventM Name RootState ()
forall a b. (a -> b) -> a -> b
$ (Event -> EventM Name LogState ())
-> () -> BrickEvent Name (HydraEvent Tx) -> EventM Name LogState ()
forall n s a w e.
(Event -> EventM n s a) -> a -> BrickEvent w e -> EventM n s a
handleVtyEventVia Event -> EventM Name LogState ()
handleVtyEventsLogState () BrickEvent Name (HydraEvent Tx)
e
  (HydraEvent Tx -> EventM Name RootState ())
-> ()
-> BrickEvent Name (HydraEvent Tx)
-> EventM Name RootState ()
forall e n s a w.
(e -> EventM n s a) -> a -> BrickEvent w e -> EventM n s a
handleAppEventVia HydraEvent Tx -> EventM Name RootState ()
handleTick () BrickEvent Name (HydraEvent Tx)
e
  LensLike'
  (Zoomed (EventM Name ConnectedState) ()) RootState ConnectedState
-> EventM Name ConnectedState () -> EventM Name RootState ()
forall c.
LensLike'
  (Zoomed (EventM Name ConnectedState) c) RootState ConnectedState
-> EventM Name ConnectedState c -> EventM Name 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 Name ConnectedState) ()) RootState ConnectedState
(ConnectedState
 -> Focusing (StateT (EventState Name) IO) () ConnectedState)
-> RootState -> Focusing (StateT (EventState Name) IO) () RootState
Lens' RootState ConnectedState
connectedStateL (EventM Name ConnectedState () -> EventM Name RootState ())
-> EventM Name ConnectedState () -> EventM Name RootState ()
forall a b. (a -> b) -> a -> b
$ do
    (HydraEvent Tx -> EventM Name ConnectedState ())
-> ()
-> BrickEvent Name (HydraEvent Tx)
-> EventM Name ConnectedState ()
forall e n s a w.
(e -> EventM n s a) -> a -> BrickEvent w e -> EventM n s a
handleAppEventVia HydraEvent Tx -> EventM Name ConnectedState ()
handleHydraEventsConnectedState () BrickEvent Name (HydraEvent Tx)
e
    LensLike'
  (Zoomed (EventM Name Connection) ()) ConnectedState Connection
-> EventM Name Connection () -> EventM Name ConnectedState ()
forall c.
LensLike'
  (Zoomed (EventM Name Connection) c) ConnectedState Connection
-> EventM Name Connection c -> EventM Name 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 Name Connection) ()) ConnectedState Connection
(Connection
 -> Focusing (StateT (EventState Name) IO) () Connection)
-> ConnectedState
-> Focusing (StateT (EventState Name) IO) () ConnectedState
Traversal' ConnectedState Connection
connectionL (EventM Name Connection () -> EventM Name ConnectedState ())
-> EventM Name Connection () -> EventM Name ConnectedState ()
forall a b. (a -> b) -> a -> b
$ CardanoClient
-> Client Tx IO
-> BrickEvent Name (HydraEvent Tx)
-> EventM Name Connection ()
forall w.
CardanoClient
-> Client Tx IO
-> BrickEvent w (HydraEvent Tx)
-> EventM Name Connection ()
handleBrickEventsConnection CardanoClient
cardanoClient Client Tx IO
client BrickEvent Name (HydraEvent Tx)
e
  LensLike'
  (Zoomed (EventM Name [LogMessage]) ()) RootState [LogMessage]
-> EventM Name [LogMessage] () -> EventM Name RootState ()
forall c.
LensLike'
  (Zoomed (EventM Name [LogMessage]) c) RootState [LogMessage]
-> EventM Name [LogMessage] c -> EventM Name 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 Name) IO) () LogState)
-> RootState -> Focusing (StateT (EventState Name) IO) () RootState
Lens' RootState LogState
logStateL ((LogState -> Focusing (StateT (EventState Name) IO) () LogState)
 -> RootState
 -> Focusing (StateT (EventState Name) IO) () RootState)
-> (([LogMessage]
     -> Focusing (StateT (EventState Name) IO) () [LogMessage])
    -> LogState -> Focusing (StateT (EventState Name) IO) () LogState)
-> ([LogMessage]
    -> Focusing (StateT (EventState Name) IO) () [LogMessage])
-> RootState
-> Focusing (StateT (EventState Name) IO) () RootState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([LogMessage]
 -> Focusing (StateT (EventState Name) IO) () [LogMessage])
-> LogState -> Focusing (StateT (EventState Name) IO) () LogState
Lens' LogState [LogMessage]
logMessagesL) (EventM Name [LogMessage] () -> EventM Name RootState ())
-> EventM Name [LogMessage] () -> EventM Name RootState ()
forall a b. (a -> b) -> a -> b
$
    (HydraEvent Tx -> EventM Name [LogMessage] ())
-> ()
-> BrickEvent Name (HydraEvent Tx)
-> EventM Name [LogMessage] ()
forall e n s a w.
(e -> EventM n s a) -> a -> BrickEvent w e -> EventM n s a
handleAppEventVia HydraEvent Tx -> EventM Name [LogMessage] ()
handleHydraEventsInfo () BrickEvent Name (HydraEvent Tx)
e
  -- XXX: Global events must be handled as the very last step.
  -- Any `EventM` that decides to `Continue` would override the `Halt` decision.
  BrickEvent Name (HydraEvent Tx) -> EventM Name RootState ()
handleGlobalEvents BrickEvent Name (HydraEvent Tx)
e

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

handleAppEventVia :: (e -> EventM n s a) -> a -> BrickEvent w e -> EventM n s a
handleAppEventVia :: forall e n s a w.
(e -> EventM n s a) -> a -> BrickEvent w e -> EventM n s a
handleAppEventVia e -> EventM n s a
f a
x = \case
  AppEvent e
e -> e -> EventM n s a
f e
e
  BrickEvent w e
_ -> a -> EventM n s a
forall a. a -> EventM n s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

handleVtyEventVia :: (Vty.Event -> EventM n s a) -> a -> BrickEvent w e -> EventM n s a
handleVtyEventVia :: forall n s a w e.
(Event -> EventM n s a) -> a -> BrickEvent w e -> EventM n s a
handleVtyEventVia Event -> EventM n s a
f a
x = \case
  VtyEvent Event
e -> Event -> EventM n s a
f Event
e
  BrickEvent w e
_ -> a -> EventM n s a
forall a. a -> EventM n s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

handleGlobalEvents :: BrickEvent Name (HydraEvent Tx) -> EventM Name RootState ()
handleGlobalEvents :: BrickEvent Name (HydraEvent Tx) -> EventM Name RootState ()
handleGlobalEvents = \case
  AppEvent HydraEvent Tx
_ -> () -> EventM Name RootState ()
forall a. a -> EventM Name RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  VtyEvent Event
e -> Event -> EventM Name RootState ()
forall n s. Event -> EventM n s ()
handleVtyGlobalEvents Event
e
  BrickEvent Name (HydraEvent Tx)
_ -> () -> EventM Name RootState ()
forall a. a -> EventM Name RootState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

handleVtyEventsHeadState :: CardanoClient -> Client Tx IO -> Vty.Event -> EventM Name HeadState ()
handleVtyEventsHeadState :: CardanoClient -> Client Tx IO -> Event -> EventM Name HeadState ()
handleVtyEventsHeadState CardanoClient
cardanoClient Client Tx IO
hydraClient Event
e = do
  HeadState
h <- Getting HeadState HeadState HeadState
-> EventM Name 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 Name HeadState ()
forall a. IO a -> EventM Name 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 Name HeadState ()
forall a. a -> EventM Name HeadState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    HeadState
_ -> () -> EventM Name HeadState ()
forall a. a -> EventM Name HeadState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  LensLike' (Zoomed (EventM Name ActiveLink) ()) HeadState ActiveLink
-> EventM Name ActiveLink () -> EventM Name HeadState ()
forall c.
LensLike' (Zoomed (EventM Name ActiveLink) c) HeadState ActiveLink
-> EventM Name ActiveLink c -> EventM Name 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 Name ActiveLink) ()) HeadState ActiveLink
(ActiveLink
 -> Focusing (StateT (EventState Name) IO) () ActiveLink)
-> HeadState -> Focusing (StateT (EventState Name) IO) () HeadState
Traversal' HeadState ActiveLink
activeLinkL (EventM Name ActiveLink () -> EventM Name HeadState ())
-> EventM Name ActiveLink () -> EventM Name HeadState ()
forall a b. (a -> b) -> a -> b
$ CardanoClient -> Client Tx IO -> Event -> EventM Name ActiveLink ()
handleVtyEventsActiveLink CardanoClient
cardanoClient Client Tx IO
hydraClient Event
e

handleVtyEventsActiveLink :: CardanoClient -> Client Tx IO -> Vty.Event -> EventM Name ActiveLink ()
handleVtyEventsActiveLink :: CardanoClient -> Client Tx IO -> Event -> EventM Name ActiveLink ()
handleVtyEventsActiveLink CardanoClient
cardanoClient Client Tx IO
hydraClient Event
e = do
  UTxO
utxo <- Getting UTxO ActiveLink UTxO -> EventM Name ActiveLink UTxO
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting UTxO ActiveLink UTxO
Lens' ActiveLink UTxO
utxoL
  LensLike'
  (Zoomed (EventM Name ActiveHeadState) ())
  ActiveLink
  ActiveHeadState
-> EventM Name ActiveHeadState () -> EventM Name ActiveLink ()
forall c.
LensLike'
  (Zoomed (EventM Name ActiveHeadState) c) ActiveLink ActiveHeadState
-> EventM Name ActiveHeadState c -> EventM Name 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 Name ActiveHeadState) ())
  ActiveLink
  ActiveHeadState
(ActiveHeadState
 -> Focusing (StateT (EventState Name) IO) () ActiveHeadState)
-> ActiveLink
-> Focusing (StateT (EventState Name) IO) () ActiveLink
Lens' ActiveLink ActiveHeadState
activeHeadStateL (EventM Name ActiveHeadState () -> EventM Name ActiveLink ())
-> EventM Name ActiveHeadState () -> EventM Name ActiveLink ()
forall a b. (a -> b) -> a -> b
$ CardanoClient
-> Client Tx IO -> UTxO -> Event -> EventM Name ActiveHeadState ()
handleVtyEventsActiveHeadState CardanoClient
cardanoClient Client Tx IO
hydraClient UTxO
utxo Event
e

handleVtyEventsActiveHeadState :: CardanoClient -> Client Tx IO -> UTxO -> Vty.Event -> EventM Name ActiveHeadState ()
handleVtyEventsActiveHeadState :: CardanoClient
-> Client Tx IO -> UTxO -> Event -> EventM Name ActiveHeadState ()
handleVtyEventsActiveHeadState CardanoClient
cardanoClient Client Tx IO
hydraClient UTxO
utxo Event
e = do
  LensLike'
  (Zoomed (EventM Name InitializingScreen) ())
  ActiveHeadState
  InitializingScreen
-> EventM Name InitializingScreen ()
-> EventM Name ActiveHeadState ()
forall c.
LensLike'
  (Zoomed (EventM Name InitializingScreen) c)
  ActiveHeadState
  InitializingScreen
-> EventM Name InitializingScreen c
-> EventM Name ActiveHeadState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((InitializingState
 -> Focusing (StateT (EventState Name) IO) () InitializingState)
-> ActiveHeadState
-> Focusing (StateT (EventState Name) IO) () ActiveHeadState
Traversal' ActiveHeadState InitializingState
initializingStateL ((InitializingState
  -> Focusing (StateT (EventState Name) IO) () InitializingState)
 -> ActiveHeadState
 -> Focusing (StateT (EventState Name) IO) () ActiveHeadState)
-> ((InitializingScreen
     -> Focusing (StateT (EventState Name) IO) () InitializingScreen)
    -> InitializingState
    -> Focusing (StateT (EventState Name) IO) () InitializingState)
-> (InitializingScreen
    -> Focusing (StateT (EventState Name) IO) () InitializingScreen)
-> ActiveHeadState
-> Focusing (StateT (EventState Name) IO) () ActiveHeadState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InitializingScreen
 -> Focusing (StateT (EventState Name) IO) () InitializingScreen)
-> InitializingState
-> Focusing (StateT (EventState Name) IO) () InitializingState
Lens' InitializingState InitializingScreen
initializingScreenL) (EventM Name InitializingScreen ()
 -> EventM Name ActiveHeadState ())
-> EventM Name InitializingScreen ()
-> EventM Name ActiveHeadState ()
forall a b. (a -> b) -> a -> b
$ CardanoClient
-> Client Tx IO -> Event -> EventM Name InitializingScreen ()
handleVtyEventsInitializingScreen CardanoClient
cardanoClient Client Tx IO
hydraClient Event
e
  LensLike'
  (Zoomed (EventM Name OpenScreen) ()) ActiveHeadState OpenScreen
-> EventM Name OpenScreen () -> EventM Name ActiveHeadState ()
forall c.
LensLike'
  (Zoomed (EventM Name OpenScreen) c) ActiveHeadState OpenScreen
-> EventM Name OpenScreen c -> EventM Name 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 Name OpenScreen) ()) ActiveHeadState OpenScreen
(OpenScreen
 -> Focusing (StateT (EventState Name) IO) () OpenScreen)
-> ActiveHeadState
-> Focusing (StateT (EventState Name) IO) () ActiveHeadState
Traversal' ActiveHeadState OpenScreen
openStateL (EventM Name OpenScreen () -> EventM Name ActiveHeadState ())
-> EventM Name OpenScreen () -> EventM Name ActiveHeadState ()
forall a b. (a -> b) -> a -> b
$ CardanoClient
-> Client Tx IO -> UTxO -> Event -> EventM Name OpenScreen ()
handleVtyEventsOpen CardanoClient
cardanoClient Client Tx IO
hydraClient UTxO
utxo Event
e
  ActiveHeadState
s <- Getting ActiveHeadState ActiveHeadState ActiveHeadState
-> EventM Name 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 Name ActiveHeadState ()
forall s. Client Tx IO -> Event -> EventM Name s ()
handleVtyEventsFanoutPossible Client Tx IO
hydraClient Event
e
    ActiveHeadState
Final -> Client Tx IO -> Event -> EventM Name ActiveHeadState ()
forall s. Client Tx IO -> Event -> EventM Name s ()
handleVtyEventsFinal Client Tx IO
hydraClient Event
e
    ActiveHeadState
_ -> () -> EventM Name ActiveHeadState ()
forall a. a -> EventM Name ActiveHeadState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

handleVtyEventsInitializingScreen :: CardanoClient -> Client Tx IO -> Vty.Event -> EventM Name InitializingScreen ()
handleVtyEventsInitializingScreen :: CardanoClient
-> Client Tx IO -> Event -> EventM Name InitializingScreen ()
handleVtyEventsInitializingScreen CardanoClient
cardanoClient Client Tx IO
hydraClient Event
e = do
  case Event
e of
    EvKey (KChar Char
'a') [] ->
      (InitializingScreen -> Identity InitializingScreen)
-> InitializingScreen -> Identity InitializingScreen
forall a. a -> a
id ((InitializingScreen -> Identity InitializingScreen)
 -> InitializingScreen -> Identity InitializingScreen)
-> InitializingScreen -> EventM Name InitializingScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Form Bool (HydraEvent Tx) Name -> InitializingScreen
ConfirmingAbort Form Bool (HydraEvent Tx) Name
forall s e n. (s ~ Bool, n ~ Name) => Form s e n
confirmRadioField
    Event
_ -> () -> EventM Name InitializingScreen ()
forall a. a -> EventM Name InitializingScreen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  InitializingScreen
initializingScreen <- Getting InitializingScreen InitializingScreen InitializingScreen
-> EventM Name InitializingScreen InitializingScreen
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting InitializingScreen InitializingScreen InitializingScreen
forall a. a -> a
id
  case InitializingScreen
initializingScreen of
    InitializingScreen
InitializingHome -> case Event
e of
      EvKey (KChar Char
'c') [] -> do
        UTxO
utxo <- IO UTxO -> EventM Name InitializingScreen UTxO
forall a. IO a -> EventM Name InitializingScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTxO -> EventM Name InitializingScreen UTxO)
-> IO UTxO -> EventM Name InitializingScreen UTxO
forall a b. (a -> b) -> a -> b
$ CardanoClient -> [Address ShelleyAddr] -> IO UTxO
queryUTxOByAddress CardanoClient
cardanoClient [CardanoClient -> Client Tx IO -> Address ShelleyAddr
mkMyAddress CardanoClient
cardanoClient Client Tx IO
hydraClient]
        (InitializingScreen -> Identity InitializingScreen)
-> InitializingScreen -> Identity InitializingScreen
forall a. a -> a
id ((InitializingScreen -> Identity InitializingScreen)
 -> InitializingScreen -> Identity InitializingScreen)
-> InitializingScreen -> EventM Name InitializingScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name
-> InitializingScreen
CommitMenu (Map TxIn (TxOut CtxUTxO)
-> Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name
forall s e n.
(s ~ Map TxIn (TxOut CtxUTxO, Bool), n ~ Name) =>
Map TxIn (TxOut CtxUTxO) -> Form s e n
utxoCheckboxField (Map TxIn (TxOut CtxUTxO)
 -> Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name)
-> Map TxIn (TxOut CtxUTxO)
-> Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name
forall a b. (a -> b) -> a -> b
$ UTxO -> Map TxIn (TxOut CtxUTxO)
forall out. UTxO' out -> Map TxIn out
UTxO.toMap UTxO
utxo)
      Event
_ -> () -> EventM Name InitializingScreen ()
forall a. a -> EventM Name InitializingScreen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    CommitMenu Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name
i -> do
      case Event
e of
        EvKey Key
KEsc [] -> (InitializingScreen -> Identity InitializingScreen)
-> InitializingScreen -> Identity InitializingScreen
forall a. a -> a
id ((InitializingScreen -> Identity InitializingScreen)
 -> InitializingScreen -> Identity InitializingScreen)
-> InitializingScreen -> EventM Name InitializingScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= InitializingScreen
InitializingHome
        EvKey Key
KEnter [] -> do
          let u :: Map TxIn (TxOut CtxUTxO, Bool)
u = Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name
-> Map TxIn (TxOut CtxUTxO, Bool)
forall s e n. Form s e n -> s
formState Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name
i
          let commitUTxO :: UTxO
commitUTxO = Map TxIn (TxOut CtxUTxO) -> UTxO
forall out. Map TxIn out -> UTxO' out
UTxO (Map TxIn (TxOut CtxUTxO) -> UTxO)
-> Map TxIn (TxOut CtxUTxO) -> UTxO
forall a b. (a -> b) -> a -> b
$ ((TxOut CtxUTxO, Bool) -> Maybe (TxOut CtxUTxO))
-> Map TxIn (TxOut CtxUTxO, Bool) -> Map TxIn (TxOut CtxUTxO)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (\(TxOut CtxUTxO
v, Bool
p) -> if Bool
p then TxOut CtxUTxO -> Maybe (TxOut CtxUTxO)
forall a. a -> Maybe a
Just TxOut CtxUTxO
v else Maybe (TxOut CtxUTxO)
forall a. Maybe a
Nothing) Map TxIn (TxOut CtxUTxO, Bool)
u
          IO () -> EventM Name InitializingScreen ()
forall a. IO a -> EventM Name InitializingScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Name InitializingScreen ())
-> IO () -> EventM Name InitializingScreen ()
forall a b. (a -> b) -> a -> b
$ Client Tx IO -> UTxO -> IO ()
forall tx (m :: * -> *). Client tx m -> UTxO -> m ()
externalCommit Client Tx IO
hydraClient UTxO
commitUTxO
          (InitializingScreen -> Identity InitializingScreen)
-> InitializingScreen -> Identity InitializingScreen
forall a. a -> a
id ((InitializingScreen -> Identity InitializingScreen)
 -> InitializingScreen -> Identity InitializingScreen)
-> InitializingScreen -> EventM Name InitializingScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= InitializingScreen
InitializingHome
        Event
_ -> () -> EventM Name InitializingScreen ()
forall a. a -> EventM Name InitializingScreen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      LensLike'
  (Zoomed
     (EventM
        Name (Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name))
     ())
  InitializingScreen
  (Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name)
-> EventM
     Name
     (Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name)
     ()
-> EventM Name InitializingScreen ()
forall c.
LensLike'
  (Zoomed
     (EventM
        Name (Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name))
     c)
  InitializingScreen
  (Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name)
-> EventM
     Name (Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name) c
-> EventM Name InitializingScreen 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
        Name (Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name))
     ())
  InitializingScreen
  (Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name)
(Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name
 -> Focusing
      (StateT (EventState Name) IO)
      ()
      (Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name))
-> InitializingScreen
-> Focusing (StateT (EventState Name) IO) () InitializingScreen
Traversal'
  InitializingScreen
  (Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name)
commitMenuL (EventM
   Name
   (Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name)
   ()
 -> EventM Name InitializingScreen ())
-> EventM
     Name
     (Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name)
     ()
-> EventM Name InitializingScreen ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Name (HydraEvent Tx)
-> EventM
     Name
     (Form (Map TxIn (TxOut CtxUTxO, Bool)) (HydraEvent Tx) Name)
     ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (Event -> BrickEvent Name (HydraEvent Tx)
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
    ConfirmingAbort Form Bool (HydraEvent Tx) Name
i -> do
      case Event
e of
        EvKey Key
KEsc [] -> (InitializingScreen -> Identity InitializingScreen)
-> InitializingScreen -> Identity InitializingScreen
forall a. a -> a
id ((InitializingScreen -> Identity InitializingScreen)
 -> InitializingScreen -> Identity InitializingScreen)
-> InitializingScreen -> EventM Name InitializingScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= InitializingScreen
InitializingHome
        EvKey Key
KEnter [] -> do
          let selected :: Bool
selected = Form Bool (HydraEvent Tx) Name -> Bool
forall s e n. Form s e n -> s
formState Form Bool (HydraEvent Tx) Name
i
          if Bool
selected
            then IO () -> EventM Name InitializingScreen ()
forall a. IO a -> EventM Name InitializingScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Name InitializingScreen ())
-> IO () -> EventM Name InitializingScreen ()
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
Abort
            else (InitializingScreen -> Identity InitializingScreen)
-> InitializingScreen -> Identity InitializingScreen
forall a. a -> a
id ((InitializingScreen -> Identity InitializingScreen)
 -> InitializingScreen -> Identity InitializingScreen)
-> InitializingScreen -> EventM Name InitializingScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= InitializingScreen
InitializingHome
        Event
_ -> () -> EventM Name InitializingScreen ()
forall a. a -> EventM Name InitializingScreen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      LensLike'
  (Zoomed (EventM Name (Form Bool (HydraEvent Tx) Name)) ())
  InitializingScreen
  (Form Bool (HydraEvent Tx) Name)
-> EventM Name (Form Bool (HydraEvent Tx) Name) ()
-> EventM Name InitializingScreen ()
forall c.
LensLike'
  (Zoomed (EventM Name (Form Bool (HydraEvent Tx) Name)) c)
  InitializingScreen
  (Form Bool (HydraEvent Tx) Name)
-> EventM Name (Form Bool (HydraEvent Tx) Name) c
-> EventM Name InitializingScreen 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 Name (Form Bool (HydraEvent Tx) Name)) ())
  InitializingScreen
  (Form Bool (HydraEvent Tx) Name)
(Form Bool (HydraEvent Tx) Name
 -> Focusing
      (StateT (EventState Name) IO) () (Form Bool (HydraEvent Tx) Name))
-> InitializingScreen
-> Focusing (StateT (EventState Name) IO) () InitializingScreen
Traversal' InitializingScreen (Form Bool (HydraEvent Tx) Name)
confirmingAbortFormL (EventM Name (Form Bool (HydraEvent Tx) Name) ()
 -> EventM Name InitializingScreen ())
-> EventM Name (Form Bool (HydraEvent Tx) Name) ()
-> EventM Name InitializingScreen ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Name (HydraEvent Tx)
-> EventM Name (Form Bool (HydraEvent Tx) Name) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (Event -> BrickEvent Name (HydraEvent Tx)
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)

handleVtyEventsOpen :: CardanoClient -> Client Tx IO -> UTxO -> Vty.Event -> EventM Name OpenScreen ()
handleVtyEventsOpen :: CardanoClient
-> Client Tx IO -> UTxO -> Event -> EventM Name OpenScreen ()
handleVtyEventsOpen CardanoClient
cardanoClient Client Tx IO
hydraClient UTxO
utxo Event
e = do
  case Event
e of
    EvKey (KChar Char
'c') [] ->
      (OpenScreen -> Identity OpenScreen)
-> OpenScreen -> Identity OpenScreen
forall a. a -> a
id ((OpenScreen -> Identity OpenScreen)
 -> OpenScreen -> Identity OpenScreen)
-> OpenScreen -> EventM Name OpenScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Form Bool (HydraEvent Tx) Name -> OpenScreen
ConfirmingClose Form Bool (HydraEvent Tx) Name
forall s e n. (s ~ Bool, n ~ Name) => Form s e n
confirmRadioField
    Event
_ -> () -> EventM Name OpenScreen ()
forall a. a -> EventM Name OpenScreen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  OpenScreen
k <- Getting OpenScreen OpenScreen OpenScreen
-> EventM Name OpenScreen OpenScreen
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting OpenScreen OpenScreen OpenScreen
forall a. a -> a
id
  case OpenScreen
k of
    ConfirmingClose Form Bool (HydraEvent Tx) Name
i -> do
      case Event
e of
        EvKey Key
KEsc [] -> (OpenScreen -> Identity OpenScreen)
-> OpenScreen -> Identity OpenScreen
forall a. a -> a
id ((OpenScreen -> Identity OpenScreen)
 -> OpenScreen -> Identity OpenScreen)
-> OpenScreen -> EventM Name OpenScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= OpenScreen
OpenHome
        EvKey Key
KEnter [] -> do
          let selected :: Bool
selected = Form Bool (HydraEvent Tx) Name -> Bool
forall s e n. Form s e n -> s
formState Form Bool (HydraEvent Tx) Name
i
          if Bool
selected
            then IO () -> EventM Name OpenScreen ()
forall a. IO a -> EventM Name OpenScreen a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Name OpenScreen ())
-> IO () -> EventM Name 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
            else (OpenScreen -> Identity OpenScreen)
-> OpenScreen -> Identity OpenScreen
forall a. a -> a
id ((OpenScreen -> Identity OpenScreen)
 -> OpenScreen -> Identity OpenScreen)
-> OpenScreen -> EventM Name OpenScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= OpenScreen
OpenHome
        Event
_ -> () -> EventM Name OpenScreen ()
forall a. a -> EventM Name OpenScreen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      LensLike'
  (Zoomed (EventM Name (Form Bool (HydraEvent Tx) Name)) ())
  OpenScreen
  (Form Bool (HydraEvent Tx) Name)
-> EventM Name (Form Bool (HydraEvent Tx) Name) ()
-> EventM Name OpenScreen ()
forall c.
LensLike'
  (Zoomed (EventM Name (Form Bool (HydraEvent Tx) Name)) c)
  OpenScreen
  (Form Bool (HydraEvent Tx) Name)
-> EventM Name (Form Bool (HydraEvent Tx) Name) c
-> EventM Name 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 Name (Form Bool (HydraEvent Tx) Name)) ())
  OpenScreen
  (Form Bool (HydraEvent Tx) Name)
(Form Bool (HydraEvent Tx) Name
 -> Focusing
      (StateT (EventState Name) IO) () (Form Bool (HydraEvent Tx) Name))
-> OpenScreen
-> Focusing (StateT (EventState Name) IO) () OpenScreen
Traversal' OpenScreen (Form Bool (HydraEvent Tx) Name)
confirmingCloseFormL (EventM Name (Form Bool (HydraEvent Tx) Name) ()
 -> EventM Name OpenScreen ())
-> EventM Name (Form Bool (HydraEvent Tx) Name) ()
-> EventM Name OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Name (HydraEvent Tx)
-> EventM Name (Form Bool (HydraEvent Tx) Name) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (Event -> BrickEvent Name (HydraEvent Tx)
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
    OpenScreen
OpenHome -> do
      case Event
e of
        EvKey (KChar Char
'n') [] -> do
          let utxo' :: Map TxIn (TxOut CtxUTxO)
utxo' = NetworkId
-> VerificationKey PaymentKey -> UTxO -> Map TxIn (TxOut CtxUTxO)
myAvailableUTxO (CardanoClient -> NetworkId
networkId CardanoClient
cardanoClient) (SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey (SigningKey PaymentKey -> VerificationKey PaymentKey)
-> SigningKey PaymentKey -> VerificationKey PaymentKey
forall a b. (a -> b) -> a -> b
$ Client Tx IO -> SigningKey PaymentKey
forall tx (m :: * -> *). Client tx m -> SigningKey PaymentKey
sk Client Tx IO
hydraClient) UTxO
utxo
          (OpenScreen -> Identity OpenScreen)
-> OpenScreen -> Identity OpenScreen
forall a. a -> a
id ((OpenScreen -> Identity OpenScreen)
 -> OpenScreen -> Identity OpenScreen)
-> OpenScreen -> EventM Name OpenScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name -> OpenScreen
SelectingUTxO (Map TxIn (TxOut CtxUTxO)
-> Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name
forall s e n.
(s ~ (TxIn, TxOut CtxUTxO), n ~ Name) =>
Map TxIn (TxOut CtxUTxO) -> Form s e n
utxoRadioField Map TxIn (TxOut CtxUTxO)
utxo')
        Event
_ -> () -> EventM Name OpenScreen ()
forall a. a -> EventM Name OpenScreen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    SelectingUTxO Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name
i -> do
      case Event
e of
        EvKey Key
KEsc [] -> (OpenScreen -> Identity OpenScreen)
-> OpenScreen -> Identity OpenScreen
forall a. a -> a
id ((OpenScreen -> Identity OpenScreen)
 -> OpenScreen -> Identity OpenScreen)
-> OpenScreen -> EventM Name OpenScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= OpenScreen
OpenHome
        EvKey Key
KEnter [] -> do
          let utxoSelected :: (TxIn, TxOut CtxUTxO)
utxoSelected@(TxIn
_, TxOut{txOutValue :: forall ctx. TxOut ctx -> Value
txOutValue = Value
v}) = Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name
-> (TxIn, TxOut CtxUTxO)
forall s e n. Form s e n -> s
formState Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name
i
          let Coin Integer
limit = Value -> Coin
selectLovelace Value
v
          let enteringAmountForm :: Form Integer (HydraEvent Tx) Name
enteringAmountForm =
                let field :: Integer -> FormFieldState Integer (HydraEvent Tx) Name
field = Lens' Integer Integer
-> Name
-> (Integer -> Bool)
-> Integer
-> FormFieldState Integer (HydraEvent Tx) Name
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 (Integer -> f Integer) -> Integer -> f Integer
forall a. a -> a
Lens' Integer Integer
id Name
"amount" (\Integer
n -> Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
limit)
                 in [Integer -> FormFieldState Integer (HydraEvent Tx) Name]
-> Integer -> Form Integer (HydraEvent Tx) Name
forall s e n. [s -> FormFieldState s e n] -> s -> Form s e n
newForm [Integer -> FormFieldState Integer (HydraEvent Tx) Name
field] Integer
limit
          (OpenScreen -> Identity OpenScreen)
-> OpenScreen -> Identity OpenScreen
forall a. a -> a
id ((OpenScreen -> Identity OpenScreen)
 -> OpenScreen -> Identity OpenScreen)
-> OpenScreen -> EventM Name OpenScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= EnteringAmount{(TxIn, TxOut CtxUTxO)
utxoSelected :: (TxIn, TxOut CtxUTxO)
$sel:utxoSelected:OpenHome :: (TxIn, TxOut CtxUTxO)
utxoSelected, Form Integer (HydraEvent Tx) Name
enteringAmountForm :: Form Integer (HydraEvent Tx) Name
$sel:enteringAmountForm:OpenHome :: Form Integer (HydraEvent Tx) Name
enteringAmountForm}
        Event
_ -> () -> EventM Name OpenScreen ()
forall a. a -> EventM Name OpenScreen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      LensLike'
  (Zoomed
     (EventM Name (Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name)) ())
  OpenScreen
  (Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name)
-> EventM Name (Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name) ()
-> EventM Name OpenScreen ()
forall c.
LensLike'
  (Zoomed
     (EventM Name (Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name)) c)
  OpenScreen
  (Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name)
-> EventM Name (Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name) c
-> EventM Name 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 Name (Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name)) ())
  OpenScreen
  (Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name)
(Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name
 -> Focusing
      (StateT (EventState Name) IO)
      ()
      (Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name))
-> OpenScreen
-> Focusing (StateT (EventState Name) IO) () OpenScreen
Traversal'
  OpenScreen (Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name)
selectingUTxOFormL (EventM Name (Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name) ()
 -> EventM Name OpenScreen ())
-> EventM Name (Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name) ()
-> EventM Name OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Name (HydraEvent Tx)
-> EventM Name (Form (TxIn, TxOut CtxUTxO) (HydraEvent Tx) Name) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (Event -> BrickEvent Name (HydraEvent Tx)
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
    EnteringAmount (TxIn, TxOut CtxUTxO)
utxoSelected Form Integer (HydraEvent Tx) Name
i -> do
      case Event
e of
        EvKey Key
KEsc [] -> (OpenScreen -> Identity OpenScreen)
-> OpenScreen -> Identity OpenScreen
forall a. a -> a
id ((OpenScreen -> Identity OpenScreen)
 -> OpenScreen -> Identity OpenScreen)
-> OpenScreen -> EventM Name OpenScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= OpenScreen
OpenHome
        EvKey Key
KEnter [] -> do
          let amountEntered :: Integer
amountEntered = Form Integer (HydraEvent Tx) Name -> Integer
forall s e n. Form s e n -> s
formState Form Integer (HydraEvent Tx) Name
i
          let ownAddress :: AddressInEra
ownAddress = forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress @Era (CardanoClient -> NetworkId
networkId CardanoClient
cardanoClient) (SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey (SigningKey PaymentKey -> VerificationKey PaymentKey)
-> SigningKey PaymentKey -> VerificationKey PaymentKey
forall a b. (a -> b) -> a -> b
$ Client Tx IO -> SigningKey PaymentKey
forall tx (m :: * -> *). Client tx m -> SigningKey PaymentKey
sk Client Tx IO
hydraClient)
          let field :: FormFieldRenderHelper AddressInEra Name
-> AddressInEra -> FormFieldState AddressInEra (HydraEvent Tx) Name
field =
                Char
-> Char
-> Char
-> Lens' AddressInEra AddressInEra
-> [(AddressInEra, Name, Name)]
-> FormFieldRenderHelper AddressInEra Name
-> AddressInEra
-> FormFieldState AddressInEra (HydraEvent Tx) Name
forall n a s e.
(Ord n, Eq a) =>
Char
-> Char
-> Char
-> Lens' s a
-> [(a, n, Name)]
-> FormFieldRenderHelper a n
-> s
-> FormFieldState s e n
customRadioField Char
'[' Char
'X' Char
']' (AddressInEra -> f AddressInEra) -> AddressInEra -> f AddressInEra
forall a. a -> a
Lens' AddressInEra AddressInEra
id ([(AddressInEra, Name, Name)]
 -> FormFieldRenderHelper AddressInEra Name
 -> AddressInEra
 -> FormFieldState AddressInEra (HydraEvent Tx) Name)
-> [(AddressInEra, Name, Name)]
-> FormFieldRenderHelper AddressInEra Name
-> AddressInEra
-> FormFieldState AddressInEra (HydraEvent Tx) Name
forall a b. (a -> b) -> a -> b
$
                  [ (AddressInEra
u, AddressInEra -> Name
forall b a. (Show a, IsString b) => a -> b
show AddressInEra
u, ByteString -> Name
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Name) -> ByteString -> Name
forall a b. (a -> b) -> a -> b
$ AddressInEra -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty AddressInEra
u)
                  | AddressInEra
u <- [AddressInEra] -> [AddressInEra]
forall a. Eq a => [a] -> [a]
nub [AddressInEra]
addresses
                  ]
              addresses :: [AddressInEra]
addresses = TxOut CtxUTxO -> AddressInEra
forall {ctx}. TxOut ctx -> AddressInEra
getRecipientAddress (TxOut CtxUTxO -> AddressInEra)
-> [TxOut CtxUTxO] -> [AddressInEra]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map TxIn (TxOut CtxUTxO) -> [TxOut CtxUTxO]
forall k a. Map k a -> [a]
Map.elems (UTxO -> Map TxIn (TxOut CtxUTxO)
forall out. UTxO' out -> Map TxIn out
UTxO.toMap UTxO
utxo)
              getRecipientAddress :: TxOut ctx -> AddressInEra
getRecipientAddress TxOut{txOutAddress :: forall {ctx}. TxOut ctx -> AddressInEra
txOutAddress = AddressInEra
addr} = AddressInEra
addr
              decorator :: FormFieldRenderHelper AddressInEra Name
decorator AddressInEra
a Name
_ Bool
_ =
                if AddressInEra
a AddressInEra -> AddressInEra -> Bool
forall a. Eq a => a -> a -> Bool
== AddressInEra
ownAddress
                  then AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
own
                  else Widget Name -> Widget Name
forall a. a -> a
id
          let selectingRecipientForm :: Form AddressInEra (HydraEvent Tx) Name
selectingRecipientForm = [AddressInEra -> FormFieldState AddressInEra (HydraEvent Tx) Name]
-> AddressInEra -> Form AddressInEra (HydraEvent Tx) Name
forall s e n. [s -> FormFieldState s e n] -> s -> Form s e n
newForm [FormFieldRenderHelper AddressInEra Name
-> AddressInEra -> FormFieldState AddressInEra (HydraEvent Tx) Name
field FormFieldRenderHelper AddressInEra Name
decorator] ([AddressInEra] -> AddressInEra
forall a. HasCallStack => [a] -> a
Prelude.head [AddressInEra]
addresses)
          (OpenScreen -> Identity OpenScreen)
-> OpenScreen -> Identity OpenScreen
forall a. a -> a
id ((OpenScreen -> Identity OpenScreen)
 -> OpenScreen -> Identity OpenScreen)
-> OpenScreen -> EventM Name OpenScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= SelectingRecipient{(TxIn, TxOut CtxUTxO)
$sel:utxoSelected:OpenHome :: (TxIn, TxOut CtxUTxO)
utxoSelected :: (TxIn, TxOut CtxUTxO)
utxoSelected, Integer
amountEntered :: Integer
$sel:amountEntered:OpenHome :: Integer
amountEntered, Form AddressInEra (HydraEvent Tx) Name
selectingRecipientForm :: Form AddressInEra (HydraEvent Tx) Name
$sel:selectingRecipientForm:OpenHome :: Form AddressInEra (HydraEvent Tx) Name
selectingRecipientForm}
        Event
_ -> () -> EventM Name OpenScreen ()
forall a. a -> EventM Name OpenScreen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      LensLike'
  (Zoomed (EventM Name (Form Integer (HydraEvent Tx) Name)) ())
  OpenScreen
  (Form Integer (HydraEvent Tx) Name)
-> EventM Name (Form Integer (HydraEvent Tx) Name) ()
-> EventM Name OpenScreen ()
forall c.
LensLike'
  (Zoomed (EventM Name (Form Integer (HydraEvent Tx) Name)) c)
  OpenScreen
  (Form Integer (HydraEvent Tx) Name)
-> EventM Name (Form Integer (HydraEvent Tx) Name) c
-> EventM Name 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 Name (Form Integer (HydraEvent Tx) Name)) ())
  OpenScreen
  (Form Integer (HydraEvent Tx) Name)
(Form Integer (HydraEvent Tx) Name
 -> Focusing
      (StateT (EventState Name) IO)
      ()
      (Form Integer (HydraEvent Tx) Name))
-> OpenScreen
-> Focusing (StateT (EventState Name) IO) () OpenScreen
Traversal' OpenScreen (Form Integer (HydraEvent Tx) Name)
enteringAmountFormL (EventM Name (Form Integer (HydraEvent Tx) Name) ()
 -> EventM Name OpenScreen ())
-> EventM Name (Form Integer (HydraEvent Tx) Name) ()
-> EventM Name OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Name (HydraEvent Tx)
-> EventM Name (Form Integer (HydraEvent Tx) Name) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (Event -> BrickEvent Name (HydraEvent Tx)
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
    SelectingRecipient (TxIn, TxOut CtxUTxO)
utxoSelected Integer
amountEntered Form AddressInEra (HydraEvent Tx) Name
i -> do
      case Event
e of
        EvKey Key
KEsc [] -> (OpenScreen -> Identity OpenScreen)
-> OpenScreen -> Identity OpenScreen
forall a. a -> a
id ((OpenScreen -> Identity OpenScreen)
 -> OpenScreen -> Identity OpenScreen)
-> OpenScreen -> EventM Name OpenScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= OpenScreen
OpenHome
        EvKey Key
KEnter [] -> do
          let recipient :: AddressInEra
recipient = Form AddressInEra (HydraEvent Tx) Name -> AddressInEra
forall s e n. Form s e n -> s
formState Form AddressInEra (HydraEvent Tx) Name
i
          case (TxIn, TxOut CtxUTxO)
-> (AddressInEra, Value)
-> SigningKey PaymentKey
-> Either TxBodyError Tx
mkSimpleTx (TxIn, TxOut CtxUTxO)
utxoSelected (AddressInEra
recipient, Coin -> Value
lovelaceToValue (Coin -> Value) -> Coin -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
amountEntered) (Client Tx IO -> SigningKey PaymentKey
forall tx (m :: * -> *). Client tx m -> SigningKey PaymentKey
sk Client Tx IO
hydraClient) of
            Left TxBodyError
_ -> () -> EventM Name OpenScreen ()
forall a. a -> EventM Name OpenScreen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Right Tx
tx -> do
              IO () -> EventM Name OpenScreen ()
forall a. IO a -> EventM Name 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 -> Identity OpenScreen)
-> OpenScreen -> Identity OpenScreen
forall a. a -> a
id ((OpenScreen -> Identity OpenScreen)
 -> OpenScreen -> Identity OpenScreen)
-> OpenScreen -> EventM Name OpenScreen ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= OpenScreen
OpenHome
        Event
_ -> () -> EventM Name OpenScreen ()
forall a. a -> EventM Name OpenScreen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      LensLike'
  (Zoomed (EventM Name (Form AddressInEra (HydraEvent Tx) Name)) ())
  OpenScreen
  (Form AddressInEra (HydraEvent Tx) Name)
-> EventM Name (Form AddressInEra (HydraEvent Tx) Name) ()
-> EventM Name OpenScreen ()
forall c.
LensLike'
  (Zoomed (EventM Name (Form AddressInEra (HydraEvent Tx) Name)) c)
  OpenScreen
  (Form AddressInEra (HydraEvent Tx) Name)
-> EventM Name (Form AddressInEra (HydraEvent Tx) Name) c
-> EventM Name 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 Name (Form AddressInEra (HydraEvent Tx) Name)) ())
  OpenScreen
  (Form AddressInEra (HydraEvent Tx) Name)
(Form AddressInEra (HydraEvent Tx) Name
 -> Focusing
      (StateT (EventState Name) IO)
      ()
      (Form AddressInEra (HydraEvent Tx) Name))
-> OpenScreen
-> Focusing (StateT (EventState Name) IO) () OpenScreen
Traversal' OpenScreen (Form AddressInEra (HydraEvent Tx) Name)
selectingRecipientFormL (EventM Name (Form AddressInEra (HydraEvent Tx) Name) ()
 -> EventM Name OpenScreen ())
-> EventM Name (Form AddressInEra (HydraEvent Tx) Name) ()
-> EventM Name OpenScreen ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Name (HydraEvent Tx)
-> EventM Name (Form AddressInEra (HydraEvent Tx) Name) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (Event -> BrickEvent Name (HydraEvent Tx)
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)

handleVtyEventsFanoutPossible :: Client Tx IO -> Vty.Event -> EventM Name s ()
handleVtyEventsFanoutPossible :: forall s. Client Tx IO -> Event -> EventM Name s ()
handleVtyEventsFanoutPossible Client Tx IO
hydraClient Event
e = do
  case Event
e of
    EvKey (KChar Char
'f') [] ->
      IO () -> EventM Name s ()
forall a. IO a -> EventM Name 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 Name s ()
forall a. a -> EventM Name 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 Name s ()
handleVtyEventsFinal Client Tx IO
hydraClient Event
e = do
  case Event
e of
    EvKey (KChar Char
'i') [] ->
      IO () -> EventM Name s ()
forall a. IO a -> EventM Name 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 Name s ()
forall a. a -> EventM Name s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

handleHydraEventsConnection :: HydraEvent Tx -> EventM Name Connection ()
handleHydraEventsConnection :: HydraEvent Tx -> EventM Name Connection ()
handleHydraEventsConnection = \case
  Update TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = Greetings{Party
me :: Party
$sel:me:PeerConnected :: forall tx. ServerOutput tx -> Party
me}} -> (IdentifiedState -> Identity IdentifiedState)
-> Connection -> Identity Connection
Lens' Connection IdentifiedState
meL ((IdentifiedState -> Identity IdentifiedState)
 -> Connection -> Identity Connection)
-> IdentifiedState -> EventM Name Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Party -> IdentifiedState
Identified Party
me
  Update TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = PeerConnected NodeId
p} -> ([NodeId] -> Identity [NodeId])
-> Connection -> Identity Connection
Lens' Connection [NodeId]
peersL (([NodeId] -> Identity [NodeId])
 -> Connection -> Identity Connection)
-> ([NodeId] -> [NodeId]) -> EventM Name Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \[NodeId]
cp -> [NodeId] -> [NodeId]
forall a. Eq a => [a] -> [a]
nub ([NodeId] -> [NodeId]) -> [NodeId] -> [NodeId]
forall a b. (a -> b) -> a -> b
$ [NodeId]
cp [NodeId] -> [NodeId] -> [NodeId]
forall a. Semigroup a => a -> a -> a
<> [NodeId
p]
  Update TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = PeerDisconnected NodeId
p} -> ([NodeId] -> Identity [NodeId])
-> Connection -> Identity Connection
Lens' Connection [NodeId]
peersL (([NodeId] -> Identity [NodeId])
 -> Connection -> Identity Connection)
-> ([NodeId] -> [NodeId]) -> EventM Name Connection ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \[NodeId]
cp -> [NodeId]
cp [NodeId] -> [NodeId] -> [NodeId]
forall a. Eq a => [a] -> [a] -> [a]
\\ [NodeId
p]
  HydraEvent Tx
e -> LensLike' (Zoomed (EventM Name HeadState) ()) Connection HeadState
-> EventM Name HeadState () -> EventM Name Connection ()
forall c.
LensLike' (Zoomed (EventM Name HeadState) c) Connection HeadState
-> EventM Name HeadState c -> EventM Name 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 Name HeadState) ()) Connection HeadState
(HeadState -> Focusing (StateT (EventState Name) IO) () HeadState)
-> Connection
-> Focusing (StateT (EventState Name) IO) () Connection
Lens' Connection HeadState
headStateL (EventM Name HeadState () -> EventM Name Connection ())
-> EventM Name HeadState () -> EventM Name Connection ()
forall a b. (a -> b) -> a -> b
$ HydraEvent Tx -> EventM Name HeadState ()
handleHydraEventsHeadState HydraEvent Tx
e

handleHydraEventsHeadState :: HydraEvent Tx -> EventM Name HeadState ()
handleHydraEventsHeadState :: HydraEvent Tx -> EventM Name HeadState ()
handleHydraEventsHeadState HydraEvent Tx
e = do
  case HydraEvent Tx
e of
    Update TimedServerOutput{UTCTime
time :: UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = HeadIsInitializing{[Party]
parties :: [Party]
$sel:parties:PeerConnected :: forall tx. ServerOutput tx -> [Party]
parties, HeadId
headId :: HeadId
$sel:headId:PeerConnected :: forall tx. ServerOutput tx -> HeadId
headId}} ->
      (HeadState -> Identity HeadState)
-> HeadState -> Identity HeadState
forall a. a -> a
id ((HeadState -> Identity HeadState)
 -> HeadState -> Identity HeadState)
-> HeadState -> EventM Name HeadState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= 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 TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = HeadIsAborted{}} ->
      (HeadState -> Identity HeadState)
-> HeadState -> Identity HeadState
forall a. a -> a
id ((HeadState -> Identity HeadState)
 -> HeadState -> Identity HeadState)
-> HeadState -> EventM Name HeadState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= HeadState
Idle
    HydraEvent Tx
_ -> () -> EventM Name HeadState ()
forall a. a -> EventM Name HeadState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  LensLike' (Zoomed (EventM Name ActiveLink) ()) HeadState ActiveLink
-> EventM Name ActiveLink () -> EventM Name HeadState ()
forall c.
LensLike' (Zoomed (EventM Name ActiveLink) c) HeadState ActiveLink
-> EventM Name ActiveLink c -> EventM Name 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 Name ActiveLink) ()) HeadState ActiveLink
(ActiveLink
 -> Focusing (StateT (EventState Name) IO) () ActiveLink)
-> HeadState -> Focusing (StateT (EventState Name) IO) () HeadState
Traversal' HeadState ActiveLink
activeLinkL (EventM Name ActiveLink () -> EventM Name HeadState ())
-> EventM Name ActiveLink () -> EventM Name HeadState ()
forall a b. (a -> b) -> a -> b
$ HydraEvent Tx -> EventM Name ActiveLink ()
handleHydraEventsActiveLink HydraEvent Tx
e

handleHydraEventsActiveLink :: HydraEvent Tx -> EventM Name ActiveLink ()
handleHydraEventsActiveLink :: HydraEvent Tx -> EventM Name ActiveLink ()
handleHydraEventsActiveLink HydraEvent Tx
e = do
  case HydraEvent Tx
e of
    Update TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = Committed{Party
party :: Party
$sel:party:PeerConnected :: forall tx. ServerOutput tx -> Party
party, UTxOType Tx
utxo :: UTxOType Tx
$sel:utxo:PeerConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxo}} -> do
      Party -> UTxO -> EventM Name ActiveLink ()
forall n. Party -> UTxO -> EventM n ActiveLink ()
partyCommitted Party
party UTxO
UTxOType Tx
utxo
    Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = HeadIsOpen{UTxOType Tx
$sel:utxo:PeerConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxo :: UTxOType Tx
utxo}} -> do
      (ActiveHeadState -> Identity ActiveHeadState)
-> ActiveLink -> Identity ActiveLink
Lens' ActiveLink ActiveHeadState
activeHeadStateL ((ActiveHeadState -> Identity ActiveHeadState)
 -> ActiveLink -> Identity ActiveLink)
-> ActiveHeadState -> EventM Name ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= OpenScreen -> ActiveHeadState
Open OpenScreen
OpenHome
    Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = SnapshotConfirmed{$sel:snapshot:PeerConnected :: 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 Name ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTxO
UTxOType Tx
utxo
    Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = HeadIsClosed{HeadId
$sel:headId:PeerConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, SnapshotNumber
snapshotNumber :: SnapshotNumber
$sel:snapshotNumber:PeerConnected :: forall tx. ServerOutput tx -> SnapshotNumber
snapshotNumber, UTCTime
contestationDeadline :: UTCTime
$sel:contestationDeadline:PeerConnected :: 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 Name ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Closed{$sel:closedState:Initializing :: ClosedState
closedState = ClosedState{UTCTime
contestationDeadline :: UTCTime
$sel:contestationDeadline:ClosedState :: UTCTime
contestationDeadline}}
    Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = ReadyToFanout{}} ->
      (ActiveHeadState -> Identity ActiveHeadState)
-> ActiveLink -> Identity ActiveLink
Lens' ActiveLink ActiveHeadState
activeHeadStateL ((ActiveHeadState -> Identity ActiveHeadState)
 -> ActiveLink -> Identity ActiveLink)
-> ActiveHeadState -> EventM Name ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ActiveHeadState
FanoutPossible
    Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = HeadIsFinalized{UTxOType Tx
$sel:utxo:PeerConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxo :: UTxOType Tx
utxo}} -> do
      (UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink
Lens' ActiveLink UTxO
utxoL ((UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink)
-> UTxO -> EventM Name ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTxO
UTxOType Tx
utxo
      (ActiveHeadState -> Identity ActiveHeadState)
-> ActiveLink -> Identity ActiveLink
Lens' ActiveLink ActiveHeadState
activeHeadStateL ((ActiveHeadState -> Identity ActiveHeadState)
 -> ActiveLink -> Identity ActiveLink)
-> ActiveHeadState -> EventM Name ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ActiveHeadState
Final
    HydraEvent Tx
_ -> () -> EventM Name ActiveLink ()
forall a. a -> EventM Name ActiveLink a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

handleHydraEventsInfo :: HydraEvent Tx -> EventM Name [LogMessage] ()
handleHydraEventsInfo :: HydraEvent Tx -> EventM Name [LogMessage] ()
handleHydraEventsInfo = \case
  Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = HeadIsInitializing{[Party]
$sel:parties:PeerConnected :: forall tx. ServerOutput tx -> [Party]
parties :: [Party]
parties, HeadId
$sel:headId:PeerConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId}} ->
    UTCTime -> Name -> EventM Name [LogMessage] ()
forall n. UTCTime -> Name -> EventM n [LogMessage] ()
info UTCTime
time Name
"Head is initializing"
  Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = Committed{Party
$sel:party:PeerConnected :: forall tx. ServerOutput tx -> Party
party :: Party
party, UTxOType Tx
$sel:utxo:PeerConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxo :: UTxOType Tx
utxo}} -> do
    UTCTime -> Name -> EventM Name [LogMessage] ()
forall n. UTCTime -> Name -> EventM n [LogMessage] ()
info UTCTime
time (Name -> EventM Name [LogMessage] ())
-> Name -> EventM Name [LogMessage] ()
forall a b. (a -> b) -> a -> b
$ Party -> Name
forall b a. (Show a, IsString b) => a -> b
show Party
party Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
" committed " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Value -> Name
renderValue (forall tx. IsTx tx => UTxOType tx -> ValueType tx
balance @Tx UTxOType Tx
utxo)
  Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = HeadIsOpen{UTxOType Tx
$sel:utxo:PeerConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxo :: UTxOType Tx
utxo}} -> do
    UTCTime -> Name -> EventM Name [LogMessage] ()
forall n. UTCTime -> Name -> EventM n [LogMessage] ()
info UTCTime
time Name
"Head is now open!"
  Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = HeadIsAborted{}} -> do
    UTCTime -> Name -> EventM Name [LogMessage] ()
forall n. UTCTime -> Name -> EventM n [LogMessage] ()
info UTCTime
time Name
"Head aborted, back to square one."
  Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = SnapshotConfirmed{$sel:snapshot:PeerConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{SnapshotNumber
number :: SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number}}} ->
    UTCTime -> Name -> EventM Name [LogMessage] ()
forall n. UTCTime -> Name -> EventM n [LogMessage] ()
info UTCTime
time (Name
"Snapshot #" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> SnapshotNumber -> Name
forall b a. (Show a, IsString b) => a -> b
show SnapshotNumber
number Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
" confirmed.")
  Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = CommandFailed{ClientInput Tx
clientInput :: ClientInput Tx
$sel:clientInput:PeerConnected :: forall tx. ServerOutput tx -> ClientInput tx
clientInput}} -> do
    UTCTime -> Name -> EventM Name [LogMessage] ()
forall n. UTCTime -> Name -> EventM n [LogMessage] ()
warn UTCTime
time (Name -> EventM Name [LogMessage] ())
-> Name -> EventM Name [LogMessage] ()
forall a b. (a -> b) -> a -> b
$ Name
"Invalid command: " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> ClientInput Tx -> Name
forall b a. (Show a, IsString b) => a -> b
show ClientInput Tx
clientInput
  Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = HeadIsClosed{SnapshotNumber
$sel:snapshotNumber:PeerConnected :: forall tx. ServerOutput tx -> SnapshotNumber
snapshotNumber :: SnapshotNumber
snapshotNumber}} -> do
    UTCTime -> Name -> EventM Name [LogMessage] ()
forall n. UTCTime -> Name -> EventM n [LogMessage] ()
info UTCTime
time (Name -> EventM Name [LogMessage] ())
-> Name -> EventM Name [LogMessage] ()
forall a b. (a -> b) -> a -> b
$ Name
"Head closed with snapshot number " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> SnapshotNumber -> Name
forall b a. (Show a, IsString b) => a -> b
show SnapshotNumber
snapshotNumber
  Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = TxValid{}} ->
    Severity -> UTCTime -> Name -> EventM Name [LogMessage] ()
forall n. Severity -> UTCTime -> Name -> EventM n [LogMessage] ()
report Severity
Success UTCTime
time Name
"Transaction submitted successfully!"
  Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = TxInvalid{Tx
transaction :: Tx
$sel:transaction:PeerConnected :: forall tx. ServerOutput tx -> tx
transaction, ValidationError
validationError :: ValidationError
$sel:validationError:PeerConnected :: forall tx. ServerOutput tx -> ValidationError
validationError}} ->
    UTCTime -> Name -> EventM Name [LogMessage] ()
forall n. UTCTime -> Name -> EventM n [LogMessage] ()
warn UTCTime
time (Name
"Transaction with id " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> TxId -> Name
forall b a. (Show a, IsString b) => a -> b
show (Tx -> TxIdType Tx
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx
transaction) Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
" is not applicable: " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> ValidationError -> Name
forall b a. (Show a, IsString b) => a -> b
show ValidationError
validationError)
  Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = HeadIsFinalized{UTxOType Tx
$sel:utxo:PeerConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxo :: UTxOType Tx
utxo}} -> do
    UTCTime -> Name -> EventM Name [LogMessage] ()
forall n. UTCTime -> Name -> EventM n [LogMessage] ()
info UTCTime
time Name
"Head is finalized"
  Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = InvalidInput{String
reason :: String
$sel:reason:PeerConnected :: forall tx. ServerOutput tx -> String
reason}} ->
    UTCTime -> Name -> EventM Name [LogMessage] ()
forall n. UTCTime -> Name -> EventM n [LogMessage] ()
warn UTCTime
time (Name
"Invalid input error: " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> String -> Name
forall a. ToText a => a -> Name
toText String
reason)
  Update TimedServerOutput{UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time, $sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = PostTxOnChainFailed{PostTxError Tx
postTxError :: PostTxError Tx
$sel:postTxError:PeerConnected :: forall tx. ServerOutput tx -> PostTxError tx
postTxError}} ->
    case PostTxError Tx
postTxError of
      PostTxError Tx
NotEnoughFuel -> do
        UTCTime -> Name -> EventM Name [LogMessage] ()
forall n. UTCTime -> Name -> EventM n [LogMessage] ()
warn UTCTime
time Name
"Not enough Fuel. Please provide more to the internal wallet and try again."
      InternalWalletError{Name
$sel:reason:NoSeedInput :: forall tx. PostTxError tx -> Name
reason :: Name
reason} ->
        UTCTime -> Name -> EventM Name [LogMessage] ()
forall n. UTCTime -> Name -> EventM n [LogMessage] ()
warn UTCTime
time Name
reason
      PostTxError Tx
_ -> UTCTime -> Name -> EventM Name [LogMessage] ()
forall n. UTCTime -> Name -> EventM n [LogMessage] ()
warn UTCTime
time (Name
"An error happened while trying to post a transaction on-chain: " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> PostTxError Tx -> Name
forall b a. (Show a, IsString b) => a -> b
show PostTxError Tx
postTxError)
  HydraEvent Tx
_ -> () -> EventM Name [LogMessage] ()
forall a. a -> EventM Name [LogMessage] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

partyCommitted :: Party -> UTxO -> EventM n ActiveLink ()
partyCommitted :: forall n. Party -> UTxO -> EventM n ActiveLink ()
partyCommitted Party
party UTxO
commit = do
  LensLike'
  (Zoomed (EventM n InitializingState) ())
  ActiveLink
  InitializingState
-> EventM n InitializingState () -> EventM n ActiveLink ()
forall c.
LensLike'
  (Zoomed (EventM n InitializingState) c)
  ActiveLink
  InitializingState
-> EventM n InitializingState c -> EventM n ActiveLink c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((ActiveHeadState
 -> Zoomed (EventM n InitializingState) () ActiveHeadState)
-> ActiveLink -> Zoomed (EventM n InitializingState) () ActiveLink
Lens' ActiveLink ActiveHeadState
activeHeadStateL ((ActiveHeadState
  -> Zoomed (EventM n InitializingState) () ActiveHeadState)
 -> ActiveLink -> Zoomed (EventM n InitializingState) () ActiveLink)
-> ((InitializingState
     -> Zoomed (EventM n InitializingState) () InitializingState)
    -> ActiveHeadState
    -> Zoomed (EventM n InitializingState) () ActiveHeadState)
-> LensLike'
     (Zoomed (EventM n InitializingState) ())
     ActiveLink
     InitializingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InitializingState
 -> Zoomed (EventM n InitializingState) () InitializingState)
-> ActiveHeadState
-> Zoomed (EventM n InitializingState) () ActiveHeadState
Traversal' ActiveHeadState InitializingState
initializingStateL) (EventM n InitializingState () -> EventM n ActiveLink ())
-> EventM n InitializingState () -> EventM n ActiveLink ()
forall a b. (a -> b) -> a -> b
$ do
    ([Party] -> Identity [Party])
-> InitializingState -> Identity InitializingState
Lens' InitializingState [Party]
remainingPartiesL (([Party] -> Identity [Party])
 -> InitializingState -> Identity InitializingState)
-> ([Party] -> [Party]) -> EventM n InitializingState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([Party] -> [Party] -> [Party]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Party
party])
  (UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink
Lens' ActiveLink UTxO
utxoL ((UTxO -> Identity UTxO) -> ActiveLink -> Identity ActiveLink)
-> (UTxO -> UTxO) -> EventM n ActiveLink ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> UTxO
commit)

handleBrickEventsConnection ::
  CardanoClient ->
  Client Tx IO ->
  BrickEvent w (HydraEvent Tx) ->
  EventM Name Connection ()
handleBrickEventsConnection :: forall w.
CardanoClient
-> Client Tx IO
-> BrickEvent w (HydraEvent Tx)
-> EventM Name Connection ()
handleBrickEventsConnection CardanoClient
cardanoClient Client Tx IO
hydraClient BrickEvent w (HydraEvent Tx)
x = case BrickEvent w (HydraEvent Tx)
x of
  AppEvent HydraEvent Tx
e -> HydraEvent Tx -> EventM Name Connection ()
handleHydraEventsConnection HydraEvent Tx
e
  VtyEvent Event
e -> CardanoClient -> Client Tx IO -> Event -> EventM Name Connection ()
handleVtyEventsConnection CardanoClient
cardanoClient Client Tx IO
hydraClient Event
e
  BrickEvent w (HydraEvent Tx)
_ -> () -> EventM Name Connection ()
forall a. a -> EventM Name Connection a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

handleVtyEventsConnection ::
  CardanoClient ->
  Client Tx IO ->
  Vty.Event ->
  EventM Name Connection ()
handleVtyEventsConnection :: CardanoClient -> Client Tx IO -> Event -> EventM Name Connection ()
handleVtyEventsConnection CardanoClient
cardanoClient Client Tx IO
hydraClient Event
e = do
  LensLike' (Zoomed (EventM Name HeadState) ()) Connection HeadState
-> EventM Name HeadState () -> EventM Name Connection ()
forall c.
LensLike' (Zoomed (EventM Name HeadState) c) Connection HeadState
-> EventM Name HeadState c -> EventM Name 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 Name HeadState) ()) Connection HeadState
(HeadState -> Focusing (StateT (EventState Name) IO) () HeadState)
-> Connection
-> Focusing (StateT (EventState Name) IO) () Connection
Lens' Connection HeadState
headStateL (EventM Name HeadState () -> EventM Name Connection ())
-> EventM Name HeadState () -> EventM Name Connection ()
forall a b. (a -> b) -> a -> b
$ CardanoClient -> Client Tx IO -> Event -> EventM Name HeadState ()
handleVtyEventsHeadState CardanoClient
cardanoClient Client Tx IO
hydraClient Event
e

handleVtyEventsLogState :: Vty.Event -> EventM Name LogState ()
handleVtyEventsLogState :: Event -> EventM Name LogState ()
handleVtyEventsLogState = \case
  EvKey (KChar Char
'<') [] -> Direction -> EventM Name LogState ()
scroll Direction
Up
  EvKey (KChar Char
'>') [] -> Direction -> EventM Name LogState ()
scroll Direction
Down
  EvKey (KChar Char
'h') [] -> (LogVerbosity -> Identity LogVerbosity)
-> LogState -> Identity LogState
Lens' LogState LogVerbosity
logVerbosityL ((LogVerbosity -> Identity LogVerbosity)
 -> LogState -> Identity LogState)
-> LogVerbosity -> EventM Name LogState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= LogVerbosity
Full
  EvKey (KChar Char
's') [] -> (LogVerbosity -> Identity LogVerbosity)
-> LogState -> Identity LogState
Lens' LogState LogVerbosity
logVerbosityL ((LogVerbosity -> Identity LogVerbosity)
 -> LogState -> Identity LogState)
-> LogVerbosity -> EventM Name LogState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= LogVerbosity
Short
  Event
_ -> () -> EventM Name LogState ()
forall a. a -> EventM Name LogState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

--
-- View
--
scroll :: Direction -> EventM Name LogState ()
scroll :: Direction -> EventM Name LogState ()
scroll Direction
direction = do
  LogVerbosity
x <- Getting LogVerbosity LogState LogVerbosity
-> EventM Name LogState LogVerbosity
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting LogVerbosity LogState LogVerbosity
Lens' LogState LogVerbosity
logVerbosityL
  case LogVerbosity
x of
    LogVerbosity
Full -> do
      let vp :: ViewportScroll Name
vp = Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
fullFeedbackViewportName
      ViewportScroll Name -> forall s. Direction -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll Name
vp Direction
direction
    LogVerbosity
Short -> do
      let vp :: ViewportScroll Name
vp = Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
shortFeedbackViewportName
      ViewportScroll Name -> forall s. Direction -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
hScrollPage ViewportScroll Name
vp Direction
direction

myAvailableUTxO :: NetworkId -> VerificationKey PaymentKey -> UTxO -> Map TxIn (TxOut CtxUTxO)
myAvailableUTxO :: NetworkId
-> VerificationKey PaymentKey -> UTxO -> Map TxIn (TxOut CtxUTxO)
myAvailableUTxO NetworkId
networkId VerificationKey PaymentKey
vk (UTxO Map TxIn (TxOut CtxUTxO)
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 -> Bool)
-> Map TxIn (TxOut CtxUTxO) -> Map TxIn (TxOut CtxUTxO)
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)
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
$ SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey (SigningKey PaymentKey -> VerificationKey PaymentKey)
-> SigningKey PaymentKey -> VerificationKey PaymentKey
forall a b. (a -> b) -> a -> b
$ Client Tx IO -> SigningKey PaymentKey
forall tx (m :: * -> *). Client tx m -> SigningKey PaymentKey
sk Client Tx IO
hydraClient)
    StakeAddressReference
NoStakeAddress