diff --git a/src/Chainweb/RestAPI/NodeInfo.hs b/src/Chainweb/RestAPI/NodeInfo.hs index 56ee7b05f2..3534c8da3f 100644 --- a/src/Chainweb/RestAPI/NodeInfo.hs +++ b/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,8 +61,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. @@ -72,9 +70,11 @@ 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, 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 diff --git a/src/Chainweb/Version.hs b/src/Chainweb/Version.hs index 0319d7610d..4d0569ccd2 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 @@ -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) 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 } -- -------------------------------------------------------------------------- -- 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 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)