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).

Author: ch1bo

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]
 

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

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)
   }

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" []

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

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]
 

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

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

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.

hydra-node/test/Hydra/ContestationPeriodSpec.hs

@@ -1,24 +1,24 @@
 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, (===))
 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)