Move contestation period from environment to Init arguments.

hydra-node/src/Hydra/ClientInput.hs

@@ -5,11 +5,12 @@ module Hydra.ClientInput where
 
 import Data.Aeson (object, withObject, (.:), (.=))
 import qualified Data.Aeson as Aeson
+import Hydra.Chain (ContestationPeriod)
 import Hydra.Ledger (Tx, UTxO)
 import Hydra.Prelude
 
 data ClientInput tx
-  = Init
+  = Init ContestationPeriod
   | Abort
   | Commit (UTxO tx)
   | NewTx tx
@@ -29,7 +30,7 @@ instance (Arbitrary tx, Arbitrary (UTxO tx)) => Arbitrary (ClientInput tx) where
   -- Overlapping instances with 'UTxO tx' even though for a fixed `tx`, there
   -- should be only one 'UTxO tx'
   shrink = \case
-    Init -> []
+    Init{} -> []
     Abort -> []
     Commit xs -> Commit <$> shrink xs
     NewTx tx -> NewTx <$> shrink tx
@@ -39,8 +40,8 @@ instance (Arbitrary tx, Arbitrary (UTxO tx)) => Arbitrary (ClientInput tx) where
 
 instance Tx tx => ToJSON (ClientInput tx) where
   toJSON = \case
-    Init ->
-      object [tagFieldName .= s "init"]
+    Init t ->
+      object [tagFieldName .= s "init", "contestationPeriod" .= t]
     Abort ->
       object [tagFieldName .= s "abort"]
     Commit u ->
@@ -62,7 +63,7 @@ instance Tx tx => FromJSON (ClientInput tx) where
     tag <- obj .: "input"
     case tag of
       "init" ->
-        pure Init
+        Init <$> (obj .: "contestationPeriod")
       "abort" ->
         pure Abort
       "commit" ->

hydra-node/src/Hydra/HeadLogic.hs

@@ -9,8 +9,7 @@ import Hydra.Prelude
 import Data.List (elemIndex, (\\))
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
-import GHC.Records (getField)
-import Hydra.Chain (ContestationPeriod, HeadParameters (..), OnChainTx (..))
+import Hydra.Chain (HeadParameters (..), OnChainTx (..))
 import Hydra.ClientInput (ClientInput (..))
 import Hydra.Ledger (
   Committed,
@@ -113,8 +112,6 @@ data Environment = Environment
     -- memory, i.e. have an 'Effect' for signing or so.
     signingKey :: SigningKey
   , otherParties :: [Party]
-  , -- | Configured 'T' to use when initiating a Head
-    contestationPeriod :: ContestationPeriod
   , snapshotStrategy :: SnapshotStrategy
   }
 
@@ -129,14 +126,14 @@ update ::
   HeadState tx ->
   Event tx ->
   Outcome tx
-update env@Environment{party, signingKey, otherParties, snapshotStrategy} ledger st ev = case (st, ev) of
+update Environment{party, signingKey, otherParties, snapshotStrategy} ledger st ev = case (st, ev) of
   -- TODO(SN) at least contestation period could be easily moved into the 'Init' client input
-  (ReadyState, ClientEvent Init) ->
+  (ReadyState, ClientEvent (Init contestationPeriod)) ->
     nextState ReadyState [OnChainEffect (InitTx parameters)]
    where
     parameters =
       HeadParameters
-        { contestationPeriod = getField @"contestationPeriod" env
+        { contestationPeriod
         , parties = party : otherParties
         }
   (_, OnChainEvent (InitTx parameters@HeadParameters{parties})) ->

hydra-node/src/Hydra/Node.hs

@@ -41,7 +41,6 @@ initEnvironment Options{me, parties} = do
       { party = UnsafeParty vk
       , signingKey = sk
       , otherParties = UnsafeParty <$> otherVKeys
-      , contestationPeriod = 10
       , snapshotStrategy = SnapshotAfterEachTx
       }
  where

hydra-node/test/Hydra/BehaviorSpec.hs

@@ -23,7 +23,8 @@ import Hydra.HeadLogic (
   Effect (ClientEffect),
   Environment (..),
   Event (ClientEvent),
-  SnapshotStrategy (..), HeadState (ReadyState)
+  HeadState (ReadyState),
+  SnapshotStrategy (..),
  )
 import Hydra.Ledger (Party, SigningKey, Tx, deriveParty)
 import Hydra.Ledger.Simple (SimpleTx (..), aValidTx, simpleLedger, utxoRef, utxoRefs)
@@ -63,13 +64,13 @@ spec = describe "Behavior of one ore more hydra nodes" $ do
       shouldRunInSim $ do
         chain <- simulatedChainAndNetwork
         withHydraNode 1 [] NoSnapshots chain $ \n ->
-          send n Init
+          send n (Init testContestationPeriod)
 
     it "accepts Commit after successful Init" $
       shouldRunInSim $ do
         chain <- simulatedChainAndNetwork
         withHydraNode 1 [] NoSnapshots chain $ \n1 -> do
-          send n1 Init
+          send n1 (Init testContestationPeriod)
           waitFor [n1] $ ReadyToCommit [1]
           send n1 (Commit (utxoRef 1))
           waitFor [n1] $ Committed 1 (utxoRef 1)
@@ -78,7 +79,7 @@ spec = describe "Behavior of one ore more hydra nodes" $ do
       shouldRunInSim $ do
         chain <- simulatedChainAndNetwork
         withHydraNode 1 [] NoSnapshots chain $ \n1 -> do
-          send n1 Init
+          send n1 (Init testContestationPeriod)
           waitFor [n1] $ ReadyToCommit [1]
           send n1 (Commit (utxoRef 1))
           waitFor [n1] $ Committed 1 (utxoRef 1)
@@ -90,7 +91,7 @@ spec = describe "Behavior of one ore more hydra nodes" $ do
       shouldRunInSim $ do
         chain <- simulatedChainAndNetwork
         withHydraNode 1 [] NoSnapshots chain $ \n1 -> do
-          send n1 Init
+          send n1 (Init testContestationPeriod)
           waitFor [n1] $ ReadyToCommit [1]
           send n1 (Commit (utxoRef 1))
           waitFor [n1] $ Committed 1 (utxoRef 1)
@@ -103,7 +104,7 @@ spec = describe "Behavior of one ore more hydra nodes" $ do
         shouldRunInSim $ do
           chain <- simulatedChainAndNetwork
           withHydraNode 1 [] NoSnapshots chain $ \n1 -> do
-            send n1 Init
+            send n1 (Init testContestationPeriod)
             waitFor [n1] $ ReadyToCommit [1]
             send n1 (Commit (utxoRef 1))
             waitFor [n1] $ Committed 1 (utxoRef 1)
@@ -119,7 +120,7 @@ spec = describe "Behavior of one ore more hydra nodes" $ do
         chain <- simulatedChainAndNetwork
         withHydraNode 1 [2] NoSnapshots chain $ \n1 ->
           withHydraNode 2 [1] NoSnapshots chain $ \n2 -> do
-            send n1 Init
+            send n1 (Init testContestationPeriod)
             waitFor [n1, n2] $ ReadyToCommit [1, 2]
 
             send n1 (Commit (utxoRef 1))
@@ -136,21 +137,21 @@ spec = describe "Behavior of one ore more hydra nodes" $ do
         chain <- simulatedChainAndNetwork
         withHydraNode 1 [2] NoSnapshots chain $ \n1 ->
           withHydraNode 2 [1] NoSnapshots chain $ \n2 -> do
-            send n1 Init
+            send n1 (Init testContestationPeriod)
             waitFor [n1, n2] $ ReadyToCommit [1, 2]
             send n1 (Commit (utxoRefs [1, 2]))
             waitFor [n1, n2] $ Committed 1 (utxoRefs [1, 2])
             send n2 Abort
             waitFor [n1, n2] $ HeadIsAborted (utxoRefs [1, 2])
-            send n1 Init
+            send n1 (Init testContestationPeriod)
             waitFor [n1, n2] $ ReadyToCommit [1, 2]
 
     it "cannot abort head when commits have been collected" $
       shouldRunInSim $ do
         chain <- simulatedChainAndNetwork
         withHydraNode 1 [2] NoSnapshots chain $ \n1 ->
           withHydraNode 2 [1] NoSnapshots chain $ \n2 -> do
-            send n1 Init
+            send n1 (Init testContestationPeriod)
             waitFor [n1, n2] $ ReadyToCommit [1, 2]
             send n1 (Commit (utxoRef 1))
             send n2 (Commit (utxoRef 2))
@@ -165,7 +166,7 @@ spec = describe "Behavior of one ore more hydra nodes" $ do
         chain <- simulatedChainAndNetwork
         withHydraNode 1 [2] NoSnapshots chain $ \n1 ->
           withHydraNode 2 [1] NoSnapshots chain $ \n2 -> do
-            send n1 Init
+            send n1 (Init testContestationPeriod)
             waitFor [n1, n2] $ ReadyToCommit [1, 2]
 
             send n1 (Commit (utxoRef 1))
@@ -185,7 +186,7 @@ spec = describe "Behavior of one ore more hydra nodes" $ do
         chain <- simulatedChainAndNetwork
         withHydraNode 1 [2] SnapshotAfterEachTx chain $ \n1 ->
           withHydraNode 2 [1] NoSnapshots chain $ \n2 -> do
-            send n1 Init
+            send n1 (Init testContestationPeriod)
             waitFor [n1, n2] $ ReadyToCommit [1, 2]
             send n1 (Commit (utxoRef 1))
 
@@ -196,7 +197,7 @@ spec = describe "Behavior of one ore more hydra nodes" $ do
 
     describe "in an open head" $ do
       let openHead n1 n2 = do
-            send n1 Init
+            send n1 (Init testContestationPeriod)
             waitFor [n1, n2] $ ReadyToCommit [1, 2]
             send n1 (Commit (utxoRef 1))
             waitFor [n1, n2] $ Committed 1 (utxoRef 1)
@@ -302,20 +303,22 @@ spec = describe "Behavior of one ore more hydra nodes" $ do
       let result = runSimTrace $ do
             chain <- simulatedChainAndNetwork
             withHydraNode 1 [] NoSnapshots chain $ \n1 -> do
-              send n1 Init
+              send n1 (Init testContestationPeriod)
               waitFor [n1] $ ReadyToCommit [1]
               send n1 (Commit (utxoRef 1))
 
           logs = selectTraceEventsDynamic @_ @(HydraNodeLog SimpleTx) result
 
-      logs `shouldContain` [ProcessingEvent 1 (ClientEvent Init)]
-      logs `shouldContain` [ProcessedEvent 1 (ClientEvent Init)]
+      logs
+        `shouldContain` [ProcessingEvent 1 $ ClientEvent $ Init testContestationPeriod]
+      logs
+        `shouldContain` [ProcessedEvent 1 $ ClientEvent $ Init testContestationPeriod]
 
     it "traces handling of effects" $ do
       let result = runSimTrace $ do
             chain <- simulatedChainAndNetwork
             withHydraNode 1 [] NoSnapshots chain $ \n1 -> do
-              send n1 Init
+              send n1 (Init testContestationPeriod)
               waitFor [n1] $ ReadyToCommit [1]
               send n1 (Commit (utxoRef 1))
 
@@ -415,7 +418,6 @@ withHydraNode signingKey otherParties snapshotStrategy connectToChain action = d
             { party
             , signingKey
             , otherParties
-            , contestationPeriod = testContestationPeriod
             , snapshotStrategy
             }
     eq <- createEventQueue

hydra-node/test/Hydra/HeadLogicSpec.hs

@@ -54,7 +54,6 @@ spec = describe "Hydra Coordinated Head Protocol" $ do
           { party = 2
           , signingKey = 2
           , otherParties = [1, 3]
-          , contestationPeriod = 42
           , snapshotStrategy = NoSnapshots
           }
 
@@ -65,7 +64,6 @@ spec = describe "Hydra Coordinated Head Protocol" $ do
               { party
               , signingKey
               , otherParties = List.delete party threeParties
-              , contestationPeriod = 42
               , snapshotStrategy = SnapshotAfterEachTx
               }
 

local-cluster/bench/Bench/EndToEnd.hs

@@ -17,7 +17,7 @@ import Control.Monad.Class.MonadSTM (
   modifyTVar,
   newTVarIO,
  )
-import Data.Aeson (Value, (.=), encodeFile)
+import Data.Aeson (Value, encodeFile, (.=))
 import Data.Aeson.Lens (key, _Array, _Number)
 import qualified Data.Map as Map
 import Data.Scientific (floatingOrInteger)
@@ -66,8 +66,8 @@ bench workDir txs = do
           withHydraNode tracer workDir chainPorts 2 bobSk [aliceVk, carolVk] $ \n2 ->
             withHydraNode tracer workDir chainPorts 3 carolSk [aliceVk, bobVk] $ \n3 -> do
               waitForNodesConnected tracer [n1, n2, n3]
-              let contestationPeriod = 10 -- TODO: Should be part of init
-              send n1 $ input "init" []
+              let contestationPeriod = 10 :: Natural
+              send n1 $ input "init" ["contestationPeriod" .= contestationPeriod]
               waitFor tracer 3 [n1, n2, n3] $
                 output "readyToCommit" ["parties" .= [int 10, 20, 30]]
               send n1 $ input "commit" ["utxo" .= [int 1]]

local-cluster/test/Test/EndToEndSpec.hs

@@ -60,8 +60,8 @@ spec = around showLogsOnFailure $
               withHydraNode tracer tmpDir chainPorts 2 bobSk [aliceVk, carolVk] $ \n2 ->
                 withHydraNode tracer tmpDir chainPorts 3 carolSk [aliceVk, bobVk] $ \n3 -> do
                   waitForNodesConnected tracer [n1, n2, n3]
-                  let contestationPeriod = 10 -- TODO: Should be part of init
-                  send n1 $ input "init" []
+                  let contestationPeriod = 10 :: Natural
+                  send n1 $ input "init" ["contestationPeriod" .= contestationPeriod]
                   waitFor tracer 3 [n1, n2, n3] $
                     output "readyToCommit" ["parties" .= [int 10, 20, 30]]
                   send n1 $ input "commit" ["utxo" .= [int 1]]
@@ -111,7 +111,7 @@ spec = around showLogsOnFailure $
               withHydraNode tracer tmpDir mockPorts 2 bobSk [aliceVk, carolVk] $ \_n2 ->
                 withHydraNode tracer tmpDir mockPorts 3 carolSk [aliceVk, bobVk] $ \_n3 -> do
                   waitForNodesConnected tracer [n1]
-                  send n1 $ input "init" []
+                  send n1 $ input "init" ["contestationPeriod" .= int 10]
                   waitFor tracer 3 [n1] $ output "readyToCommit" ["parties" .= [int 10, 20, 30]]
                   metrics <- getMetrics n1
                   metrics `shouldSatisfy` ("hydra_head_events  4" `BS.isInfixOf`)