Skip to content

Commit

Permalink
Define Period type and allow contest <= deadline
Browse files Browse the repository at this point in the history
We introduce Period to have a more restricted type on the contestation
period value in the context (should be using it everywhere).
  • Loading branch information
ch1bo committed Jul 5, 2022
1 parent a1f3bb8 commit 07e62b7
Show file tree
Hide file tree
Showing 3 changed files with 23 additions and 6 deletions.
25 changes: 21 additions & 4 deletions hydra-node/src/Hydra/Chain/Direct/Context.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..),
Expand Down Expand Up @@ -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
Expand All @@ -45,18 +46,34 @@ 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

ctxHeadParameters ::
HydraContext ->
HeadParameters
ctxHeadParameters ctx@HydraContext{ctxContestationPeriod} =
HeadParameters ctxContestationPeriod (ctxParties ctx)
HeadParameters (periodToNominalDiffTime ctxContestationPeriod) (ctxParties ctx)

--
-- Generators
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion hydra-node/test/Hydra/Chain/Direct/StateSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion hydra-plutus/src/Hydra/Contract/Head.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 #-}

Expand Down

0 comments on commit 07e62b7

Please sign in to comment.