Add GET /tick endpoint

To obtain latest point in time observed on chain.

hydra-explorer/hydra-explorer.cabal

@@ -45,7 +45,6 @@ library
   build-depends:
     , aeson
     , base
-    , directory
     , hydra-cardano-api
     , hydra-chain-observer
     , hydra-node
@@ -83,7 +82,6 @@ test-suite tests
     , hspec
     , hspec-wai
     , http-types
-    , hydra-cardano-api
     , hydra-chain-observer
     , hydra-explorer
     , hydra-node

hydra-explorer/json-schemas/hydra-explorer-api.yaml

@@ -3,6 +3,24 @@ info:
   title: Head Explorer API
   version: 1.0.0
 paths:
+  /tick:
+    get:
+      summary: Get the latest point 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
   /heads:
     get:
       summary: Get a list of head states

hydra-explorer/src/Hydra/Explorer.hs

@@ -5,9 +5,8 @@ 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 (ChainObservation)
-import Hydra.Explorer.ExplorerState (ExplorerState (..), HeadState, aggregateHeadObservations)
+import Hydra.Explorer.ExplorerState (ExplorerState (..), HeadState, TickState, aggregateHeadObservations, initialTickState)
 import Hydra.Explorer.Options (Options (..), hydraExplorerOptions, toArgStartChainFrom)
 import Hydra.Logging (Tracer, Verbosity (..), traceWith, withTracer)
 import Hydra.Options qualified as Options
@@ -27,6 +26,7 @@ type CorsHeaders =
   , Header "Access-Control-Allow-Headers" String
   ]
 
+-- REVIEW: maybe rename
 type GetHeadsHeaders :: [Type]
 type GetHeadsHeaders = Header "Accept" String ': CorsHeaders
 
@@ -39,20 +39,35 @@ type API =
             GetHeadsHeaders
             [HeadState]
         )
+    :<|> "tick"
+      :> Get
+          '[JSON]
+          ( Headers
+              GetHeadsHeaders
+              TickState
+          )
     :<|> Raw
 
 type GetHeads :: Type
 type GetHeads = IO [HeadState]
 
+type GetTick :: Type
+type GetTick = IO TickState
+
 api :: Proxy API
 api = Proxy
 
 server ::
   forall (m :: Type -> Type).
   GetHeads ->
+  GetTick ->
   Handler (Headers GetHeadsHeaders [HeadState])
+    :<|> Handler (Headers GetHeadsHeaders TickState)
     :<|> Tagged m Application
-server getHeads = handleGetHeads getHeads :<|> serveDirectoryFileServer "static"
+server getHeads getTick =
+  handleGetHeads getHeads
+    :<|> handleGetTick getTick
+    :<|> serveDirectoryFileServer "static"
 
 handleGetHeads ::
   GetHeads ->
@@ -64,6 +79,16 @@ handleGetHeads getHeads = do
       return $ addHeader "application/json" $ addCorsHeaders heads
     Left (_ :: SomeException) -> throwError err500
 
+handleGetTick ::
+  GetTick ->
+  Handler (Headers GetHeadsHeaders TickState)
+handleGetTick getTick = do
+  result <- liftIO $ try getTick
+  case result of
+    Right tick -> do
+      return $ addHeader "application/json" $ addCorsHeaders tick
+    Left (_ :: SomeException) -> throwError err500
+
 logMiddleware :: Tracer IO APIServerLog -> Middleware
 logMiddleware tracer app' req sendResponse = do
   liftIO $
@@ -74,9 +99,9 @@ logMiddleware tracer app' req sendResponse = do
         }
   app' req sendResponse
 
-httpApp :: Tracer IO APIServerLog -> GetHeads -> Application
-httpApp tracer getHeads =
-  logMiddleware tracer $ serve api $ server getHeads
+httpApp :: Tracer IO APIServerLog -> GetHeads -> GetTick -> Application
+httpApp tracer getHeads getTick =
+  logMiddleware tracer $ serve api $ server getHeads getTick
 
 observerHandler :: TVar IO ExplorerState -> [ChainObservation] -> IO ()
 observerHandler explorerState observations = do
@@ -89,6 +114,11 @@ readModelGetHeadIds explorerStateTVar = do
   ExplorerState{heads} <- readTVarIO explorerStateTVar
   pure heads
 
+readModelGetTick :: TVar IO ExplorerState -> GetTick
+readModelGetTick explorerStateTVar = do
+  ExplorerState{tick} <- readTVarIO explorerStateTVar
+  pure tick
+
 main :: IO ()
 main = do
   withTracer (Verbose "hydra-explorer") $ \tracer -> do
@@ -99,8 +129,9 @@ main = do
           , nodeSocket
           , startChainFrom
           } = opts
-    explorerState <- newTVarIO (ExplorerState [] ChainPointAtGenesis 0)
-    let getHeads = readModelGetHeadIds explorerState
+    explorerState <- newTVarIO (ExplorerState [] initialTickState)
+    let getTick = readModelGetTick explorerState
+        getHeads = readModelGetHeadIds explorerState
         chainObserverArgs =
           Options.toArgNodeSocket nodeSocket
             <> Options.toArgNetworkId networkId
@@ -110,7 +141,7 @@ main = do
           Hydra.ChainObserver.main (observerHandler explorerState)
       )
       ( traceWith tracer (APIServerStarted port)
-          *> Warp.runSettings (settings tracer port) (httpApp tracer getHeads)
+          *> Warp.runSettings (settings tracer port) (httpApp tracer getHeads getTick)
       )
  where
   settings tracer port =

hydra-explorer/src/Hydra/Explorer/ExplorerState.hs

@@ -5,7 +5,7 @@ import Hydra.Prelude
 import Hydra.HeadId (HeadId (..), HeadSeed)
 
 import Data.Aeson (Value (..))
-import Hydra.Cardano.Api (BlockNo, ChainPoint, TxIn, UTxO)
+import Hydra.Cardano.Api (BlockNo, ChainPoint (..), TxIn, UTxO)
 import Hydra.Chain (HeadParameters (..), OnChainTx (..))
 import Hydra.Chain.Direct.Tx (
   headSeedToTxIn,
@@ -78,10 +78,23 @@ data HeadState = HeadState
 instance Arbitrary HeadState where
   arbitrary = genericArbitrary
 
+-- | Represents the latest point in time observed on chain.
+data TickState = TickState
+  { point :: ChainPoint
+  , blockNo :: BlockNo
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (FromJSON, ToJSON)
+
+instance Arbitrary TickState where
+  arbitrary = genericArbitrary
+
+initialTickState :: TickState
+initialTickState = TickState ChainPointAtGenesis 0
+
 data ExplorerState = ExplorerState
   { heads :: [HeadState]
-  , point :: ChainPoint
-  , blockNo :: BlockNo
+  , tick :: TickState
   }
 
 aggregateInitObservation :: HeadId -> ChainPoint -> BlockNo -> HeadSeed -> HeadParameters -> [OnChainId] -> [HeadState] -> [HeadState]
@@ -302,50 +315,42 @@ aggregateHeadObservations observations explorerState =
       HeadObservation{point, blockNo, onChainTx = OnInitTx{headId, headSeed, headParameters, participants}} ->
         ExplorerState
           { heads = aggregateInitObservation headId point blockNo headSeed headParameters participants heads
-          , point
-          , blockNo
+          , tick = TickState point blockNo
           }
       HeadObservation{point, blockNo, onChainTx = OnAbortTx{headId}} ->
         ExplorerState
           { heads = aggregateAbortObservation headId point blockNo heads
-          , point
-          , blockNo
+          , tick = TickState point blockNo
           }
       HeadObservation{point, blockNo, onChainTx = OnCommitTx{headId, party, committed}} ->
         ExplorerState
           { heads = aggregateCommitObservation headId point blockNo party committed heads
-          , point
-          , blockNo
+          , tick = TickState point blockNo
           }
       HeadObservation{point, blockNo, onChainTx = OnCollectComTx{headId}} ->
         ExplorerState
           { heads = aggregateCollectComObservation headId point blockNo heads
-          , point
-          , blockNo
+          , tick = TickState point blockNo
           }
       HeadObservation{point, blockNo, onChainTx = OnCloseTx{headId, snapshotNumber, contestationDeadline}} ->
         ExplorerState
           { heads = aggregateCloseObservation headId point blockNo snapshotNumber contestationDeadline heads
-          , point
-          , blockNo
+          , tick = TickState point blockNo
           }
       HeadObservation{point, blockNo, onChainTx = OnContestTx{headId, snapshotNumber}} ->
         ExplorerState
           { heads = aggregateContestObservation headId point blockNo snapshotNumber heads
-          , point
-          , blockNo
+          , tick = TickState point blockNo
           }
       HeadObservation{point, blockNo, onChainTx = OnFanoutTx{headId}} ->
         ExplorerState
           { heads = aggregateFanoutObservation headId point blockNo heads
-          , point
-          , blockNo
+          , tick = TickState point blockNo
           }
       Tick{point, blockNo} ->
         ExplorerState
           { heads
-          , point
-          , blockNo
+          , tick = TickState point blockNo
           }
 
 findHeadState :: HeadId -> [HeadState] -> Maybe HeadState

hydra-explorer/test/Hydra/Explorer/ExplorerStateSpec.hs

@@ -3,9 +3,8 @@ module Hydra.Explorer.ExplorerStateSpec where
 import Hydra.Prelude
 import Test.Hydra.Prelude
 
-import Hydra.Cardano.Api (ChainPoint (..))
 import Hydra.ChainObserver (ChainObservation (..))
-import Hydra.Explorer.ExplorerState (ExplorerState (..), HeadState (..), aggregateHeadObservations)
+import Hydra.Explorer.ExplorerState (ExplorerState (..), HeadState (..), aggregateHeadObservations, initialTickState)
 import Hydra.HeadId (HeadId)
 import Hydra.OnChainId ()
 import Test.QuickCheck (forAll, suchThat, (=/=))
@@ -17,13 +16,13 @@ spec = do
     -- Even if we only observe a part of the life cycle of some head.
     prop "Any head observations (of some head id) must yield an entry of that head id" $
       forAll genObservations $ \observations ->
-        let ExplorerState{heads} = aggregateHeadObservations observations (ExplorerState [] ChainPointAtGenesis 0)
+        let ExplorerState{heads} = aggregateHeadObservations observations (ExplorerState [] initialTickState)
          in heads =/= []
     prop "Given any observations, the resulting list of head ids is a prefix of the original" $
       forAll genObservations $ \observations ->
-        forAll arbitrary $ \initialState -> do
-          let resultExplorerState = aggregateHeadObservations observations (ExplorerState initialState ChainPointAtGenesis 0)
-          getHeadIds initialState `isPrefixOf` getHeadIds (heads resultExplorerState)
+        forAll arbitrary $ \initialHeads -> do
+          let resultExplorerState = aggregateHeadObservations observations (ExplorerState initialHeads initialTickState)
+          getHeadIds initialHeads `isPrefixOf` getHeadIds (heads resultExplorerState)
  where
   genObservations :: Gen [ChainObservation]
   genObservations =

hydra-explorer/test/Hydra/ExplorerSpec.hs

@@ -21,7 +21,7 @@ import Data.OpenApi (
  )
 import Data.Yaml qualified as Yaml
 import Hydra.Explorer (httpApp)
-import Hydra.Explorer.ExplorerState (HeadState)
+import Hydra.Explorer.ExplorerState (HeadState, TickState)
 import Hydra.Logging (nullTracer)
 import Network.HTTP.Types (statusCode)
 import Network.Wai.Test (SResponse (..))
@@ -35,7 +35,7 @@ spec = apiServerSpec
 apiServerSpec :: Spec
 apiServerSpec = do
   Wai.with (return webServer) $
-    describe "API should respond correctly" $
+    describe "API should respond correctly" $ do
       describe "GET /heads" $
         it "matches schema" $ do
           let openApiSchema = "json-schemas" </> "hydra-explorer-api.yaml"
@@ -63,7 +63,38 @@ apiServerSpec = do
                   case validateJSON componentSchemas headsSchema value of
                     [] -> pure ()
                     errs -> liftIO . failure . toString $ unlines (map toText errs)
+      describe "GET /tick" $
+        it "matches schema" $ do
+          let openApiSchema = "json-schemas" </> "hydra-explorer-api.yaml"
+          openApi <- liftIO $ Yaml.decodeFileThrow @_ @OpenApi openApiSchema
+          let componentSchemas = openApi ^?! components . schemas
+          let maybeTickSchema = do
+                path <- openApi ^. paths . at "/tick"
+                endpoint <- path ^. get
+                res <- endpoint ^. responses . at 200
+                -- XXX: _Inline here assumes that no $ref is used within the
+                -- openapi Operation
+                jsonContent <- res ^. _Inline . content . at "application/json"
+                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
+              SResponse{simpleStatus, simpleHeaders, simpleBody} <- Wai.get "/tick"
+              liftIO $ statusCode simpleStatus `shouldBe` 200
+              liftIO $ simpleHeaders `shouldContain` [("Accept", "application/json")]
+              case Aeson.eitherDecode simpleBody of
+                Left err -> liftIO . failure $ "Failed to decode body: " <> err
+                Right value ->
+                  case validateJSON componentSchemas tickSchema value of
+                    [] -> pure ()
+                    errs -> liftIO . failure . toString $ unlines (map toText errs)
  where
-  webServer = httpApp nullTracer dummyGetHeads
+  webServer = httpApp nullTracer dummyGetHeads dummyGetTick
+
   dummyGetHeads :: IO [HeadState]
   dummyGetHeads = generate arbitrary
+
+  dummyGetTick :: IO TickState
+  dummyGetTick = generate arbitrary

hydra-explorer/web/src/app/headsTable.tsx

@@ -25,7 +25,7 @@ const HeadsTable = () => {
 
     const getHeads = async () => {
         try {
-            const response = await fetch('http://0.0.0.0:3000/heads')
+            const response = await fetch('/heads')
             // The return value is *not* serialized
             // You can return Date, Map, Set, etc.
             if (!response.ok) {