diff --git a/CHANGELOG.md b/CHANGELOG.md index e0733db161f..0ac1358f1c4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -41,6 +41,8 @@ changes. - **BREAKING** Enable handling client recover in all head states. - See [Issue #1812](https://github.com/cardano-scaling/hydra/issues/1812) and [PR #2217](https://github.com/cardano-scaling/hydra/pull/2217). + > This enables clients (e.g. the TUI) to fully recover after event-log rotation. + - The Checkpoint event, and consequently the EventLogRotated server output, now carry the full NodeState instead of just the HeadState. - Optimistic approach to statefile corruption by just ignoring invalid JSON lines [#2253](https://github.com/cardano-scaling/hydra/issues/2253) diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 234c620fe86..8ae8d81b00a 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -99,6 +99,7 @@ library Hydra.Node.Network Hydra.Node.ParameterMismatch Hydra.Node.Run + Hydra.Node.State Hydra.Node.Util Hydra.Options Hydra.Persistence diff --git a/hydra-node/src/Hydra/API/HTTPServer.hs b/hydra-node/src/Hydra/API/HTTPServer.hs index 2798113797d..d0893bd42e6 100644 --- a/hydra-node/src/Hydra/API/HTTPServer.hs +++ b/hydra-node/src/Hydra/API/HTTPServer.hs @@ -19,12 +19,12 @@ import Hydra.Cardano.Api (Coin, LedgerEra, PolicyAssets, PolicyId, Tx) import Hydra.Chain (Chain (..), PostTxError (..), draftCommitTx) import Hydra.Chain.ChainState (IsChainState) import Hydra.Chain.Direct.State () -import Hydra.HeadLogic.State (NodeState (..)) import Hydra.Ledger (ValidationError (..)) import Hydra.Logging (Tracer, traceWith) import Hydra.Node.ApiTransactionTimeout (ApiTransactionTimeout (..)) import Hydra.Node.DepositPeriod (toNominalDiffTime) import Hydra.Node.Environment (Environment (..)) +import Hydra.Node.State (NodeState (..)) import Hydra.Tx (CommitBlueprintTx (..), ConfirmedSnapshot, IsTx (..), Snapshot (..), UTxOType) import Network.HTTP.Types (ResponseHeaders, hContentType, status200, status202, status400, status404, status500) import Network.Wai (Application, Request (pathInfo, requestMethod), Response, consumeRequestBodyStrict, rawPathInfo, responseLBS) diff --git a/hydra-node/src/Hydra/API/Server.hs b/hydra-node/src/Hydra/API/Server.hs index 834a4c1aa69..dd947cb4f2e 100644 --- a/hydra-node/src/Hydra/API/Server.hs +++ b/hydra-node/src/Hydra/API/Server.hs @@ -34,20 +34,18 @@ import Hydra.Chain.ChainState (IsChainState) import Hydra.Chain.Direct.State () import Hydra.Events (EventSink (..), EventSource (..)) import Hydra.HeadLogic ( - Deposit (..), HeadState (..), InitialState (..), - NodeState (..), OpenState (..), aggregateNodeState, ) import Hydra.HeadLogic.Outcome qualified as StateChanged -import Hydra.HeadLogic.State (initNodeState) import Hydra.HeadLogic.StateEvent (StateEvent (..)) import Hydra.Logging (Tracer, traceWith) import Hydra.Network (IP, PortNumber) import Hydra.Node.ApiTransactionTimeout (ApiTransactionTimeout) import Hydra.Node.Environment (Environment) +import Hydra.Node.State (Deposit (..), NodeState (..), initNodeState) import Hydra.Tx (IsTx (..), Party, txId) import Network.HTTP.Types (status500) import Network.Wai (responseLBS) diff --git a/hydra-node/src/Hydra/API/ServerOutput.hs b/hydra-node/src/Hydra/API/ServerOutput.hs index a8cbacd08b3..2c4d9268dfe 100644 --- a/hydra-node/src/Hydra/API/ServerOutput.hs +++ b/hydra-node/src/Hydra/API/ServerOutput.hs @@ -12,11 +12,12 @@ import Data.ByteString.Lazy qualified as LBS import Hydra.API.ClientInput (ClientInput) import Hydra.Chain (PostChainTx, PostTxError) import Hydra.Chain.ChainState (ChainStateType, IsChainState) -import Hydra.HeadLogic.State (ClosedState (..), HeadState (..), InitialState (..), NodeState, OpenState (..), SeenSnapshot (..)) +import Hydra.HeadLogic.State (ClosedState (..), HeadState (..), InitialState (..), OpenState (..), SeenSnapshot (..)) import Hydra.HeadLogic.State qualified as HeadState import Hydra.Ledger (ValidationError) import Hydra.Network (Host, ProtocolVersion) import Hydra.Node.Environment (Environment (..)) +import Hydra.Node.State (NodeState) import Hydra.Prelude hiding (seq) import Hydra.Tx (HeadId, Party, Snapshot, SnapshotNumber, getSnapshot) import Hydra.Tx qualified as Tx diff --git a/hydra-node/src/Hydra/API/WSServer.hs b/hydra-node/src/Hydra/API/WSServer.hs index 2fb8e323389..c77fd572f96 100644 --- a/hydra-node/src/Hydra/API/WSServer.hs +++ b/hydra-node/src/Hydra/API/WSServer.hs @@ -41,11 +41,12 @@ import Hydra.Chain.ChainState ( IsChainState, ) import Hydra.Chain.Direct.State () -import Hydra.HeadLogic (ClosedState (ClosedState, readyToFanoutSent), HeadState, InitialState (..), NodeState (..), OpenState (..), StateChanged) +import Hydra.HeadLogic (ClosedState (ClosedState, readyToFanoutSent), HeadState, InitialState (..), OpenState (..), StateChanged) import Hydra.HeadLogic.State qualified as HeadState import Hydra.Logging (Tracer, traceWith) import Hydra.NetworkVersions qualified as NetworkVersions import Hydra.Node.Environment (Environment (..)) +import Hydra.Node.State (NodeState (..)) import Hydra.Tx (HeadId, Party) import Network.WebSockets ( PendingConnection (pendingRequest), diff --git a/hydra-node/src/Hydra/HeadLogic.hs b/hydra-node/src/Hydra/HeadLogic.hs index 82692348b10..31ddb91331d 100644 --- a/hydra-node/src/Hydra/HeadLogic.hs +++ b/hydra-node/src/Hydra/HeadLogic.hs @@ -61,15 +61,11 @@ import Hydra.HeadLogic.State ( ClosedState (..), Committed, CoordinatedHeadState (..), - Deposit (..), - DepositStatus (..), HeadState (..), IdleState (IdleState, chainState), InitialState (..), - NodeState (..), OpenState (..), PendingCommits, - PendingDeposits, SeenSnapshot (..), getChainState, seenSnapshotNumber, @@ -83,6 +79,7 @@ import Hydra.Network qualified as Network import Hydra.Network.Message (Message (..), NetworkEvent (..)) import Hydra.Node.DepositPeriod (DepositPeriod (..)) import Hydra.Node.Environment (Environment (..), mkHeadParameters) +import Hydra.Node.State (Deposit (..), DepositStatus (..), NodeState (..), PendingDeposits, depositsForHead) import Hydra.Tx ( HeadId, HeadSeed, @@ -925,39 +922,18 @@ onOpenNetworkReqDec env ledger ttl currentSlot openState decommitTx = , coordinatedHeadState } = openState --- | Process the chain (and time) advancing in an open head. +-- | Process the chain (and time) advancing in any head state. -- --- __Transition__: 'OpenState' → 'OpenState' +-- __Transition__: 'AnyState' → 'AnyState' -- --- This is primarily used to track deposits and either drop them or request --- snapshots for inclusion. -onOpenChainTick :: IsTx tx => Environment -> PendingDeposits tx -> OpenState tx -> UTCTime -> Outcome tx -onOpenChainTick env pendingDeposits st chainTime = +-- This is primarily used to track deposits status changes. +onChainTick :: IsTx tx => Environment -> PendingDeposits tx -> UTCTime -> Outcome tx +onChainTick env pendingDeposits chainTime = -- Determine new active and new expired updateDeposits $ \newActive newExpired -> -- Emit state change for both -- XXX: This is a bit messy - ((mkDepositActivated newActive <> mkDepositExpired newExpired) <>) $ - -- Apply state changes and pick next active to request snapshot - -- XXX: This is smelly as we rely on Map <> to override entries (left - -- biased). This is also weird because we want to actually apply the state - -- change and also to determine the next active. - withNextActive (newActive <> newExpired <> pendingDeposits) $ \depositTxId -> - -- REVIEW: this is not really a wait, but discard? - -- TODO: Spec: wait tx𝜔 = ⊥ ∧ 𝑈𝛼 = ∅ - if isNothing decommitTx - && isNothing currentDepositTxId - && not snapshotInFlight - && isLeader parameters party nextSn - then - -- XXX: This state update has no equivalence in the - -- spec. Do we really need to store that we have - -- requested a snapshot? If yes, should update spec. - newState SnapshotRequestDecided{snapshotNumber = nextSn} - -- Spec: multicast (reqSn,̂ 𝑣,̄ 𝒮.𝑠 + 1,̂ 𝒯, 𝑈𝛼, ⊥) - <> cause (NetworkEffect $ ReqSn version nextSn (txId <$> localTxs) Nothing (Just depositTxId)) - else - noop + mkDepositActivated newActive <> mkDepositExpired newExpired where updateDeposits cont = uncurry cont $ Map.foldlWithKey updateDeposit (mempty, mempty) pendingDeposits @@ -979,6 +955,43 @@ onOpenChainTick env pendingDeposits st chainTime = plusTime = flip addUTCTime + mkDepositActivated m = changes . (`Map.foldMapWithKey` m) $ \depositTxId deposit -> + pure DepositActivated{depositTxId, chainTime, deposit} + + mkDepositExpired m = changes . (`Map.foldMapWithKey` m) $ \depositTxId deposit -> + pure DepositExpired{depositTxId, chainTime, deposit} + + Environment{depositPeriod} = env + +-- | Process the chain (and time) advancing in an open head. +-- +-- __Transition__: 'OpenState' → 'OpenState' +-- +-- This is primarily used to track deposits and either drop them or request +-- snapshots for inclusion. +onOpenChainTick :: IsTx tx => Environment -> PendingDeposits tx -> OpenState tx -> Outcome tx +onOpenChainTick env pendingDeposits st = + -- Apply state changes and pick next active to request snapshot + -- XXX: This is smelly as we rely on Map <> to override entries (left + -- biased). This is also weird because we want to actually apply the state + -- change and also to determine the next active. + withNextActive pendingDeposits $ \depositTxId -> + -- REVIEW: this is not really a wait, but discard? + -- TODO: Spec: wait tx𝜔 = ⊥ ∧ 𝑈𝛼 = ∅ + if isNothing decommitTx + && isNothing currentDepositTxId + && not snapshotInFlight + && isLeader parameters party nextSn + then + -- XXX: This state update has no equivalence in the + -- spec. Do we really need to store that we have + -- requested a snapshot? If yes, should update spec. + newState SnapshotRequestDecided{snapshotNumber = nextSn} + -- Spec: multicast (reqSn,̂ 𝑣,̄ 𝒮.𝑠 + 1,̂ 𝒯, 𝑈𝛼, ⊥) + <> cause (NetworkEffect $ ReqSn version nextSn (txId <$> localTxs) Nothing (Just depositTxId)) + else + noop + where -- REVIEW! check what if there are more than 1 new active deposit -- What is the sorting criteria to pick next? withNextActive :: forall tx. (Eq (UTxOType tx), Monoid (UTxOType tx)) => Map (TxIdType tx) (Deposit tx) -> (TxIdType tx -> Outcome tx) -> Outcome tx @@ -988,15 +1001,9 @@ onOpenChainTick env pendingDeposits st chainTime = p (_, Deposit{deposited, status}) = deposited /= mempty && status == Active maybe noop (cont . fst) . find p $ Map.toList deposits - mkDepositActivated m = changes . (`Map.foldMapWithKey` m) $ \depositTxId deposit -> - pure DepositActivated{depositTxId, chainTime, deposit} - - mkDepositExpired m = changes . (`Map.foldMapWithKey` m) $ \depositTxId deposit -> - pure DepositExpired{depositTxId, chainTime, deposit} - nextSn = confirmedSn + 1 - Environment{party, depositPeriod} = env + Environment{party} = env CoordinatedHeadState { localTxs @@ -1354,10 +1361,10 @@ update env ledger NodeState{headState = st, pendingDeposits, currentSlot} ev = c onOpenClientNewTx tx (Open openState, NetworkInput ttl (ReceivedMessage{msg = ReqTx tx})) -> onOpenNetworkReqTx env ledger currentSlot openState ttl tx - (Open openState, NetworkInput _ (ReceivedMessage{sender, msg = ReqSn sv sn txIds decommitTx depositTxId})) -> - onOpenNetworkReqSn env ledger pendingDeposits currentSlot openState sender sv sn txIds decommitTx depositTxId - (Open openState, NetworkInput _ (ReceivedMessage{sender, msg = AckSn snapshotSignature sn})) -> - onOpenNetworkAckSn env pendingDeposits openState sender snapshotSignature sn + (Open openState@OpenState{headId = ourHeadId}, NetworkInput _ (ReceivedMessage{sender, msg = ReqSn sv sn txIds decommitTx depositTxId})) -> + onOpenNetworkReqSn env ledger (depositsForHead ourHeadId pendingDeposits) currentSlot openState sender sv sn txIds decommitTx depositTxId + (Open openState@OpenState{headId = ourHeadId}, NetworkInput _ (ReceivedMessage{sender, msg = AckSn snapshotSignature sn})) -> + onOpenNetworkAckSn env (depositsForHead ourHeadId pendingDeposits) openState sender snapshotSignature sn ( Open openState@OpenState{headId = ourHeadId} , ChainInput Observation{observedTx = OnCloseTx{headId, snapshotNumber = closedSnapshotNumber, contestationDeadline}, newChainState} ) @@ -1378,17 +1385,13 @@ update env ledger NodeState{headState = st, pendingDeposits, currentSlot} ev = c onOpenClientDecommit headId ledger currentSlot coordinatedHeadState decommitTx (Open openState, NetworkInput ttl (ReceivedMessage{msg = ReqDec{transaction}})) -> onOpenNetworkReqDec env ledger ttl currentSlot openState transaction - (Open OpenState{headId = ourHeadId}, ChainInput Observation{observedTx = OnDepositTx{headId, depositTxId, deposited, created, deadline}, newChainState}) - | ourHeadId == headId -> - newState DepositRecorded{chainState = newChainState, headId, depositTxId, deposited, created, deadline} - | otherwise -> - Error NotOurHead{ourHeadId, otherHeadId = headId} - (Open openState@OpenState{}, ChainInput Tick{chainTime, chainSlot}) -> + (Open openState@OpenState{headId = ourHeadId}, ChainInput Tick{chainTime, chainSlot}) -> -- XXX: We originally forgot the normal TickObserved state event here and so -- time did not advance in an open head anymore. This is a hint that we -- should compose event handling better. newState TickObserved{chainSlot} - <> onOpenChainTick env pendingDeposits openState chainTime + <> onChainTick env pendingDeposits chainTime + <> onOpenChainTick env (depositsForHead ourHeadId pendingDeposits) openState (Open openState@OpenState{headId = ourHeadId}, ChainInput Observation{observedTx = OnIncrementTx{headId, newVersion, depositTxId}, newChainState}) | ourHeadId == headId -> onOpenChainIncrementTx openState newChainState newVersion depositTxId @@ -1409,6 +1412,7 @@ update env ledger NodeState{headState = st, pendingDeposits, currentSlot} ev = c (Closed ClosedState{contestationDeadline, readyToFanoutSent, headId}, ChainInput Tick{chainTime, chainSlot}) | chainTime > contestationDeadline && not readyToFanoutSent -> newState TickObserved{chainSlot} + <> onChainTick env pendingDeposits chainTime <> newState HeadIsReadyToFanout{headId} (Closed closedState, ClientInput Fanout) -> onClosedClientFanout closedState @@ -1418,6 +1422,8 @@ update env ledger NodeState{headState = st, pendingDeposits, currentSlot} ev = c | otherwise -> Error NotOurHead{ourHeadId, otherHeadId = headId} -- Node-level + (_, ChainInput Observation{observedTx = OnDepositTx{headId, depositTxId, deposited, created, deadline}, newChainState}) -> + newState DepositRecorded{chainState = newChainState, headId, depositTxId, deposited, created, deadline} (_, ClientInput Recover{recoverTxId}) -> do onClientRecover currentSlot pendingDeposits recoverTxId (_, ChainInput Observation{observedTx = OnRecoverTx{headId, recoveredTxId, recoveredUTxO}, newChainState}) -> @@ -1425,8 +1431,9 @@ update env ledger NodeState{headState = st, pendingDeposits, currentSlot} ev = c -- General (_, ChainInput Rollback{rolledBackChainState}) -> newState ChainRolledBack{chainState = rolledBackChainState} - (_, ChainInput Tick{chainSlot}) -> + (_, ChainInput Tick{chainTime, chainSlot}) -> newState TickObserved{chainSlot} + <> onChainTick env pendingDeposits chainTime (_, ChainInput PostTxError{postChainTx, postTxError}) -> cause . ClientEffect $ ServerOutput.PostTxOnChainFailed{postChainTx, postTxError} (_, ClientInput{clientInput}) -> @@ -1482,6 +1489,8 @@ aggregateNodeState nodeState sc = } TickObserved{chainSlot} -> ns{currentSlot = chainSlot} + ChainRolledBack{chainState} -> + ns{currentSlot = chainStateSlot chainState} _ -> ns -- * HeadState aggregate diff --git a/hydra-node/src/Hydra/HeadLogic/Outcome.hs b/hydra-node/src/Hydra/HeadLogic/Outcome.hs index 0987e449051..b70cf5e0dd4 100644 --- a/hydra-node/src/Hydra/HeadLogic/Outcome.hs +++ b/hydra-node/src/Hydra/HeadLogic/Outcome.hs @@ -9,11 +9,11 @@ import Hydra.API.ServerOutput (ClientMessage, DecommitInvalidReason) import Hydra.Chain (PostChainTx) import Hydra.Chain.ChainState (ChainSlot, ChainStateType, IsChainState) import Hydra.HeadLogic.Error (LogicError) -import Hydra.HeadLogic.State (Deposit, NodeState) import Hydra.Ledger (ValidationError) import Hydra.Network (Host, ProtocolVersion) import Hydra.Network.Message (Message) import Hydra.Node.Environment (Environment (..), mkHeadParameters) +import Hydra.Node.State (Deposit, NodeState) import Hydra.Tx ( HeadId, HeadParameters, diff --git a/hydra-node/src/Hydra/HeadLogic/State.hs b/hydra-node/src/Hydra/HeadLogic/State.hs index 6c2919980c5..52616401567 100644 --- a/hydra-node/src/Hydra/HeadLogic/State.hs +++ b/hydra-node/src/Hydra/HeadLogic/State.hs @@ -7,7 +7,7 @@ module Hydra.HeadLogic.State where import Hydra.Prelude import Data.Map qualified as Map -import Hydra.Chain.ChainState (ChainSlot, IsChainState (..)) +import Hydra.Chain.ChainState (IsChainState (..)) import Hydra.Tx ( HeadId, HeadParameters, @@ -23,36 +23,6 @@ import Hydra.Tx.Snapshot ( SnapshotNumber, SnapshotVersion, ) -import Test.QuickCheck (recursivelyShrink) - -type PendingDeposits tx = Map (TxIdType tx) (Deposit tx) - --- FIXME: move to a dedicated module (maybe with deposits too?) -data NodeState tx = NodeState - { headState :: HeadState tx - , pendingDeposits :: PendingDeposits tx - -- ^ Pending deposits as observed on chain. - -- TODO: could even move the chain state here (also see todo below) - -- , chainState :: ChainStateType tx - , currentSlot :: ChainSlot - } - deriving stock (Generic) - -instance (ArbitraryIsTx tx, Arbitrary (ChainStateType tx)) => Arbitrary (NodeState tx) where - arbitrary = genericArbitrary - -deriving stock instance (IsTx tx, Eq (ChainStateType tx)) => Eq (NodeState tx) -deriving stock instance (IsTx tx, Show (ChainStateType tx)) => Show (NodeState tx) -deriving anyclass instance (IsTx tx, ToJSON (ChainStateType tx)) => ToJSON (NodeState tx) -deriving anyclass instance (IsTx tx, FromJSON (ChainStateType tx)) => FromJSON (NodeState tx) - -initNodeState :: IsChainState tx => ChainStateType tx -> NodeState tx -initNodeState chainState = - NodeState - { headState = Idle IdleState{chainState} - , pendingDeposits = mempty - , currentSlot = chainStateSlot chainState - } -- | The main state of the Hydra protocol state machine. It holds both, the -- overall protocol state, but also the off-chain 'CoordinatedHeadState'. @@ -249,33 +219,6 @@ seenSnapshotNumber = \case RequestedSnapshot{lastSeen} -> lastSeen SeenSnapshot{snapshot = Snapshot{number}} -> number --- | A deposit tracked by the protocol. The 'DepositStatus' determines whether --- it may be used for an incremental commit or not. -data Deposit tx = Deposit - { headId :: HeadId - , deposited :: UTxOType tx - , created :: UTCTime - , deadline :: UTCTime - , status :: DepositStatus - } - deriving (Generic) - -deriving stock instance IsTx tx => Eq (Deposit tx) -deriving stock instance IsTx tx => Show (Deposit tx) -deriving anyclass instance IsTx tx => ToJSON (Deposit tx) -deriving anyclass instance IsTx tx => FromJSON (Deposit tx) - -instance ArbitraryIsTx tx => Arbitrary (Deposit tx) where - arbitrary = genericArbitrary - shrink = recursivelyShrink - -data DepositStatus = Inactive | Active | Expired - deriving (Generic, Eq, Show, ToJSON, FromJSON) - -instance Arbitrary DepositStatus where - arbitrary = genericArbitrary - shrink = genericShrink - -- ** Closed -- | An 'Closed' head with an current candidate 'ConfirmedSnapshot', which may diff --git a/hydra-node/src/Hydra/HeadLogic/StateEvent.hs b/hydra-node/src/Hydra/HeadLogic/StateEvent.hs index 76195f6fd6a..9c8acf3905e 100644 --- a/hydra-node/src/Hydra/HeadLogic/StateEvent.hs +++ b/hydra-node/src/Hydra/HeadLogic/StateEvent.hs @@ -5,8 +5,8 @@ module Hydra.HeadLogic.StateEvent where import Hydra.Chain.ChainState (IsChainState) import Hydra.Events (EventId, HasEventId (..)) -import Hydra.HeadLogic (NodeState) import Hydra.HeadLogic.Outcome (StateChanged (Checkpoint)) +import Hydra.Node.State (NodeState) import Hydra.Prelude import Hydra.Tx (ArbitraryIsTx) diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index c6d8f0168a4..661609acc1d 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -36,7 +36,6 @@ import Hydra.HeadLogic ( Effect (..), HeadState (..), Input (..), - NodeState (..), Outcome (..), TTL, aggregateChainStateHistory, @@ -45,7 +44,7 @@ import Hydra.HeadLogic ( ) import Hydra.HeadLogic qualified as HeadLogic import Hydra.HeadLogic.Outcome (StateChanged (..)) -import Hydra.HeadLogic.State (getHeadParameters, initNodeState) +import Hydra.HeadLogic.State (getHeadParameters) import Hydra.HeadLogic.StateEvent (StateEvent (..)) import Hydra.Ledger (Ledger) import Hydra.Logging (Tracer, traceWith) @@ -55,6 +54,7 @@ import Hydra.Network.Message (Message (..), NetworkEvent (..)) import Hydra.Node.Environment (Environment (..)) import Hydra.Node.InputQueue (InputQueue (..), Queued (..), createInputQueue) import Hydra.Node.ParameterMismatch (ParamMismatch (..), ParameterMismatch (..)) +import Hydra.Node.State (NodeState (..), initNodeState) import Hydra.Node.Util (readFileTextEnvelopeThrow) import Hydra.Options (CardanoChainConfig (..), ChainConfig (..), RunOptions (..), defaultContestationPeriod, defaultDepositPeriod) import Hydra.Tx (HasParty (..), HeadParameters (..), Party (..), deriveParty) @@ -404,8 +404,6 @@ processEffects node tracer inputId effects = do -- ** Manage state --- TODO! pendingDeposits :: Map (TxIdType tx) (Deposit tx) - -- | Handle to access and modify the state in the Hydra Node. data NodeStateHandler tx m = NodeStateHandler { modifyNodeState :: forall a. (NodeState tx -> (a, NodeState tx)) -> STM m a diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 3e171deee6f..e979244854f 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -30,7 +30,6 @@ import Hydra.Events (EventSink) import Hydra.Events.FileBased (mkFileBasedEventStore) import Hydra.Events.Rotation (EventStore (..), RotationConfig (..), newRotatedEventStore) import Hydra.HeadLogic (aggregateNodeState) -import Hydra.HeadLogic.State (NodeState (..), initNodeState) import Hydra.HeadLogic.StateEvent (StateEvent (StateEvent, stateChanged), mkCheckpoint) import Hydra.Ledger (Ledger) import Hydra.Ledger.Cardano (cardanoLedger, newLedgerEnv) @@ -50,6 +49,7 @@ import Hydra.Node ( ) import Hydra.Node.Environment (Environment (..)) import Hydra.Node.Network (NetworkConfiguration (..), withNetwork) +import Hydra.Node.State (NodeState (..), initNodeState) import Hydra.Options ( CardanoChainConfig (..), ChainBackendOptions (..), diff --git a/hydra-node/src/Hydra/Node/State.hs b/hydra-node/src/Hydra/Node/State.hs new file mode 100644 index 00000000000..d5a657e5272 --- /dev/null +++ b/hydra-node/src/Hydra/Node/State.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE UndecidableInstances #-} + +module Hydra.Node.State where + +import Hydra.Prelude + +import Data.Map qualified as Map +import Hydra.Chain.ChainState (ChainSlot, IsChainState (..)) +import Hydra.HeadLogic.State (HeadState (Idle), IdleState (..)) +import Hydra.Tx ( + HeadId, + IsTx (..), + ) +import Hydra.Tx.IsTx (ArbitraryIsTx) +import Test.QuickCheck (recursivelyShrink) + +type PendingDeposits tx = Map (TxIdType tx) (Deposit tx) + +data NodeState tx = NodeState + { headState :: HeadState tx + , pendingDeposits :: PendingDeposits tx + -- ^ Pending deposits as observed on chain. + -- TODO: could even move the chain state here (also see todo below) + -- , chainState :: ChainStateType tx + , currentSlot :: ChainSlot + } + deriving stock (Generic) + +instance (ArbitraryIsTx tx, Arbitrary (ChainStateType tx)) => Arbitrary (NodeState tx) where + arbitrary = genericArbitrary + +deriving stock instance (IsTx tx, Eq (ChainStateType tx)) => Eq (NodeState tx) +deriving stock instance (IsTx tx, Show (ChainStateType tx)) => Show (NodeState tx) +deriving anyclass instance (IsTx tx, ToJSON (ChainStateType tx)) => ToJSON (NodeState tx) +deriving anyclass instance (IsTx tx, FromJSON (ChainStateType tx)) => FromJSON (NodeState tx) + +initNodeState :: IsChainState tx => ChainStateType tx -> NodeState tx +initNodeState chainState = + NodeState + { headState = Idle IdleState{chainState} + , pendingDeposits = mempty + , currentSlot = chainStateSlot chainState + } + +-- | A deposit tracked by the protocol. The 'DepositStatus' determines whether +-- it may be used for an incremental commit or not. +data Deposit tx = Deposit + { headId :: HeadId + , deposited :: UTxOType tx + , created :: UTCTime + , deadline :: UTCTime + , status :: DepositStatus + } + deriving (Generic) + +deriving stock instance IsTx tx => Eq (Deposit tx) +deriving stock instance IsTx tx => Show (Deposit tx) +deriving anyclass instance IsTx tx => ToJSON (Deposit tx) +deriving anyclass instance IsTx tx => FromJSON (Deposit tx) + +instance ArbitraryIsTx tx => Arbitrary (Deposit tx) where + arbitrary = genericArbitrary + shrink = recursivelyShrink + +data DepositStatus = Inactive | Active | Expired + deriving (Generic, Eq, Show, ToJSON, FromJSON) + +instance Arbitrary DepositStatus where + arbitrary = genericArbitrary + shrink = genericShrink + +depositsForHead :: HeadId -> PendingDeposits tx -> PendingDeposits tx +depositsForHead targetHeadId = + Map.filter (\Deposit{headId} -> headId == targetHeadId) diff --git a/hydra-node/test/Hydra/API/HTTPServerSpec.hs b/hydra-node/test/Hydra/API/HTTPServerSpec.hs index 12b74ac9e7e..b0db14b249b 100644 --- a/hydra-node/test/Hydra/API/HTTPServerSpec.hs +++ b/hydra-node/test/Hydra/API/HTTPServerSpec.hs @@ -33,13 +33,14 @@ import Hydra.Cardano.Api ( import Hydra.Chain (Chain (draftCommitTx), PostTxError (..), draftDepositTx) import Hydra.Chain.ChainState (ChainSlot (ChainSlot)) import Hydra.Chain.Direct.Handlers (checkAmount, rejectLowDeposits) -import Hydra.HeadLogic.State (ClosedState (..), HeadState (..), NodeState (..), SeenSnapshot (..)) +import Hydra.HeadLogic.State (ClosedState (..), HeadState (..), SeenSnapshot (..)) import Hydra.HeadLogicSpec (inIdleState) import Hydra.JSONSchema (SchemaSelector, prop_validateJSONSchema, validateJSON, withJsonSpecifications) import Hydra.Ledger (ValidationError (..)) import Hydra.Ledger.Cardano (Tx) import Hydra.Ledger.Simple (SimpleTx (..)) import Hydra.Logging (nullTracer) +import Hydra.Node.State (NodeState (..)) import Hydra.Tx (ConfirmedSnapshot (..)) import Hydra.Tx.IsTx (UTxOType, txId) import Hydra.Tx.Snapshot (Snapshot (..)) diff --git a/hydra-node/test/Hydra/BehaviorSpec.hs b/hydra-node/test/Hydra/BehaviorSpec.hs index f18151c76bd..d5eaad60e45 100644 --- a/hydra-node/test/Hydra/BehaviorSpec.hs +++ b/hydra-node/test/Hydra/BehaviorSpec.hs @@ -33,8 +33,7 @@ import Hydra.Chain.ChainState (ChainSlot (ChainSlot), ChainStateType, IsChainSta import Hydra.Chain.Direct.Handlers (LocalChainState, getLatest, newLocalChainState, pushNew, rollback) import Hydra.Events (EventSink (..)) import Hydra.Events.Rotation (EventStore (..)) -import Hydra.HeadLogic (CoordinatedHeadState (..), Effect (..), HeadState (..), InitialState (..), Input (..), NodeState (..), OpenState (..)) -import Hydra.HeadLogic.State (initNodeState) +import Hydra.HeadLogic (CoordinatedHeadState (..), Effect (..), HeadState (..), InitialState (..), Input (..), OpenState (..)) import Hydra.HeadLogicSpec (testSnapshot) import Hydra.Ledger (Ledger, nextChainSlot) import Hydra.Ledger.Simple (SimpleChainState (..), SimpleTx (..), aValidTx, simpleLedger, utxoRef, utxoRefs) @@ -46,6 +45,7 @@ import Hydra.Node.DepositPeriod (DepositPeriod (..)) import Hydra.Node.DepositPeriod qualified as DP import Hydra.Node.Environment (Environment (..)) import Hydra.Node.InputQueue (InputQueue (enqueue), createInputQueue) +import Hydra.Node.State (NodeState (..), initNodeState) import Hydra.NodeSpec (createMockEventStore) import Hydra.Options (defaultContestationPeriod, defaultDepositPeriod) import Hydra.Tx (HeadId) diff --git a/hydra-node/test/Hydra/Events/RotationSpec.hs b/hydra-node/test/Hydra/Events/RotationSpec.hs index 42df5a9d7cb..3b30affac05 100644 --- a/hydra-node/test/Hydra/Events/RotationSpec.hs +++ b/hydra-node/test/Hydra/Events/RotationSpec.hs @@ -9,12 +9,12 @@ import Hydra.Chain (OnChainTx (..)) import Hydra.Chain.ChainState (ChainSlot (..), IsChainState) import Hydra.Events (EventId, EventSink (..), HasEventId (..), getEvents) import Hydra.Events.Rotation (EventStore (..), RotationConfig (..), newRotatedEventStore) -import Hydra.HeadLogic (HeadState (..), NodeState (..), StateChanged (..), aggregateNodeState) -import Hydra.HeadLogic.State (initNodeState) +import Hydra.HeadLogic (HeadState (..), StateChanged (..), aggregateNodeState) import Hydra.HeadLogic.StateEvent (StateEvent (..), mkCheckpoint) import Hydra.Ledger.Simple (SimpleChainState (..), SimpleTx, simpleLedger) import Hydra.Logging (showLogsOnFailure) import Hydra.Node (DraftHydraNode, hydrate) +import Hydra.Node.State (NodeState (..), initNodeState) import Hydra.NodeSpec (createMockEventStore, inputsToOpenHead, notConnect, observationInput, primeWith, runToCompletion) import Hydra.Tx.ContestationPeriod (toNominalDiffTime) import Test.Hydra.Node.Fixture (testEnvironment, testHeadId) diff --git a/hydra-node/test/Hydra/HeadLogicSnapshotSpec.hs b/hydra-node/test/Hydra/HeadLogicSnapshotSpec.hs index c4c4b8cb057..5c9fedab19a 100644 --- a/hydra-node/test/Hydra/HeadLogicSnapshotSpec.hs +++ b/hydra-node/test/Hydra/HeadLogicSnapshotSpec.hs @@ -8,11 +8,12 @@ import Test.Hydra.Prelude import Data.List qualified as List import Data.Map.Strict qualified as Map -import Hydra.HeadLogic (CoordinatedHeadState (..), Effect (..), HeadState (..), NodeState (..), OpenState (OpenState), Outcome, SeenSnapshot (..), coordinatedHeadState, isLeader, update) +import Hydra.HeadLogic (CoordinatedHeadState (..), Effect (..), HeadState (..), OpenState (OpenState), Outcome, SeenSnapshot (..), coordinatedHeadState, isLeader, update) import Hydra.HeadLogicSpec (StepState, getState, hasEffect, hasEffectSatisfying, hasNoEffectSatisfying, inOpenState, inOpenState', receiveMessage, receiveMessageFrom, runHeadLogic, step) import Hydra.Ledger.Simple (SimpleTx (..), aValidTx, simpleLedger, utxoRef) import Hydra.Network.Message (Message (..)) import Hydra.Node.Environment (Environment (..)) +import Hydra.Node.State (NodeState (headState)) import Hydra.Options (defaultContestationPeriod, defaultDepositPeriod) import Hydra.Tx.Crypto (sign) import Hydra.Tx.HeadParameters (HeadParameters (..)) diff --git a/hydra-node/test/Hydra/HeadLogicSpec.hs b/hydra-node/test/Hydra/HeadLogicSpec.hs index a46a795fc35..3d71feb1b81 100644 --- a/hydra-node/test/Hydra/HeadLogicSpec.hs +++ b/hydra-node/test/Hydra/HeadLogicSpec.hs @@ -28,8 +28,8 @@ import Hydra.Chain ( ) import Hydra.Chain.ChainState (ChainSlot (..), IsChainState) import Hydra.Chain.Direct.State () -import Hydra.HeadLogic (ClosedState (..), CoordinatedHeadState (..), Effect (..), HeadState (..), InitialState (..), Input (..), LogicError (..), NodeState (..), OpenState (..), Outcome (..), RequirementFailure (..), SideLoadRequirementFailure (..), StateChanged (..), TTL, WaitReason (..), aggregateState, cause, noop, update) -import Hydra.HeadLogic.State (SeenSnapshot (..), getHeadParameters, initNodeState) +import Hydra.HeadLogic (ClosedState (..), CoordinatedHeadState (..), Effect (..), HeadState (..), InitialState (..), Input (..), LogicError (..), OpenState (..), Outcome (..), RequirementFailure (..), SideLoadRequirementFailure (..), StateChanged (..), TTL, WaitReason (..), aggregateState, cause, noop, update) +import Hydra.HeadLogic.State (SeenSnapshot (..), getHeadParameters) import Hydra.Ledger (Ledger (..), ValidationError (..)) import Hydra.Ledger.Cardano (cardanoLedger, mkRangedTx) import Hydra.Ledger.Cardano.TimeSpec (genUTCTime) @@ -37,9 +37,12 @@ import Hydra.Ledger.Simple (SimpleChainState (..), SimpleTx (..), aValidTx, simp import Hydra.Network (Connectivity) import Hydra.Network.Message (Message (..), NetworkEvent (..)) import Hydra.Node (mkNetworkInput) +import Hydra.Node.DepositPeriod (toNominalDiffTime) import Hydra.Node.Environment (Environment (..)) +import Hydra.Node.State (Deposit (..), DepositStatus (Active), NodeState (..), initNodeState) import Hydra.Options (defaultContestationPeriod, defaultDepositPeriod) import Hydra.Prelude qualified as Prelude +import Hydra.Tx (HeadId) import Hydra.Tx.Crypto (aggregate, generateSigningKey, sign) import Hydra.Tx.Crypto qualified as Crypto import Hydra.Tx.HeadParameters (HeadParameters (..)) @@ -50,6 +53,7 @@ import Test.Hydra.Node.Fixture qualified as Fixture import Test.Hydra.Tx.Fixture (alice, aliceSk, bob, bobSk, carol, carolSk, deriveOnChainId, testHeadId, testHeadSeed) import Test.Hydra.Tx.Gen (genKeyPair, genOutput) import Test.QuickCheck (Property, counterexample, elements, forAll, forAllShrink, oneof, shuffle, suchThat) +import Test.QuickCheck.Gen (generate) import Test.QuickCheck.Monadic (assert, monadicIO, pick, run) spec :: Spec @@ -152,6 +156,39 @@ spec = localTxs `shouldBe` [tx2, tx3] _ -> fail "expected Open state" + describe "Deposit" $ do + let plusTime = flip addUTCTime + it "on tick, ignores deposits from other heads when picking the next active deposit for ReqSn" $ do + now <- getCurrentTime + otherHeadId :: HeadId <- generate arbitrary + let depositTime = plusTime now + deadline = depositTime 5 `plusTime` toNominalDiffTime (depositPeriod aliceEnv) `plusTime` toNominalDiffTime (depositPeriod aliceEnv) + deposit1 = Deposit{headId = otherHeadId, deposited = utxoRef 1, created = depositTime 1, deadline, status = Active} + deposit2 = Deposit{headId = testHeadId, deposited = utxoRef 2, created = depositTime 2, deadline, status = Active} + -- open state with pending deposits from another head + party = [alice] + openState = (inOpenState party){pendingDeposits = Map.fromList [(1, deposit1), (2, deposit2)]} + input = ChainInput $ Tick{chainTime = depositTime 3, chainSlot = ChainSlot 3} + outcome = update aliceEnv ledger openState input + + outcome `hasEffectSatisfying` \case + NetworkEffect ReqSn{depositTxId} -> depositTxId == Just 2 + _ -> False + + prop "tracks depositTx of another head" $ \otherHeadId -> do + let depositOtherHead = + observeTx $ + OnDepositTx + { headId = otherHeadId + , deposited = mempty + , depositTxId = 1 + , created = genUTCTime `generateWith` 41 + , deadline = genUTCTime `generateWith` 42 + } + update bobEnv ledger (inOpenState threeParties) depositOtherHead `hasStateChangedSatisfying` \case + DepositRecorded{headId, depositTxId} -> headId == otherHeadId && depositTxId == 1 + _ -> False + describe "Decommit" $ do it "observes DecommitRecorded and ReqDec in an Open state" $ do let outputs = utxoRef 1 @@ -687,19 +724,6 @@ spec = update bobEnv ledger (inInitialState threeParties) collectOtherHead `shouldBe` Error (NotOurHead{ourHeadId = testHeadId, otherHeadId}) - prop "ignores depositTx of another head" $ \otherHeadId -> do - let depositOtherHead = - observeTx $ - OnDepositTx - { headId = otherHeadId - , deposited = mempty - , depositTxId = 1 - , created = genUTCTime `generateWith` 41 - , deadline = genUTCTime `generateWith` 42 - } - update bobEnv ledger (inOpenState threeParties) depositOtherHead - `shouldBe` Error (NotOurHead{ourHeadId = testHeadId, otherHeadId}) - prop "ignores decrementTx of another head" $ \otherHeadId -> do let decrementOtherHead = observeTx $ OnDecrementTx{headId = otherHeadId, newVersion = 1, distributedUTxO = mempty} update bobEnv ledger (inOpenState threeParties) decrementOtherHead diff --git a/hydra-node/test/Hydra/Model.hs b/hydra-node/test/Hydra/Model.hs index 707bfff4f99..1858378913e 100644 --- a/hydra-node/test/Hydra/Model.hs +++ b/hydra-node/test/Hydra/Model.hs @@ -50,7 +50,7 @@ import Hydra.BehaviorSpec ( import Hydra.Cardano.Api.Prelude (fromShelleyPaymentCredential) import Hydra.Chain (maximumNumberOfParties) import Hydra.Chain.Direct.State (initialChainState) -import Hydra.HeadLogic (Committed (), NodeState (headState)) +import Hydra.HeadLogic (Committed ()) import Hydra.Ledger.Cardano (cardanoLedger, mkSimpleTx) import Hydra.Logging (Tracer) import Hydra.Logging.Messages (HydraLog (DirectChain, Node)) @@ -58,6 +58,7 @@ import Hydra.Model.MockChain (mockChainAndNetwork) import Hydra.Model.Payment (CardanoSigningKey (..), Payment (..), applyTx, genAdaValue) import Hydra.Node (runHydraNode) import Hydra.Node.DepositPeriod (DepositPeriod (..)) +import Hydra.Node.State (NodeState (headState)) import Hydra.Tx (HeadId) import Hydra.Tx.ContestationPeriod (ContestationPeriod (..)) import Hydra.Tx.Crypto (HydraKey) diff --git a/hydra-node/test/Hydra/Model/MockChain.hs b/hydra-node/test/Hydra/Model/MockChain.hs index d47350c469b..b54d3ce8e5a 100644 --- a/hydra-node/test/Hydra/Model/MockChain.hs +++ b/hydra-node/test/Hydra/Model/MockChain.hs @@ -56,7 +56,6 @@ import Hydra.HeadLogic ( IdleState (..), InitialState (..), Input (..), - NodeState (..), OpenState (..), ) import Hydra.Ledger (Ledger (..), ValidationError (..), collectTransactions) @@ -69,6 +68,7 @@ import Hydra.Network.Message (Message (..)) import Hydra.Node (DraftHydraNode (..), HydraNode (..), NodeStateHandler (..), connect, mkNetworkInput) import Hydra.Node.Environment (Environment (Environment, participants, party)) import Hydra.Node.InputQueue (InputQueue (..)) +import Hydra.Node.State (NodeState (..)) import Hydra.NodeSpec (mockServer) import Hydra.Tx (txId) import Hydra.Tx.BlueprintTx (mkSimpleBlueprintTx) diff --git a/hydra-node/test/Hydra/NodeSpec.hs b/hydra-node/test/Hydra/NodeSpec.hs index 985619818eb..954972d430c 100644 --- a/hydra-node/test/Hydra/NodeSpec.hs +++ b/hydra-node/test/Hydra/NodeSpec.hs @@ -15,7 +15,7 @@ import Hydra.Chain (Chain (..), ChainEvent (..), OnChainTx (..), PostTxError (.. import Hydra.Chain.ChainState (ChainSlot (ChainSlot), IsChainState) import Hydra.Events (EventSink (..), EventSource (..), getEventId) import Hydra.Events.Rotation (EventStore (..), LogId) -import Hydra.HeadLogic (Input (..), NodeState (..), TTL) +import Hydra.HeadLogic (Input (..), TTL) import Hydra.HeadLogic.Outcome (StateChanged (HeadInitialized), genStateChanged) import Hydra.HeadLogic.StateEvent (StateEvent (..), genStateEvent) import Hydra.HeadLogicSpec (inInitialState, receiveMessage, receiveMessageFrom, testSnapshot) @@ -36,6 +36,7 @@ import Hydra.Node ( import Hydra.Node.Environment as Environment import Hydra.Node.InputQueue (InputQueue (..)) import Hydra.Node.ParameterMismatch (ParameterMismatch (..)) +import Hydra.Node.State (NodeState (..)) import Hydra.Options (defaultContestationPeriod, defaultDepositPeriod) import Hydra.Tx.ContestationPeriod (ContestationPeriod (..)) import Hydra.Tx.Crypto (HydraKey, sign) diff --git a/hydra-tui/src/Hydra/TUI/Model.hs b/hydra-tui/src/Hydra/TUI/Model.hs index 92c6d8f75c7..b89dac19f44 100644 --- a/hydra-tui/src/Hydra/TUI/Model.hs +++ b/hydra-tui/src/Hydra/TUI/Model.hs @@ -16,6 +16,7 @@ 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.Logging.Types (LogState) import Hydra.Tx (HeadId, Party (..), Snapshot (..)) import Hydra.Tx.ContestationPeriod qualified as CP @@ -249,8 +250,8 @@ isModalOpen s = Just OpenHome -> False Just _ -> True -recoverHeadState :: UTCTime -> HeadState -> State.NodeState Tx -> HeadState -recoverHeadState now current State.NodeState{headState, pendingDeposits} = +recoverHeadState :: UTCTime -> HeadState -> NodeState Tx -> HeadState +recoverHeadState now current NodeState{headState, pendingDeposits} = case headState of State.Idle State.IdleState{} -> current State.Initial @@ -317,7 +318,7 @@ recoverHeadState now current State.NodeState{headState, pendingDeposits} = where pendingIncrements = Map.toList pendingDeposits - <&> ( \(txId, State.Deposit{deposited, deadline}) -> + <&> ( \(txId, Deposit{deposited, deadline}) -> PendingIncrement { utxoToCommit = deposited , deposit = txId