From 80856adcfe57138e30f98bf2319a2c8f648d7a54 Mon Sep 17 00:00:00 2001 From: KadenaFriend <241389759+kdafriend@users.noreply.github.com> Date: Fri, 17 Jul 2026 08:16:17 +0000 Subject: [PATCH 1/4] JSONify ForkHeight --- src/Chainweb/Version.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/Chainweb/Version.hs b/src/Chainweb/Version.hs index 0319d7610d..a4ce8ddfa9 100644 --- a/src/Chainweb/Version.hs +++ b/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 From f54239a7c455984e134722a339904232bfe95601 Mon Sep 17 00:00:00 2001 From: KadenaFriend <241389759+kdafriend@users.noreply.github.com> Date: Fri, 17 Jul 2026 08:21:29 +0000 Subject: [PATCH 2/4] latestBehaviorAt returns a ForkHeight --- src/Chainweb/RestAPI/NodeInfo.hs | 4 ++-- src/Chainweb/Version.hs | 16 +++++++++++----- test/lib/Chainweb/Test/Utils.hs | 4 +++- .../Chainweb/Test/Pact4/PactMultiChainTest.hs | 12 ++++++++---- 4 files changed, 24 insertions(+), 12 deletions(-) diff --git a/src/Chainweb/RestAPI/NodeInfo.hs b/src/Chainweb/RestAPI/NodeInfo.hs index 56ee7b05f2..0c13f35781 100644 --- a/src/Chainweb/RestAPI/NodeInfo.hs +++ b/src/Chainweb/RestAPI/NodeInfo.hs @@ -63,8 +63,8 @@ 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. diff --git a/src/Chainweb/Version.hs b/src/Chainweb/Version.hs index a4ce8ddfa9..4d0569ccd2 100644 --- a/src/Chainweb/Version.hs +++ b/src/Chainweb/Version.hs @@ -844,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) diff --git a/test/lib/Chainweb/Test/Utils.hs b/test/lib/Chainweb/Test/Utils.hs index 2f519dba7c..3c70777c26 100644 --- a/test/lib/Chainweb/Test/Utils.hs +++ b/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 diff --git a/test/unit/Chainweb/Test/Pact4/PactMultiChainTest.hs b/test/unit/Chainweb/Test/Pact4/PactMultiChainTest.hs index b5eff22709..b9735ccbea 100644 --- a/test/unit/Chainweb/Test/Pact4/PactMultiChainTest.hs +++ b/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 From 494f912976615d7bb5d4a4a5e380a483877226eb Mon Sep 17 00:00:00 2001 From: KadenaFriend <241389759+kdafriend@users.noreply.github.com> Date: Fri, 17 Jul 2026 08:24:28 +0000 Subject: [PATCH 3/4] Lift fromJSON constraint of NodeInfo --- src/Chainweb/RestAPI/NodeInfo.hs | 5 +---- test/unit/Chainweb/Test/Roundtrips.hs | 2 -- 2 files changed, 1 insertion(+), 6 deletions(-) diff --git a/src/Chainweb/RestAPI/NodeInfo.hs b/src/Chainweb/RestAPI/NodeInfo.hs index 0c13f35781..c03cb89b1a 100644 --- a/src/Chainweb/RestAPI/NodeInfo.hs +++ b/src/Chainweb/RestAPI/NodeInfo.hs @@ -42,9 +42,6 @@ import Chainweb.Version 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) @@ -74,7 +71,7 @@ data NodeInfo = NodeInfo -- ^ The PoW block delay of the node (microseconds) } 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 diff --git a/test/unit/Chainweb/Test/Roundtrips.hs b/test/unit/Chainweb/Test/Roundtrips.hs index 3a08a751dc..69880b084c 100644 --- a/test/unit/Chainweb/Test/Roundtrips.hs +++ b/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) From e743c92f32058c2d148d549fb4d0eb4344d26d7a Mon Sep 17 00:00:00 2001 From: KadenaFriend <241389759+kdafriend@users.noreply.github.com> Date: Fri, 17 Jul 2026 08:25:12 +0000 Subject: [PATCH 4/4] Add current node ForkNumber in NodeInfo --- src/Chainweb/RestAPI/NodeInfo.hs | 4 ++++ test/lib/Chainweb/Test/Orphans/Internal.hs | 1 + 2 files changed, 5 insertions(+) diff --git a/src/Chainweb/RestAPI/NodeInfo.hs b/src/Chainweb/RestAPI/NodeInfo.hs index c03cb89b1a..3534c8da3f 100644 --- a/src/Chainweb/RestAPI/NodeInfo.hs +++ b/src/Chainweb/RestAPI/NodeInfo.hs @@ -39,6 +39,7 @@ import Chainweb.RestAPI.Utils import Chainweb.Utils import Chainweb.Utils.Rule import Chainweb.Version +import Chainweb.ForkState (ForkNumber) type NodeInfoApi = "info" :> Get '[JSON] NodeInfo @@ -69,6 +70,8 @@ data NodeInfo = NodeInfo -- ^ 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) @@ -92,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 diff --git a/test/lib/Chainweb/Test/Orphans/Internal.hs b/test/lib/Chainweb/Test/Orphans/Internal.hs index 1618adc9bd..e4da71b1a3 100644 --- a/test/lib/Chainweb/Test/Orphans/Internal.hs +++ b/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 } -- -------------------------------------------------------------------------- --