Report a snapshotted utxo set and confirmed txs in HeadIsClosed

hydra-node/src/Hydra/HeadLogic.hs

@@ -20,6 +20,7 @@ import Hydra.Ledger (
   UTxO,
   ValidationError,
   ValidationResult (Invalid, Valid),
+  emptyUTxO,
   initLedgerState,
  )
 
@@ -52,11 +53,13 @@ data ClientRequest tx
   | Contest
   deriving (Eq, Read, Show)
 
+type SnapshotNumber = Natural
+
 data ClientResponse tx
   = NodeConnectedToNetwork
   | ReadyToCommit
   | HeadIsOpen (UTxO tx)
-  | HeadIsClosed DiffTime (UTxO tx)
+  | HeadIsClosed DiffTime (UTxO tx) SnapshotNumber [tx]
   | HeadIsFinalized (UTxO tx)
   | CommandFailed
   | TxConfirmed tx
@@ -104,7 +107,8 @@ deriving instance Tx tx => Show (HeadStatus tx)
 data SimpleHeadState tx = SimpleHeadState
   { confirmedLedger :: LedgerState tx
   , -- TODO: tx should be an abstract 'TxId'
-    signatures :: Map tx (Set Party)
+    unconfirmedTxs :: Map tx (Set Party)
+  , confirmedTxs :: [tx]
   }
 
 deriving instance Tx tx => Eq (SimpleHeadState tx)
@@ -187,7 +191,7 @@ update Environment{party} ledger (HeadState p st) ev = case (st, ev) of
     let ls = initLedgerState ledger
      in newState
           p
-          (OpenState $ SimpleHeadState ls mempty)
+          (OpenState $ SimpleHeadState ls mempty mempty)
           [ClientEffect $ HeadIsOpen $ getUTxO ledger ls]
   --
   (OpenState _, OnChainEvent CommitTx{}) ->
@@ -203,39 +207,42 @@ update Environment{party} ledger (HeadState p st) ev = case (st, ev) of
     case canApply ledger (confirmedLedger headState) tx of
       Invalid _ -> panic "TODO: wait until it may be applied"
       Valid -> newState p st [NetworkEffect $ AckTx party tx]
-  (OpenState headState, NetworkEvent (MessageReceived (AckTx otherParty tx))) ->
-    case applyTransaction ledger (confirmedLedger headState) tx of
+  (OpenState headState@SimpleHeadState{confirmedLedger, confirmedTxs, unconfirmedTxs}, NetworkEvent (MessageReceived (AckTx otherParty tx))) ->
+    case applyTransaction ledger confirmedLedger tx of
       Left err -> panic $ "TODO: validation error: " <> show err
       Right newLedgerState -> do
         let sigs =
               Set.insert
                 otherParty
-                (fromMaybe Set.empty $ Map.lookup tx (signatures headState))
+                (fromMaybe Set.empty $ Map.lookup tx unconfirmedTxs)
         if sigs == parties p
           then
             newState
               p
               ( OpenState $
                   headState
                     { confirmedLedger = newLedgerState
-                    , signatures = Map.delete tx (signatures headState)
+                    , unconfirmedTxs = Map.delete tx unconfirmedTxs
+                    , confirmedTxs = tx : confirmedTxs
                     }
               )
               [ClientEffect $ TxConfirmed tx]
           else
             newState
               p
-              ( OpenState $
-                  headState
-                    { signatures = Map.insert tx sigs (signatures headState)
-                    }
+              ( OpenState headState{unconfirmedTxs = Map.insert tx sigs unconfirmedTxs}
               )
               []
 
   --
-  (OpenState SimpleHeadState{confirmedLedger}, OnChainEvent CloseTx) ->
+  (OpenState SimpleHeadState{confirmedLedger, confirmedTxs}, OnChainEvent CloseTx) ->
     let utxo = getUTxO ledger confirmedLedger
-     in newState p (ClosedState utxo) [ClientEffect $ HeadIsClosed (contestationPeriod p) utxo]
+        snapshotUtxo = emptyUTxO ledger
+        snapshotNumber = 0
+     in newState
+          p
+          (ClosedState utxo)
+          [ClientEffect $ HeadIsClosed (contestationPeriod p) snapshotUtxo snapshotNumber confirmedTxs]
   (ClosedState{}, ShouldPostFanout) ->
     newState p st [OnChainEffect FanoutTx]
   (ClosedState utxos, OnChainEvent FanoutTx) ->

hydra-node/src/Hydra/Ledger.hs

@@ -49,3 +49,7 @@ data ValidationResult
   deriving (Eq, Show)
 
 data ValidationError = ValidationError deriving (Eq, Show)
+
+emptyUTxO :: Ledger tx -> UTxO tx
+emptyUTxO Ledger{initLedgerState, getUTxO} =
+  getUTxO initLedgerState

hydra-node/test/Hydra/BehaviorSpec.hs

@@ -16,7 +16,8 @@ import Hydra.HeadLogic (
   createHeadState,
  )
 import Hydra.Ledger (LedgerState)
-import Hydra.Ledger.Mock (MockLedgerState (..), MockTx (..), mockLedger)
+import Hydra.Ledger.Mock (MockTx (..), mockLedger)
+
 import Hydra.Logging (traceInTVarIO)
 import Hydra.Network (HydraNetwork (..))
 import Hydra.Node (
@@ -89,7 +90,7 @@ spec = describe "Behavior of one ore more hydra-nodes" $ do
 
       sendRequestAndWaitFor n1 (Init [1]) ReadyToCommit
       sendRequestAndWaitFor n1 (Commit 1) (HeadIsOpen [])
-      sendRequestAndWaitFor n1 Close (HeadIsClosed 3 [])
+      sendRequestAndWaitFor n1 Close (HeadIsClosed 3 [] 0 [])
 
     it "sees the head closed by other nodes" $ do
       chain <- simulatedChainAndNetwork
@@ -105,7 +106,7 @@ spec = describe "Behavior of one ore more hydra-nodes" $ do
       wait1sForResponse n1 `shouldReturn` Just (HeadIsOpen [])
       sendRequest n1 Close
 
-      wait1sForResponse n2 `shouldReturn` Just (HeadIsClosed 3 [])
+      wait1sForResponse n2 `shouldReturn` Just (HeadIsClosed 3 [] 0 [])
 
     it "only opens the head after all nodes committed" $ do
       chain <- simulatedChainAndNetwork
@@ -121,7 +122,7 @@ spec = describe "Behavior of one ore more hydra-nodes" $ do
 
       wait1sForResponse n1 `shouldReturn` Just (HeadIsOpen [])
 
-    it "valid new transaction in open head is stored in ledger" $ do
+    it "valid new transactions get confirmed without snapshotting" $ do
       chain <- simulatedChainAndNetwork
       n1 <- startHydraNode 1 chain
       n2 <- startHydraNode 2 chain
@@ -132,10 +133,12 @@ spec = describe "Behavior of one ore more hydra-nodes" $ do
       sendRequestAndWaitFor n2 (Commit 1) (HeadIsOpen [])
       wait1sForResponse n1 `shouldReturn` Just (HeadIsOpen [])
 
-      sendRequest n1 (NewTx $ ValidTx 1)
+      sendRequest n1 (NewTx $ ValidTx 42)
+      wait1sForResponse n1 `shouldReturn` Just (TxConfirmed (ValidTx 42))
+      wait1sForResponse n2 `shouldReturn` Just (TxConfirmed (ValidTx 42))
 
-      waitForLedgerState n1 (Just $ MockLedgerState [ValidTx 1])
-      waitForLedgerState n2 (Just $ MockLedgerState [ValidTx 1])
+      sendRequest n1 Close
+      wait1sForResponse n1 `shouldReturn` Just (HeadIsClosed 3 [] 0 [ValidTx 42])
 
   describe "Hydra Node Logging" $ do
     it "traces processing of events" $ do

hydra-node/test/Hydra/HeadLogicSpec.hs

@@ -21,7 +21,7 @@ import Hydra.HeadLogic (
   update,
  )
 import Hydra.Ledger (Ledger (initLedgerState))
-import Hydra.Ledger.Mock (MockLedgerState (..), MockTx (ValidTx), mockLedger)
+import Hydra.Ledger.Mock (MockTx (ValidTx), mockLedger)
 import Test.Hspec (
   Spec,
   describe,
@@ -44,7 +44,7 @@ spec = describe "Hydra Head Logic" $ do
         ledger = mockLedger
         s0 =
           HeadState
-            { headStatus = OpenState $ SimpleHeadState (initLedgerState ledger) mempty
+            { headStatus = OpenState $ SimpleHeadState (initLedgerState ledger) mempty mempty
             , headParameters =
                 HeadParameters
                   { contestationPeriod = 42
@@ -62,9 +62,9 @@ spec = describe "Hydra Head Logic" $ do
 
     confirmedTransactions s4 `shouldBe` [ValidTx 1]
 
-confirmedTransactions :: HeadState MockTx -> [MockTx]
+confirmedTransactions :: HeadState tx -> [tx]
 confirmedTransactions HeadState{headStatus} = case headStatus of
-  OpenState (SimpleHeadState MockLedgerState{transactions} _) -> transactions
+  OpenState SimpleHeadState{confirmedTxs} -> confirmedTxs
   _ -> []
 
 assertNewState :: Outcome MockTx -> IO (HeadState MockTx)

local-cluster/test/Test/EndToEndSpec.hs

@@ -46,7 +46,7 @@ spec = describe "End-to-end test using a mocked chain though" $ do
                 sendRequest n1 "NewTx (ValidTx 42)"
                 waitForResponse 10 [n1, n2, n3] "TxConfirmed (ValidTx 42)"
                 sendRequest n1 "Close"
-                waitForResponse 3 [n1] "HeadIsClosed 3s [ValidTx 42]"
+                waitForResponse 3 [n1] "HeadIsClosed 3 [ValidTx 42]"
                 waitForResponse (contestationPeriod + 3) [n1] "HeadIsFinalized [ValidTx 42]"
 
     -- NOTE(SN): This is likely too detailed and should move to a lower-level