expand info endpoint with more information

Change-Id: I7999b4200ce823be0a0466291852d159824cc16f

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

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.

changes/2024-06-11T104051-0500.txt

@@ -0,0 +1 @@
+Move serviceDate to be a part of the ChainwebVersion

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

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

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

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

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
     }

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"
     }

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
     }

src/Chainweb/Version/Testnet.hs

@@ -190,4 +190,5 @@ testnet = ChainwebVersion
             , (fromJuste (decodeStrictOrThrow' "\"3fpFnFUrRsu67ItHicBGa9PVlWp71AggrcWoikht3jk\""), Gas 65130)
             ]
         }
+    , _versionServiceDate = Just "2024-08-21T00:00:00Z"
     }

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
             }
 
 -- -------------------------------------------------------------------------- --