{-# 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.Network (Host (..), NodeId)
import Hydra.TUI.Logging.Types (LogState)
import Hydra.Tx (HeadId, Party (..))
import Lens.Micro ((^?))
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
  | CommitMenu {InitializingScreen -> UTxOCheckboxForm (HydraEvent Tx) Name
commitMenu :: 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}
  | 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 Integer (HydraEvent Tx) Name
enteringAmountForm :: Form Integer (HydraEvent Tx) Name}
  | SelectingRecipient
      { utxoSelected :: (TxIn, TxOut CtxUTxO)
      , OpenScreen -> Integer
amountEntered :: Integer
      , OpenScreen -> Form SelectAddressItem (HydraEvent Tx) Name
selectingRecipientForm :: Form SelectAddressItem (HydraEvent Tx) Name
      }
  | EnteringRecipientAddress
      { utxoSelected :: (TxIn, TxOut CtxUTxO)
      , amountEntered :: Integer
      , 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 (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 PendingIncrement
  = PendingDeposit
      { PendingIncrement -> UTxO
utxoToCommit :: UTxO
      , PendingIncrement -> TxId
deposit :: TxId
      , PendingIncrement -> UTCTime
depositDeadline :: UTCTime
      }
  | PendingIncrement
      { utxoToCommit :: UTxO
      }

data ActiveLink = ActiveLink
  { ActiveLink -> UTxO
utxo :: UTxO
  , ActiveLink -> UTxO
pendingUTxOToDecommit :: UTxO
  , ActiveLink -> Maybe PendingIncrement
pendingIncrement :: Maybe PendingIncrement
  , 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")
  , ("selectingUTxOToDecommitForm", "selectingUTxOToDecommitFormL")
  , ("selectingUTxOToIncrementForm", "selectingUTxOToIncrementFormL")
  , ("enteringAmountForm", "enteringAmountFormL")
  , ("selectingRecipientForm", "selectingRecipientFormL")
  , ("enteringRecipientAddressForm", "enteringRecipientAddressFormL")
  , ("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
  [ ("commitMenu", "commitMenuL")
  , ("confirmingAbortForm", "confirmingAbortFormL")
  ]
  ''InitializingScreen

makeLensesFor
  [ ("transitionNote", "transitionNoteL")
  , ("me", "meL")
  , ("peers", "peersL")
  , ("headState", "headStateL")
  ]
  ''Connection

makeLensesFor
  [ ("remainingParties", "remainingPartiesL")
  , ("initializingScreen", "initializingScreenL")
  ]
  ''InitializingState

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

makeLensesFor
  [ ("utxo", "utxoL")
  , ("pendingUTxOToDecommit", "pendingUTxOToDecommitL")
  , ("pendingIncrement", "pendingIncrementL")
  , ("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
    , $sel:pendingUTxOToDecommit:ActiveLink :: UTxO
pendingUTxOToDecommit = UTxO
forall a. Monoid a => a
mempty
    , $sel:pendingIncrement:ActiveLink :: Maybe PendingIncrement
pendingIncrement = Maybe PendingIncrement
forall a. Maybe a
Nothing
    , HeadId
$sel:headId:ActiveLink :: HeadId
headId :: HeadId
headId
    }

isModalOpen :: RootState -> Bool
isModalOpen :: RootState -> Bool
isModalOpen RootState
s =
  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
_ -> Bool
True