{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Hydra.TUI.Model where

import Hydra.Prelude hiding (Down, State)

import Data.Time.LocalTime (TimeZone)

import Hydra.Cardano.Api hiding (Active)

import Brick.Forms (Form)
import Brick.Widgets.List qualified as BrickList
import Data.Map qualified as Map
import Data.Vector qualified as Vec
import Hydra.API.ServerOutput (FanoutProgressMode (..), fanoutProgressMode)
import Hydra.Chain.Direct.State ()
import Hydra.Client (HydraEvent (..))
import Hydra.HeadLogic.State (CoordinatedHeadState (CoordinatedHeadState))
import Hydra.HeadLogic.State qualified as State
import Hydra.Network (Host (..))
import Hydra.Node.State (Deposit (..), NodeState (..))
import Hydra.TUI.Config (Theme (..))
import Hydra.TUI.Logging.Types (EventHistoryFilter, LogMessage, LogState)
import Hydra.Tx (HeadId, Party (..), Snapshot (..))
import Hydra.Tx.ContestationPeriod qualified as CP
import Hydra.Tx.HeadParameters as HeadParameters
import Hydra.Tx.Snapshot qualified as Snapshot
import Lens.Micro ((^.), (^?))
import Lens.Micro.TH (makeLensesFor)

-- | TUI-local event wrapper so we can inject async results alongside Hydra node events.
data TUIEvent tx
  = NodeEvent (HydraEvent tx)
  | UTxOQueryResult (Map TxIn (TxOut CtxUTxO))
  | L1UTxORefresh (Map TxIn (TxOut CtxUTxO))
  | FuelUTxORefresh (Map TxIn (TxOut CtxUTxO))
  | TxBuildError Text

data RootState = RootState
  { RootState -> Host
nodeHost :: Host
  , RootState -> UTCTime
now :: UTCTime
  , RootState -> TimeZone
timeZone :: TimeZone
  , RootState -> ConnectedState
connectedState :: ConnectedState
  , RootState -> LogState
logState :: LogState
  , RootState -> ActiveTab
activeTab :: ActiveTab
  , RootState -> Bool
eventDetailRaw :: Bool
  , RootState -> List Name LogMessage
eventHistoryList :: BrickList.List Name LogMessage
  , RootState -> Maybe Name
pendingAction :: Maybe Text
  , RootState -> Maybe (Map TxIn (TxOut CtxUTxO))
l1UTxO :: Maybe (Map TxIn (TxOut CtxUTxO))
  , RootState -> Maybe (VerificationKey PaymentKey)
fuelVk :: Maybe (VerificationKey PaymentKey)
  -- ^ Verification key of the node's internal wallet, if a fuel key was
  -- configured. Used to derive the fuel address and highlight its outputs.
  , RootState -> Maybe (Map TxIn (TxOut CtxUTxO))
fuelUTxO :: Maybe (Map TxIn (TxOut CtxUTxO))
  -- ^ Last queried UTxO at the fuel address. Display-only; never committed.
  , RootState -> ActiveTab
previousTab :: ActiveTab
  , RootState -> Theme
theme :: Theme
  , RootState -> Maybe (TxIdRadioFieldForm (HydraEvent Tx) Name)
recoveryForm :: Maybe (TxIdRadioFieldForm (HydraEvent Tx) Name)
  , RootState -> Maybe (UTxOCheckboxForm (HydraEvent Tx) Name)
fanoutSelectionForm :: Maybe (UTxOCheckboxForm (HydraEvent Tx) Name)
  -- ^ When set, the operator is multi-selecting which UTxOs to fan out for a
  -- selective 'PartialFanout' (a top-level modal flow, like 'recoveryForm').
  -- Available regardless of head state once fanout is possible.
  , RootState -> EventHistoryFilter
eventHistoryFilter :: EventHistoryFilter
  }

-- | Connection to the hydra node.
data ConnectedState
  = Disconnected
  | Connected {ConnectedState -> Connection
connection :: Connection}

data IdentifiedState
  = Unidentified
  | Identified Party

-- | Connectivity of the hydra node to the hydra network.
data NetworkState = NetworkConnected | NetworkDisconnected

-- | Synchronization status of the hydra node to the cardano chain.
data ChainSyncedStatus = InSync | CatchingUp

data PeerStatus = PeerIsConnected | PeerIsDisconnected | PeerIsUnknown

data Connection = Connection
  { Connection -> IdentifiedState
me :: IdentifiedState
  , Connection -> [(Host, PeerStatus)]
peers :: [(Host, PeerStatus)]
  , Connection -> Maybe NetworkState
networkState :: Maybe NetworkState
  , Connection -> ChainSyncedStatus
chainSyncedStatus :: ChainSyncedStatus
  , 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 TxIdRadioFieldForm e n = Form TxId e n

type ConfirmingRadioFieldForm e n = Form Bool e n

data OpenScreen
  = OpenHome
  | LoadingUTxOForIncrement
  | NoUTxOToIncrement
  | SelectingUTxO {OpenScreen -> UTxORadioFieldForm (HydraEvent Tx) Name
selectingUTxOForm :: UTxORadioFieldForm (HydraEvent Tx) Name}
  | SelectingUTxOToDecommit {OpenScreen -> UTxORadioFieldForm (HydraEvent Tx) Name
selectingUTxOToDecommitForm :: UTxORadioFieldForm (HydraEvent Tx) Name}
  | SelectingUTxOToIncrement {OpenScreen -> UTxORadioFieldForm (HydraEvent Tx) Name
selectingUTxOToIncrementForm :: UTxORadioFieldForm (HydraEvent Tx) Name}
  | EnteringAmount {OpenScreen -> (TxIn, TxOut CtxUTxO)
utxoSelected :: (TxIn, TxOut CtxUTxO), OpenScreen -> Form Double (HydraEvent Tx) Name
enteringAmountForm :: Form Double (HydraEvent Tx) Name}
  | SelectingRecipient
      { utxoSelected :: (TxIn, TxOut CtxUTxO)
      , OpenScreen -> Double
amountEntered :: Double
      , OpenScreen -> Form SelectAddressItem (HydraEvent Tx) Name
selectingRecipientForm :: Form SelectAddressItem (HydraEvent Tx) Name
      }
  | EnteringRecipientAddress
      { utxoSelected :: (TxIn, TxOut CtxUTxO)
      , amountEntered :: Double
      , OpenScreen -> Form AddressInEra (HydraEvent Tx) Name
enteringRecipientAddressForm :: Form AddressInEra (HydraEvent Tx) Name
      }
  | ConfirmingClose {OpenScreen -> ConfirmingRadioFieldForm (HydraEvent Tx) Name
confirmingCloseForm :: ConfirmingRadioFieldForm (HydraEvent Tx) Name}

data SelectAddressItem
  = ManualEntry
  | SelectAddress AddressInEra
  deriving stock (SelectAddressItem -> SelectAddressItem -> Bool
(SelectAddressItem -> SelectAddressItem -> Bool)
-> (SelectAddressItem -> SelectAddressItem -> Bool)
-> Eq SelectAddressItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectAddressItem -> SelectAddressItem -> Bool
== :: SelectAddressItem -> SelectAddressItem -> Bool
$c/= :: SelectAddressItem -> SelectAddressItem -> Bool
/= :: SelectAddressItem -> SelectAddressItem -> Bool
Eq, Int -> SelectAddressItem -> ShowS
[SelectAddressItem] -> ShowS
SelectAddressItem -> String
(Int -> SelectAddressItem -> ShowS)
-> (SelectAddressItem -> String)
-> ([SelectAddressItem] -> ShowS)
-> Show SelectAddressItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectAddressItem -> ShowS
showsPrec :: Int -> SelectAddressItem -> ShowS
$cshow :: SelectAddressItem -> String
show :: SelectAddressItem -> String
$cshowList :: [SelectAddressItem] -> ShowS
showList :: [SelectAddressItem] -> ShowS
Show)

instance Pretty SelectAddressItem where
  pretty :: forall ann. SelectAddressItem -> Doc ann
pretty = \case
    SelectAddressItem
ManualEntry -> Doc ann
"Manual entry"
    SelectAddress AddressInEra
addr -> Name -> Doc ann
forall ann. Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Name -> Doc ann) -> Name -> Doc ann
forall a b. (a -> b) -> a -> b
$ AddressInEra -> Name
forall addr. SerialiseAddress addr => addr -> Name
serialiseAddress AddressInEra
addr

newtype ClosedState = ClosedState {ClosedState -> UTCTime
contestationDeadline :: UTCTime}

data HeadState
  = Idle
  | Active {HeadState -> ActiveLink
activeLink :: ActiveLink}

data PendingIncrementStatus
  = PendingDeposit
  | FinalizingDeposit
  deriving stock (Int -> PendingIncrementStatus -> ShowS
[PendingIncrementStatus] -> ShowS
PendingIncrementStatus -> String
(Int -> PendingIncrementStatus -> ShowS)
-> (PendingIncrementStatus -> String)
-> ([PendingIncrementStatus] -> ShowS)
-> Show PendingIncrementStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PendingIncrementStatus -> ShowS
showsPrec :: Int -> PendingIncrementStatus -> ShowS
$cshow :: PendingIncrementStatus -> String
show :: PendingIncrementStatus -> String
$cshowList :: [PendingIncrementStatus] -> ShowS
showList :: [PendingIncrementStatus] -> ShowS
Show)

data PendingIncrement
  = PendingIncrement
  { PendingIncrement -> UTxO
utxoToCommit :: UTxO
  , PendingIncrement -> TxId
deposit :: TxId
  , PendingIncrement -> UTCTime
depositDeadline :: UTCTime
  , PendingIncrement -> PendingIncrementStatus
status :: PendingIncrementStatus
  }

data ActiveLink = ActiveLink
  { ActiveLink -> UTxO
utxo :: UTxO
  , ActiveLink -> UTxO
pendingUTxOToDecommit :: UTxO
  , ActiveLink -> [PendingIncrement]
pendingIncrements :: [PendingIncrement]
  , ActiveLink -> [Party]
parties :: [Party]
  , ActiveLink -> HeadId
headId :: HeadId
  , ActiveLink -> ActiveHeadState
activeHeadState :: ActiveHeadState
  }

data ActiveHeadState
  = Open {ActiveHeadState -> OpenScreen
openState :: OpenScreen}
  | Closed {ActiveHeadState -> ClosedState
closedState :: ClosedState}
  | FanoutPossible
  | -- | A selective partial fanout is in progress (on-chain @FanoutProgress@):
    -- some UTxO has been distributed and 'fanoutRemaining' is still in the head.
    -- Only further partial fanouts are accepted (no full 'Fanout'). 'fanoutMode'
    -- (reported by the node) says whether it keeps draining on its own or awaits
    -- the next selection, driving what the UI offers.
    FanningOut {ActiveHeadState -> UTxO
fanoutRemaining :: UTxO, ActiveHeadState -> FanoutProgressMode
fanoutMode :: FanoutProgressMode}
  | Final

type Name = Text

data ActiveTab = MainTab | FundsTab | EventHistoryTab | ModalTab
  deriving stock (ActiveTab -> ActiveTab -> Bool
(ActiveTab -> ActiveTab -> Bool)
-> (ActiveTab -> ActiveTab -> Bool) -> Eq ActiveTab
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActiveTab -> ActiveTab -> Bool
== :: ActiveTab -> ActiveTab -> Bool
$c/= :: ActiveTab -> ActiveTab -> Bool
/= :: ActiveTab -> ActiveTab -> Bool
Eq)

makeLensesFor
  [ ("selectingUTxOForm", "selectingUTxOFormL")
  , ("selectingUTxOToDecommitForm", "selectingUTxOToDecommitFormL")
  , ("selectingUTxOToIncrementForm", "selectingUTxOToIncrementFormL")
  , ("enteringAmountForm", "enteringAmountFormL")
  , ("selectingRecipientForm", "selectingRecipientFormL")
  , ("enteringRecipientAddressForm", "enteringRecipientAddressFormL")
  , ("confirmingCloseForm", "confirmingCloseFormL")
  ]
  ''OpenScreen

makeLensesFor
  [ ("initializingState", "initializingStateL")
  , ("openState", "openStateL")
  , ("closedState", "closedStateL")
  ]
  ''ActiveHeadState

makeLensesFor
  [ ("connectedState", "connectedStateL")
  , ("now", "nowL")
  , ("timeZone", "timeZoneL")
  , ("logState", "logStateL")
  , ("activeTab", "activeTabL")
  , ("eventDetailRaw", "eventDetailRawL")
  , ("eventHistoryList", "eventHistoryListL")
  , ("pendingAction", "pendingActionL")
  , ("l1UTxO", "l1UTxOL")
  , ("fuelVk", "fuelVkL")
  , ("fuelUTxO", "fuelUTxOL")
  , ("previousTab", "previousTabL")
  , ("theme", "themeL")
  , ("recoveryForm", "recoveryFormL")
  , ("fanoutSelectionForm", "fanoutSelectionFormL")
  , ("eventHistoryFilter", "eventHistoryFilterL")
  ]
  ''RootState

makeLensesFor
  [("connection", "connectionL")]
  ''ConnectedState

makeLensesFor
  [ ("me", "meL")
  , ("peers", "peersL")
  , ("networkState", "networkStateL")
  , ("chainSyncedStatus", "chainSyncedStatusL")
  , ("headState", "headStateL")
  ]
  ''Connection

makeLensesFor
  [ ("activeLink", "activeLinkL")
  ]
  ''HeadState

makeLensesFor
  [ ("utxo", "utxoL")
  , ("pendingUTxOToDecommit", "pendingUTxOToDecommitL")
  , ("pendingIncrements", "pendingIncrementsL")
  , ("activeHeadState", "activeHeadStateL")
  ]
  ''ActiveLink

eventHistoryListName :: Name
eventHistoryListName :: Name
eventHistoryListName = Name
"event-history-list"

mainUTxOViewportName :: Name
mainUTxOViewportName :: Name
mainUTxOViewportName = Name
"main-utxo"

fundsL2ViewportName :: Name
fundsL2ViewportName :: Name
fundsL2ViewportName = Name
"funds-l2"

fundsL1ViewportName :: Name
fundsL1ViewportName :: Name
fundsL1ViewportName = Name
"funds-l1"

fundsFuelViewportName :: Name
fundsFuelViewportName :: Name
fundsFuelViewportName = Name
"funds-fuel"

fanoutSelectionViewportName :: Name
fanoutSelectionViewportName :: Name
fanoutSelectionViewportName = Name
"fanout-selection"

emptyEventHistoryList :: BrickList.List Name LogMessage
emptyEventHistoryList :: List Name LogMessage
emptyEventHistoryList = Name -> Vector LogMessage -> Int -> List Name LogMessage
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BrickList.list Name
eventHistoryListName Vector LogMessage
forall a. Vector a
Vec.empty Int
1

emptyConnection :: Connection
emptyConnection :: Connection
emptyConnection =
  Connection
    { $sel:me:Connection :: IdentifiedState
me = IdentifiedState
Unidentified
    , $sel:peers:Connection :: [(Host, PeerStatus)]
peers = []
    , $sel:networkState:Connection :: Maybe NetworkState
networkState = Maybe NetworkState
forall a. Maybe a
Nothing
    , $sel:chainSyncedStatus:Connection :: ChainSyncedStatus
chainSyncedStatus = ChainSyncedStatus
CatchingUp
    , $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 = Open{$sel:openState:Open :: OpenScreen
openState = OpenScreen
OpenHome}
    , $sel:utxo:ActiveLink :: UTxO
utxo = UTxO
forall a. Monoid a => a
mempty
    , $sel:pendingUTxOToDecommit:ActiveLink :: UTxO
pendingUTxOToDecommit = UTxO
forall a. Monoid a => a
mempty
    , $sel:pendingIncrements:ActiveLink :: [PendingIncrement]
pendingIncrements = [PendingIncrement]
forall a. Monoid a => a
mempty
    , HeadId
$sel:headId:ActiveLink :: HeadId
headId :: HeadId
headId
    }

isModalOpen :: RootState -> Bool
isModalOpen :: RootState -> Bool
isModalOpen RootState
s =
  RootState
s RootState -> Getting ActiveTab RootState ActiveTab -> ActiveTab
forall s a. s -> Getting a s a -> a
^. Getting ActiveTab RootState ActiveTab
Lens' RootState ActiveTab
activeTabL ActiveTab -> ActiveTab -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveTab
ModalTab
    Bool -> Bool -> Bool
|| case RootState
s
      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 of
      Maybe OpenScreen
Nothing -> Bool
False
      Just OpenScreen
OpenHome -> Bool
False
      Just OpenScreen
LoadingUTxOForIncrement -> Bool
False -- handled by ModalTab check above
      Just OpenScreen
_ -> Bool
True

recoverHeadState :: UTCTime -> HeadState -> NodeState Tx -> HeadState
recoverHeadState :: UTCTime -> HeadState -> NodeState Tx -> HeadState
recoverHeadState UTCTime
now HeadState
current NodeState Tx
nodeState =
  case NodeState Tx
nodeState.headState of
    State.Idle State.IdleState{} -> HeadState
current
    State.Open
      State.OpenState
        { HeadParameters
parameters :: HeadParameters
$sel:parameters:OpenState :: forall tx. OpenState tx -> HeadParameters
parameters
        , HeadId
headId :: HeadId
$sel:headId:OpenState :: forall tx. OpenState tx -> HeadId
headId
        , $sel:coordinatedHeadState:OpenState :: forall tx. OpenState tx -> CoordinatedHeadState tx
coordinatedHeadState = CoordinatedHeadState{ConfirmedSnapshot Tx
confirmedSnapshot :: ConfirmedSnapshot Tx
$sel:confirmedSnapshot:CoordinatedHeadState :: forall tx. CoordinatedHeadState tx -> ConfirmedSnapshot tx
confirmedSnapshot}
        } ->
        let Snapshot{UTxOType Tx
utxo :: UTxOType Tx
$sel:utxo:Snapshot :: forall tx. Snapshot tx -> UTxOType tx
utxo, Maybe (UTxOType Tx)
utxoToDecommit :: Maybe (UTxOType Tx)
$sel:utxoToDecommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit} = ConfirmedSnapshot Tx -> Snapshot Tx
forall tx. IsTx tx => ConfirmedSnapshot tx -> Snapshot tx
Snapshot.getSnapshot ConfirmedSnapshot Tx
confirmedSnapshot
         in ActiveLink -> HeadState
Active
              ActiveLink
                { UTxO
UTxOType Tx
$sel:utxo:ActiveLink :: UTxO
utxo :: UTxOType Tx
utxo
                , $sel:pendingUTxOToDecommit:ActiveLink :: UTxO
pendingUTxOToDecommit = UTxO -> Maybe UTxO -> UTxO
forall a. a -> Maybe a -> a
fromMaybe UTxO
forall a. Monoid a => a
mempty Maybe UTxO
Maybe (UTxOType Tx)
utxoToDecommit
                , [PendingIncrement]
$sel:pendingIncrements:ActiveLink :: [PendingIncrement]
pendingIncrements :: [PendingIncrement]
pendingIncrements
                , $sel:parties:ActiveLink :: [Party]
parties = HeadParameters -> [Party]
HeadParameters.parties HeadParameters
parameters
                , HeadId
$sel:headId:ActiveLink :: HeadId
headId :: HeadId
headId
                , $sel:activeHeadState:ActiveLink :: ActiveHeadState
activeHeadState = OpenScreen -> ActiveHeadState
Open OpenScreen
OpenHome
                }
    State.Closed
      State.ClosedState
        { HeadParameters
parameters :: HeadParameters
$sel:parameters:ClosedState :: forall tx. ClosedState tx -> HeadParameters
parameters
        , HeadId
headId :: HeadId
$sel:headId:ClosedState :: forall tx. ClosedState tx -> HeadId
headId
        , ConfirmedSnapshot Tx
confirmedSnapshot :: ConfirmedSnapshot Tx
$sel:confirmedSnapshot:ClosedState :: forall tx. ClosedState tx -> ConfirmedSnapshot tx
confirmedSnapshot
        , Bool
readyToFanoutSent :: Bool
$sel:readyToFanoutSent:ClosedState :: forall tx. ClosedState tx -> Bool
readyToFanoutSent
        } ->
        let Snapshot{UTxOType Tx
$sel:utxo:Snapshot :: forall tx. Snapshot tx -> UTxOType tx
utxo :: UTxOType Tx
utxo, Maybe (UTxOType Tx)
$sel:utxoToDecommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType Tx)
utxoToDecommit} = ConfirmedSnapshot Tx -> Snapshot Tx
forall tx. IsTx tx => ConfirmedSnapshot tx -> Snapshot tx
Snapshot.getSnapshot ConfirmedSnapshot Tx
confirmedSnapshot
            contestationDeadline :: UTCTime
contestationDeadline = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (ContestationPeriod -> NominalDiffTime
CP.toNominalDiffTime (ContestationPeriod -> NominalDiffTime)
-> ContestationPeriod -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ HeadParameters -> ContestationPeriod
HeadParameters.contestationPeriod HeadParameters
parameters) UTCTime
now
         in ActiveLink -> HeadState
Active
              ActiveLink
                { UTxO
UTxOType Tx
$sel:utxo:ActiveLink :: UTxO
utxo :: UTxOType Tx
utxo
                , $sel:pendingUTxOToDecommit:ActiveLink :: UTxO
pendingUTxOToDecommit = UTxO -> Maybe UTxO -> UTxO
forall a. a -> Maybe a -> a
fromMaybe UTxO
forall a. Monoid a => a
mempty Maybe UTxO
Maybe (UTxOType Tx)
utxoToDecommit
                , [PendingIncrement]
$sel:pendingIncrements:ActiveLink :: [PendingIncrement]
pendingIncrements :: [PendingIncrement]
pendingIncrements
                , $sel:parties:ActiveLink :: [Party]
parties = HeadParameters -> [Party]
HeadParameters.parties HeadParameters
parameters
                , HeadId
$sel:headId:ActiveLink :: HeadId
headId :: HeadId
headId
                , $sel:activeHeadState:ActiveLink :: ActiveHeadState
activeHeadState =
                    if Bool
readyToFanoutSent
                      then ActiveHeadState
FanoutPossible
                      else Closed{$sel:closedState:Open :: ClosedState
closedState = ClosedState{UTCTime
$sel:contestationDeadline:ClosedState :: UTCTime
contestationDeadline :: UTCTime
contestationDeadline}}
                }
    State.FanoutProgress
      State.PartialFanoutState
        { HeadParameters
parameters :: HeadParameters
$sel:parameters:PartialFanoutState :: forall tx. PartialFanoutState tx -> HeadParameters
parameters
        , HeadId
headId :: HeadId
$sel:headId:PartialFanoutState :: forall tx. PartialFanoutState tx -> HeadId
headId
        , ConfirmedSnapshot Tx
confirmedSnapshot :: ConfirmedSnapshot Tx
$sel:confirmedSnapshot:PartialFanoutState :: forall tx. PartialFanoutState tx -> ConfirmedSnapshot tx
confirmedSnapshot
        , UTxOType Tx
remainingOutputs :: UTxOType Tx
$sel:remainingOutputs:PartialFanoutState :: forall tx. PartialFanoutState tx -> UTxOType tx
remainingOutputs
        , FanoutMode Tx
mode :: FanoutMode Tx
$sel:mode:PartialFanoutState :: forall tx. PartialFanoutState tx -> FanoutMode tx
mode
        } ->
        let Snapshot{Maybe (UTxOType Tx)
$sel:utxoToDecommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType Tx)
utxoToDecommit} = ConfirmedSnapshot Tx -> Snapshot Tx
forall tx. IsTx tx => ConfirmedSnapshot tx -> Snapshot tx
Snapshot.getSnapshot ConfirmedSnapshot Tx
confirmedSnapshot
         in ActiveLink -> HeadState
Active
              ActiveLink
                { $sel:utxo:ActiveLink :: UTxO
utxo = UTxO
UTxOType Tx
remainingOutputs
                , $sel:pendingUTxOToDecommit:ActiveLink :: UTxO
pendingUTxOToDecommit = UTxO -> Maybe UTxO -> UTxO
forall a. a -> Maybe a -> a
fromMaybe UTxO
forall a. Monoid a => a
mempty Maybe UTxO
Maybe (UTxOType Tx)
utxoToDecommit
                , [PendingIncrement]
$sel:pendingIncrements:ActiveLink :: [PendingIncrement]
pendingIncrements :: [PendingIncrement]
pendingIncrements
                , $sel:parties:ActiveLink :: [Party]
parties = HeadParameters -> [Party]
HeadParameters.parties HeadParameters
parameters
                , HeadId
$sel:headId:ActiveLink :: HeadId
headId :: HeadId
headId
                , $sel:activeHeadState:ActiveLink :: ActiveHeadState
activeHeadState = FanningOut{fanoutRemaining :: UTxO
fanoutRemaining = UTxO
UTxOType Tx
remainingOutputs, fanoutMode :: FanoutProgressMode
fanoutMode = FanoutMode Tx -> FanoutProgressMode
forall tx. FanoutMode tx -> FanoutProgressMode
fanoutProgressMode FanoutMode Tx
mode}
                }
 where
  pendingIncrements :: [PendingIncrement]
pendingIncrements =
    Map TxId (Deposit Tx) -> [(TxId, Deposit Tx)]
forall k a. Map k a -> [(k, a)]
Map.toList NodeState Tx
nodeState.pendingDeposits
      [(TxId, Deposit Tx)]
-> ((TxId, Deposit Tx) -> PendingIncrement) -> [PendingIncrement]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \(TxId
txId', Deposit{UTxOType Tx
deposited :: UTxOType Tx
$sel:deposited:Deposit :: forall tx. Deposit tx -> UTxOType tx
deposited, UTCTime
deadline :: UTCTime
$sel:deadline:Deposit :: forall tx. Deposit tx -> UTCTime
deadline}) ->
              PendingIncrement
                { $sel:utxoToCommit:PendingIncrement :: UTxO
utxoToCommit = UTxO
UTxOType Tx
deposited
                , $sel:deposit:PendingIncrement :: TxId
deposit = TxId
txId'
                , $sel:depositDeadline:PendingIncrement :: UTCTime
depositDeadline = UTCTime
deadline
                , $sel:status:PendingIncrement :: PendingIncrementStatus
status = PendingIncrementStatus
PendingDeposit
                }
          )