From 07e62b770c1bfe008cf2f044bd5e128a6357ed5c Mon Sep 17 00:00:00 2001
From: Sebastian Nagel <sebastian.nagel@ncoding.at>
Date: Tue, 5 Jul 2022 10:03:08 +0200
Subject: [PATCH] Define Period type and allow contest <= deadline

We introduce Period to have a more restricted type on the contestation
period value in the context (should be using it everywhere).
---
 hydra-node/src/Hydra/Chain/Direct/Context.hs  | 25 ++++++++++++++++---
 .../test/Hydra/Chain/Direct/StateSpec.hs      |  2 +-
 hydra-plutus/src/Hydra/Contract/Head.hs       |  2 +-
 3 files changed, 23 insertions(+), 6 deletions(-)

diff --git a/hydra-node/src/Hydra/Chain/Direct/Context.hs b/hydra-node/src/Hydra/Chain/Direct/Context.hs
index e8973a3a494..59c9ee04049 100644
--- a/hydra-node/src/Hydra/Chain/Direct/Context.hs
+++ b/hydra-node/src/Hydra/Chain/Direct/Context.hs
@@ -5,6 +5,7 @@ module Hydra.Chain.Direct.Context where
 import Hydra.Prelude
 
 import Data.List ((\\))
+import qualified Data.Time as Time
 import Hydra.Cardano.Api (
   NetworkId (..),
   NetworkMagic (..),
@@ -32,7 +33,7 @@ import Hydra.Ledger.Cardano (genOneUTxOFor, genTxIn, genUTxOAdaOnlyOfSize, genVe
 import Hydra.Ledger.Cardano.Evaluate (genPointInTime, genPointInTimeAfter)
 import Hydra.Party (Party, deriveParty)
 import Hydra.Snapshot (ConfirmedSnapshot (..), Snapshot (..), SnapshotNumber, genConfirmedSnapshot)
-import Test.QuickCheck (Positive (Positive), choose, elements, frequency, vector)
+import Test.QuickCheck (choose, elements, frequency, getPositive, vector)
 
 -- | Define some 'global' context from which generators can pick
 -- values for generation. This allows to write fairly independent generators
@@ -45,10 +46,26 @@ data HydraContext = HydraContext
   { ctxVerificationKeys :: [VerificationKey PaymentKey]
   , ctxHydraSigningKeys :: [Hydra.SigningKey]
   , ctxNetworkId :: NetworkId
-  , ctxContestationPeriod :: NominalDiffTime
+  , ctxContestationPeriod :: Period
   }
   deriving (Show)
 
+-- | A positive number of seconds.
+newtype Period = UnsafePeriod Natural
+  deriving (Eq, Show)
+
+instance Arbitrary Period where
+  -- NOTE: fromInteger to avoid overlapping instances for 'Arbitrary Natural'
+  arbitrary = UnsafePeriod . fromInteger . getPositive <$> (arbitrary :: Gen (Positive Integer))
+
+mkPeriod :: Natural -> Maybe Period
+mkPeriod n
+  | n == 0 = Nothing
+  | otherwise = Just (UnsafePeriod n)
+
+periodToNominalDiffTime :: Period -> NominalDiffTime
+periodToNominalDiffTime (UnsafePeriod s) = Time.secondsToNominalDiffTime $ fromIntegral s
+
 ctxParties :: HydraContext -> [Party]
 ctxParties = fmap deriveParty . ctxHydraSigningKeys
 
@@ -56,7 +73,7 @@ ctxHeadParameters ::
   HydraContext ->
   HeadParameters
 ctxHeadParameters ctx@HydraContext{ctxContestationPeriod} =
-  HeadParameters ctxContestationPeriod (ctxParties ctx)
+  HeadParameters (periodToNominalDiffTime ctxContestationPeriod) (ctxParties ctx)
 
 --
 -- Generators
@@ -74,7 +91,7 @@ genHydraContextFor n = do
   ctxVerificationKeys <- replicateM n genVerificationKey
   ctxHydraSigningKeys <- fmap Hydra.generateSigningKey <$> vector n
   ctxNetworkId <- Testnet . NetworkMagic <$> arbitrary
-  Positive ctxContestationPeriod <- arbitrary
+  ctxContestationPeriod <- arbitrary
   pure $
     HydraContext
       { ctxVerificationKeys
diff --git a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs
index b8dee0cc330..7f139b08867 100644
--- a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs
@@ -547,7 +547,7 @@ forAllContest action =
       & counterexample ("Contestation period: " <> show ctxContestationPeriod)
       & counterexample ("Close point: " <> show closePointInTime)
       & tabulate "Contestation deadline" (tabulateNum $ getContestationDeadline stClosed)
-      & tabulate "Contestation period" (tabulateNum ctxContestationPeriod)
+      & label ("Contestation period: " <> show ctxContestationPeriod) -- TODO: remove
       & tabulate "Close point (slot)" (tabulateNum $ fst closePointInTime)
  where
   tabulateNum x
diff --git a/hydra-plutus/src/Hydra/Contract/Head.hs b/hydra-plutus/src/Hydra/Contract/Head.hs
index 37ab5081546..df0a1d13dc6 100644
--- a/hydra-plutus/src/Hydra/Contract/Head.hs
+++ b/hydra-plutus/src/Hydra/Contract/Head.hs
@@ -342,7 +342,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
+      UpperBound (Finite time) _ -> traceIfFalse "upper bound validity beyond contestation deadline" $ time <= contestationDeadline
       _ -> traceError "no upper bound validity interval defined for contest"
 {-# INLINEABLE checkContest #-}