move /tick into /ticks

cardano-scaling · Feb 4, 2025 · 45a36ac · 45a36ac
1 parent 0e00632
commit 45a36ac
Show file tree

Hide file tree

Showing 5 changed files with 101 additions and 43 deletions.
diff --git a/api/client-api.yaml b/api/client-api.yaml
@@ -11,24 +11,18 @@ externalDocs:
   description: More information about the Hydra protocol
   url: http://hydra.family
 paths:
-  /tick:
+  /ticks:
     get:
-      summary: Get the latest point in time obseverd on chain by the explorer
+      summary: Get a list of points in time obseverd on chain by the explorer
       responses:
         '200':
           description: Successful response
           content:
             application/json:
               schema:
-                type: object
-                required:
-                  - point
-                  - blockNo
-                properties:
-                  point:
-                    $ref: '#/components/schemas/ChainPoint'
-                  blockNo:
-                    type: integer
+                type: array
+                items:
+                  $ref: '#/components/schemas/TickState'
   /heads:
     get:
       summary: Get a list of head states
@@ -274,3 +268,19 @@ components:
           $ref: '#/components/schemas/ChainPoint'
         blockNo:
           type: integer
+    TickState:
+      type: object
+      required:
+        - network
+        - networkMagic
+        - point
+        - blockNo
+      properties:
+        network:
+          $ref: "#/components/schemas/Network"
+        networkMagic:
+          $ref: "#/components/schemas/NetworkMagic"
+        point:
+          $ref: '#/components/schemas/ChainPoint'
+        blockNo:
+          type: integer
diff --git a/hydra-explorer/src/Hydra/Explorer.hs b/hydra-explorer/src/Hydra/Explorer.hs
@@ -40,7 +40,7 @@ handlePostObservation pushObservation (NetworkParam networkId) version observati
 
 type ClientApi =
   "heads" :> Get '[JSON] [HeadState]
-    :<|> "tick" :> Get '[JSON] TickState
+    :<|> "ticks" :> Get '[JSON] [TickState]
     :<|> Raw
 
 -- | WAI application serving the 'ClientApi'.
@@ -61,9 +61,9 @@ handleGetHeads getExplorerState =
 
 handleGetTick ::
   GetExplorerState ->
-  Handler TickState
+  Handler [TickState]
 handleGetTick getExplorerState = do
-  liftIO getExplorerState <&> \ExplorerState{tick} -> tick
+  liftIO getExplorerState <&> \ExplorerState{ticks} -> ticks
 
 -- * Agreggator
 

diff --git a/hydra-explorer/src/Hydra/Explorer/ExplorerState.hs b/hydra-explorer/src/Hydra/Explorer/ExplorerState.hs
@@ -10,9 +10,9 @@ import Hydra.Chain (OnChainTx (..))
 import Test.Hydra.Tx.Gen (genUTxO)
 
 import Data.Aeson (Value (..))
-import Hydra.Cardano.Api (BlockNo, ChainPoint (..), NetworkId, NetworkMagic, TxIn, UTxO, networkIdToNetwork, toNetworkMagic)
-import Hydra.Cardano.Api.Network (Network)
-import Hydra.Explorer.ObservationApi (HydraVersion, Observation (..))
+import Hydra.Cardano.Api (BlockNo, ChainPoint (..), NetworkId, NetworkMagic (..), TxIn, UTxO, networkIdToNetwork, toNetworkMagic)
+import Hydra.Cardano.Api.Network (Network (..))
+import Hydra.Explorer.ObservationApi (HydraVersion (..), Observation (..))
 import Hydra.Tx.ContestationPeriod (ContestationPeriod, toNominalDiffTime)
 import Hydra.Tx.HeadId (HeadId (..), HeadSeed, headSeedToTxIn)
 import Hydra.Tx.HeadParameters (HeadParameters (..))
@@ -91,7 +91,9 @@ instance Arbitrary HeadState where
 
 -- | Represents the latest point in time observed on chain.
 data TickState = TickState
-  { point :: ChainPoint
+  { network :: Network
+  , networkMagic :: NetworkMagic
+  , point :: ChainPoint
   , blockNo :: BlockNo
   }
   deriving stock (Eq, Show, Generic)
@@ -100,12 +102,19 @@ data TickState = TickState
 instance Arbitrary TickState where
   arbitrary = genericArbitrary
 
-initialTickState :: TickState
-initialTickState = TickState ChainPointAtGenesis 0
+initialTickState :: [TickState]
+initialTickState =
+  [ TickState
+      { network = Testnet
+      , networkMagic = NetworkMagic 2
+      , point = ChainPointAtGenesis
+      , blockNo = 0
+      }
+  ]
 
 data ExplorerState = ExplorerState
   { heads :: [HeadState]
-  , tick :: TickState
+  , ticks :: [TickState]
   }
   deriving (Eq, Show)
 
@@ -549,6 +558,36 @@ replaceHeadState newHeadState@HeadState{headId = newHeadStateId} currentHeads =
         then newHeadState : tailStates
         else currentHeadState : replaceHeadState newHeadState tailStates
 
+replaceTickState :: TickState -> [TickState] -> [TickState]
+replaceTickState newTickState@TickState{network = newNetwork, networkMagic = newNetworkMagic} currentTicks =
+  case currentTicks of
+    [] -> [newTickState]
+    (currentTickState@TickState{network = currentNetwork, networkMagic = currentNetworkMagic} : tailStates) ->
+      if newNetwork == currentNetwork && newNetworkMagic == currentNetworkMagic
+        then newTickState : tailStates
+        else currentTickState : replaceTickState newTickState tailStates
+
+aggregateTickObservation ::
+  NetworkId ->
+  ChainPoint ->
+  BlockNo ->
+  [TickState] ->
+  [TickState]
+aggregateTickObservation networkId point blockNo currentTicks =
+  case findTickState networkId currentTicks of
+    Just _ ->
+      let newTickState = newUnknownTickState
+       in replaceTickState newTickState currentTicks
+    Nothing -> currentTicks <> [newUnknownTickState]
+ where
+  newUnknownTickState =
+    TickState
+      { network = networkIdToNetwork networkId
+      , networkMagic = toNetworkMagic networkId
+      , point
+      , blockNo
+      }
+
 -- XXX: Aggregation is very conservative and does ignore most information when
 -- matching data is already present.
 aggregateObservation ::
@@ -557,68 +596,75 @@ aggregateObservation ::
   Observation ->
   ExplorerState ->
   ExplorerState
-aggregateObservation networkId version Observation{point, blockNo, observedTx} ExplorerState{heads} =
+aggregateObservation networkId version Observation{point, blockNo, observedTx} ExplorerState{heads, ticks} =
   case observedTx of
     Nothing ->
       ExplorerState
         { heads
-        , tick = TickState point blockNo
+        , ticks = aggregateTickObservation networkId point blockNo ticks
         }
     Just OnInitTx{headId, headSeed, headParameters, participants} ->
       ExplorerState
         { heads = aggregateInitObservation networkId version headId point blockNo headSeed headParameters participants heads
-        , tick = TickState point blockNo
+        , ticks = aggregateTickObservation networkId point blockNo ticks
         }
     Just OnAbortTx{headId} ->
       ExplorerState
         { heads = aggregateAbortObservation networkId version headId point blockNo heads
-        , tick = TickState point blockNo
+        , ticks = aggregateTickObservation networkId point blockNo ticks
         }
     Just OnCommitTx{headId, party, committed} ->
       ExplorerState
         { heads = aggregateCommitObservation networkId version headId point blockNo party committed heads
-        , tick = TickState point blockNo
+        , ticks = aggregateTickObservation networkId point blockNo ticks
         }
     Just OnCollectComTx{headId} ->
       ExplorerState
         { heads = aggregateCollectComObservation networkId version headId point blockNo heads
-        , tick = TickState point blockNo
+        , ticks = aggregateTickObservation networkId point blockNo ticks
         }
     Just OnDepositTx{headId} ->
       ExplorerState
         { heads = aggregateDepositObservation networkId version headId point blockNo heads
-        , tick = TickState point blockNo
+        , ticks = aggregateTickObservation networkId point blockNo ticks
         }
     Just OnRecoverTx{headId} ->
       ExplorerState
         { heads = aggregateRecoverObservation networkId version headId point blockNo heads
-        , tick = TickState point blockNo
+        , ticks = aggregateTickObservation networkId point blockNo ticks
         }
     Just OnIncrementTx{headId} ->
       ExplorerState
         { heads = aggregateIncrementObservation networkId version headId point blockNo heads
-        , tick = TickState point blockNo
+        , ticks = aggregateTickObservation networkId point blockNo ticks
         }
     Just OnDecrementTx{headId} ->
       ExplorerState
         { heads = aggregateDecrementObservation networkId version headId point blockNo heads
-        , tick = TickState point blockNo
+        , ticks = aggregateTickObservation networkId point blockNo ticks
         }
     Just OnCloseTx{headId, snapshotNumber, contestationDeadline} ->
       ExplorerState
         { heads = aggregateCloseObservation networkId version headId point blockNo snapshotNumber contestationDeadline heads
-        , tick = TickState point blockNo
+        , ticks = aggregateTickObservation networkId point blockNo ticks
         }
     Just OnContestTx{headId, snapshotNumber} ->
       ExplorerState
         { heads = aggregateContestObservation networkId version headId point blockNo snapshotNumber heads
-        , tick = TickState point blockNo
+        , ticks = aggregateTickObservation networkId point blockNo ticks
         }
     Just OnFanoutTx{headId} ->
       ExplorerState
         { heads = aggregateFanoutObservation networkId version headId point blockNo heads
-        , tick = TickState point blockNo
+        , ticks = aggregateTickObservation networkId point blockNo ticks
         }
 
 findHeadState :: HeadId -> [HeadState] -> Maybe HeadState
 findHeadState idToFind = find (\HeadState{headId} -> headId == idToFind)
+
+findTickState :: NetworkId -> [TickState] -> Maybe TickState
+findTickState networkId =
+  find
+    ( \TickState{network, networkMagic} ->
+        networkIdToNetwork networkId == network && toNetworkMagic networkId == networkMagic
+    )
diff --git a/hydra-explorer/test/Hydra/Explorer/ApiSpec.hs b/hydra-explorer/test/Hydra/Explorer/ApiSpec.hs
@@ -65,7 +65,7 @@ apiServerSpec = do
           openApi <- liftIO $ Yaml.decodeFileThrow @_ @OpenApi openApiSchema
           let componentSchemas = openApi ^?! components . schemas
           let maybeTickSchema = do
-                path <- openApi ^. paths . at "/tick"
+                path <- openApi ^. paths . at "/ticks"
                 endpoint <- path ^. get
                 res <- endpoint ^. responses . at 200
                 -- XXX: _Inline here assumes that no $ref is used within the
@@ -74,11 +74,11 @@ apiServerSpec = do
                 s <- jsonContent ^. schema
                 pure $ s ^. _Inline
           case maybeTickSchema of
-            Nothing -> liftIO . failure $ "Failed to find schema for GET /tick endpoint"
-            Just tickSchema -> do
-              liftIO $ tickSchema `shouldNotBe` mempty
-              Wai.get "tick"
-                `shouldRespondWith` matchingJSONSchema componentSchemas tickSchema
+            Nothing -> liftIO . failure $ "Failed to find schema for GET /ticks endpoint"
+            Just ticksSchema -> do
+              liftIO $ ticksSchema `shouldNotBe` mempty
+              Wai.get "ticks"
+                `shouldRespondWith` matchingJSONSchema componentSchemas ticksSchema
 
 matchingJSONSchema :: Definitions Schema -> Schema -> ResponseMatcher
 matchingJSONSchema definitions s =

diff --git a/hydra-explorer/test/Hydra/Explorer/IntegrationSpec.hs b/hydra-explorer/test/Hydra/Explorer/IntegrationSpec.hs
@@ -141,7 +141,9 @@ spec = do
               withChainObserver node explorer $ do
                 threadDelay 1
                 tip <- toJSON <$> queryTip networkId nodeSocket
-                tick <- getTick explorer
+                allTicks <- getTicks explorer
+
+                let tick = fromMaybe Null $ allTicks ^? nth 0
 
                 let tipSlot = tip ^? key "slot" . _Number
                     tickSlot = tick ^? key "point" . key "slot" . _Number
@@ -157,7 +159,7 @@ data HydraExplorerClient = HydraExplorerClient
   { clientPort :: PortNumber
   , observerPort :: PortNumber
   , getHeads :: IO Value
-  , getTick :: IO Value
+  , getTicks :: IO Value
   }
 
 -- | Starts a 'hydra-explorer'.
@@ -177,7 +179,7 @@ withHydraExplorer action =
             { clientPort
             , observerPort
             , getHeads = getJSON clientPort "/heads"
-            , getTick = getJSON clientPort "/tick"
+            , getTicks = getJSON clientPort "/ticks"
             }
  where
   getJSON port path =