Improve / Fix /info Endpoint => DO NOT MERGE NOT TESTED

src/Chainweb/RestAPI/NodeInfo.hs

@@ -39,12 +39,10 @@ import Chainweb.RestAPI.Utils
 import Chainweb.Utils
 import Chainweb.Utils.Rule
 import Chainweb.Version
+import Chainweb.ForkState (ForkNumber)
 
 type NodeInfoApi = "info" :> Get '[JSON] NodeInfo
 
-someNodeInfoApi :: SomeApi
-someNodeInfoApi = SomeApi (Proxy @NodeInfoApi)
-
 someNodeInfoServer :: ChainwebVersion -> CutDb tbl -> SomeServer
 someNodeInfoServer v c =
   SomeServer (Proxy @NodeInfoApi) (nodeInfoHandler v $ someCutDbVal v c)
@@ -63,18 +61,20 @@ data NodeInfo = NodeInfo
   , 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.
-  , nodeLatestBehaviorHeight :: BlockHeight
-    -- ^ Height at which the latest behavior of the node is activated. See
+  , nodeLatestBehaviorHeight :: ForkHeight
+    -- ^ Height or ForkuNumber 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
   , nodeBlockDelay :: BlockDelay
     -- ^ The PoW block delay of the node (microseconds)
+  , nodeForkNumber :: ForkNumber
+    -- ^ The ForkNumber of the given version of the node
   }
   deriving (Show, Eq, Generic)
-  deriving anyclass (ToJSON, FromJSON)
+  deriving anyclass (ToJSON)
 
 nodeInfoHandler :: ChainwebVersion -> SomeCutDb tbl -> Server NodeInfoApi
 nodeInfoHandler v (SomeCutDb (CutDbT db :: CutDbT cas v)) = do
@@ -95,6 +95,7 @@ nodeInfoHandler v (SomeCutDb (CutDbT db :: CutDbT cas v)) = do
       , nodeGenesisHeights = map (\c -> (chainIdToText c, genesisHeight v c)) $ HS.toList (chainIds v)
       , nodeHistoricalChains = ruleElems $ fmap (HM.toList . HM.map HS.toList . toAdjacencySets) $ _versionGraphs v
       , nodeBlockDelay = _versionBlockDelay v
+      , nodeForkNumber = _versionForkNumber v
       }
 
 -- | Converts chainwebGraphs to a simpler structure that has invertible JSON

src/Chainweb/Version.hs

@@ -366,6 +366,12 @@ instance Ord ForkHeight where
 
 makePrisms ''ForkHeight
 
+instance ToJSON ForkHeight where
+    toJSON (ForkAtForkNumber n )= object ["forkNumber" .= n]
+    toJSON (ForkAtBlockHeight h) = object ["blockHeight" .= h]
+    toJSON ForkAtGenesis= String "genesis"
+    toJSON ForkNever = String "never"
+
 succByHeight :: ForkHeight -> ForkHeight
 succByHeight (ForkAtBlockHeight x) = ForkAtBlockHeight $ succ x
 succByHeight ForkNever = ForkNever
@@ -838,15 +844,21 @@ indexByForkHeights v = OnChains . foldl' go (HM.empty <$ HS.toMap (chainIds v))
 
 -- | The block height at all chains at which the latest known behavior changes
 -- will have taken effect: forks, upgrade transactions, or graph changes.
-latestBehaviorAt :: ChainwebVersion -> BlockHeight
-latestBehaviorAt v = foldlOf' behaviorChanges max 0 v + 1
+latestBehaviorAt :: ChainwebVersion -> ForkHeight
+latestBehaviorAt v = foldlOf' behaviorChanges max' ForkAtGenesis v
     where
     behaviorChanges = fold
-        [ versionForks . folded . folded . _ForkAtBlockHeight
-        , versionUpgrades . folded . ifolded . asIndex
-        , versionGraphs . to ruleHead . _1
+        [ versionForks . folded . folded
+        , versionUpgrades . folded . ifolded . asIndex . to ForkAtBlockHeight
+        , versionGraphs . to ruleHead . _1 . to ForkAtBlockHeight
         ]
 
+    -- A special max function that ignores ForkNever
+    max' :: ForkHeight -> ForkHeight -> ForkHeight
+    max' x ForkNever = x
+    max' ForkNever x = x
+    max' x y = max x y
+
 -- | Easy construction of a `ChainMap` with entries for every chain
 -- in a `ChainwebVersion`.
 onAllChains :: Applicative m => ChainwebVersion -> (ChainId -> m a) -> m (ChainMap a)

test/lib/Chainweb/Test/Orphans/Internal.hs

@@ -301,6 +301,7 @@ instance Arbitrary NodeInfo where
             , nodeGenesisHeights = map (\c -> (chainIdToText c, genesisHeight v c)) $ HS.toList $ chainIds v
             , nodeHistoricalChains = ruleElems $ HM.toList . HM.map HS.toList . toAdjacencySets <$> _versionGraphs v
             , nodeBlockDelay = _versionBlockDelay v
+            , nodeForkNumber = _versionForkNumber v
             }
 
 -- -------------------------------------------------------------------------- --

test/lib/Chainweb/Test/Utils.hs

@@ -1018,7 +1018,9 @@ withNodesAtLatestBehavior
     -> ResourceT IO ChainwebNetwork
 withNodesAtLatestBehavior v conf dbDirs = do
     net <- withNodes v conf dbDirs
-    liftIO $ awaitBlockHeight v (_getServiceClientEnv net) (latestBehaviorAt v)
+    liftIO $ case latestBehaviorAt v of
+                ForkAtBlockHeight h -> awaitBlockHeight v (_getServiceClientEnv net) h
+                _ -> assertFailure "Only ForkHeight supported for tests versions"
     return net
 
 -- | Network initialization takes some time. Within my ghci session it took

test/unit/Chainweb/Test/Pact4/PactMultiChainTest.hs

@@ -1294,8 +1294,10 @@ chainweb223Test = do
 compactAndSyncTest :: PactTestM ()
 compactAndSyncTest = do
   -- start with all forks on.
-  let start = latestBehaviorAt testVersion
-  runToHeight start
+  start <- case latestBehaviorAt testVersion of
+              ForkAtBlockHeight height -> runToHeight height >> return height
+              _ -> liftIO $ assertFailure "Only ForkHeight supported for tests versions"
+
   -- we want to run a transaction but it doesn't matter what it does, as long
   -- as it gets on-chain and thus affects the Pact state.
   -- note that this is a decimal because we're parsing the CommandResult out of the payload, and
@@ -1309,8 +1311,10 @@ compactAndSyncTest = do
 
 compactionCompactsUnmodifiedTables :: PactTestM ()
 compactionCompactsUnmodifiedTables = do
-  let start = latestBehaviorAt testVersion
-  runToHeight start
+  start <- case latestBehaviorAt testVersion of
+              ForkAtBlockHeight height -> runToHeight height >> return height
+              _ -> liftIO $ assertFailure "Only ForkHeight supported for tests versions"
+
   runBlockTest
     -- create table
     [ PactTxTest

test/unit/Chainweb/Test/Roundtrips.hs

@@ -63,7 +63,6 @@ import Chainweb.Pact.Types
 import Chainweb.Payload
 import Chainweb.PowHash
 import Chainweb.RestAPI.NetworkID
-import Chainweb.RestAPI.NodeInfo
 import Chainweb.SPV
 import Chainweb.SPV.EventProof
 import Chainweb.SPV.PayloadProof
@@ -286,7 +285,6 @@ jsonTestCases f =
     , testProperty "CutId" $ f @CutId
     , testProperty "CutHashes" $ f @CutHashes
     , testProperty "NodeVersion" $ f @NodeVersion
-    , testProperty "NodeInfo" $ f @NodeInfo
     , testProperty "EnableConfig MiningConfig" $ f @(EnableConfig MiningConfig)
     , testProperty "NextItem Int" $ f @(NextItem Int)
     , testProperty "Page BlockHash BlockHeader" $ f @(Page BlockHash BlockHeader)