From 53f369574d7187161aacd564421f6249492b27c7 Mon Sep 17 00:00:00 2001 From: chessai Date: Thu, 6 Jun 2024 14:07:05 -0500 Subject: [PATCH] expand info endpoint with more information Change-Id: I7999b4200ce823be0a0466291852d159824cc16f --- chainweb.cabal | 2 + changes/2024-06-11T102857-0500.txt | 1 + changes/2024-06-11T104051-0500.txt | 1 + node/ChainwebNode.hs | 7 +-- src/Chainweb/NodeVersion.hs | 9 +--- src/Chainweb/RestAPI/NodeInfo.hs | 57 ++++++++++++++++-------- src/Chainweb/Version.hs | 3 ++ src/Chainweb/Version/Development.hs | 1 + src/Chainweb/Version/Mainnet.hs | 5 ++- src/Chainweb/Version/RecapDevelopment.hs | 1 + src/Chainweb/Version/Testnet.hs | 1 + test/Chainweb/Test/Orphans/Internal.hs | 13 +++++- 12 files changed, 64 insertions(+), 37 deletions(-) create mode 100644 changes/2024-06-11T102857-0500.txt create mode 100644 changes/2024-06-11T104051-0500.txt diff --git a/chainweb.cabal b/chainweb.cabal index f66ad1846d..0ad3f80b48 100644 --- a/chainweb.cabal +++ b/chainweb.cabal @@ -576,6 +576,7 @@ test-suite chainweb-tests , data-dword >= 0.3 , data-ordlist >= 0.4.7 , deepseq >= 1.4 + , digraph , direct-sqlite >= 2.3.27 , directory >= 1.2 , ethereum @@ -849,6 +850,7 @@ benchmark bench , containers >= 0.5 , criterion , deepseq >= 1.4 + , digraph , exceptions >= 0.8 , file-embed >= 0.0 , lens >= 4.17 diff --git a/changes/2024-06-11T102857-0500.txt b/changes/2024-06-11T102857-0500.txt new file mode 100644 index 0000000000..4a9830bcc4 --- /dev/null +++ b/changes/2024-06-11T102857-0500.txt @@ -0,0 +1 @@ +Expand /info endpoint with: historical fork heights, node package version, genesis heights, the upcoming service date, and the block delay. diff --git a/changes/2024-06-11T104051-0500.txt b/changes/2024-06-11T104051-0500.txt new file mode 100644 index 0000000000..0bb59d014a --- /dev/null +++ b/changes/2024-06-11T104051-0500.txt @@ -0,0 +1 @@ +Move serviceDate to be a part of the ChainwebVersion diff --git a/node/ChainwebNode.hs b/node/ChainwebNode.hs index 7e92acb955..0b0ca0cc78 100644 --- a/node/ChainwebNode.hs +++ b/node/ChainwebNode.hs @@ -540,11 +540,6 @@ pkgInfoScopes = -- -------------------------------------------------------------------------- -- -- main --- SERVICE DATE for version 2.24 --- -serviceDate :: Maybe String -serviceDate = Just "2024-08-21T00:00:00Z" - mainInfo :: ProgramInfo ChainwebNodeConfiguration mainInfo = programInfoValidate "Chainweb Node" @@ -571,7 +566,7 @@ main = do , Handler $ \(e :: SomeException) -> logFunctionJson logger Error (ProcessDied $ show e) >> throwIO e ] $ do - kt <- mapM iso8601ParseM serviceDate + kt <- mapM iso8601ParseM (_versionServiceDate v) withServiceDate (_configChainwebVersion (_nodeConfigChainweb conf)) (logFunctionText logger) kt $ void $ race (node conf logger) (gcRunner (logFunctionText logger)) where diff --git a/src/Chainweb/NodeVersion.hs b/src/Chainweb/NodeVersion.hs index 7e217c9fa3..624b3ccd70 100644 --- a/src/Chainweb/NodeVersion.hs +++ b/src/Chainweb/NodeVersion.hs @@ -39,7 +39,6 @@ module Chainweb.NodeVersion import Control.DeepSeq import Control.Lens hiding ((.=)) -import Control.Monad import Control.Monad.Catch import Data.Aeson @@ -236,10 +235,7 @@ requestRemoteNodeInfo mgr ver addr maybeReq = -- | Obtain 'NodeInfo' of a remote Chainweb node from response headers. -- --- This function throws 'NodeInfoUnsupported' for remote chainweb nodes --- with a node version smaller or equal 2.5. --- --- No retries are attempted in case of a failure. +-- No retries are attempted in case of a failure. -- getRemoteNodeInfo :: forall m @@ -252,9 +248,6 @@ getRemoteNodeInfo addr hdrs = do Nothing -> throwM $ VersionHeaderMissing addr Just x -> hdrFromText x - -- can be removed once all nodes run version 2.4 or larger - unless (vers >= NodeVersion [2,5]) $ throwM $ NodeInfoUnsupported addr vers - RemoteNodeInfo vers <$> case lookup serverTimestampHeaderName hdrs of Nothing -> throwM $ ServerTimestampHeaderMissing addr diff --git a/src/Chainweb/RestAPI/NodeInfo.hs b/src/Chainweb/RestAPI/NodeInfo.hs index 9dcf13c176..9d076fbefa 100644 --- a/src/Chainweb/RestAPI/NodeInfo.hs +++ b/src/Chainweb/RestAPI/NodeInfo.hs @@ -1,8 +1,9 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} @@ -16,9 +17,9 @@ import Control.Lens import Control.Monad.Trans import Data.Aeson import Data.Bifunctor +import Data.HashSet qualified as HashSet import qualified Data.DiGraph as G import qualified Data.HashMap.Strict as HashMap -import qualified Data.HashSet as HashSet import qualified Data.List.NonEmpty as NE import Data.Text (Text) import qualified Data.Text as T @@ -27,10 +28,12 @@ import GHC.Generics import Servant +import Chainweb.BlockHeader (genesisHeight) import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Cut.CutHashes import Chainweb.CutDB +import Chainweb.Difficulty (BlockDelay) import Chainweb.Graph import Chainweb.RestAPI.Utils import Chainweb.Utils.Rule @@ -46,39 +49,55 @@ someNodeInfoServer v c = SomeServer (Proxy @NodeInfoApi) (nodeInfoHandler v $ someCutDbVal v c) data NodeInfo = NodeInfo - { - nodeVersion :: ChainwebVersionName + { nodeVersion :: ChainwebVersionName + -- ^ ChainwebVersion the node is running + , nodePackageVersion :: Text + -- ^ Chainweb Package version that the node is running , nodeApiVersion :: Text + -- ^ Chainweb Node API version , nodeChains :: [Text] - -- ^ Current list of chains + -- ^ Current list of chains , nodeNumberOfChains :: !Int - -- ^ Current number of chains + -- ^ Current number of chains , nodeGraphHistory :: [(BlockHeight, [(Int, [Int])])] - -- ^ List of chain graphs and the block height they took effect. Sorted - -- descending by height so the current chain graph is at the beginning. + -- ^ List of chain graphs and the block height they took effect. Sorted + -- descending by height so the current chain graph is at the beginning. , nodeLatestBehaviorHeight :: BlockHeight - -- ^ Height at which the latest behavior of the node is activated. See - -- `Chainweb.Version.latestBehaviorAt`. - } deriving (Show, Eq, Generic) - -instance ToJSON NodeInfo -instance FromJSON NodeInfo + -- ^ Height at which the latest behavior of the node is activated. See + -- `Chainweb.Version.latestBehaviorAt`. + , nodeGenesisHeights :: [(Text, BlockHeight)] + -- ^ Genesis heights of each chain. + , nodeHistoricalChains :: Rule BlockHeight [ChainId] + -- ^ The graph upgrades over time. For now, this is just the vertices, + -- instead of the full graph. + , nodeServiceDate :: Maybe Text + -- ^ The upcoming service date for the node. + , nodeBlockDelay :: BlockDelay + -- ^ The PoW block delay of the node (microseconds) + } + deriving (Show, Eq, Generic) + deriving anyclass (ToJSON, FromJSON) nodeInfoHandler :: ChainwebVersion -> SomeCutDb tbl -> Server NodeInfoApi -nodeInfoHandler v (SomeCutDb ((CutDbT db) :: CutDbT cas v)) = do +nodeInfoHandler v (SomeCutDb (CutDbT db :: CutDbT cas v)) = do curCut <- liftIO $ _cut db let ch = cutToCutHashes Nothing curCut - curHeight = maximum $ map _bhwhHeight $ HashMap.elems $ _cutHashes ch - graphs = unpackGraphs v - curGraph = head $ dropWhile (\(h,_) -> h > curHeight) graphs - curChains = map fst $ snd curGraph + let curHeight = maximum $ map _bhwhHeight $ HashMap.elems $ _cutHashes ch + let graphs = unpackGraphs v + let curGraph = head $ dropWhile (\(h,_) -> h > curHeight) graphs + let curChains = map fst $ snd curGraph return $ NodeInfo { nodeVersion = _versionName v + , nodePackageVersion = chainwebNodeVersionHeaderValue , nodeApiVersion = prettyApiVersion , nodeChains = T.pack . show <$> curChains , nodeNumberOfChains = length curChains , nodeGraphHistory = graphs , nodeLatestBehaviorHeight = latestBehaviorAt v + , nodeGenesisHeights = map (\c -> (chainIdToText c, genesisHeight v c)) $ HashSet.toList (chainIds v) + , nodeHistoricalChains = fmap (HashSet.toList . G.vertices . (^. chainGraphGraph)) (_versionGraphs v) + , nodeServiceDate = T.pack <$> _versionServiceDate v + , nodeBlockDelay = _versionBlockDelay v } -- | Converts chainwebGraphs to a simpler structure that has invertible JSON diff --git a/src/Chainweb/Version.hs b/src/Chainweb/Version.hs index b7212f0058..f56ffa29e3 100644 --- a/src/Chainweb/Version.hs +++ b/src/Chainweb/Version.hs @@ -68,6 +68,7 @@ module Chainweb.Version , versionGenesis , versionVerifierPluginNames , versionQuirks + , versionServiceDate , genesisBlockPayload , genesisBlockPayloadHash , genesisBlockTarget @@ -407,6 +408,8 @@ data ChainwebVersion -- ^ Verifier plugins that can be run to verify transaction contents. , _versionQuirks :: VersionQuirks -- ^ Modifications to behavior at particular blockheights + , _versionServiceDate :: Maybe String + -- ^ The node service date for this version. } deriving stock (Generic) deriving anyclass NFData diff --git a/src/Chainweb/Version/Development.hs b/src/Chainweb/Version/Development.hs index 1ebc78a158..aec4736721 100644 --- a/src/Chainweb/Version/Development.hs +++ b/src/Chainweb/Version/Development.hs @@ -62,4 +62,5 @@ devnet = ChainwebVersion , _versionVerifierPluginNames = AllChains $ End $ Set.fromList $ map VerifierName ["hyperlane_v3_message", "allow"] , _versionQuirks = noQuirks + , _versionServiceDate = Nothing } diff --git a/src/Chainweb/Version/Mainnet.hs b/src/Chainweb/Version/Mainnet.hs index 1427a6e0fb..4025e1be10 100644 --- a/src/Chainweb/Version/Mainnet.hs +++ b/src/Chainweb/Version/Mainnet.hs @@ -215,8 +215,9 @@ mainnet = ChainwebVersion End mempty , _versionQuirks = VersionQuirks { _quirkGasFees = HM.fromList - [ (fromJuste (decodeStrictOrThrow' "\"s9fUspNaCHoV4rNI-Tw-JYU1DxqZAOXS-80oEy7Zfbo\""), Gas 67618) - , (fromJuste (decodeStrictOrThrow' "\"_f1xkIQPGRcOBNBWkOvP0dGNOjmNtmXwOnXzfdwnmJQ\""), Gas 69092) + [ (fromJuste (decodeStrictOrThrow' "\"s9fUspNaCHoV4rNI-Tw-JYU1DxqZAOXS-80oEy7Zfbo\""), Gas 67_618) + , (fromJuste (decodeStrictOrThrow' "\"_f1xkIQPGRcOBNBWkOvP0dGNOjmNtmXwOnXzfdwnmJQ\""), Gas 69_092) ] } + , _versionServiceDate = Just "2024-08-21T00:00:00Z" } diff --git a/src/Chainweb/Version/RecapDevelopment.hs b/src/Chainweb/Version/RecapDevelopment.hs index e800c5d12c..76cdb9d6ef 100644 --- a/src/Chainweb/Version/RecapDevelopment.hs +++ b/src/Chainweb/Version/RecapDevelopment.hs @@ -120,4 +120,5 @@ recapDevnet = ChainwebVersion (600, Set.fromList $ map VerifierName ["hyperlane_v3_message", "allow"]) `Above` End mempty , _versionQuirks = noQuirks + , _versionServiceDate = Nothing } diff --git a/src/Chainweb/Version/Testnet.hs b/src/Chainweb/Version/Testnet.hs index 4a2c71fc65..ac902e89f2 100644 --- a/src/Chainweb/Version/Testnet.hs +++ b/src/Chainweb/Version/Testnet.hs @@ -190,4 +190,5 @@ testnet = ChainwebVersion , (fromJuste (decodeStrictOrThrow' "\"3fpFnFUrRsu67ItHicBGa9PVlWp71AggrcWoikht3jk\""), Gas 65130) ] } + , _versionServiceDate = Just "2024-08-21T00:00:00Z" } diff --git a/test/Chainweb/Test/Orphans/Internal.hs b/test/Chainweb/Test/Orphans/Internal.hs index b21a3aa774..411b3b6cc0 100644 --- a/test/Chainweb/Test/Orphans/Internal.hs +++ b/test/Chainweb/Test/Orphans/Internal.hs @@ -60,6 +60,7 @@ module Chainweb.Test.Orphans.Internal ) where import Control.Applicative +import Control.Lens ((^.)) import Control.Monad import Control.Monad.Catch @@ -68,9 +69,11 @@ import Crypto.Hash.Algorithms import Data.Aeson hiding (Error) import qualified Data.ByteString as B import qualified Data.ByteString.Short as BS +import qualified Data.DiGraph as G import Data.Foldable import Data.Function import qualified Data.HashMap.Strict as HM +import qualified Data.HashSet as HS import Data.Kind import qualified Data.List as L import Data.MerkleLog @@ -79,6 +82,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Type.Equality import qualified Data.Vector as V +import Data.Word (Word32) import GHC.Stack @@ -282,15 +286,20 @@ instance Arbitrary NodeInfo where v <- arbitrary curHeight <- arbitrary let graphs = unpackGraphs v - curGraph = head $ dropWhile (\(h,_) -> h > curHeight) graphs - curChains = map fst $ snd curGraph + let curGraph = head $ dropWhile (\(h,_) -> h > curHeight) graphs + let curChains = map fst $ snd curGraph return $ NodeInfo { nodeVersion = _versionName v + , nodePackageVersion = chainwebNodeVersionHeaderValue , nodeApiVersion = prettyApiVersion , nodeChains = T.pack . show <$> curChains , nodeNumberOfChains = length curChains , nodeGraphHistory = graphs , nodeLatestBehaviorHeight = latestBehaviorAt v + , nodeGenesisHeights = map (\c -> (chainIdToText c, genesisHeight v c)) $ map (unsafeChainId . int @Int @Word32) curChains + , nodeHistoricalChains = fmap (HS.toList . G.vertices . (^. chainGraphGraph)) (_versionGraphs v) + , nodeServiceDate = T.pack <$> _versionServiceDate v + , nodeBlockDelay = _versionBlockDelay v } -- -------------------------------------------------------------------------- --