diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index e5a3dfcb670..1777f65e6df 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -60,7 +60,7 @@ import Hydra.Cluster.Faucet (FaucetLog, createOutputAtAddress, seedFromFaucet, s import Hydra.Cluster.Faucet qualified as Faucet import Hydra.Cluster.Fixture (Actor (..), actorName, alice, aliceSk, aliceVk, bob, bobSk, bobVk, carol, carolSk) import Hydra.Cluster.Util (chainConfigFor, keysFor, modifyConfig, setNetworkId) -import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) +import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod), fromDiffTime) import Hydra.HeadId (HeadId) import Hydra.Ledger (IsTx (balance)) import Hydra.Ledger.Cardano (genKeyPair) @@ -232,7 +232,7 @@ singlePartyHeadFullLifeCycle tracer workDir node hydraScriptsTxId = refuelIfNeeded tracer node Alice 25_000_000 -- Start hydra-node on chain tip tip <- queryTip networkId nodeSocket - let contestationPeriod = UnsafeContestationPeriod $ max 1 . truncate $ 10 * blockTime + contestationPeriod <- fromDiffTime $ 10 * blockTime aliceChainConfig <- chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] contestationPeriod <&> modifyConfig (\config -> config{networkId, startChainFrom = Just tip}) diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 6e852db9a6d..b4a173585f5 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -292,6 +292,7 @@ test-suite tests Hydra.Chain.Direct.TimeHandleSpec Hydra.Chain.Direct.TxSpec Hydra.Chain.Direct.WalletSpec + Hydra.ContestationPeriodSpec Hydra.CryptoSpec Hydra.FireForgetSpec Hydra.HeadLogicSnapshotSpec diff --git a/hydra-node/src/Hydra/ContestationPeriod.hs b/hydra-node/src/Hydra/ContestationPeriod.hs index d28386b9814..562f6def308 100644 --- a/hydra-node/src/Hydra/ContestationPeriod.hs +++ b/hydra-node/src/Hydra/ContestationPeriod.hs @@ -2,6 +2,7 @@ module Hydra.ContestationPeriod where import Hydra.Prelude hiding (Show, show) +import Data.Fixed (Pico) import Data.Ratio ((%)) import Data.Time (secondsToNominalDiffTime) import Hydra.Data.ContestationPeriod qualified as OnChain @@ -36,6 +37,16 @@ instance Arbitrary ContestationPeriod where oneMonth = oneDay * 30 oneYear = oneDay * 365 +-- | Create a 'ContestationPeriod' from a 'DiffTime'. This will fail if a +-- negative DiffTime is provided and truncates to 1s if values < 1s are given. +fromDiffTime :: MonadFail m => DiffTime -> m ContestationPeriod +fromDiffTime dt = + if seconds > 0 + then pure . UnsafeContestationPeriod $ truncate seconds + else fail $ "fromDiffTime: contestation period <= 0: " <> show dt + where + seconds :: Pico = realToFrac dt + -- | Convert an off-chain contestation period to its on-chain representation. toChain :: ContestationPeriod -> OnChain.ContestationPeriod toChain (UnsafeContestationPeriod s) = diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index c418ad587d5..682df182d34 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -35,7 +35,7 @@ import Hydra.Cardano.Api ( serialiseToRawBytesHexText, ) import Hydra.Chain (maximumNumberOfParties) -import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) +import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod), fromDiffTime) import Hydra.Contract qualified as Contract import Hydra.Ledger.Cardano () import Hydra.Logging (Verbosity (..)) @@ -732,7 +732,7 @@ defaultContestationPeriod = UnsafeContestationPeriod 60 contestationPeriodParser :: Parser ContestationPeriod contestationPeriodParser = option - (parseNatural <|> parseNominalDiffTime) + (parseNatural <|> parseViaDiffTime) ( long "contestation-period" <> metavar "SECONDS" <> value defaultContestationPeriod @@ -746,12 +746,7 @@ contestationPeriodParser = where parseNatural = UnsafeContestationPeriod <$> auto - parseNominalDiffTime = - auto >>= \dt -> do - let s = nominalDiffTimeToSeconds dt - if s <= 0 - then fail $ "contestation period <= 0: " <> show s - else pure $ UnsafeContestationPeriod $ truncate s + parseViaDiffTime = auto >>= fromDiffTime data InvalidOptions = MaximumNumberOfPartiesExceeded diff --git a/hydra-node/test/Hydra/ContestationPeriodSpec.hs b/hydra-node/test/Hydra/ContestationPeriodSpec.hs new file mode 100644 index 00000000000..a7f9c3c3ec1 --- /dev/null +++ b/hydra-node/test/Hydra/ContestationPeriodSpec.hs @@ -0,0 +1,18 @@ +module Hydra.ContestationPeriodSpec where + +import Hydra.Prelude + +import Hydra.ContestationPeriod (fromDiffTime) +import Test.Hspec (Spec, describe) +import Test.Hspec.QuickCheck (prop) +import Test.QuickCheck (getNonPositive, getPositive) +import Test.QuickCheck.Instances.Time () + +spec :: Spec +spec = do + describe "fromDiffTime" $ do + prop "works for diff times > 0" $ + isJust . fromDiffTime . getPositive + + prop "fails for diff times <= 0" $ + isNothing . fromDiffTime . getNonPositive