Add close action and closed state to model spec.

Also improve wait observation to show errors in case of PostTxOnChainFailed

hydra-node/test/Hydra/Model.hs

@@ -120,6 +120,10 @@ data GlobalState
       { headParameters :: HeadParameters
       , offChainState :: OffChainState
       }
+  | Closed
+      { headParameters :: HeadParameters
+      , offChainState :: OffChainState
+      }
   | Final {finalUTxO :: UTxOType Payment}
   deriving stock (Eq, Show)
 
@@ -174,6 +178,7 @@ instance StateModel WorldState where
     -- Check that all parties have observed the head as open
     ObserveHeadIsOpen :: Action WorldState ()
     StopTheWorld :: Action WorldState ()
+    Close :: Party -> Action WorldState ()
 
   initialState =
     WorldState
@@ -192,7 +197,10 @@ instance StateModel WorldState where
           , (1, genAbort)
           ]
       Open{} -> do
-        genNewTx
+        frequency
+          [ (5, genNewTx)
+          , (1, Some <$> genClose hydraParties)
+          ]
       _ -> fmap Some genSeed
    where
     genCommit pending = do
@@ -225,6 +233,8 @@ instance StateModel WorldState where
     True
   precondition WorldState{hydraState = Open{}} ObserveHeadIsOpen =
     True
+  precondition WorldState{hydraState = Open{}} Close{} =
+    True
   precondition _ StopTheWorld =
     True
   precondition _ _ =
@@ -290,6 +300,13 @@ instance StateModel WorldState where
             committedUTxO = mconcat $ Map.elems commits
           _ -> Final mempty
       --
+      Close _ ->
+        WorldState{hydraParties, hydraState = updateWithClosed hydraState}
+       where
+        updateWithClosed = \case
+          Open{headParameters, offChainState} -> 
+            Closed{headParameters, offChainState}
+          _ -> error "unexpected state"
       (NewTx _ tx) ->
         WorldState{hydraParties, hydraState = updateWithNewTx hydraState}
        where
@@ -328,6 +345,12 @@ genInit hydraParties = do
   let party = deriveParty key
   pure $ Init party
 
+genClose :: [(SigningKey HydraKey, b)] -> Gen (Action WorldState ())
+genClose hydraParties = do
+  key <- fst <$> elements hydraParties
+  let party = deriveParty key
+  pure $ Close party
+
 genCommit' ::
   [(SigningKey HydraKey, CardanoSigningKey)] ->
   (SigningKey HydraKey, CardanoSigningKey) ->
@@ -463,6 +486,8 @@ instance
         performInit party
       Abort party -> do
         performAbort party
+      Close party -> do
+        performClose party
       Wait delay ->
         lift $ threadDelay delay
       ObserveConfirmedTx tx -> do
@@ -559,6 +584,7 @@ performCommit parties party paymentUTxO = do
             Committed{party = cp, utxo = committedUTxO}
               | cp == party -> Just committedUTxO
             err@CommandFailed{} -> error $ show err
+            err@PostTxOnChainFailed{} -> error $ show err
             _ -> Nothing
 
       pure $ fromUtxo observedUTxO
@@ -643,8 +669,25 @@ performInit party = do
     waitUntilMatch (toList nodes) $ \case
       HeadIsInitializing{} -> True
       err@CommandFailed{} -> error $ show err
+      err@PostTxOnChainFailed{} -> error $ show err
       _ -> False
 
+performClose :: (MonadDelay m, MonadThrow m, MonadAsync m, MonadTimer m) => Party -> RunMonad m ()
+performClose party = do
+  nodes <- gets nodes
+  let thisNode = nodes ! party
+  waitForOpen thisNode
+
+  party `sendsInput` Input.Close
+
+  lift $
+    waitUntilMatch (toList nodes) $ \case
+      HeadIsClosed{} -> True
+      err@CommandFailed{} -> error $ show err
+      err@PostTxOnChainFailed{} -> error $ show err
+      _ -> False
+
+
 performAbort :: (MonadDelay m, MonadThrow m, MonadAsync m, MonadTimer m) => Party -> RunMonad m ()
 performAbort party = do
   party `sendsInput` Input.Abort
@@ -654,6 +697,7 @@ performAbort party = do
     waitUntilMatch (toList nodes) $ \case
       HeadIsAborted{} -> True
       err@CommandFailed{} -> error $ show err
+      err@PostTxOnChainFailed{} -> error $ show err
       _ -> False
 
 stopTheWorld :: MonadAsync m => RunMonad m ()
@@ -674,6 +718,7 @@ showFromAction k = \case
   Init{} -> k
   Commit{} -> k
   Abort{} -> k
+  Close{} -> k
   NewTx{} -> k
   Wait{} -> k
   ObserveConfirmedTx{} -> k