From e2e530649fc9230a028d3fe24239799b38bd9aa6 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Thu, 11 Jan 2024 15:58:48 +0100 Subject: [PATCH 1/7] Fix the fix of ContestationPeriod fromDiffTime --- hydra-node/src/Hydra/ContestationPeriod.hs | 2 +- hydra-node/test/Hydra/ContestationPeriodSpec.hs | 10 ++++++++-- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/hydra-node/src/Hydra/ContestationPeriod.hs b/hydra-node/src/Hydra/ContestationPeriod.hs index 562f6def308..f4efdb285a7 100644 --- a/hydra-node/src/Hydra/ContestationPeriod.hs +++ b/hydra-node/src/Hydra/ContestationPeriod.hs @@ -42,7 +42,7 @@ instance Arbitrary ContestationPeriod where fromDiffTime :: MonadFail m => DiffTime -> m ContestationPeriod fromDiffTime dt = if seconds > 0 - then pure . UnsafeContestationPeriod $ truncate seconds + then pure . UnsafeContestationPeriod . max 1 $ truncate seconds else fail $ "fromDiffTime: contestation period <= 0: " <> show dt where seconds :: Pico = realToFrac dt diff --git a/hydra-node/test/Hydra/ContestationPeriodSpec.hs b/hydra-node/test/Hydra/ContestationPeriodSpec.hs index a7f9c3c3ec1..5afd01b334a 100644 --- a/hydra-node/test/Hydra/ContestationPeriodSpec.hs +++ b/hydra-node/test/Hydra/ContestationPeriodSpec.hs @@ -2,10 +2,11 @@ module Hydra.ContestationPeriodSpec where import Hydra.Prelude -import Hydra.ContestationPeriod (fromDiffTime) +import Data.Time (picosecondsToDiffTime) +import Hydra.ContestationPeriod (ContestationPeriod, fromDiffTime) import Test.Hspec (Spec, describe) import Test.Hspec.QuickCheck (prop) -import Test.QuickCheck (getNonPositive, getPositive) +import Test.QuickCheck (getNonPositive, getPositive, (===)) import Test.QuickCheck.Instances.Time () spec :: Spec @@ -16,3 +17,8 @@ spec = do prop "fails for diff times <= 0" $ isNothing . fromDiffTime . getNonPositive + + prop "rounds to 1 second" $ \n -> + let subSecondPicos = getPositive n `mod` 1_000_000_000_000 + in fromDiffTime (picosecondsToDiffTime subSecondPicos) + === (fromDiffTime 1 :: Maybe ContestationPeriod) From a24c170b672eb73b2d492155e8e9ef3a10951636 Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Thu, 11 Jan 2024 16:43:43 +0100 Subject: [PATCH 2/7] Simplify rounding to use ceiling also cleanup some imports --- hydra-node/src/Hydra/ContestationPeriod.hs | 2 +- hydra-node/src/Hydra/Options.hs | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/hydra-node/src/Hydra/ContestationPeriod.hs b/hydra-node/src/Hydra/ContestationPeriod.hs index f4efdb285a7..bcc8fedab3a 100644 --- a/hydra-node/src/Hydra/ContestationPeriod.hs +++ b/hydra-node/src/Hydra/ContestationPeriod.hs @@ -42,7 +42,7 @@ instance Arbitrary ContestationPeriod where fromDiffTime :: MonadFail m => DiffTime -> m ContestationPeriod fromDiffTime dt = if seconds > 0 - then pure . UnsafeContestationPeriod . max 1 $ truncate seconds + then pure . UnsafeContestationPeriod $ ceiling seconds else fail $ "fromDiffTime: contestation period <= 0: " <> show dt where seconds :: Pico = realToFrac dt diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index 682df182d34..eb32d3f6c53 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -18,7 +18,6 @@ import Data.ByteString.Char8 qualified as BSC import Data.IP (IP (IPv4), toIPv4, toIPv4w) import Data.Text (unpack) import Data.Text qualified as T -import Data.Time.Clock (nominalDiffTimeToSeconds) import Data.Version (Version (..), showVersion) import Hydra.Cardano.Api ( AsType (AsTxId), From 95a77bd2a11a96a9c40b52b029fdb24cfc7c6924 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Thu, 11 Jan 2024 17:34:29 +0100 Subject: [PATCH 3/7] Define a test suite for withCardanoNodeOnKnownNetwork This also asserts correctly computed block time now. --- hydra-cluster/test/Test/CardanoNodeSpec.hs | 45 ++++++++++++++++------ 1 file changed, 33 insertions(+), 12 deletions(-) diff --git a/hydra-cluster/test/Test/CardanoNodeSpec.hs b/hydra-cluster/test/Test/CardanoNodeSpec.hs index be6ff0e60f6..ae35bebc155 100644 --- a/hydra-cluster/test/Test/CardanoNodeSpec.hs +++ b/hydra-cluster/test/Test/CardanoNodeSpec.hs @@ -6,10 +6,13 @@ import Test.Hydra.Prelude import CardanoNode ( getCardanoNodeVersion, withCardanoNodeDevnet, + withCardanoNodeOnKnownNetwork, ) import CardanoClient (RunningNode (..), queryTipSlotNo) import Hydra.Cardano.Api (NetworkId (Testnet), NetworkMagic (NetworkMagic), unFile) +import Hydra.Cardano.Api qualified as NetworkId +import Hydra.Cluster.Fixture (KnownNetwork (Mainnet)) import Hydra.Logging (showLogsOnFailure) import System.Directory (doesFileExist) @@ -21,17 +24,35 @@ spec = do it "has expected cardano-node version available" $ getCardanoNodeVersion >>= (`shouldContain` "8.7.2") - -- NOTE: We hard-code the expected networkId here to detect any change to the - -- genesis-shelley.json it "withCardanoNodeDevnet does start a block-producing devnet within 5 seconds" $ failAfter 5 $ - showLogsOnFailure "CardanoNodeSpec" $ \tr -> do - withTempDir "hydra-cluster" $ \tmp -> do - withCardanoNodeDevnet tr tmp $ \RunningNode{nodeSocket, networkId} -> do - doesFileExist (unFile nodeSocket) `shouldReturn` True - networkId `shouldBe` Testnet (NetworkMagic 42) - -- Should produce blocks (tip advances) - slot1 <- queryTipSlotNo networkId nodeSocket - threadDelay 1 - slot2 <- queryTipSlotNo networkId nodeSocket - slot2 `shouldSatisfy` (> slot1) + showLogsOnFailure "CardanoNodeSpec" $ \tr -> + withTempDir "hydra-cluster" $ \tmp -> + withCardanoNodeDevnet tr tmp $ + \RunningNode{nodeSocket, networkId, blockTime} -> do + doesFileExist (unFile nodeSocket) `shouldReturn` True + -- NOTE: We hard-code the expected networkId and blockTime here to + -- detect any change to the genesis-shelley.json + networkId `shouldBe` Testnet (NetworkMagic 42) + blockTime `shouldBe` 0.1 + -- Should produce blocks (tip advances) + slot1 <- queryTipSlotNo networkId nodeSocket + threadDelay 1 + slot2 <- queryTipSlotNo networkId nodeSocket + slot2 `shouldSatisfy` (> slot1) + + it "withCardanoNodeOnKnownNetwork on mainnet starts synchronizing within 5 seconds" $ + -- NOTE: This implies that withCardanoNodeOnKnownNetwork does not + -- synchronize the whole chain before continuing. + failAfter 5 $ + showLogsOnFailure "CardanoNodeSpec" $ \tr -> + withTempDir "hydra-cluster" $ \tmp -> + withCardanoNodeOnKnownNetwork tr tmp Mainnet $ + \RunningNode{nodeSocket, networkId, blockTime} -> do + networkId `shouldBe` NetworkId.Mainnet + blockTime `shouldBe` 20 + -- Should synchronize blocks (tip advances) + slot1 <- queryTipSlotNo networkId nodeSocket + threadDelay 1 + slot2 <- queryTipSlotNo networkId nodeSocket + slot2 `shouldSatisfy` (> slot1) From 45d660435fc3847fc53f7e52ccd283f5a0a8f45a Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Thu, 11 Jan 2024 17:35:43 +0100 Subject: [PATCH 4/7] Move waitForFullySynchronized and use RunningNode The contained TODO can be addressed in a next step now. --- hydra-cluster/exe/hydra-cluster/Main.hs | 3 +- hydra-cluster/src/CardanoClient.hs | 41 ----------------- hydra-cluster/src/CardanoNode.hs | 47 ++++++++++++++++---- hydra-cluster/src/Hydra/Cluster/Scenarios.hs | 2 +- hydra-cluster/test/Test/ChainObserverSpec.hs | 4 +- hydra-cluster/test/Test/DirectChainSpec.hs | 3 +- hydra-tui/test/Hydra/TUISpec.hs | 4 +- 7 files changed, 47 insertions(+), 57 deletions(-) diff --git a/hydra-cluster/exe/hydra-cluster/Main.hs b/hydra-cluster/exe/hydra-cluster/Main.hs index 73323e46c41..ce490947a1e 100644 --- a/hydra-cluster/exe/hydra-cluster/Main.hs +++ b/hydra-cluster/exe/hydra-cluster/Main.hs @@ -2,7 +2,7 @@ module Main where import Hydra.Prelude -import CardanoNode (withCardanoNodeDevnet, withCardanoNodeOnKnownNetwork) +import CardanoNode (waitForFullySynchronized, withCardanoNodeDevnet, withCardanoNodeOnKnownNetwork) import Hydra.Cluster.Faucet (publishHydraScriptsAs) import Hydra.Cluster.Fixture (Actor (Faucet)) import Hydra.Cluster.Options (Options (..), PublishOrReuse (Publish, Reuse), parseOptions) @@ -24,6 +24,7 @@ run options = case knownNetwork of Just network -> withCardanoNodeOnKnownNetwork fromCardanoNode workDir network $ \node -> do + waitForFullySynchronized fromCardanoNode node publishOrReuseHydraScripts tracer node >>= singlePartyHeadFullLifeCycle tracer workDir node Nothing -> diff --git a/hydra-cluster/src/CardanoClient.hs b/hydra-cluster/src/CardanoClient.hs index f35e87a49cf..83c42277597 100644 --- a/hydra-cluster/src/CardanoClient.hs +++ b/hydra-cluster/src/CardanoClient.hs @@ -15,11 +15,8 @@ import Hydra.Cardano.Api hiding (Block) import Hydra.Chain.CardanoClient import Cardano.Api.UTxO qualified as UTxO -import Cardano.Slotting.Time (RelativeTime (getRelativeTime), diffRelativeTime, toRelativeTime) -import Data.Fixed (Centi) import Data.Map qualified as Map import Hydra.Chain.CardanoClient qualified as CardanoClient -import Hydra.Logging (Tracer, traceWith) -- TODO(SN): DRY with Hydra.Cardano.Api @@ -170,41 +167,3 @@ data RunningNode = RunningNode , blockTime :: DiffTime -- ^ Expected time between blocks (varies a lot on testnets) } - --- Logging - -data NodeLog - = MsgNodeCmdSpec {cmd :: Text} - | MsgCLI [Text] - | MsgCLIStatus Text Text - | MsgCLIRetry Text - | MsgCLIRetryResult Text Int - | MsgNodeStarting {stateDirectory :: FilePath} - | MsgSocketIsReady SocketPath - | MsgSynchronizing {percentDone :: Centi} - | MsgNodeIsReady - deriving stock (Eq, Show, Generic) - deriving anyclass (ToJSON, FromJSON) - --- | Wait until the node is fully caught up with the network. This can take a --- while! -waitForFullySynchronized :: - Tracer IO NodeLog -> - NetworkId -> - SocketPath -> - IO () -waitForFullySynchronized tracer networkId nodeSocket = do - systemStart <- querySystemStart networkId nodeSocket QueryTip - check systemStart - where - check systemStart = do - targetTime <- toRelativeTime systemStart <$> getCurrentTime - eraHistory <- queryEraHistory networkId nodeSocket QueryTip - tipSlotNo <- queryTipSlotNo networkId nodeSocket - (tipTime, _slotLength) <- either throwIO pure $ getProgress tipSlotNo eraHistory - let timeDifference = diffRelativeTime targetTime tipTime - let percentDone = realToFrac (100.0 * getRelativeTime tipTime / getRelativeTime targetTime) - traceWith tracer $ MsgSynchronizing{percentDone} - if timeDifference < 20 -- TODO: derive from known network and block times - then pure () - else threadDelay 3 >> check systemStart diff --git a/hydra-cluster/src/CardanoNode.hs b/hydra-cluster/src/CardanoNode.hs index ba1050c2d62..b532dbb78f4 100644 --- a/hydra-cluster/src/CardanoNode.hs +++ b/hydra-cluster/src/CardanoNode.hs @@ -4,12 +4,14 @@ module CardanoNode where import Hydra.Prelude -import CardanoClient (NodeLog (..), QueryPoint (QueryTip), RunningNode (..), queryGenesisParameters, waitForFullySynchronized) +import Cardano.Slotting.Time (diffRelativeTime, getRelativeTime, toRelativeTime) +import CardanoClient (QueryPoint (QueryTip), RunningNode (..), queryEraHistory, querySystemStart, queryTipSlotNo) import Control.Lens ((?~), (^?!)) import Control.Tracer (Tracer, traceWith) import Data.Aeson (Value (String), (.=)) import Data.Aeson qualified as Aeson import Data.Aeson.Lens (atKey, key, _Number) +import Data.Fixed (Centi) import Data.Text qualified as Text import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import Hydra.Cardano.Api ( @@ -23,6 +25,7 @@ import Hydra.Cardano.Api ( SocketPath, VerificationKey, generateSigningKey, + getProgress, getVerificationKey, ) import Hydra.Cardano.Api qualified as Api @@ -45,6 +48,18 @@ import System.Process ( ) import Test.Hydra.Prelude +data NodeLog + = MsgNodeCmdSpec {cmd :: Text} + | MsgCLI [Text] + | MsgCLIStatus Text Text + | MsgCLIRetry Text + | MsgCLIRetryResult Text Int + | MsgNodeStarting {stateDirectory :: FilePath} + | MsgSocketIsReady SocketPath + | MsgSynchronizing {percentDone :: Centi} + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON, FromJSON) + type Port = Int newtype NodeId = NodeId Int @@ -291,17 +306,11 @@ withCardanoNode tr stateDirectory args@CardanoNodeArgs{nodeSocket} networkId act traceWith tr $ MsgNodeStarting{stateDirectory} waitForSocket nodeSocketPath traceWith tr $ MsgSocketIsReady nodeSocketPath - -- Wait for synchronization since otherwise we will receive a query - -- exception when trying to obtain pparams and the era is not the one we - -- expect. - _ <- waitForFullySynchronized tr networkId nodeSocketPath - traceWith tr MsgNodeIsReady - blockTime <- calculateBlockTime <$> queryGenesisParameters networkId nodeSocketPath QueryTip action RunningNode { nodeSocket = nodeSocketPath , networkId - , blockTime + , blockTime = 0.1 } calculateBlockTime @@ -316,6 +325,28 @@ withCardanoNode tr stateDirectory args@CardanoNodeArgs{nodeSocket} networkId act whenM (doesFileExist socketPath) $ removeFile socketPath +-- | Wait until the node is fully caught up with the network. This can take a +-- while! +waitForFullySynchronized :: + Tracer IO NodeLog -> + RunningNode -> + IO () +waitForFullySynchronized tracer RunningNode{networkId, nodeSocket} = do + systemStart <- querySystemStart networkId nodeSocket QueryTip + check systemStart + where + check systemStart = do + targetTime <- toRelativeTime systemStart <$> getCurrentTime + eraHistory <- queryEraHistory networkId nodeSocket QueryTip + tipSlotNo <- queryTipSlotNo networkId nodeSocket + (tipTime, _slotLength) <- either throwIO pure $ getProgress tipSlotNo eraHistory + let timeDifference = diffRelativeTime targetTime tipTime + let percentDone = realToFrac (100.0 * getRelativeTime tipTime / getRelativeTime targetTime) + traceWith tracer $ MsgSynchronizing{percentDone} + if timeDifference < 20 -- TODO: derive from known network and block times + then pure () + else threadDelay 3 >> check systemStart + -- | Wait for the node socket file to become available. waitForSocket :: SocketPath -> IO () waitForSocket socketPath = diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index 1777f65e6df..6ffd5a9b664 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -8,7 +8,6 @@ import Test.Hydra.Prelude import Cardano.Api.UTxO qualified as UTxO import CardanoClient ( - NodeLog, QueryPoint (QueryTip), RunningNode (..), buildTransaction, @@ -16,6 +15,7 @@ import CardanoClient ( queryUTxOFor, submitTx, ) +import CardanoNode (NodeLog) import Control.Concurrent.Async (mapConcurrently_) import Control.Lens ((^?)) import Data.Aeson (Value, object, (.=)) diff --git a/hydra-cluster/test/Test/ChainObserverSpec.hs b/hydra-cluster/test/Test/ChainObserverSpec.hs index 6ddd292a7e5..71d7346afcf 100644 --- a/hydra-cluster/test/Test/ChainObserverSpec.hs +++ b/hydra-cluster/test/Test/ChainObserverSpec.hs @@ -9,8 +9,8 @@ module Test.ChainObserverSpec where import Hydra.Prelude import Test.Hydra.Prelude -import CardanoClient (NodeLog, RunningNode (..), submitTx) -import CardanoNode (withCardanoNodeDevnet) +import CardanoClient (RunningNode (..), submitTx) +import CardanoNode (NodeLog, withCardanoNodeDevnet) import Control.Concurrent.Class.MonadSTM (modifyTVar', newTVarIO, readTVarIO) import Control.Exception (IOException) import Control.Lens ((^?)) diff --git a/hydra-cluster/test/Test/DirectChainSpec.hs b/hydra-cluster/test/Test/DirectChainSpec.hs index b5a6148243d..9949aa1d0fc 100644 --- a/hydra-cluster/test/Test/DirectChainSpec.hs +++ b/hydra-cluster/test/Test/DirectChainSpec.hs @@ -7,7 +7,6 @@ import Test.Hydra.Prelude import Cardano.Api.UTxO (UTxO' (UTxO, toMap)) import CardanoClient ( - NodeLog, QueryPoint (QueryTip), RunningNode (..), buildAddress, @@ -16,7 +15,7 @@ import CardanoClient ( submitTx, waitForUTxO, ) -import CardanoNode (withCardanoNodeDevnet) +import CardanoNode (NodeLog, withCardanoNodeDevnet) import Control.Concurrent.STM (newEmptyTMVarIO, takeTMVar) import Control.Concurrent.STM.TMVar (putTMVar) import Hydra.Cardano.Api ( diff --git a/hydra-tui/test/Hydra/TUISpec.hs b/hydra-tui/test/Hydra/TUISpec.hs index 007ce802758..2b3f8ad66d7 100644 --- a/hydra-tui/test/Hydra/TUISpec.hs +++ b/hydra-tui/test/Hydra/TUISpec.hs @@ -7,8 +7,8 @@ import Hydra.Prelude import Test.Hydra.Prelude import Blaze.ByteString.Builder.Char8 (writeChar) -import CardanoClient (NodeLog, RunningNode (..)) -import CardanoNode (withCardanoNodeDevnet) +import CardanoClient (RunningNode (..)) +import CardanoNode (NodeLog, withCardanoNodeDevnet) import Control.Concurrent.Class.MonadSTM (newTQueueIO, readTQueue, tryReadTQueue, writeTQueue) import Data.ByteString qualified as BS import Graphics.Vty ( From 448517b6aae2f33a4b9f034484d5398676df1597 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Thu, 11 Jan 2024 18:04:35 +0100 Subject: [PATCH 5/7] Read block time from shelley genesis JSON This file must be available to start the cardano-node and we do not need to wait for the network to be in a shelley compatible era to query it. --- hydra-cluster/src/CardanoNode.hs | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/hydra-cluster/src/CardanoNode.hs b/hydra-cluster/src/CardanoNode.hs index b532dbb78f4..ebf6536503a 100644 --- a/hydra-cluster/src/CardanoNode.hs +++ b/hydra-cluster/src/CardanoNode.hs @@ -6,7 +6,7 @@ import Hydra.Prelude import Cardano.Slotting.Time (diffRelativeTime, getRelativeTime, toRelativeTime) import CardanoClient (QueryPoint (QueryTip), RunningNode (..), queryEraHistory, querySystemStart, queryTipSlotNo) -import Control.Lens ((?~), (^?!)) +import Control.Lens ((?~), (^?), (^?!)) import Control.Tracer (Tracer, traceWith) import Data.Aeson (Value (String), (.=)) import Data.Aeson qualified as Aeson @@ -17,7 +17,6 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import Hydra.Cardano.Api ( AsType (AsPaymentKey), File (..), - GenesisParameters (..), NetworkId, NetworkMagic (..), PaymentKey, @@ -283,7 +282,7 @@ withCardanoNode :: NetworkId -> (RunningNode -> IO a) -> IO a -withCardanoNode tr stateDirectory args@CardanoNodeArgs{nodeSocket} networkId action = do +withCardanoNode tr stateDirectory args networkId action = do traceWith tr $ MsgNodeCmdSpec (show $ cmdspec process) withLogFile logFilePath $ \out -> do hSetBuffering out NoBuffering @@ -295,6 +294,8 @@ withCardanoNode tr stateDirectory args@CardanoNodeArgs{nodeSocket} networkId act Left{} -> error "should never been reached" Right a -> pure a where + CardanoNodeArgs{nodeSocket, nodeShelleyGenesisFile} = args + process = cardanoNodeProcess (Just stateDirectory) args logFilePath = stateDirectory "logs" "cardano-node.log" @@ -306,20 +307,21 @@ withCardanoNode tr stateDirectory args@CardanoNodeArgs{nodeSocket} networkId act traceWith tr $ MsgNodeStarting{stateDirectory} waitForSocket nodeSocketPath traceWith tr $ MsgSocketIsReady nodeSocketPath + blockTime <- readBlockTime $ stateDirectory nodeShelleyGenesisFile action RunningNode { nodeSocket = nodeSocketPath , networkId - , blockTime = 0.1 + , blockTime } - calculateBlockTime - GenesisParameters - { protocolParamActiveSlotsCoefficient - , protocolParamSlotLength - } = - fromRational $ - protocolParamActiveSlotsCoefficient * toRational protocolParamSlotLength + -- Read expected time between blocks from shelley genesis + readBlockTime fp = do + shelleyGenesis <- readFileBS fp + maybe (fail $ "failed to decode " <> fp) pure $ do + slotLength <- shelleyGenesis ^? key "slotLength" . _Number + activeSlotsCoeff <- shelleyGenesis ^? key "activeSlotsCoeff" . _Number + pure . realToFrac $ slotLength / activeSlotsCoeff cleanupSocketFile = whenM (doesFileExist socketPath) $ From baaca52aabd85ecd425ef3fdc6140f044147afdb Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Thu, 11 Jan 2024 18:14:43 +0100 Subject: [PATCH 6/7] Change withCardanoNode to read networkId from shelley genesis This removes the hard-coded 42 network magic from withCardanoNodeDevnet --- hydra-cluster/src/CardanoNode.hs | 57 +++++++++++-------------- hydra-cluster/test/Test/EndToEndSpec.hs | 9 ++-- 2 files changed, 28 insertions(+), 38 deletions(-) diff --git a/hydra-cluster/src/CardanoNode.hs b/hydra-cluster/src/CardanoNode.hs index ebf6536503a..c101987599b 100644 --- a/hydra-cluster/src/CardanoNode.hs +++ b/hydra-cluster/src/CardanoNode.hs @@ -6,7 +6,7 @@ import Hydra.Prelude import Cardano.Slotting.Time (diffRelativeTime, getRelativeTime, toRelativeTime) import CardanoClient (QueryPoint (QueryTip), RunningNode (..), queryEraHistory, querySystemStart, queryTipSlotNo) -import Control.Lens ((?~), (^?), (^?!)) +import Control.Lens ((?~), (^?!)) import Control.Tracer (Tracer, traceWith) import Data.Aeson (Value (String), (.=)) import Data.Aeson qualified as Aeson @@ -28,10 +28,7 @@ import Hydra.Cardano.Api ( getVerificationKey, ) import Hydra.Cardano.Api qualified as Api -import Hydra.Cluster.Fixture ( - KnownNetwork (Mainnet, Preproduction, Preview), - defaultNetworkId, - ) +import Hydra.Cluster.Fixture (KnownNetwork (..)) import Hydra.Cluster.Util (readConfigFile) import Network.HTTP.Simple (getResponseBody, httpBS, parseRequestThrow) import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile) @@ -139,10 +136,7 @@ withCardanoNodeDevnet :: IO a withCardanoNodeDevnet tracer stateDirectory action = do args <- setupCardanoDevnet stateDirectory - withCardanoNode tracer stateDirectory args networkId action - where - -- NOTE: This needs to match what's in config/genesis-shelley.json - networkId = defaultNetworkId + withCardanoNode tracer stateDirectory args action -- | Run a cardano-node as normal network participant on a known network. withCardanoNodeOnKnownNetwork :: @@ -155,8 +149,7 @@ withCardanoNodeOnKnownNetwork :: IO a withCardanoNodeOnKnownNetwork tracer workDir knownNetwork action = do copyKnownNetworkFiles - networkId <- readNetworkId - withCardanoNode tracer workDir args networkId action + withCardanoNode tracer workDir args action where args = defaultCardanoNodeArgs @@ -168,15 +161,6 @@ withCardanoNodeOnKnownNetwork tracer workDir knownNetwork action = do , nodeConwayGenesisFile = "conway-genesis.json" } - -- Read 'NetworkId' from shelley genesis - readNetworkId = do - shelleyGenesis :: Aeson.Value <- unsafeDecodeJson =<< readFileBS (workDir "shelley-genesis.json") - if shelleyGenesis ^?! key "networkId" == "Mainnet" - then pure Api.Mainnet - else do - let magic = shelleyGenesis ^?! key "networkMagic" . _Number - pure $ Api.Testnet (Api.NetworkMagic $ truncate magic) - -- Copy/download configuration files for a known network copyKnownNetworkFiles = forM_ @@ -279,10 +263,9 @@ withCardanoNode :: Tracer IO NodeLog -> FilePath -> CardanoNodeArgs -> - NetworkId -> (RunningNode -> IO a) -> IO a -withCardanoNode tr stateDirectory args networkId action = do +withCardanoNode tr stateDirectory args action = do traceWith tr $ MsgNodeCmdSpec (show $ cmdspec process) withLogFile logFilePath $ \out -> do hSetBuffering out NoBuffering @@ -307,21 +290,29 @@ withCardanoNode tr stateDirectory args networkId action = do traceWith tr $ MsgNodeStarting{stateDirectory} waitForSocket nodeSocketPath traceWith tr $ MsgSocketIsReady nodeSocketPath - blockTime <- readBlockTime $ stateDirectory nodeShelleyGenesisFile + shelleyGenesis :: Aeson.Value <- readShelleyGenesisJSON $ stateDirectory nodeShelleyGenesisFile action RunningNode { nodeSocket = nodeSocketPath - , networkId - , blockTime + , networkId = getShelleyGenesisNetworkId shelleyGenesis + , blockTime = getShelleyGenesisBlockTime shelleyGenesis } + readShelleyGenesisJSON = readFileBS >=> unsafeDecodeJson + + -- Read 'NetworkId' from shelley genesis JSON file + getShelleyGenesisNetworkId json = do + if json ^?! key "networkId" == "Mainnet" + then Api.Mainnet + else do + let magic = json ^?! key "networkMagic" . _Number + Api.Testnet (Api.NetworkMagic $ truncate magic) + -- Read expected time between blocks from shelley genesis - readBlockTime fp = do - shelleyGenesis <- readFileBS fp - maybe (fail $ "failed to decode " <> fp) pure $ do - slotLength <- shelleyGenesis ^? key "slotLength" . _Number - activeSlotsCoeff <- shelleyGenesis ^? key "activeSlotsCoeff" . _Number - pure . realToFrac $ slotLength / activeSlotsCoeff + getShelleyGenesisBlockTime json = do + let slotLength = json ^?! key "slotLength" . _Number + let activeSlotsCoeff = json ^?! key "activeSlotsCoeff" . _Number + realToFrac $ slotLength / activeSlotsCoeff cleanupSocketFile = whenM (doesFileExist socketPath) $ @@ -333,7 +324,7 @@ waitForFullySynchronized :: Tracer IO NodeLog -> RunningNode -> IO () -waitForFullySynchronized tracer RunningNode{networkId, nodeSocket} = do +waitForFullySynchronized tracer RunningNode{networkId, nodeSocket, blockTime} = do systemStart <- querySystemStart networkId nodeSocket QueryTip check systemStart where @@ -345,7 +336,7 @@ waitForFullySynchronized tracer RunningNode{networkId, nodeSocket} = do let timeDifference = diffRelativeTime targetTime tipTime let percentDone = realToFrac (100.0 * getRelativeTime tipTime / getRelativeTime targetTime) traceWith tracer $ MsgSynchronizing{percentDone} - if timeDifference < 20 -- TODO: derive from known network and block times + if timeDifference < blockTime then pure () else threadDelay 3 >> check systemStart diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 2907f53cfa8..62158a96d50 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -57,7 +57,6 @@ import Hydra.Cluster.Fixture ( carolSk, carolVk, cperiod, - defaultNetworkId, ) import Hydra.Cluster.Scenarios ( EndToEndLog (..), @@ -511,7 +510,7 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do withClusterTempDir "unsupported-era" $ \tmpDir -> do args <- setupCardanoDevnet tmpDir forkIntoConwayInEpoch tmpDir args 1 - withCardanoNode (contramap FromCardanoNode tracer) tmpDir args defaultNetworkId $ \node@RunningNode{nodeSocket} -> do + withCardanoNode (contramap FromCardanoNode tracer) tmpDir args $ \node@RunningNode{nodeSocket} -> do let hydraTracer = contramap FromHydraNode tracer hydraScriptsTxId <- publishHydraScriptsAs node Faucet chainConfig <- chainConfigFor Alice tmpDir nodeSocket hydraScriptsTxId [] cperiod @@ -531,7 +530,7 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do withClusterTempDir "unsupported-era-startup" $ \tmpDir -> do args <- setupCardanoDevnet tmpDir forkIntoConwayInEpoch tmpDir args 1 - withCardanoNode (contramap FromCardanoNode tracer) tmpDir args defaultNetworkId $ \node@RunningNode{nodeSocket} -> do + withCardanoNode (contramap FromCardanoNode tracer) tmpDir args $ \node@RunningNode{nodeSocket} -> do let hydraTracer = contramap FromHydraNode tracer hydraScriptsTxId <- publishHydraScriptsAs node Faucet chainConfig <- chainConfigFor Alice tmpDir nodeSocket hydraScriptsTxId [] cperiod @@ -549,7 +548,7 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do args <- setupCardanoDevnet tmpDir forkIntoConwayInEpoch tmpDir args 10 - withCardanoNode (contramap FromCardanoNode tracer) tmpDir args defaultNetworkId $ + withCardanoNode (contramap FromCardanoNode tracer) tmpDir args $ \node@RunningNode{nodeSocket} -> do let lovelaceBalanceValue = 100_000_000 -- Funds to be used as fuel by Hydra protocol transactions @@ -585,7 +584,7 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do args <- setupCardanoDevnet tmpDir forkIntoConwayInEpoch tmpDir args 10 - withCardanoNode (contramap FromCardanoNode tracer) tmpDir args defaultNetworkId $ + withCardanoNode (contramap FromCardanoNode tracer) tmpDir args $ \node@RunningNode{nodeSocket} -> do let lovelaceBalanceValue = 100_000_000 -- Funds to be used as fuel by Hydra protocol transactions From b5a63de55d021ba90d3a03d2565cce77b1753745 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Fri, 12 Jan 2024 14:18:04 +0100 Subject: [PATCH 7/7] Use NominalDiffTime in RunningNode blockTime This is generally a more desirable type to describe a given duration of time, e.g. how long to wait. Updating our wait.. functions to NominalDiffTime also removed some conversions in test code (realToFrac). --- hydra-cluster/bench/Bench/EndToEnd.hs | 4 ++-- hydra-cluster/bench/Bench/Options.hs | 6 +++--- hydra-cluster/src/CardanoClient.hs | 2 +- hydra-cluster/src/Hydra/Cluster/Scenarios.hs | 6 +++--- hydra-cluster/src/HydraNode.hs | 19 +++++++++---------- hydra-cluster/test/Test/EndToEndSpec.hs | 4 ++-- hydra-node/src/Hydra/ContestationPeriod.hs | 18 +++++++++--------- hydra-node/src/Hydra/Options.hs | 4 ++-- hydra-node/test/Hydra/BehaviorSpec.hs | 4 ++-- .../test/Hydra/ContestationPeriodSpec.hs | 18 +++++++++--------- hydra-test-utils/src/Test/Hydra/Prelude.hs | 6 +++--- 11 files changed, 45 insertions(+), 46 deletions(-) diff --git a/hydra-cluster/bench/Bench/EndToEnd.hs b/hydra-cluster/bench/Bench/EndToEnd.hs index d7073f9f13a..f031cc35f36 100644 --- a/hydra-cluster/bench/Bench/EndToEnd.hs +++ b/hydra-cluster/bench/Bench/EndToEnd.hs @@ -76,7 +76,7 @@ data Event = Event deriving stock (Generic, Eq, Show) deriving anyclass (ToJSON) -bench :: Int -> DiffTime -> FilePath -> Dataset -> IO Summary +bench :: Int -> NominalDiffTime -> FilePath -> Dataset -> IO Summary bench startingNodeId timeoutSeconds workDir dataset@Dataset{clientDatasets, title, description} = do putStrLn $ "Test logs available in: " <> (workDir "test.log") withFile (workDir "test.log") ReadWriteMode $ \hdl -> @@ -122,7 +122,7 @@ bench startingNodeId timeoutSeconds workDir dataset@Dataset{clientDatasets, titl v ^? key "contestationDeadline" . _JSON -- Expect to see ReadyToFanout within 3 seconds after deadline - remainingTime <- realToFrac . diffUTCTime deadline <$> getCurrentTime + remainingTime <- diffUTCTime deadline <$> getCurrentTime waitFor hydraTracer (remainingTime + 3) [leader] $ output "ReadyToFanout" ["headId" .= headId] diff --git a/hydra-cluster/bench/Bench/Options.hs b/hydra-cluster/bench/Bench/Options.hs index 3a495a42910..d5d84e3688c 100644 --- a/hydra-cluster/bench/Bench/Options.hs +++ b/hydra-cluster/bench/Bench/Options.hs @@ -31,14 +31,14 @@ data Options { workDirectory :: Maybe FilePath , outputDirectory :: Maybe FilePath , scalingFactor :: Int - , timeoutSeconds :: DiffTime + , timeoutSeconds :: NominalDiffTime , clusterSize :: Word64 , startingNodeId :: Int } | DatasetOptions { datasetFiles :: [FilePath] , outputDirectory :: Maybe FilePath - , timeoutSeconds :: DiffTime + , timeoutSeconds :: NominalDiffTime , startingNodeId :: Int } @@ -119,7 +119,7 @@ scalingFactorParser = <> help "The scaling factor to apply to transactions generator (default: 100)" ) -timeoutParser :: Parser DiffTime +timeoutParser :: Parser NominalDiffTime timeoutParser = option auto diff --git a/hydra-cluster/src/CardanoClient.hs b/hydra-cluster/src/CardanoClient.hs index 83c42277597..1af3112333b 100644 --- a/hydra-cluster/src/CardanoClient.hs +++ b/hydra-cluster/src/CardanoClient.hs @@ -164,6 +164,6 @@ mkGenesisTx networkId pparams signingKey initialAmount recipients = data RunningNode = RunningNode { nodeSocket :: SocketPath , networkId :: NetworkId - , blockTime :: DiffTime + , blockTime :: NominalDiffTime -- ^ Expected time between blocks (varies a lot on testnets) } diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index 6ffd5a9b664..7607b2dca48 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), fromDiffTime) +import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod), fromNominalDiffTime) 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 - contestationPeriod <- fromDiffTime $ 10 * blockTime + contestationPeriod <- fromNominalDiffTime $ 10 * blockTime aliceChainConfig <- chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] contestationPeriod <&> modifyConfig (\config -> config{networkId, startChainFrom = Just tip}) @@ -250,7 +250,7 @@ singlePartyHeadFullLifeCycle tracer workDir node hydraScriptsTxId = guard $ v ^? key "tag" == Just "HeadIsClosed" guard $ v ^? key "headId" == Just (toJSON headId) v ^? key "contestationDeadline" . _JSON - remainingTime <- realToFrac . diffUTCTime deadline <$> getCurrentTime + remainingTime <- diffUTCTime deadline <$> getCurrentTime waitFor hydraTracer (remainingTime + 3 * blockTime) [n1] $ output "ReadyToFanout" ["headId" .= headId] send n1 $ input "Fanout" [] diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 18fa3b978e6..1d913a9ef50 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -74,14 +74,14 @@ output tag pairs = object $ ("tag" .= tag) : pairs -- | Wait some time for a single API server output from each of given nodes. -- This function waits for @delay@ seconds for message @expected@ to be seen by all -- given @nodes@. -waitFor :: HasCallStack => Tracer IO HydraNodeLog -> DiffTime -> [HydraClient] -> Aeson.Value -> IO () +waitFor :: HasCallStack => Tracer IO HydraNodeLog -> NominalDiffTime -> [HydraClient] -> Aeson.Value -> IO () waitFor tracer delay nodes v = waitForAll tracer delay nodes [v] -- | Wait up to some time for an API server output to match the given predicate. -waitMatch :: HasCallStack => DiffTime -> HydraClient -> (Aeson.Value -> Maybe a) -> IO a +waitMatch :: HasCallStack => NominalDiffTime -> HydraClient -> (Aeson.Value -> Maybe a) -> IO a waitMatch delay client@HydraClient{tracer, hydraNodeId} match = do seenMsgs <- newTVarIO [] - timeout delay (go seenMsgs) >>= \case + timeout (realToFrac delay) (go seenMsgs) >>= \case Just x -> pure x Nothing -> do msgs <- readTVarIO seenMsgs @@ -106,7 +106,7 @@ waitMatch delay client@HydraClient{tracer, hydraNodeId} match = do -- | Wait up to some `delay` for some JSON `Value` to match given function. -- -- This is a generalisation of `waitMatch` to multiple nodes. -waitForAllMatch :: (Eq a, Show a, HasCallStack) => DiffTime -> [HydraClient] -> (Aeson.Value -> Maybe a) -> IO a +waitForAllMatch :: (Eq a, Show a, HasCallStack) => NominalDiffTime -> [HydraClient] -> (Aeson.Value -> Maybe a) -> IO a waitForAllMatch delay nodes match = do when (null nodes) $ failure "no clients to wait for" @@ -122,13 +122,12 @@ waitForAllMatch delay nodes match = do -- | Wait some time for a list of outputs from each of given nodes. -- This function is the generalised version of 'waitFor', allowing several messages -- to be waited for and received in /any order/. -waitForAll :: HasCallStack => Tracer IO HydraNodeLog -> DiffTime -> [HydraClient] -> [Aeson.Value] -> IO () +waitForAll :: HasCallStack => Tracer IO HydraNodeLog -> NominalDiffTime -> [HydraClient] -> [Aeson.Value] -> IO () waitForAll tracer delay nodes expected = do traceWith tracer (StartWaiting (map hydraNodeId nodes) expected) forConcurrently_ nodes $ \client@HydraClient{hydraNodeId} -> do msgs <- newIORef [] - -- The chain is slow... - result <- timeout delay $ tryNext client msgs expected + result <- timeout (realToFrac delay) $ tryNext client msgs expected case result of Just x -> pure x Nothing -> do @@ -393,13 +392,13 @@ withConnectionToNode tracer hydraNodeId action = do hydraNodeProcess :: RunOptions -> CreateProcess hydraNodeProcess = proc "hydra-node" . toArgs -waitForNodesConnected :: HasCallStack => Tracer IO HydraNodeLog -> DiffTime -> [HydraClient] -> IO () -waitForNodesConnected tracer timeOut clients = +waitForNodesConnected :: HasCallStack => Tracer IO HydraNodeLog -> NominalDiffTime -> [HydraClient] -> IO () +waitForNodesConnected tracer delay clients = mapM_ waitForNodeConnected clients where allNodeIds = hydraNodeId <$> clients waitForNodeConnected n@HydraClient{hydraNodeId} = - waitForAll tracer timeOut [n] $ + waitForAll tracer delay [n] $ fmap ( \nodeId -> object diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 62158a96d50..84289d79fc1 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -269,7 +269,7 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do v ^? key "contestationDeadline" . _JSON -- Expect to see ReadyToFanout within 3 seconds after deadline - remainingTime <- realToFrac . diffUTCTime deadline <$> getCurrentTime + remainingTime <- diffUTCTime deadline <$> getCurrentTime waitFor hydraTracer (remainingTime + 3) [n1] $ output "ReadyToFanout" ["headId" .= headId] @@ -831,7 +831,7 @@ initAndClose tmpDir tracer clusterIx hydraScriptsTxId node@RunningNode{nodeSocke v ^? key "contestationDeadline" . _JSON -- Expect to see ReadyToFanout within 3 seconds after deadline - remainingTime <- realToFrac . diffUTCTime deadline <$> getCurrentTime + remainingTime <- diffUTCTime deadline <$> getCurrentTime waitFor hydraTracer (remainingTime + 3) [n1] $ output "ReadyToFanout" ["headId" .= headId] diff --git a/hydra-node/src/Hydra/ContestationPeriod.hs b/hydra-node/src/Hydra/ContestationPeriod.hs index bcc8fedab3a..5b3cb7b0b0f 100644 --- a/hydra-node/src/Hydra/ContestationPeriod.hs +++ b/hydra-node/src/Hydra/ContestationPeriod.hs @@ -37,16 +37,20 @@ 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 = +-- | Create a 'ContestationPeriod' from a 'NominalDiffTime'. This will fail if a +-- negative NominalDiffTime is provided and truncates to 1s if values < 1s are given. +fromNominalDiffTime :: MonadFail m => NominalDiffTime -> m ContestationPeriod +fromNominalDiffTime dt = if seconds > 0 then pure . UnsafeContestationPeriod $ ceiling seconds - else fail $ "fromDiffTime: contestation period <= 0: " <> show dt + else fail $ "fromNominalDiffTime: contestation period <= 0: " <> show dt where seconds :: Pico = realToFrac dt +toNominalDiffTime :: ContestationPeriod -> NominalDiffTime +toNominalDiffTime (UnsafeContestationPeriod s) = + secondsToNominalDiffTime $ fromIntegral s + -- | Convert an off-chain contestation period to its on-chain representation. toChain :: ContestationPeriod -> OnChain.ContestationPeriod toChain (UnsafeContestationPeriod s) = @@ -61,7 +65,3 @@ fromChain cp = UnsafeContestationPeriod . truncate $ toInteger (OnChain.milliseconds cp) % 1000 - -toNominalDiffTime :: ContestationPeriod -> NominalDiffTime -toNominalDiffTime (UnsafeContestationPeriod s) = - secondsToNominalDiffTime $ fromIntegral s diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index eb32d3f6c53..7104812c1a4 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -34,7 +34,7 @@ import Hydra.Cardano.Api ( serialiseToRawBytesHexText, ) import Hydra.Chain (maximumNumberOfParties) -import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod), fromDiffTime) +import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod), fromNominalDiffTime) import Hydra.Contract qualified as Contract import Hydra.Ledger.Cardano () import Hydra.Logging (Verbosity (..)) @@ -745,7 +745,7 @@ contestationPeriodParser = where parseNatural = UnsafeContestationPeriod <$> auto - parseViaDiffTime = auto >>= fromDiffTime + parseViaDiffTime = auto >>= fromNominalDiffTime data InvalidOptions = MaximumNumberOfPartiesExceeded diff --git a/hydra-node/test/Hydra/BehaviorSpec.hs b/hydra-node/test/Hydra/BehaviorSpec.hs index 9f1b2e6498f..894f04cdda8 100644 --- a/hydra-node/test/Hydra/BehaviorSpec.hs +++ b/hydra-node/test/Hydra/BehaviorSpec.hs @@ -721,10 +721,10 @@ testContestationPeriod = UnsafeContestationPeriod 3600 nothingHappensFor :: (MonadTimer m, MonadThrow m, IsChainState tx) => TestHydraClient tx m -> - DiffTime -> + NominalDiffTime -> m () nothingHappensFor node secs = - timeout secs (waitForNext node) >>= (`shouldBe` Nothing) + timeout (realToFrac secs) (waitForNext node) >>= (`shouldBe` Nothing) withHydraNode :: forall s a. diff --git a/hydra-node/test/Hydra/ContestationPeriodSpec.hs b/hydra-node/test/Hydra/ContestationPeriodSpec.hs index 5afd01b334a..2e6c84eb5a8 100644 --- a/hydra-node/test/Hydra/ContestationPeriodSpec.hs +++ b/hydra-node/test/Hydra/ContestationPeriodSpec.hs @@ -1,9 +1,9 @@ module Hydra.ContestationPeriodSpec where -import Hydra.Prelude +import Hydra.Prelude hiding (label) -import Data.Time (picosecondsToDiffTime) -import Hydra.ContestationPeriod (ContestationPeriod, fromDiffTime) +import Data.Time (secondsToNominalDiffTime) +import Hydra.ContestationPeriod (ContestationPeriod, fromNominalDiffTime) import Test.Hspec (Spec, describe) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (getNonPositive, getPositive, (===)) @@ -11,14 +11,14 @@ import Test.QuickCheck.Instances.Time () spec :: Spec spec = do - describe "fromDiffTime" $ do + describe "fromNominalDiffTime" $ do prop "works for diff times > 0" $ - isJust . fromDiffTime . getPositive + isJust . fromNominalDiffTime . getPositive prop "fails for diff times <= 0" $ - isNothing . fromDiffTime . getNonPositive + isNothing . fromNominalDiffTime . getNonPositive prop "rounds to 1 second" $ \n -> - let subSecondPicos = getPositive n `mod` 1_000_000_000_000 - in fromDiffTime (picosecondsToDiffTime subSecondPicos) - === (fromDiffTime 1 :: Maybe ContestationPeriod) + let subSecond = getPositive n / 100 -- Definitely < 1 second + in fromNominalDiffTime (secondsToNominalDiffTime subSecond) + === (fromNominalDiffTime 1 :: Maybe ContestationPeriod) diff --git a/hydra-test-utils/src/Test/Hydra/Prelude.hs b/hydra-test-utils/src/Test/Hydra/Prelude.hs index 7bd0fc85401..8984946e03a 100644 --- a/hydra-test-utils/src/Test/Hydra/Prelude.hs +++ b/hydra-test-utils/src/Test/Hydra/Prelude.hs @@ -90,10 +90,10 @@ failure msg = throwIO (HUnitFailure location $ Reason msg) -- | Fail some monadic action if it does not complete within given timeout. --- A 'DiffTime' can be represented as a decimal number of seconds. -failAfter :: (HasCallStack, MonadTimer m, MonadThrow m) => DiffTime -> m a -> m a +-- A 'NominalDiffTime' can be represented as a decimal number of seconds. +failAfter :: (HasCallStack, MonadTimer m, MonadThrow m) => NominalDiffTime -> m a -> m a failAfter seconds action = - timeout seconds action >>= \case + timeout (realToFrac seconds) action >>= \case Nothing -> failure $ "Test timed out after " <> show seconds Just a -> pure a