Create a unit test case for acking snapshots only after seen all AckSn

hydra-node/src/Hydra/HeadLogic.hs

@@ -76,12 +76,14 @@ data ClientResponse tx
 deriving instance Tx tx => Eq (ClientResponse tx)
 deriving instance Tx tx => Show (ClientResponse tx)
 
+-- NOTE(SN): Every message comes from a 'Party', we might want to move it out of
+-- here into the 'NetworkEvent'
 data HydraMessage tx
   = ReqTx tx
   | AckTx Party tx
   | ConfTx
   | ReqSn SnapshotNumber [tx]
-  | AckSn (Snapshot tx) -- TODO: should actually be stored locally and not transmitted
+  | AckSn Party (Snapshot tx) -- TODO: should actually be stored locally and not transmitted
   | ConfSn
   | Ping Party
   deriving (Eq, Show)
@@ -274,8 +276,8 @@ update Environment{party, snapshotStrategy} ledger (HeadState p st) ev = case (s
         panic $ "Received not applicable snapshot (" <> show sn <> ") " <> show txs <> ": " <> show e
       Right u ->
         let nextSnapshot = Snapshot sn u txs
-         in newState p (OpenState s) [NetworkEffect $ AckSn nextSnapshot]
-  (OpenState headState@SimpleHeadState{confirmedTxs, confirmedSnapshot}, NetworkEvent (AckSn sn))
+         in newState p (OpenState s) [NetworkEffect $ AckSn party nextSnapshot]
+  (OpenState headState@SimpleHeadState{confirmedTxs, confirmedSnapshot}, NetworkEvent (AckSn _otherParty sn))
     | number confirmedSnapshot + 1 == number sn ->
       -- TODO: wait for all AckSn before confirming!
       newState

hydra-node/src/Hydra/Network.hs

@@ -78,9 +78,9 @@ instance (ToCBOR tx, ToCBOR (UTxO tx)) => ToCBOR (HydraMessage tx) where
     AckTx party tx -> toCBOR ("AckTx" :: Text) <> toCBOR party <> toCBOR tx
     ConfTx -> toCBOR ("ConfTx" :: Text)
     ReqSn sn txs -> toCBOR ("ReqSn" :: Text) <> toCBOR sn <> toCBOR txs
-    AckSn sn -> toCBOR ("AckSn" :: Text) <> toCBOR sn
+    AckSn party sn -> toCBOR ("AckSn" :: Text) <> toCBOR party <> toCBOR sn
     ConfSn -> toCBOR ("ConfSn" :: Text)
-    Ping pty -> toCBOR ("Ping" :: Text) <> toCBOR pty
+    Ping party -> toCBOR ("Ping" :: Text) <> toCBOR party
 
 instance (ToCBOR tx, ToCBOR (UTxO tx)) => ToCBOR (Snapshot tx) where
   toCBOR Snapshot{number, utxo, confirmed} = toCBOR number <> toCBOR utxo <> toCBOR confirmed
@@ -92,7 +92,7 @@ instance (FromCBOR tx, FromCBOR (UTxO tx)) => FromCBOR (HydraMessage tx) where
       "AckTx" -> AckTx <$> fromCBOR <*> fromCBOR
       "ConfTx" -> pure ConfTx
       "ReqSn" -> ReqSn <$> fromCBOR <*> fromCBOR
-      "AckSn" -> AckSn <$> fromCBOR
+      "AckSn" -> AckSn <$> fromCBOR <*> fromCBOR
       "ConfSn" -> pure ConfSn
       "Ping" -> Ping <$> fromCBOR
       msg -> fail $ show msg <> " is not a proper CBOR-encoded HydraMessage"

hydra-node/test/Hydra/HeadLogicSpec.hs

@@ -51,24 +51,33 @@ spec = describe "Hydra Head Logic" $ do
 
   it "confirms tx given it receives AckTx from all parties" $ do
     let reqTx = NetworkEvent $ ReqTx (ValidTx 1)
-        ackFrom1 = NetworkEvent $ AckTx 1 (ValidTx 1)
-        ackFrom2 = NetworkEvent $ AckTx 2 (ValidTx 1)
-        ackFrom3 = NetworkEvent $ AckTx 3 (ValidTx 1)
+        ackFrom n = NetworkEvent $ AckTx n (ValidTx 1)
         s0 = initialState threeParties ledger
 
     s1 <- assertNewState $ update env ledger s0 reqTx
-    s2 <- assertNewState $ update env ledger s1 ackFrom3
-    s3 <- assertNewState $ update env ledger s2 ackFrom1
+    s2 <- assertNewState $ update env ledger s1 (ackFrom 3)
+    s3 <- assertNewState $ update env ledger s2 (ackFrom 1)
+    getConfirmedTransactions s3 `shouldBe` []
 
-    confirmedTransactions s3 `shouldBe` []
-
-    s4 <- assertNewState $ update env ledger s3 ackFrom2
-
-    confirmedTransactions s4 `shouldBe` [ValidTx 1]
+    s4 <- assertNewState $ update env ledger s3 (ackFrom 2)
+    getConfirmedTransactions s4 `shouldBe` [ValidTx 1]
 
   it "notifies client when it receives a ping" $ do
     update env ledger (initialState threeParties ledger) (NetworkEvent $ Ping 2) `hasEffect` ClientEffect (PeerConnected 2)
 
+  it "confirms snapshot given it receives AckSn from all parties" $ do
+    let s0 = initialState threeParties ledger
+        reqSn = NetworkEvent $ ReqSn 1 []
+        ackFrom n = NetworkEvent $ AckSn n (Snapshot 1 [] [])
+    s1 <- assertNewState $ update env ledger s0 reqSn
+    s2 <- assertNewState $ update env ledger s1 (ackFrom 3)
+    s3 <- assertNewState $ update env ledger s2 (ackFrom 1)
+
+    getConfirmedSnapshot s3 `shouldBe` Just (Snapshot 0 [] [])
+
+    s4 <- assertNewState $ update env ledger s3 (ackFrom 2)
+    getConfirmedSnapshot s4 `shouldBe` Just (Snapshot 1 [] [])
+
   it "does not confirm snapshots from non-leaders" pending
   it "does not confirm old snapshots" pending
 
@@ -134,11 +143,16 @@ initialState parties Ledger{initUTxO} =
               }
         }
 
-confirmedTransactions :: HeadState tx -> [tx]
-confirmedTransactions HeadState{headStatus} = case headStatus of
+getConfirmedTransactions :: HeadState tx -> [tx]
+getConfirmedTransactions HeadState{headStatus} = case headStatus of
   OpenState SimpleHeadState{confirmedTxs} -> confirmedTxs
   _ -> []
 
+getConfirmedSnapshot :: HeadState tx -> Maybe (Snapshot tx)
+getConfirmedSnapshot HeadState{headStatus} = case headStatus of
+  OpenState SimpleHeadState{confirmedSnapshot} -> Just confirmedSnapshot
+  _ -> Nothing
+
 assertNewState :: Outcome MockTx -> IO (HeadState MockTx)
 assertNewState = \case
   NewState st _ -> pure st

hydra-node/test/Hydra/NetworkSpec.hs

@@ -91,7 +91,7 @@ instance Arbitrary (HydraMessage MockTx) where
       , AckTx <$> arbitraryNatural <*> arbitrary
       , pure ConfTx
       , ReqSn <$> arbitraryNatural <*> arbitrary
-      , AckSn <$> arbitrary
+      , AckSn <$> arbitraryNatural <*> arbitrary
       , pure ConfSn
       , Ping <$> arbitraryNatural
       ]