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/Graph.hs

@@ -14,7 +14,6 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 
@@ -44,6 +43,7 @@ module Chainweb.Graph
 , chainGraphGraph
 , validChainGraph
 , adjacentChainIds
+, toAdjacencySets
 , HasChainGraph(..)
 
 -- * Undirected Edges
@@ -92,6 +92,7 @@ import Control.Monad.Catch (Exception, MonadThrow(..))
 import Data.Bits (xor)
 import Data.Function (on)
 import Data.Hashable (Hashable(..))
+import qualified Data.HashMap.Strict as HM
 import qualified Data.HashSet as HS
 import Data.Kind (Type)
 
@@ -197,6 +198,11 @@ adjacentChainIds graph@(ChainGraph g _ _ _) cid
     | otherwise = mempty
 {-# INLINE adjacentChainIds #-}
 
+-- | Return the adjacency set representation of the underlying graph
+--
+toAdjacencySets :: ChainGraph -> HM.HashMap ChainId (HS.HashSet ChainId)
+toAdjacencySets g = G.adjacencySets (_chainGraphGraph g)
+
 -- -------------------------------------------------------------------------- --
 -- Undirected Edges
 

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 HS
 import qualified Data.DiGraph as G
-import qualified Data.HashMap.Strict as HashMap
-import qualified Data.HashSet as HashSet
+import qualified Data.HashMap.Strict as HM
 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,54 @@ 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 :: NE.NonEmpty (BlockHeight, [(ChainId, [ChainId])])
+    -- ^ All graph upgrades. If a BlockHeight is 'null', that's genesis.
+  , 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 $ HM.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)) $ HS.toList (chainIds v)
+      , nodeHistoricalChains = ruleElems 0 $ fmap (HM.toList . HM.map HS.toList . toAdjacencySets) $ _versionGraphs v
+      , nodeServiceDate = T.pack <$> _versionServiceDate v
+      , nodeBlockDelay = _versionBlockDelay v
       }
 
 -- | Converts chainwebGraphs to a simpler structure that has invertible JSON
@@ -87,6 +105,6 @@ unpackGraphs :: ChainwebVersion -> [(BlockHeight, [(Int, [Int])])]
 unpackGraphs v = gs
   where
     gs = map (second graphAdjacencies) $ NE.toList $ ruleElems (BlockHeight 0) $ _versionGraphs v
-    graphAdjacencies = map unChain . HashMap.toList . fmap HashSet.toList . G.adjacencySets . view chainGraphGraph
+    graphAdjacencies = map unChain . HM.toList . fmap HS.toList . G.adjacencySets . view chainGraphGraph
     unChain (a, bs) = (chainIdInt a, map chainIdInt bs)
 

src/Chainweb/Utils/Rule.hs

@@ -2,13 +2,16 @@
 {-# language DeriveGeneric #-}
 {-# language DeriveTraversable #-}
 {-# language DerivingStrategies #-}
+{-# language InstanceSigs #-}
+{-# language LambdaCase #-}
 {-# language TupleSections #-}
 
 module Chainweb.Utils.Rule where
 
 import Control.DeepSeq
 
 import Data.Aeson
+import Data.Bifunctor
 import Data.Hashable
 import qualified Data.List.NonEmpty as NE
 import Data.Functor.Apply
@@ -30,6 +33,14 @@ data Rule h a = Above (h, a) (Rule h a) | End a
     deriving stock (Eq, Ord, Show, Foldable, Functor, Generic, Generic1, Traversable)
     deriving anyclass (Hashable, NFData)
 
+instance Bifunctor Rule where
+  bimap :: (h -> h') -> (a -> a') -> Rule h a -> Rule h' a'
+  bimap fh fa = go
+    where
+      go = \case
+        Above (h, a) r -> Above (fh h, fa a) (go r)
+        End a -> End (fa a)
+
 instance Foldable1 (Rule h) where foldMap1 = foldMap1Default
 instance Traversable1 (Rule h) where
     traverse1 f (Above (h, a) t) = Above <$> ((h,) <$> f a) <.> traverse1 f t

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

@@ -71,6 +71,7 @@ import qualified Data.ByteString.Short as BS
 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
@@ -143,6 +144,7 @@ import Chainweb.Test.TestVersions
 import Chainweb.Time
 import Chainweb.Utils
 import Chainweb.Utils.Paging
+import Chainweb.Utils.Rule (ruleElems)
 import Chainweb.Utils.Serialization
 import Chainweb.Version
 import Chainweb.Version.RecapDevelopment
@@ -282,15 +284,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)) $ HS.toList $ chainIds v
+            , nodeHistoricalChains = ruleElems 0 $ fmap (HM.toList . HM.map HS.toList . toAdjacencySets) $ _versionGraphs v
+            , nodeServiceDate = T.pack <$> _versionServiceDate v
+            , nodeBlockDelay = _versionBlockDelay v
             }
 
 -- -------------------------------------------------------------------------- --

test/Chainweb/Test/TestVersions.hs

@@ -128,6 +128,7 @@ testVersionTemplate v = v
     & versionBootstraps .~ [testBootstrapPeerInfos]
     & versionVerifierPluginNames .~ AllChains (End mempty)
     & versionQuirks .~ noQuirks
+    & versionServiceDate .~ Nothing
 
 -- | A set of fork heights which are relatively fast, but not fast enough to break anything.
 fastForks :: HashMap Fork (ChainMap ForkHeight)