Add a test about head finalization and pick a long contestation period

startHydraNode is deliberately not parameterized to illustrate the
benefit of using io-sim instead of IO in this test suite.

hydra-node/test/Hydra/BehaviorSpec.hs

@@ -2,8 +2,10 @@
 
 module Hydra.BehaviorSpec where
 
-import Cardano.Prelude hiding (atomically, check)
+import Cardano.Prelude hiding (atomically, check, threadDelay)
 import Control.Monad.Class.MonadSTM (TVar, atomically, check, modifyTVar, newTVarIO, readTVar)
+import Control.Monad.Class.MonadTime (DiffTime)
+import Control.Monad.Class.MonadTimer (threadDelay)
 import Data.IORef (modifyIORef', newIORef, readIORef)
 import Hydra.HeadLogic (
   ClientRequest (..),
@@ -77,7 +79,19 @@ 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 testContestationPeriod [])
+
+    it "does finalize head after contestation period" $ do
+      chain <- simulatedChainAndNetwork
+      n1 <- startHydraNode 1 chain
+
+      sendRequestAndWaitFor n1 (Init [1]) ReadyToCommit
+      sendRequest n1 (Commit 1)
+      failAfter 1 $ waitForResponse n1 `shouldReturn` HeadIsOpen []
+      sendRequest n1 Close
+      failAfter 1 $ waitForResponse n1 `shouldReturn` HeadIsClosed testContestationPeriod []
+      threadDelay testContestationPeriod
+      failAfter 1 $ waitForResponse n1 `shouldReturn` HeadIsFinalized []
 
   describe "Two participant Head" $ do
     it "accepts a tx after the head was opened between two nodes" $ do
@@ -107,7 +121,7 @@ spec = describe "Behavior of one ore more hydra-nodes" $ do
       failAfter 1 $ waitForResponse n1 `shouldReturn` HeadIsOpen []
       sendRequest n1 Close
 
-      failAfter 1 $ waitForResponse n2 `shouldReturn` HeadIsClosed 3 []
+      failAfter 1 $ waitForResponse n2 `shouldReturn` HeadIsClosed testContestationPeriod []
 
     it "only opens the head after all nodes committed" $ do
       chain <- simulatedChainAndNetwork
@@ -207,6 +221,10 @@ simulatedChainAndNetwork = do
 
   broadcast nodes msg = atomically (readTVar nodes) >>= mapM_ (`handleMessage` msg)
 
+-- NOTE(SN): Deliberately not configurable via 'startHydraNode'
+testContestationPeriod :: DiffTime
+testContestationPeriod = 10
+
 startHydraNode ::
   Natural ->
   (HydraNode MockTx IO -> IO Connections) ->
@@ -243,7 +261,7 @@ startHydraNode nodeId connectToChain = do
   createHydraNode response = do
     let env = Environment nodeId
     eq <- createEventQueue
-    let headState = createHeadState [] (HeadParameters 3 []) SnapshotStrategy
+    let headState = createHeadState [] (HeadParameters testContestationPeriod []) SnapshotStrategy
     hh <- createHydraHead headState mockLedger
     let hn' = HydraNetwork{broadcast = const $ pure ()}
     let node = HydraNode{eq, hn = hn', hh, oc = OnChain (const $ pure ()), sendResponse = putMVar response, env}