From ab7815a790dec77fe357290eb2d872420a55ef2e Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Wed, 18 May 2022 15:01:36 +0000
Subject: [PATCH 01/24] Set Fanout tx lower bound and check it's above
 contestation deadline

---
 hydra-node/src/Hydra/Chain/Direct.hs          | 15 +++---
 hydra-node/src/Hydra/Chain/Direct/Context.hs  | 16 +++++-
 hydra-node/src/Hydra/Chain/Direct/State.hs    |  5 +-
 hydra-node/src/Hydra/Chain/Direct/Tx.hs       | 12 +++--
 .../src/Hydra/Ledger/Cardano/Builder.hs       | 11 +++-
 .../Hydra/Chain/Direct/Contract/Contest.hs    |  6 +--
 .../Hydra/Chain/Direct/Contract/FanOut.hs     | 35 +++++++++++--
 .../test/Hydra/Chain/Direct/StateSpec.hs      | 18 ++-----
 hydra-node/test/Hydra/Chain/Direct/TxSpec.hs  | 50 +------------------
 hydra-plutus/src/Hydra/Contract/Head.hs       | 18 +++++--
 10 files changed, 95 insertions(+), 91 deletions(-)

diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs
index b69efb36850..66ed52254c2 100644
--- a/hydra-node/src/Hydra/Chain/Direct.hs
+++ b/hydra-node/src/Hydra/Chain/Direct.hs
@@ -619,6 +619,9 @@ fromPostChainTx ::
   PostChainTx Tx ->
   STM m Tx
 fromPostChainTx TimeHandle{currentSlot, convertSlot} cardanoKeys wallet someHeadState tx = do
+  slot <- (+ closeGraceTime) <$> currentSlot
+  posixTime <- convertSlot slot
+  let pointInTime = (slot, posixTime)
   SomeOnChainHeadState st <- currentOnChainHeadState <$> readTVar someHeadState
   case (tx, reifyState st) of
     (InitTx params, TkIdle) -> do
@@ -643,16 +646,12 @@ fromPostChainTx TimeHandle{currentSlot, convertSlot} cardanoKeys wallet someHead
     -- that both states are consistent.
     (CollectComTx{}, TkInitialized) -> do
       pure (collect st)
-    (CloseTx{confirmedSnapshot}, TkOpen) -> do
-      slot <- (+ closeGraceTime) <$> currentSlot
-      posixTime <- convertSlot slot
-      pure (close confirmedSnapshot (slot, posixTime) st)
+    (CloseTx{confirmedSnapshot}, TkOpen) ->
+      pure (close confirmedSnapshot pointInTime st)
     (ContestTx{confirmedSnapshot}, TkClosed) -> do
-      slot <- (+ closeGraceTime) <$> currentSlot
-      posixTime <- convertSlot slot
-      pure (contest confirmedSnapshot (slot, posixTime) st)
+      pure (contest confirmedSnapshot pointInTime st)
     (FanoutTx{utxo}, TkClosed) ->
-      pure (fanout utxo st)
+      pure (fanout utxo pointInTime st)
     (_, _) ->
       throwIO $ InvalidStateToPost tx
 
diff --git a/hydra-node/src/Hydra/Chain/Direct/Context.hs b/hydra-node/src/Hydra/Chain/Direct/Context.hs
index 16ce64a4c62..33f5e1d5fc1 100644
--- a/hydra-node/src/Hydra/Chain/Direct/Context.hs
+++ b/hydra-node/src/Hydra/Chain/Direct/Context.hs
@@ -22,17 +22,18 @@ import Hydra.Chain.Direct.State (
   collect,
   commit,
   contest,
+  fanout,
   getContestationDeadline,
   idleOnChainHeadState,
   initialize,
   observeTx,
  )
 import qualified Hydra.Crypto as Hydra
-import Hydra.Ledger.Cardano (genOneUTxOFor, genTxIn, genVerificationKey, renderTx)
+import Hydra.Ledger.Cardano (genOneUTxOFor, genTxIn, genUTxO, genVerificationKey, renderTx, simplifyUTxO)
 import Hydra.Ledger.Cardano.Evaluate (genPointInTime, slotNoToPOSIXTime)
 import Hydra.Party (Party, deriveParty)
 import Hydra.Snapshot (ConfirmedSnapshot (..), Snapshot (..), SnapshotNumber, genConfirmedSnapshot, getSnapshot)
-import Test.QuickCheck (choose, elements, frequency, suchThat, vector)
+import Test.QuickCheck (choose, elements, frequency, resize, suchThat, vector)
 
 -- | Define some 'global' context from which generators can pick
 -- values for generation. This allows to write fairly independent generators
@@ -157,6 +158,17 @@ genContestTx numParties = do
       slotNoToPOSIXTime slot < getContestationDeadline stClosed
   pure (stClosed, contest snapshot pointInTime stClosed)
 
+genFanoutTx :: Int -> Gen (OnChainHeadState 'StClosed, Tx)
+genFanoutTx numParties = do
+  ctx <- genHydraContext numParties
+  let maxAssetsSupported = 1
+  utxo <- resize maxAssetsSupported $ simplifyUTxO <$> genUTxO
+  (_, stClosed) <- genStClosed ctx utxo
+  pointInTime <-
+    genPointInTime `suchThat` \(slot, _) ->
+      slotNoToPOSIXTime slot < getContestationDeadline stClosed
+  pure (stClosed, fanout utxo pointInTime stClosed)
+
 genStOpen ::
   HydraContext ->
   Gen (UTxO, OnChainHeadState 'StOpen)
diff --git a/hydra-node/src/Hydra/Chain/Direct/State.hs b/hydra-node/src/Hydra/Chain/Direct/State.hs
index af4ee198a17..e1f2a5128bd 100644
--- a/hydra-node/src/Hydra/Chain/Direct/State.hs
+++ b/hydra-node/src/Hydra/Chain/Direct/State.hs
@@ -344,11 +344,12 @@ contest confirmedSnapshot pointInTime OnChainHeadState{ownVerificationKey, state
 
 fanout ::
   UTxO ->
+  PointInTime ->
   OnChainHeadState 'StClosed ->
   Tx
-fanout utxo OnChainHeadState{stateMachine} = do
+fanout utxo pointInTime OnChainHeadState{stateMachine} = do
   let ClosedThreadOutput{closedThreadUTxO = (i, o, dat)} = closedThreadOutput
-   in fanoutTx utxo (i, o, dat) closedHeadTokenScript
+   in fanoutTx utxo (i, o, dat) pointInTime closedHeadTokenScript
  where
   Closed{closedThreadOutput, closedHeadTokenScript} = stateMachine
 
diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs
index 498bd021893..8dbcff03413 100644
--- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs
+++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs
@@ -27,7 +27,7 @@ import Hydra.Crypto (MultiSignature, toPlutusSignatures)
 import Hydra.Data.ContestationPeriod (addContestationPeriod, contestationPeriodFromDiffTime, contestationPeriodToDiffTime)
 import qualified Hydra.Data.ContestationPeriod as OnChain
 import qualified Hydra.Data.Party as OnChain
-import Hydra.Ledger.Cardano (hashTxOuts, setValiditityUpperBound)
+import Hydra.Ledger.Cardano (hashTxOuts, setValidityLowerBound, setValidityUpperBound)
 import Hydra.Ledger.Cardano.Builder (
   addExtraRequiredSigners,
   addInputs,
@@ -293,7 +293,7 @@ closeTx vk closing (slotNo, posixTime) openThreadOutput =
       & addInputs [(headInput, headWitness)]
       & addOutputs [headOutputAfter]
       & addExtraRequiredSigners [verificationKeyHash vk]
-      & setValiditityUpperBound slotNo
+      & setValidityUpperBound slotNo
  where
   OpenThreadOutput
     { openThreadUTxO = (headInput, headOutputBefore, ScriptDatumForTxIn -> headDatumBefore)
@@ -364,7 +364,7 @@ contestTx vk Snapshot{number, utxo} sig (slotNo, _) ClosedThreadOutput{closedThr
       & addInputs [(headInput, headWitness)]
       & addOutputs [headOutputAfter]
       & addExtraRequiredSigners [verificationKeyHash vk]
-      & setValiditityUpperBound slotNo
+      & setValidityUpperBound slotNo
  where
   headWitness =
     BuildTxWith $ ScriptWitness scriptWitnessCtx $ mkScriptWitness headScript headDatumBefore headRedeemer
@@ -394,15 +394,19 @@ fanoutTx ::
   UTxO ->
   -- | Everything needed to spend the Head state-machine output.
   UTxOWithScript ->
+  -- | Point in time at which this transaction is posted, used to set
+  -- lower bound.
+  PointInTime ->
   -- | Minting Policy script, made from initial seed
   PlutusScript ->
   Tx
-fanoutTx utxo (headInput, headOutput, ScriptDatumForTxIn -> headDatumBefore) headTokenScript =
+fanoutTx utxo (headInput, headOutput, ScriptDatumForTxIn -> headDatumBefore) (slotNo, _) headTokenScript =
   unsafeBuildTransaction $
     emptyTxBody
       & addInputs [(headInput, headWitness)]
       & addOutputs fanoutOutputs
       & burnTokens headTokenScript Burn headTokens
+      & setValidityLowerBound slotNo
  where
   headWitness =
     BuildTxWith $ ScriptWitness scriptWitnessCtx $ mkScriptWitness headScript headDatumBefore headRedeemer
diff --git a/hydra-node/src/Hydra/Ledger/Cardano/Builder.hs b/hydra-node/src/Hydra/Ledger/Cardano/Builder.hs
index c78ec3962ba..ec2cc4d245e 100644
--- a/hydra-node/src/Hydra/Ledger/Cardano/Builder.hs
+++ b/hydra-node/src/Hydra/Ledger/Cardano/Builder.hs
@@ -133,8 +133,15 @@ burnTokens script redeemer assets =
   mintTokens script redeemer (fmap (second negate) assets)
 
 -- | Set the upper validity bound for this transaction to some 'SlotNo'.
-setValiditityUpperBound :: SlotNo -> TxBuilder -> TxBuilder
-setValiditityUpperBound slotNo tx =
+setValidityUpperBound :: SlotNo -> TxBuilder -> TxBuilder
+setValidityUpperBound slotNo tx =
   tx{txValidityRange = (lower, TxValidityUpperBound slotNo)}
  where
   (lower, _upper) = txValidityRange tx
+
+-- | Set the lower validity bound for this transaction to some 'SlotNo'.
+setValidityLowerBound :: SlotNo -> TxBuilder -> TxBuilder
+setValidityLowerBound slotNo tx =
+  tx{txValidityRange = (TxValidityLowerBound slotNo, upper)}
+ where
+  (_lower, upper) = txValidityRange tx
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs
index 682773ae739..2e2535a81af 100644
--- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs
@@ -68,9 +68,6 @@ healthyContestTx =
       , closedContestationDeadline = healthyContestationDeadline
       }
 
-healthySlotNo :: SlotNo
-healthySlotNo = arbitrary `generateWith` 42
-
 addParticipationTokens :: [Party] -> TxOut CtxUTxO -> TxOut CtxUTxO
 addParticipationTokens parties (TxOut addr val datum) =
   TxOut addr val' datum
@@ -111,6 +108,9 @@ healthyClosedState =
     , contestationDeadline = healthyContestationDeadline
     }
 
+healthySlotNo :: SlotNo
+healthySlotNo = arbitrary `generateWith` 42
+
 healthyContestationDeadline :: POSIXTime
 healthyContestationDeadline =
   fromInteger
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs
index 0a3f42fc3e0..29791731ac8 100644
--- a/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-deprecations #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Hydra.Chain.Direct.Contract.FanOut where
@@ -19,9 +20,10 @@ import Hydra.Ledger.Cardano (
   genValue,
   hashTxOuts,
  )
+import Hydra.Ledger.Cardano.Evaluate (slotNoToPOSIXTime)
 import Hydra.Party (partyToChain)
 import Plutus.Orphans ()
-import Plutus.V1.Ledger.Api (toBuiltin, toData)
+import Plutus.V1.Ledger.Api (POSIXTime, toBuiltin, toData)
 import Test.QuickCheck (elements, oneof, suchThat, vectorOf)
 import Test.QuickCheck.Instances ()
 
@@ -29,12 +31,23 @@ healthyFanoutTx :: (Tx, UTxO)
 healthyFanoutTx =
   (tx, lookupUTxO)
  where
-  tx = fanoutTx healthyFanoutUTxO (headInput, headOutput, headDatum) headTokenScript
+  tx =
+    fanoutTx
+      healthyFanoutUTxO
+      (headInput, headOutput, headDatum)
+      (healthySlotNo, slotNoToPOSIXTime healthySlotNo)
+      headTokenScript
+
   headInput = generateWith arbitrary 42
+
   headTokenScript = mkHeadTokenScript testSeedInput
+
   headOutput' = mkHeadOutput testNetworkId testPolicyId (toUTxOContext $ mkTxOutDatum healthyFanoutDatum)
+
   parties = generateWith (vectorOf 3 (arbitrary @(VerificationKey PaymentKey))) 42
+
   headOutput = modifyTxOutValue (<> participationTokens) headOutput'
+
   participationTokens =
     valueFromList $
       map
@@ -42,7 +55,9 @@ healthyFanoutTx =
             (AssetId testPolicyId (AssetName . serialiseToRawBytes . verificationKeyHash $ vk), 1)
         )
         parties
+
   headDatum = fromPlutusData $ toData healthyFanoutDatum
+
   lookupUTxO = UTxO.singleton (headInput, headOutput)
 
 healthyFanoutUTxO :: UTxO
@@ -50,18 +65,26 @@ healthyFanoutUTxO =
   -- FIXME: fanoutTx would result in 0 outputs and MutateChangeOutputValue below fail
   adaOnly <$> generateWith (genUTxOWithSimplifiedAddresses `suchThat` (not . null)) 42
 
+healthySlotNo :: SlotNo
+healthySlotNo = arbitrary `generateWith` 42
+
+healthyContestationDeadline :: POSIXTime
+healthyContestationDeadline =
+  slotNoToPOSIXTime $ healthySlotNo - 1
+
 healthyFanoutDatum :: Head.State
 healthyFanoutDatum =
   Head.Closed
     { snapshotNumber = 1
     , utxoHash = toBuiltin $ hashTxOuts $ toList healthyFanoutUTxO
     , parties = partyToChain <$> arbitrary `generateWith` 42
-    , contestationDeadline = arbitrary `generateWith` 42
+    , contestationDeadline = healthyContestationDeadline
     }
 
 data FanoutMutation
   = MutateAddUnexpectedOutput
   | MutateChangeOutputValue
+  | MutateValidityBeforeDeadline
   deriving (Generic, Show, Enum, Bounded)
 
 genFanoutMutation :: (Tx, UTxO) -> Gen SomeMutation
@@ -77,4 +100,10 @@ genFanoutMutation (tx, _utxo) =
         (ix, out) <- elements (zip [0 .. length outs - 1] outs)
         value' <- genValue `suchThat` (/= txOutValue out)
         pure $ ChangeOutput (fromIntegral ix) (modifyTxOutValue (const value') out)
+    , SomeMutation MutateValidityBeforeDeadline . ChangeValidityInterval <$> do
+        lb <- arbitrary `suchThat` slotBeforeContestationDeadline
+        pure (TxValidityLowerBound lb, TxValidityNoUpperBound)
     ]
+ where
+  slotBeforeContestationDeadline slotNo =
+    slotNoToPOSIXTime slotNo < healthyContestationDeadline
diff --git a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs
index 9b12afcd193..03b394551c6 100644
--- a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs
@@ -54,9 +54,9 @@ import Hydra.Chain.Direct.Context (
   genCommit,
   genCommits,
   genContestTx,
+  genFanoutTx,
   genHydraContext,
   genInitTx,
-  genStClosed,
   genStIdle,
   genStInitialized,
   unsafeCommit,
@@ -73,7 +73,6 @@ import Hydra.Chain.Direct.State (
   TransitionFrom (..),
   abort,
   commit,
-  fanout,
   getKnownUTxO,
   idleOnChainHeadState,
   initialize,
@@ -82,11 +81,9 @@ import Hydra.Chain.Direct.State (
 import Hydra.Chain.Direct.Util (Block)
 import Hydra.Ledger.Cardano (
   genTxIn,
-  genUTxO,
   genValue,
   renderTx,
   renderTxs,
-  simplifyUTxO,
  )
 import Hydra.Ledger.Cardano.Evaluate (evaluateTx')
 import Ouroboros.Consensus.Block (Point, blockPoint)
@@ -114,7 +111,6 @@ import Test.QuickCheck (
   forAllBlind,
   forAllShow,
   label,
-  resize,
   sublistOf,
   (==>),
  )
@@ -521,15 +517,11 @@ forAllFanout ::
   (Testable property) =>
   (OnChainHeadState 'StClosed -> Tx -> property) ->
   Property
-forAllFanout action = do
-  forAll (genHydraContext 3) $ \ctx ->
-    forAllShow (resize maxAssetsSupported $ simplifyUTxO <$> genUTxO) renderUTxO $ \utxo ->
-      forAll (genStClosed ctx utxo) $ \(_, stClosed) ->
-        action stClosed (fanout utxo stClosed)
-          & label ("Fanout size: " <> prettyLength (assetsInUtxo utxo))
+forAllFanout action =
+  forAll (genFanoutTx 3) $ \(stClosed, tx) ->
+    action stClosed tx
+      & label ("Fanout size: " <> prettyLength (assetsInUtxo $ getKnownUTxO stClosed))
  where
-  maxAssetsSupported = 1
-
   assetsInUtxo = valueSize . foldMap txOutValue
 
   prettyLength len
diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs
index 5bbf2c2a757..8e0860a3a2c 100644
--- a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs
@@ -40,14 +40,11 @@ import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime)
 import Hydra.Ledger.Cardano (
   adaOnly,
   genOneUTxOFor,
-  genUTxO,
   genVerificationKey,
-  hashTxOuts,
   renderTx,
-  simplifyUTxO,
  )
 import Hydra.Party (Party, partyToChain)
-import Plutus.V1.Ledger.Api (toBuiltin, toData)
+import Plutus.V1.Ledger.Api (toData)
 import Test.Cardano.Ledger.Alonzo.Serialisation.Generators ()
 import Test.QuickCheck (
   Property,
@@ -61,7 +58,6 @@ import Test.QuickCheck (
   label,
   oneof,
   property,
-  resize,
   suchThat,
   vectorOf,
   withMaxSuccess,
@@ -109,50 +105,6 @@ spec =
                               & counterexample ("Tx: " <> renderTx tx)
                           ]
 
-    describe "fanoutTx" $ do
-      prop "validates" $ \headInput ->
-        forAll (resize 70 $ simplifyUTxO <$> genUTxO) $ \inHeadUTxO ->
-          let tx =
-                fanoutTx
-                  inHeadUTxO
-                  (headInput, headOutput, fromPlutusData $ toData headDatum)
-                  (mkHeadTokenScript testSeedInput)
-              onChainUTxO = UTxO.singleton (headInput, headOutput)
-              headScript = fromPlutusScript Head.validatorScript
-              -- FIXME: Ensure the headOutput contains enough value to fanout all inHeadUTxO
-              headOutput =
-                TxOut
-                  (mkScriptAddress @PlutusScriptV1 testNetworkId headScript)
-                  ( lovelaceToValue (Lovelace 10_000_000)
-                      <> valueFromList
-                        [ (AssetId (headPolicyId testSeedInput) hydraHeadV1AssetName, 1)
-                        ]
-                  )
-                  (toUTxOContext $ mkTxOutDatum headDatum)
-              headDatum =
-                Head.Closed
-                  { snapshotNumber = 1
-                  , utxoHash = toBuiltin (hashTxOuts $ toList inHeadUTxO)
-                  , parties = []
-                  , contestationDeadline = 0
-                  }
-           in checkCoverage $ case validateTxScriptsUnlimited onChainUTxO tx of
-                Left basicFailure ->
-                  property False & counterexample ("Basic failure: " <> show basicFailure)
-                Right redeemerReport ->
-                  conjoin
-                    [ 1 == length (successfulRedeemersSpending redeemerReport)
-                        & counterexample "Wrong count of spend redeemer(s)"
-                    , 1 == length (successfulRedeemersMinting redeemerReport)
-                        & counterexample "Wrong count of mint redeemer(s)"
-                    , withinTxExecutionBudget redeemerReport
-                    ]
-                    & label (show (length inHeadUTxO) <> " UTXO")
-                    & label (show (valueSize $ foldMap txOutValue inHeadUTxO) <> " Assets")
-                    & counterexample ("Redeemer report: " <> show redeemerReport)
-                    & counterexample ("Tx: " <> renderTx tx)
-                    & cover 80 True "Success"
-
     describe "abortTx" $ do
       prop "validates" $
         forAll (vectorOf 4 arbitrary) $ \parties ->
diff --git a/hydra-plutus/src/Hydra/Contract/Head.hs b/hydra-plutus/src/Hydra/Contract/Head.hs
index 8b349fb23a6..bfbc063c755 100644
--- a/hydra-plutus/src/Hydra/Contract/Head.hs
+++ b/hydra-plutus/src/Hydra/Contract/Head.hs
@@ -32,6 +32,7 @@ import Plutus.V1.Ledger.Api (
   DatumHash,
   FromData (fromBuiltinData),
   Interval (..),
+  LowerBound (LowerBound),
   POSIXTime,
   PubKeyHash (getPubKeyHash),
   Script,
@@ -85,8 +86,8 @@ headValidator commitAddress initialAddress oldState input context =
       checkClose context headContext parties initialUtxoHash snapshotNumber closedUtxoHash signature contestationPeriod
     (Closed{parties, snapshotNumber = closedSnapshotNumber, contestationDeadline}, Contest{snapshotNumber = contestSnapshotNumber, utxoHash = contestUtxoHash, signature}) ->
       checkContest context headContext contestationDeadline parties closedSnapshotNumber contestSnapshotNumber contestUtxoHash signature
-    (Closed{utxoHash}, Fanout{numberOfFanoutOutputs}) ->
-      checkFanout utxoHash numberOfFanoutOutputs context
+    (Closed{utxoHash, contestationDeadline}, Fanout{numberOfFanoutOutputs}) ->
+      checkFanout utxoHash contestationDeadline numberOfFanoutOutputs context
     _ ->
       traceError "invalid head state transition"
  where
@@ -368,7 +369,7 @@ checkContest ctx@ScriptContext{scriptContextTxInfo} headContext contestationDead
   mustBeWithinContestationPeriod =
     case ivTo (txInfoValidRange scriptContextTxInfo) of
       UpperBound (Finite time) _ -> traceIfFalse "upper bound validity beyond contestation deadline" $ time < contestationDeadline
-      _ -> traceError "no upper bound validity interval defined for close"
+      _ -> traceError "no upper bound validity interval defined for contest"
 {-# INLINEABLE checkContest #-}
 
 checkHeadOutputDatum :: ToData a => ScriptContext -> a -> Bool
@@ -401,14 +402,21 @@ txInfoAdaFee tx = valueOf (txInfoFee tx) adaSymbol adaToken
 
 checkFanout ::
   BuiltinByteString ->
+  POSIXTime ->
   Integer ->
   ScriptContext ->
   Bool
-checkFanout utxoHash numberOfFanoutOutputs ScriptContext{scriptContextTxInfo = txInfo} =
-  traceIfFalse "fannedOutUtxoHash /= closedUtxoHash" $ fannedOutUtxoHash == utxoHash
+checkFanout utxoHash contestationDeadline numberOfFanoutOutputs ScriptContext{scriptContextTxInfo = txInfo} =
+  hasSameUTxOHash && afterContestationDeadline
  where
+  hasSameUTxOHash = traceIfFalse "fannedOutUtxoHash /= closedUtxoHash" $ fannedOutUtxoHash == utxoHash
   fannedOutUtxoHash = hashTxOuts $ take numberOfFanoutOutputs txInfoOutputs
   TxInfo{txInfoOutputs} = txInfo
+
+  afterContestationDeadline =
+    case ivFrom (txInfoValidRange txInfo) of
+      LowerBound (Finite time) _ -> traceIfFalse "lower bound validity before contestation deadline" $ time > contestationDeadline
+      _ -> traceError "no lower bound validity interval defined for fanout"
 {-# INLINEABLE checkFanout #-}
 
 (&) :: a -> (a -> b) -> b

From 25fad005a1ce47812bf8bcfb9d847cc853f1c455 Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Wed, 18 May 2022 16:11:11 +0000
Subject: [PATCH 02/24] Do not adjust fanout lower bound

We added a grace period of 100 slots meaning the transaction is very
likely to be rejected when we post it, esp. in a test setting. As ETE
test is also failing because we don't wait enough, this should make it
possible to have the ETE tests pass but we should have a better story
for resubmitting transactions.
---
 hydra-node/src/Hydra/Chain/Direct.hs         | 42 +++++++++++---------
 hydra-node/src/Hydra/Chain/Direct/Context.hs |  2 +-
 2 files changed, 24 insertions(+), 20 deletions(-)

diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs
index 66ed52254c2..8f18c688e65 100644
--- a/hydra-node/src/Hydra/Chain/Direct.hs
+++ b/hydra-node/src/Hydra/Chain/Direct.hs
@@ -106,6 +106,7 @@ import Hydra.Chain.Direct.State (
   observeSomeTx,
   reifyState,
  )
+import Hydra.Chain.Direct.Tx (PointInTime)
 import Hydra.Chain.Direct.Util (
   Block,
   Era,
@@ -163,7 +164,6 @@ import Ouroboros.Network.Protocol.LocalTxSubmission.Client (
   SubmitResult (..),
   localTxSubmissionClientPeer,
  )
-import Plutus.V1.Ledger.Api (POSIXTime)
 import Test.Cardano.Ledger.Alonzo.Serialisation.Generators ()
 
 withDirectChain ::
@@ -266,11 +266,11 @@ withDirectChain tracer networkId iocp socketPath keyPair party cardanoKeys point
         }
 
 data TimeHandle m = TimeHandle
-  { currentSlot :: m SlotNo
-  , -- | Convert some slot into an absolute point in time.
-    -- It throws an exception when requesting a `SlotNo` that is
-    -- more than the current epoch length (5 days at time of writing this comment).
-    convertSlot :: MonadThrow m => SlotNo -> m POSIXTime
+  { -- | Get the current 'PointInTime'
+    currentSlot :: m PointInTime
+  , -- | Adjust a 'PointInTime' by some number of slots, positively or
+    -- negatively.
+    adjustSlot :: SlotNo -> PointInTime -> m PointInTime
   }
 
 -- | Query ad-hoc epoch, system start and protocol parameters to determine
@@ -282,14 +282,18 @@ queryTimeHandle networkId socketPath = do
   let epochInfo = toEpochInfo eraHistory
   pparams <- queryProtocolParameters networkId socketPath
   slotNo <- queryTipSlotNo networkId socketPath
+  let toTime =
+        slotToPOSIXTime
+          (toLedgerPParams ShelleyBasedEraAlonzo pparams :: PParams LedgerEra)
+          epochInfo
+          systemStart
   pure $
     TimeHandle
-      { currentSlot = pure slotNo
-      , convertSlot =
-          slotToPOSIXTime
-            (toLedgerPParams ShelleyBasedEraAlonzo pparams :: PParams LedgerEra)
-            epochInfo
-            systemStart
+      { currentSlot = (slotNo,) <$> toTime slotNo
+      , adjustSlot = \n (slot, _) -> do
+          let adjusted = slot + n
+          time <- toTime adjusted
+          pure (adjusted, time)
       }
  where
   toEpochInfo :: MonadThrow m => EraHistory CardanoMode -> EpochInfo m
@@ -618,10 +622,8 @@ fromPostChainTx ::
   TVar m SomeOnChainHeadStateAt ->
   PostChainTx Tx ->
   STM m Tx
-fromPostChainTx TimeHandle{currentSlot, convertSlot} cardanoKeys wallet someHeadState tx = do
-  slot <- (+ closeGraceTime) <$> currentSlot
-  posixTime <- convertSlot slot
-  let pointInTime = (slot, posixTime)
+fromPostChainTx TimeHandle{currentSlot, adjustSlot} cardanoKeys wallet someHeadState tx = do
+  pointInTime <- currentSlot
   SomeOnChainHeadState st <- currentOnChainHeadState <$> readTVar someHeadState
   case (tx, reifyState st) of
     (InitTx params, TkIdle) -> do
@@ -646,10 +648,12 @@ fromPostChainTx TimeHandle{currentSlot, convertSlot} cardanoKeys wallet someHead
     -- that both states are consistent.
     (CollectComTx{}, TkInitialized) -> do
       pure (collect st)
-    (CloseTx{confirmedSnapshot}, TkOpen) ->
-      pure (close confirmedSnapshot pointInTime st)
+    (CloseTx{confirmedSnapshot}, TkOpen) -> do
+      shifted <- adjustSlot closeGraceTime pointInTime
+      pure (close confirmedSnapshot shifted st)
     (ContestTx{confirmedSnapshot}, TkClosed) -> do
-      pure (contest confirmedSnapshot pointInTime st)
+      shifted <- adjustSlot closeGraceTime pointInTime
+      pure (contest confirmedSnapshot shifted st)
     (FanoutTx{utxo}, TkClosed) ->
       pure (fanout utxo pointInTime st)
     (_, _) ->
diff --git a/hydra-node/src/Hydra/Chain/Direct/Context.hs b/hydra-node/src/Hydra/Chain/Direct/Context.hs
index 33f5e1d5fc1..7bb464112ff 100644
--- a/hydra-node/src/Hydra/Chain/Direct/Context.hs
+++ b/hydra-node/src/Hydra/Chain/Direct/Context.hs
@@ -166,7 +166,7 @@ genFanoutTx numParties = do
   (_, stClosed) <- genStClosed ctx utxo
   pointInTime <-
     genPointInTime `suchThat` \(slot, _) ->
-      slotNoToPOSIXTime slot < getContestationDeadline stClosed
+      slotNoToPOSIXTime slot > getContestationDeadline stClosed
   pure (stClosed, fanout utxo pointInTime stClosed)
 
 genStOpen ::

From 551fad2a9633b71b36fde3e9d26cff99bc26f263 Mon Sep 17 00:00:00 2001
From: Sebastian Nagel <sebastian.nagel@ncoding.at>
Date: Thu, 19 May 2022 10:14:51 +0200
Subject: [PATCH 03/24] Use protocol version 6 in hydra-cluster

This fixes slot to posix time conversion!
---
 hydra-cluster/config/genesis-shelley.json | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/hydra-cluster/config/genesis-shelley.json b/hydra-cluster/config/genesis-shelley.json
index cd7a81255c3..bf24bdd4e41 100644
--- a/hydra-cluster/config/genesis-shelley.json
+++ b/hydra-cluster/config/genesis-shelley.json
@@ -4,7 +4,7 @@
         "poolDeposit": 0,
         "protocolVersion": {
             "minor": 0,
-            "major": 0
+            "major": 6
         },
         "minUTxOValue": 0,
         "decentralisationParam": 1,

From 3bd4d47d228deefb5efaecf6c0b9bf2e9261b894 Mon Sep 17 00:00:00 2001
From: Sebastian Nagel <sebastian.nagel@ncoding.at>
Date: Thu, 19 May 2022 10:17:32 +0200
Subject: [PATCH 04/24] Rename TimeHandle functions to be consistent

---
 hydra-node/src/Hydra/Chain/Direct.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs
index 8f18c688e65..afc6e29ab07 100644
--- a/hydra-node/src/Hydra/Chain/Direct.hs
+++ b/hydra-node/src/Hydra/Chain/Direct.hs
@@ -267,10 +267,10 @@ withDirectChain tracer networkId iocp socketPath keyPair party cardanoKeys point
 
 data TimeHandle m = TimeHandle
   { -- | Get the current 'PointInTime'
-    currentSlot :: m PointInTime
+    currentPointInTime :: m PointInTime
   , -- | Adjust a 'PointInTime' by some number of slots, positively or
     -- negatively.
-    adjustSlot :: SlotNo -> PointInTime -> m PointInTime
+    adjustPointInTime :: SlotNo -> PointInTime -> m PointInTime
   }
 
 -- | Query ad-hoc epoch, system start and protocol parameters to determine
@@ -289,8 +289,8 @@ queryTimeHandle networkId socketPath = do
           systemStart
   pure $
     TimeHandle
-      { currentSlot = (slotNo,) <$> toTime slotNo
-      , adjustSlot = \n (slot, _) -> do
+      { currentPointInTime = (slotNo,) <$> toTime slotNo
+      , adjustPointInTime = \n (slot, _) -> do
           let adjusted = slot + n
           time <- toTime adjusted
           pure (adjusted, time)
@@ -622,8 +622,8 @@ fromPostChainTx ::
   TVar m SomeOnChainHeadStateAt ->
   PostChainTx Tx ->
   STM m Tx
-fromPostChainTx TimeHandle{currentSlot, adjustSlot} cardanoKeys wallet someHeadState tx = do
-  pointInTime <- currentSlot
+fromPostChainTx TimeHandle{currentPointInTime, adjustPointInTime} cardanoKeys wallet someHeadState tx = do
+  pointInTime <- currentPointInTime
   SomeOnChainHeadState st <- currentOnChainHeadState <$> readTVar someHeadState
   case (tx, reifyState st) of
     (InitTx params, TkIdle) -> do
@@ -649,10 +649,10 @@ fromPostChainTx TimeHandle{currentSlot, adjustSlot} cardanoKeys wallet someHeadS
     (CollectComTx{}, TkInitialized) -> do
       pure (collect st)
     (CloseTx{confirmedSnapshot}, TkOpen) -> do
-      shifted <- adjustSlot closeGraceTime pointInTime
+      shifted <- adjustPointInTime closeGraceTime pointInTime
       pure (close confirmedSnapshot shifted st)
     (ContestTx{confirmedSnapshot}, TkClosed) -> do
-      shifted <- adjustSlot closeGraceTime pointInTime
+      shifted <- adjustPointInTime closeGraceTime pointInTime
       pure (contest confirmedSnapshot shifted st)
     (FanoutTx{utxo}, TkClosed) ->
       pure (fanout utxo pointInTime st)

From c0c546f3deeaf4d1adf3dd647be31dd97e0a9b80 Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Thu, 19 May 2022 08:35:49 +0000
Subject: [PATCH 05/24] Add grace period before posting fanout tx

---
 hydra-cluster/test/Test/EndToEndSpec.hs | 3 ++-
 hydra-node/src/Hydra/HeadLogic.hs       | 7 ++++++-
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs
index da071eeb707..89267d63d08 100644
--- a/hydra-cluster/test/Test/EndToEndSpec.hs
+++ b/hydra-cluster/test/Test/EndToEndSpec.hs
@@ -341,7 +341,8 @@ initAndClose tracer clusterIx node@(RunningNode _ nodeSocket) = do
         snapshotNumber <- v ^? key "snapshotNumber"
         guard $ snapshotNumber == toJSON expectedSnapshotNumber
 
-      waitFor tracer (contestationPeriod + 3) [n1] $
+      -- NOTE: 6 = 2 * hardcoded gracePeriod
+      waitFor tracer (contestationPeriod + 6) [n1] $
         output "HeadIsFinalized" ["utxo" .= newUTxO]
 
       case fromJSON $ toJSON newUTxO of
diff --git a/hydra-node/src/Hydra/HeadLogic.hs b/hydra-node/src/Hydra/HeadLogic.hs
index 385503a549b..9d97ac657c0 100644
--- a/hydra-node/src/Hydra/HeadLogic.hs
+++ b/hydra-node/src/Hydra/HeadLogic.hs
@@ -401,7 +401,7 @@ update Environment{party, signingKey, otherParties} ledger st ev = case (st, ev)
                   -- upper validity bound of the close transaction. The contestation
                   -- period here is really a minimum. At the moment, this isn't enforced
                   -- on-chain anyway so it's only faking it (until we make it).
-                  delay = contestationPeriod
+                  delay = contestationPeriod + gracePeriod
                 , reason = WaitOnContestationPeriod
                 , event = ShouldPostFanout
                 }
@@ -442,6 +442,11 @@ update Environment{party, signingKey, otherParties} ledger st ev = case (st, ev)
     SeenSnapshot{} -> True
     _ -> False
 
+-- | Some time buffer before submitting `ShouldPostFanout` event to cope with time drifting.
+-- FIXME: we should rather follow chain's "time" (slots) and use at as reference
+gracePeriod :: DiffTime
+gracePeriod = 3
+
 data SnapshotOutcome tx
   = ShouldSnapshot SnapshotNumber [tx] -- TODO(AB) : should really be a Set (TxId tx)
   | ShouldNotSnapshot NoSnapshotReason

From 3bfadfe7873492b557d629e9f7b5ed0e8d036402 Mon Sep 17 00:00:00 2001
From: Sebastian Nagel <sebastian.nagel@ncoding.at>
Date: Thu, 19 May 2022 11:00:44 +0200
Subject: [PATCH 06/24] Increase grace periods and timeouts to make it pass

---
 hydra-cluster/test/Test/EndToEndSpec.hs |  6 +++---
 hydra-node/src/Hydra/Chain/Direct.hs    |  4 ++--
 hydra-node/src/Hydra/HeadLogic.hs       | 20 ++++++++++++--------
 3 files changed, 17 insertions(+), 13 deletions(-)

diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs
index 89267d63d08..e0e5f4e41a7 100644
--- a/hydra-cluster/test/Test/EndToEndSpec.hs
+++ b/hydra-cluster/test/Test/EndToEndSpec.hs
@@ -86,7 +86,7 @@ spec = around showLogsOnFailure $ do
   describe "End-to-end test using a single cardano-node" $ do
     describe "three hydra nodes scenario" $
       it "inits a Head, processes a single Cardano transaction and closes it again" $ \tracer ->
-        failAfter 60 $
+        failAfter 600 $
           withTempDir "end-to-end-cardano-node" $ \tmpDir -> do
             config <- newNodeConfig tmpDir
             withBFTNode (contramap FromCardanoNode tracer) config $ \node -> do
@@ -341,8 +341,8 @@ initAndClose tracer clusterIx node@(RunningNode _ nodeSocket) = do
         snapshotNumber <- v ^? key "snapshotNumber"
         guard $ snapshotNumber == toJSON expectedSnapshotNumber
 
-      -- NOTE: 6 = 2 * hardcoded gracePeriod
-      waitFor tracer (contestationPeriod + 6) [n1] $
+      -- NOTE: Hardcoded 'fanoutGracePeriod' + some three secs longer
+      waitFor tracer (contestationPeriod + 100 + 3) [n1] $
         output "HeadIsFinalized" ["utxo" .= newUTxO]
 
       case fromJSON $ toJSON newUTxO of
diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs
index afc6e29ab07..614732cd3c5 100644
--- a/hydra-node/src/Hydra/Chain/Direct.hs
+++ b/hydra-node/src/Hydra/Chain/Direct.hs
@@ -608,8 +608,8 @@ finalizeTx TinyWallet{sign, getUTxO, coverFee} headState partialTx = do
     Right validatedTx -> do
       pure $ sign validatedTx
 
--- | Hardcoded grace time for close transaction to be valid.
--- TODO: replace/remove with deadline contestation
+-- | Hardcoded grace time for close transaction to be valid. See also
+-- 'fanoutGracePeriod' in the HeadLogic.
 -- TODO: make it a node configuration parameter
 closeGraceTime :: SlotNo
 closeGraceTime = 100
diff --git a/hydra-node/src/Hydra/HeadLogic.hs b/hydra-node/src/Hydra/HeadLogic.hs
index 9d97ac657c0..6747054e5fc 100644
--- a/hydra-node/src/Hydra/HeadLogic.hs
+++ b/hydra-node/src/Hydra/HeadLogic.hs
@@ -398,10 +398,10 @@ update Environment{party, signingKey, otherParties} ledger st ev = case (st, ev)
               -- may want to only post fanout once we have contested.
               Delay
                 { -- TODO: In principle, we want to start the stopwatch from the
-                  -- upper validity bound of the close transaction. The contestation
-                  -- period here is really a minimum. At the moment, this isn't enforced
-                  -- on-chain anyway so it's only faking it (until we make it).
-                  delay = contestationPeriod + gracePeriod
+                  -- upper validity bound of the close transaction. The
+                  -- contestation period here is really a minimum. We add the
+                  -- grace period here to cope for this.
+                  delay = contestationPeriod + fanoutGracePeriod
                 , reason = WaitOnContestationPeriod
                 , event = ShouldPostFanout
                 }
@@ -442,10 +442,14 @@ update Environment{party, signingKey, otherParties} ledger st ev = case (st, ev)
     SeenSnapshot{} -> True
     _ -> False
 
--- | Some time buffer before submitting `ShouldPostFanout` event to cope with time drifting.
--- FIXME: we should rather follow chain's "time" (slots) and use at as reference
-gracePeriod :: DiffTime
-gracePeriod = 3
+-- | Some time buffer before submitting `ShouldPostFanout` event to cope with
+-- time drifting and the fact that we start our stopwatch when we observe the
+-- close transaction, not from it's upper bound validity.
+-- NOTE: This needs to be AT LEAST the 'closeGraceTime' equivalent of the
+-- slowest chain we want to support. For example, 100 slots * 1 slot / s = 100 secs
+-- FIXME: we should rather follow chain's "time" (slots) and use that as reference
+fanoutGracePeriod :: DiffTime
+fanoutGracePeriod = 100
 
 data SnapshotOutcome tx
   = ShouldSnapshot SnapshotNumber [tx] -- TODO(AB) : should really be a Set (TxId tx)

From a083f8356c0433f30d05bd6e95d6d704b1075bb6 Mon Sep 17 00:00:00 2001
From: Sebastian Nagel <sebastian.nagel@ncoding.at>
Date: Fri, 20 May 2022 10:43:42 +0200
Subject: [PATCH 07/24] Change our expectation on the e2e test

---
 hydra-cluster/test/Test/EndToEndSpec.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs
index e0e5f4e41a7..64f9dee6ac3 100644
--- a/hydra-cluster/test/Test/EndToEndSpec.hs
+++ b/hydra-cluster/test/Test/EndToEndSpec.hs
@@ -86,7 +86,7 @@ spec = around showLogsOnFailure $ do
   describe "End-to-end test using a single cardano-node" $ do
     describe "three hydra nodes scenario" $
       it "inits a Head, processes a single Cardano transaction and closes it again" $ \tracer ->
-        failAfter 600 $
+        failAfter 60 $
           withTempDir "end-to-end-cardano-node" $ \tmpDir -> do
             config <- newNodeConfig tmpDir
             withBFTNode (contramap FromCardanoNode tracer) config $ \node -> do
@@ -341,8 +341,9 @@ initAndClose tracer clusterIx node@(RunningNode _ nodeSocket) = do
         snapshotNumber <- v ^? key "snapshotNumber"
         guard $ snapshotNumber == toJSON expectedSnapshotNumber
 
-      -- NOTE: Hardcoded 'fanoutGracePeriod' + some three secs longer
-      waitFor tracer (contestationPeriod + 100 + 3) [n1] $
+      -- NOTE: We expect the head to be finalized after the contestation period
+      -- and some three secs later
+      waitFor tracer (contestationPeriod + 3) [n1] $
         output "HeadIsFinalized" ["utxo" .= newUTxO]
 
       case fromJSON $ toJSON newUTxO of

From f91d0908a04912121cf6ec320324773126f62bc8 Mon Sep 17 00:00:00 2001
From: Sebastian Nagel <sebastian.nagel@ncoding.at>
Date: Fri, 20 May 2022 10:44:07 +0200
Subject: [PATCH 08/24] Add a remainingContestationPeriod to OnCloseTx

---
 hydra-node/src/Hydra/Chain.hs        |  7 ++-
 hydra-node/src/Hydra/Chain/Direct.hs |  3 +-
 hydra-node/src/Hydra/HeadLogic.hs    | 74 +++++++++++++---------------
 3 files changed, 41 insertions(+), 43 deletions(-)

diff --git a/hydra-node/src/Hydra/Chain.hs b/hydra-node/src/Hydra/Chain.hs
index 944cde16332..1a2c26cdea5 100644
--- a/hydra-node/src/Hydra/Chain.hs
+++ b/hydra-node/src/Hydra/Chain.hs
@@ -82,7 +82,12 @@ data OnChainTx tx
   | OnCommitTx {party :: Party, committed :: UTxOType tx}
   | OnAbortTx
   | OnCollectComTx
-  | OnCloseTx {snapshotNumber :: SnapshotNumber}
+  | OnCloseTx
+      { snapshotNumber :: SnapshotNumber
+      , -- | The remaining contestation period in wall clock time calculated
+        -- from the actual upper bound of the close transaction observed.
+        remainingContestationPeriod :: DiffTime
+      }
   | OnContestTx {snapshotNumber :: SnapshotNumber}
   | OnFanoutTx
   deriving (Generic)
diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs
index 614732cd3c5..4ca4436be91 100644
--- a/hydra-node/src/Hydra/Chain/Direct.hs
+++ b/hydra-node/src/Hydra/Chain/Direct.hs
@@ -608,8 +608,7 @@ finalizeTx TinyWallet{sign, getUTxO, coverFee} headState partialTx = do
     Right validatedTx -> do
       pure $ sign validatedTx
 
--- | Hardcoded grace time for close transaction to be valid. See also
--- 'fanoutGracePeriod' in the HeadLogic.
+-- | Hardcoded grace time for close transaction to be valid.
 -- TODO: make it a node configuration parameter
 closeGraceTime :: SlotNo
 closeGraceTime = 100
diff --git a/hydra-node/src/Hydra/HeadLogic.hs b/hydra-node/src/Hydra/HeadLogic.hs
index 6747054e5fc..b25e18c6c20 100644
--- a/hydra-node/src/Hydra/HeadLogic.hs
+++ b/hydra-node/src/Hydra/HeadLogic.hs
@@ -376,40 +376,43 @@ update Environment{party, signingKey, otherParties} ledger st ev = case (st, ev)
                         }
                     )
                     []
-  (previousRecoverableState@OpenState{parameters, coordinatedHeadState}, OnChainEvent (Observation OnCloseTx{snapshotNumber = closedSnapshotNumber})) ->
-    let HeadParameters{contestationPeriod} = parameters
-        CoordinatedHeadState{confirmedSnapshot} = coordinatedHeadState
-     in -- TODO(2): In principle here, we want to:
-        --
-        --   a) Warn the user about a close tx outside of an open state
-        --   b) Move to close state, using information from the close tx
-        nextState
-          ( ClosedState
-              { parameters
-              , utxos = getField @"utxo" $ getSnapshot confirmedSnapshot
-              , previousRecoverableState
+  ( previousRecoverableState@OpenState{parameters, coordinatedHeadState}
+    , OnChainEvent
+        ( Observation
+            OnCloseTx
+              { snapshotNumber = closedSnapshotNumber
+              , remainingContestationPeriod
               }
           )
-          ( [ ClientEffect
-                HeadIsClosed
-                  { snapshotNumber = closedSnapshotNumber
-                  }
-            , -- FIXME(MB): This is most likely wrong in the case of contestation. We
-              -- may want to only post fanout once we have contested.
-              Delay
-                { -- TODO: In principle, we want to start the stopwatch from the
-                  -- upper validity bound of the close transaction. The
-                  -- contestation period here is really a minimum. We add the
-                  -- grace period here to cope for this.
-                  delay = contestationPeriod + fanoutGracePeriod
-                , reason = WaitOnContestationPeriod
-                , event = ShouldPostFanout
+    ) ->
+      let CoordinatedHeadState{confirmedSnapshot} = coordinatedHeadState
+       in -- TODO(2): In principle here, we want to:
+          --
+          --   a) Warn the user about a close tx outside of an open state
+          --   b) Move to close state, using information from the close tx
+          nextState
+            ( ClosedState
+                { parameters
+                , utxos = getField @"utxo" $ getSnapshot confirmedSnapshot
+                , previousRecoverableState
                 }
-            ]
-              ++ [ OnChainEffect ContestTx{confirmedSnapshot}
-                 | number (getSnapshot confirmedSnapshot) > closedSnapshotNumber
-                 ]
-          )
+            )
+            ( [ ClientEffect
+                  HeadIsClosed
+                    { snapshotNumber = closedSnapshotNumber
+                    }
+              , -- FIXME(MB): This is most likely wrong in the case of contestation. We
+                -- may want to only post fanout once we have contested.
+                Delay
+                  { delay = remainingContestationPeriod
+                  , reason = WaitOnContestationPeriod
+                  , event = ShouldPostFanout
+                  }
+              ]
+                ++ [ OnChainEffect ContestTx{confirmedSnapshot}
+                   | number (getSnapshot confirmedSnapshot) > closedSnapshotNumber
+                   ]
+            )
   --
   (_, OnChainEvent (Observation OnContestTx{snapshotNumber})) ->
     -- TODO: Is there more to handle contestation?
@@ -442,15 +445,6 @@ update Environment{party, signingKey, otherParties} ledger st ev = case (st, ev)
     SeenSnapshot{} -> True
     _ -> False
 
--- | Some time buffer before submitting `ShouldPostFanout` event to cope with
--- time drifting and the fact that we start our stopwatch when we observe the
--- close transaction, not from it's upper bound validity.
--- NOTE: This needs to be AT LEAST the 'closeGraceTime' equivalent of the
--- slowest chain we want to support. For example, 100 slots * 1 slot / s = 100 secs
--- FIXME: we should rather follow chain's "time" (slots) and use that as reference
-fanoutGracePeriod :: DiffTime
-fanoutGracePeriod = 100
-
 data SnapshotOutcome tx
   = ShouldSnapshot SnapshotNumber [tx] -- TODO(AB) : should really be a Set (TxId tx)
   | ShouldNotSnapshot NoSnapshotReason

From eca0b475b31b0e2ee4f172c4d4b8a24954e06b9a Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Fri, 20 May 2022 09:25:15 +0000
Subject: [PATCH 09/24] Fake computing remaining period upstream

---
 hydra-node/src/Hydra/Chain/Direct.hs    | 18 +++++++++++++-----
 hydra-node/src/Hydra/Chain/Direct/Tx.hs |  2 +-
 2 files changed, 14 insertions(+), 6 deletions(-)

diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs
index 4ca4436be91..92c837c13f0 100644
--- a/hydra-node/src/Hydra/Chain/Direct.hs
+++ b/hydra-node/src/Hydra/Chain/Direct.hs
@@ -386,7 +386,7 @@ data ChainSyncHandler m = ChainSyncHandler
 
 chainSyncHandler ::
   forall m.
-  (MonadSTM m) =>
+  (MonadSTM m, MonadTime m) =>
   -- | Tracer for logging
   Tracer m DirectChainLog ->
   -- | Chain callback
@@ -411,7 +411,8 @@ chainSyncHandler tracer callback headState =
   onRollForward :: Block -> m ()
   onRollForward blk = do
     let receivedTxs = toList $ getAlonzoTxs blk
-    onChainTxs <- reverse <$> atomically (foldM (withNextTx (blockPoint blk)) [] receivedTxs)
+    now <- getCurrentTime
+    onChainTxs <- reverse <$> atomically (foldM (withNextTx now (blockPoint blk)) [] receivedTxs)
     unless (null receivedTxs) $
       traceWith tracer $
         ReceivedTxs
@@ -420,8 +421,10 @@ chainSyncHandler tracer callback headState =
           }
     mapM_ (callback . Observation) onChainTxs
 
-  withNextTx :: Point Block -> [OnChainTx Tx] -> ValidatedTx Era -> STM m [OnChainTx Tx]
-  withNextTx point observed (fromLedgerTx -> tx) = do
+  -- NOTE: We pass 'now' or current time because we need it for observing passing of time in the
+  -- contestation phase.
+  withNextTx :: UTCTime -> Point Block -> [OnChainTx Tx] -> ValidatedTx Era -> STM m [OnChainTx Tx]
+  withNextTx now point observed (fromLedgerTx -> tx) = do
     st <- readTVar headState
     case observeSomeTx tx (currentOnChainHeadState st) of
       Just (onChainTx, st') -> do
@@ -430,7 +433,12 @@ chainSyncHandler tracer callback headState =
             { currentOnChainHeadState = st'
             , recordedAt = AtPoint (fromConsensusPointHF point) st
             }
-        pure $ onChainTx : observed
+        -- FIXME: The right thing to do is probably to decouple the observation from the
+        -- transformation into an `OnChainTx`
+        let event = case onChainTx of
+              OnCloseTx{} -> onChainTx{remainingContestationPeriod = 5}
+              _ -> onChainTx
+        pure $ event : observed
       Nothing ->
         pure observed
 
diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs
index 8dbcff03413..bac065805f5 100644
--- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs
+++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs
@@ -735,7 +735,7 @@ observeCloseTx utxo tx = do
         _ -> Nothing
       snapshotNumber <- integerToNatural onChainSnapshotNumber
       pure
-        ( OnCloseTx{snapshotNumber}
+        ( OnCloseTx{snapshotNumber, remainingContestationPeriod = 0}
         , CloseObservation
             { threadOutput =
                 ClosedThreadOutput

From 0a3412bd743e639e77c9069f714f1b88d95b6aec Mon Sep 17 00:00:00 2001
From: Sebastian Nagel <sebastian.nagel@ncoding.at>
Date: Fri, 20 May 2022 11:36:15 +0200
Subject: [PATCH 10/24] Calculate remainingContestationPeriod in
 Hydra.Chain.Direct

---
 hydra-node/src/Hydra/Chain/Direct.hs | 16 +++++++++++++---
 1 file changed, 13 insertions(+), 3 deletions(-)

diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs
index 92c837c13f0..50d9ef86a47 100644
--- a/hydra-node/src/Hydra/Chain/Direct.hs
+++ b/hydra-node/src/Hydra/Chain/Direct.hs
@@ -50,6 +50,8 @@ import Control.Tracer (nullTracer)
 import Data.Aeson (Value (String), object, (.=))
 import Data.List ((\\))
 import Data.Sequence.Strict (StrictSeq)
+import Data.Time (picosecondsToDiffTime)
+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
 import Hydra.Cardano.Api (
   CardanoMode,
   ChainPoint (..),
@@ -100,6 +102,7 @@ import Hydra.Chain.Direct.State (
   commit,
   contest,
   fanout,
+  getContestationDeadline,
   getKnownUTxO,
   idleOnChainHeadState,
   initialize,
@@ -123,6 +126,7 @@ import Hydra.Chain.Direct.Wallet (
   getTxId,
   withTinyWallet,
  )
+import Hydra.Data.ContestationPeriod (millisInPico)
 import Hydra.Logging (Tracer, traceWith)
 import Hydra.Party (Party)
 import Ouroboros.Consensus.Cardano.Block (EraMismatch, GenTx (..), HardForkApplyTxErr (ApplyTxErrAlonzo), HardForkBlock (BlockAlonzo))
@@ -164,6 +168,7 @@ import Ouroboros.Network.Protocol.LocalTxSubmission.Client (
   SubmitResult (..),
   localTxSubmissionClientPeer,
  )
+import qualified Plutus.V1.Ledger.Api as Plutus
 import Test.Cardano.Ledger.Alonzo.Serialisation.Generators ()
 
 withDirectChain ::
@@ -427,7 +432,7 @@ chainSyncHandler tracer callback headState =
   withNextTx now point observed (fromLedgerTx -> tx) = do
     st <- readTVar headState
     case observeSomeTx tx (currentOnChainHeadState st) of
-      Just (onChainTx, st') -> do
+      Just (onChainTx, st'@(SomeOnChainHeadState nextState)) -> do
         writeTVar headState $
           SomeOnChainHeadStateAt
             { currentOnChainHeadState = st'
@@ -435,8 +440,13 @@ chainSyncHandler tracer callback headState =
             }
         -- FIXME: The right thing to do is probably to decouple the observation from the
         -- transformation into an `OnChainTx`
-        let event = case onChainTx of
-              OnCloseTx{} -> onChainTx{remainingContestationPeriod = 5}
+        let event = case (onChainTx, reifyState nextState) of
+              (OnCloseTx{snapshotNumber}, TkClosed) ->
+                let deadlineInMillis = Plutus.getPOSIXTime $ getContestationDeadline nextState
+                    posixNow = truncate (utcTimeToPOSIXSeconds now)
+                    differenceInPicos = deadlineInMillis * millisInPico - posixNow
+                    remainingDiffTime = picosecondsToDiffTime differenceInPicos
+                 in OnCloseTx{snapshotNumber, remainingContestationPeriod = remainingDiffTime}
               _ -> onChainTx
         pure $ event : observed
       Nothing ->

From 262dfa8d6f7ec9e52a26507a71b72fb5fa027ad7 Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Fri, 20 May 2022 12:03:05 +0200
Subject: [PATCH 11/24] Add function to convert UTCTime -> POSIXTime in
 hydra-plutus

  And bootstrap the first specs for this package.
---
 .../Hydra/Chain/Direct/Contract/Mutation.hs   |  6 -----
 hydra-plutus/hydra-plutus.cabal               | 19 ++++++++++++++++
 .../src/Hydra/Data/ContestationPeriod.hs      |  5 ++++-
 hydra-plutus/src/Plutus/Orphans.hs            | 22 ++++++++++++++-----
 .../test/Hydra/Data/ContestationPeriodSpec.hs | 14 ++++++++++++
 hydra-plutus/test/Main.hs                     | 14 ++++++++++++
 hydra-plutus/test/Spec.hs                     |  1 +
 hydra-plutus/test/Test.hs                     | 18 ---------------
 8 files changed, 69 insertions(+), 30 deletions(-)
 create mode 100644 hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs
 create mode 100644 hydra-plutus/test/Main.hs
 create mode 100644 hydra-plutus/test/Spec.hs
 delete mode 100644 hydra-plutus/test/Test.hs

diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs
index 8fbb5efd92e..c6591717254 100644
--- a/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs
@@ -438,12 +438,6 @@ instance Arbitrary Head.Input where
 instance Arbitrary Head.State where
   arbitrary = genericArbitrary
 
-instance Arbitrary POSIXTime where
-  arbitrary = POSIXTime <$> arbitrary
-
-instance Arbitrary a => Arbitrary (UpperBound a) where
-  arbitrary = upperBound <$> arbitrary
-
 -- * Helpers
 
 -- | Identify Head script's output.
diff --git a/hydra-plutus/hydra-plutus.cabal b/hydra-plutus/hydra-plutus.cabal
index 7cfa9b25727..33298146daa 100644
--- a/hydra-plutus/hydra-plutus.cabal
+++ b/hydra-plutus/hydra-plutus.cabal
@@ -115,6 +115,25 @@ library
     -- NOTE(SN): should fix HLS choking on PlutusTx plugin
     ghc-options: -fplugin-opt PlutusTx.Plugin:defer-errors
 
+test-suite tests
+  import:             project-config
+  ghc-options:        -threaded -rtsopts -with-rtsopts=-N
+  hs-source-dirs:     test
+  main-is:            Main.hs
+  type:               exitcode-stdio-1.0
+  other-modules:
+    Hydra.Data.ContestationPeriodSpec
+    Spec
+  build-depends:
+    , base
+    , hspec
+    , hspec-core
+    , hydra-prelude
+    , hydra-plutus
+    , hydra-test-utils
+    , QuickCheck
+  build-tool-depends: hspec-discover:hspec-discover -any
+
 executable inspect-script
   import:         project-config
   hs-source-dirs: exe/inspect-script
diff --git a/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs b/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs
index a803a194807..5bd9f59dcdf 100644
--- a/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs
+++ b/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs
@@ -8,7 +8,7 @@ import Hydra.Prelude
 import qualified PlutusTx.Prelude as Plutus
 
 import Data.Time (diffTimeToPicoseconds, picosecondsToDiffTime)
-import Plutus.V1.Ledger.Api (POSIXTime)
+import Plutus.V1.Ledger.Api (POSIXTime (..))
 import Plutus.V1.Ledger.Time (DiffMilliSeconds, fromMilliSeconds)
 import qualified PlutusTx
 
@@ -40,6 +40,9 @@ contestationPeriodToDiffTime cp =
  where
   millisToPico = (* millisInPico)
 
+posixToUTCTime :: POSIXTime -> UTCTime
+posixToUTCTime (POSIXTime ms) = undefined
+
 millisInPico :: Integer
 millisInPico = 10 ^ (9 :: Integer)
 
diff --git a/hydra-plutus/src/Plutus/Orphans.hs b/hydra-plutus/src/Plutus/Orphans.hs
index 579484571e9..462742056d5 100644
--- a/hydra-plutus/src/Plutus/Orphans.hs
+++ b/hydra-plutus/src/Plutus/Orphans.hs
@@ -7,9 +7,15 @@ module Plutus.Orphans where
 import Hydra.Prelude
 
 import qualified Data.ByteString as BS
-import Plutus.V1.Ledger.Api (CurrencySymbol, TokenName, Value)
-import qualified Plutus.V1.Ledger.Api as Plutus
-import qualified Plutus.V1.Ledger.Crypto as Plutus
+import Plutus.V1.Ledger.Api (
+  CurrencySymbol,
+  POSIXTime (..),
+  TokenName,
+  UpperBound (..),
+  Value,
+  upperBound,
+ )
+import Plutus.V1.Ledger.Crypto (Signature (..))
 import qualified PlutusTx.AssocMap as AssocMap
 import PlutusTx.Prelude (BuiltinByteString, toBuiltin)
 import Test.QuickCheck (vector)
@@ -32,5 +38,11 @@ instance Arbitrary Value where
 instance (Arbitrary k, Arbitrary v) => Arbitrary (AssocMap.Map k v) where
   arbitrary = AssocMap.fromList <$> arbitrary
 
-instance Arbitrary Plutus.Signature where
-  arbitrary = Plutus.Signature . Plutus.toBuiltin . BS.pack <$> vector 64
+instance Arbitrary Signature where
+  arbitrary = Signature . toBuiltin . BS.pack <$> vector 64
+
+instance Arbitrary POSIXTime where
+  arbitrary = POSIXTime <$> arbitrary
+
+instance Arbitrary a => Arbitrary (UpperBound a) where
+  arbitrary = upperBound <$> arbitrary
diff --git a/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs b/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs
new file mode 100644
index 00000000000..5b8019fc917
--- /dev/null
+++ b/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs
@@ -0,0 +1,14 @@
+module Hydra.Data.ContestationPeriodSpec where
+
+import Hydra.Prelude
+
+import Hydra.Data.ContestationPeriod (posixToUTCTime)
+import Plutus.Orphans ()
+import Test.Hspec (Spec, describe)
+import Test.Hspec.QuickCheck (prop)
+import Test.QuickCheck ((===))
+
+spec :: Spec
+spec = describe "posixToUTCTime" $ do
+  prop "is homorphic w.r.t to Ord" $ \t1 t2 ->
+    compare t1 t2 === compare (posixToUTCTime t1) (posixToUTCTime t2)
diff --git a/hydra-plutus/test/Main.hs b/hydra-plutus/test/Main.hs
new file mode 100644
index 00000000000..cf12d36827c
--- /dev/null
+++ b/hydra-plutus/test/Main.hs
@@ -0,0 +1,14 @@
+module Main where
+
+import Hydra.Prelude
+
+import Test.Hspec.Runner (configFormat, defaultConfig, hspecWith)
+import Test.Hydra.Prelude (dualFormatter)
+
+import qualified Spec
+
+main :: IO ()
+main =
+  hspecWith
+    defaultConfig{configFormat = Just (dualFormatter "hydra-plutus")}
+    Spec.spec
diff --git a/hydra-plutus/test/Spec.hs b/hydra-plutus/test/Spec.hs
new file mode 100644
index 00000000000..5416ef6a866
--- /dev/null
+++ b/hydra-plutus/test/Spec.hs
@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}
diff --git a/hydra-plutus/test/Test.hs b/hydra-plutus/test/Test.hs
deleted file mode 100644
index 7641f546c3b..00000000000
--- a/hydra-plutus/test/Test.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-module Main where
-
-import Hydra.Prelude
-
-import qualified Hydra.ContractModelTest as Model
-import qualified Hydra.ContractTest as Contract
-import Test.Tasty
-
-main :: IO ()
-main = defaultMain tests
-
-tests :: TestTree
-tests =
-  testGroup
-    "Contracts tests"
-    [ Contract.tests
-    , Model.tests
-    ]

From e1faf9f0077eabd119c964f9057cdcdb32c97c1a Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Mon, 23 May 2022 04:25:35 +0000
Subject: [PATCH 12/24] Update nix cache fqdn

---
 .github/workflows/ci.yaml | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml
index 6a9a9b941d4..bcf87fcff06 100644
--- a/.github/workflows/ci.yaml
+++ b/.github/workflows/ci.yaml
@@ -38,8 +38,8 @@ jobs:
       with:
         skip_adding_nixpkgs_channel: true
         extra_nix_config: |
-          trusted-public-keys = iohk.cachix.org-1:DpRUyj7h7V830dp/i6Nti+NEO2/nhblbov/8MW7Rqoo= hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=
-          substituters = https://cache.nixos.org https://hydra.iohk.io https://iohk.cachix.org
+          trusted-public-keys = iohk.cachix.org-1:DpRUyj7h7V830dp/i6Nti+NEO2/nhblbov/8MW7Rqoo= cache.iog.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=
+          substituters = https://cache.nixos.org https://cache.iog.io https://iohk.cachix.org
 
     - name: Cachix cache of nix derivations
       uses: cachix/cachix-action@v10
@@ -136,8 +136,8 @@ jobs:
       with:
         skip_adding_nixpkgs_channel: true
         extra_nix_config: |
-          trusted-public-keys = iohk.cachix.org-1:DpRUyj7h7V830dp/i6Nti+NEO2/nhblbov/8MW7Rqoo= hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=
-          substituters = https://cache.nixos.org https://hydra.iohk.io https://iohk.cachix.org
+          trusted-public-keys = iohk.cachix.org-1:DpRUyj7h7V830dp/i6Nti+NEO2/nhblbov/8MW7Rqoo= cache.iog.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=
+          substituters = https://cache.nixos.org https://cache.iog.io https://iohk.cachix.org
 
     - name: Cachix cache of nix derivations
       uses: cachix/cachix-action@v10

From f6e2115c8b92d09686bd84c6042f75852e391523 Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Mon, 23 May 2022 12:11:37 +0000
Subject: [PATCH 13/24] Fix compilation errors following change in OnCloseTx

---
 hydra-node/src/Hydra/Chain/Direct/Tx.hs                 | 2 +-
 hydra-node/test/Hydra/BehaviorSpec.hs                   | 7 ++++---
 hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs | 3 ---
 hydra-node/test/Hydra/HeadLogicSpec.hs                  | 2 +-
 4 files changed, 6 insertions(+), 8 deletions(-)

diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs
index bac065805f5..bb673a87974 100644
--- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs
+++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs
@@ -16,7 +16,7 @@ import Hydra.Prelude
 import qualified Cardano.Api.UTxO as UTxO
 import Cardano.Binary (decodeFull', serialize')
 import qualified Data.Map as Map
-import Hydra.Chain (HeadId (..), HeadParameters (..), OnChainTx (..))
+import Hydra.Chain (HeadId (..), HeadParameters (..), OnChainTx (..), remainingContestationPeriod)
 import qualified Hydra.Contract.Commit as Commit
 import qualified Hydra.Contract.Head as Head
 import qualified Hydra.Contract.HeadState as Head
diff --git a/hydra-node/test/Hydra/BehaviorSpec.hs b/hydra-node/test/Hydra/BehaviorSpec.hs
index 75ca0b58f2f..f631a2b7067 100644
--- a/hydra-node/test/Hydra/BehaviorSpec.hs
+++ b/hydra-node/test/Hydra/BehaviorSpec.hs
@@ -337,9 +337,9 @@ spec = parallel $ do
                 SnapshotConfirmed{snapshot = Snapshot{number}} -> number == 1
                 _ -> False
 
-              -- Have n1 observe a close with not the latest snapshot
-              chainEvent n1 (Observation (OnCloseTx 0))
-              chainEvent n2 (Observation (OnCloseTx 0))
+              -- Have n1 & n2 observe a close with not the latest snapshot
+              chainEvent n1 (Observation (OnCloseTx 0 42))
+              chainEvent n2 (Observation (OnCloseTx 0 42))
 
               waitUntilMatch [n1, n2] $ \case
                 HeadIsClosed{snapshotNumber} -> snapshotNumber == 0
@@ -511,6 +511,7 @@ toOnChainTx =
     (CloseTx confirmedSnapshot) ->
       OnCloseTx
         { snapshotNumber = number (getSnapshot confirmedSnapshot)
+        , remainingContestationPeriod = testContestationPeriod
         }
     ContestTx{confirmedSnapshot} ->
       OnContestTx
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs
index c6591717254..6e879f16480 100644
--- a/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs
@@ -151,11 +151,8 @@ import Hydra.Ledger.Cardano.Evaluate (evaluateTx)
 import Hydra.Prelude hiding (label)
 import Plutus.Orphans ()
 import Plutus.V1.Ledger.Api (
-  POSIXTime (..),
-  UpperBound,
   fromData,
   toData,
-  upperBound,
  )
 import qualified System.Directory.Internal.Prelude as Prelude
 import Test.Hydra.Prelude
diff --git a/hydra-node/test/Hydra/HeadLogicSpec.hs b/hydra-node/test/Hydra/HeadLogicSpec.hs
index bf8958ad88a..6a535853e43 100644
--- a/hydra-node/test/Hydra/HeadLogicSpec.hs
+++ b/hydra-node/test/Hydra/HeadLogicSpec.hs
@@ -216,7 +216,7 @@ spec = do
 
       it "any node should post FanoutTx when observing on-chain CloseTx" $ do
         let s0 = inOpenState threeParties ledger
-            closeTx = OnChainEvent $ Observation $ OnCloseTx 0
+            closeTx = OnChainEvent $ Observation $ OnCloseTx 0 42
 
         let shouldPostFanout =
               Delay

From c22e397030eabf6b398d2697bad04094f2a0d853 Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Mon, 23 May 2022 12:11:48 +0000
Subject: [PATCH 14/24] Check conversion from plutus time preserves ordering

---
 hydra-plutus/src/Hydra/Data/ContestationPeriod.hs      |  4 +++-
 hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs | 10 +++++++---
 2 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs b/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs
index 5bd9f59dcdf..a4bc42d70cd 100644
--- a/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs
+++ b/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs
@@ -8,6 +8,7 @@ import Hydra.Prelude
 import qualified PlutusTx.Prelude as Plutus
 
 import Data.Time (diffTimeToPicoseconds, picosecondsToDiffTime)
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import Plutus.V1.Ledger.Api (POSIXTime (..))
 import Plutus.V1.Ledger.Time (DiffMilliSeconds, fromMilliSeconds)
 import qualified PlutusTx
@@ -41,7 +42,8 @@ contestationPeriodToDiffTime cp =
   millisToPico = (* millisInPico)
 
 posixToUTCTime :: POSIXTime -> UTCTime
-posixToUTCTime (POSIXTime ms) = undefined
+posixToUTCTime (POSIXTime ms) =
+  posixSecondsToUTCTime (fromInteger $ 1000 * ms)
 
 millisInPico :: Integer
 millisInPico = 10 ^ (9 :: Integer)
diff --git a/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs b/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs
index 5b8019fc917..00d916069df 100644
--- a/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs
+++ b/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs
@@ -6,9 +6,13 @@ import Hydra.Data.ContestationPeriod (posixToUTCTime)
 import Plutus.Orphans ()
 import Test.Hspec (Spec, describe)
 import Test.Hspec.QuickCheck (prop)
-import Test.QuickCheck ((===))
+import Test.QuickCheck (tabulate, (===))
+import Test.QuickCheck.Property (coverTable)
 
 spec :: Spec
 spec = describe "posixToUTCTime" $ do
-  prop "is homorphic w.r.t to Ord" $ \t1 t2 ->
-    compare t1 t2 === compare (posixToUTCTime t1) (posixToUTCTime t2)
+  prop "is homomorphic w.r.t to Ord" $ \t1 t2 ->
+    let ordering = compare t1 t2
+     in ordering === compare (posixToUTCTime t1) (posixToUTCTime t2)
+          & tabulate "Ord" (map show $ enumFrom LT)
+          & coverTable "Cover" [("LT", 33), ("EQ", 33), ("GT", 33)]

From 1ebf51ab1055bd347e114e6d533a7edac9cd98d1 Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Mon, 23 May 2022 12:31:23 +0000
Subject: [PATCH 15/24] Fix values used in QC's cover function

The docs are somewhat misleading: This value is a percentage not
expressed as a value between 0 and 1 but between 0 and 100.
---
 hydra-cluster/test/Test/LogFilterSpec.hs | 2 +-
 hydra-node/test/Hydra/API/ServerSpec.hs  | 6 +++---
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/hydra-cluster/test/Test/LogFilterSpec.hs b/hydra-cluster/test/Test/LogFilterSpec.hs
index e20e835a1bb..91fe3733e60 100644
--- a/hydra-cluster/test/Test/LogFilterSpec.hs
+++ b/hydra-cluster/test/Test/LogFilterSpec.hs
@@ -43,6 +43,6 @@ spec = parallel $ do
         filtered = encode $ mapMaybe filterLog jsonLogs
         sizeRatio = fromIntegral (LBS.length filtered) * (100.0 :: Double) / fromIntegral (LBS.length bytes)
      in LBS.length filtered < LBS.length bytes && sizeRatio > 0
-          & cover 0.9 (sizeRatio < 10.0) "reduces size by 90%"
+          & cover 90 (sizeRatio < 10.0) "reduces size by 90%"
           & tabulate "Ratios" [show (floor (sizeRatio / 10) * 10 :: Int) <> " %"]
           & checkCoverage
diff --git a/hydra-node/test/Hydra/API/ServerSpec.hs b/hydra-node/test/Hydra/API/ServerSpec.hs
index 9b81d17fb59..6c80b92bf13 100644
--- a/hydra-node/test/Hydra/API/ServerSpec.hs
+++ b/hydra-node/test/Hydra/API/ServerSpec.hs
@@ -58,9 +58,9 @@ spec = parallel $ do
               failAfter 1 $ atomically (tryReadTQueue queue) `shouldReturn` Nothing
 
   prop "echoes history (past outputs) to client upon reconnection" $ \msgs -> monadicIO $ do
-    monitor $ cover 1 (null msgs) "no message when reconnecting"
-    monitor $ cover 1 (length msgs == 1) "only one message when reconnecting"
-    monitor $ cover 1 (length msgs > 1) "more than one message when reconnecting"
+    monitor $ cover 100 (null msgs) "no message when reconnecting"
+    monitor $ cover 100 (length msgs == 1) "only one message when reconnecting"
+    monitor $ cover 100 (length msgs > 1) "more than one message when reconnecting"
     run . failAfter 5 $ do
       withFreePort $ \port ->
         withAPIServer @SimpleTx "127.0.0.1" (fromIntegral port) alice nullTracer noop $ \Server{sendOutput} -> do

From 409da6dbdca6fa03ac5a0bd3b6a56016fde89659 Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Mon, 23 May 2022 13:01:00 +0000
Subject: [PATCH 16/24] Handle special case in test for observing OnCloseTx

---
 hydra-node/src/Hydra/Chain/Direct/Tx.hs         | 5 ++++-
 hydra-node/test/Hydra/Chain/Direct/StateSpec.hs | 6 +++++-
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs
index bb673a87974..45748083eae 100644
--- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs
+++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs
@@ -735,7 +735,10 @@ observeCloseTx utxo tx = do
         _ -> Nothing
       snapshotNumber <- integerToNatural onChainSnapshotNumber
       pure
-        ( OnCloseTx{snapshotNumber, remainingContestationPeriod = 0}
+        ( -- FIXME: The 0 here is a wart. We are in a pure function so we cannot easily compute with
+          -- time. We tried passing the current time from the caller but given the current machinery
+          -- around `observeSomeTx` this is actually not straightforward and quite ugly.
+          OnCloseTx{snapshotNumber, remainingContestationPeriod = 0}
         , CloseObservation
             { threadOutput =
                 ClosedThreadOutput
diff --git a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs
index 03b394551c6..5b4d42b7192 100644
--- a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs
@@ -37,7 +37,7 @@ import Hydra.Cardano.Api (
   pattern TxOut,
   pattern TxOutDatumNone,
  )
-import Hydra.Chain (ChainEvent (..), PostTxError (..))
+import Hydra.Chain (ChainEvent (..), OnChainTx (OnCloseTx, remainingContestationPeriod), PostTxError (..), snapshotNumber)
 import Hydra.Chain.Direct (
   ChainSyncHandler (..),
   RecordedAt (..),
@@ -199,6 +199,10 @@ spec = parallel $ do
         let callback = \case
               Rollback{} ->
                 fail "rolled back but expected roll forward."
+              Observation OnCloseTx{snapshotNumber} ->
+                -- FIXME: Special case for `OnCloseTx` because we don't directly observe the remaining contestation period,
+                -- it's the result of a computation that involves current time
+                fst <$> observeSomeTx tx st `shouldBe` Just OnCloseTx{snapshotNumber, remainingContestationPeriod = 0}
               Observation onChainTx ->
                 fst <$> observeSomeTx tx st `shouldBe` Just onChainTx
         forAllBlind (genBlockAt 1 [tx]) $ \blk -> monadicIO $ do

From b76d376a7a08b0afe6896832509334b2c3a94f13 Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Mon, 23 May 2022 13:15:31 +0000
Subject: [PATCH 17/24] Add missing fields in the Log's schema

---
 hydra-cluster/test/Test/LogFilterSpec.hs | 2 +-
 hydra-node/json-schemas/logs.yaml        | 4 ++++
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/hydra-cluster/test/Test/LogFilterSpec.hs b/hydra-cluster/test/Test/LogFilterSpec.hs
index 91fe3733e60..fde511f5a10 100644
--- a/hydra-cluster/test/Test/LogFilterSpec.hs
+++ b/hydra-cluster/test/Test/LogFilterSpec.hs
@@ -43,6 +43,6 @@ spec = parallel $ do
         filtered = encode $ mapMaybe filterLog jsonLogs
         sizeRatio = fromIntegral (LBS.length filtered) * (100.0 :: Double) / fromIntegral (LBS.length bytes)
      in LBS.length filtered < LBS.length bytes && sizeRatio > 0
-          & cover 90 (sizeRatio < 10.0) "reduces size by 90%"
+          & cover 40 (sizeRatio < 10.0) "reduces size by 90%"
           & tabulate "Ratios" [show (floor (sizeRatio / 10) * 10 :: Int) <> " %"]
           & checkCoverage
diff --git a/hydra-node/json-schemas/logs.yaml b/hydra-node/json-schemas/logs.yaml
index ad136ae04d5..359573e2aae 100644
--- a/hydra-node/json-schemas/logs.yaml
+++ b/hydra-node/json-schemas/logs.yaml
@@ -891,6 +891,7 @@ definitions:
         required:
         - tag
         - snapshotNumber
+        - remainingContestationPeriod
         properties:
           tag:
             type: string
@@ -898,6 +899,9 @@ definitions:
           snapshotNumber:
             type: integer
             minimum: 0
+          remainingContestationPeriod:
+            type: integer
+            minimum: 0
       - title: OnContestTx
         type: object
         additionalProperties: false

From ff15ebfd9672adb1ebc63e1f4ca166c672f86b3c Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Mon, 23 May 2022 13:55:15 +0000
Subject: [PATCH 18/24] Replace the use of DiffTime w/ NominalDiffTime

The former takes into account leap seconds and works with
AbsoluteTime, whereas we work with UTCTime and really care about
actual passing of time.
---
 hydra-node/src/Hydra/Chain.hs                 |  6 ++---
 hydra-node/src/Hydra/Chain/Direct/Context.hs  |  2 +-
 hydra-node/src/Hydra/HeadLogic.hs             |  2 +-
 hydra-node/src/Hydra/Node.hs                  |  4 ++--
 hydra-node/test/Hydra/BehaviorSpec.hs         |  2 +-
 .../src/Hydra/Data/ContestationPeriod.hs      | 15 +++++-------
 .../test/Hydra/Data/ContestationPeriodSpec.hs | 24 +++++++++++++------
 7 files changed, 31 insertions(+), 24 deletions(-)

diff --git a/hydra-node/src/Hydra/Chain.hs b/hydra-node/src/Hydra/Chain.hs
index 1a2c26cdea5..57789fe29c1 100644
--- a/hydra-node/src/Hydra/Chain.hs
+++ b/hydra-node/src/Hydra/Chain.hs
@@ -25,7 +25,7 @@ import Hydra.Snapshot (ConfirmedSnapshot, SnapshotNumber)
 
 -- | Contains the head's parameters as established in the initial transaction.
 data HeadParameters = HeadParameters
-  { contestationPeriod :: DiffTime
+  { contestationPeriod :: NominalDiffTime
   , parties :: [Party] -- NOTE(SN): The order of this list is important for leader selection.
   }
   deriving stock (Eq, Show, Generic)
@@ -34,7 +34,7 @@ data HeadParameters = HeadParameters
 instance Arbitrary HeadParameters where
   arbitrary = genericArbitrary
 
-type ContestationPeriod = DiffTime
+type ContestationPeriod = NominalDiffTime
 
 -- | Data type used to post transactions on chain. It holds everything to
 -- construct corresponding Head protocol transactions.
@@ -86,7 +86,7 @@ data OnChainTx tx
       { snapshotNumber :: SnapshotNumber
       , -- | The remaining contestation period in wall clock time calculated
         -- from the actual upper bound of the close transaction observed.
-        remainingContestationPeriod :: DiffTime
+        remainingContestationPeriod :: NominalDiffTime
       }
   | OnContestTx {snapshotNumber :: SnapshotNumber}
   | OnFanoutTx
diff --git a/hydra-node/src/Hydra/Chain/Direct/Context.hs b/hydra-node/src/Hydra/Chain/Direct/Context.hs
index 7bb464112ff..b0d92dda564 100644
--- a/hydra-node/src/Hydra/Chain/Direct/Context.hs
+++ b/hydra-node/src/Hydra/Chain/Direct/Context.hs
@@ -46,7 +46,7 @@ data HydraContext = HydraContext
   { ctxVerificationKeys :: [VerificationKey PaymentKey]
   , ctxHydraSigningKeys :: [Hydra.SigningKey]
   , ctxNetworkId :: NetworkId
-  , ctxContestationPeriod :: DiffTime
+  , ctxContestationPeriod :: NominalDiffTime
   }
   deriving (Show)
 
diff --git a/hydra-node/src/Hydra/HeadLogic.hs b/hydra-node/src/Hydra/HeadLogic.hs
index b25e18c6c20..c23509486d8 100644
--- a/hydra-node/src/Hydra/HeadLogic.hs
+++ b/hydra-node/src/Hydra/HeadLogic.hs
@@ -54,7 +54,7 @@ data Effect tx
   = ClientEffect {serverOutput :: ServerOutput tx}
   | NetworkEffect {message :: Message tx}
   | OnChainEffect {onChainTx :: PostChainTx tx}
-  | Delay {delay :: DiffTime, reason :: WaitReason, event :: Event tx}
+  | Delay {delay :: NominalDiffTime, reason :: WaitReason, event :: Event tx}
   deriving stock (Generic)
 
 instance IsTx tx => Arbitrary (Effect tx) where
diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs
index 5d0a46273d4..ee5c6951c81 100644
--- a/hydra-node/src/Hydra/Node.hs
+++ b/hydra-node/src/Hydra/Node.hs
@@ -203,7 +203,7 @@ processEffect HydraNode{hn, oc, server, eq, env = Environment{party}} tracer e =
 -- alternative implementation
 data EventQueue m e = EventQueue
   { putEvent :: e -> m ()
-  , putEventAfter :: DiffTime -> e -> m ()
+  , putEventAfter :: NominalDiffTime -> e -> m ()
   , nextEvent :: m e
   , isEmpty :: m Bool
   }
@@ -219,7 +219,7 @@ createEventQueue = do
       , putEventAfter = \delay e -> do
           atomically $ modifyTVar' numThreads succ
           void . async $ do
-            threadDelay delay
+            threadDelay $ realToFrac delay
             atomically $ do
               modifyTVar' numThreads pred
               writeTQueue q e
diff --git a/hydra-node/test/Hydra/BehaviorSpec.hs b/hydra-node/test/Hydra/BehaviorSpec.hs
index f631a2b7067..99b21318cd0 100644
--- a/hydra-node/test/Hydra/BehaviorSpec.hs
+++ b/hydra-node/test/Hydra/BehaviorSpec.hs
@@ -521,7 +521,7 @@ toOnChainTx =
       OnFanoutTx
 
 -- NOTE(SN): Deliberately long to emphasize that we run these tests in IOSim.
-testContestationPeriod :: DiffTime
+testContestationPeriod :: Num a => a
 testContestationPeriod = 3600
 
 withHydraNode ::
diff --git a/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs b/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs
index a4bc42d70cd..46eec3be5ad 100644
--- a/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs
+++ b/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs
@@ -7,7 +7,8 @@ import Hydra.Prelude
 
 import qualified PlutusTx.Prelude as Plutus
 
-import Data.Time (diffTimeToPicoseconds, picosecondsToDiffTime)
+import Data.Ratio ((%))
+import Data.Time (nominalDiffTimeToSeconds, secondsToNominalDiffTime)
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import Plutus.V1.Ledger.Api (POSIXTime (..))
 import Plutus.V1.Ledger.Time (DiffMilliSeconds, fromMilliSeconds)
@@ -30,16 +31,12 @@ instance ToJSON ContestationPeriod where
   toJSON =
     toJSON . toInteger . milliseconds
 
-contestationPeriodFromDiffTime :: DiffTime -> ContestationPeriod
-contestationPeriodFromDiffTime = UnsafeContestationPeriod . fromInteger . picoToMillis . diffTimeToPicoseconds
- where
-  picoToMillis = (`div` millisInPico)
+contestationPeriodFromDiffTime :: NominalDiffTime -> ContestationPeriod
+contestationPeriodFromDiffTime = UnsafeContestationPeriod . truncate . (* 1000) . nominalDiffTimeToSeconds
 
-contestationPeriodToDiffTime :: ContestationPeriod -> DiffTime
+contestationPeriodToDiffTime :: ContestationPeriod -> NominalDiffTime
 contestationPeriodToDiffTime cp =
-  picosecondsToDiffTime $ millisToPico $ toInteger $ milliseconds cp
- where
-  millisToPico = (* millisInPico)
+  secondsToNominalDiffTime $ fromRational (toInteger (milliseconds cp) % 1000)
 
 posixToUTCTime :: POSIXTime -> UTCTime
 posixToUTCTime (POSIXTime ms) =
diff --git a/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs b/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs
index 00d916069df..aaa16d5bd2f 100644
--- a/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs
+++ b/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs
@@ -2,7 +2,11 @@ module Hydra.Data.ContestationPeriodSpec where
 
 import Hydra.Prelude
 
-import Hydra.Data.ContestationPeriod (posixToUTCTime)
+import Hydra.Data.ContestationPeriod (
+  contestationPeriodFromDiffTime,
+  contestationPeriodToDiffTime,
+  posixToUTCTime,
+ )
 import Plutus.Orphans ()
 import Test.Hspec (Spec, describe)
 import Test.Hspec.QuickCheck (prop)
@@ -10,9 +14,15 @@ import Test.QuickCheck (tabulate, (===))
 import Test.QuickCheck.Property (coverTable)
 
 spec :: Spec
-spec = describe "posixToUTCTime" $ do
-  prop "is homomorphic w.r.t to Ord" $ \t1 t2 ->
-    let ordering = compare t1 t2
-     in ordering === compare (posixToUTCTime t1) (posixToUTCTime t2)
-          & tabulate "Ord" (map show $ enumFrom LT)
-          & coverTable "Cover" [("LT", 33), ("EQ", 33), ("GT", 33)]
+spec = do
+  describe "to/from NominalDiffTime" $
+    prop "is isomorphic to NominalDiffTime" $ \t ->
+      let diff = contestationPeriodToDiffTime t
+       in contestationPeriodFromDiffTime diff === t
+
+  describe "posixToUTCTime" $ do
+    prop "is homomorphic w.r.t to Ord" $ \t1 t2 ->
+      let ordering = compare t1 t2
+       in ordering === compare (posixToUTCTime t1) (posixToUTCTime t2)
+            & tabulate "Ord" (map show $ enumFrom LT)
+            & coverTable "Cover" [("LT", 33), ("EQ", 33), ("GT", 33)]

From fc319a7fb01c809dd5a9cfbb194eb238f3295d3b Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Mon, 23 May 2022 13:57:27 +0000
Subject: [PATCH 19/24] Simplify computation of remaining contestation period

---
 hydra-node/src/Hydra/Chain/Direct.hs | 10 ++--------
 1 file changed, 2 insertions(+), 8 deletions(-)

diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs
index 50d9ef86a47..cea6d931517 100644
--- a/hydra-node/src/Hydra/Chain/Direct.hs
+++ b/hydra-node/src/Hydra/Chain/Direct.hs
@@ -50,8 +50,6 @@ import Control.Tracer (nullTracer)
 import Data.Aeson (Value (String), object, (.=))
 import Data.List ((\\))
 import Data.Sequence.Strict (StrictSeq)
-import Data.Time (picosecondsToDiffTime)
-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
 import Hydra.Cardano.Api (
   CardanoMode,
   ChainPoint (..),
@@ -126,7 +124,7 @@ import Hydra.Chain.Direct.Wallet (
   getTxId,
   withTinyWallet,
  )
-import Hydra.Data.ContestationPeriod (millisInPico)
+import Hydra.Data.ContestationPeriod (posixToUTCTime)
 import Hydra.Logging (Tracer, traceWith)
 import Hydra.Party (Party)
 import Ouroboros.Consensus.Cardano.Block (EraMismatch, GenTx (..), HardForkApplyTxErr (ApplyTxErrAlonzo), HardForkBlock (BlockAlonzo))
@@ -168,7 +166,6 @@ import Ouroboros.Network.Protocol.LocalTxSubmission.Client (
   SubmitResult (..),
   localTxSubmissionClientPeer,
  )
-import qualified Plutus.V1.Ledger.Api as Plutus
 import Test.Cardano.Ledger.Alonzo.Serialisation.Generators ()
 
 withDirectChain ::
@@ -442,10 +439,7 @@ chainSyncHandler tracer callback headState =
         -- transformation into an `OnChainTx`
         let event = case (onChainTx, reifyState nextState) of
               (OnCloseTx{snapshotNumber}, TkClosed) ->
-                let deadlineInMillis = Plutus.getPOSIXTime $ getContestationDeadline nextState
-                    posixNow = truncate (utcTimeToPOSIXSeconds now)
-                    differenceInPicos = deadlineInMillis * millisInPico - posixNow
-                    remainingDiffTime = picosecondsToDiffTime differenceInPicos
+                let remainingDiffTime = diffUTCTime now (posixToUTCTime $ getContestationDeadline nextState)
                  in OnCloseTx{snapshotNumber, remainingContestationPeriod = remainingDiffTime}
               _ -> onChainTx
         pure $ event : observed

From cbecdd4b9c17ac72dae18c33e2ba542f5aea2045 Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Mon, 23 May 2022 15:15:35 +0000
Subject: [PATCH 20/24] Fix time transformation and remaining deadline

---
 hydra-cluster/test/Test/DirectChainSpec.hs        | 9 +++++++--
 hydra-node/src/Hydra/Chain/Direct.hs              | 2 +-
 hydra-plutus/src/Hydra/Data/ContestationPeriod.hs | 2 +-
 3 files changed, 9 insertions(+), 4 deletions(-)

diff --git a/hydra-cluster/test/Test/DirectChainSpec.hs b/hydra-cluster/test/Test/DirectChainSpec.hs
index 264407f34a3..dc518699a8a 100644
--- a/hydra-cluster/test/Test/DirectChainSpec.hs
+++ b/hydra-cluster/test/Test/DirectChainSpec.hs
@@ -27,6 +27,7 @@ import Hydra.Cardano.Api (
   ChainPoint (..),
   lovelaceToValue,
   txOutValue,
+  unSlotNo,
   unsafeDeserialiseFromRawBytesBase16,
  )
 import Hydra.Chain (
@@ -40,6 +41,7 @@ import Hydra.Chain (
 import Hydra.Chain.Direct (
   DirectChainLog,
   IntersectionNotFoundException,
+  closeGraceTime,
   withDirectChain,
   withIOManager,
  )
@@ -192,8 +194,8 @@ spec = around showLogsOnFailure $ do
           withDirectChain (contramap (FromDirectChain "alice") tracer) defaultNetworkId iocp nodeSocket aliceKeys alice cardanoKeys Nothing (putMVar alicesCallback) $ \Chain{postTx} -> do
             seedFromFaucet_ defaultNetworkId node aliceCardanoVk 100_000_000 Fuel
 
-            postTx $ InitTx $ HeadParameters 100 [alice]
-            alicesCallback `observesInTime` OnInitTx 100 [alice]
+            postTx $ InitTx $ HeadParameters 1 [alice]
+            alicesCallback `observesInTime` OnInitTx 1 [alice]
 
             someUTxO <- seedFromFaucet defaultNetworkId node aliceCardanoVk 1_000_000 Normal
             postTx $ CommitTx alice someUTxO
@@ -222,6 +224,9 @@ spec = around showLogsOnFailure $ do
               _ ->
                 False
 
+            -- TODO: compute from chain parameters
+            -- contestation period + closeGraceTime * slot length
+            threadDelay $ 1 + (fromIntegral (unSlotNo closeGraceTime) * 0.1)
             postTx $
               FanoutTx
                 { utxo = someUTxO
diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs
index cea6d931517..2fe80f0a8c3 100644
--- a/hydra-node/src/Hydra/Chain/Direct.hs
+++ b/hydra-node/src/Hydra/Chain/Direct.hs
@@ -439,7 +439,7 @@ chainSyncHandler tracer callback headState =
         -- transformation into an `OnChainTx`
         let event = case (onChainTx, reifyState nextState) of
               (OnCloseTx{snapshotNumber}, TkClosed) ->
-                let remainingDiffTime = diffUTCTime now (posixToUTCTime $ getContestationDeadline nextState)
+                let remainingDiffTime = diffUTCTime (posixToUTCTime $ getContestationDeadline nextState) now
                  in OnCloseTx{snapshotNumber, remainingContestationPeriod = remainingDiffTime}
               _ -> onChainTx
         pure $ event : observed
diff --git a/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs b/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs
index 46eec3be5ad..511641d7e23 100644
--- a/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs
+++ b/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs
@@ -40,7 +40,7 @@ contestationPeriodToDiffTime cp =
 
 posixToUTCTime :: POSIXTime -> UTCTime
 posixToUTCTime (POSIXTime ms) =
-  posixSecondsToUTCTime (fromInteger $ 1000 * ms)
+  posixSecondsToUTCTime (fromRational $ ms % 1000)
 
 millisInPico :: Integer
 millisInPico = 10 ^ (9 :: Integer)

From 6384a99b468cf78a475c25998544f0c7667a5829 Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Mon, 23 May 2022 15:35:57 +0000
Subject: [PATCH 21/24] Add a small margin to remaining period to prevent tx to
 fail

also compute wait time in ETE test with some ridiculous formula taking
into account contestation period, close grace time  and slot length!
---
 hydra-cluster/test/Test/EndToEndSpec.hs | 10 +++++++---
 hydra-node/src/Hydra/Chain/Direct.hs    |  4 ++--
 2 files changed, 9 insertions(+), 5 deletions(-)

diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs
index 64f9dee6ac3..a89385bdac5 100644
--- a/hydra-cluster/test/Test/EndToEndSpec.hs
+++ b/hydra-cluster/test/Test/EndToEndSpec.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 module Test.EndToEndSpec where
@@ -34,7 +35,9 @@ import Hydra.Cardano.Api (
   lovelaceToValue,
   mkVkAddress,
   serialiseAddress,
+  unSlotNo,
  )
+import Hydra.Chain.Direct (closeGraceTime)
 import Hydra.Crypto (deriveVerificationKey, generateSigningKey)
 import qualified Hydra.Crypto as Hydra
 import Hydra.Ledger (txId)
@@ -273,7 +276,8 @@ initAndClose tracer clusterIx node@(RunningNode _ nodeSocket) = do
       seedFromFaucet_ defaultNetworkId node bobCardanoVk 100_000_000 Fuel
       seedFromFaucet_ defaultNetworkId node carolCardanoVk 100_000_000 Fuel
 
-      let contestationPeriod = 10 :: Natural
+      let contestationPeriod = 2
+
       send n1 $ input "Init" ["contestationPeriod" .= contestationPeriod]
       waitFor tracer 10 [n1, n2, n3] $
         output "ReadyToCommit" ["parties" .= Set.fromList [alice, bob, carol]]
@@ -342,8 +346,8 @@ initAndClose tracer clusterIx node@(RunningNode _ nodeSocket) = do
         guard $ snapshotNumber == toJSON expectedSnapshotNumber
 
       -- NOTE: We expect the head to be finalized after the contestation period
-      -- and some three secs later
-      waitFor tracer (contestationPeriod + 3) [n1] $
+      -- and some three secs later, plus the closeGraceTime * slotLength
+      waitFor tracer (truncate $ contestationPeriod + (fromIntegral @_ @Double (unSlotNo closeGraceTime) * 0.1) + 3) [n1] $
         output "HeadIsFinalized" ["utxo" .= newUTxO]
 
       case fromJSON $ toJSON newUTxO of
diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs
index 2fe80f0a8c3..239d6948bd9 100644
--- a/hydra-node/src/Hydra/Chain/Direct.hs
+++ b/hydra-node/src/Hydra/Chain/Direct.hs
@@ -439,8 +439,8 @@ chainSyncHandler tracer callback headState =
         -- transformation into an `OnChainTx`
         let event = case (onChainTx, reifyState nextState) of
               (OnCloseTx{snapshotNumber}, TkClosed) ->
-                let remainingDiffTime = diffUTCTime (posixToUTCTime $ getContestationDeadline nextState) now
-                 in OnCloseTx{snapshotNumber, remainingContestationPeriod = remainingDiffTime}
+                let remainingTimeWithBuffer = 1 + diffUTCTime (posixToUTCTime $ getContestationDeadline nextState) now
+                 in OnCloseTx{snapshotNumber, remainingContestationPeriod = remainingTimeWithBuffer}
               _ -> onChainTx
         pure $ event : observed
       Nothing ->

From 3ea667a0af1f108ec1fb6fb2016f9046376b9dac Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Mon, 23 May 2022 15:53:59 +0000
Subject: [PATCH 22/24] Fix benchmark compilation

---
 hydra-node/exe/tx-cost/TxCost.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/hydra-node/exe/tx-cost/TxCost.hs b/hydra-node/exe/tx-cost/TxCost.hs
index 1ac8c01b7af..26ee230ca7d 100644
--- a/hydra-node/exe/tx-cost/TxCost.hs
+++ b/hydra-node/exe/tx-cost/TxCost.hs
@@ -46,7 +46,7 @@ import Hydra.Ledger.Cardano (
   genTxIn,
   simplifyUTxO,
  )
-import Hydra.Ledger.Cardano.Evaluate (evaluateTx, pparams)
+import Hydra.Ledger.Cardano.Evaluate (evaluateTx, genPointInTime, pparams)
 import Plutus.Orphans ()
 import Test.QuickCheck (generate, sublistOf, vectorOf)
 
@@ -164,7 +164,8 @@ computeFanOutCost = do
     ctx <- genHydraContext 3
     let utxo = genSimpleUTxOOfSize numOutputs `generateWith` 42
     (_, stClosed) <- genStClosed ctx utxo
-    pure (fanout utxo stClosed, getKnownUTxO stClosed)
+    pointInTime <- genPointInTime
+    pure (fanout utxo pointInTime stClosed, getKnownUTxO stClosed)
 
 genSimpleUTxOOfSize :: Int -> Gen UTxO
 genSimpleUTxOOfSize numUTxO =

From dacf52043a140333324303a1914e63ef9229a6eb Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Mon, 23 May 2022 17:02:24 +0000
Subject: [PATCH 23/24] Increase wait time in TUISpec

---
 hydra-tui/test/Hydra/TUISpec.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/hydra-tui/test/Hydra/TUISpec.hs b/hydra-tui/test/Hydra/TUISpec.hs
index 26ba4e07017..1b90d61ce7b 100644
--- a/hydra-tui/test/Hydra/TUISpec.hs
+++ b/hydra-tui/test/Hydra/TUISpec.hs
@@ -86,7 +86,7 @@ spec =
           sendInputEvent $ EvKey (KChar 'c') []
           threadDelay 1
           shouldRender "Closed"
-          threadDelay 10 -- contestation period
+          threadDelay 25 -- contestation period + some
           shouldRender "Final"
           shouldRender "42000000 lovelace"
           sendInputEvent $ EvKey (KChar 'q') []

From 76be7882fdae33ad0f2caeaa26bf31b491dd0cb5 Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Tue, 24 May 2022 07:58:14 +0000
Subject: [PATCH 24/24] Simplify property for comparing time

expecting 1/3rd of each Ordering ctor from randomly generated values does not make sense
as EQ is much likely to appear than the other ones.
---
 hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs b/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs
index aaa16d5bd2f..7348dfe09f4 100644
--- a/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs
+++ b/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs
@@ -10,8 +10,7 @@ import Hydra.Data.ContestationPeriod (
 import Plutus.Orphans ()
 import Test.Hspec (Spec, describe)
 import Test.Hspec.QuickCheck (prop)
-import Test.QuickCheck (tabulate, (===))
-import Test.QuickCheck.Property (coverTable)
+import Test.QuickCheck (collect, (===))
 
 spec :: Spec
 spec = do
@@ -24,5 +23,4 @@ spec = do
     prop "is homomorphic w.r.t to Ord" $ \t1 t2 ->
       let ordering = compare t1 t2
        in ordering === compare (posixToUTCTime t1) (posixToUTCTime t2)
-            & tabulate "Ord" (map show $ enumFrom LT)
-            & coverTable "Cover" [("LT", 33), ("EQ", 33), ("GT", 33)]
+            & collect ordering