Remove contestationDeadline from OnCloseTx #279

This is not enforced so YAGNI

hydra-node/json-schemas/logs.yaml

@@ -861,9 +861,6 @@ definitions:
           snapshotNumber:
             type: integer
             minimum: 0
-          contestationDeadline:
-            type: string
-            format: date-time
       - title: OnContestTx
         type: object
         additionalProperties: false

hydra-node/src/Hydra/Chain.hs

@@ -80,7 +80,7 @@ data OnChainTx tx
   | OnCommitTx {party :: Party, committed :: UTxOType tx}
   | OnAbortTx
   | OnCollectComTx
-  | OnCloseTx {contestationDeadline :: UTCTime, snapshotNumber :: SnapshotNumber}
+  | OnCloseTx {snapshotNumber :: SnapshotNumber}
   | OnContestTx
   | OnFanoutTx
   deriving (Generic)

hydra-node/src/Hydra/Chain/Direct/Tx.hs

@@ -17,7 +17,6 @@ import Hydra.Prelude
 import qualified Cardano.Api.UTxO as UTxO
 import Cardano.Binary (decodeFull', serialize')
 import qualified Data.Map as Map
-import Data.Time (Day (ModifiedJulianDay), UTCTime (UTCTime))
 import Hydra.Chain (HeadId (..), HeadParameters (..), OnChainTx (..))
 import qualified Hydra.Contract.Commit as Commit
 import qualified Hydra.Contract.Head as Head
@@ -579,7 +578,7 @@ observeCloseTx utxo tx = do
       newHeadDatum <- lookupScriptData tx newHeadOutput
       snapshotNumber <- integerToNatural onChainSnapshotNumber
       pure
-        ( OnCloseTx{contestationDeadline, snapshotNumber}
+        ( OnCloseTx{snapshotNumber}
         , CloseObservation
             { threadOutput =
                 ( newHeadInput
@@ -594,9 +593,6 @@ observeCloseTx utxo tx = do
  where
   headScript = fromPlutusScript Head.validatorScript
 
-  -- FIXME(SN): store in/read from datum
-  contestationDeadline = UTCTime (ModifiedJulianDay 0) 0
-
 type FanoutObservation = ()
 
 -- | Identify a fanout tx by lookup up the input spending the Head output and

hydra-node/src/Hydra/HeadLogic.hs

@@ -307,7 +307,7 @@ update Environment{party, signingKey, otherParties} ledger st ev = case (st, ev)
                           }
                     )
                     []
-  (OpenState parameters CoordinatedHeadState{confirmedSnapshot}, OnChainEvent OnCloseTx{contestationDeadline}) ->
+  (OpenState parameters CoordinatedHeadState{confirmedSnapshot}, OnChainEvent OnCloseTx{}) ->
     -- TODO(1): Should check whether we want / can contest the close snapshot by
     --       comparing with our local state / utxo.
     --
@@ -319,8 +319,7 @@ update Environment{party, signingKey, otherParties} ledger st ev = case (st, ev)
       (ClosedState parameters $ getField @"utxo" $ getSnapshot confirmedSnapshot)
       [ ClientEffect $
           HeadIsClosed
-            { contestationDeadline
-            , latestSnapshot = getSnapshot confirmedSnapshot
+            { latestSnapshot = getSnapshot confirmedSnapshot
             }
       ]
   --

hydra-node/src/Hydra/ServerOutput.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Hydra.ServerOutput where
@@ -16,7 +15,7 @@ data ServerOutput tx
   | ReadyToCommit {parties :: Set Party}
   | Committed {party :: Party, utxo :: UTxOType tx}
   | HeadIsOpen {utxo :: UTxOType tx}
-  | HeadIsClosed {contestationDeadline :: UTCTime, latestSnapshot :: Snapshot tx}
+  | HeadIsClosed {latestSnapshot :: Snapshot tx}
   | HeadIsAborted {utxo :: UTxOType tx}
   | HeadIsFinalized {utxo :: UTxOType tx}
   | CommandFailed
@@ -51,7 +50,7 @@ instance (Arbitrary tx, Arbitrary (UTxOType tx), Arbitrary (TxIdType tx)) => Arb
     ReadyToCommit xs -> ReadyToCommit <$> shrink xs
     Committed p u -> Committed <$> shrink p <*> shrink u
     HeadIsOpen u -> HeadIsOpen <$> shrink u
-    HeadIsClosed t s -> HeadIsClosed t <$> shrink s
+    HeadIsClosed s -> HeadIsClosed <$> shrink s
     HeadIsFinalized u -> HeadIsFinalized <$> shrink u
     HeadIsAborted u -> HeadIsAborted <$> shrink u
     CommandFailed -> []

hydra-node/test/Hydra/BehaviorSpec.hs

@@ -45,7 +45,7 @@ import Hydra.Party (Party, SigningKey, aggregate, deriveParty, sign)
 import Hydra.ServerOutput (ServerOutput (..))
 import Hydra.Snapshot (Snapshot (..), getSnapshot)
 import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs)
-import Test.Util (shouldBe, shouldNotBe, shouldReturn, shouldRunInSim, shouldSatisfy, traceInIOSim)
+import Test.Util (shouldBe, shouldNotBe, shouldReturn, shouldRunInSim, traceInIOSim)
 
 spec :: Spec
 spec = parallel $ do
@@ -405,7 +405,7 @@ data ConnectToChain tx m = ConnectToChain
 -- patch" a 'HydraNode' such that it is connected. This is necessary, to get to
 -- know all nodes which use this function and simulate network and chain
 -- messages being sent around.
-simulatedChainAndNetwork :: (MonadSTM m, MonadTime m) => m (ConnectToChain tx m)
+simulatedChainAndNetwork :: (MonadSTM m) => m (ConnectToChain tx m)
 simulatedChainAndNetwork = do
   refHistory <- newTVarIO []
   nodes <- newTVarIO []
@@ -429,8 +429,7 @@ simulatedChainAndNetwork = do
     case res of
       Nothing -> pure ()
       Just ns -> do
-        time <- getCurrentTime
-        mapM_ (`handleChainTx` toOnChainTx time tx) ns
+        mapM_ (`handleChainTx` toOnChainTx tx) ns
 
   broadcast node nodes msg = do
     allNodes <- readTVarIO nodes
@@ -442,16 +441,15 @@ simulatedChainAndNetwork = do
 -- | Derive an 'OnChainTx' from 'PostChainTx' to simulate a "perfect" chain.
 -- NOTE(SN): This implementation does *NOT* honor the 'HeadParameters' and
 -- announces hard-coded contestationDeadlines.
-toOnChainTx :: UTCTime -> PostChainTx tx -> OnChainTx tx
-toOnChainTx currentTime = \case
+toOnChainTx :: PostChainTx tx -> OnChainTx tx
+toOnChainTx = \case
   InitTx HeadParameters{contestationPeriod, parties} -> OnInitTx{contestationPeriod, parties}
   (CommitTx pa ut) -> OnCommitTx pa ut
   AbortTx{} -> OnAbortTx
   CollectComTx{} -> OnCollectComTx
   (CloseTx confirmedSnapshot) ->
     OnCloseTx
-      { contestationDeadline = addUTCTime 10 currentTime
-      , snapshotNumber = number (getSnapshot confirmedSnapshot)
+      { snapshotNumber = number (getSnapshot confirmedSnapshot)
       }
   ContestTx{} -> OnContestTx
   FanoutTx{} -> OnFanoutTx
@@ -503,15 +501,13 @@ matchFanout = \case
   FanoutTx{} -> True
   _ -> False
 
-assertHeadIsClosed :: (HasCallStack, MonadThrow m, MonadTime m) => ServerOutput tx -> m ()
+assertHeadIsClosed :: (HasCallStack, MonadThrow m) => ServerOutput tx -> m ()
 assertHeadIsClosed = \case
-  HeadIsClosed{contestationDeadline} -> do
-    getCurrentTime >>= \t -> contestationDeadline `shouldSatisfy` (> t)
+  HeadIsClosed{} -> pure ()
   _ -> failure "expected HeadIsClosed"
 
-assertHeadIsClosedWith :: (HasCallStack, MonadThrow m, MonadTime m, IsTx tx) => Snapshot tx -> ServerOutput tx -> m ()
+assertHeadIsClosedWith :: (HasCallStack, MonadThrow m, IsTx tx) => Snapshot tx -> ServerOutput tx -> m ()
 assertHeadIsClosedWith expectedSnapshot = \case
-  HeadIsClosed{contestationDeadline, latestSnapshot} -> do
-    getCurrentTime >>= \t -> contestationDeadline `shouldSatisfy` (> t)
+  HeadIsClosed{latestSnapshot} -> do
     latestSnapshot `shouldBe` expectedSnapshot
   _ -> failure "expected HeadIsClosed"

hydra-node/test/Hydra/Chain/Direct/TxSpec.hs

@@ -132,7 +132,7 @@ spec =
                     & label (show (valueSize $ foldMap txOutValue inHeadUTxO) <> " Assets")
                     & counterexample ("Redeemer report: " <> show redeemerReport)
                     & counterexample ("Tx: " <> toString (renderTx tx))
-                    & cover 0.8 True "Success"
+                    & cover 80 True "Success"
 
     describe "abortTx" $ do
       prop "validates" $
@@ -167,7 +167,7 @@ spec =
                           & counterexample ("Redeemer report: " <> show redeemerReport)
                           & counterexample ("Tx: " <> toString (renderTx tx))
                           & counterexample ("Input utxo: " <> decodeUtf8 (encodePretty utxo))
-                          & cover 0.8 True "Success"
+                          & cover 80 True "Success"
 
       prop "cover fee correctly handles redeemers" $
         withMaxSuccess 60 $ \txIn cperiod (party :| parties) cardanoKeys walletUTxO ->

hydra-node/test/Hydra/HeadLogicSpec.hs

@@ -10,7 +10,7 @@ import Hydra.Prelude
 import Test.Hydra.Prelude
 
 import qualified Data.Set as Set
-import Hydra.Chain (HeadParameters (HeadParameters), OnChainTx (OnAbortTx, OnCollectComTx))
+import Hydra.Chain (HeadParameters (HeadParameters), OnChainTx (OnAbortTx, OnCloseTx, OnCollectComTx))
 import Hydra.HeadLogic (
   CoordinatedHeadState (..),
   Effect (..),
@@ -205,6 +205,12 @@ spec = do
         let s2 = update env ledger s1 invalidEvent
         s2 `shouldBe` Error (InvalidEvent invalidEvent s1)
 
+      it "any node should post FanoutTx when observing on-chain CloseTx" $ do
+        let s0 = inOpenState threeParties ledger
+            secondReqSn = OnChainEvent $ OnCloseTx 0
+
+        update env ledger s0 secondReqSn `shouldBe` Error (InvalidEvent secondReqSn s0)
+
 --
 -- Assertion utilities
 --

hydra-tui/src/Hydra/TUI.hs

@@ -63,7 +63,6 @@ import Hydra.ServerOutput (
     TxInvalid,
     TxSeen,
     TxValid,
-    contestationDeadline,
     me,
     parties,
     party,
@@ -140,7 +139,7 @@ data HeadState
   = Ready
   | Initializing {parties :: [Party], remainingParties :: [Party], utxo :: UTxO}
   | Open {parties :: [Party], utxo :: UTxO}
-  | Closed {contestationDeadline :: UTCTime}
+  | Closed
   | Final {utxo :: UTxO}
   deriving (Eq, Show, Generic)
 
@@ -255,8 +254,8 @@ handleAppEvent s = \case
   Update HeadIsOpen{utxo} ->
     s & headStateL %~ headIsOpen utxo
       & feedbackL ?~ UserFeedback Info "Head is now open!"
-  Update HeadIsClosed{contestationDeadline} ->
-    s & headStateL .~ Closed{contestationDeadline}
+  Update HeadIsClosed{} ->
+    s & headStateL .~ Closed{}
       & feedbackL ?~ UserFeedback Info "Head closed."
   Update HeadIsFinalized{utxo} ->
     s & headStateL .~ Final{utxo}
@@ -505,10 +504,9 @@ draw Client{sk} CardanoClient{networkId} s =
               , "[C]lose"
               , "[Q]uit"
               ]
-          Just Closed{contestationDeadline} ->
+          Just Closed{} ->
             withCommands
               [ drawHeadState
-              , padLeftRight 1 $ str $ "Contestation deadline: " <> show contestationDeadline
               ]
               ["[Q]uit"]
           Just Final{utxo} ->