refactor synced status to compute diff based on query tip

Author: ffakenz

hydra-node/golden/ServerOutput/ChainOutOfSync.json

@@ -1,15 +1,19 @@
 {
     "samples": [
         {
-            "nodeStateSlot": 0,
             "syncedStatus": {
                 "diff": 0,
                 "point": {
-                    "blockHash": "0001000000010100010100000000010101010001010000010000010101000001",
+                    "blockHash": "0101000000000000000000000000010001000100010000010100010101010000",
                     "slot": 0,
                     "tag": "ChainPoint"
                 },
-                "status": true
+                "status": true,
+                "tip": {
+                    "blockHash": "0101000001000101010001000101000001010101010101000101010101010001",
+                    "slot": 1,
+                    "tag": "ChainPoint"
+                }
             },
             "tag": "ChainOutOfSync"
         }

hydra-node/json-schemas/api.yaml

@@ -1806,7 +1806,6 @@ components:
         - tag
         - seq
         - syncedStatus
-        - nodeStateSlot
         - timestamp
       properties:
         tag:
@@ -1816,8 +1815,6 @@ components:
           $ref: "api.yaml#/components/schemas/SequenceNumber"
         syncedStatus:
           $ref: "api.yaml#/components/schemas/SyncedStatus"
-        nodeStateSlot:
-          $ref: "api.yaml#/components/schemas/ChainSlot"
         timestamp:
           $ref: "api.yaml#/components/schemas/UTCTime"
 
@@ -3583,6 +3580,7 @@ components:
         - status
         - diff
         - point
+        - tip
       properties:
         status:
           type: boolean
@@ -3593,3 +3591,5 @@ components:
             - type: "null"
         point:
           $ref: "api.yaml#/components/schemas/ChainPoint"
+        tip:
+          $ref: "api.yaml#/components/schemas/ChainPoint"

hydra-node/src/Hydra/API/ServerOutput.hs

@@ -11,7 +11,7 @@ import Data.Aeson.Lens (atKey, key)
 import Data.ByteString.Lazy qualified as LBS
 import Hydra.API.ClientInput (ClientInput)
 import Hydra.Chain (PostChainTx, PostTxError)
-import Hydra.Chain.ChainState (ChainSlot, ChainStateType, IsChainState)
+import Hydra.Chain.ChainState (ChainStateType, IsChainState)
 import Hydra.Chain.SyncedStatus (SyncedStatus)
 import Hydra.HeadLogic.State (ClosedState (..), HeadState (..), InitialState (..), OpenState (..), SeenSnapshot (..))
 import Hydra.HeadLogic.State qualified as HeadState
@@ -216,7 +216,7 @@ data ServerOutput tx
     -- Any signing round has been discarded, and the snapshot leader has changed accordingly.
     SnapshotSideLoaded {headId :: HeadId, snapshotNumber :: SnapshotNumber}
   | EventLogRotated {checkpoint :: NodeState tx}
-  | ChainOutOfSync {syncedStatus :: SyncedStatus, nodeStateSlot :: ChainSlot}
+  | ChainOutOfSync {syncedStatus :: SyncedStatus}
   deriving stock (Generic)
 
 deriving stock instance IsChainState tx => Eq (ServerOutput tx)

hydra-node/src/Hydra/API/WSServer.hs

@@ -42,7 +42,6 @@ import Hydra.API.ServerOutputFilter (
 import Hydra.Chain.ChainState (
   IsChainState,
  )
-import Hydra.Chain.Direct.State (chainSlotFromPoint)
 import Hydra.Chain.SyncedStatus (SyncedStatus (..))
 import Hydra.HeadLogic (ClosedState (ClosedState, readyToFanoutSent), HeadState, InitialState (..), OpenState (..), StateChanged)
 import Hydra.HeadLogic.State qualified as HeadState
@@ -85,13 +84,10 @@ wsApp env party tracer history callback nodeStateP networkInfoP responseChannel
   queryParams <- uriQuery <$> mkURIBs path
   con <- acceptRequest pending
   _ <- forkLabelled "ws-check-sync-status" $ forever $ do
-    NodeState{currentSlot} <- atomically getLatestNodeState
-    synced@SyncedStatus{status, point} <- chainSyncedStatus
-    if status && currentSlot <= chainSlotFromPoint point
-      then pure ()
-      else do
-        tso <- timed 0 (ChainOutOfSync synced currentSlot)
-        atomically $ writeTChan responseChannel (Left tso)
+    synced@SyncedStatus{status} <- chainSyncedStatus
+    unless status $ do
+      tso <- timed 0 (ChainOutOfSync synced)
+      atomically $ writeTChan responseChannel (Left tso)
     -- check every second
     -- TODO! configure threadDelay
     threadDelay 1
@@ -186,9 +182,8 @@ wsApp env party tracer history callback nodeStateP networkInfoP responseChannel
     msg <- receiveData con
     case Aeson.eitherDecode msg of
       Right input -> do
-        NodeState{currentSlot} <- atomically getLatestNodeState
-        SyncedStatus{status, point} <- chainSyncedStatus
-        if status && currentSlot <= chainSlotFromPoint point
+        SyncedStatus{status} <- chainSyncedStatus
+        if status
           then do
             traceWith tracer (APIInputReceived $ toJSON input)
             callback input

hydra-node/src/Hydra/Chain/Blockfrost.hs

@@ -126,14 +126,16 @@ withBlockfrostChain backend tracer config ctx wallet chainStateHistory callback
   let persistedPoint = recordedAt (currentState chainStateHistory)
   queue <- newLabelledTQueueIO "blockfrost-chain-queue"
   -- Select a chain point from which to start synchronizing
-  chainPoint <- maybe (queryTip backend) pure $ do
+  let getCurrentTip = queryTip backend
+  chainPoint <- maybe getCurrentTip pure $ do
     (max <$> startChainFrom <*> persistedPoint)
       <|> persistedPoint
       <|> startChainFrom
 
   let getTimeHandle = queryTimeHandle backend
   localChainState <- newLocalChainState chainStateHistory
-  syncedStatus <- newLabelledTVarIO "blockfrost-chain-sync-status" unSynced
+  tip <- getCurrentTip
+  syncedStatus <- newLabelledTVarIO "blockfrost-chain-sync-status" (unSynced tip)
   let chainHandle =
         mkChain
           tracer
@@ -143,7 +145,7 @@ withBlockfrostChain backend tracer config ctx wallet chainStateHistory callback
           localChainState
           (submitTx queue)
           syncedStatus
-  let handler = chainSyncHandler tracer callback getTimeHandle ctx localChainState contestationPeriod syncedStatus
+  let handler = chainSyncHandler tracer callback getTimeHandle ctx localChainState syncedStatus getCurrentTip
 
   res <-
     raceLabelled
@@ -158,7 +160,7 @@ withBlockfrostChain backend tracer config ctx wallet chainStateHistory callback
     Right a -> pure a
  where
   BlockfrostBackend{options = BlockfrostOptions{projectPath}} = backend
-  CardanoChainConfig{startChainFrom, contestationPeriod} = config
+  CardanoChainConfig{startChainFrom} = config
 
   submitTx :: TQueue IO (Tx, TMVar IO (Maybe (PostTxError Tx))) -> Tx -> IO ()
   submitTx queue tx = do

hydra-node/src/Hydra/Chain/Direct.hs

@@ -143,14 +143,16 @@ withDirectChain backend tracer config ctx wallet chainStateHistory callback acti
   let persistedPoint = recordedAt (currentState chainStateHistory)
   queue <- newLabelledTQueueIO "direct-chain-queue"
   -- Select a chain point from which to start synchronizing
-  chainPoint <- maybe (queryTip backend) pure $ do
+  let getCurrentTip = queryTip backend
+  chainPoint <- maybe getCurrentTip pure $ do
     (max <$> startChainFrom <*> persistedPoint)
       <|> persistedPoint
       <|> startChainFrom
 
   let getTimeHandle = queryTimeHandle backend
   localChainState <- newLocalChainState chainStateHistory
-  syncedStatus <- newLabelledTVarIO "direct-chain-sync-status" unSynced
+  tip <- getCurrentTip
+  syncedStatus <- newLabelledTVarIO "direct-chain-sync-status" (unSynced tip)
   let chainHandle =
         mkChain
           tracer
@@ -160,7 +162,7 @@ withDirectChain backend tracer config ctx wallet chainStateHistory callback acti
           localChainState
           (submitTx queue)
           syncedStatus
-  let handler = chainSyncHandler tracer callback getTimeHandle ctx localChainState contestationPeriod syncedStatus
+  let handler = chainSyncHandler tracer callback getTimeHandle ctx localChainState syncedStatus getCurrentTip
   res <-
     raceLabelled
       ( "direct-chain-connection"
@@ -175,7 +177,7 @@ withDirectChain backend tracer config ctx wallet chainStateHistory callback acti
     Right a -> pure a
  where
   DirectBackend{options = DirectOptions{networkId, nodeSocket}} = backend
-  CardanoChainConfig{startChainFrom, contestationPeriod} = config
+  CardanoChainConfig{startChainFrom} = config
 
   connectInfo networkId' nodeSocket' =
     LocalNodeConnectInfo

hydra-node/src/Hydra/Chain/Direct/Handlers.hs

@@ -83,7 +83,7 @@ import Hydra.Tx (
   UTxOType,
   headSeedToTxIn,
  )
-import Hydra.Tx.ContestationPeriod (ContestationPeriod, toNominalDiffTime)
+import Hydra.Tx.ContestationPeriod (toNominalDiffTime)
 import Hydra.Tx.Deposit (DepositObservation (..), depositTx, splitTokens)
 import Hydra.Tx.Observe (
   AbortObservation (..),
@@ -315,7 +315,7 @@ data TimeConversionException = TimeConversionException
 -- converted to a 'UTCTime' with the given 'TimeHandle'.
 chainSyncHandler ::
   forall m.
-  (MonadSTM m, MonadThrow m, MonadTime m) =>
+  (MonadSTM m, MonadThrow m) =>
   -- | Tracer for logging
   Tracer m CardanoChainLog ->
   ChainCallback Tx m ->
@@ -324,11 +324,11 @@ chainSyncHandler ::
   -- | Contextual information about our chain connection.
   ChainContext ->
   LocalChainState m Tx ->
-  ContestationPeriod ->
   TVar m SyncedStatus ->
+  m ChainPoint ->
   -- | A chain-sync handler to use in a local-chain-sync client.
   ChainSyncHandler m
-chainSyncHandler tracer callback getTimeHandle ctx localChainState contestationPeriod syncedStatus = do
+chainSyncHandler tracer callback getTimeHandle ctx localChainState syncedStatus getCurrentTip = do
   ChainSyncHandler
     { onRollBackward
     , onRollForward
@@ -362,7 +362,8 @@ chainSyncHandler tracer callback getTimeHandle ctx localChainState contestationP
           Right utcTime -> do
             let chainSlot = ChainSlot . fromIntegral $ unSlotNo slotNo
             callback (Tick{chainTime = utcTime, chainSlot})
-            updateSyncStatus syncedStatus contestationPeriod utcTime point
+            tip <- getCurrentTip
+            updateSyncStatus syncedStatus tip point
 
     forM_ receivedTxs $
       maybeObserveSomeTx timeHandle point >=> \case

hydra-node/src/Hydra/Chain/Offline.hs

@@ -9,7 +9,7 @@ import Cardano.Slotting.Time (SystemStart (SystemStart), mkSlotLength)
 import Control.Monad.Class.MonadAsync (link)
 import Data.Aeson qualified as Aeson
 import Data.Aeson.Types qualified as Aeson
-import Hydra.Cardano.Api (GenesisParameters (..), ShelleyEra, ShelleyGenesis (..), Tx)
+import Hydra.Cardano.Api (ChainPoint (ChainPointAtGenesis), GenesisParameters (..), ShelleyEra, ShelleyGenesis (..), Tx)
 import Hydra.Chain (
   Chain (..),
   ChainComponent,
@@ -86,7 +86,7 @@ withOfflineChain config party otherParties chainStateHistory callback action = d
   chainHandle =
     Chain
       { mkChainState = initialChainState
-      , chainSyncedStatus = pure unSynced
+      , chainSyncedStatus = pure (unSynced ChainPointAtGenesis)
       , submitTx = const $ pure ()
       , draftCommitTx = \_ _ -> pure $ Left FailedToDraftTxNotInitializing
       , draftDepositTx = \_ _ _ _ _ _ -> pure $ Left FailedToConstructDepositTx{failureReason = "not implemented"}

hydra-node/src/Hydra/Chain/SyncedStatus.hs

@@ -3,14 +3,15 @@ module Hydra.Chain.SyncedStatus where
 import Hydra.Prelude
 
 import Control.Concurrent.Class.MonadSTM (writeTVar)
-import Hydra.Cardano.Api (ChainPoint (..))
-import Hydra.Tx.ContestationPeriod (ContestationPeriod, toNominalDiffTime)
+import Hydra.Cardano.Api (ChainPoint (..), SlotNo (SlotNo), chainPointToSlotNo)
+import Hydra.Chain.ChainState (ChainSlot (ChainSlot))
 
 data SyncedStatus
   = SyncedStatus
   { status :: Bool
-  , diff :: Maybe NominalDiffTime
+  , diff :: Maybe ChainSlot
   , point :: ChainPoint
+  , tip :: ChainPoint
   }
   deriving stock (Eq, Show, Generic)
   deriving anyclass (ToJSON, FromJSON)
@@ -19,20 +20,24 @@ instance Arbitrary SyncedStatus where
   arbitrary = genericArbitrary
   shrink = genericShrink
 
-unSynced :: SyncedStatus
-unSynced = SyncedStatus{status = False, diff = Nothing, point = ChainPointAtGenesis}
+unSynced :: ChainPoint -> SyncedStatus
+unSynced tip = SyncedStatus{status = False, diff = Nothing, point = ChainPointAtGenesis, tip}
 
 updateSyncStatus ::
-  (MonadSTM m, MonadTime m) =>
+  MonadSTM m =>
   TVar m SyncedStatus ->
-  ContestationPeriod ->
-  UTCTime ->
+  ChainPoint ->
   ChainPoint ->
   m ()
-updateSyncStatus syncedStatus contestationPeriod slotUTCTime point = do
-  -- TODO! replace by: slotToUTCTime tipSlot
-  now <- getCurrentTime
-  let diff = now `diffUTCTime` slotUTCTime
-      synced = diff < toNominalDiffTime contestationPeriod
+updateSyncStatus syncedStatus tip point = do
+  let diff = chainSlotFromPoint tip - chainSlotFromPoint point
+      synced = tip == point
   atomically $
-    writeTVar syncedStatus SyncedStatus{status = synced, diff = Just diff, point}
+    writeTVar syncedStatus SyncedStatus{status = synced, diff = Just diff, point, tip}
+ where
+  -- TODO! DRY
+  chainSlotFromPoint :: ChainPoint -> ChainSlot
+  chainSlotFromPoint p =
+    case chainPointToSlotNo p of
+      Nothing -> ChainSlot 0
+      Just (SlotNo s) -> ChainSlot $ fromIntegral s

hydra-node/test/Hydra/API/ServerSpec.hs

@@ -380,7 +380,7 @@ dummyChainHandle :: Chain tx IO
 dummyChainHandle =
   Chain
     { mkChainState = error "unexpected call to mkChainState"
-    , chainSyncedStatus = pure SyncedStatus{status = True, diff = Nothing, point = ChainPointAtGenesis}
+    , chainSyncedStatus = pure SyncedStatus{status = True, diff = Nothing, point = ChainPointAtGenesis, tip = ChainPointAtGenesis}
     , postTx = \_ -> error "unexpected call to postTx"
     , draftCommitTx = \_ -> error "unexpected call to draftCommitTx"
     , draftDepositTx = \_ -> error "unexpected call to draftDepositTx"