WIP: Simulate closing with inital snapshot

We are able to simulate closing with initial snapshot while we had a
snapshot with one tx already. This reveals the bug where we previously
saw H25 error related to contest deadline not being pushed.

hydra-node/test/Hydra/BehaviorSpec.hs

@@ -548,7 +548,7 @@ data SimulatedChainNetwork tx m = SimulatedChainNetwork
   , tickThread :: Async m ()
   , rollbackAndForward :: Natural -> m ()
   , simulateCommit :: (Party, UTxOType tx) -> m ()
-  , postCloseTx :: Party -> m ()
+  , closeWithInitialSnapshot :: (Party, UTxOType tx) -> m ()
   }
 
 dummySimulatedChainNetwork :: SimulatedChainNetwork tx m
@@ -558,7 +558,7 @@ dummySimulatedChainNetwork =
     , tickThread = error "tickThread"
     , rollbackAndForward = \_ -> error "rollbackAndForward"
     , simulateCommit = \_ -> error "simulateCommit"
-    , postCloseTx = \_ -> error "postCloseTx"
+    , closeWithInitialSnapshot = \(_, _) -> error "closeWithInitialSnapshot"
     }
 
 -- | With-pattern wrapper around 'simulatedChainAndNetwork' which does 'cancel'
@@ -624,7 +624,7 @@ simulatedChainAndNetwork initialChainState = do
       , rollbackAndForward = rollbackAndForward nodes history localChainState
       , simulateCommit = \(party, committed) ->
           createAndYieldEvent nodes history localChainState $ OnCommitTx{headId = testHeadId, party, committed}
-      , postCloseTx = error "unexpected call to postCloseTx"
+      , closeWithInitialSnapshot = error "unexpected call to closeWithInitialSnapshot"
       }
  where
   -- seconds

hydra-node/test/Hydra/Model.hs

@@ -118,6 +118,7 @@ data GlobalState
   | Open
       { headParameters :: HeadParameters
       , offChainState :: OffChainState
+      , committed :: Committed Payment
       }
   | Closed
       { closedUTxO :: UTxOType Payment
@@ -166,7 +167,7 @@ instance StateModel WorldState where
     -- Check that all parties have observed the head as open
     ObserveHeadIsOpen :: Action WorldState ()
     RollbackAndForward :: Natural -> Action WorldState ()
-    PostCloseTx :: Party -> Action WorldState ()
+    CloseWithInitialSnapshot :: Party -> Action WorldState ()
     StopTheWorld :: Action WorldState ()
 
   initialState =
@@ -188,7 +189,7 @@ instance StateModel WorldState where
       Open{} ->
         frequency
           [ (10, genNewTx)
-          , (1, frequency [(5, genClose), (5, genPostCloseTx)])
+          , (1, genClose)
           , (1, genRollbackAndForward)
           ]
       Closed{} ->
@@ -218,9 +219,6 @@ instance StateModel WorldState where
       numberOfBlocks <- choose (1, 2)
       pure . Some $ RollbackAndForward (wordToNatural numberOfBlocks)
 
-    genPostCloseTx =
-      Some . PostCloseTx . deriveParty . fst <$> elements hydraParties
-
   precondition WorldState{hydraState = Start} Seed{} =
     True
   precondition WorldState{hydraState = Idle{idleParties}} (Init p) =
@@ -241,7 +239,7 @@ instance StateModel WorldState where
     True
   precondition WorldState{hydraState = Closed{}} (Fanout _) =
     True
-  precondition WorldState{hydraState = Open{}} (PostCloseTx _) =
+  precondition WorldState{hydraState = Open{}} (CloseWithInitialSnapshot _) =
     True
   precondition WorldState{hydraState} (RollbackAndForward _) =
     case hydraState of
@@ -295,6 +293,7 @@ instance StateModel WorldState where
                 then
                   Open
                     { headParameters
+                    , committed = commits'
                     , offChainState =
                         OffChainState
                           { confirmedUTxO = mconcat (Map.elems commits')
@@ -334,16 +333,17 @@ instance StateModel WorldState where
         WorldState{hydraParties, hydraState = updateWithNewTx hydraState}
        where
         updateWithNewTx = \case
-          Open{headParameters, offChainState = OffChainState{confirmedUTxO}} ->
+          Open{headParameters, committed, offChainState = OffChainState{confirmedUTxO}} ->
             Open
               { headParameters
+              , committed
               , offChainState =
                   OffChainState
                     { confirmedUTxO = confirmedUTxO `applyTx` tx
                     }
               }
           _ -> error "unexpected state"
-      PostCloseTx _ ->
+      CloseWithInitialSnapshot _ ->
         WorldState{hydraParties, hydraState = updateWithClose hydraState}
        where
         updateWithClose = \case
@@ -549,8 +549,8 @@ instance
           case find headIsOpen outputs of
             Just _ -> pure ()
             Nothing -> error "The head is not open for node"
-      PostCloseTx party ->
-        performCloseTx party
+      CloseWithInitialSnapshot party ->
+        performCloseWithInitialSnapshot st party
       RollbackAndForward numberOfBlocks ->
         performRollbackAndForward numberOfBlocks
       StopTheWorld ->
@@ -754,18 +754,25 @@ performFanout party = do
     HeadIsFinalized{} -> True
     _otherwise -> False
 
-performCloseTx :: (MonadThrow m, MonadTimer m, MonadDelay m, MonadAsync m) => Party -> RunMonad m ()
-performCloseTx party = do
+performCloseWithInitialSnapshot :: (MonadThrow m, MonadTimer m, MonadDelay m, MonadAsync m) => WorldState -> Party -> RunMonad m ()
+performCloseWithInitialSnapshot st party = do
   nodes <- gets nodes
   let thisNode = nodes ! party
   waitForOpen thisNode
-  SimulatedChainNetwork{postCloseTx} <- gets chain
-  lift $ postCloseTx party
-  lift $
-    waitUntilMatch (toList nodes) $ \case
-      HeadIsClosed{} -> True
-      err@CommandFailed{} -> error $ show err
-      _ -> False
+  case hydraState st of
+    Open{committed} -> do
+      SimulatedChainNetwork{closeWithInitialSnapshot} <- gets chain
+      _ <- lift $ closeWithInitialSnapshot (party, toRealUTxO $ foldMap snd $ Map.toList committed)
+      lift $
+        waitUntilMatch (toList nodes) $ \case
+          HeadIsClosed{snapshotNumber} ->
+            -- we deliberately wait to see close with the initial snapshot
+            -- here to mimic one node not seeing the confirmed tx
+            snapshotNumber == Snapshot.UnsafeSnapshotNumber 0
+          err@CommandFailed{} -> error $ show err
+          _ -> False
+    _ -> error "Not in open state"
+
 performRollbackAndForward :: (MonadThrow m, MonadTimer m) => Natural -> RunMonad m ()
 performRollbackAndForward numberOfBlocks = do
   SimulatedChainNetwork{rollbackAndForward} <- gets chain
@@ -824,7 +831,7 @@ showFromAction k = \case
   NewTx{} -> k
   Wait{} -> k
   ObserveConfirmedTx{} -> k
-  PostCloseTx{} -> k
+  CloseWithInitialSnapshot{} -> k
   RollbackAndForward{} -> k
   StopTheWorld -> k
   ObserveHeadIsOpen -> k

hydra-node/test/Hydra/Model/MockChain.hs

@@ -61,7 +61,6 @@ import Hydra.HeadLogic (
  )
 import Hydra.HeadLogic.State (
   ClosedState (..),
-  CoordinatedHeadState (..),
   HeadState (..),
   IdleState (..),
   InitialState (..),
@@ -78,6 +77,7 @@ import Hydra.Network.Message (Message)
 import Hydra.Node (HydraNode (..), NodeState (..))
 import Hydra.Node.EventQueue (EventQueue (..))
 import Hydra.Party (Party (..), deriveParty)
+import Hydra.Snapshot (ConfirmedSnapshot (..))
 import Test.QuickCheck (getPositive)
 
 -- | Create a mocked chain which connects nodes through 'ChainSyncHandler' and
@@ -111,7 +111,7 @@ mockChainAndNetwork tr seedKeys commits = do
       , tickThread
       , rollbackAndForward = rollbackAndForward nodes chain
       , simulateCommit = simulateCommit nodes
-      , postCloseTx = postCloseTx nodes
+      , closeWithInitialSnapshot = closeWithInitialSnapshot nodes
       }
  where
   initialUTxO = initUTxO <> commits <> registryUTxO scriptRegistry
@@ -211,10 +211,10 @@ mockChainAndNetwork tr seedKeys commits = do
             Left e -> throwIO e
             Right tx -> submitTx tx
 
-  postCloseTx nodes party = do
+  closeWithInitialSnapshot nodes (party, modelInitialUTxO) = do
     hydraNodes <- readTVarIO nodes
     case find (matchingParty party) hydraNodes of
-      Nothing -> error "postCloseTx: Could not find matching HydraNode"
+      Nothing -> error "closeWithInitialSnapshot: Could not find matching HydraNode"
       Just
         MockHydraNode
           { node = HydraNode{oc = Chain{postTx}, nodeState = NodeState{queryHeadState}}
@@ -223,8 +223,10 @@ mockChainAndNetwork tr seedKeys commits = do
           case hs of
             Idle IdleState{} -> error "Cannot post Close tx when in Idle state"
             Initial InitialState{} -> error "Cannot post Close tx when in Initial state"
-            Open OpenState{headId = openHeadId, parameters = headParameters, coordinatedHeadState = CoordinatedHeadState{confirmedSnapshot}} -> do
-              let closeTx = CloseTx{headId = openHeadId, headParameters, confirmedSnapshot}
+            Open OpenState{headId = openHeadId, parameters = headParameters} -> do
+              let initialSnapshot = InitialSnapshot{headId = openHeadId, initialUTxO = modelInitialUTxO}
+
+              let closeTx = CloseTx{headId = openHeadId, headParameters, confirmedSnapshot = initialSnapshot}
               postTx closeTx
             Closed ClosedState{} -> error "Cannot post Close tx when in Closed state"
 

hydra-node/test/Hydra/ModelSpec.hs

@@ -186,13 +186,33 @@ spec = do
   prop "fanout contains whole confirmed UTxO" prop_fanoutContainsWholeConfirmedUTxO
   prop "toRealUTxO is distributive" $ propIsDistributive toRealUTxO
   prop "toTxOuts is distributive" $ propIsDistributive toTxOuts
+  prop "parties contest to wrong closed snapshot" prop_partyContestsToWrongClosedSnapshot
 
 propIsDistributive :: (Show b, Eq b, Semigroup a, Semigroup b) => (a -> b) -> a -> a -> Property
 propIsDistributive f x y =
   f x <> f y === f (x <> y)
     & counterexample ("f (x <> y)   " <> show (f (x <> y)))
     & counterexample ("f x <> f y: " <> show (f x <> f y))
 
+prop_partyContestsToWrongClosedSnapshot :: Property
+prop_partyContestsToWrongClosedSnapshot =
+  forAllDL partyContestsToWrongClosedSnapshot prop_HydraModel
+
+-- | Expect to see contestations when trying to close with
+-- an old snapshot
+partyContestsToWrongClosedSnapshot :: DL WorldState ()
+partyContestsToWrongClosedSnapshot = do
+  headOpensIfAllPartiesCommit
+  getModelStateDL >>= \case
+    st@WorldState{hydraState = Open{}} -> do
+      (party, payment) <- forAllNonVariableQ (nonConflictingTx st)
+      tx <- action $ Model.NewTx party payment
+      eventually (ObserveConfirmedTx tx)
+      action_ $ Model.CloseWithInitialSnapshot party
+      void $ action $ Model.Fanout party
+    _ -> pure ()
+  action_ Model.StopTheWorld
+
 prop_fanoutContainsWholeConfirmedUTxO :: Property
 prop_fanoutContainsWholeConfirmedUTxO =
   forAllDL fanoutContainsWholeConfirmedUTxO prop_HydraModel