From 45a36acf4171c736ae57bd8c30718384841e41e9 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Tue, 4 Feb 2025 02:42:32 +0100 Subject: [PATCH] move /tick into /ticks --- api/client-api.yaml | 32 ++++--- hydra-explorer/src/Hydra/Explorer.hs | 6 +- .../src/Hydra/Explorer/ExplorerState.hs | 86 ++++++++++++++----- hydra-explorer/test/Hydra/Explorer/ApiSpec.hs | 12 +-- .../test/Hydra/Explorer/IntegrationSpec.hs | 8 +- 5 files changed, 101 insertions(+), 43 deletions(-) diff --git a/api/client-api.yaml b/api/client-api.yaml index 4e642cb..29fa2a0 100644 --- 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 index 445dde2..f9f17d1 100644 --- 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 index e886e24..4820963 100644 --- 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 index cfde11a..714760f 100644 --- 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 index 89ba0e3..4810024 100644 --- 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 =