Merge pull request #523 from input-output-hk/ensemble/time-horizon-pa…

…st-3k-slots Hydra node cannot handle time conversion once 2k blocks have passed
input-output-hk · Sep 28, 2022 · a4daab7 · a4daab7
2 parents f3b881a + 262694d
commit a4daab7
Show file tree

Hide file tree

Showing 6 changed files with 168 additions and 86 deletions.
diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs
@@ -179,28 +179,17 @@ withDirectChain tracer networkId iocp socketPath keyPair party cardanoKeys point
         { currentChainState = Idle IdleState{ctx}
         , recordedAt = AtStart
         }
+  let chainHandle =
+        mkChain
+          tracer
+          (queryTimeHandle networkId socketPath)
+          wallet
+          headState
+          (submitTx queue)
   res <-
     race
-      ( do
-          -- FIXME: There's currently a race-condition with the actual client
-          -- which will only see transactions after it has established
-          -- connection with the server's tip. So any transaction submitted
-          -- before that tip will be missed.
-          threadDelay 2
-          action $
-            mkChain
-              tracer
-              (queryTimeHandle networkId socketPath)
-              wallet
-              headState
-              (submitTx queue)
-      )
       ( handle onIOException $ do
-          -- NOTE: We can't re-query the time handle while the
-          -- 'chainSyncHandler' is running due to constraints. So this will use
-          -- always these initial parameters (as queried) for time conversions.
-          timeHandle <- queryTimeHandle networkId socketPath
-          let handler = chainSyncHandler tracer callback headState timeHandle
+          let handler = chainSyncHandler tracer callback headState (queryTimeHandle networkId socketPath)
 
           let intersection = toConsensusPointHF <$> point
           let client = ouroborosApplication tracer intersection queue handler wallet
@@ -211,9 +200,17 @@ withDirectChain tracer networkId iocp socketPath keyPair party cardanoKeys point
             (versions networkId client)
             socketPath
       )
+      ( do
+          -- FIXME: There's currently a race-condition with the actual client
+          -- which will only see transactions after it has established
+          -- connection with the server's tip. So any transaction submitted
+          -- before that tip will be missed.
+          threadDelay 2
+          action chainHandle
+      )
   case res of
-    Left a -> pure a
-    Right () -> error "'connectTo' cannot terminate but did?"
+    Left () -> error "'connectTo' cannot terminate but did?"
+    Right a -> pure a
  where
   queryUTxOEtc queryPoint address = do
     utxo <- Ledger.unUTxO . toLedgerUTxO <$> queryUTxO networkId socketPath queryPoint [address]

diff --git a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs
@@ -72,6 +72,9 @@ import Test.Cardano.Ledger.Alonzo.Serialisation.Generators ()
 -- | A callback used to actually submit a transaction to the chain.
 type SubmitTx m = ValidatedTx LedgerEra -> m ()
 
+-- | A way to acquire a 'TimeHandle'
+type GetTimeHandle m = m TimeHandle
+
 -- | Create a `Chain` component for posting "real" cardano transactions.
 --
 -- This component does not actually interact with a cardano-node, but creates
@@ -86,7 +89,7 @@ mkChain ::
   (MonadSTM m, MonadTimer m, MonadThrow (STM m)) =>
   Tracer m DirectChainLog ->
   -- | Means to acquire a new 'TimeHandle'.
-  m TimeHandle ->
+  GetTimeHandle m ->
   TinyWallet m ->
   TVar m ChainStateAt ->
   SubmitTx m ->
@@ -188,6 +191,8 @@ data TimeConversionException = TimeConversionException
 -- This forms the other half of a `ChainComponent` along with `mkChain` but is decoupled from
 -- actual interactions with the chain.
 --
+-- A `TimeHandle` is needed to do `SlotNo -> POSIXTime` conversions for 'Tick' events.
+--
 -- Throws 'TimeConversionException' when a received block's 'SlotNo' cannot be
 -- converted to a 'UTCTime' with the given 'TimeHandle'.
 chainSyncHandler ::
@@ -199,11 +204,11 @@ chainSyncHandler ::
   (ChainEvent Tx -> m ()) ->
   -- | On-chain head-state.
   TVar m ChainStateAt ->
-  -- | A handle on time to do `SlotNo -> POSIXTime` conversions for 'Tick' events.
-  TimeHandle ->
+  -- | Means to acquire a new 'TimeHandle'.
+  GetTimeHandle m ->
   -- | A chain-sync handler to use in a local-chain-sync client.
   ChainSyncHandler m
-chainSyncHandler tracer callback headState timeHandle =
+chainSyncHandler tracer callback headState getTimeHandle =
   ChainSyncHandler
     { onRollBackward
     , onRollForward
@@ -225,6 +230,7 @@ chainSyncHandler tracer callback headState timeHandle =
         slotNo = case chainPoint of
           ChainPointAtGenesis -> 0
           ChainPoint s _ -> s
+    timeHandle <- getTimeHandle
     case slotToUTCTime timeHandle slotNo of
       Left reason ->
         throwIO TimeConversionException{slotNo, reason}

diff --git a/hydra-node/src/Hydra/Chain/Direct/TimeHandle.hs b/hydra-node/src/Hydra/Chain/Direct/TimeHandle.hs
@@ -5,11 +5,8 @@ module Hydra.Chain.Direct.TimeHandle where
 
 import Hydra.Prelude
 
-import Cardano.Slotting.EpochInfo (EpochInfo, epochInfoSlotToUTCTime, hoistEpochInfo)
-import Cardano.Slotting.Slot (SlotNo)
-import Cardano.Slotting.Time (SystemStart (SystemStart), toRelativeTime)
-import Control.Arrow (left)
-import Control.Monad.Trans.Except (runExcept)
+import Cardano.Slotting.Slot (SlotNo (SlotNo))
+import Cardano.Slotting.Time (SystemStart (SystemStart), fromRelativeTime, toRelativeTime)
 import Data.Time (secondsToNominalDiffTime)
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import Hydra.Cardano.Api (
@@ -23,10 +20,9 @@ import Hydra.Chain.CardanoClient (
   querySystemStart,
   queryTip,
  )
-import qualified Hydra.Ledger.Cardano.Evaluate as Fixture
-import qualified Ouroboros.Consensus.HardFork.History as Consensus
-import Ouroboros.Consensus.HardFork.History.Qry (interpretQuery, wallclockToSlot)
+import Ouroboros.Consensus.HardFork.History.Qry (interpretQuery, slotToWallclock, wallclockToSlot)
 import Test.QuickCheck (getPositive)
+import Hydra.Ledger.Cardano.Evaluate (eraHistoryWithHorizonAt)
 
 type PointInTime = (SlotNo, UTCTime)
 
@@ -44,16 +40,23 @@ data TimeHandle = TimeHandle
     adjustPointInTime :: SlotNo -> PointInTime -> Either Text PointInTime
   }
 
+-- | Generate consistent values for 'SystemStart' and 'EraHistory' which has
+-- a horizon at the returned SlotNo as well as some UTCTime before that
+genTimeParams :: Gen (SystemStart, EraHistory CardanoMode, SlotNo, UTCTime)
+genTimeParams = do
+  startTime <- posixSecondsToUTCTime . secondsToNominalDiffTime . getPositive <$> arbitrary
+  uptimeSeconds <- getPositive <$> arbitrary
+  let uptime = secondsToNominalDiffTime uptimeSeconds
+      currentTime = addUTCTime uptime startTime
+      -- formula: 3 * k / f where k = securityParam and f = slotLength from the genesis config 
+      safeZone = 3 * 2160 / 0.05
+      horizonSlot = SlotNo $ truncate $ uptimeSeconds + safeZone
+  pure (SystemStart startTime, eraHistoryWithHorizonAt horizonSlot, horizonSlot, currentTime)
+
 instance Arbitrary TimeHandle where
   arbitrary = do
-    startTime <- posixSecondsToUTCTime . secondsToNominalDiffTime . getPositive <$> arbitrary
-    uptime <- secondsToNominalDiffTime . getPositive <$> arbitrary
-    let currentTime = addUTCTime uptime startTime
-    pure $
-      mkTimeHandle
-        currentTime
-        (SystemStart startTime)
-        Fixture.eraHistory
+    (systemStart, eraHistory, _, currentTime) <- genTimeParams
+    pure $ mkTimeHandle currentTime systemStart eraHistory
 
 -- | Construct a time handle using current time and given chain parameters. See
 -- 'queryTimeHandle' to create one by querying a cardano-node.
@@ -65,7 +68,7 @@ mkTimeHandle ::
 mkTimeHandle now systemStart eraHistory = do
   TimeHandle
     { currentPointInTime = do
-        currentSlotNo <- left show $ utcTimeToSlot now
+        currentSlotNo <- slotFromUTCTime now
         pt <- slotToUTCTime currentSlotNo
         pure (currentSlotNo, pt)
     , slotFromUTCTime
@@ -76,26 +79,17 @@ mkTimeHandle now systemStart eraHistory = do
         pure (adjusted, time)
     }
  where
-  epochInfo :: EpochInfo (Either Text)
-  epochInfo =
-    hoistEpochInfo (left show . runExcept) $
-      Consensus.interpreterToEpochInfo interpreter
-
+  slotToUTCTime :: HasCallStack => SlotNo -> Either Text UTCTime
   slotToUTCTime slot =
-    -- NOTE: We are not using the Ledger.slotToPOSIXTime as we do not need the
-    -- workaround for past protocol versions. Hence, we also not need the
-    -- protocol parameters for this conversion.
-    epochInfoSlotToUTCTime
-      epochInfo
-      systemStart
-      slot
-
-  slotFromUTCTime t = left show $ utcTimeToSlot t
+    case interpretQuery interpreter (slotToWallclock slot) of
+      Left pastHorizonEx -> Left $ show pastHorizonEx
+      Right (relativeTime, _slotLength) -> pure $ fromRelativeTime systemStart relativeTime
 
-  utcTimeToSlot utcTime = do
+  slotFromUTCTime :: HasCallStack => UTCTime -> Either Text SlotNo
+  slotFromUTCTime utcTime = do
     let relativeTime = toRelativeTime systemStart utcTime
     case interpretQuery interpreter (wallclockToSlot relativeTime) of
-      Left pastHorizonEx -> Left pastHorizonEx
+      Left pastHorizonEx -> Left $ show pastHorizonEx
       Right (slotNo, _timeSpentInSlot, _timeLeftInSlot) -> pure slotNo
 
   (EraHistory _ interpreter) = eraHistory

diff --git a/hydra-node/src/Hydra/Ledger/Cardano/Evaluate.hs b/hydra-node/src/Hydra/Ledger/Cardano/Evaluate.hs
@@ -23,7 +23,7 @@ import Cardano.Ledger.BaseTypes (ProtVer (..), boundRational)
 import Cardano.Ledger.Coin (Coin (Coin))
 import Cardano.Ledger.Val (Val ((<+>)), (<×>))
 import Cardano.Slotting.EpochInfo (EpochInfo, fixedEpochInfo)
-import Cardano.Slotting.Slot (EpochSize (EpochSize), SlotNo (SlotNo))
+import Cardano.Slotting.Slot (EpochNo (EpochNo), EpochSize (EpochSize), SlotNo (SlotNo))
 import Cardano.Slotting.Time (RelativeTime (RelativeTime), SlotLength (getSlotLength), SystemStart (SystemStart), mkSlotLength, toRelativeTime)
 import qualified Data.ByteString as BS
 import Data.Default (def)
@@ -59,7 +59,8 @@ import Hydra.Cardano.Api (
 import Hydra.Data.ContestationPeriod (posixToUTCTime)
 import Ouroboros.Consensus.Cardano.Block (CardanoEras)
 import Ouroboros.Consensus.HardFork.History (
-  EraEnd (EraUnbounded),
+  Bound (Bound, boundEpoch, boundSlot, boundTime),
+  EraEnd (EraEnd, EraUnbounded),
   EraParams (..),
   EraSummary (..),
   SafeZone (..),
@@ -184,31 +185,71 @@ maxMem, maxCpu :: Natural
 maxCpu = executionSteps maxTxExecutionUnits
 maxMem = executionMemory maxTxExecutionUnits
 
+-- | An artifical era history comprised by a single never ending (forking) era,
+-- with fixed 'epochSize' and 'slotLength'.
 eraHistory :: EraHistory CardanoMode
 eraHistory =
   EraHistory CardanoMode (mkInterpreter summary)
  where
-  summary :: Summary (CardanoEras StandardCrypto)
-  summary = Summary neverForksUntyped
-
   -- NOTE: Inlined / similar to --
   -- Ouroboros.Consensus.HardFork.History.Summary.neverForksSummary, but without
   -- a fixed '[x] type so we can use the CardanoMode eras
-  neverForksUntyped =
-    NonEmptyOne $
+  summary :: Summary (CardanoEras StandardCrypto)
+  summary =
+    Summary . NonEmptyOne $
       EraSummary
         { eraStart = initBound
         , eraEnd = EraUnbounded
         , eraParams =
             EraParams
-              { eraEpochSize = EpochSize 100
-              , eraSlotLength = mkSlotLength 1
+              { eraEpochSize = epochSize
+              , eraSlotLength = slotLength
               , eraSafeZone = UnsafeIndefiniteSafeZone
               }
         }
 
+-- | An era history with a single era which will end at some point.
+--
+-- A "real" 'EraHistory' received from the cardano-node will have the 'eraEnd'
+-- at a known or earliest possible end of the current era + a safe zone.
+--
+-- See 'Ouroboros.Consensus.HardFork.History.EraParams' for details.
+--
+-- NOTE: This era is using not so realistic epoch sizes of 1 and sets a slot
+-- length of 1
+eraHistoryWithHorizonAt :: SlotNo -> EraHistory CardanoMode
+eraHistoryWithHorizonAt slotNo@(SlotNo n) =
+  EraHistory CardanoMode (mkInterpreter summary)
+ where
+  summary :: Summary (CardanoEras StandardCrypto)
+  summary =
+    Summary . NonEmptyOne $
+      EraSummary
+        { eraStart = initBound
+        , eraEnd =
+            EraEnd $
+              Bound
+                { boundTime = RelativeTime $ fromIntegral n
+                , boundSlot = slotNo
+                , boundEpoch = EpochNo n
+                }
+        , eraParams
+        }
+
+  eraParams =
+    EraParams
+      { eraEpochSize = EpochSize 1
+      , eraSlotLength = mkSlotLength 1
+      , -- NOTE: unused if the 'eraEnd' is already defined, but would be used to
+        -- extend the last era accordingly in the real cardano-node
+        eraSafeZone = UnsafeIndefiniteSafeZone
+      }
+
 epochInfo :: Monad m => EpochInfo m
-epochInfo = fixedEpochInfo (EpochSize 100) slotLength
+epochInfo = fixedEpochInfo epochSize slotLength
+
+epochSize :: EpochSize
+epochSize = EpochSize 100
 
 slotLength :: SlotLength
 slotLength = mkSlotLength 1