{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Hydra.TUI.Model where
import Hydra.Prelude hiding (Down, State, padLeft)
import Hydra.Cardano.Api
import Brick.Forms (Form)
import Hydra.Chain.Direct.State ()
import Hydra.Client (HydraEvent (..))
import Hydra.HeadId (HeadId)
import Hydra.Network (Host (..), NodeId)
import Hydra.Party (Party (..))
import Hydra.TUI.Logging.Types (LogState)
import Lens.Micro.TH (makeLensesFor)
data RootState = RootState
{ RootState -> Host
nodeHost :: Host
, RootState -> UTCTime
now :: UTCTime
, RootState -> ConnectedState
connectedState :: ConnectedState
, RootState -> LogState
logState :: LogState
}
data ConnectedState
= Disconnected
| Connected {ConnectedState -> Connection
connection :: Connection}
data IdentifiedState
= Unidentified
| Identified Party
data Connection = Connection
{ Connection -> IdentifiedState
me :: IdentifiedState
, Connection -> [NodeId]
peers :: [NodeId]
, Connection -> HeadState
headState :: HeadState
}
type UTxOCheckboxForm e n = Form (Map TxIn (TxOut CtxUTxO, Bool)) e n
type UTxORadioFieldForm e n = Form (TxIn, TxOut CtxUTxO) e n
type ConfirmingRadioFieldForm e n = Form Bool e n
data InitializingState = InitializingState
{ InitializingState -> [Party]
remainingParties :: [Party]
, InitializingState -> InitializingScreen
initializingScreen :: InitializingScreen
}
data InitializingScreen
= InitializingHome
| { :: UTxOCheckboxForm (HydraEvent Tx) Name}
| ConfirmingAbort {InitializingScreen -> ConfirmingRadioFieldForm (HydraEvent Tx) Name
confirmingAbortForm :: ConfirmingRadioFieldForm (HydraEvent Tx) Name}
data OpenScreen
= OpenHome
| SelectingUTxO {OpenScreen -> UTxORadioFieldForm (HydraEvent Tx) Name
selectingUTxOForm :: UTxORadioFieldForm (HydraEvent Tx) Name}
| EnteringAmount {OpenScreen -> (TxIn, TxOut CtxUTxO)
utxoSelected :: (TxIn, TxOut CtxUTxO), OpenScreen -> Form Integer (HydraEvent Tx) Name
enteringAmountForm :: Form Integer (HydraEvent Tx) Name}
| SelectingRecipient {utxoSelected :: (TxIn, TxOut CtxUTxO), OpenScreen -> Integer
amountEntered :: Integer, OpenScreen -> Form AddressInEra (HydraEvent Tx) Name
selectingRecipientForm :: Form AddressInEra (HydraEvent Tx) Name}
| ConfirmingClose {OpenScreen -> ConfirmingRadioFieldForm (HydraEvent Tx) Name
confirmingCloseForm :: ConfirmingRadioFieldForm (HydraEvent Tx) Name}
newtype ClosedState = ClosedState {ClosedState -> UTCTime
contestationDeadline :: UTCTime}
data HeadState
= Idle
| Active {HeadState -> ActiveLink
activeLink :: ActiveLink}
data ActiveLink = ActiveLink
{ ActiveLink -> UTxO
utxo :: UTxO
, ActiveLink -> [Party]
parties :: [Party]
, ActiveLink -> HeadId
headId :: HeadId
, ActiveLink -> ActiveHeadState
activeHeadState :: ActiveHeadState
}
data ActiveHeadState
= Initializing {ActiveHeadState -> InitializingState
initializingState :: InitializingState}
| Open {ActiveHeadState -> OpenScreen
openState :: OpenScreen}
| Closed {ActiveHeadState -> ClosedState
closedState :: ClosedState}
| FanoutPossible
| Final
type Name = Text
makeLensesFor
[ ("selectingUTxOForm", "selectingUTxOFormL")
, ("enteringAmountForm", "enteringAmountFormL")
, ("selectingRecipientForm", "selectingRecipientFormL")
, ("confirmingCloseForm", "confirmingCloseFormL")
]
''OpenScreen
makeLensesFor
[ ("initializingState", "initializingStateL")
, ("openState", "openStateL")
, ("closedState", "closedStateL")
]
''ActiveHeadState
makeLensesFor
[ ("connectedState", "connectedStateL")
, ("nodeHost", "nodeHostL")
, ("now", "nowL")
, ("logState", "logStateL")
]
''RootState
makeLensesFor
[("connection", "connectionL")]
''ConnectedState
makeLensesFor
[ ("transitionNote", "transitionNoteL")
, ("me", "meL")
, ("peers", "peersL")
, ("headState", "headStateL")
]
''Connection
makeLensesFor
[ ("remainingParties", "remainingPartiesL")
, ("initializingScreen", "initializingScreenL")
]
''InitializingState
makeLensesFor
[ ("activeLink", "activeLinkL")
]
''HeadState
makeLensesFor
[ ("utxo", "utxoL")
, ("parties", "partiesL")
, ("activeHeadState", "activeHeadStateL")
, ("headId", "headIdL")
]
''ActiveLink
fullFeedbackViewportName :: Name
fullFeedbackViewportName :: Name
fullFeedbackViewportName = Name
"full-feedback-view-port"
shortFeedbackViewportName :: Name
shortFeedbackViewportName :: Name
shortFeedbackViewportName = Name
"short-feedback-view-port"
emptyConnection :: Connection
emptyConnection :: Connection
emptyConnection =
Connection
{ $sel:me:Connection :: IdentifiedState
me = IdentifiedState
Unidentified
, $sel:peers:Connection :: [NodeId]
peers = []
, $sel:headState:Connection :: HeadState
headState = HeadState
Idle
}
newActiveLink :: [Party] -> HeadId -> ActiveLink
newActiveLink :: [Party] -> HeadId -> ActiveLink
newActiveLink [Party]
parties HeadId
headId =
ActiveLink
{ [Party]
$sel:parties:ActiveLink :: [Party]
parties :: [Party]
parties
, $sel:activeHeadState:ActiveLink :: ActiveHeadState
activeHeadState =
Initializing
{ $sel:initializingState:Initializing :: InitializingState
initializingState =
InitializingState
{ $sel:remainingParties:InitializingState :: [Party]
remainingParties = [Party]
parties
, $sel:initializingScreen:InitializingState :: InitializingScreen
initializingScreen = InitializingScreen
InitializingHome
}
}
, $sel:utxo:ActiveLink :: UTxO
utxo = UTxO
forall a. Monoid a => a
mempty
, HeadId
$sel:headId:ActiveLink :: HeadId
headId :: HeadId
headId
}