From 66212a20a91a330e22a1f24cac4f70afabf4ac44 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Tue, 10 Sep 2024 16:36:45 +0200 Subject: [PATCH] Introduce incrementUTxo field in the ReqSn and stub out onOpenChainDepositTx Signed-off-by: Sasha Bogicevic --- hydra-node/exe/hydra-net/Main.hs | 2 +- hydra-node/src/Hydra/HeadLogic.hs | 41 ++++++++++++--- hydra-node/src/Hydra/Network/Message.hs | 5 +- .../test/Hydra/HeadLogicSnapshotSpec.hs | 12 ++--- hydra-node/test/Hydra/HeadLogicSpec.hs | 50 +++++++++---------- hydra-node/test/Hydra/NodeSpec.hs | 10 ++-- 6 files changed, 73 insertions(+), 47 deletions(-) diff --git a/hydra-node/exe/hydra-net/Main.hs b/hydra-node/exe/hydra-net/Main.hs index 04ca6d572d3..b920cd5b202 100644 --- a/hydra-node/exe/hydra-net/Main.hs +++ b/hydra-node/exe/hydra-net/Main.hs @@ -225,7 +225,7 @@ injectReqSn peer snapshotNumber hydraKeyFile fakeHydraKeyFile = do client tracer sk party = Idle $ do let snapshotVersion = 0 - let msg = Data "2" (ReqSn @Tx snapshotVersion snapshotNumber [] Nothing) + let msg = Data "2" (ReqSn @Tx snapshotVersion snapshotNumber [] Nothing Nothing) let signed = Signed msg (sign sk msg) party traceWith tracer $ Injecting signed pure $ SendMsg signed (pure $ SendDone (pure ())) diff --git a/hydra-node/src/Hydra/HeadLogic.hs b/hydra-node/src/Hydra/HeadLogic.hs index 346512e9fc1..031bfe0a1bb 100644 --- a/hydra-node/src/Hydra/HeadLogic.hs +++ b/hydra-node/src/Hydra/HeadLogic.hs @@ -357,7 +357,7 @@ onOpenNetworkReqTx env ledger st ttl tx = -- spec. Do we really need to store that we have -- requested a snapshot? If yes, should update spec. <> newState SnapshotRequestDecided{snapshotNumber = nextSn} - <> cause (NetworkEffect $ ReqSn version nextSn (txId <$> localTxs') decommitTx) + <> cause (NetworkEffect $ ReqSn version nextSn (txId <$> localTxs') decommitTx Nothing) else outcome Environment{party} = env @@ -406,8 +406,9 @@ onOpenNetworkReqSn :: [TxIdType tx] -> -- | Optional decommit transaction of removing funds from the head. Maybe tx -> + Maybe (UTxOType tx) -> Outcome tx -onOpenNetworkReqSn env ledger st otherParty sv sn requestedTxIds mDecommitTx = +onOpenNetworkReqSn env ledger st otherParty sv sn requestedTxIds mDecommitTx mIncrementUTxO = -- Spec: require s = ŝ + 1 ∧ leader(s) = j requireReqSn $ -- Spec: wait ŝ = ̅S.s @@ -652,7 +653,7 @@ onOpenNetworkAckSn Environment{party} openState otherParty snapshotSignature sn then outcome <> newState SnapshotRequestDecided{snapshotNumber = nextSn} - <> cause (NetworkEffect $ ReqSn version nextSn (txId <$> localTxs) decommitTx) + <> cause (NetworkEffect $ ReqSn version nextSn (txId <$> localTxs) decommitTx Nothing) else outcome maybePostDecrementTx snapshot@Snapshot{utxoToDecommit} signatures outcome = @@ -815,7 +816,7 @@ onOpenNetworkReqDec env ledger ttl openState decommitTx = maybeRequestSnapshot = if not snapshotInFlight && isLeader parameters party nextSn - then cause (NetworkEffect (ReqSn version nextSn (txId <$> localTxs) (Just decommitTx))) + then cause (NetworkEffect (ReqSn version nextSn (txId <$> localTxs) (Just decommitTx) Nothing)) else noop Environment{party} = env @@ -850,10 +851,34 @@ onOpenNetworkReqDec env ledger ttl openState decommitTx = onOpenChainDepositTx :: IsTx tx => + Environment -> OpenState tx -> UTxOType tx -> Outcome tx -onOpenChainDepositTx openState utxo = undefined +onOpenChainDepositTx env st utxo = + if not snapshotInFlight && isLeader parameters party nextSn + then -- TODO: shall we include deposit tx in the ReqSn? + cause (NetworkEffect $ ReqSn version nextSn (txId <$> localTxs) Nothing (Just utxo)) + else noop + where + -- TODO: implement me! + waitOnResolvedDecrement cont = undefined + + nextSn = confirmedSn + 1 + + Environment{party} = env + + CoordinatedHeadState{localTxs, localUTxO, confirmedSnapshot, seenSnapshot, decommitTx, version} = coordinatedHeadState + + Snapshot{number = confirmedSn} = getSnapshot confirmedSnapshot + + OpenState{coordinatedHeadState, headId, currentSlot, parameters} = st + + snapshotInFlight = case seenSnapshot of + NoSeenSnapshot -> False + LastSeenSnapshot{} -> False + RequestedSnapshot{} -> True + SeenSnapshot{} -> True -- | Observe a decrement transaction. If the outputs match the ones of the -- pending decommit tx, then we consider the decommit finalized, and remove the @@ -1112,8 +1137,8 @@ update env ledger st ev = case (st, ev) of onOpenClientNewTx tx (Open openState, NetworkInput ttl (ReceivedMessage{msg = ReqTx tx})) -> onOpenNetworkReqTx env ledger openState ttl tx - (Open openState, NetworkInput _ (ReceivedMessage{sender, msg = ReqSn sv sn txIds decommitTx})) -> - onOpenNetworkReqSn env ledger openState sender sv sn txIds decommitTx + (Open openState, NetworkInput _ (ReceivedMessage{sender, msg = ReqSn sv sn txIds decommitTx incrementUTxO})) -> + onOpenNetworkReqSn env ledger openState sender sv sn txIds decommitTx incrementUTxO (Open openState, NetworkInput _ (ReceivedMessage{sender, msg = AckSn snapshotSignature sn})) -> onOpenNetworkAckSn env openState sender snapshotSignature sn ( Open openState@OpenState{headId = ourHeadId} @@ -1136,7 +1161,7 @@ update env ledger st ev = case (st, ev) of (Open openState, NetworkInput ttl (ReceivedMessage{msg = ReqDec{transaction}})) -> onOpenNetworkReqDec env ledger ttl openState transaction (Open openState@OpenState{headId = ourHeadId}, ChainInput Observation{observedTx = OnDepositTx{headId, utxo}}) - | ourHeadId == headId -> onOpenChainDepositTx openState utxo + | ourHeadId == headId -> onOpenChainDepositTx env openState utxo (Open openState@OpenState{headId = ourHeadId}, ChainInput Observation{observedTx = OnDecrementTx{headId, newVersion, distributedOutputs}}) -- TODO: What happens if observed decrement tx get's rolled back? | ourHeadId == headId -> diff --git a/hydra-node/src/Hydra/Network/Message.hs b/hydra-node/src/Hydra/Network/Message.hs index 161f7eeee6c..6e7e26628ac 100644 --- a/hydra-node/src/Hydra/Network/Message.hs +++ b/hydra-node/src/Hydra/Network/Message.hs @@ -78,6 +78,7 @@ data Message tx , snapshotNumber :: SnapshotNumber , transactionIds :: [TxIdType tx] , decommitTx :: Maybe tx + , incrementUTxO :: Maybe (UTxOType tx) } | AckSn { signed :: Signature (Snapshot tx) @@ -97,7 +98,7 @@ instance ArbitraryIsTx tx => Arbitrary (Message tx) where instance (ToCBOR tx, ToCBOR (UTxOType tx), ToCBOR (TxIdType tx)) => ToCBOR (Message tx) where toCBOR = \case ReqTx tx -> toCBOR ("ReqTx" :: Text) <> toCBOR tx - ReqSn sv sn txs decommitTx -> toCBOR ("ReqSn" :: Text) <> toCBOR sv <> toCBOR sn <> toCBOR txs <> toCBOR decommitTx + ReqSn sv sn txs decommitTx incrementUTxO -> toCBOR ("ReqSn" :: Text) <> toCBOR sv <> toCBOR sn <> toCBOR txs <> toCBOR decommitTx <> toCBOR incrementUTxO AckSn sig sn -> toCBOR ("AckSn" :: Text) <> toCBOR sig <> toCBOR sn ReqDec utxo -> toCBOR ("ReqDec" :: Text) <> toCBOR utxo @@ -105,7 +106,7 @@ instance (FromCBOR tx, FromCBOR (UTxOType tx), FromCBOR (TxIdType tx)) => FromCB fromCBOR = fromCBOR >>= \case ("ReqTx" :: Text) -> ReqTx <$> fromCBOR - "ReqSn" -> ReqSn <$> fromCBOR <*> fromCBOR <*> fromCBOR <*> fromCBOR + "ReqSn" -> ReqSn <$> fromCBOR <*> fromCBOR <*> fromCBOR <*> fromCBOR <*> fromCBOR "AckSn" -> AckSn <$> fromCBOR <*> fromCBOR "ReqDec" -> ReqDec <$> fromCBOR msg -> fail $ show msg <> " is not a proper CBOR-encoded Message" diff --git a/hydra-node/test/Hydra/HeadLogicSnapshotSpec.hs b/hydra-node/test/Hydra/HeadLogicSnapshotSpec.hs index bbf77cb7347..971017aa098 100644 --- a/hydra-node/test/Hydra/HeadLogicSnapshotSpec.hs +++ b/hydra-node/test/Hydra/HeadLogicSnapshotSpec.hs @@ -85,7 +85,7 @@ spec = do outcome = update (envFor aliceSk) simpleLedger (inOpenState' [alice, bob] coordinatedHeadState) $ receiveMessage $ ReqTx tx outcome - `hasEffect` NetworkEffect (ReqSn 0 1 [txId tx] Nothing) + `hasEffect` NetworkEffect (ReqSn 0 1 [txId tx] Nothing Nothing) it "does NOT send ReqSn when we are NOT the leader even if no snapshot in flight" $ do let tx = aValidTx 1 @@ -124,7 +124,7 @@ spec = do it "sends ReqSn when leader and there are seen transactions" $ do headState <- runHeadLogic bobEnv simpleLedger (inOpenState threeParties) $ do - step (receiveMessage $ ReqSn 0 1 [] Nothing) + step (receiveMessage $ ReqSn 0 1 [] Nothing Nothing) step (receiveMessageFrom carol $ ReqTx $ aValidTx 1) step (ackFrom carolSk carol) step (ackFrom aliceSk alice) @@ -135,7 +135,7 @@ spec = do it "does NOT send ReqSn when we are the leader but there are NO seen transactions" $ do headState <- runHeadLogic bobEnv simpleLedger (inOpenState threeParties) $ do - step (receiveMessage $ ReqSn 0 1 [] Nothing) + step (receiveMessage $ ReqSn 0 1 [] Nothing Nothing) step (ackFrom carolSk carol) step (ackFrom aliceSk alice) getState @@ -148,7 +148,7 @@ spec = do notLeaderEnv = envFor carolSk let initiateSigningASnapshot actor = - step (receiveMessageFrom actor $ ReqSn 0 1 [] Nothing) + step (receiveMessageFrom actor $ ReqSn 0 1 [] Nothing Nothing) newTxBeforeSnapshotAcknowledged = step (receiveMessageFrom carol $ ReqTx $ aValidTx 1) @@ -164,7 +164,7 @@ spec = do it "updates seenSnapshot state when sending ReqSn" $ do headState <- runHeadLogic bobEnv simpleLedger (inOpenState threeParties) $ do - step (receiveMessage $ ReqSn 0 1 [] Nothing) + step (receiveMessage $ ReqSn 0 1 [] Nothing Nothing) step (receiveMessageFrom carol $ ReqTx $ aValidTx 1) step (ackFrom carolSk carol) step (ackFrom aliceSk alice) @@ -212,7 +212,7 @@ prop_singleMemberHeadAlwaysSnapshotOnReqTx sn = monadicST $ do Snapshot{number = confirmedSn} = getSnapshot sn nextSn = confirmedSn + 1 pure $ - outcome `hasEffect` NetworkEffect (ReqSn version nextSn [txId tx] Nothing) + outcome `hasEffect` NetworkEffect (ReqSn version nextSn [txId tx] Nothing Nothing) & counterexample (show outcome) prop_thereIsAlwaysALeader :: Property diff --git a/hydra-node/test/Hydra/HeadLogicSpec.hs b/hydra-node/test/Hydra/HeadLogicSpec.hs index 96615cdc30a..fd80bbb3ebe 100644 --- a/hydra-node/test/Hydra/HeadLogicSpec.hs +++ b/hydra-node/test/Hydra/HeadLogicSpec.hs @@ -120,7 +120,7 @@ spec = `assertWait` WaitOnNotApplicableTx (ValidationError "cannot apply transaction") it "confirms snapshot given it receives AckSn from all parties" $ do - let reqSn = receiveMessage $ ReqSn 0 1 [] Nothing + let reqSn = receiveMessage $ ReqSn 0 1 [] Nothing Nothing snapshot1 = Snapshot testHeadId 0 1 [] mempty Nothing ackFrom sk vk = receiveMessageFrom vk $ AckSn (sign sk snapshot1) 1 snapshotInProgress <- runHeadLogic bobEnv ledger (inOpenState threeParties) $ do @@ -151,7 +151,7 @@ spec = step $ receiveMessage $ ReqTx tx1 step $ receiveMessage $ ReqTx tx2 step $ receiveMessage $ ReqTx tx3 - step $ receiveMessage $ ReqSn 0 1 [1] Nothing + step $ receiveMessage $ ReqSn 0 1 [1] Nothing Nothing getState case s of @@ -261,7 +261,7 @@ spec = let s1 = update aliceEnv ledger s0 reqDecEvent - let reqSn = ReqSn{snapshotVersion = 0, snapshotNumber = 1, transactionIds = [], decommitTx = Just decommitTx'} + let reqSn = ReqSn{snapshotVersion = 0, snapshotNumber = 1, transactionIds = [], decommitTx = Just decommitTx', incrementUTxO = Nothing} s1 `hasEffect` NetworkEffect reqSn describe "Tracks Transaction Ids" $ do @@ -280,7 +280,7 @@ spec = it "removes transactions in allTxs given it receives a ReqSn" $ do let s0 = inOpenState threeParties t1 = SimpleTx 1 mempty (utxoRef 1) - reqSn = receiveMessage $ ReqSn 0 1 [1] Nothing + reqSn = receiveMessage $ ReqSn 0 1 [1] Nothing Nothing s1 <- runHeadLogic bobEnv ledger s0 $ do step $ receiveMessage $ ReqTx t1 @@ -294,7 +294,7 @@ 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 = receiveMessage $ ReqSn 0 1 [1] Nothing + reqSn = receiveMessage $ ReqSn 0 1 [1] Nothing Nothing snapshot1 = testSnapshot 1 0 [1] (utxoRefs [1]) ackFrom sk vk = receiveMessageFrom vk $ AckSn (sign sk snapshot1) 1 @@ -314,7 +314,7 @@ spec = _ -> False it "rejects last AckSn if one signature was from a different snapshot" $ do - let reqSn = receiveMessage $ ReqSn 0 1 [] Nothing + let reqSn = receiveMessage $ ReqSn 0 1 [] Nothing Nothing snapshot = testSnapshot 1 0 [] mempty snapshot' = testSnapshot 2 0 [] mempty ackFrom sk vk = receiveMessageFrom vk $ AckSn (sign sk snapshot) 1 @@ -331,7 +331,7 @@ spec = _ -> False it "rejects last AckSn if one signature was from a different key" $ do - let reqSn = receiveMessage $ ReqSn 0 1 [] Nothing + let reqSn = receiveMessage $ ReqSn 0 1 [] Nothing Nothing snapshot = testSnapshot 1 0 [] mempty ackFrom sk vk = receiveMessageFrom vk $ AckSn (sign sk snapshot) 1 waitingForLastAck <- @@ -347,7 +347,7 @@ spec = _ -> False it "rejects last AckSn if one signature was from a completely different message" $ do - let reqSn = receiveMessage $ ReqSn 0 1 [] Nothing + let reqSn = receiveMessage $ ReqSn 0 1 [] Nothing Nothing snapshot1 = testSnapshot 1 0 [] mempty ackFrom sk vk = receiveMessageFrom vk $ AckSn (sign sk snapshot1) 1 invalidAckFrom sk vk = @@ -366,7 +366,7 @@ spec = _ -> False it "rejects last AckSn if already received signature from this party" $ do - let reqSn = receiveMessage $ ReqSn 0 1 [] Nothing + let reqSn = receiveMessage $ ReqSn 0 1 [] Nothing Nothing snapshot1 = testSnapshot 1 0 [] mempty ackFrom sk vk = receiveMessageFrom vk $ AckSn (sign sk snapshot1) 1 waitingForAck <- @@ -383,7 +383,7 @@ spec = it "rejects snapshot request with transaction not applicable to previous snapshot" $ do let reqTx42 = receiveMessage $ ReqTx (SimpleTx 42 mempty (utxoRef 1)) reqTx1 = receiveMessage $ ReqTx (SimpleTx 1 (utxoRef 1) (utxoRef 2)) - input = receiveMessage $ ReqSn 0 1 [1] Nothing + input = receiveMessage $ ReqSn 0 1 [1] Nothing Nothing s0 = inOpenState threeParties s2 <- runHeadLogic bobEnv ledger s0 $ do @@ -396,7 +396,7 @@ spec = it "waits if we receive a snapshot with unseen transactions" $ do let s0 = inOpenState threeParties - reqSn = receiveMessage $ ReqSn 0 1 [1] Nothing + reqSn = receiveMessage $ ReqSn 0 1 [1] Nothing Nothing update bobEnv ledger s0 reqSn `assertWait` WaitOnTxs [1] @@ -411,13 +411,13 @@ spec = -- snapshot collection. it "rejects if we receive a too far future snapshot" $ do - let input = receiveMessageFrom bob $ ReqSn 0 2 [] Nothing + let input = receiveMessageFrom bob $ ReqSn 0 2 [] Nothing Nothing st = inOpenState threeParties 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 = receiveMessage $ ReqSn 0 1 [] Nothing - reqSn2 = receiveMessageFrom bob $ ReqSn 0 2 [] Nothing + let reqSn1 = receiveMessage $ ReqSn 0 1 [] Nothing Nothing + reqSn2 = receiveMessageFrom bob $ ReqSn 0 2 [] Nothing Nothing st <- runHeadLogic bobEnv ledger (inOpenState threeParties) $ do step reqSn1 @@ -429,14 +429,14 @@ spec = it "acks signed snapshot from the constant leader" $ do let leader = alice snapshot = testSnapshot 1 0 [] mempty - input = receiveMessageFrom leader $ ReqSn 0 (number snapshot) [] Nothing + input = receiveMessageFrom leader $ ReqSn 0 (number snapshot) [] Nothing Nothing sig = sign bobSk snapshot st = inOpenState threeParties ack = AckSn sig (number snapshot) update bobEnv ledger st input `hasEffect` NetworkEffect ack it "does not ack snapshots from non-leaders" $ do - let input = receiveMessageFrom notTheLeader $ ReqSn 0 1 [] Nothing + let input = receiveMessageFrom notTheLeader $ ReqSn 0 1 [] Nothing Nothing notTheLeader = bob st = inOpenState threeParties update bobEnv ledger st input `shouldSatisfy` \case @@ -444,7 +444,7 @@ spec = _ -> False it "rejects too-old snapshots" $ do - let input = receiveMessageFrom theLeader $ ReqSn 0 2 [] Nothing + let input = receiveMessageFrom theLeader $ ReqSn 0 2 [] Nothing Nothing theLeader = alice snapshot = testSnapshot 2 0 [] mempty st = @@ -453,7 +453,7 @@ spec = update bobEnv ledger st input `shouldBe` Error (RequireFailed $ ReqSnNumberInvalid 2 0) it "rejects too-old snapshots when collecting signatures" $ do - let input = receiveMessageFrom theLeader $ ReqSn 0 2 [] Nothing + let input = receiveMessageFrom theLeader $ ReqSn 0 2 [] Nothing Nothing theLeader = alice snapshot = testSnapshot 2 0 [] mempty st = @@ -465,7 +465,7 @@ spec = update bobEnv ledger st input `shouldBe` Error (RequireFailed $ ReqSnNumberInvalid 2 3) it "rejects too-new snapshots from the leader" $ do - let input = receiveMessageFrom theLeader $ ReqSn 0 3 [] Nothing + let input = receiveMessageFrom theLeader $ ReqSn 0 3 [] Nothing Nothing theLeader = carol st = inOpenState threeParties update bobEnv ledger st input `shouldBe` Error (RequireFailed $ ReqSnNumberInvalid 3 0) @@ -473,7 +473,7 @@ spec = it "rejects invalid snapshots version" $ do let validSnNumber = 0 invalidSnVersion = 1 - input = receiveMessageFrom theLeader $ ReqSn invalidSnVersion validSnNumber [] Nothing + input = receiveMessageFrom theLeader $ ReqSn invalidSnVersion validSnNumber [] Nothing Nothing theLeader = carol expectedSnVersion = 0 st = inOpenState threeParties @@ -483,9 +483,9 @@ spec = let theLeader = alice nextSN = 1 firstReqTx = receiveMessage $ ReqTx (aValidTx 42) - firstReqSn = receiveMessageFrom theLeader $ ReqSn 0 nextSN [42] Nothing + firstReqSn = receiveMessageFrom theLeader $ ReqSn 0 nextSN [42] Nothing Nothing secondReqTx = receiveMessage $ ReqTx (aValidTx 51) - secondReqSn = receiveMessageFrom theLeader $ ReqSn 0 nextSN [51] Nothing + secondReqSn = receiveMessageFrom theLeader $ ReqSn 0 nextSN [51] Nothing Nothing s3 <- runHeadLogic bobEnv ledger (inOpenState threeParties) $ do step firstReqTx @@ -518,8 +518,8 @@ spec = , seenSnapshot = LastSeenSnapshot 1 , localUTxO = activeUTxO } - reqSn0 = receiveMessageFrom alice $ ReqSn 0 1 [] (Just decommitTx1) - reqSn1 = receiveMessageFrom bob $ ReqSn 0 2 [] (Just decommitTx2) + reqSn0 = receiveMessageFrom alice $ ReqSn 0 1 [] (Just decommitTx1) Nothing + reqSn1 = receiveMessageFrom bob $ ReqSn 0 2 [] (Just decommitTx2) Nothing outcome <- runHeadLogic bobEnv ledger s0 $ do step reqSn0 @@ -707,7 +707,7 @@ spec = st <- run $ runHeadLogic bobEnv ledger st0 $ do - step (receiveMessage $ ReqSn 0 1 [] Nothing) + step (receiveMessage $ ReqSn 0 1 [] Nothing Nothing) getState assert $ case st of diff --git a/hydra-node/test/Hydra/NodeSpec.hs b/hydra-node/test/Hydra/NodeSpec.hs index f4334416e4d..9dab8b38e38 100644 --- a/hydra-node/test/Hydra/NodeSpec.hs +++ b/hydra-node/test/Hydra/NodeSpec.hs @@ -197,7 +197,7 @@ spec = parallel $ do testHydraNode tracer aliceSk [bob, carol] cperiod inputs >>= recordNetwork runToCompletion node - getNetworkEvents `shouldReturn` [ReqSn 0 1 [1] Nothing, AckSn signedSnapshot 1] + getNetworkEvents `shouldReturn` [ReqSn 0 1 [1] Nothing Nothing, AckSn signedSnapshot 1] it "rotates snapshot leaders" $ showLogsOnFailure "NodeSpec" $ \tracer -> do @@ -206,7 +206,7 @@ spec = parallel $ do sn2 = testSnapshot 2 0 [1] (utxoRefs [1, 3, 4]) inputs = inputsToOpenHead - <> [ receiveMessage ReqSn{snapshotVersion = 0, snapshotNumber = 1, transactionIds = mempty, decommitTx = Nothing} + <> [ receiveMessage ReqSn{snapshotVersion = 0, snapshotNumber = 1, transactionIds = mempty, decommitTx = Nothing, incrementUTxO = Nothing} , receiveMessage $ AckSn (sign aliceSk sn1) 1 , receiveMessageFrom carol $ AckSn (sign carolSk sn1) 1 , receiveMessage ReqTx{transaction = tx1} @@ -217,7 +217,7 @@ spec = parallel $ do >>= recordNetwork runToCompletion node - getNetworkEvents `shouldReturn` [AckSn (sign bobSk sn1) 1, ReqSn 0 2 [1] Nothing, AckSn (sign bobSk sn2) 2] + getNetworkEvents `shouldReturn` [AckSn (sign bobSk sn1) 1, ReqSn 0 2 [1] Nothing Nothing, AckSn (sign bobSk sn2) 2] it "processes out-of-order AckSn" $ showLogsOnFailure "NodeSpec" $ \tracer -> do @@ -227,7 +227,7 @@ spec = parallel $ do inputs = inputsToOpenHead <> [ receiveMessageFrom bob AckSn{signed = sigBob, snapshotNumber = 1} - , receiveMessage ReqSn{snapshotVersion = 0, snapshotNumber = 1, transactionIds = [], decommitTx = Nothing} + , receiveMessage ReqSn{snapshotVersion = 0, snapshotNumber = 1, transactionIds = [], decommitTx = Nothing, incrementUTxO = Nothing} ] (node, getNetworkEvents) <- testHydraNode tracer aliceSk [bob, carol] cperiod inputs @@ -260,7 +260,7 @@ spec = parallel $ do inputsToOpenHead <> [ receiveMessageFrom bob ReqTx{transaction = SimpleTx{txSimpleId = 1, txInputs = utxoRefs [2], txOutputs = utxoRefs [4]}} , receiveMessageFrom bob ReqTx{transaction = SimpleTx{txSimpleId = 2, txInputs = utxoRefs [2], txOutputs = utxoRefs [5]}} - , receiveMessage ReqSn{snapshotVersion = 0, snapshotNumber = 1, transactionIds = [2], decommitTx = Nothing} + , receiveMessage ReqSn{snapshotVersion = 0, snapshotNumber = 1, transactionIds = [2], decommitTx = Nothing, incrementUTxO = Nothing} ] (node, getNetworkEvents) <- testHydraNode tracer bobSk [alice, carol] cperiod inputs