From 179a8e376d56dbdd754202bbe44820811e2a3143 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Wed, 6 Mar 2024 19:40:49 +0100 Subject: [PATCH 01/15] Start renaming --- hydra-node/src/Hydra/HeadLogic/Event.hs | 34 ++++++++++++------------- 1 file changed, 16 insertions(+), 18 deletions(-) diff --git a/hydra-node/src/Hydra/HeadLogic/Event.hs b/hydra-node/src/Hydra/HeadLogic/Event.hs index 3b4b4933671..91b102f0f9a 100644 --- a/hydra-node/src/Hydra/HeadLogic/Event.hs +++ b/hydra-node/src/Hydra/HeadLogic/Event.hs @@ -1,6 +1,6 @@ {-# LANGUAGE UndecidableInstances #-} -module Hydra.HeadLogic.Event where +module Hydra.HeadLogic.Input where import Hydra.Prelude @@ -12,28 +12,26 @@ import Hydra.Party (Party) type TTL = Natural --- TODO: Move logic up and types down or re-organize using explicit exports - --- | The different events which are processed by the head logic (the "core"). --- Corresponding to each of the "shell" layers, we distinguish between events --- from the client, the network and the chain. -data Event tx - = -- | Event received from clients via the "Hydra.API". - ClientEvent {clientInput :: ClientInput tx} - | -- | Event received from peers via a "Hydra.Network". +-- | Inputs that are processed by the head logic (the "core"). Corresponding to +-- each of the "shell" layers, we distinguish between inputs from the client, +-- the network and the chain. +data Input tx + = -- | Input received from clients via the "Hydra.API". + ClientInput {clientInput :: ClientInput tx} + | -- | Input received from peers via a "Hydra.Network". -- -- * `ttl` is a simple counter that's decreased every time the event is -- reenqueued due to a wait. It's default value is `defaultTTL` - NetworkEvent {ttl :: TTL, party :: Party, message :: Message tx} - | -- | Event received from the chain via a "Hydra.Chain". - OnChainEvent {chainEvent :: ChainEvent tx} + NetworkInput {ttl :: TTL, party :: Party, message :: Message tx} + | -- | Input received from the chain via a "Hydra.Chain". + ChainInput {chainInput :: ChainEvent tx} deriving stock (Generic) -deriving stock instance IsChainState tx => Eq (Event tx) -deriving stock instance IsChainState tx => Show (Event tx) -deriving anyclass instance IsChainState tx => ToJSON (Event tx) -deriving anyclass instance IsChainState tx => FromJSON (Event tx) +deriving stock instance IsChainState tx => Eq (Input tx) +deriving stock instance IsChainState tx => Show (Input tx) +deriving anyclass instance IsChainState tx => ToJSON (Input tx) +deriving anyclass instance IsChainState tx => FromJSON (Input tx) -instance (IsTx tx, IsChainState tx) => Arbitrary (Event tx) where +instance (IsTx tx, IsChainState tx) => Arbitrary (Input tx) where arbitrary = genericArbitrary shrink = genericShrink From 14d76be456aa65bdc3c587afdeadb6852fd316d5 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 11 Mar 2024 11:01:44 +0100 Subject: [PATCH 02/15] Rename HeadLogic.Event -> Input Hydra.HeadLogic.* renamed --- hydra-node/hydra-node.cabal | 2 +- hydra-node/json-schemas/logs.yaml | 1 + hydra-node/src/Hydra/HeadLogic.hs | 73 +++++++++---------- hydra-node/src/Hydra/HeadLogic/Error.hs | 19 +++-- .../Hydra/HeadLogic/{Event.hs => Input.hs} | 7 +- hydra-node/src/Hydra/HeadLogic/Outcome.hs | 2 +- hydra-node/src/Hydra/HeadLogic/State.hs | 8 +- 7 files changed, 53 insertions(+), 59 deletions(-) rename hydra-node/src/Hydra/HeadLogic/{Event.hs => Input.hs} (87%) diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 812fb015e8e..37a3d50a355 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -70,7 +70,7 @@ library Hydra.HeadId Hydra.HeadLogic Hydra.HeadLogic.Error - Hydra.HeadLogic.Event + Hydra.HeadLogic.Input Hydra.HeadLogic.Outcome Hydra.HeadLogic.SnapshotOutcome Hydra.HeadLogic.State diff --git a/hydra-node/json-schemas/logs.yaml b/hydra-node/json-schemas/logs.yaml index 0a7aacd6680..2d19e48dd05 100644 --- a/hydra-node/json-schemas/logs.yaml +++ b/hydra-node/json-schemas/logs.yaml @@ -1523,6 +1523,7 @@ definitions: items: $ref: "api.yaml#/components/schemas/Signature" + # FIXME: update schema Event: description: >- Events (with Effects) are the atomic elements of the Hydra Head protocol diff --git a/hydra-node/src/Hydra/HeadLogic.hs b/hydra-node/src/Hydra/HeadLogic.hs index 03021b8adff..aad5fd52798 100644 --- a/hydra-node/src/Hydra/HeadLogic.hs +++ b/hydra-node/src/Hydra/HeadLogic.hs @@ -3,17 +3,17 @@ -- | Implements the Head Protocol's /state machine/ as /pure functions/ in an event sourced manner. -- --- More specifically, the 'update' will handle incoming 'Event' (or rather --- "commands" in event sourcing speak) and convert that into a set of --- side-'Effect's and internal 'StateChanged' events, which in turn are --- 'aggregate'd into a single 'HeadState'. +-- More specifically, the 'update' will handle 'Input's (or rather "commands" in +-- event sourcing speak) and convert that into a list of side-'Effect's and +-- 'StateChanged' events, which in turn are 'aggregate'd into a single +-- 'HeadState'. -- -- As the specification is using a more imperative way of specifying the protocl -- behavior, one would find the decision logic in 'update' while state updates -- can be found in the corresponding 'aggregate' branch. module Hydra.HeadLogic ( module Hydra.HeadLogic, - module Hydra.HeadLogic.Event, + module Hydra.HeadLogic.Input, module Hydra.HeadLogic.Error, module Hydra.HeadLogic.State, module Hydra.HeadLogic.Outcome, @@ -52,10 +52,7 @@ import Hydra.HeadLogic.Error ( LogicError (..), RequirementFailure (..), ) -import Hydra.HeadLogic.Event ( - Event (..), - TTL, - ) +import Hydra.HeadLogic.Input (Input (..), TTL) import Hydra.HeadLogic.Outcome ( Effect (..), Outcome (..), @@ -684,92 +681,92 @@ onClosedChainFanoutTx closedState newChainState = ClosedState{confirmedSnapshot, headId} = closedState --- | Handles commands and converts them into internal 'StateChanged' events --- along with 'Effect's, in case it is processed succesfully. --- Later, the Node will 'aggregate' the events, resulting in a new 'HeadState'. +-- | Handles inputs and converts them into 'StateChanged' events along with +-- 'Effect's, in case it is processed succesfully. Later, the Node will +-- 'aggregate' the events, resulting in a new 'HeadState'. update :: IsChainState tx => Environment -> Ledger tx -> -- | Current HeadState to validate the command against. HeadState tx -> - -- | Command sent to the HeadLogic to be processed. - Event tx -> + -- | Input to be processed. + Input tx -> Outcome tx update env ledger st ev = case (st, ev) of - (Idle _, ClientEvent Init) -> + (Idle _, ClientInput Init) -> onIdleClientInit env - (Idle _, OnChainEvent Observation{observedTx = OnInitTx{headId, headSeed, headParameters, participants}, newChainState}) -> + (Idle _, ChainInput Observation{observedTx = OnInitTx{headId, headSeed, headParameters, participants}, newChainState}) -> onIdleChainInitTx env newChainState headId headSeed headParameters participants - (Initial initialState@InitialState{headId = ourHeadId}, OnChainEvent Observation{observedTx = OnCommitTx{headId, party = pt, committed = utxo}, newChainState}) + (Initial initialState@InitialState{headId = ourHeadId}, ChainInput Observation{observedTx = OnCommitTx{headId, party = pt, committed = utxo}, newChainState}) | ourHeadId == headId -> onInitialChainCommitTx initialState newChainState pt utxo | otherwise -> Error NotOurHead{ourHeadId, otherHeadId = headId} - (Initial initialState, ClientEvent Abort) -> + (Initial initialState, ClientInput Abort) -> onInitialClientAbort initialState - (Initial initialState@InitialState{headId = ourHeadId}, OnChainEvent Observation{observedTx = OnCollectComTx{headId}, newChainState}) + (Initial initialState@InitialState{headId = ourHeadId}, ChainInput Observation{observedTx = OnCollectComTx{headId}, newChainState}) | ourHeadId == headId -> onInitialChainCollectTx initialState newChainState | otherwise -> Error NotOurHead{ourHeadId, otherHeadId = headId} - (Initial InitialState{headId = ourHeadId, committed}, OnChainEvent Observation{observedTx = OnAbortTx{headId}, newChainState}) + (Initial InitialState{headId = ourHeadId, committed}, ChainInput Observation{observedTx = OnAbortTx{headId}, newChainState}) | ourHeadId == headId -> onInitialChainAbortTx newChainState committed headId | otherwise -> Error NotOurHead{ourHeadId, otherHeadId = headId} - (Initial InitialState{committed, headId}, ClientEvent GetUTxO) -> + (Initial InitialState{committed, headId}, ClientInput GetUTxO) -> cause (ClientEffect . ServerOutput.GetUTxOResponse headId $ fold committed) -- Open - (Open openState, ClientEvent Close) -> + (Open openState, ClientInput Close) -> onOpenClientClose openState - (Open{}, ClientEvent (NewTx tx)) -> + (Open{}, ClientInput (NewTx tx)) -> onOpenClientNewTx tx - (Open openState, NetworkEvent ttl _ (ReqTx tx)) -> + (Open openState, NetworkInput ttl _ (ReqTx tx)) -> onOpenNetworkReqTx env ledger openState ttl tx - (Open openState, NetworkEvent _ otherParty (ReqSn sn txIds)) -> + (Open openState, NetworkInput _ otherParty (ReqSn sn txIds)) -> -- XXX: ttl == 0 not handled for ReqSn onOpenNetworkReqSn env ledger openState otherParty sn txIds - (Open openState, NetworkEvent _ otherParty (AckSn snapshotSignature sn)) -> + (Open openState, NetworkInput _ otherParty (AckSn snapshotSignature sn)) -> -- XXX: ttl == 0 not handled for AckSn onOpenNetworkAckSn env openState otherParty snapshotSignature sn ( Open openState@OpenState{headId = ourHeadId} - , OnChainEvent Observation{observedTx = OnCloseTx{headId, snapshotNumber = closedSnapshotNumber, contestationDeadline}, newChainState} + , ChainInput Observation{observedTx = OnCloseTx{headId, snapshotNumber = closedSnapshotNumber, contestationDeadline}, newChainState} ) | ourHeadId == headId -> onOpenChainCloseTx openState newChainState closedSnapshotNumber contestationDeadline | otherwise -> Error NotOurHead{ourHeadId, otherHeadId = headId} - (Open OpenState{coordinatedHeadState = CoordinatedHeadState{confirmedSnapshot}, headId}, ClientEvent GetUTxO) -> + (Open OpenState{coordinatedHeadState = CoordinatedHeadState{confirmedSnapshot}, headId}, ClientInput GetUTxO) -> -- TODO: Is it really intuitive that we respond from the confirmed ledger if -- transactions are validated against the seen ledger? cause (ClientEffect . ServerOutput.GetUTxOResponse headId $ getField @"utxo" $ getSnapshot confirmedSnapshot) -- NOTE: If posting the collectCom transaction failed in the open state, then -- another party likely opened the head before us and it's okay to ignore. - (Open{}, OnChainEvent PostTxError{postChainTx = CollectComTx{}}) -> + (Open{}, ChainInput PostTxError{postChainTx = CollectComTx{}}) -> noop -- Closed - (Closed closedState@ClosedState{headId = ourHeadId}, OnChainEvent Observation{observedTx = OnContestTx{headId, snapshotNumber, contestationDeadline}, newChainState}) + (Closed closedState@ClosedState{headId = ourHeadId}, ChainInput Observation{observedTx = OnContestTx{headId, snapshotNumber, contestationDeadline}, newChainState}) | ourHeadId == headId -> onClosedChainContestTx closedState newChainState snapshotNumber contestationDeadline | otherwise -> Error NotOurHead{ourHeadId, otherHeadId = headId} - (Closed ClosedState{contestationDeadline, readyToFanoutSent, headId}, OnChainEvent Tick{chainTime}) + (Closed ClosedState{contestationDeadline, readyToFanoutSent, headId}, ChainInput Tick{chainTime}) | chainTime > contestationDeadline && not readyToFanoutSent -> newState HeadIsReadyToFanout <> cause (ClientEffect $ ServerOutput.ReadyToFanout headId) - (Closed closedState, ClientEvent Fanout) -> + (Closed closedState, ClientInput Fanout) -> onClosedClientFanout closedState - (Closed closedState@ClosedState{headId = ourHeadId}, OnChainEvent Observation{observedTx = OnFanoutTx{headId}, newChainState}) + (Closed closedState@ClosedState{headId = ourHeadId}, ChainInput Observation{observedTx = OnFanoutTx{headId}, newChainState}) | ourHeadId == headId -> onClosedChainFanoutTx closedState newChainState | otherwise -> Error NotOurHead{ourHeadId, otherHeadId = headId} -- General - (_, OnChainEvent Rollback{rolledBackChainState}) -> + (_, ChainInput Rollback{rolledBackChainState}) -> newState ChainRolledBack{chainState = rolledBackChainState} - (_, OnChainEvent Tick{chainSlot}) -> + (_, ChainInput Tick{chainSlot}) -> newState TickObserved{chainSlot} - (_, OnChainEvent PostTxError{postChainTx, postTxError}) -> + (_, ChainInput PostTxError{postChainTx, postTxError}) -> cause . ClientEffect $ ServerOutput.PostTxOnChainFailed{postChainTx, postTxError} - (_, ClientEvent{clientInput}) -> + (_, ClientInput{clientInput}) -> cause . ClientEffect $ ServerOutput.CommandFailed clientInput st _ -> - Error $ InvalidEvent ev st + Error $ UnhandledInput ev st -- * HeadState aggregate diff --git a/hydra-node/src/Hydra/HeadLogic/Error.hs b/hydra-node/src/Hydra/HeadLogic/Error.hs index 2a46f302698..2a90f67b3c5 100644 --- a/hydra-node/src/Hydra/HeadLogic/Error.hs +++ b/hydra-node/src/Hydra/HeadLogic/Error.hs @@ -1,35 +1,34 @@ {-# LANGUAGE UndecidableInstances #-} +-- | Error types used in the Hydra.HeadLogic module. module Hydra.HeadLogic.Error where import Hydra.Prelude import Hydra.Crypto (HydraKey, VerificationKey) import Hydra.HeadId (HeadId) -import Hydra.HeadLogic.Event (Event) +import Hydra.HeadLogic.Input (Input) import Hydra.HeadLogic.State (HeadState) import Hydra.Ledger (IsTx (TxIdType), ValidationError) import Hydra.Party (Party) import Hydra.Snapshot (SnapshotNumber) --- | Preliminary type for collecting errors occurring during 'update'. --- TODO: Try to merge this (back) into 'Outcome'. data LogicError tx - = InvalidEvent {invalidEvent :: Event tx, currentHeadState :: HeadState tx} + = UnhandledInput {input :: Input tx, currentHeadState :: HeadState tx} | RequireFailed {requirementFailure :: RequirementFailure tx} | NotOurHead {ourHeadId :: HeadId, otherHeadId :: HeadId} deriving stock (Generic) -instance (Typeable tx, Show (Event tx), Show (HeadState tx), Show (RequirementFailure tx)) => Exception (LogicError tx) +instance (Typeable tx, Show (Input tx), Show (HeadState tx), Show (RequirementFailure tx)) => Exception (LogicError tx) -instance (Arbitrary (Event tx), Arbitrary (HeadState tx), Arbitrary (RequirementFailure tx)) => Arbitrary (LogicError tx) where +instance (Arbitrary (Input tx), Arbitrary (HeadState tx), Arbitrary (RequirementFailure tx)) => Arbitrary (LogicError tx) where arbitrary = genericArbitrary shrink = genericShrink -deriving stock instance (Eq (HeadState tx), Eq (Event tx), Eq (RequirementFailure tx)) => Eq (LogicError tx) -deriving stock instance (Show (HeadState tx), Show (Event tx), Show (RequirementFailure tx)) => Show (LogicError tx) -deriving anyclass instance (ToJSON (HeadState tx), ToJSON (Event tx), ToJSON (RequirementFailure tx)) => ToJSON (LogicError tx) -deriving anyclass instance (FromJSON (HeadState tx), FromJSON (Event tx), FromJSON (RequirementFailure tx)) => FromJSON (LogicError tx) +deriving stock instance (Eq (HeadState tx), Eq (Input tx), Eq (RequirementFailure tx)) => Eq (LogicError tx) +deriving stock instance (Show (HeadState tx), Show (Input tx), Show (RequirementFailure tx)) => Show (LogicError tx) +deriving anyclass instance (ToJSON (HeadState tx), ToJSON (Input tx), ToJSON (RequirementFailure tx)) => ToJSON (LogicError tx) +deriving anyclass instance (FromJSON (HeadState tx), FromJSON (Input tx), FromJSON (RequirementFailure tx)) => FromJSON (LogicError tx) data RequirementFailure tx = ReqSnNumberInvalid {requestedSn :: SnapshotNumber, lastSeenSn :: SnapshotNumber} diff --git a/hydra-node/src/Hydra/HeadLogic/Event.hs b/hydra-node/src/Hydra/HeadLogic/Input.hs similarity index 87% rename from hydra-node/src/Hydra/HeadLogic/Event.hs rename to hydra-node/src/Hydra/HeadLogic/Input.hs index 91b102f0f9a..6f5310a7824 100644 --- a/hydra-node/src/Hydra/HeadLogic/Event.hs +++ b/hydra-node/src/Hydra/HeadLogic/Input.hs @@ -1,12 +1,9 @@ -{-# LANGUAGE UndecidableInstances #-} - module Hydra.HeadLogic.Input where import Hydra.Prelude import Hydra.API.ClientInput (ClientInput) import Hydra.Chain (ChainEvent, IsChainState) -import Hydra.Ledger (IsTx) import Hydra.Network.Message (Message) import Hydra.Party (Party) @@ -24,7 +21,7 @@ data Input tx -- reenqueued due to a wait. It's default value is `defaultTTL` NetworkInput {ttl :: TTL, party :: Party, message :: Message tx} | -- | Input received from the chain via a "Hydra.Chain". - ChainInput {chainInput :: ChainEvent tx} + ChainInput {chainEvent :: ChainEvent tx} deriving stock (Generic) deriving stock instance IsChainState tx => Eq (Input tx) @@ -32,6 +29,6 @@ deriving stock instance IsChainState tx => Show (Input tx) deriving anyclass instance IsChainState tx => ToJSON (Input tx) deriving anyclass instance IsChainState tx => FromJSON (Input tx) -instance (IsTx tx, IsChainState tx) => Arbitrary (Input tx) where +instance IsChainState tx => Arbitrary (Input tx) where arbitrary = genericArbitrary shrink = genericShrink diff --git a/hydra-node/src/Hydra/HeadLogic/Outcome.hs b/hydra-node/src/Hydra/HeadLogic/Outcome.hs index 68481e643a7..dec6a78005b 100644 --- a/hydra-node/src/Hydra/HeadLogic/Outcome.hs +++ b/hydra-node/src/Hydra/HeadLogic/Outcome.hs @@ -16,7 +16,7 @@ import Hydra.Network.Message (Message) import Hydra.Party (Party) import Hydra.Snapshot (Snapshot, SnapshotNumber) --- | Analogous to events, the pure head logic "core" can have effects emited to +-- | Analogous to inputs, the pure head logic "core" can have effects emited to -- the "shell" layers and we distinguish the same: effects onto the client, the -- network and the chain. data Effect tx diff --git a/hydra-node/src/Hydra/HeadLogic/State.hs b/hydra-node/src/Hydra/HeadLogic/State.hs index d93d38f0f97..f755b6ab9f2 100644 --- a/hydra-node/src/Hydra/HeadLogic/State.hs +++ b/hydra-node/src/Hydra/HeadLogic/State.hs @@ -47,16 +47,16 @@ instance Arbitrary Environment where -- | The main state of the Hydra protocol state machine. It holds both, the -- overall protocol state, but also the off-chain 'CoordinatedHeadState'. -- --- Each of the sub-types (InitialState, OpenState, etc.) contain black-box --- 'chainState' corresponding to 'OnChainEvent' that has been observed leading +-- Each of the sub-types (InitialState, OpenState, etc.) contain a black-box +-- 'chainState' corresponding to the 'ChainEvent' that has been observed leading -- to the state. -- -- Note that rollbacks are currently not fully handled in the head logic and -- only this internal chain state gets replaced with the "rolled back to" -- version. -- --- XXX: chainState would actualy not be needed in the HeadState anymore as we do --- not persist the 'HeadState' and not access it in the HeadLogic either. +-- TODO: chainState would actualy not be needed in the HeadState anymore as we +-- do not persist the 'HeadState' and not access it in the HeadLogic either. data HeadState tx = Idle (IdleState tx) | Initial (InitialState tx) From eb0ed70638fbe1b438ad9a92e81a260b6225636f Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 11 Mar 2024 11:08:37 +0100 Subject: [PATCH 03/15] Rename EventQueue -> InputQueue --- hydra-node/hydra-node.cabal | 4 +-- hydra-node/src/Hydra/Node.hs | 2 +- .../Node/{EventQueue.hs => InputQueue.hs} | 34 +++++++++---------- hydra-node/test/Hydra/Node/EventQueueSpec.hs | 29 ---------------- hydra-node/test/Hydra/Node/InputQueueSpec.hs | 29 ++++++++++++++++ hydra-node/test/Hydra/NodeSpec.hs | 10 +++--- 6 files changed, 54 insertions(+), 54 deletions(-) rename hydra-node/src/Hydra/Node/{EventQueue.hs => InputQueue.hs} (66%) delete mode 100644 hydra-node/test/Hydra/Node/EventQueueSpec.hs create mode 100644 hydra-node/test/Hydra/Node/InputQueueSpec.hs diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 37a3d50a355..91c3669df0f 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -94,7 +94,7 @@ library Hydra.Network.Ouroboros.Type Hydra.Network.Reliability Hydra.Node - Hydra.Node.EventQueue + Hydra.Node.InputQueue Hydra.Node.Network Hydra.Node.ParameterMismatch Hydra.Node.Run @@ -308,7 +308,7 @@ test-suite tests Hydra.Network.HeartbeatSpec Hydra.Network.ReliabilitySpec Hydra.NetworkSpec - Hydra.Node.EventQueueSpec + Hydra.Node.InputQueueSpec Hydra.Node.RunSpec Hydra.NodeSpec Hydra.OptionsSpec diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index 95a7dc2a2d3..8e1e8ed6f38 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -50,7 +50,7 @@ import Hydra.Ledger (Ledger) import Hydra.Logging (Tracer, traceWith) import Hydra.Network (Network (..)) import Hydra.Network.Message (Message) -import Hydra.Node.EventQueue (EventQueue (..), Queued (..)) +import Hydra.Node.InputQueue (InputQueue (..), Queued (..)) import Hydra.Node.ParameterMismatch (ParamMismatch (..), ParameterMismatch (..)) import Hydra.Options (ChainConfig (..), DirectChainConfig (..), RunOptions (..), defaultContestationPeriod) import Hydra.Party (Party (..), deriveParty) diff --git a/hydra-node/src/Hydra/Node/EventQueue.hs b/hydra-node/src/Hydra/Node/InputQueue.hs similarity index 66% rename from hydra-node/src/Hydra/Node/EventQueue.hs rename to hydra-node/src/Hydra/Node/InputQueue.hs index ae740ae8de5..109534b1517 100644 --- a/hydra-node/src/Hydra/Node/EventQueue.hs +++ b/hydra-node/src/Hydra/Node/InputQueue.hs @@ -1,5 +1,5 @@ --- | The general event queue from which the Hydra head is fed with events. -module Hydra.Node.EventQueue where +-- | The general input queue from which the Hydra head is fed with inputs. +module Hydra.Node.InputQueue where import Hydra.Prelude @@ -20,42 +20,42 @@ import Control.Monad.Class.MonadAsync (async) -- NOTE(SN): this probably should be bounded and include proper logging -- NOTE(SN): handle pattern, but likely not required as there is no need for an -- alternative implementation -data EventQueue m e = EventQueue - { putEvent :: e -> m () - , putEventAfter :: DiffTime -> Queued e -> m () - , nextEvent :: m (Queued e) +data InputQueue m e = InputQueue + { enqueue :: e -> m () + , reenqueue :: DiffTime -> Queued e -> m () + , dequeue :: m (Queued e) , isEmpty :: m Bool } -data Queued e = Queued {eventId :: Word64, queuedEvent :: e} +data Queued a = Queued {queuedId :: Word64, queuedItem :: a} -createEventQueue :: +createInputQueue :: ( MonadDelay m , MonadAsync m , MonadLabelledSTM m ) => - m (EventQueue m e) -createEventQueue = do + m (InputQueue m e) +createInputQueue = do numThreads <- newTVarIO (0 :: Integer) nextId <- newTVarIO 0 labelTVarIO numThreads "num-threads" q <- atomically newTQueue - labelTQueueIO q "event-queue" + labelTQueueIO q "input-queue" pure - EventQueue - { putEvent = \queuedEvent -> + InputQueue + { enqueue = \queuedItem -> atomically $ do - eventId <- readTVar nextId - writeTQueue q Queued{eventId, queuedEvent} + queuedId <- readTVar nextId + writeTQueue q Queued{queuedId, queuedItem} modifyTVar' nextId succ - , putEventAfter = \delay e -> do + , reenqueue = \delay e -> do atomically $ modifyTVar' numThreads succ void . async $ do threadDelay delay atomically $ do modifyTVar' numThreads pred writeTQueue q e - , nextEvent = + , dequeue = atomically $ readTQueue q , isEmpty = do atomically $ do diff --git a/hydra-node/test/Hydra/Node/EventQueueSpec.hs b/hydra-node/test/Hydra/Node/EventQueueSpec.hs deleted file mode 100644 index 7411dbf86ce..00000000000 --- a/hydra-node/test/Hydra/Node/EventQueueSpec.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Hydra.Node.EventQueueSpec where - -import Hydra.Prelude - -import Control.Monad.IOSim (IOSim, runSimOrThrow) -import Hydra.API.ServerSpec (strictlyMonotonic) -import Hydra.Node.EventQueue (Queued (eventId), createEventQueue, nextEvent, putEvent) -import Test.Hspec (Spec) -import Test.Hspec.QuickCheck (prop) -import Test.QuickCheck (NonEmptyList (NonEmpty), Property, counterexample) - -spec :: Spec -spec = - prop "adds sequential id to all events enqueued" prop_identify_enqueued_events - -newtype DummyEvent = DummyEvent Int - deriving newtype (Eq, Show, Arbitrary) - -prop_identify_enqueued_events :: NonEmptyList DummyEvent -> Property -prop_identify_enqueued_events (NonEmpty events) = - let test :: IOSim s [Word64] - test = do - q <- createEventQueue - forM events $ \e -> do - putEvent q e - eventId <$> nextEvent q - eventIds = runSimOrThrow test - in strictlyMonotonic eventIds - & counterexample ("queued ids: " <> show eventIds) diff --git a/hydra-node/test/Hydra/Node/InputQueueSpec.hs b/hydra-node/test/Hydra/Node/InputQueueSpec.hs new file mode 100644 index 00000000000..81c1977732e --- /dev/null +++ b/hydra-node/test/Hydra/Node/InputQueueSpec.hs @@ -0,0 +1,29 @@ +module Hydra.Node.InputQueueSpec where + +import Hydra.Prelude + +import Control.Monad.IOSim (IOSim, runSimOrThrow) +import Hydra.API.ServerSpec (strictlyMonotonic) +import Hydra.Node.InputQueue (Queued (queuedId), createInputQueue, dequeue, enqueue) +import Test.Hspec (Spec) +import Test.Hspec.QuickCheck (prop) +import Test.QuickCheck (NonEmptyList (NonEmpty), Property, counterexample) + +spec :: Spec +spec = + prop "adds sequential id to all events enqueued" prop_identify_enqueued_events + +newtype DummyInput = DummyInput Int + deriving newtype (Eq, Show, Arbitrary) + +prop_identify_enqueued_events :: NonEmptyList Int -> Property +prop_identify_enqueued_events (NonEmpty inputs) = + let test :: IOSim s [Word64] + test = do + q <- createInputQueue + forM inputs $ \i -> do + enqueue q i + queuedId <$> dequeue q + ids = runSimOrThrow test + in strictlyMonotonic ids + & counterexample ("queued ids: " <> show ids) diff --git a/hydra-node/test/Hydra/NodeSpec.hs b/hydra-node/test/Hydra/NodeSpec.hs index c93479256af..c81442f1f94 100644 --- a/hydra-node/test/Hydra/NodeSpec.hs +++ b/hydra-node/test/Hydra/NodeSpec.hs @@ -35,7 +35,7 @@ import Hydra.Node ( loadState, stepHydraNode, ) -import Hydra.Node.EventQueue (EventQueue (..), createEventQueue) +import Hydra.Node.InputQueue (InputQueue (..), createInputQueue) import Hydra.Node.ParameterMismatch (ParameterMismatch (..)) import Hydra.Options (defaultContestationPeriod) import Hydra.Party (Party, deriveParty) @@ -231,7 +231,7 @@ runToCompletion :: Tracer IO (HydraNodeLog tx) -> HydraNode tx IO -> IO () -runToCompletion tracer node@HydraNode{eq = EventQueue{isEmpty}} = go +runToCompletion tracer node@HydraNode{eq = InputQueue{isEmpty}} = go where go = unlessM isEmpty $ @@ -260,13 +260,13 @@ createHydraNode' :: [Event SimpleTx] -> m (HydraNode SimpleTx m) createHydraNode' persistence signingKey otherParties contestationPeriod events = do - eq@EventQueue{putEvent} <- createEventQueue - forM_ events putEvent + inputQueue@InputQueue{enqueue} <- createInputQueue + forM_ events enqueue (headState, _) <- loadState nullTracer persistence SimpleChainState{slot = ChainSlot 0} nodeState <- createNodeState headState pure $ HydraNode - { eq + { inputQueue , hn = Network{broadcast = \_ -> pure ()} , nodeState , oc = From ba25a1cf36d44c7180c78e3da51c48ceb977022b Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 11 Mar 2024 11:18:01 +0100 Subject: [PATCH 04/15] Rename eq -> inputQueue and Begin/EndEvent -> Begin/EndInput --- hydra-node/json-schemas/logs.yaml | 1 + hydra-node/src/Hydra/Node.hs | 54 ++++++++++++++++++------------- hydra-node/src/Hydra/Node/Run.hs | 14 ++++---- 3 files changed, 39 insertions(+), 30 deletions(-) diff --git a/hydra-node/json-schemas/logs.yaml b/hydra-node/json-schemas/logs.yaml index 2d19e48dd05..5a5b80f24e1 100644 --- a/hydra-node/json-schemas/logs.yaml +++ b/hydra-node/json-schemas/logs.yaml @@ -748,6 +748,7 @@ definitions: Node: oneOf: + # FIXME: Update logs schema - title: BeginEvent description: >- Head has started processing an event drawn from some pool or queue of diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index 8e1e8ed6f38..2862702ee00 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -34,9 +34,9 @@ import Hydra.Crypto (AsType (AsHydraKey)) import Hydra.HeadLogic ( Effect (..), Environment (..), - Event (..), HeadState (..), IdleState (..), + Input (..), Outcome (..), aggregateState, defaultTTL, @@ -135,7 +135,7 @@ checkHeadState tracer env headState = do -- | Main handle of a hydra node where all layers are tied together. data HydraNode tx m = HydraNode - { eq :: EventQueue m (Event tx) + { inputQueue :: InputQueue m (Input tx) , hn :: Network m (Message tx) , nodeState :: NodeState tx m , oc :: Chain tx m @@ -146,10 +146,10 @@ data HydraNode tx m = HydraNode } data HydraNodeLog tx - = BeginEvent {by :: Party, eventId :: Word64, event :: Event tx} - | EndEvent {by :: Party, eventId :: Word64} - | BeginEffect {by :: Party, eventId :: Word64, effectId :: Word32, effect :: Effect tx} - | EndEffect {by :: Party, eventId :: Word64, effectId :: Word32} + = BeginInput {by :: Party, inputId :: Word64, input :: Input tx} + | EndInput {by :: Party, inputId :: Word64} + | BeginEffect {by :: Party, inputId :: Word64, effectId :: Word32, effect :: Effect tx} + | EndEffect {by :: Party, inputId :: Word64, effectId :: Word32} | LogicOutcome {by :: Party, outcome :: Outcome tx} | LoadedState {numberOfEvents :: Word64} | Misconfiguration {misconfigurationErrors :: [ParamMismatch]} @@ -186,44 +186,44 @@ stepHydraNode :: HydraNode tx m -> m () stepHydraNode tracer node = do - e@Queued{eventId, queuedEvent} <- nextEvent eq - traceWith tracer $ BeginEvent{by = party, eventId, event = queuedEvent} - outcome <- atomically (processNextEvent node queuedEvent) + i@Queued{queuedId, queuedItem} <- dequeue + traceWith tracer $ BeginInput{by = party, inputId = queuedId, input = queuedItem} + outcome <- atomically (processNextInput node queuedItem) traceWith tracer (LogicOutcome party outcome) case outcome of Continue{events, effects} -> do forM_ events append - processEffects node tracer eventId effects + processEffects node tracer queuedId effects Wait{events} -> do forM_ events append - putEventAfter eq waitDelay (decreaseTTL e) + reenqueue waitDelay (decreaseTTL i) Error{} -> pure () - traceWith tracer EndEvent{by = party, eventId} + traceWith tracer EndInput{by = party, inputId = queuedId} where decreaseTTL = \case -- XXX: this is smelly, handle wait re-enqueing differently - Queued{eventId, queuedEvent = NetworkEvent ttl aParty msg} - | ttl > 0 -> Queued{eventId, queuedEvent = NetworkEvent (ttl - 1) aParty msg} + Queued{queuedId, queuedItem = NetworkInput ttl aParty msg} + | ttl > 0 -> Queued{queuedId, queuedItem = NetworkInput (ttl - 1) aParty msg} e -> e Environment{party} = env PersistenceIncremental{append} = persistence - HydraNode{persistence, eq, env} = node + HydraNode{persistence, inputQueue = InputQueue{dequeue, reenqueue}, env} = node -- | The time to wait between re-enqueuing a 'Wait' outcome from 'HeadLogic'. waitDelay :: DiffTime waitDelay = 0.1 -- | Monadic interface around 'Hydra.Logic.update'. -processNextEvent :: +processNextInput :: IsChainState tx => HydraNode tx m -> - Event tx -> + Input tx -> STM m (Outcome tx) -processNextEvent HydraNode{nodeState, ledger, env} e = +processNextInput HydraNode{nodeState, ledger, env} e = modifyHeadState $ \s -> let outcome = computeOutcome s e in (outcome, aggregateState s outcome) @@ -242,19 +242,27 @@ processEffects :: Word64 -> [Effect tx] -> m () -processEffects HydraNode{hn, oc = Chain{postTx}, server, eq, env = Environment{party}} tracer eventId effects = do +processEffects node tracer inputId effects = do mapM_ processEffect $ zip effects [0 ..] where processEffect (effect, effectId) = do - traceWith tracer $ BeginEffect party eventId effectId effect + traceWith tracer $ BeginEffect party inputId effectId effect case effect of ClientEffect i -> sendOutput server i - NetworkEffect msg -> broadcast hn msg >> putEvent eq (NetworkEvent defaultTTL party msg) + NetworkEffect msg -> broadcast hn msg >> enqueue (NetworkInput defaultTTL party msg) OnChainEffect{postChainTx} -> postTx postChainTx `catch` \(postTxError :: PostTxError tx) -> - putEvent eq . OnChainEvent $ PostTxError{postChainTx, postTxError} - traceWith tracer $ EndEffect party eventId effectId + enqueue . ChainInput $ PostTxError{postChainTx, postTxError} + traceWith tracer $ EndEffect party inputId effectId + + HydraNode + { hn + , oc = Chain{postTx} + , server + , inputQueue = InputQueue{enqueue} + , env = Environment{party} + } = node -- ** Manage state diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 5eb7747f95e..6c7b9fb1237 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -14,7 +14,7 @@ import Hydra.Chain.Direct.State (initialChainState) import Hydra.Chain.Offline (loadGenesisFile, withOfflineChain) import Hydra.HeadLogic ( Environment (..), - Event (..), + Input (..), defaultTTL, ) import Hydra.Ledger.Cardano qualified as Ledger @@ -38,7 +38,7 @@ import Hydra.Node ( loadState, runHydraNode, ) -import Hydra.Node.EventQueue (EventQueue (..), createEventQueue) +import Hydra.Node.InputQueue (InputQueue (..), createInputQueue) import Hydra.Node.Network (NetworkConfiguration (..), withNetwork) import Hydra.Options ( ChainConfig (..), @@ -73,7 +73,7 @@ run opts = do withTracer verbosity $ \tracer' -> withMonitoring monitoringPort tracer' $ \tracer -> do traceWith tracer (NodeOptions opts) - eq@EventQueue{putEvent} <- createEventQueue + inputQueue@InputQueue{enqueue} <- createInputQueue let RunOptions{chainConfig, ledgerConfig} = opts pparams <- readJsonFileThrow pparamsFromJson (cardanoLedgerProtocolParametersFile ledgerConfig) @@ -87,20 +87,20 @@ run opts = do nodeState <- createNodeState hs -- Chain withChain <- prepareChainComponent tracer env chainConfig - withChain chainStateHistory (putEvent . OnChainEvent) $ \chain -> do + withChain chainStateHistory (enqueue . ChainInput) $ \chain -> do -- API let RunOptions{host, port, peers, nodeId} = opts - putNetworkEvent (Authenticated msg otherParty) = putEvent $ NetworkEvent defaultTTL otherParty msg + putNetworkEvent (Authenticated msg otherParty) = enqueue $ NetworkInput defaultTTL otherParty msg RunOptions{apiHost, apiPort} = opts apiPersistence <- createPersistenceIncremental $ persistenceDir <> "/server-output" - withAPIServer apiHost apiPort party apiPersistence (contramap APIServer tracer) chain pparams (putEvent . ClientEvent) $ \server -> do + withAPIServer apiHost apiPort party apiPersistence (contramap APIServer tracer) chain pparams (enqueue . ClientInput) $ \server -> do -- Network let networkConfiguration = NetworkConfiguration{persistenceDir, signingKey, otherParties, host, port, peers, nodeId} withNetwork tracer (connectionMessages server) networkConfiguration putNetworkEvent $ \hn -> do -- Main loop runHydraNode (contramap Node tracer) $ HydraNode - { eq + { inputQueue , hn , nodeState , oc = chain From b55eb2d1455dbad78f8ddfb12929a966c50c40fb Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 11 Mar 2024 11:19:07 +0100 Subject: [PATCH 05/15] Rename Begin/EndEvent -> Begin/EndInput in Monitoring --- hydra-node/src/Hydra/Logging/Monitoring.hs | 8 ++++---- hydra-node/test/Hydra/Logging/MonitoringSpec.hs | 8 ++++---- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/hydra-node/src/Hydra/Logging/Monitoring.hs b/hydra-node/src/Hydra/Logging/Monitoring.hs index caef5988517..a4005cbd434 100644 --- a/hydra-node/src/Hydra/Logging/Monitoring.hs +++ b/hydra-node/src/Hydra/Logging/Monitoring.hs @@ -20,13 +20,13 @@ import Data.Map.Strict as Map import Hydra.API.ServerOutput (ServerOutput (..)) import Hydra.HeadLogic ( Effect (ClientEffect), - Event (NetworkEvent), + Input (NetworkInput), ) import Hydra.Ledger (IsTx (TxIdType), txId) import Hydra.Logging.Messages (HydraLog (..)) import Hydra.Network (PortNumber) import Hydra.Network.Message (Message (ReqTx)) -import Hydra.Node (HydraNodeLog (BeginEffect, BeginEvent, EndEvent), event) +import Hydra.Node (HydraNodeLog (BeginEffect, BeginInput, EndInput, input)) import Hydra.Snapshot (Snapshot (confirmed)) import System.Metrics.Prometheus.Http.Scrape (serveMetrics) import System.Metrics.Prometheus.Metric (Metric (CounterMetric, HistogramMetric)) @@ -89,7 +89,7 @@ monitor :: HydraLog tx net -> m () monitor transactionsMap metricsMap = \case - (Node BeginEvent{event = NetworkEvent _ _ (ReqTx tx)}) -> do + (Node BeginInput{input = NetworkInput _ _ (ReqTx tx)}) -> do t <- getMonotonicTime -- NOTE: If a requested transaction never gets confirmed, it might stick -- forever in the transactions map which could lead to unbounded growth and @@ -107,7 +107,7 @@ monitor transactionsMap metricsMap = \case histo "hydra_head_tx_confirmation_time_ms" (diffTime t start) Nothing -> pure () tickN "hydra_head_confirmed_tx" (length $ confirmed snapshot) - (Node (EndEvent _ _)) -> + (Node (EndInput _ _)) -> tick "hydra_head_events" _ -> pure () where diff --git a/hydra-node/test/Hydra/Logging/MonitoringSpec.hs b/hydra-node/test/Hydra/Logging/MonitoringSpec.hs index e43dfae005d..8599b1fb52b 100644 --- a/hydra-node/test/Hydra/Logging/MonitoringSpec.hs +++ b/hydra-node/test/Hydra/Logging/MonitoringSpec.hs @@ -7,7 +7,7 @@ import Data.Text qualified as Text import Hydra.API.ServerOutput (ServerOutput (SnapshotConfirmed)) import Hydra.HeadLogic ( Effect (ClientEffect), - Event (NetworkEvent), + Input (NetworkInput), defaultTTL, ) import Hydra.HeadLogicSpec (testSnapshot) @@ -16,7 +16,7 @@ import Hydra.Logging (nullTracer, traceWith) import Hydra.Logging.Messages (HydraLog (Node)) import Hydra.Logging.Monitoring import Hydra.Network.Message (Message (ReqTx)) -import Hydra.Node (HydraNodeLog (BeginEffect, BeginEvent)) +import Hydra.Node (HydraNodeLog (BeginEffect, BeginInput)) import Network.HTTP.Req (GET (..), NoReqBody (..), bsResponse, defaultHttpConfig, http, port, req, responseBody, runReq, (/:)) import Test.Hydra.Fixture (alice, testHeadId) import Test.Network.Ports (randomUnusedTCPPorts) @@ -27,8 +27,8 @@ spec = failAfter 3 $ do [p] <- randomUnusedTCPPorts 1 withMonitoring (Just $ fromIntegral p) nullTracer $ \tracer -> do - traceWith tracer (Node $ BeginEvent alice 0 (NetworkEvent defaultTTL alice (ReqTx (aValidTx 42)))) - traceWith tracer (Node $ BeginEvent alice 1 (NetworkEvent defaultTTL alice (ReqTx (aValidTx 43)))) + traceWith tracer (Node $ BeginInput alice 0 (NetworkInput defaultTTL alice (ReqTx (aValidTx 42)))) + traceWith tracer (Node $ BeginInput alice 1 (NetworkInput defaultTTL alice (ReqTx (aValidTx 43)))) threadDelay 0.1 traceWith tracer (Node $ BeginEffect alice 0 0 (ClientEffect (SnapshotConfirmed testHeadId (testSnapshot 1 (utxoRefs [1]) [43, 42]) mempty))) From 3e45ac67fd49916aa967211114130a3e47b5b7e9 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 11 Mar 2024 11:30:47 +0100 Subject: [PATCH 06/15] Remove golden JSON tests of Event and HeadState Both are not used in any of our interfaces (plainly). --- hydra-node/golden/Event SimpleTx.json | 140 - hydra-node/golden/HeadState SimpleTx.json | 2820 --------------------- hydra-node/test/Hydra/HeadLogicSpec.hs | 7 +- 3 files changed, 1 insertion(+), 2966 deletions(-) delete mode 100644 hydra-node/golden/Event SimpleTx.json delete mode 100644 hydra-node/golden/HeadState SimpleTx.json diff --git a/hydra-node/golden/Event SimpleTx.json b/hydra-node/golden/Event SimpleTx.json deleted file mode 100644 index a1420cf7114..00000000000 --- a/hydra-node/golden/Event SimpleTx.json +++ /dev/null @@ -1,140 +0,0 @@ -{ - "samples": [ - { - "clientInput": { - "tag": "Contest" - }, - "tag": "ClientEvent" - }, - { - "message": { - "tag": "ReqTx", - "transaction": { - "id": -2, - "inputs": [ - -29, - -27, - -26, - -25, - -24, - -18, - -14, - -11, - -8, - -7, - -6, - -4, - -3, - -1, - 2, - 4, - 5, - 6, - 9, - 17, - 18, - 20, - 25, - 27 - ], - "outputs": [ - -27, - -25, - -21, - -18, - -15, - -3, - -1, - 0, - 5, - 6, - 11, - 14, - 17, - 20, - 21, - 22, - 23, - 25, - 26, - 30 - ] - } - }, - "party": { - "vkey": "61bac906d8f5fce531afcd9943c9fa393b6d08360179e8c448bdb84c08120562" - }, - "tag": "NetworkEvent", - "ttl": 30 - }, - { - "message": { - "tag": "ReqTx", - "transaction": { - "id": -2, - "inputs": [ - -25, - -24, - -21, - -18, - -3, - 6, - 17 - ], - "outputs": [ - -28, - -26, - -20, - -16, - -3, - -1, - 2, - 3, - 4, - 11, - 14, - 15, - 18, - 21, - 24, - 27, - 28 - ] - } - }, - "party": { - "vkey": "24c701586ebf817540eab9169b9f53cc5b444f0ae68f2a8e4614f4d92fc38161" - }, - "tag": "NetworkEvent", - "ttl": 6 - }, - { - "message": { - "snapshotNumber": 3, - "tag": "ReqSn", - "transactionIds": [ - 22, - -13 - ] - }, - "party": { - "vkey": "6c1d4461d17a7672230bfddcd44e243331ca8abb19a54ea35b28c6046d7a1ac1" - }, - "tag": "NetworkEvent", - "ttl": 5 - }, - { - "message": { - "signed": "a27f8582e9c12e66b02b24b029716d5a4ab32da11c899b1aba99650c7a972318b031e8a57df63f22d38561da7dbb23e9c8504ecb11bee34877b01a02372aa20b", - "snapshotNumber": 0, - "tag": "AckSn" - }, - "party": { - "vkey": "3a31af3b199ce0f7d1efda02534708c9cb969d018b5b09e16584c1b40f41ec47" - }, - "tag": "NetworkEvent", - "ttl": 27 - } - ], - "seed": 598034234 -} \ No newline at end of file diff --git a/hydra-node/golden/HeadState SimpleTx.json b/hydra-node/golden/HeadState SimpleTx.json deleted file mode 100644 index cb1d5ba98f5..00000000000 --- a/hydra-node/golden/HeadState SimpleTx.json +++ /dev/null @@ -1,2820 +0,0 @@ -{ - "samples": [ - { - "contents": { - "chainState": { - "slot": 13 - }, - "confirmedSnapshot": { - "signatures": { - "multiSignature": [ - "d6fa04ddba3d69d7177490952ec254f14e2d12ec0f2bc1bbee7f1708b4764defe17c6e3bbc82741b2440dd96a8c3ae756b1d42053d3b613ab28f3bfa63d84304", - "cca3c8456c056833aff62e86d16f07836c40e4379db0be82a6c2b070b433793d04852c6977b545c854cecc54c408edaf0be9c16b07349a1072a92b69a9bbd801", - "efbeb81f9e3fe7492e803c9dd505ee1a8d23bad5d713ab7f1951e37203a666b76bf11b34da9762cf49030780a8fbe41be2cfbcc813d71bc054894f5d8450550e", - "4d32cfa956a0bd643f5dcf7c5afb2439315bcf4769495b0980403b210692409a463218b7c1d56d81bb34ecdb4d6a0278e6e15b668ce00262469586e5faae7b0e", - "80bfac5c64f680b95fd6608fbf9594a9968a00aadb7e46efddb6c5d05def609b836882e504f595235aded7a43d9f0290fad08803241f9e12c4007297f35dba04", - "e33b4a2be4d5462831e93ccc00ae62991ee832315f1f6bbb1ee19ef785df069626f00be8812d8cfa058cb89e7339925e329fcc7939720651d72082ba3b549102", - "1b1e4f749ed3fc1caa93f9f9a457703d7a39e5de4fc4ba89c89956a7fb3b788939edfc053d8b1d24242284d74c59c353e049f17f4969db06a9b3b318efd80d0d", - "48682b7676a09812e6679a2c3fc30e9de9d624de8910be3cf419257c5799c65fd179f3c40b0313d1932ca6b3342a225e5ff501709f019dcb5bcc53c79b3d9903", - "58786b41f3f9a0c932b7a0d4e776f237cea5532cbfa9a0d1c90bda346f0f91aea1053aec8bd0c1e1c027fb6a84c1b786cfd31d7a220ad6b29468639b1ed8ed03", - "27491499751fbc4c6b4b375c04c37648330f5759c4ed43fa8818a9ba9176acbf5cc12b6be9a96b10f6c0d6dbbcfb3224035f38e6c6e3d390af572fda22da880d", - "2895e3f33bfc62b04bc2b7f1bf2e1ed8d61ae1b6806536617e054da98eee9bc6b61c284513f5027955538697b159da0a9d52491a8dde56eff95a1a813532cf00", - "e0ad6e4f24ec01dd2937cd32a27ceb106865f4a63ab518d2f4e09e6c77ec193c5fcb949e115211f4fc485264ecd91ab5cba928111bf81c64360ee7c3af5bc00a", - "a641c99d0152f6b67358764ac31c89eda9f404783476832c03eca0f7259dfc01394600c71d3389c5fdd6ab11d460b498dfc6b663785ee7319ed58a662b981a02", - "f9ef5f407c422f2225739e996074c26eb1e84b355dc3abf033c6958ac16d7fdf3b03705bff801b4652657448b7881b6c82d9ae2d7fa10a0d21d3abdffb617e0d", - "1df60e0bc2f03f5aec76daa4df13c44ee07e1c7bfb0e9478f8863c813d380fd9ee2c06204cd34e9be0c05a6040e11e82db7ba874a9b8a131514957b596977e04", - "505a56d58e46a8ccc83fd7d7a53d50c6ac396687f31312232e7456a4fde8f98e2833e072021e61fd344c2ba154e6ef40b9bc0910bf987ebec36336b7d1e6a20d" - ] - }, - "snapshot": { - "confirmedTransactions": [], - "headId": "870ee0dcf5de1cfd85bf328f5544cf6a", - "snapshotNumber": 20, - "utxo": [ - -30, - -28, - -17, - -15, - 1, - 7 - ] - }, - "tag": "ConfirmedSnapshot" - }, - "contestationDeadline": "1864-04-29T11:46:22.558184720845Z", - "headId": "4567ebfab39d7dfdd459386539b72690", - "headSeed": "1771c7100fb067347cc6f5383100b72c", - "parameters": { - "contestationPeriod": 43200, - "parties": [ - { - "vkey": "0b1cc36bcc417d4e92a282481fd6babcb52e718d7fe436ec0b87a7d40db43e51" - }, - { - "vkey": "e038a3caf02e332b2e7a23db1d54ec36f06b7288822d9e9cc3c2def8c8bfe99b" - }, - { - "vkey": "769c84d3addb006623833bf87fad539f8bfe202dba23fac29e861769f781fd41" - }, - { - "vkey": "5d853688bfa69e4aa0e823922647028c0d21fafb8b7d2bb1bd4dbb2c5d4d29fd" - }, - { - "vkey": "8799534b6fe741324e512857bc6c453f1b6592ab1ccddf4317ee875553bb4bfe" - }, - { - "vkey": "bc5639d6b72bc7fb31e6feafebf8762beb0adbc8d6b5f5d6516251624e05ec80" - }, - { - "vkey": "b95981e283b3e9841d71d6a30fa993c72ab074b49bb05400f744fa3a0b317328" - } - ] - }, - "readyToFanoutSent": false - }, - "tag": "Closed" - }, - { - "contents": { - "chainState": { - "slot": 26 - }, - "coordinatedHeadState": { - "allTxs": { - "-12": { - "id": 14, - "inputs": [ - -29, - -16, - -15, - -3, - 14, - 15, - 16, - 18, - 20 - ], - "outputs": [ - -29, - -23, - -22, - -16, - -5, - 4, - 11, - 15, - 19, - 21, - 22, - 24 - ] - }, - "-13": { - "id": -29, - "inputs": [ - -9, - -5, - -3, - -1, - 0, - 2, - 10, - 11, - 12, - 19, - 20, - 22, - 24, - 25, - 26, - 27, - 30 - ], - "outputs": [ - -24, - -23, - -20, - -18, - -17, - -14, - -3, - -2, - -1, - 1, - 7, - 8, - 11, - 14, - 15, - 17, - 20, - 25 - ] - }, - "-18": { - "id": 12, - "inputs": [ - -29, - -27, - -26, - -23, - -21, - -20, - -19, - -18, - -9, - 3, - 4, - 7, - 8, - 9, - 10, - 13, - 16, - 18, - 20, - 21, - 24, - 25, - 27, - 28 - ], - "outputs": [ - -29, - -28, - -23, - -18, - -17, - -16, - -15, - -13, - -9, - -8, - -6, - -5, - -3, - -1, - 0, - 3, - 5, - 6, - 7, - 9, - 16, - 20, - 21, - 22, - 28 - ] - }, - "-20": { - "id": 7, - "inputs": [ - -27, - -24, - -21, - -19, - -17, - -6, - -3, - -1, - 2, - 3, - 8, - 11, - 13, - 14, - 20, - 24, - 30 - ], - "outputs": [ - -24, - -22, - -19, - -14, - -7, - -4, - 2, - 8, - 15, - 20, - 24, - 28 - ] - }, - "-25": { - "id": 13, - "inputs": [ - -15, - -9, - 5, - 11, - 18, - 20, - 23, - 25, - 27 - ], - "outputs": [] - }, - "-27": { - "id": -5, - "inputs": [ - -24, - -9, - -5, - -4, - -3, - 2, - 6, - 8, - 11, - 13, - 15, - 18, - 24, - 27 - ], - "outputs": [ - -28, - -27, - -23, - -21, - -16, - -15, - -14, - -9, - -7, - -6, - -5, - -1, - 1, - 2, - 5, - 6, - 11, - 12, - 16, - 21, - 25, - 29 - ] - }, - "-29": { - "id": 20, - "inputs": [ - -30, - -28, - -16, - -12, - -9, - -7, - -2, - 6, - 27, - 29 - ], - "outputs": [ - -30, - -29, - -27, - -20, - -19, - -16, - -7, - -6, - -1, - 2, - 4, - 5, - 11, - 17, - 19, - 24, - 25, - 29, - 30 - ] - }, - "-5": { - "id": 12, - "inputs": [ - -30, - -27, - -11, - -6, - -5, - -2, - 1, - 2, - 4, - 7, - 8, - 11, - 14, - 18, - 19, - 20, - 21, - 25, - 27, - 29, - 30 - ], - "outputs": [ - -16, - 27 - ] - }, - "10": { - "id": 26, - "inputs": [ - -30, - -25, - -23, - -11, - -9, - -6, - -4, - -1, - 0, - 3, - 11 - ], - "outputs": [ - -27, - -24, - -21, - -1, - 5, - 7, - 25, - 27 - ] - }, - "12": { - "id": -1, - "inputs": [ - -26, - -19, - -14, - -7, - 0, - 5, - 7, - 15, - 16, - 18, - 26, - 29 - ], - "outputs": [ - -30, - -25, - -21, - -17, - -15, - -13, - -11, - -10, - -8, - 2, - 4, - 5, - 7, - 12, - 13, - 19, - 22, - 29 - ] - }, - "13": { - "id": -26, - "inputs": [ - -26, - -25, - -19, - -16, - -4, - -1, - 4, - 8, - 14, - 28 - ], - "outputs": [ - -29, - -26, - -19, - -17, - -6, - 26 - ] - }, - "14": { - "id": -11, - "inputs": [], - "outputs": [ - -29, - -22, - -18, - -13, - -3, - 0, - 6, - 8, - 12, - 14, - 15, - 16, - 19, - 20 - ] - }, - "23": { - "id": -26, - "inputs": [ - -24, - -19, - -16, - -14, - -12, - -9, - -2, - 2, - 4, - 13 - ], - "outputs": [ - -27, - -26, - -23, - -17, - -14, - -12, - -9, - -7, - -6, - -4, - -2, - 2, - 7, - 18, - 19, - 22, - 24, - 25, - 26, - 29, - 30 - ] - }, - "24": { - "id": -12, - "inputs": [ - -11, - -10 - ], - "outputs": [ - -29, - -25, - -24, - -21, - -8, - -4, - 5, - 9, - 12, - 15, - 18, - 21, - 23, - 24, - 25, - 29 - ] - }, - "27": { - "id": -11, - "inputs": [ - -25, - -21, - -20, - -19, - -15, - -11, - -9, - -7, - -5, - -4, - -2, - 0, - 1, - 4, - 11, - 12, - 16, - 18, - 23, - 25, - 28, - 29, - 30 - ], - "outputs": [ - -30, - -29, - -22, - -8, - -4, - -2, - 18, - 27, - 30 - ] - }, - "28": { - "id": 0, - "inputs": [ - -27, - -26, - -22, - -14, - -5, - -4, - 1, - 2, - 5, - 8, - 9, - 17 - ], - "outputs": [] - }, - "29": { - "id": 21, - "inputs": [ - -14, - -13, - -2, - -1, - 4, - 5, - 9, - 17, - 19, - 23 - ], - "outputs": [ - -28, - -26, - -25, - -21, - -13, - -12, - -11, - -7, - -3, - 1, - 3, - 11, - 13, - 17, - 18, - 20, - 21, - 22, - 25, - 27 - ] - }, - "3": { - "id": 29, - "inputs": [], - "outputs": [ - -25, - -18, - -16, - -13, - -11, - -8, - 5, - 13, - 15, - 28 - ] - }, - "5": { - "id": -7, - "inputs": [ - -28, - 2, - 7, - 12, - 25, - 28 - ], - "outputs": [ - 0 - ] - }, - "6": { - "id": -16, - "inputs": [ - -7, - 12, - 16, - 21, - 22 - ], - "outputs": [ - -30, - -21, - -20, - -18, - -16, - -11, - -9, - -3, - 3, - 9, - 11, - 13, - 18, - 27, - 28, - 30 - ] - }, - "7": { - "id": 29, - "inputs": [], - "outputs": [ - -24, - -21, - -19, - -16, - -11, - -10, - -9, - -1, - 0, - 4, - 11, - 16, - 26 - ] - } - }, - "confirmedSnapshot": { - "signatures": { - "multiSignature": [ - "a8b9c5ea8ed5e9f5999fb677cb8bb53722773af6801bc810c5a9b7ec5fc8e3b4b485f32ce80488ad4046d9f9f5035d6546fe16826642759c156884396fdbf703", - "e1bde2d000bac072a6a10a36f6889c37e9ab561c2f1c7975bd245154a1ea37b65f4a1338809ef6a09d84a2745802e743defcf36078248b6a2bc9d97610d13109", - "d3e53dae0172c6faf679f7c05bd795c1d8a8bd08e3f5b4e8e138779173fa853a5d5486b9e037d6d223abc056e211257a8a8f27300a429074f4eec50281067a06", - "2f47f75049623bf6f4976cae282ffd32bc8ed7d34f86a57a96c30c779cea80498a8c1061f7e154ae2b02de02c41a6bc2b942cab9a22de9f5a8fefcb92b6f7a02", - "fc6fb25b29156e4638c7c110e5b3c2af57e9347ebf9aa240c44e7b6fe008f8c6e74a042ea05ca46ccfca82043d95677d3f0fb03b5f92b07a573c6dcef3c58d01", - "3fa34e8f0e5ba59f8b990f29754eac9c2ee5d03540dfdfea56250c8616d639e1fe5dc2d8cf9e3ace0f8316445ae59b19f73f24efbe484ae4159de0e92b418b00", - "f9367ede9c33195f4a79f2407dc0c752aae1b70885862067805cbccd029ec503910a5bcc74db03a7904ec62a699133369523566ce07af1ce6daef77fffcbaf05" - ] - }, - "snapshot": { - "confirmedTransactions": [], - "headId": "ea74ed45f1ee24350127fcf78841b278", - "snapshotNumber": 14, - "utxo": [ - -25, - -24, - -22, - -12, - -8, - -6, - -4, - 0, - 7, - 12, - 15, - 20, - 22, - 24, - 29, - 30 - ] - }, - "tag": "ConfirmedSnapshot" - }, - "localTxs": [ - { - "id": -29, - "inputs": [ - -24, - -22, - -18, - -15, - -14, - -8, - -6, - -5, - -2, - 4, - 7, - 10, - 11, - 15, - 19, - 20, - 23, - 27, - 29 - ], - "outputs": [ - -30, - -28, - -22, - -6, - -4, - -3, - 4, - 13, - 17, - 19, - 28, - 29 - ] - }, - { - "id": 30, - "inputs": [ - -20, - -3, - 1, - 5, - 11, - 13, - 16, - 22 - ], - "outputs": [ - -28, - -21, - -19, - -10, - -8, - -7, - 1, - 2, - 8, - 13, - 19 - ] - }, - { - "id": 25, - "inputs": [ - -26, - -22, - -20, - -12, - -8, - -7, - 0, - 3, - 10, - 18, - 23 - ], - "outputs": [ - -29, - -27, - -26, - -19, - -17, - -15, - -13, - -9, - -7, - -5, - 2, - 5, - 7, - 8, - 13, - 15, - 20, - 23, - 27 - ] - }, - { - "id": -18, - "inputs": [ - -30, - -29, - -26, - -25, - -24, - -23, - -21, - -20, - -19, - -10, - -9, - -7, - -5, - 6, - 8, - 12, - 18, - 19, - 20, - 22, - 25 - ], - "outputs": [ - -5, - 3, - 15, - 18, - 21, - 26 - ] - }, - { - "id": 13, - "inputs": [ - -25, - -23, - -17, - -16, - -13, - -11, - -9, - -8, - -3, - -2, - 3, - 6, - 10, - 16, - 19, - 25, - 30 - ], - "outputs": [ - -28, - -23, - -22, - -19, - -16, - -11, - -9, - -7, - -2, - 2, - 3, - 7, - 9, - 16, - 17, - 18, - 20, - 27 - ] - }, - { - "id": -3, - "inputs": [ - -29, - -22, - -18, - -17, - -12, - -11, - -7, - 5, - 9, - 11, - 13, - 14, - 16, - 20, - 22, - 29, - 30 - ], - "outputs": [ - -27, - -13, - -11, - -9, - -6, - 0, - 5, - 11, - 15, - 26 - ] - }, - { - "id": -27, - "inputs": [ - -23, - -21, - -11, - -9, - -8, - -5, - -4, - -1, - 3, - 9, - 11, - 13, - 16, - 24, - 26, - 27, - 30 - ], - "outputs": [ - -30, - -28, - -25, - -23, - -19, - -18, - -17, - -16, - -15, - -14, - -10, - -9, - -8, - -7, - -2, - -1, - 4, - 6, - 7, - 14, - 16, - 24, - 25, - 27, - 28, - 29 - ] - }, - { - "id": 11, - "inputs": [ - -24, - -21, - -16, - -13, - -11, - -10, - -9, - -5, - -4, - -2, - 0, - 6, - 8, - 12, - 14, - 24 - ], - "outputs": [ - -29, - -28, - -14, - -13, - -11, - -9, - -5, - -4, - 5, - 8, - 11, - 12, - 16, - 19, - 21, - 23 - ] - }, - { - "id": -12, - "inputs": [ - -29, - -27, - -25, - -23, - -18, - -15, - -13, - -12, - -9, - -7, - -2, - 2, - 10, - 13, - 14, - 16, - 20, - 25, - 26, - 27, - 29 - ], - "outputs": [ - -24, - -20, - 3, - 16 - ] - }, - { - "id": 29, - "inputs": [ - -1, - 0, - 13 - ], - "outputs": [ - -27, - -24, - -21, - -9, - 9, - 11, - 15, - 19, - 30 - ] - }, - { - "id": 24, - "inputs": [ - -28, - -26, - -23, - -19, - -7, - -5, - -4, - -1, - 0, - 2, - 4, - 9, - 11, - 16, - 18, - 23, - 25, - 28, - 30 - ], - "outputs": [ - -24, - -9, - 5, - 7, - 16, - 21, - 25 - ] - }, - { - "id": 9, - "inputs": [ - -27, - -24, - -21, - -16, - -14, - -11, - -10, - -9, - -8, - -6, - -4, - 1, - 9, - 10 - ], - "outputs": [ - -26, - -25, - -17, - -15, - -6, - -3, - 0, - 4, - 6, - 7, - 13, - 22, - 26 - ] - }, - { - "id": 13, - "inputs": [ - 25 - ], - "outputs": [ - -5, - 0, - 4, - 11, - 15, - 22, - 26, - 29 - ] - }, - { - "id": 23, - "inputs": [ - -18, - -16, - -14, - -12, - -10, - -9, - -7, - -5, - -1, - 0, - 18, - 19, - 24, - 29 - ], - "outputs": [ - -29, - -25, - -19, - -16, - -15, - -13, - -11, - 3, - 4, - 5, - 12, - 13, - 14, - 15, - 29 - ] - }, - { - "id": -11, - "inputs": [ - -23, - -20, - -16, - -12, - -10, - -9, - 14, - 16, - 18, - 19, - 22, - 26 - ], - "outputs": [ - -29, - -27, - -24, - -23, - -22, - -13, - -12, - -9, - -7, - -5, - 4, - 8, - 13, - 14, - 15, - 17, - 18, - 19, - 26, - 29 - ] - }, - { - "id": 8, - "inputs": [ - -23, - -19, - -16, - -2, - 12, - 15 - ], - "outputs": [ - -29, - -27, - -23, - -19, - -13, - -12, - -11, - 7, - 8, - 9, - 27, - 28 - ] - }, - { - "id": 17, - "inputs": [ - -28, - -24, - -10, - -6, - 6, - 13, - 16 - ], - "outputs": [ - -25, - -24, - -22, - -20, - -19, - -17, - -16, - -14, - -8, - 1, - 4, - 11, - 14, - 18, - 19, - 20, - 21, - 25, - 29 - ] - }, - { - "id": -13, - "inputs": [ - -26, - 8, - 16, - 21, - 22 - ], - "outputs": [ - -30, - -22, - -19, - -17, - -16, - -15, - -9, - -4, - -2, - 2, - 3, - 4, - 6, - 7, - 9, - 11, - 12, - 18, - 19, - 21, - 25 - ] - } - ], - "localUTxO": [ - 27, - 28 - ], - "seenSnapshot": { - "lastSeen": 27, - "tag": "LastSeenSnapshot" - } - }, - "currentSlot": 13, - "headId": "dcca3462712174cf7f262beec317c0bd", - "headSeed": "b827374f8e226a9f4565308a17e392b9", - "parameters": { - "contestationPeriod": 2592000, - "parties": [ - { - "vkey": "d5b4a39b122dfc02d559037b3c528195d715794b69d09a7dcedb0b2216097d80" - }, - { - "vkey": "75c3ea0ecb7f2f2c1a3e976ac7fbafd188c66fea05af8576deabe3f999797c5f" - }, - { - "vkey": "57eb465b9dfa644da9821deed2d9ac8880be90d1b95afb34d3228a1fa59c8450" - }, - { - "vkey": "b76f6656b936d25b4b7c849c96f61e2dff0997c4c479ce52fab2f023089ea6a5" - }, - { - "vkey": "fc3da5909b00ffb60dced9048a27524813db9f87e6e9d85f2cf14487ec259611" - }, - { - "vkey": "4785777dcd693f571defbedd74090e00dfac756998ad337eadeef15b148205ed" - }, - { - "vkey": "f671a1faff824c23a3a96e499ba462a63d6192c008936837a542eb5018ece96e" - }, - { - "vkey": "e781b67171ece4ef48063616c618bcac7f00eb69824e90765dc31898fab3b491" - }, - { - "vkey": "536738dfa640b5b2250901299ae04da4ae1eac87245086e773df52337618254a" - }, - { - "vkey": "93e74b7e43ebf3393c631cc38436c9326e60cdd5806be3d7850652913e8ceee6" - }, - { - "vkey": "ed4193d0185d394f3e78d40b6a8880256ec5900e919a01d1d52646df663ddcfb" - }, - { - "vkey": "595939c35006f1f8699c68c494898cc3bc442b4f0e2188d63e8d301e368127be" - }, - { - "vkey": "b7522a08527776973b7e816bb01f4c0910f0bd2ca3b01a9d2321156eebcf5345" - }, - { - "vkey": "222b71e8c070f1883442c717f0821e8a0e303500a7adc955c81894d0a665e96c" - }, - { - "vkey": "e907e5186f5817d74f26b186368f7243d4f70cdad1cd16a39fdb992b04091cd0" - }, - { - "vkey": "4f1507e48f325035341789640147add3960cafea22a0dac118fc3afcf02fdf60" - } - ] - } - }, - "tag": "Open" - }, - { - "contents": { - "chainState": { - "slot": 2 - }, - "confirmedSnapshot": { - "signatures": { - "multiSignature": [ - "74440c32b3b7a298d7d08add7a954ad606e882a031cd510dc96ba9ebbfd03aca79024114b9b146b1da8a5c6597c585cf50347f072a0b920fda7182198d780908", - "d336d6b50d37141c7c947e426c32d178fbbd0aac3b8968cc814d94288c0511b74c6d82561a351a5dace624570bce044ce8872535cf4528c125bebde4386d7704", - "099b0cab75fd253707c200a9822e2c72c43f4df5ab27debdaba4a81f74386ade1ad8a0b2f08c8fbfbdbbbdaaea72475e845af7d98893c6c2d959dc646df50707", - "9c6c9a41e75921c3ce3e2468b751a08913f8eb7d307a5fbb9760a1353b43b00bcf853e982762e844a5d5fbb3e47c22e4c329237a68b9e54b5c7d9b46207f4b07", - "b9c30517d0418d1ad3b787f26fcfa5278cd9fd94224ccb66315af3a7f11ae99e4d318bc6b14b08ffaa4d1112f8215eecc2fdd8da46749168af58d9b181c03401", - "7c1a0dc27662914cb1371fb2dd1b4a69cfc32bbe13b8cd6d2993f03ef49dc133d8fae130f4e16c0e26159aa7247ad5c3bbe62b85524e95f2ad35b3570be43406", - "a107d21e136ef57cf76976d5858c6998c4ad6528112f615c5950653d34f33dff5421a0325136c72c7dda4d3488fdf140df25730eb1d4de1979f3e660ae484c0a", - "c11559dc3ebe26a77a83da999a4fb2d659816d7f5ecdd8fbcd1bcf9c0b658da5bce5c233d5290c28f9fa6f35484892e10867e234c505cde0d1e0f3309c15610f", - "2f09284033a53b3cae3fa140afa2dc8c6f7daa4b7257aaadff701f4ea711dc6a1f6521950d17dacd8a5edb6039c737cfd2aacbe3e4307c0bd442cbdd08c5c406", - "ee131e9441a4cd0b24b44b71a9aafbcc0a330a546a45d2ee4f4bc387dfff6bc25da3e8d24ba2de24a51b902a78fbc6c19c732022550742fda98c207169fe0f08", - "ede423999f0602baa05037a6dc6c18b8240d44602c4541d9a261b4612ec59c8bbb406c6b820960f960715aa4efdd5b19246722f25d30fb7d20fa5b1478d88e0c", - "b21d5bdb45c764371160bb5152ac4f5043746dfb5a866f68664c9ecc13f607234ebe494de13ec320d90977867e65f15d4636f6db6f246c3bf09db8f2f5148d00" - ] - }, - "snapshot": { - "confirmedTransactions": [], - "headId": "a578dc3d490406711750c8379c5d5c65", - "snapshotNumber": 18, - "utxo": [ - -30, - -19, - -16, - -11, - -7, - -3, - -2, - -1, - 0, - 1, - 7, - 12, - 15, - 28, - 30 - ] - }, - "tag": "ConfirmedSnapshot" - }, - "contestationDeadline": "1864-05-26T12:26:42.752460599353Z", - "headId": "eeaad3f51b4ab077526de4ececd0694d", - "headSeed": "d62b62ebdb57070fe94c5a2e4e5feb9b", - "parameters": { - "contestationPeriod": 86400, - "parties": [ - { - "vkey": "e54287019dbb5defbd6d72902955efa942857961c86cceb2b186a6ab64c2e5e2" - }, - { - "vkey": "b39ace71be0183c0336d9dfa0a440cd87ef6d6119d8d4a4bcbf9c9bb298bde62" - } - ] - }, - "readyToFanoutSent": true - }, - "tag": "Closed" - }, - { - "contents": { - "chainState": { - "slot": 24 - }, - "coordinatedHeadState": { - "allTxs": { - "17": { - "id": -12, - "inputs": [ - -24, - -20, - -9, - -7, - -2, - 2, - 3, - 4, - 7, - 9, - 10, - 13, - 14, - 16, - 17, - 18, - 19, - 20, - 21, - 27, - 29 - ], - "outputs": [ - -1, - 1, - 2, - 30 - ] - }, - "21": { - "id": 4, - "inputs": [ - -28, - 26 - ], - "outputs": [ - -28, - -22, - -19, - -16, - -12, - -6, - -5, - 2, - 9, - 10, - 14, - 19, - 21, - 22, - 23 - ] - }, - "26": { - "id": 18, - "inputs": [ - -22, - -17, - -15, - -8, - -6, - -2, - 0, - 11, - 19, - 23, - 30 - ], - "outputs": [ - -19, - -17, - -12, - 11 - ] - } - }, - "confirmedSnapshot": { - "signatures": { - "multiSignature": [ - "05a1cc062e674464c7bcf216e6e4586e404bb85b26fca9616ad19cb8c6f6740f35faaa9c6653b75a58171e851f378ec00eed7de822ff26cb8358c2f8d1126f07", - "7823aed105709b31f967514e50a3c73693e64f867d6685f8b312a7349b12e5d0e3c1ea99a46b274e56928027e300a526d8ad8cc932d013ce4b17121850a62f0e", - "c289149d903060eb3e7ddb67ac564c0065d8686d1e816fb49868501b959524258534f3be3f3851efa18e74bed808d10293ae57fca3b4cbda56d57c8a659f5a0f", - "c571973be2f05bf08aeef5c66edca789959bc81a1074e0ee2333bd7cd358f2b47e07b276df34d47671af18dc599c7de895d28999dae6cd4104e5930ec1f32500", - "9a390ab1c3faa3d997e741c92374b1a35aa94849051a2656dbb7acb640d7885c233c13f8fb1e40e1cbcf11009bc3868fe378c8b6ba8e74442a58b43093f0ff01", - "6f63c29e778179c7db5aa2d3b84fbf37b7d4b2689fc023e0fda40e669f5162329e6860b00b7607c39fea6546b2094be41b690a7f9927626ccf2cd456ace2ee03", - "768b67b87a00cbf507add1d56b35332c0f574e8670693327bc67a121a78b1b865c125f444d587f733c6351b084a633659331647e19c138f63a0313c879bfe00e", - "9e527ef41f9292e9e146a4d57b92a58828dd55f50cf1e8ba0d18973db7a641a79ee8b794829fd8a46c61999191f0dbf9ee3094201b5ae059d3cf1d60dc570d05", - "ab786c61a4d5ef572bf2c75edac1dd002feef45260f009f177435a9203d10356b0be4511f8db575e7ae544840cfc3b88dc28f374bbb649aea64afb5b46e9f804", - "c144fea61a4855bf01f592ba003e037dea28d5af8038d5915177976fc4fd94f02e0180e950fc575a4c64a0f6716b4456e55b29ab2936d55763485d662d3b560e", - "0df87751e0928b94d0014807e7e98c5b35e9b643120e0be8a917305f6990906828ef5fb82f32f1942fb8b123bbff8fe81cd5727621b6dd4df9eb042609a3f207", - "d164505a4d10dea443e86720aa442730ea6628070385d84e2491b8d2305ac19d9707331aeccac0deaeb378bf150c45ee651525d6a96ee5f04dc5898f2547f902", - "a86ed8089cfc337458f3767fab5bef2eaa7097dda9c8da78d41f7c132e96521b0e8ac0ecbffe1cee9d7e970a6830e287c810c32f96de17fd85900d6ab3803f08", - "8b116e1b2a72541a9f6e148832f824b2586ad3e508d0e0ab5724430c8eb37bd308bf0e4ab0cce7a2d71c16000bfacb56370d5c5bbb22bf2054910544abe1370f", - "b15f75ad04ab666a89cbbc39c432d481c23c688034a79af50543dee2344ee7e936b1a8fbea52dff84556c6e32ace246586a2700f50d5a795cd1ecbe71ee97805", - "091569121fc398642e36283b94344af0ce079977fc25d0019f4df4b1f0fc0e35a9d7a17987c43eb1b35caf25f43ee93f12e0ffb59d5be057b8bea9a358ee0204", - "24cc10b7ff5223ac984824d575491793a328d76f36b92bfbee8659cf6d3bc12b7e7e17a92d378c219e24280183796497958c94858e149974202c775386cbf905", - "c53347dfff0d4cbfd38c8f0397cd6783020984e1d688beb1ec16da0d00d0e804ef7eae892af8505a3e0bd770e1d1cf76b5821befd4d8dcd5cdd00369e6c9450a", - "04b6d72c35b7a4076471faade8ad671d8301ee4135afab0f8778fb97ec198996fe27af98a12f51a4a4c798c2d510fbf93074314c0d6190d7165a257cd86d1300", - "f4a3464fd3cbeee3f1ac0f6a0e808365c0601f8556135e3d9c93ead1f90faf6c1d6f6abe054e45a804784381b938ae16245a63d1d4aaa44482de56000208d708", - "5ca6189cacb7e3aa057b132484d489c022def11b12266fb9d0cd394453242fb93883674aa5a469e5fc717ce2285eef8e4f2b27633956d09cd16cbd6882d33b02", - "d378e74798d7554f60e3da6349897656ede96a3ee3a2d9d92350bb5cbf766678ae7706adfe1af2969f35ea28144743a396088dc21ca4470a1cae0a4311190102", - "731b2c3d58d5fe015162f6497e6e51aaed0a7fda0c0ad0e831ae03643bb83efdd237ed80fe57a8a39f3a2ff8e4322493884a77a93f388517bf1e5d76bef55308", - "4e4474bcb22f1676cc6a0409f8e7181b6ea9d1f775c309fd1b257b785785babd216a86daeef7a078fa3fc2703a6a463ad6318267f92ab1ec693a0b0e95679d01", - "9939fd49c7979c285b3ce369e8bf0e076ab26119fa7f0ff26f6be7e6f6be21f9ffa0d0a324a3662124781e1b3de2c11fbf92058198a0119a3a783ec9a10a810b", - "7c05b6a4e695bca36b444f0ace80d5a8f77e9267f8f322ca1b6741464e6ed167a2aa14ea802648713e295bbb4ed376dd56355e60a26b0f3bf4b5682a2cf6d60b", - "2c52ed93f86cf380cced9f33edf91938bf9e923508f8617ef866ef1240ad4bc9427c58ce31fa7ceee49e095a8d93a107aa0546d4b14747153f698cf17575af0f", - "40cc98c500a1d0270f159589fad0e0cc3712cb2c1dc69a1e57484d45e5e62bb2d503ed4fb770d1b01755bd99efa2229331aff73e5e0d8e9686196b65df5a1206", - "566479fc4a086eaf33e624e577c3e73f3676fa6586ba35d45e6a4d0071b4954084a793290534782a569b0cd29fd27992a4c548a7349f2e8f95805a45b72fee09", - "01e579ed8e10791bcdb8a89c3b8ffe2ce2b2398b7be3cb13a234e5433d492a001f15b30a675e0b0c9d91e8d39a8fe50c034129c60e6629fe6b3fdb5dbca9aa0d" - ] - }, - "snapshot": { - "confirmedTransactions": [], - "headId": "c4bbb3d5e0a1bc8a6dba504037492ed7", - "snapshotNumber": 4, - "utxo": [ - -29, - -27, - -25, - -20, - -17, - -11, - -10, - -7, - -1, - 3, - 6, - 9, - 10, - 18, - 24 - ] - }, - "tag": "ConfirmedSnapshot" - }, - "localTxs": [ - { - "id": 25, - "inputs": [ - -30, - -27, - -24, - -20, - -16, - -15, - -11, - -10, - -2, - 9, - 11, - 14, - 16, - 17, - 18, - 29, - 30 - ], - "outputs": [ - -26, - -24, - -23, - -18, - -17, - -14, - 0, - 13, - 14, - 19, - 26 - ] - }, - { - "id": -8, - "inputs": [ - -25, - -21, - -8, - -3, - -2, - 8, - 10, - 27, - 28 - ], - "outputs": [ - -20, - -15, - -11, - -8, - -3, - -1, - 1, - 3, - 8, - 9, - 21 - ] - }, - { - "id": 30, - "inputs": [ - -28, - -24, - -13, - -6, - 4, - 12, - 14, - 17, - 23, - 25 - ], - "outputs": [ - -27, - -23, - -20, - -19, - -10, - -9, - -8, - -7, - -6, - 0, - 2, - 4, - 8, - 13, - 15, - 18, - 20, - 22, - 27, - 28 - ] - }, - { - "id": 5, - "inputs": [ - -30, - -24, - -22, - -15, - -13, - -12, - -8, - -7, - -5, - -1, - 3, - 6, - 12, - 25, - 27, - 29, - 30 - ], - "outputs": [ - -26, - -23, - -21, - -19, - -15, - -14, - -12, - -10, - -9, - -3, - 3, - 4, - 7, - 9, - 10, - 11, - 13, - 19, - 20, - 25, - 26, - 28 - ] - }, - { - "id": -28, - "inputs": [ - -30, - -11, - 1, - 2, - 4, - 14, - 20, - 22, - 24 - ], - "outputs": [ - -25, - -1, - 12 - ] - }, - { - "id": 7, - "inputs": [ - -25, - -21, - -19, - -16, - -14, - -11, - -9, - -5, - -2, - 2, - 3, - 6, - 10, - 11, - 16, - 17, - 19, - 23 - ], - "outputs": [ - -28, - -27, - -24, - -19, - -14, - -13, - -12, - -10, - -7, - -5, - 4, - 16, - 18, - 23, - 24, - 30 - ] - }, - { - "id": -30, - "inputs": [ - -20, - -15, - -10, - 0, - 9, - 11, - 12, - 13, - 20, - 26, - 30 - ], - "outputs": [ - -28, - -27, - -19, - -18, - -16, - -7, - -5, - -3, - 1, - 10, - 12, - 16, - 19, - 20, - 25 - ] - }, - { - "id": -7, - "inputs": [ - -30, - -29, - -27, - -18, - -14, - -13, - -12, - -11, - -10, - -5, - -2, - -1, - 2, - 4, - 9, - 12, - 14, - 15, - 16, - 19, - 21, - 23, - 30 - ], - "outputs": [ - -27, - -18, - -16, - -12, - -11, - 10, - 22, - 28 - ] - }, - { - "id": -3, - "inputs": [ - -30, - -28, - -20, - -15, - -13, - -11, - -7, - 5, - 6, - 14, - 19, - 24, - 26, - 27, - 28 - ], - "outputs": [ - -21, - -20, - -9, - -7, - 1, - 5, - 6, - 12, - 19, - 24, - 28, - 29 - ] - }, - { - "id": -11, - "inputs": [ - -30, - -25, - -24, - -19, - -18, - -17, - -16, - -13, - -12, - -4, - -3, - 2, - 3, - 12, - 14, - 15, - 16, - 22, - 24, - 30 - ], - "outputs": [ - 7 - ] - }, - { - "id": 1, - "inputs": [ - -30, - -29, - -24, - -20, - -17, - -14, - -8, - -6, - -5, - -3, - -2, - -1, - 2, - 4, - 5, - 9, - 11, - 13, - 19, - 22, - 28, - 30 - ], - "outputs": [ - -30, - -27, - -22, - -20, - -15, - -14, - -13, - -11, - -10, - -9, - 1, - 30 - ] - }, - { - "id": -18, - "inputs": [ - -28, - -26, - -8, - -7, - -2, - 12, - 14, - 22 - ], - "outputs": [ - -25, - -24, - -15, - -10, - 10, - 13, - 23, - 29 - ] - }, - { - "id": -13, - "inputs": [ - -30, - -29, - -28, - -26, - -24, - -22, - -20, - -17, - -16, - -15, - -12, - -10, - -7, - -1, - 0, - 3, - 5, - 11, - 21, - 23 - ], - "outputs": [ - -25, - -22, - -20, - -18, - -17, - -16, - -14, - -13, - -12, - -11, - -10, - -7, - -6, - -3, - 3, - 4, - 18, - 19, - 20, - 21, - 23, - 26, - 29 - ] - }, - { - "id": 13, - "inputs": [ - -29, - -17, - -16, - -8, - -5, - -3, - 0, - 10, - 12, - 16, - 21, - 30 - ], - "outputs": [ - 7, - 13 - ] - }, - { - "id": -24, - "inputs": [ - -23, - -21, - -19, - -18, - -16, - -11, - -8, - -5, - -4, - -3, - 0, - 5, - 11, - 15, - 16, - 17, - 22, - 30 - ], - "outputs": [ - -30, - -27, - -24, - -22, - -21, - -15, - -13, - -12, - -10, - -1, - 1, - 3, - 8, - 10, - 13, - 14, - 19, - 22, - 23, - 24, - 25, - 30 - ] - }, - { - "id": 24, - "inputs": [ - -28, - -22, - -21, - -18, - -14, - -11, - -9, - -7, - -6, - -3, - -1, - 0, - 5, - 7, - 11, - 13, - 15, - 18, - 21, - 24, - 26, - 27, - 29 - ], - "outputs": [ - -26, - -16, - -13, - -10, - -4, - 5, - 6, - 9, - 11, - 12, - 13, - 14, - 22, - 23, - 24, - 25, - 28, - 29 - ] - }, - { - "id": -20, - "inputs": [ - -26, - -21, - -15, - -9, - -7, - -6, - -5, - -3, - -2, - 1, - 2, - 11, - 12, - 14, - 18, - 19, - 22, - 23, - 30 - ], - "outputs": [ - -15, - -4, - 18, - 25, - 27, - 30 - ] - }, - { - "id": 15, - "inputs": [ - -29, - -25, - -17, - -16, - -11, - -8, - -4, - -2, - 3, - 6, - 8, - 9, - 16, - 18, - 21, - 24, - 25, - 26 - ], - "outputs": [ - -25, - -24, - -21, - -7, - -4, - -2, - 1, - 2, - 4, - 11, - 14, - 18 - ] - }, - { - "id": 6, - "inputs": [ - -13, - 15, - 29 - ], - "outputs": [ - -29, - -27, - -22, - -19, - -13, - -12, - -10, - -9, - -8, - 3, - 9, - 10, - 13, - 14, - 15, - 17 - ] - }, - { - "id": -12, - "inputs": [ - 12 - ], - "outputs": [ - -16, - -13, - -9, - -6, - 5, - 7, - 8, - 9, - 11, - 13, - 14, - 17, - 19, - 22, - 23, - 27, - 30 - ] - }, - { - "id": 26, - "inputs": [ - -27, - -25, - -24, - -22, - -20, - -16, - -15, - -14, - -12, - -8, - -6, - -4, - -3, - -2, - -1, - 6, - 7, - 8, - 11, - 16, - 20, - 22 - ], - "outputs": [ - -30, - -23, - -22, - -19, - -16, - -15, - -10, - -3, - 6, - 8, - 11, - 14, - 17, - 18, - 24, - 27, - 28 - ] - }, - { - "id": -2, - "inputs": [ - -30, - -24, - -23, - -21, - -20, - -17, - -13, - -12, - -11, - -10, - -6, - -5, - -4, - -1, - 0, - 1, - 3, - 7, - 8, - 9, - 10, - 16, - 18, - 24 - ], - "outputs": [ - -24, - -19, - -14, - 1 - ] - } - ], - "localUTxO": [ - -12, - -2, - 0, - 9, - 11, - 15 - ], - "seenSnapshot": { - "lastSeen": 21, - "requested": 16, - "tag": "RequestedSnapshot" - } - }, - "currentSlot": 27, - "headId": "b947cef38009c1137dd3aed495183a3c", - "headSeed": "7b9c2b1da47c63b22495b8979b2dd87d", - "parameters": { - "contestationPeriod": 64492, - "parties": [ - { - "vkey": "e0c8006e8e5018551c6309ba2c91971bd95cf1b1c797105ab766a34d5624a728" - }, - { - "vkey": "f7266a3448969cc4245af38bf7564e19c0864a9aeb6adaf4a3faa4ec4b9f1d6a" - }, - { - "vkey": "cc0999296e94a91cf45ff77d6753943a1a307e64741b589bca530720261a84eb" - }, - { - "vkey": "b60012f412b873cfb971d9bb3abe2a3769de1e61d9c05e296eb78e3f453cf131" - }, - { - "vkey": "1e9e331ce0ce5c049e626d2cf87af5bff80b3d91ed25f48ce93ba85faed7e92e" - }, - { - "vkey": "1462d7e23ba177d98104560faf6b71ed9017a548e87ed185a42c94ce7964bf62" - }, - { - "vkey": "82640d6c4ed96afd41445831da3fa498cf03264538154de67406ac70b50c7432" - }, - { - "vkey": "061d34412922ca544d82b4127e15f36f97ad9231bbdad0681b665fc7a24cdbf6" - }, - { - "vkey": "70641f65d615b954f4d9ae8fc949066a4b497e91a8fd9b13078012d4ad8d688b" - }, - { - "vkey": "3d30fbccf1fabe8a1c934dd790bd4bbb4bc4cee7142afbb15cf71b6a9a4a957a" - }, - { - "vkey": "f54eda059df511a08db713b5a2ae197e4fb1733fa0226dc0685895c0eef398a4" - }, - { - "vkey": "5186ca7b4d3f26432c7156ca139a9146df8e487f719721d4def112a637da3e14" - }, - { - "vkey": "6aca5201d868ff5fa9bd1963527d537ba63be7fd4256edbd9ec8f01bd937c401" - }, - { - "vkey": "764d4937ed2fc970ebcbb5727d10052d1b9b4ab7d77d0619eea4ed830a5d64c5" - }, - { - "vkey": "75dd7e66410173ece2556ab839e06676d119202a48d36271b1ab739965426b3e" - }, - { - "vkey": "8dea1159170ce7fb1b4c73d2394ac324ff3ca56b57412790d7eccbb46ed7a071" - }, - { - "vkey": "a8a223f81953259dd64febc2aea562939cc3f0b213de65073038803623894004" - }, - { - "vkey": "9a84a704b87504a1c0f347f816a06b9e7e9066557dfec0c23f4186f4115a9654" - }, - { - "vkey": "9967e3ad3aae98bb166a4809eb5d5491feb3d2aae554e9d29c4df0242ec53866" - }, - { - "vkey": "50b5034f8a44487079205756549dce76450d1b756feda78498a6b4d5acd2e0f0" - }, - { - "vkey": "50b0cb05690e2f891d7bd988b982ec04b546c16efc06112fd342f17a8af881b0" - }, - { - "vkey": "527a916b3b70db14670ccd96304dfa022213a02519e872c21eb96701199b9379" - }, - { - "vkey": "7bd5149022e6041df86d7ff4473987efc773bb8ada1cdac3d6327f79e990fe1f" - }, - { - "vkey": "8083f9587bfa40f558743dee72cb03bb10b7abb9c3d57250a1cd7d9cd07c5780" - }, - { - "vkey": "15e2cd18629edb137c62f24f59367ef6bdf4f71dd36862a5b4bd7467f3e3f0aa" - } - ] - } - }, - "tag": "Open" - }, - { - "contents": { - "chainState": { - "slot": 18 - }, - "coordinatedHeadState": { - "allTxs": { - "-18": { - "id": -25, - "inputs": [ - -25, - -14, - -10, - -3, - 3, - 7, - 22 - ], - "outputs": [ - -24, - -22 - ] - }, - "-28": { - "id": 10, - "inputs": [ - -7, - 20, - 22 - ], - "outputs": [ - -22, - -13, - -10, - -5, - -2, - 0, - 8, - 11, - 12, - 28, - 30 - ] - }, - "11": { - "id": 18, - "inputs": [ - -29, - -15, - -14, - 1, - 5, - 14, - 17, - 19, - 20 - ], - "outputs": [ - -22, - -19, - -17, - -12, - -10, - -7, - -6, - 1, - 10, - 21, - 22, - 29 - ] - }, - "5": { - "id": 27, - "inputs": [ - -27, - -18, - -16, - -8, - -7, - -4, - -3, - 1, - 3, - 4, - 6, - 7, - 9, - 12, - 13, - 14, - 15, - 16, - 17, - 19, - 20, - 21, - 23, - 25, - 27, - 29 - ], - "outputs": [ - -29, - -27, - -24, - -22, - -21, - -15, - 11, - 14, - 15, - 17, - 25, - 27 - ] - } - }, - "confirmedSnapshot": { - "signatures": { - "multiSignature": [ - "98b6a92a3f37012d632816777fe8d3a007c8f05a108cb2ca7be8231e796f415b8a120303602e7c5dbaf3c109b9db83fa4efcb90c80135aa1415eed9106d5bb04", - "c9e4acc0f850b66edfc6f6f21d5035bc68f92d9762325755860cc1d807053dd5ea8e55dd8e14272a2bbf458d5f08670380edfed793fdf108f36041aaacd5a90b", - "1327eb49654c2583de728cf4705098bbd34b7721e1c42f8b5e4b65ffde3abf3764671ee61f887d2e9d1714741b24ee2dfa5eecc1f145c573815193cc904a7903", - "2210d8fb53cadfd9541995cf44d672b8b62f09bea10f78c6234f8d453112cb2d39a2d820950f9ff27240b8019c67b19446feb416e4013331d719b509e4cdb706", - "6bb6302e4160a34f22c49dd52753525de0d79644bddbb4471281da67f17b9aa89ff8cd901e43a3e485f50b138888a30294b59aaeec9beb99b6320db2e9115006", - "dca085d9a7b7313b04c60fbb435010c37ba78425b13c4a5cd93f9d7ce3510ae44291da7bb6da8d22fa551aeff49a20e13943d3413cf7126b38aa70a5a0f4a40a", - "79f08f4c300f33fabe36e1b665c3cf4d76ea4a506796fc30b4d3efee472f537a154b9c4ba74a23f88c9663ad89e984bb6d83f477a08c146392649608e984e70a" - ] - }, - "snapshot": { - "confirmedTransactions": [], - "headId": "7b5ee579bedcff71d05220030d5dfb96", - "snapshotNumber": 21, - "utxo": [ - -24, - -14, - 19, - 26 - ] - }, - "tag": "ConfirmedSnapshot" - }, - "localTxs": [ - { - "id": -9, - "inputs": [ - -29, - -24, - -23, - -22, - -21, - -15, - -13, - -7, - -2, - 4, - 10, - 11, - 14, - 18 - ], - "outputs": [ - 21 - ] - }, - { - "id": 27, - "inputs": [ - -29, - -20, - -15, - -14, - -12, - -7, - -5, - 11, - 13, - 16, - 19, - 23, - 29 - ], - "outputs": [ - -29, - -27, - -17, - -15, - 1, - 6, - 17, - 18 - ] - }, - { - "id": 22, - "inputs": [ - -28, - -26, - -25, - -23, - -21, - -16, - -7, - -6, - -5, - 1, - 2, - 3, - 4, - 5, - 6, - 7, - 11, - 12, - 14, - 16, - 26 - ], - "outputs": [ - -30, - 6, - 15, - 19 - ] - }, - { - "id": -4, - "inputs": [ - -29, - -27, - -24, - -16, - -8, - -5, - -2, - 0, - 1, - 3, - 10, - 13, - 20, - 24 - ], - "outputs": [ - -23, - -22, - -9, - -5, - 3, - 4, - 5, - 7, - 9, - 12, - 18, - 20, - 24 - ] - } - ], - "localUTxO": [ - 4, - 14, - 21, - 27, - 28 - ], - "seenSnapshot": { - "signatories": {}, - "snapshot": { - "confirmedTransactions": [ - 1, - -17, - -1, - 12, - -5, - -21, - 25, - -8, - -7 - ], - "headId": "ba0b7a50e3004bb991841da8593f95bb", - "snapshotNumber": 17, - "utxo": [ - -26, - -25, - -23, - -22, - -21, - -18, - -17, - -16, - -1, - 1, - 4, - 7, - 10, - 12, - 15, - 23 - ] - }, - "tag": "SeenSnapshot" - } - }, - "currentSlot": 23, - "headId": "488504d3885a033e5b33a9c387204cee", - "headSeed": "c37b571704a8df408aa48cb7d8aae652", - "parameters": { - "contestationPeriod": 80500, - "parties": [ - { - "vkey": "72b342ef5dd9992e0d4b12506cd1430990100d69d7c0991905c8e4958095b036" - } - ] - } - }, - "tag": "Open" - } - ], - "seed": 531819866 -} \ No newline at end of file diff --git a/hydra-node/test/Hydra/HeadLogicSpec.hs b/hydra-node/test/Hydra/HeadLogicSpec.hs index ceac6f3ed2b..4907ba599d1 100644 --- a/hydra-node/test/Hydra/HeadLogicSpec.hs +++ b/hydra-node/test/Hydra/HeadLogicSpec.hs @@ -33,10 +33,10 @@ import Hydra.HeadLogic ( CoordinatedHeadState (..), Effect (..), Environment (..), - Event (..), HeadState (..), IdleState (..), InitialState (..), + Input (..), LogicError (..), OpenState (..), Outcome (..), @@ -56,7 +56,6 @@ import Hydra.Options (defaultContestationPeriod) import Hydra.Party (Party (..)) import Hydra.Prelude qualified as Prelude import Hydra.Snapshot (ConfirmedSnapshot (..), Snapshot (..), SnapshotNumber, getSnapshot) -import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs) import Test.Hydra.Fixture (alice, aliceSk, bob, bobSk, carol, carolSk, deriveOnChainId, testHeadId, testHeadSeed) import Test.QuickCheck (Property, counterexample, elements, forAll, oneof, shuffle, suchThat) import Test.QuickCheck.Monadic (assert, monadicIO, pick, run) @@ -64,10 +63,6 @@ import Test.QuickCheck.Monadic (assert, monadicIO, pick, run) spec :: Spec spec = parallel $ do - describe "Types" $ do - roundtripAndGoldenSpecs (Proxy @(Event SimpleTx)) - roundtripAndGoldenSpecs (Proxy @(HeadState SimpleTx)) - let threeParties = [alice, bob, carol] bobEnv = Environment From 33299e75145e03a0c7bafba7e33f81fc7879fde0 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 11 Mar 2024 11:56:55 +0100 Subject: [PATCH 07/15] Rename Event -> Input in NodeSpec --- hydra-node/test/Hydra/NodeSpec.hs | 92 +++++++++++++++---------------- 1 file changed, 46 insertions(+), 46 deletions(-) diff --git a/hydra-node/test/Hydra/NodeSpec.hs b/hydra-node/test/Hydra/NodeSpec.hs index c81442f1f94..0a6c16bdc3c 100644 --- a/hydra-node/test/Hydra/NodeSpec.hs +++ b/hydra-node/test/Hydra/NodeSpec.hs @@ -15,7 +15,7 @@ import Hydra.ContestationPeriod (ContestationPeriod (..)) import Hydra.Crypto (HydraKey, sign) import Hydra.HeadLogic ( Environment (..), - Event (..), + Input (..), StateChanged, defaultTTL, ) @@ -47,18 +47,18 @@ spec = parallel $ do it "emits a single ReqSn and AckSn as leader, even after multiple ReqTxs" $ showLogsOnFailure "NodeSpec" $ \tracer -> do -- NOTE(SN): Sequence of parties in OnInitTx of - -- 'eventsToOpenHead' is relevant, so 10 is the (initial) snapshot leader + -- 'inputsToOpenHead' is relevant, so 10 is the (initial) snapshot leader let tx1 = SimpleTx{txSimpleId = 1, txInputs = utxoRefs [2], txOutputs = utxoRefs [4]} tx2 = SimpleTx{txSimpleId = 2, txInputs = utxoRefs [4], txOutputs = utxoRefs [5]} tx3 = SimpleTx{txSimpleId = 3, txInputs = utxoRefs [5], txOutputs = utxoRefs [6]} - events = - eventsToOpenHead - <> [ NetworkEvent{ttl = defaultTTL, party = alice, message = ReqTx{transaction = tx1}} - , NetworkEvent{ttl = defaultTTL, party = alice, message = ReqTx{transaction = tx2}} - , NetworkEvent{ttl = defaultTTL, party = alice, message = ReqTx{transaction = tx3}} + inputs = + inputsToOpenHead + <> [ NetworkInput{ttl = defaultTTL, party = alice, message = ReqTx{transaction = tx1}} + , NetworkInput{ttl = defaultTTL, party = alice, message = ReqTx{transaction = tx2}} + , NetworkInput{ttl = defaultTTL, party = alice, message = ReqTx{transaction = tx3}} ] signedSnapshot = sign aliceSk $ testSnapshot 1 (utxoRefs [1, 3, 4]) [1] - node <- createHydraNode aliceSk [bob, carol] defaultContestationPeriod events + node <- createHydraNode aliceSk [bob, carol] defaultContestationPeriod inputs (node', getNetworkMessages) <- recordNetwork node runToCompletion tracer node' getNetworkMessages `shouldReturn` [ReqSn 1 [1], AckSn signedSnapshot 1] @@ -68,15 +68,15 @@ spec = parallel $ do let tx1 = SimpleTx{txSimpleId = 1, txInputs = utxoRefs [2], txOutputs = utxoRefs [4]} sn1 = testSnapshot 1 (utxoRefs [1, 2, 3]) mempty sn2 = testSnapshot 2 (utxoRefs [1, 3, 4]) [1] - events = - eventsToOpenHead - <> [ NetworkEvent{ttl = defaultTTL, party = alice, message = ReqSn{snapshotNumber = 1, transactionIds = mempty}} - , NetworkEvent{ttl = defaultTTL, party = alice, message = AckSn (sign aliceSk sn1) 1} - , NetworkEvent{ttl = defaultTTL, party = carol, message = AckSn (sign carolSk sn1) 1} - , NetworkEvent{ttl = defaultTTL, party = alice, message = ReqTx{transaction = tx1}} + inputs = + inputsToOpenHead + <> [ NetworkInput{ttl = defaultTTL, party = alice, message = ReqSn{snapshotNumber = 1, transactionIds = mempty}} + , NetworkInput{ttl = defaultTTL, party = alice, message = AckSn (sign aliceSk sn1) 1} + , NetworkInput{ttl = defaultTTL, party = carol, message = AckSn (sign carolSk sn1) 1} + , NetworkInput{ttl = defaultTTL, party = alice, message = ReqTx{transaction = tx1}} ] - node <- createHydraNode bobSk [alice, carol] defaultContestationPeriod events + node <- createHydraNode bobSk [alice, carol] defaultContestationPeriod inputs (node', getNetworkMessages) <- recordNetwork node runToCompletion tracer node' @@ -87,21 +87,21 @@ spec = parallel $ do let snapshot = testSnapshot 1 (utxoRefs [1, 2, 3]) [] sigBob = sign bobSk snapshot sigAlice = sign aliceSk snapshot - events = - eventsToOpenHead - <> [ NetworkEvent{ttl = defaultTTL, party = bob, message = AckSn{signed = sigBob, snapshotNumber = 1}} - , NetworkEvent{ttl = defaultTTL, party = alice, message = ReqSn{snapshotNumber = 1, transactionIds = []}} + inputs = + inputsToOpenHead + <> [ NetworkInput{ttl = defaultTTL, party = bob, message = AckSn{signed = sigBob, snapshotNumber = 1}} + , NetworkInput{ttl = defaultTTL, party = alice, message = ReqSn{snapshotNumber = 1, transactionIds = []}} ] - node <- createHydraNode aliceSk [bob, carol] defaultContestationPeriod events + node <- createHydraNode aliceSk [bob, carol] defaultContestationPeriod inputs (node', getNetworkMessages) <- recordNetwork node runToCompletion tracer node' getNetworkMessages `shouldReturn` [AckSn{signed = sigAlice, snapshotNumber = 1}] it "notifies client when postTx throws PostTxError" $ showLogsOnFailure "NodeSpec" $ \tracer -> do - let events = [ClientEvent Init] + let inputs = [ClientInput Init] (node, getServerOutputs) <- - createHydraNode aliceSk [bob, carol] defaultContestationPeriod events + createHydraNode aliceSk [bob, carol] defaultContestationPeriod inputs >>= throwExceptionOnPostTx NoSeedInput >>= recordServerOutputs @@ -118,13 +118,13 @@ spec = parallel $ do showLogsOnFailure "NodeSpec" $ \tracer -> do let snapshot = testSnapshot 1 (utxoRefs [1, 3, 5]) [2] sigBob = sign bobSk snapshot - events = - eventsToOpenHead - <> [ NetworkEvent{ttl = defaultTTL, party = bob, message = ReqTx{transaction = SimpleTx{txSimpleId = 1, txInputs = utxoRefs [2], txOutputs = utxoRefs [4]}}} - , NetworkEvent{ttl = defaultTTL, party = bob, message = ReqTx{transaction = SimpleTx{txSimpleId = 2, txInputs = utxoRefs [2], txOutputs = utxoRefs [5]}}} - , NetworkEvent{ttl = defaultTTL, party = alice, message = ReqSn{snapshotNumber = 1, transactionIds = [2]}} + inputs = + inputsToOpenHead + <> [ NetworkInput{ttl = defaultTTL, party = bob, message = ReqTx{transaction = SimpleTx{txSimpleId = 1, txInputs = utxoRefs [2], txOutputs = utxoRefs [4]}}} + , NetworkInput{ttl = defaultTTL, party = bob, message = ReqTx{transaction = SimpleTx{txSimpleId = 2, txInputs = utxoRefs [2], txOutputs = utxoRefs [5]}}} + , NetworkInput{ttl = defaultTTL, party = alice, message = ReqSn{snapshotNumber = 1, transactionIds = [2]}} ] - node <- createHydraNode bobSk [alice, carol] defaultContestationPeriod events + node <- createHydraNode bobSk [alice, carol] defaultContestationPeriod inputs (node', getNetworkMessages) <- recordNetwork node runToCompletion tracer node' getNetworkMessages `shouldReturn` [AckSn{signed = sigBob, snapshotNumber = 1}] @@ -134,14 +134,14 @@ spec = parallel $ do showLogsOnFailure "NodeSpec" $ \tracer -> do persistence <- createPersistenceInMemory - createHydraNode' persistence bobSk [alice, carol] defaultContestationPeriod eventsToOpenHead + createHydraNode' persistence bobSk [alice, carol] defaultContestationPeriod inputsToOpenHead >>= runToCompletion tracer - let reqTxEvent = NetworkEvent{ttl = defaultTTL, party = alice, message = ReqTx{transaction = tx1}} + let reqTx = NetworkInput{ttl = defaultTTL, party = alice, message = ReqTx{transaction = tx1}} tx1 = SimpleTx{txSimpleId = 1, txInputs = utxoRefs [2], txOutputs = utxoRefs [4]} (node, getServerOutputs) <- - createHydraNode' persistence bobSk [alice, carol] defaultContestationPeriod [reqTxEvent] + createHydraNode' persistence bobSk [alice, carol] defaultContestationPeriod [reqTx] >>= recordServerOutputs runToCompletion tracer node @@ -203,18 +203,18 @@ isReqSn = \case ReqSn{} -> True _ -> False -eventsToOpenHead :: [Event SimpleTx] -eventsToOpenHead = - [ observationEvent $ OnInitTx testHeadId testHeadSeed headParameters participants - , observationEvent $ OnCommitTx testHeadId carol (utxoRef 3) - , observationEvent $ OnCommitTx testHeadId bob (utxoRef 2) - , observationEvent $ OnCommitTx testHeadId alice (utxoRef 1) - , observationEvent $ OnCollectComTx testHeadId +inputsToOpenHead :: [Input SimpleTx] +inputsToOpenHead = + [ observationInput $ OnInitTx testHeadId testHeadSeed headParameters participants + , observationInput $ OnCommitTx testHeadId carol (utxoRef 3) + , observationInput $ OnCommitTx testHeadId bob (utxoRef 2) + , observationInput $ OnCommitTx testHeadId alice (utxoRef 1) + , observationInput $ OnCollectComTx testHeadId ] where - observationEvent :: OnChainTx SimpleTx -> Event SimpleTx - observationEvent observedTx = - OnChainEvent + observationInput :: OnChainTx SimpleTx -> Input SimpleTx + observationInput observedTx = + ChainInput { chainEvent = Observation { observedTx @@ -231,7 +231,7 @@ runToCompletion :: Tracer IO (HydraNodeLog tx) -> HydraNode tx IO -> IO () -runToCompletion tracer node@HydraNode{eq = InputQueue{isEmpty}} = go +runToCompletion tracer node@HydraNode{inputQueue = InputQueue{isEmpty}} = go where go = unlessM isEmpty $ @@ -242,7 +242,7 @@ createHydraNode :: SigningKey HydraKey -> [Party] -> ContestationPeriod -> - [Event SimpleTx] -> + [Input SimpleTx] -> m (HydraNode SimpleTx m) createHydraNode = createHydraNode' @@ -257,11 +257,11 @@ createHydraNode' :: SigningKey HydraKey -> [Party] -> ContestationPeriod -> - [Event SimpleTx] -> + [Input SimpleTx] -> m (HydraNode SimpleTx m) -createHydraNode' persistence signingKey otherParties contestationPeriod events = do +createHydraNode' persistence signingKey otherParties contestationPeriod inputs = do inputQueue@InputQueue{enqueue} <- createInputQueue - forM_ events enqueue + forM_ inputs enqueue (headState, _) <- loadState nullTracer persistence SimpleChainState{slot = ChainSlot 0} nodeState <- createNodeState headState pure $ From da26f7f69e495b252fd874a693a5d0a7bee2789e Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 11 Mar 2024 12:00:15 +0100 Subject: [PATCH 08/15] Rename Event -> Input in BehaviorSpec and MockChain --- hydra-node/test/Hydra/BehaviorSpec.hs | 22 +++++++++++----------- hydra-node/test/Hydra/Model/MockChain.hs | 10 +++++----- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/hydra-node/test/Hydra/BehaviorSpec.hs b/hydra-node/test/Hydra/BehaviorSpec.hs index d59cc241730..2b017a8dc6f 100644 --- a/hydra-node/test/Hydra/BehaviorSpec.hs +++ b/hydra-node/test/Hydra/BehaviorSpec.hs @@ -41,9 +41,9 @@ import Hydra.Crypto (HydraKey, aggregate, sign) import Hydra.HeadLogic ( Effect (..), Environment (..), - Event (..), HeadState (..), IdleState (..), + Input (..), defaultTTL, ) import Hydra.HeadLogicSpec (testSnapshot) @@ -60,7 +60,7 @@ import Hydra.Node ( runHydraNode, waitDelay, ) -import Hydra.Node.EventQueue (EventQueue (putEvent), createEventQueue) +import Hydra.Node.InputQueue (InputQueue (enqueue), createInputQueue) import Hydra.NodeSpec (createPersistenceInMemory) import Hydra.Party (Party (..), deriveParty) import Hydra.Snapshot (Snapshot (..), SnapshotNumber, getSnapshot) @@ -436,9 +436,9 @@ spec = parallel $ do logs = selectTraceEventsDynamic @_ @(HydraNodeLog SimpleTx) result logs - `shouldContain` [BeginEvent alice 0 (ClientEvent Init)] + `shouldContain` [BeginInput alice 0 (ClientInput Init)] logs - `shouldContain` [EndEvent alice 0] + `shouldContain` [EndInput alice 0] it "traces handling of effects" $ do let result = runSimTrace $ do @@ -681,7 +681,7 @@ simulatedChainAndNetwork initialChainState = do recordAndYieldEvent nodes history ev handleChainEvent :: HydraNode tx m -> ChainEvent tx -> m () -handleChainEvent HydraNode{eq} = putEvent eq . OnChainEvent +handleChainEvent HydraNode{inputQueue} = enqueue inputQueue . ChainInput createMockNetwork :: MonadSTM m => HydraNode tx m -> TVar m [HydraNode tx m] -> Network m (Message tx) createMockNetwork node nodes = @@ -692,7 +692,7 @@ createMockNetwork node nodes = let otherNodes = filter (\n -> getNodeId n /= getNodeId node) allNodes mapM_ (`handleMessage` msg) otherNodes - handleMessage HydraNode{eq} = putEvent eq . NetworkEvent defaultTTL (getNodeId node) + handleMessage HydraNode{inputQueue} = enqueue inputQueue . NetworkInput defaultTTL (getNodeId node) getNodeId HydraNode{env = Environment{party}} = party @@ -756,11 +756,11 @@ createTestHydraClient :: HydraNode tx m -> NodeState tx m -> TestHydraClient tx m -createTestHydraClient outputs outputHistory HydraNode{eq} nodeState = +createTestHydraClient outputs outputHistory HydraNode{inputQueue} nodeState = TestHydraClient - { send = putEvent eq . ClientEvent + { send = enqueue inputQueue . ClientInput , waitForNext = atomically (readTQueue outputs) - , injectChainEvent = putEvent eq . OnChainEvent + , injectChainEvent = enqueue inputQueue . ChainInput , serverOutputs = reverse <$> readTVarIO outputHistory , queryState = atomically (queryHeadState nodeState) } @@ -777,11 +777,11 @@ createHydraNode :: ContestationPeriod -> m (HydraNode tx m) createHydraNode ledger nodeState signingKey otherParties outputs outputHistory chain cp = do - eq <- createEventQueue + inputQueue <- createInputQueue persistence <- createPersistenceInMemory connectNode chain $ HydraNode - { eq + { inputQueue , hn = Network{broadcast = \_ -> pure ()} , nodeState , ledger diff --git a/hydra-node/test/Hydra/Model/MockChain.hs b/hydra-node/test/Hydra/Model/MockChain.hs index 55c89bfcc6c..34b03081e0b 100644 --- a/hydra-node/test/Hydra/Model/MockChain.hs +++ b/hydra-node/test/Hydra/Model/MockChain.hs @@ -56,7 +56,7 @@ import Hydra.Chain.Direct.Wallet (TinyWallet (..)) import Hydra.Crypto (HydraKey) import Hydra.HeadLogic ( Environment (Environment, party), - Event (..), + Input (..), defaultTTL, ) import Hydra.HeadLogic.State ( @@ -75,7 +75,7 @@ import Hydra.Model.Payment (CardanoSigningKey (..)) import Hydra.Network (Network (..)) import Hydra.Network.Message (Message) import Hydra.Node (HydraNode (..), NodeState (..)) -import Hydra.Node.EventQueue (EventQueue (..)) +import Hydra.Node.InputQueue (InputQueue (..)) import Hydra.Party (Party (..), deriveParty) import Hydra.Snapshot (ConfirmedSnapshot (..)) import Test.QuickCheck (getPositive) @@ -147,7 +147,7 @@ mockChainAndNetwork tr seedKeys commits = do , scriptRegistry } let getTimeHandle = pure $ fixedTimeHandleIndefiniteHorizon `generateWith` 42 - let HydraNode{eq = EventQueue{putEvent}} = node + let HydraNode{inputQueue = InputQueue{enqueue}} = node -- Validate transactions on submission and queue them for inclusion if valid. let submitTx tx = atomically $ do @@ -179,7 +179,7 @@ mockChainAndNetwork tr seedKeys commits = do let chainHandler = chainSyncHandler tr - (putEvent . OnChainEvent) + (enqueue . ChainInput) getTimeHandle ctx localChainState @@ -347,7 +347,7 @@ createMockNetwork myNode nodes = let otherNodes = filter (\n -> getNodeId n /= getNodeId myNode) allNodes mapM_ (`handleMessage` msg) otherNodes - handleMessage HydraNode{eq} = putEvent eq . NetworkEvent defaultTTL (getNodeId myNode) + handleMessage HydraNode{inputQueue} = enqueue inputQueue . NetworkInput defaultTTL (getNodeId myNode) getNodeId HydraNode{env = Environment{party}} = party From 19040f98e9e0f56e8d1b7e604c218c0f33c55bf3 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 11 Mar 2024 12:11:11 +0100 Subject: [PATCH 09/15] Rename Event -> Input in HeadLogicSpec --- .../test/Hydra/HeadLogicSnapshotSpec.hs | 40 +-- hydra-node/test/Hydra/HeadLogicSpec.hs | 228 ++++++++---------- 2 files changed, 125 insertions(+), 143 deletions(-) diff --git a/hydra-node/test/Hydra/HeadLogicSnapshotSpec.hs b/hydra-node/test/Hydra/HeadLogicSnapshotSpec.hs index 966a9cdba2b..36be17cd5ec 100644 --- a/hydra-node/test/Hydra/HeadLogicSnapshotSpec.hs +++ b/hydra-node/test/Hydra/HeadLogicSnapshotSpec.hs @@ -14,8 +14,8 @@ import Hydra.HeadLogic ( CoordinatedHeadState (..), Effect (..), Environment (..), - Event (NetworkEvent), HeadState (..), + Input (NetworkInput), OpenState (OpenState), SeenSnapshot (..), coordinatedHeadState, @@ -23,7 +23,7 @@ import Hydra.HeadLogic ( isLeader, update, ) -import Hydra.HeadLogicSpec (getState, hasEffect, hasEffectSatisfying, hasNoEffectSatisfying, inOpenState, inOpenState', runEvents, step) +import Hydra.HeadLogicSpec (getState, hasEffect, hasEffectSatisfying, hasNoEffectSatisfying, inOpenState, inOpenState', runHeadLogic, step) import Hydra.Ledger (txId) import Hydra.Ledger.Simple (SimpleTx (..), aValidTx, simpleLedger, utxoRef) import Hydra.Network.Message (Message (..)) @@ -63,7 +63,7 @@ spec = do _ -> False let snapshot1 = Snapshot testHeadId 1 mempty [] - let ackFrom sk vk = NetworkEvent defaultTTL vk $ AckSn (sign sk snapshot1) 1 + let ackFrom sk vk = NetworkInput defaultTTL vk $ AckSn (sign sk snapshot1) 1 describe "Generic Snapshot property" $ do prop "there's always a leader for every snapshot number" prop_thereIsAlwaysALeader @@ -73,7 +73,7 @@ spec = do it "sends ReqSn when leader and no snapshot in flight" $ do let tx = aValidTx 1 - outcome = update (envFor aliceSk) simpleLedger (inOpenState' [alice, bob] coordinatedHeadState) $ NetworkEvent defaultTTL alice $ ReqTx tx + outcome = update (envFor aliceSk) simpleLedger (inOpenState' [alice, bob] coordinatedHeadState) $ NetworkInput defaultTTL alice $ ReqTx tx outcome `hasEffect` NetworkEffect (ReqSn 1 [txId tx]) @@ -81,7 +81,7 @@ spec = do it "does NOT send ReqSn when we are NOT the leader even if no snapshot in flight" $ do let tx = aValidTx 1 st = coordinatedHeadState{localTxs = [tx]} - outcome = update (envFor bobSk) simpleLedger (inOpenState' [alice, bob] st) $ NetworkEvent defaultTTL bob $ ReqTx tx + outcome = update (envFor bobSk) simpleLedger (inOpenState' [alice, bob] st) $ NetworkInput defaultTTL bob $ ReqTx tx outcome `hasNoEffectSatisfying` sendReqSn @@ -89,7 +89,7 @@ spec = do let tx = aValidTx 1 sn1 = Snapshot testHeadId 1 u0 mempty :: Snapshot SimpleTx st = coordinatedHeadState{seenSnapshot = SeenSnapshot sn1 mempty} - outcome = update (envFor aliceSk) simpleLedger (inOpenState' [alice, bob] st) $ NetworkEvent defaultTTL alice $ ReqTx tx + outcome = update (envFor aliceSk) simpleLedger (inOpenState' [alice, bob] st) $ NetworkInput defaultTTL alice $ ReqTx tx outcome `hasNoEffectSatisfying` sendReqSn @@ -106,8 +106,8 @@ spec = do , seenSnapshot = RequestedSnapshot{lastSeen = 0, requested = 1} } - actualState <- runEvents (envFor aliceSk) simpleLedger st $ do - step $ NetworkEvent defaultTTL alice $ ReqTx tx + actualState <- runHeadLogic (envFor aliceSk) simpleLedger st $ do + step $ NetworkInput defaultTTL alice $ ReqTx tx getState actualState `shouldBe` st' @@ -115,9 +115,9 @@ spec = do let bobEnv = envFor bobSk it "sends ReqSn when leader and there are seen transactions" $ do - headState <- runEvents bobEnv simpleLedger (inOpenState threeParties) $ do - step (NetworkEvent defaultTTL alice $ ReqSn 1 []) - step (NetworkEvent defaultTTL carol $ ReqTx $ aValidTx 1) + headState <- runHeadLogic bobEnv simpleLedger (inOpenState threeParties) $ do + step (NetworkInput defaultTTL alice $ ReqSn 1 []) + step (NetworkInput defaultTTL carol $ ReqTx $ aValidTx 1) step (ackFrom carolSk carol) step (ackFrom aliceSk alice) getState @@ -126,8 +126,8 @@ spec = do `hasEffectSatisfying` sendReqSn it "does NOT send ReqSn when we are the leader but there are NO seen transactions" $ do - headState <- runEvents bobEnv simpleLedger (inOpenState threeParties) $ do - step (NetworkEvent defaultTTL alice $ ReqSn 1 []) + headState <- runHeadLogic bobEnv simpleLedger (inOpenState threeParties) $ do + step (NetworkInput defaultTTL alice $ ReqSn 1 []) step (ackFrom carolSk carol) step (ackFrom aliceSk alice) getState @@ -140,11 +140,11 @@ spec = do notLeaderEnv = envFor carolSk let initiateSigningASnapshot actor = - step (NetworkEvent defaultTTL actor $ ReqSn 1 []) + step (NetworkInput defaultTTL actor $ ReqSn 1 []) newTxBeforeSnapshotAcknowledged = - step (NetworkEvent defaultTTL carol $ ReqTx $ aValidTx 1) + step (NetworkInput defaultTTL carol $ ReqTx $ aValidTx 1) - headState <- runEvents notLeaderEnv simpleLedger (inOpenState threeParties) $ do + headState <- runHeadLogic notLeaderEnv simpleLedger (inOpenState threeParties) $ do initiateSigningASnapshot alice step (ackFrom carolSk carol) newTxBeforeSnapshotAcknowledged @@ -155,9 +155,9 @@ spec = do everybodyAcknowleged `hasNoEffectSatisfying` sendReqSn it "updates seenSnapshot state when sending ReqSn" $ do - headState <- runEvents bobEnv simpleLedger (inOpenState threeParties) $ do - step (NetworkEvent defaultTTL alice $ ReqSn 1 []) - step (NetworkEvent defaultTTL carol $ ReqTx $ aValidTx 1) + headState <- runHeadLogic bobEnv simpleLedger (inOpenState threeParties) $ do + step (NetworkInput defaultTTL alice $ ReqSn 1 []) + step (NetworkInput defaultTTL carol $ ReqTx $ aValidTx 1) step (ackFrom carolSk carol) step (ackFrom aliceSk alice) step (ackFrom bobSk bob) @@ -195,7 +195,7 @@ prop_singleMemberHeadAlwaysSnapshotOnReqTx sn = monadicST $ do , confirmedSnapshot = sn , seenSnapshot } - outcome = update aliceEnv simpleLedger (inOpenState' [alice] st) $ NetworkEvent defaultTTL alice $ ReqTx tx + outcome = update aliceEnv simpleLedger (inOpenState' [alice] st) $ NetworkInput defaultTTL alice $ ReqTx tx Snapshot{number = confirmedSn} = getSnapshot sn nextSn = confirmedSn + 1 pure $ diff --git a/hydra-node/test/Hydra/HeadLogicSpec.hs b/hydra-node/test/Hydra/HeadLogicSpec.hs index 4907ba599d1..eadf221f5aa 100644 --- a/hydra-node/test/Hydra/HeadLogicSpec.hs +++ b/hydra-node/test/Hydra/HeadLogicSpec.hs @@ -89,7 +89,7 @@ spec = let inputs = utxoRef 1 tx = SimpleTx 2 inputs mempty ttl = 0 - reqTx = NetworkEvent ttl alice $ ReqTx tx + reqTx = NetworkInput ttl alice $ ReqTx tx s0 = inOpenState threeParties update bobEnv ledger s0 reqTx `hasEffectSatisfying` \case @@ -97,7 +97,7 @@ spec = _ -> False it "waits if a requested tx is not (yet) applicable" $ do - let reqTx = NetworkEvent defaultTTL alice $ ReqTx $ SimpleTx 2 inputs mempty + let reqTx = NetworkInput defaultTTL alice $ ReqTx $ SimpleTx 2 inputs mempty inputs = utxoRef 1 s0 = inOpenState threeParties @@ -105,10 +105,10 @@ spec = `assertWait` WaitOnNotApplicableTx (ValidationError "cannot apply transaction") it "confirms snapshot given it receives AckSn from all parties" $ do - let reqSn = NetworkEvent defaultTTL alice $ ReqSn 1 [] + let reqSn = NetworkInput defaultTTL alice $ ReqSn 1 [] snapshot1 = Snapshot testHeadId 1 mempty [] - ackFrom sk vk = NetworkEvent defaultTTL vk $ AckSn (sign sk snapshot1) 1 - snapshotInProgress <- runEvents bobEnv ledger (inOpenState threeParties) $ do + ackFrom sk vk = NetworkInput defaultTTL vk $ AckSn (sign sk snapshot1) 1 + snapshotInProgress <- runHeadLogic bobEnv ledger (inOpenState threeParties) $ do step reqSn step (ackFrom carolSk carol) step (ackFrom aliceSk alice) @@ -117,7 +117,7 @@ spec = getConfirmedSnapshot snapshotInProgress `shouldBe` Just (testSnapshot 0 mempty []) snapshotConfirmed <- - runEvents bobEnv ledger snapshotInProgress $ do + runHeadLogic bobEnv ledger snapshotInProgress $ do step (ackFrom bobSk bob) getState getConfirmedSnapshot snapshotConfirmed `shouldBe` Just snapshot1 @@ -127,8 +127,8 @@ spec = let s0 = inOpenState threeParties t1 = SimpleTx 1 mempty (utxoRef 1) - sa <- runEvents bobEnv ledger s0 $ do - step $ NetworkEvent defaultTTL alice $ ReqTx t1 + sa <- runHeadLogic bobEnv ledger s0 $ do + step $ NetworkInput defaultTTL alice $ ReqTx t1 getState sa `shouldSatisfy` \case @@ -138,10 +138,10 @@ spec = it "removes transactions in allTxs given it receives a ReqSn" $ do let s0 = inOpenState threeParties t1 = SimpleTx 1 mempty (utxoRef 1) - reqSn = NetworkEvent defaultTTL alice $ ReqSn 1 [1] + reqSn = NetworkInput defaultTTL alice $ ReqSn 1 [1] - s1 <- runEvents bobEnv ledger s0 $ do - step $ NetworkEvent defaultTTL alice $ ReqTx t1 + s1 <- runHeadLogic bobEnv ledger s0 $ do + step $ NetworkInput defaultTTL alice $ ReqTx t1 step reqSn getState @@ -152,17 +152,17 @@ spec = it "removes transactions from allTxs when included in a acked snapshot even when emitting a ReqSn" $ do let t1 = SimpleTx 1 mempty (utxoRef 1) pendingTransaction = SimpleTx 2 mempty (utxoRef 2) - reqSn = NetworkEvent defaultTTL alice $ ReqSn 1 [1] + reqSn = NetworkInput defaultTTL alice $ ReqSn 1 [1] snapshot1 = testSnapshot 1 (utxoRefs [1]) [1] - ackFrom sk vk = NetworkEvent defaultTTL vk $ AckSn (sign sk snapshot1) 1 + ackFrom sk vk = NetworkInput defaultTTL vk $ AckSn (sign sk snapshot1) 1 - sa <- runEvents bobEnv ledger (inOpenState threeParties) $ do - step $ NetworkEvent defaultTTL alice $ ReqTx t1 + sa <- runHeadLogic bobEnv ledger (inOpenState threeParties) $ do + step $ NetworkInput defaultTTL alice $ ReqTx t1 step reqSn step (ackFrom carolSk carol) step (ackFrom aliceSk alice) - step $ NetworkEvent defaultTTL alice $ ReqTx pendingTransaction + step $ NetworkInput defaultTTL alice $ ReqTx pendingTransaction step (ackFrom bobSk bob) getState @@ -172,13 +172,13 @@ spec = _ -> False it "rejects last AckSn if one signature was from a different snapshot" $ do - let reqSn = NetworkEvent defaultTTL alice $ ReqSn 1 [] + let reqSn = NetworkInput defaultTTL alice $ ReqSn 1 [] snapshot = testSnapshot 1 mempty [] snapshot' = testSnapshot 2 mempty [] - ackFrom sk vk = NetworkEvent defaultTTL vk $ AckSn (sign sk snapshot) 1 - invalidAckFrom sk vk = NetworkEvent defaultTTL vk $ AckSn (sign sk snapshot') 1 + ackFrom sk vk = NetworkInput defaultTTL vk $ AckSn (sign sk snapshot) 1 + invalidAckFrom sk vk = NetworkInput defaultTTL vk $ AckSn (sign sk snapshot') 1 waitingForLastAck <- - runEvents bobEnv ledger (inOpenState threeParties) $ do + runHeadLogic bobEnv ledger (inOpenState threeParties) $ do step reqSn step (ackFrom carolSk carol) step (ackFrom aliceSk alice) @@ -190,11 +190,11 @@ spec = _ -> False it "rejects last AckSn if one signature was from a different key" $ do - let reqSn = NetworkEvent defaultTTL alice $ ReqSn 1 [] + let reqSn = NetworkInput defaultTTL alice $ ReqSn 1 [] snapshot = testSnapshot 1 mempty [] - ackFrom sk vk = NetworkEvent defaultTTL vk $ AckSn (sign sk snapshot) 1 + ackFrom sk vk = NetworkInput defaultTTL vk $ AckSn (sign sk snapshot) 1 waitingForLastAck <- - runEvents bobEnv ledger (inOpenState threeParties) $ do + runHeadLogic bobEnv ledger (inOpenState threeParties) $ do step reqSn step (ackFrom carolSk carol) step (ackFrom aliceSk alice) @@ -206,14 +206,14 @@ spec = _ -> False it "rejects last AckSn if one signature was from a completely different message" $ do - let reqSn = NetworkEvent defaultTTL alice $ ReqSn 1 [] + let reqSn = NetworkInput defaultTTL alice $ ReqSn 1 [] snapshot1 = testSnapshot 1 mempty [] - ackFrom sk vk = NetworkEvent defaultTTL vk $ AckSn (sign sk snapshot1) 1 + ackFrom sk vk = NetworkInput defaultTTL vk $ AckSn (sign sk snapshot1) 1 invalidAckFrom sk vk = - NetworkEvent defaultTTL vk $ + NetworkInput defaultTTL vk $ AckSn (coerce $ sign sk ("foo" :: ByteString)) 1 waitingForLastAck <- - runEvents bobEnv ledger (inOpenState threeParties) $ do + runHeadLogic bobEnv ledger (inOpenState threeParties) $ do step reqSn step (ackFrom carolSk carol) step (invalidAckFrom bobSk bob) @@ -225,11 +225,11 @@ spec = _ -> False it "rejects last AckSn if already received signature from this party" $ do - let reqSn = NetworkEvent defaultTTL alice $ ReqSn 1 [] + let reqSn = NetworkInput defaultTTL alice $ ReqSn 1 [] snapshot1 = testSnapshot 1 mempty [] - ackFrom sk vk = NetworkEvent defaultTTL vk $ AckSn (sign sk snapshot1) 1 + ackFrom sk vk = NetworkInput defaultTTL vk $ AckSn (sign sk snapshot1) 1 waitingForAck <- - runEvents bobEnv ledger (inOpenState threeParties) $ do + runHeadLogic bobEnv ledger (inOpenState threeParties) $ do step reqSn step (ackFrom carolSk carol) getState @@ -240,29 +240,29 @@ spec = _ -> False it "waits if we receive a snapshot with transaction not applicable on previous snapshot" $ do - let reqTx42 = NetworkEvent defaultTTL alice $ ReqTx (SimpleTx 42 mempty (utxoRef 1)) - reqTx1 = NetworkEvent defaultTTL alice $ ReqTx (SimpleTx 1 (utxoRef 1) (utxoRef 2)) - event = NetworkEvent defaultTTL alice $ ReqSn 1 [1] + let reqTx42 = NetworkInput defaultTTL alice $ ReqTx (SimpleTx 42 mempty (utxoRef 1)) + reqTx1 = NetworkInput defaultTTL alice $ ReqTx (SimpleTx 1 (utxoRef 1) (utxoRef 2)) + input = NetworkInput defaultTTL alice $ ReqSn 1 [1] s0 = inOpenState threeParties - s2 <- runEvents bobEnv ledger s0 $ do + s2 <- runHeadLogic bobEnv ledger s0 $ do step reqTx42 step reqTx1 getState - update bobEnv ledger s2 event + update bobEnv ledger s2 input `shouldBe` Error (RequireFailed (SnapshotDoesNotApply 1 1 (ValidationError "cannot apply transaction"))) it "waits if we receive a snapshot with unseen transactions" $ do let s0 = inOpenState threeParties - reqSn = NetworkEvent defaultTTL alice $ ReqSn 1 [1] + reqSn = NetworkInput defaultTTL alice $ ReqSn 1 [1] update bobEnv ledger s0 reqSn `assertWait` WaitOnTxs [1] it "waits if we receive an AckSn for an unseen snapshot" $ do let snapshot = testSnapshot 1 mempty [] - event = NetworkEvent defaultTTL alice $ AckSn (sign aliceSk snapshot) 1 - update bobEnv ledger (inOpenState threeParties) event + input = NetworkInput defaultTTL alice $ AckSn (sign aliceSk snapshot) 1 + update bobEnv ledger (inOpenState threeParties) input `assertWait` WaitOnSeenSnapshot -- TODO: Write property tests for various future / old snapshot behavior. @@ -270,15 +270,15 @@ spec = -- snapshot collection. it "rejects if we receive a too far future snapshot" $ do - let event = NetworkEvent defaultTTL bob $ ReqSn 2 [] + let input = NetworkInput defaultTTL bob $ ReqSn 2 [] st = inOpenState threeParties - update bobEnv ledger st event `shouldBe` Error (RequireFailed $ ReqSnNumberInvalid 2 0) + update bobEnv ledger st input `shouldBe` Error (RequireFailed $ ReqSnNumberInvalid 2 0) it "waits if we receive a future snapshot while collecting signatures" $ do - let reqSn1 = NetworkEvent defaultTTL alice $ ReqSn 1 [] - reqSn2 = NetworkEvent defaultTTL bob $ ReqSn 2 [] + let reqSn1 = NetworkInput defaultTTL alice $ ReqSn 1 [] + reqSn2 = NetworkInput defaultTTL bob $ ReqSn 2 [] st <- - runEvents bobEnv ledger (inOpenState threeParties) $ do + runHeadLogic bobEnv ledger (inOpenState threeParties) $ do step reqSn1 getState @@ -288,31 +288,31 @@ spec = it "acks signed snapshot from the constant leader" $ do let leader = alice snapshot = testSnapshot 1 mempty [] - event = NetworkEvent defaultTTL leader $ ReqSn (number snapshot) [] + input = NetworkInput defaultTTL leader $ ReqSn (number snapshot) [] sig = sign bobSk snapshot st = inOpenState threeParties ack = AckSn sig (number snapshot) - update bobEnv ledger st event `hasEffect` NetworkEffect ack + update bobEnv ledger st input `hasEffect` NetworkEffect ack it "does not ack snapshots from non-leaders" $ do - let event = NetworkEvent defaultTTL notTheLeader $ ReqSn 1 [] + let input = NetworkInput defaultTTL notTheLeader $ ReqSn 1 [] notTheLeader = bob st = inOpenState threeParties - update bobEnv ledger st event `shouldSatisfy` \case + update bobEnv ledger st input `shouldSatisfy` \case Error (RequireFailed ReqSnNotLeader{requestedSn = 1, leader}) -> leader == notTheLeader _ -> False it "rejects too-old snapshots" $ do - let event = NetworkEvent defaultTTL theLeader $ ReqSn 2 [] + let input = NetworkInput defaultTTL theLeader $ ReqSn 2 [] theLeader = alice snapshot = testSnapshot 2 mempty [] st = inOpenState' threeParties $ coordinatedHeadState{confirmedSnapshot = ConfirmedSnapshot snapshot (Crypto.aggregate [])} - update bobEnv ledger st event `shouldBe` Error (RequireFailed $ ReqSnNumberInvalid 2 0) + update bobEnv ledger st input `shouldBe` Error (RequireFailed $ ReqSnNumberInvalid 2 0) it "rejects too-old snapshots when collecting signatures" $ do - let event = NetworkEvent defaultTTL theLeader $ ReqSn 2 [] + let input = NetworkInput defaultTTL theLeader $ ReqSn 2 [] theLeader = alice snapshot = testSnapshot 2 mempty [] st = @@ -321,23 +321,23 @@ spec = { confirmedSnapshot = ConfirmedSnapshot snapshot (Crypto.aggregate []) , seenSnapshot = SeenSnapshot (testSnapshot 3 mempty []) mempty } - update bobEnv ledger st event `shouldBe` Error (RequireFailed $ ReqSnNumberInvalid 2 3) + update bobEnv ledger st input `shouldBe` Error (RequireFailed $ ReqSnNumberInvalid 2 3) it "rejects too-new snapshots from the leader" $ do - let event = NetworkEvent defaultTTL theLeader $ ReqSn 3 [] + let input = NetworkInput defaultTTL theLeader $ ReqSn 3 [] theLeader = carol st = inOpenState threeParties - update bobEnv ledger st event `shouldBe` Error (RequireFailed $ ReqSnNumberInvalid 3 0) + update bobEnv ledger st input `shouldBe` Error (RequireFailed $ ReqSnNumberInvalid 3 0) it "rejects overlapping snapshot requests from the leader" $ do let theLeader = alice nextSN = 1 - firstReqTx = NetworkEvent defaultTTL alice $ ReqTx (aValidTx 42) - firstReqSn = NetworkEvent defaultTTL theLeader $ ReqSn nextSN [42] - secondReqTx = NetworkEvent defaultTTL alice $ ReqTx (aValidTx 51) - secondReqSn = NetworkEvent defaultTTL theLeader $ ReqSn nextSN [51] + firstReqTx = NetworkInput defaultTTL alice $ ReqTx (aValidTx 42) + firstReqSn = NetworkInput defaultTTL theLeader $ ReqSn nextSN [42] + secondReqTx = NetworkInput defaultTTL alice $ ReqTx (aValidTx 51) + secondReqSn = NetworkInput defaultTTL theLeader $ ReqSn nextSN [51] - s3 <- runEvents bobEnv ledger (inOpenState threeParties) $ do + s3 <- runHeadLogic bobEnv ledger (inOpenState threeParties) $ do step firstReqTx step firstReqSn step secondReqTx @@ -349,58 +349,58 @@ spec = it "ignores in-flight ReqTx when closed" $ do let s0 = inClosedState threeParties - event = NetworkEvent defaultTTL alice $ ReqTx (aValidTx 42) - update bobEnv ledger s0 event `shouldBe` Error (InvalidEvent event s0) + input = NetworkInput defaultTTL alice $ ReqTx (aValidTx 42) + update bobEnv ledger s0 input `shouldBe` Error (UnhandledInput input s0) it "everyone does collect on last commit after collect com" $ do let aliceCommit = OnCommitTx testHeadId alice (utxoRef 1) bobCommit = OnCommitTx testHeadId bob (utxoRef 2) carolCommit = OnCommitTx testHeadId carol (utxoRef 3) waitingForLastCommit <- - runEvents bobEnv ledger (inInitialState threeParties) $ do - step (observeEventAtSlot 1 aliceCommit) - step (observeEventAtSlot 2 bobCommit) + runHeadLogic bobEnv ledger (inInitialState threeParties) $ do + step (observeTxAtSlot 1 aliceCommit) + step (observeTxAtSlot 2 bobCommit) getState -- Bob is not the last party, but still does post a collect - update bobEnv ledger waitingForLastCommit (observeEventAtSlot 3 carolCommit) + update bobEnv ledger waitingForLastCommit (observeTxAtSlot 3 carolCommit) `hasEffectSatisfying` \case OnChainEffect{postChainTx = CollectComTx{}} -> True _ -> False it "cannot observe abort after collect com" $ do afterCollectCom <- - runEvents bobEnv ledger (inInitialState threeParties) $ do - step (observationEvent $ OnCollectComTx testHeadId) + runHeadLogic bobEnv ledger (inInitialState threeParties) $ do + step (observeTx $ OnCollectComTx testHeadId) getState - let invalidEvent = observationEvent OnAbortTx{headId = testHeadId} - update bobEnv ledger afterCollectCom invalidEvent - `shouldBe` Error (InvalidEvent invalidEvent afterCollectCom) + let invalidInput = observeTx OnAbortTx{headId = testHeadId} + update bobEnv ledger afterCollectCom invalidInput + `shouldBe` Error (UnhandledInput invalidInput afterCollectCom) it "cannot observe collect com after abort" $ do afterAbort <- - runEvents bobEnv ledger (inInitialState threeParties) $ do - step (observationEvent OnAbortTx{headId = testHeadId}) + runHeadLogic bobEnv ledger (inInitialState threeParties) $ do + step (observeTx OnAbortTx{headId = testHeadId}) getState - let invalidEvent = observationEvent (OnCollectComTx testHeadId) - update bobEnv ledger afterAbort invalidEvent - `shouldBe` Error (InvalidEvent invalidEvent afterAbort) + let invalidInput = observeTx (OnCollectComTx testHeadId) + update bobEnv ledger afterAbort invalidInput + `shouldBe` Error (UnhandledInput invalidInput afterAbort) it "notifies user on head closing and when passing the contestation deadline" $ do let s0 = inOpenState threeParties snapshotNumber = 0 contestationDeadline = arbitrary `generateWith` 42 observeCloseTx = - observationEvent + observeTx OnCloseTx { headId = testHeadId , snapshotNumber , contestationDeadline } clientEffect = ClientEffect HeadIsClosed{headId = testHeadId, snapshotNumber, contestationDeadline} - runEvents bobEnv ledger s0 $ do + runHeadLogic bobEnv ledger s0 $ do outcome1 <- step observeCloseTx lift $ do outcome1 `hasEffect` clientEffect @@ -411,7 +411,7 @@ spec = let oneSecondsPastDeadline = addUTCTime 1 contestationDeadline someChainSlot = arbitrary `generateWith` 42 - stepTimePastDeadline = OnChainEvent $ Tick oneSecondsPastDeadline someChainSlot + stepTimePastDeadline = ChainInput $ Tick oneSecondsPastDeadline someChainSlot outcome2 <- step stepTimePastDeadline lift $ outcome2 `hasEffect` ClientEffect (ReadyToFanout testHeadId) @@ -422,12 +422,10 @@ spec = inOpenState' threeParties $ coordinatedHeadState{confirmedSnapshot = latestConfirmedSnapshot} deadline = arbitrary `generateWith` 42 - closeTxEvent = observationEvent $ OnCloseTx testHeadId 0 deadline params = fromMaybe (HeadParameters defaultContestationPeriod threeParties) (getHeadParameters s0) - contestTxEffect = chainEffect $ ContestTx testHeadId params latestConfirmedSnapshot - runEvents bobEnv ledger s0 $ do - o1 <- step closeTxEvent - lift $ o1 `hasEffect` contestTxEffect + runHeadLogic bobEnv ledger s0 $ do + o1 <- step $ observeTx (OnCloseTx testHeadId 0 deadline) + lift $ o1 `hasEffect` chainEffect (ContestTx testHeadId params latestConfirmedSnapshot) s1 <- getState lift $ s1 `shouldSatisfy` \case @@ -439,38 +437,35 @@ spec = latestConfirmedSnapshot = ConfirmedSnapshot snapshot2 (Crypto.aggregate []) s0 = inClosedState' threeParties latestConfirmedSnapshot deadline = arbitrary `generateWith` 42 - contestSnapshot1Event = observationEvent $ OnContestTx testHeadId 1 deadline params = fromMaybe (HeadParameters defaultContestationPeriod threeParties) (getHeadParameters s0) - contestTxEffect = chainEffect $ ContestTx testHeadId params latestConfirmedSnapshot - s1 = update bobEnv ledger s0 contestSnapshot1Event - s1 `hasEffect` contestTxEffect - assertEffects s1 + update bobEnv ledger s0 (observeTx $ OnContestTx testHeadId 1 deadline) + `hasEffect` chainEffect (ContestTx testHeadId params latestConfirmedSnapshot) it "ignores unrelated initTx" prop_ignoresUnrelatedOnInitTx prop "ignores abortTx of another head" $ \otherHeadId -> do - let abortOtherHead = observationEvent $ OnAbortTx{headId = otherHeadId} + let abortOtherHead = observeTx $ OnAbortTx{headId = otherHeadId} update bobEnv ledger (inInitialState threeParties) abortOtherHead `shouldBe` Error (NotOurHead{ourHeadId = testHeadId, otherHeadId}) prop "ignores collectComTx of another head" $ \otherHeadId -> do - let collectOtherHead = observationEvent $ OnCollectComTx{headId = otherHeadId} + let collectOtherHead = observeTx $ OnCollectComTx{headId = otherHeadId} update bobEnv ledger (inInitialState threeParties) collectOtherHead `shouldBe` Error (NotOurHead{ourHeadId = testHeadId, otherHeadId}) prop "ignores closeTx of another head" $ \otherHeadId snapshotNumber contestationDeadline -> do let openState = inOpenState threeParties - let closeOtherHead = observationEvent $ OnCloseTx{headId = otherHeadId, snapshotNumber, contestationDeadline} + let closeOtherHead = observeTx $ OnCloseTx{headId = otherHeadId, snapshotNumber, contestationDeadline} update bobEnv ledger openState closeOtherHead `shouldBe` Error (NotOurHead{ourHeadId = testHeadId, otherHeadId}) prop "ignores contestTx of another head" $ \otherHeadId snapshotNumber contestationDeadline -> do - let contestOtherHead = observationEvent $ OnContestTx{headId = otherHeadId, snapshotNumber, contestationDeadline} + let contestOtherHead = observeTx $ OnContestTx{headId = otherHeadId, snapshotNumber, contestationDeadline} update bobEnv ledger (inClosedState threeParties) contestOtherHead `shouldBe` Error (NotOurHead{ourHeadId = testHeadId, otherHeadId}) prop "ignores fanoutTx of another head" $ \otherHeadId -> do - let collectOtherHead = observationEvent $ OnFanoutTx{headId = otherHeadId} + let collectOtherHead = observeTx $ OnFanoutTx{headId = otherHeadId} update bobEnv ledger (inClosedState threeParties) collectOtherHead `shouldBe` Error (NotOurHead{ourHeadId = testHeadId, otherHeadId}) @@ -509,8 +504,8 @@ spec = st <- run $ - runEvents bobEnv ledger st0 $ do - step (NetworkEvent defaultTTL alice $ ReqSn 1 []) + runHeadLogic bobEnv ledger st0 $ do + step (NetworkInput defaultTTL alice $ ReqSn 1 []) getState assert $ case st of @@ -527,7 +522,7 @@ prop_ignoresUnrelatedOnInitTx :: Property prop_ignoresUnrelatedOnInitTx = forAll arbitrary $ \env -> forAll (genUnrelatedInit env) $ \unrelatedInit -> do - let outcome = update env simpleLedger inIdleState (observationEvent unrelatedInit) + let outcome = update env simpleLedger inIdleState (observeTx unrelatedInit) counterexample ("Outcome: " <> show outcome) $ outcome `hasEffectSatisfying` \case @@ -586,13 +581,6 @@ prop_ignoresUnrelatedOnInitTx = -- * Utilities -runEvents :: Monad m => Environment -> Ledger tx -> HeadState tx -> StateT (StepState tx) m a -> m a -runEvents env ledger headState = (`evalStateT` StepState{env, ledger, headState}) - --- --- Assertion utilities --- - -- | Create a chain effect with fixed chain state and slot. chainEffect :: PostChainTx SimpleTx -> Effect SimpleTx chainEffect postChainTx = @@ -600,9 +588,10 @@ chainEffect postChainTx = { postChainTx } -observeEventAtSlot :: Natural -> OnChainTx SimpleTx -> Event SimpleTx -observeEventAtSlot slot observedTx = - OnChainEvent +-- | Create an observation chain input with chain state at given slot. +observeTxAtSlot :: Natural -> OnChainTx SimpleTx -> Input SimpleTx +observeTxAtSlot slot observedTx = + ChainInput { chainEvent = Observation { observedTx @@ -610,16 +599,9 @@ observeEventAtSlot slot observedTx = } } --- | Create an observation event with fixed chain state and slot. -observationEvent :: OnChainTx SimpleTx -> Event SimpleTx -observationEvent observedTx = - OnChainEvent - { chainEvent = - Observation - { observedTx - , newChainState = SimpleChainState{slot = ChainSlot 0} - } - } +-- | Create an observation chain input with fixed chain state and slot. +observeTx :: OnChainTx SimpleTx -> Input SimpleTx +observeTx = observeTxAtSlot 0 inIdleState :: HeadState SimpleTx inIdleState = @@ -713,25 +695,25 @@ data StepState tx = StepState , ledger :: Ledger tx } --- | Retrieves the latest 'HeadState' from within 'runEvents'. +runHeadLogic :: Monad m => Environment -> Ledger tx -> HeadState tx -> StateT (StepState tx) m a -> m a +runHeadLogic env ledger headState = (`evalStateT` StepState{env, ledger, headState}) + +-- | Retrieves the latest 'HeadState' from within 'runHeadLogic'. getState :: MonadState (StepState tx) m => m (HeadState tx) getState = headState <$> get --- | Calls 'update' and 'aggregate' to drive the 'runEvents' monad forward. +-- | Calls 'update' and 'aggregate' to drive the 'runHeadLogic' monad forward. step :: (MonadState (StepState tx) m, IsChainState tx) => - Event tx -> + Input tx -> m (Outcome tx) -step event = do +step input = do StepState{headState, env, ledger} <- get - let outcome = update env ledger headState event + let outcome = update env ledger headState input let headState' = aggregateState headState outcome put StepState{env, ledger, headState = headState'} pure outcome -assertEffects :: (HasCallStack, IsChainState tx) => Outcome tx -> IO () -assertEffects outcome = hasEffectSatisfying outcome (const True) - hasEffect :: (HasCallStack, IsChainState tx) => Outcome tx -> Effect tx -> IO () hasEffect outcome effect = hasEffectSatisfying outcome (== effect) From f3a9f1f4b07f150f63875fc830b4098f1be3a207 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 11 Mar 2024 12:21:15 +0100 Subject: [PATCH 10/15] Remove log-filter executable This utility saw very minimal use and even in the we documentation we recommend using other off-the-shelf structured logging tools. --- docs/docs/getting-started/operating-hydra.md | 6 - hydra-cluster/exe/log-filter/Main.hs | 67 ----------- hydra-cluster/hydra-cluster.cabal | 15 --- hydra-cluster/src/Hydra/LogFilter.hs | 110 ------------------- 4 files changed, 198 deletions(-) delete mode 100644 hydra-cluster/exe/log-filter/Main.hs delete mode 100644 hydra-cluster/src/Hydra/LogFilter.hs diff --git a/docs/docs/getting-started/operating-hydra.md b/docs/docs/getting-started/operating-hydra.md index e2d5829f249..d786a337ee7 100644 --- a/docs/docs/getting-started/operating-hydra.md +++ b/docs/docs/getting-started/operating-hydra.md @@ -14,12 +14,6 @@ This page aims at helping Hydra users troubleshoot issues when running their own Following [ADR-9](/adr/9) design principles, the `hydra-node` provides [JSON](https://json.org) formatted logs on the `stdout` stream, one line per log item. The log items follow a [JSON schema](https://github.com/input-output-hk/hydra/blob/master/hydra-node/json-schemas/logs.yaml). This logging capability is kept voluntarily simple and non configurable in order to ease integration of Hydra logging into more general log analysis infrastructure, whether a custom ELK stack, third-party services, docker sidecars... -:::info - -There is an unpublished [log-filter](https://github.com/input-output-hk/hydra/blob/master/hydra-cluster/exe/log-filter/Main.hs) executable that one can attach to a hydra-node in order to trim down the volume of information in the log stream. This filter provides _some_ filtering features, namely removing transactions bodies and replacing them with transaction ids, but it's not general enough to warrant publication. Similar capabilities can be easily provided with tools like [jq](https://stedolan.github.io/jq/). - -::: - ## Monitoring When given `--monitoring-port PORT` argument, the hydra-node executable will expose a [Prometheus](https://prometheus.io) compatible HTTP `/metrics` endpoint on the given port to enable _scraping_ of exposed metrics. diff --git a/hydra-cluster/exe/log-filter/Main.hs b/hydra-cluster/exe/log-filter/Main.hs deleted file mode 100644 index 0751d2f7ccf..00000000000 --- a/hydra-cluster/exe/log-filter/Main.hs +++ /dev/null @@ -1,67 +0,0 @@ -module Main where - -import Data.Aeson (decode, encode) -import Data.ByteString.Char8 qualified as LBS -import Hydra.Ledger.Cardano (Tx) -import Hydra.LogFilter (tracePerformance) -import Hydra.Prelude -import Options.Applicative ( - Parser, - ParserInfo, - argument, - execParser, - fullDesc, - header, - help, - helper, - info, - metavar, - progDesc, - str, - ) -import System.IO.Error (isEOFError) - -newtype Options - = FileInput (Maybe FilePath) - -logFilterOptionsParser :: Parser Options -logFilterOptionsParser = - FileInput <$> optional (argument str (metavar "FILE" <> help "The name of file to filter")) - -logFilterOptions :: ParserInfo Options -logFilterOptions = - info - (logFilterOptionsParser <**> helper) - ( fullDesc - <> progDesc - ( toString $ - unlines - [ "Filter logs and compute events duration per transaction." - , "" - , "This program reads hydra-node JSON formatted log entries," - , "compute the duration (in micro-seconds), of each event and effect" - , "appearing in the logs, and then emit a new JSON object for each" - , "event/effect identified" - , "" - , "Without a FILE argument, it filters its standard input." - ] - ) - <> header "log-filter - Hydra-node logs filter" - ) - -main :: IO () -main = do - execParser logFilterOptions >>= \case - FileInput (Just logFile) -> withFile logFile ReadMode $ \hdl -> go mempty hdl - FileInput Nothing -> go mempty stdin - where - go pending hdl = - try (LBS.hGetLine hdl) >>= \case - Left err | isEOFError err -> pure () - Left err -> throwIO err - Right line -> do - case decode (LBS.fromStrict line) of - Nothing -> go pending hdl - Just e -> - let (evs, pending') = runState (tracePerformance @Tx e) pending - in mapM_ (LBS.hPutStrLn stdout . LBS.toStrict . encode) evs >> go pending' hdl diff --git a/hydra-cluster/hydra-cluster.cabal b/hydra-cluster/hydra-cluster.cabal index 16413680ea8..5c16e3b1045 100644 --- a/hydra-cluster/hydra-cluster.cabal +++ b/hydra-cluster/hydra-cluster.cabal @@ -73,7 +73,6 @@ library Hydra.Cluster.Scenarios Hydra.Cluster.Util Hydra.Generator - Hydra.LogFilter HydraNode Paths_hydra_cluster @@ -128,20 +127,6 @@ executable hydra-cluster build-tool-depends: hydra-node:hydra-node ghc-options: -threaded -rtsopts -executable log-filter - import: project-config - hs-source-dirs: exe/log-filter - main-is: Main.hs - ghc-options: -threaded -rtsopts - build-depends: - , aeson - , base >=4.7 && <5 - , bytestring - , hydra-cluster - , hydra-node - , hydra-prelude - , optparse-applicative - test-suite tests import: project-config hs-source-dirs: test diff --git a/hydra-cluster/src/Hydra/LogFilter.hs b/hydra-cluster/src/Hydra/LogFilter.hs deleted file mode 100644 index 8879f11f258..00000000000 --- a/hydra-cluster/src/Hydra/LogFilter.hs +++ /dev/null @@ -1,110 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DuplicateRecordFields #-} - --- | Utility functions to filter and simplify raw logs. -module Hydra.LogFilter where - -import Hydra.Prelude hiding (id) - -import Data.Map qualified as Map -import Hydra.API.ClientInput (ClientInput (NewTx)) -import Hydra.API.ServerOutput (ServerOutput (..)) -import Hydra.HeadLogic (Effect (..), Event (..)) -import Hydra.Ledger (IsTx (..)) -import Hydra.Logging (Envelope (..)) -import Hydra.Logging.Messages (HydraLog (Node)) -import Hydra.Network.Message (Message (..)) -import Hydra.Node (HydraNodeLog (..)) -import Hydra.Snapshot (Snapshot (..)) - --- | A trace of an event or effect for a specific transaction. -data Trace tx - = TraceEvent - { timestamp :: UTCTime - -- ^ The starting point in time for this event. - , txid :: TxIdType tx - -- ^ The transaction id this event applies to. - , us :: NominalDiffTime - -- ^ The duration of the event, expressed as a number of - -- seconds with a $10^12$ precision. - , event :: Text - -- ^ A string identifying this event. - } - | TraceEffect - { timestamp :: UTCTime - -- ^ The starting point in time for this effect. - , txid :: TxIdType tx - -- ^ The transaction id this effect applies to. - , us :: NominalDiffTime - -- ^ The duration of the effect, expressed as a number of - -- seconds with a $10^12$ precision. - , effect :: Text - -- ^ A string identifying this effect. - } - deriving stock (Generic) - -deriving stock instance IsTx tx => Eq (Trace tx) -deriving stock instance IsTx tx => Show (Trace tx) -deriving anyclass instance IsTx tx => ToJSON (Trace tx) - -data TraceKey - = EventKey Word64 - | EffectKey Word64 Word32 - deriving stock (Eq, Show, Ord) - --- | Compute duration of some `Event`s and `Effect`s from logs. --- --- This function is meant to be used with a `sequence` in order to traverse a stream of --- log entries and output list of `Trace` as begin/end pairs are found and identified. --- Each `Trace` emitted is tied to a specific transaction id which provides an easy way to --- identify in which part of their journey through Hydra transactions are spending time. --- --- It currently compute duration of: --- * `NewTx`, `ReqTx`, `ReqSn` events, --- * `ReqTx`, `TxValid` and `SnapshotConfirmed` effects. --- --- NOTE: Some potential improvements --- * Move this function to `Monitoring` and expose an histogram kind of metric for each type of event / effect --- * Handle more events, in particular the `AckSn` which is slightly problematic as it does not contain --- a direct reference to a transaction id so we would need to carry around a secondary map to keep --- track of this link. -tracePerformance :: IsTx tx => Envelope (HydraLog tx (Message tx)) -> State (Map TraceKey [Trace tx]) [Trace tx] -tracePerformance envelope = do - pending <- get - case envelope of - Envelope{timestamp, message = Node BeginEvent{eventId, event = ClientEvent (NewTx tx)}} -> do - put (Map.insert (EventKey eventId) [TraceEvent{event = "NewTx", timestamp, txid = txId tx, us = 0}] pending) - pure [] - Envelope{timestamp, message = Node BeginEvent{eventId, event = NetworkEvent{message = ReqTx{transaction}}}} -> do - put (Map.insert (EventKey eventId) [TraceEvent{event = "ReqTx", timestamp, txid = txId transaction, us = 0}] pending) - pure [] - Envelope{timestamp, message = Node BeginEvent{eventId, event = NetworkEvent{message = ReqSn{transactionIds}}}} -> do - put (Map.insert (EventKey eventId) (map (\txid -> TraceEvent{event = "ReqSn", timestamp, txid, us = 0}) transactionIds) pending) - pure [] - Envelope{timestamp, message = Node EndEvent{eventId}} -> - case Map.lookup (EventKey eventId) pending of - Just es -> do - put $ Map.delete (EventKey eventId) pending - pure $ map (computeDuration timestamp) es - Nothing -> pure [] - Envelope{timestamp, message = Node BeginEffect{eventId, effectId, effect = NetworkEffect ReqTx{transaction}}} -> do - put (Map.insert (EffectKey eventId effectId) [TraceEffect{effect = "ReqTx", timestamp, txid = txId transaction, us = 0}] pending) - pure [] - Envelope{timestamp, message = Node BeginEffect{eventId, effectId, effect = ClientEffect TxValid{transaction}}} -> do - put (Map.insert (EffectKey eventId effectId) [TraceEffect{effect = "TxValid", timestamp, txid = txId transaction, us = 0}] pending) - pure [] - Envelope{timestamp, message = Node BeginEffect{eventId, effectId, effect = ClientEffect SnapshotConfirmed{snapshot = Snapshot{confirmed}}}} -> do - put (Map.insert (EffectKey eventId effectId) (map (\txid -> TraceEffect{effect = "SnapshotConfirmed", timestamp, txid, us = 0}) confirmed) pending) - pure [] - Envelope{timestamp, message = Node EndEffect{eventId, effectId}} -> - case Map.lookup (EffectKey eventId effectId) pending of - Just es -> do - put $ Map.delete (EffectKey eventId effectId) pending - pure $ fmap (computeDuration timestamp) es - Nothing -> pure [] - _ -> pure [] - where - computeDuration :: UTCTime -> Trace tx -> Trace tx - computeDuration endTime = \case - e@TraceEvent{timestamp = startTime} -> e{us = 1_000_000 * diffUTCTime endTime startTime} - e@TraceEffect{timestamp = startTime} -> e{us = 1_000_000 * diffUTCTime endTime startTime} From 6cdc206a95eb56a3b8a8c3f6d19f0a9bb96bec31 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 11 Mar 2024 12:22:07 +0100 Subject: [PATCH 11/15] Update changelog --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 03f021d9bcb..9cfa86a6919 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -38,6 +38,10 @@ changes. - Add support for `Conway` in `hydra-chain-observer`. +- **BREAKING** Change to the `hydra-node` logs and removal of `log-filter` executable: + - We renamed the `Event` data types to `Input` and consequently log items like `BeginEvent` to `BeginInput`. + - In course of this, we also removed the `log-filter` executable as nobody is actively using it and we recommend using other off-the-shelf utilities to manipulate structured JSON logs (`jq` is already quite powerful). + ## [0.15.0] - 2024-01-18 - Tested with `cardano-node 8.7.3` and `cardano-cli 8.17.0.0`. From 45d093a92a5c9573e6607ce091322c3c5b5ce9e4 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 11 Mar 2024 12:27:59 +0100 Subject: [PATCH 12/15] Update logs.yaml with InvalidEvent -> UnhandledInput --- hydra-node/json-schemas/logs.yaml | 10 +++++----- hydra-node/test/Hydra/HeadLogicSpec.hs | 12 ++++++------ 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/hydra-node/json-schemas/logs.yaml b/hydra-node/json-schemas/logs.yaml index 5a5b80f24e1..4c872508171 100644 --- a/hydra-node/json-schemas/logs.yaml +++ b/hydra-node/json-schemas/logs.yaml @@ -910,18 +910,18 @@ definitions: $ref: "logs.yaml#/definitions/ParamMismatch" LogicError: oneOf: - - title: InvalidEvent + - title: UnhandledInput additionalProperties: false required: - tag - - invalidEvent + - input - currentHeadState properties: tag: type: string - enum: ["InvalidEvent"] - invalidEvent: - $ref: "logs.yaml#/definitions/Event" + enum: ["UnhandledInput"] + input: + $ref: "logs.yaml#/definitions/Input" currentHeadState: $ref: "logs.yaml#/definitions/HeadState" diff --git a/hydra-node/test/Hydra/HeadLogicSpec.hs b/hydra-node/test/Hydra/HeadLogicSpec.hs index eadf221f5aa..c7885fac83d 100644 --- a/hydra-node/test/Hydra/HeadLogicSpec.hs +++ b/hydra-node/test/Hydra/HeadLogicSpec.hs @@ -374,9 +374,9 @@ spec = step (observeTx $ OnCollectComTx testHeadId) getState - let invalidInput = observeTx OnAbortTx{headId = testHeadId} - update bobEnv ledger afterCollectCom invalidInput - `shouldBe` Error (UnhandledInput invalidInput afterCollectCom) + let unhandledInput = observeTx OnAbortTx{headId = testHeadId} + update bobEnv ledger afterCollectCom unhandledInput + `shouldBe` Error (UnhandledInput unhandledInput afterCollectCom) it "cannot observe collect com after abort" $ do afterAbort <- @@ -384,9 +384,9 @@ spec = step (observeTx OnAbortTx{headId = testHeadId}) getState - let invalidInput = observeTx (OnCollectComTx testHeadId) - update bobEnv ledger afterAbort invalidInput - `shouldBe` Error (UnhandledInput invalidInput afterAbort) + let unhandledInput = observeTx (OnCollectComTx testHeadId) + update bobEnv ledger afterAbort unhandledInput + `shouldBe` Error (UnhandledInput unhandledInput afterAbort) it "notifies user on head closing and when passing the contestation deadline" $ do let s0 = inOpenState threeParties From d65021de0531b20146d022573d3bbfe7efa740bd Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 11 Mar 2024 12:37:24 +0100 Subject: [PATCH 13/15] Update logs.yaml with renamed Event -> Input --- hydra-node/json-schemas/logs.yaml | 135 ++++++++++++------------------ 1 file changed, 53 insertions(+), 82 deletions(-) diff --git a/hydra-node/json-schemas/logs.yaml b/hydra-node/json-schemas/logs.yaml index 4c872508171..e9bcf7eb59e 100644 --- a/hydra-node/json-schemas/logs.yaml +++ b/hydra-node/json-schemas/logs.yaml @@ -59,8 +59,7 @@ properties: - tag - node description: >- - A log entry denoting events and effects processed by the Node as part - of the Head protocol. + A log entry produced by the main loop in the node. properties: tag: type: string @@ -748,53 +747,51 @@ definitions: Node: oneOf: - # FIXME: Update logs schema - - title: BeginEvent + - title: BeginInput description: >- - Head has started processing an event drawn from some pool or queue of - events to process. + Head has started processing an input from the chain, network, or client. type: object additionalProperties: false required: - tag - by - - eventId - - event + - inputId + - input properties: tag: type: string - enum: ["BeginEvent"] + enum: ["BeginInput"] by: "$ref": "api.yaml#/components/schemas/Party" description: >- The Party emitting the log entry. - eventId: + inputId: type: integer minimum: 0 description: >- - Provides a unique, incremental, number identifying that event within - the stream of events from this node. This is useful to correlate with - `EndEvent`. - event: - "$ref": "logs.yaml#/definitions/Event" - - title: EndEvent + Provides a unique, incremental, number identifying that input + within the stream of inputs. This is useful to correlate with + `EndInput`. + input: + "$ref": "logs.yaml#/definitions/Input" + - title: EndInput description: >- - Head has succesfully finished processing an event. + Head has finished processing an input. type: object additionalProperties: false required: - tag - by - - eventId + - inputId properties: tag: type: string - enum: ["EndEvent"] + enum: ["EndInput"] by: "$ref": "api.yaml#/components/schemas/Party" description: >- The Party emitting the log entry. - eventId: + inputId: type: integer minimum: 0 - title: BeginEffect @@ -806,7 +803,7 @@ definitions: required: - tag - by - - eventId + - inputId - effectId - effect properties: @@ -817,20 +814,22 @@ definitions: "$ref": "api.yaml#/components/schemas/Party" description: >- The Party emitting the log entry. - eventId: + inputId: type: integer minimum: 0 description: >- - Provides a unique, incremental, number identifying which event within - the stream of events from this node this effect is part of. This number - can be used to correlate `EndEffect` entries. + Provides a unique, incremental, number identifying which input + within the stream of inputs from this node this effect is a + consequence of. This number can be used to correlate `EndEffect` + entries. effectId: type: integer minimum: 0 description: >- - Provides a unique, monotonically increasing index for this effect within - the span of a specific `eventId`. This number along with the `eventId` - field is used to correlate the beginning and end of an effect. + Provides a unique, monotonically increasing index for this effect + within the span of a specific `inputId`. This number along with + the `inputId` field is used to correlate the beginning and end of + an effect. effect: $ref: "logs.yaml#/definitions/Effect" - title: EndEffect @@ -842,7 +841,7 @@ definitions: required: - tag - by - - eventId + - inputId - effectId properties: tag: @@ -852,7 +851,7 @@ definitions: "$ref": "api.yaml#/components/schemas/Party" description: >- The Party emitting the log entry. - eventId: + inputId: type: integer minimum: 0 effectId: @@ -860,7 +859,7 @@ definitions: minimum: 0 - title: LogicOutcome description: >- - An outcome produced is a decision the node took after processing an input event. + An outcome produced is a decision the node took after processing an input. type: object additionalProperties: false required: @@ -1524,27 +1523,26 @@ definitions: items: $ref: "api.yaml#/components/schemas/Signature" - # FIXME: update schema - Event: + Input: description: >- - Events (with Effects) are the atomic elements of the Hydra Head protocol - which is basically a state-machine consuming events and producing effects. - Events can come from different sources representing the various components - a Head needs to interact with: Clients, other peers through the Network, - main Chain. + Inputs (with Effects) are the atomic elements of the Hydra Head protocol + which is basically a state-machine consuming inputs and producing effects. + Inputs can come from different sources representing the various components + a Head needs to interact with: Clients via the API, other peers through + the Network, and the underlying Chain. oneOf: - - title: ClientEvent + - title: ClientInput type: object additionalProperties: false required: - tag - clientInput description: >- - An event representing some input from a client. + Input received from clients via the API. properties: tag: type: string - enum: ["ClientEvent"] + enum: ["ClientInput"] clientInput: oneOf: - $ref: "api.yaml#/components/messages/Init/payload" @@ -1555,7 +1553,7 @@ definitions: - $ref: "api.yaml#/components/messages/Contest/payload" - $ref: "api.yaml#/components/messages/Fanout/payload" - - title: NetworkEvent + - title: NetworkInput type: object additionalProperties: false required: @@ -1564,32 +1562,32 @@ definitions: - message - party description: >- - An event representing some message received from peers in the network. + Input representing some message received from peers on the network. properties: tag: type: string - enum: ["NetworkEvent"] + enum: ["NetworkInput"] message: $ref: "logs.yaml#/definitions/Message" ttl: type: number party: $ref: "api.yaml#/components/schemas/Party" - - title: OnChainEvent + - title: ChainInput type: object additionalProperties: false required: - tag - chainEvent description: >- - An event representing the confirmation that some transaction part of the - Head protocol has been confirmed on the main chain. + Input representing an observation made on the main chain (or witnessed + rollbacks, ticks and errors). properties: tag: type: string - enum: ["OnChainEvent"] + enum: ["ChainInput"] chainEvent: - $ref: "logs.yaml#/definitions/OnChainEvent" + $ref: "logs.yaml#/definitions/ChainEvent" Message: description: >- @@ -1653,7 +1651,7 @@ definitions: Signature from given party of the snapshot. The bytes representing the signature are hex-encoded. - OnChainEvent: + ChainEvent: oneOf: - title: Observation type: object @@ -1710,7 +1708,7 @@ definitions: - postChainTx - postTxError description: >- - Event emitted when posting a transaction on the main chain failed. + Posting a transaction on the main chain failed. properties: tag: type: string @@ -1850,7 +1848,7 @@ definitions: Effect: description: >- - Effects are the outcome of Head protocol processing Events. Each Effect + Effects are the outcome of Head protocol processing inputs. Each effect represents a message that needs to be sent somewhere, either to clients for notification purpose, to other heads, or to the chain as part of the protocol. @@ -1893,7 +1891,7 @@ definitions: - postChainTx description: >- An effect representing some transaction must be posted on-chain. Note - that incoming transactions are represented by OnChainEvent which can be + that incoming transactions are represented by ChainEvent which can be different from outgoing transactions. properties: tag: @@ -1901,37 +1899,10 @@ definitions: enum: ["OnChainEffect"] postChainTx: $ref: "api.yaml#/components/schemas/PostChainTx" - - title: Delay - type: object - additionalProperties: false - required: - - tag - - delay - - reason - - event - description: >- - A special effect requesting the given event to be delayed from - processing for some amount of time. Delays can happen in the protocol - because messages can be received out-of-order due to the asynchronous - nature of the network, hence an otherwise invalid event could become - invalid in the future. - properties: - tag: - type: string - enum: ["Delay"] - delay: - type: number - minimum: 0 - description: >- - The length of the delay, in seconds. - reason: - $ref: "logs.yaml#/definitions/WaitReason" - event: - $ref: "logs.yaml#/definitions/Event" Outcome: description: >- - The decision taken by the node logic after processing an Event. + The decision taken by the node logic after processing an input. oneOf: - title: Continue type: object @@ -1984,7 +1955,7 @@ definitions: - tag - error description: >- - Processing an input event resulted in an error. + Processing an input resulted in an error. properties: tag: type: string From 4408b4dccd3d27713f7f18a50c06522627b45443 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 11 Mar 2024 12:42:32 +0100 Subject: [PATCH 14/15] Rename prometheus metric hydra_head_events -> hydra_head_inputs --- CHANGELOG.md | 3 ++- docs/docs/getting-started/operating-hydra.md | 4 ++-- hydra-cluster/test/Test/EndToEndSpec.hs | 2 +- hydra-node/src/Hydra/Logging/Monitoring.hs | 4 ++-- 4 files changed, 7 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9cfa86a6919..7942cbcea67 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -38,9 +38,10 @@ changes. - Add support for `Conway` in `hydra-chain-observer`. -- **BREAKING** Change to the `hydra-node` logs and removal of `log-filter` executable: +- **BREAKING** Change to the `hydra-node` logs, monitoring and removal of `log-filter` executable: - We renamed the `Event` data types to `Input` and consequently log items like `BeginEvent` to `BeginInput`. - In course of this, we also removed the `log-filter` executable as nobody is actively using it and we recommend using other off-the-shelf utilities to manipulate structured JSON logs (`jq` is already quite powerful). + - Renamed prometheus metric `hydra_head_events -> hydra_head_inputs`. ## [0.15.0] - 2024-01-18 diff --git a/docs/docs/getting-started/operating-hydra.md b/docs/docs/getting-started/operating-hydra.md index d786a337ee7..afb5a9b3819 100644 --- a/docs/docs/getting-started/operating-hydra.md +++ b/docs/docs/getting-started/operating-hydra.md @@ -31,8 +31,8 @@ will output ``` # TYPE hydra_head_confirmed_tx counter hydra_head_confirmed_tx 0 -# TYPE hydra_head_events counter -hydra_head_events 50467 +# TYPE hydra_head_inputs counter +hydra_head_inputs 50467 # TYPE hydra_head_requested_tx counter hydra_head_requested_tx 0 # TYPE hydra_head_tx_confirmation_time_ms histogram diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 5819b0318bb..d1e589fffe3 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -479,7 +479,7 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do send n1 $ input "Init" [] void $ waitForAllMatch 3 [n1] $ headIsInitializingWith (Set.fromList [alice, bob, carol]) metrics <- getMetrics n1 - metrics `shouldSatisfy` ("hydra_head_events" `BS.isInfixOf`) + metrics `shouldSatisfy` ("hydra_head_inputs" `BS.isInfixOf`) describe "hydra-node executable" $ do it "logs its command line arguments" $ \tracer -> do diff --git a/hydra-node/src/Hydra/Logging/Monitoring.hs b/hydra-node/src/Hydra/Logging/Monitoring.hs index a4005cbd434..a1056f1d8cb 100644 --- a/hydra-node/src/Hydra/Logging/Monitoring.hs +++ b/hydra-node/src/Hydra/Logging/Monitoring.hs @@ -75,7 +75,7 @@ data MetricDefinition where -- | All custom 'MetricDefinition's for Hydra allMetrics :: [MetricDefinition] allMetrics = - [ MetricDefinition (Name "hydra_head_events") CounterMetric $ flip registerCounter mempty + [ MetricDefinition (Name "hydra_head_inputs") CounterMetric $ flip registerCounter mempty , MetricDefinition (Name "hydra_head_requested_tx") CounterMetric $ flip registerCounter mempty , MetricDefinition (Name "hydra_head_confirmed_tx") CounterMetric $ flip registerCounter mempty , MetricDefinition (Name "hydra_head_tx_confirmation_time_ms") HistogramMetric $ \n -> registerHistogram n mempty [5, 10, 50, 100, 1000] @@ -108,7 +108,7 @@ monitor transactionsMap metricsMap = \case Nothing -> pure () tickN "hydra_head_confirmed_tx" (length $ confirmed snapshot) (Node (EndInput _ _)) -> - tick "hydra_head_events" + tick "hydra_head_inputs" _ -> pure () where tick metricName = From d68c00078a2853771e3e665ab09aebc591dc58e0 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 11 Mar 2024 13:01:10 +0100 Subject: [PATCH 15/15] Remove last mentions of Event in docs & spec --- docs/core-concepts/architecture/index.md | 7 +------ hydra-node/test/Hydra/Node/InputQueueSpec.hs | 6 +++--- spec/offchain.tex | 20 ++++++++++---------- 3 files changed, 14 insertions(+), 19 deletions(-) diff --git a/docs/core-concepts/architecture/index.md b/docs/core-concepts/architecture/index.md index c616d7c4e91..8f63aeec154 100644 --- a/docs/core-concepts/architecture/index.md +++ b/docs/core-concepts/architecture/index.md @@ -43,12 +43,7 @@ The Hydra node maintains an internal wallet using the Cardano signing key provid ### Head Logic -This is the component which is the heart of the Hydra node, implementing the protocol's _input-output state machine_. It is structured around the concepts of `Event`s and `Effect`s: - -- `Event`s are _inputs_ to the state machine from various parts of the node that can change the state and they ... -- ... produce `Effect`s which are _outputs_ from the state machine interpreted by other components to produce "side-effects". - -The _Head Logic_ of course maintains the internal state of the head and persists it when it changes. This state consists in both the content of the Head itself (eg. current Ledger, transactions pending) _and_ the data from the Layer 1 that's needed to observe and trigger on-chain transitions. +This is the component which is the heart of the Hydra node, implementing the protocol's _state machine_. It is structured around the concepts of `Input`s and `Effect`s: `Input`s from the outside world are interpreted against the current state, this may result in internal `Event`s, which are aggregated into an updated state, and `Effect`s which result in "side-effects" on the outside world. The state available to the _Head Logic_ consists of both, the content of the Head itself (eg. current Ledger, transactions pending) _and_ the data from the Layer 1 that's needed to observe and trigger on-chain transitions. ### Hydra Smart Contracts diff --git a/hydra-node/test/Hydra/Node/InputQueueSpec.hs b/hydra-node/test/Hydra/Node/InputQueueSpec.hs index 81c1977732e..ada9f5aae87 100644 --- a/hydra-node/test/Hydra/Node/InputQueueSpec.hs +++ b/hydra-node/test/Hydra/Node/InputQueueSpec.hs @@ -11,13 +11,13 @@ import Test.QuickCheck (NonEmptyList (NonEmpty), Property, counterexample) spec :: Spec spec = - prop "adds sequential id to all events enqueued" prop_identify_enqueued_events + prop "adds sequential id to all enqueued items" prop_identify_enqueued_items newtype DummyInput = DummyInput Int deriving newtype (Eq, Show, Arbitrary) -prop_identify_enqueued_events :: NonEmptyList Int -> Property -prop_identify_enqueued_events (NonEmpty inputs) = +prop_identify_enqueued_items :: NonEmptyList Int -> Property +prop_identify_enqueued_items (NonEmpty inputs) = let test :: IOSim s [Word64] test = do q <- createInputQueue diff --git a/spec/offchain.tex b/spec/offchain.tex index 7860911430e..d2ebcfd372e 100644 --- a/spec/offchain.tex +++ b/spec/offchain.tex @@ -8,7 +8,7 @@ \section{Off-Chain Protocol}\label{sec:offchain} defining how the protocol behaves off-chain and notably the relationship between on- and off-chain semantics. Participants of the protocol are also called Hydra head members, parties or simply protocol actors. The protocol is specified as a -reactive system that processes three kinds of events: +reactive system that processes three kinds of inputs: \begin{enumerate} \item On-chain protocol transactions as introduced in Section~\ref{sec:on-chain}, which are posted to the mainchain and can be @@ -51,17 +51,17 @@ \subsection{Assumptions} % multiple Hydra heads might exist on the same blockchain, it is vital % that they do not interfere and the specification will take special care % to ensure this. - \item All events are processed to completion, i.e.\ run-to-completion semantics + \item All inputs are processed to completion, i.e.\ run-to-completion semantics and no preemption. - \item Events are deduplicated. That is, any two identical events must not lead + \item Inputs are deduplicated. That is, any two identical inputs must not lead to multiple invocations of the handling semantics. - \item Given the specification, events may pile up forever and implementations + \item Given the specification, inputs may pile up forever and implementations need to consider these situations (i.e.\ potential for DoS). A valid reaction - to this would be to just drop these events. Note that, from a security standpoint, + to this would be to just drop these inputs. Note that, from a security standpoint, these situations are identical to a non-collaborative peer and closing the head is also a possible reaction. \item The lifecycle of a Hydra head on-chain does not cross (hard fork) - protocol update boundaries. Note that these events are announced in + protocol update boundaries. Note that these inputs are announced in advance hence it should be possible for implementations to react in such a way as to expedite closing of the head before such a protocol update. This further assumes that the contestation period parameter is picked @@ -71,9 +71,9 @@ \subsection{Assumptions} \subsection{Notation} \todo{missing:, apply tx} \begin{itemize} - \item $\KwOn~event$ specifies how the protocol reacts on a given $event$. + \item $\KwOn~event$ specifies how the protocol reacts on a given input $event$. Further information may be available from the constituents of $event$ - and origin of the event. + and origin of the input. \item $\Req~p$ means that boolean expression $p \in \tyBool$ must be satisfied for the further execution of a routine, while discontinued on $\neg p$. A conservative protocol actor could interpret this as a reason to close @@ -210,7 +210,7 @@ \subsubsection{Processing transactions off-chain} \subsubsection{Closing the head} \dparagraph{$\hpClose$.}\quad In order to close a head, a client issues the -$\hpClose$ event which uses the latest confirmed snapshot $\barmU$ to create +$\hpClose$ input which uses the latest confirmed snapshot $\barmU$ to create \begin{itemize} \item the new $\eta$-state $\eta'$ from the last confirmed UTxO set and snapshot number, and @@ -232,7 +232,7 @@ \subsection{Rollbacks and protocol changes}\label{sec:rollbacks} % FIXME: Need to address this fully \todo{Discuss protocol updates as well, also in light of rollbacks} -The overall life-cycle of the Head protocol is driven by on-chain events (see +The overall life-cycle of the Head protocol is driven by on-chain inputs (see introduction of Section~\ref{sec:offchain}) which stem from observing transactions on the mainchain. Most blockchains, however, do only provide \emph{eventual} consistency. The consensus algorithm ensures a consistent view