Refactor chain observation model

To avoid using Maybe type to represent head observations.
cardano-scaling · Mar 4, 2024 · 553fb67 · 553fb67
1 parent 1561381
commit 553fb67
Show file tree

Hide file tree

Showing 5 changed files with 53 additions and 32 deletions.
diff --git a/hydra-chain-observer/src/Hydra/ChainObserver.hs b/hydra-chain-observer/src/Hydra/ChainObserver.hs
@@ -50,16 +50,21 @@ import Ouroboros.Network.Protocol.ChainSync.Client (
   ClientStNext (..),
  )
 
-type ObserverHandler m = [HeadObservationAt] -> m ()
+type ObserverHandler m = [ChainObservation] -> m ()
 
-data HeadObservationAt = HeadObservationAt
-  { point :: ChainPoint
-  , blockNo :: BlockNo
-  , onChainTx :: Maybe (OnChainTx Tx)
-  }
+data ChainObservation
+  = Tick
+      { point :: ChainPoint
+      , blockNo :: BlockNo
+      }
+  | HeadObservation
+      { point :: ChainPoint
+      , blockNo :: BlockNo
+      , onChainTx :: OnChainTx Tx
+      }
   deriving stock (Eq, Show, Generic)
 
-instance Arbitrary HeadObservationAt where
+instance Arbitrary ChainObservation where
   arbitrary = genericArbitrary
 
 defaultObserverHandler :: Applicative m => ObserverHandler m
@@ -183,8 +188,8 @@ chainSyncClient tracer networkId startingPoint observerHandler =
           forM_ onChainTxs (traceWith tracer . logOnChainTx)
           let observationsAt =
                 fmap convertObservation observations <&> \case
-                  Just onChainTx -> HeadObservationAt point blockNo (Just onChainTx)
-                  Nothing -> HeadObservationAt point blockNo Nothing
+                  Just onChainTx -> HeadObservation point blockNo onChainTx
+                  Nothing -> Tick point blockNo
           observerHandler observationsAt
           pure $ clientStIdle utxo'
       , recvMsgRollBackward = \point _tip -> ChainSyncClient $ do

diff --git a/hydra-explorer/src/Hydra/Explorer.hs b/hydra-explorer/src/Hydra/Explorer.hs
@@ -6,7 +6,7 @@ import Hydra.Prelude
 import Control.Concurrent.Class.MonadSTM (modifyTVar', newTVarIO, readTVarIO)
 import Hydra.API.APIServerLog (APIServerLog (..), Method (..), PathInfo (..))
 import Hydra.Cardano.Api (ChainPoint (..))
-import Hydra.ChainObserver (HeadObservationAt)
+import Hydra.ChainObserver (ChainObservation)
 import Hydra.Explorer.ExplorerState (ExplorerState (..), HeadState, aggregateHeadObservations)
 import Hydra.Explorer.Options (Options (..), hydraExplorerOptions, toArgStartChainFrom)
 import Hydra.Logging (Tracer, Verbosity (..), traceWith, withTracer)
@@ -78,7 +78,7 @@ httpApp :: Tracer IO APIServerLog -> GetHeads -> Application
 httpApp tracer getHeads =
   logMiddleware tracer $ serve api $ server getHeads
 
-observerHandler :: TVar IO ExplorerState -> [HeadObservationAt] -> IO ()
+observerHandler :: TVar IO ExplorerState -> [ChainObservation] -> IO ()
 observerHandler explorerState observations = do
   atomically $
     modifyTVar' explorerState $

diff --git a/hydra-explorer/src/Hydra/Explorer/ExplorerState.hs b/hydra-explorer/src/Hydra/Explorer/ExplorerState.hs
@@ -5,12 +5,12 @@ import Hydra.Prelude
 import Hydra.HeadId (HeadId (..), HeadSeed)
 
 import Data.Aeson (Value (..))
-import Hydra.Cardano.Api (BlockNo, ChainPoint, SlotNo, TxIn, UTxO)
+import Hydra.Cardano.Api (BlockNo, ChainPoint, TxIn, UTxO)
 import Hydra.Chain (HeadParameters (..), OnChainTx (..))
 import Hydra.Chain.Direct.Tx (
   headSeedToTxIn,
  )
-import Hydra.ChainObserver (HeadObservationAt (..))
+import Hydra.ChainObserver (ChainObservation (..))
 import Hydra.ContestationPeriod (ContestationPeriod, toNominalDiffTime)
 import Hydra.OnChainId (OnChainId)
 import Hydra.Party (Party)
@@ -292,56 +292,56 @@ replaceHeadState newHeadState@HeadState{headId = newHeadStateId} currentHeads =
         then newHeadState : tailStates
         else currentHeadState : replaceHeadState newHeadState tailStates
 
-aggregateHeadObservations :: [HeadObservationAt] -> ExplorerState -> ExplorerState
+aggregateHeadObservations :: [ChainObservation] -> ExplorerState -> ExplorerState
 aggregateHeadObservations observations explorerState =
   foldl' aggregateOnChainTx explorerState observations
  where
-  aggregateOnChainTx :: ExplorerState -> HeadObservationAt -> ExplorerState
+  aggregateOnChainTx :: ExplorerState -> ChainObservation -> ExplorerState
   aggregateOnChainTx ExplorerState{heads} =
     \case
-      HeadObservationAt{point, blockNo, onChainTx = Just OnInitTx{headId, headSeed, headParameters, participants}} ->
+      HeadObservation{point, blockNo, onChainTx = OnInitTx{headId, headSeed, headParameters, participants}} ->
         ExplorerState
           { heads = aggregateInitObservation headId point blockNo headSeed headParameters participants heads
           , point
           , blockNo
           }
-      HeadObservationAt{point, blockNo, onChainTx = Just OnAbortTx{headId}} ->
+      HeadObservation{point, blockNo, onChainTx = OnAbortTx{headId}} ->
         ExplorerState
           { heads = aggregateAbortObservation headId point blockNo heads
           , point
           , blockNo
           }
-      HeadObservationAt{point, blockNo, onChainTx = Just OnCommitTx{headId, party, committed}} ->
+      HeadObservation{point, blockNo, onChainTx = OnCommitTx{headId, party, committed}} ->
         ExplorerState
           { heads = aggregateCommitObservation headId point blockNo party committed heads
           , point
           , blockNo
           }
-      HeadObservationAt{point, blockNo, onChainTx = Just OnCollectComTx{headId}} ->
+      HeadObservation{point, blockNo, onChainTx = OnCollectComTx{headId}} ->
         ExplorerState
           { heads = aggregateCollectComObservation headId point blockNo heads
           , point
           , blockNo
           }
-      HeadObservationAt{point, blockNo, onChainTx = Just OnCloseTx{headId, snapshotNumber, contestationDeadline}} ->
+      HeadObservation{point, blockNo, onChainTx = OnCloseTx{headId, snapshotNumber, contestationDeadline}} ->
         ExplorerState
           { heads = aggregateCloseObservation headId point blockNo snapshotNumber contestationDeadline heads
           , point
           , blockNo
           }
-      HeadObservationAt{point, blockNo, onChainTx = Just OnContestTx{headId, snapshotNumber}} ->
+      HeadObservation{point, blockNo, onChainTx = OnContestTx{headId, snapshotNumber}} ->
         ExplorerState
           { heads = aggregateContestObservation headId point blockNo snapshotNumber heads
           , point
           , blockNo
           }
-      HeadObservationAt{point, blockNo, onChainTx = Just OnFanoutTx{headId}} ->
+      HeadObservation{point, blockNo, onChainTx = OnFanoutTx{headId}} ->
         ExplorerState
           { heads = aggregateFanoutObservation headId point blockNo heads
           , point
           , blockNo
           }
-      HeadObservationAt{point, blockNo, onChainTx = Nothing} ->
+      Tick{point, blockNo} ->
         ExplorerState
           { heads
           , point

diff --git a/hydra-explorer/test/Hydra/Explorer/ExplorerStateSpec.hs b/hydra-explorer/test/Hydra/Explorer/ExplorerStateSpec.hs
@@ -4,7 +4,7 @@ import Hydra.Prelude
 import Test.Hydra.Prelude
 
 import Hydra.Cardano.Api (ChainPoint (..))
-import Hydra.ChainObserver (HeadObservationAt (..))
+import Hydra.ChainObserver (ChainObservation (..))
 import Hydra.Explorer.ExplorerState (ExplorerState (..), HeadState (..), aggregateHeadObservations)
 import Hydra.HeadId (HeadId)
 import Hydra.OnChainId ()
@@ -25,8 +25,17 @@ spec = do
           let resultExplorerState = aggregateHeadObservations observations (ExplorerState initialState ChainPointAtGenesis 0)
           getHeadIds initialState `isPrefixOf` getHeadIds (heads resultExplorerState)
  where
-  genObservations :: Gen [HeadObservationAt]
-  genObservations = arbitrary `suchThat` (not . null) `suchThat` any (isJust . onChainTx)
+  genObservations :: Gen [ChainObservation]
+  genObservations =
+    arbitrary
+      `suchThat` (not . null)
+      `suchThat` ( not
+                    . any
+                      ( \case
+                          HeadObservation{} -> False
+                          Tick{} -> True
+                      )
+                 )
 
   getHeadIds :: [HeadState] -> [HeadId]
   getHeadIds = fmap headId
diff --git a/hydra-explorer/web/src/app/headsTable.tsx b/hydra-explorer/web/src/app/headsTable.tsx
@@ -3,10 +3,15 @@
 import { useState, useEffect } from "react"
 import Image from "next/image"
 
+interface ChainPoint {
+    blockHash: string
+    slot: string
+}
+
 interface HeadState {
     headId: string
     status: string
-    lastUpdatedAtSlotNo: number
+    lastUpdatedAtPoint: ChainPoint
     lastUpdatedAtBlockNo: number
 }
 
@@ -20,7 +25,7 @@ const HeadsTable = () => {
 
     const getHeads = async () => {
         try {
-            const response = await fetch('http://explorer.hydra.family/heads')
+            const response = await fetch('http://0.0.0.0:3000/heads')
             // The return value is *not* serialized
             // You can return Date, Map, Set, etc.
             if (!response.ok) {
@@ -60,15 +65,17 @@ const HeadsTable = () => {
                                 <th className="px-4 py-2">Status</th>
                                 <th className="px-4 py-2">Last Updated At SlotNo</th>
                                 <th className="px-4 py-2">Last Updated At BlockNo</th>
+                                <th className="px-4 py-2">Last Updated At BlockHash</th>
                             </tr>
                         </thead>
                         <tbody>
                             {Heads.map((entry, index) => (
                                 <tr key={index} className={`${index % 2 === 0 ? 'bg-gray-700' : 'bg-gray-600'}`}>
-                                    <td className="border px-4 py-2">{entry.headId}</td>
-                                    <td className="border px-4 py-2">{entry.status}</td>
-                                    <td className="border px-4 py-2">{entry.lastUpdatedAtSlotNo}</td>
-                                    <td className="border px-4 py-2">{entry.lastUpdatedAtBlockNo}</td>
+                                    <td className="truncate border px-4 py-2">{entry.headId}</td>
+                                    <td className="truncate border px-4 py-2">{entry.status}</td>
+                                    <td className="truncate border px-4 py-2">{entry.lastUpdatedAtPoint.slot}</td>
+                                    <td className="truncate border px-4 py-2">{entry.lastUpdatedAtBlockNo}</td>
+                                    <td className="truncate border px-4 py-2">{entry.lastUpdatedAtPoint.blockHash}</td>
                                 </tr>
                             ))}
                         </tbody>