From c481b6bceea02522e1bdd2aa9a12d20e77f57d6b Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Mon, 4 Mar 2024 21:18:18 -0300 Subject: [PATCH] Add GET /tick endpoint To obtain latest point in time observed on chain. --- hydra-explorer/hydra-explorer.cabal | 2 - .../json-schemas/hydra-explorer-api.yaml | 18 +++++++ hydra-explorer/src/Hydra/Explorer.hs | 49 +++++++++++++++---- .../src/Hydra/Explorer/ExplorerState.hs | 43 +++++++++------- .../test/Hydra/Explorer/ExplorerStateSpec.hs | 11 ++--- hydra-explorer/test/Hydra/ExplorerSpec.hs | 37 ++++++++++++-- hydra-explorer/web/src/app/headsTable.tsx | 2 +- 7 files changed, 122 insertions(+), 40 deletions(-) diff --git a/hydra-explorer/hydra-explorer.cabal b/hydra-explorer/hydra-explorer.cabal index 6eb7537929c..f0935b778d5 100644 --- a/hydra-explorer/hydra-explorer.cabal +++ b/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 diff --git a/hydra-explorer/json-schemas/hydra-explorer-api.yaml b/hydra-explorer/json-schemas/hydra-explorer-api.yaml index 18b44c64686..57f84b6ed4a 100644 --- a/hydra-explorer/json-schemas/hydra-explorer-api.yaml +++ b/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 diff --git a/hydra-explorer/src/Hydra/Explorer.hs b/hydra-explorer/src/Hydra/Explorer.hs index 426ba1bd2fd..a4ba9bc9a25 100644 --- a/hydra-explorer/src/Hydra/Explorer.hs +++ b/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 = diff --git a/hydra-explorer/src/Hydra/Explorer/ExplorerState.hs b/hydra-explorer/src/Hydra/Explorer/ExplorerState.hs index ec402bc8edd..a3ee6eb5ecc 100644 --- a/hydra-explorer/src/Hydra/Explorer/ExplorerState.hs +++ b/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 diff --git a/hydra-explorer/test/Hydra/Explorer/ExplorerStateSpec.hs b/hydra-explorer/test/Hydra/Explorer/ExplorerStateSpec.hs index d1b5dde65bb..b0f9f54e321 100644 --- a/hydra-explorer/test/Hydra/Explorer/ExplorerStateSpec.hs +++ b/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 = diff --git a/hydra-explorer/test/Hydra/ExplorerSpec.hs b/hydra-explorer/test/Hydra/ExplorerSpec.hs index 7fb49cfa25e..8a627d52492 100644 --- a/hydra-explorer/test/Hydra/ExplorerSpec.hs +++ b/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 diff --git a/hydra-explorer/web/src/app/headsTable.tsx b/hydra-explorer/web/src/app/headsTable.tsx index 437c8cdf9b1..26c4c25ddd9 100644 --- a/hydra-explorer/web/src/app/headsTable.tsx +++ b/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) {