From afb8810e9a3a4fec71a52086def9bccd696b25eb Mon Sep 17 00:00:00 2001 From: chessai Date: Mon, 9 Dec 2024 17:07:21 -0600 Subject: [PATCH 1/2] expose the CutDB store getter Change-Id: Idde5c6b6c55c4fb06f6442a9f0693a3ef7381938 --- src/Chainweb/CutDB.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Chainweb/CutDB.hs b/src/Chainweb/CutDB.hs index e86f7bb351..3e2db5693d 100644 --- a/src/Chainweb/CutDB.hs +++ b/src/Chainweb/CutDB.hs @@ -52,6 +52,7 @@ module Chainweb.CutDB , pruneCuts , cutDbWebBlockHeaderDb , cutDbBlockHeaderDb +, cutDbStore , cutDbPayloadDb , cutDbPactService , cut @@ -280,6 +281,10 @@ cutDbPactService :: Getter (CutDb tbl) WebPactExecutionService cutDbPactService = to $ _webBlockPayloadStorePact . _cutDbPayloadStore {-# INLINE cutDbPactService #-} +cutDbStore :: Getter (CutDb tbl) (Casify RocksDbTable CutHashes) +cutDbStore = to _cutDbCutStore +{-# INLINE cutDbStore #-} + cutDbPayloadStore :: Getter (CutDb tbl) (WebBlockPayloadStore tbl) cutDbPayloadStore = to _cutDbPayloadStore {-# INLINE cutDbPayloadStore #-} From efdd7eccc5a604ff93aa05b9e2ba95c3390d8c8d Mon Sep 17 00:00:00 2001 From: chessai Date: Mon, 9 Dec 2024 17:07:44 -0600 Subject: [PATCH 2/2] implement X-Min-Block-Height http header Change-Id: If4b86fedafcbe1962f5a59807fe66b2c420b2260 --- src/Chainweb/Chainweb.hs | 21 ++++++++++++++++++++- test/unit/Chainweb/Test/RestAPI.hs | 2 +- 2 files changed, 21 insertions(+), 2 deletions(-) diff --git a/src/Chainweb/Chainweb.hs b/src/Chainweb/Chainweb.hs index 71a2dc7465..12cc7e3734 100644 --- a/src/Chainweb/Chainweb.hs +++ b/src/Chainweb/Chainweb.hs @@ -7,6 +7,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NumericUnderscores #-} @@ -133,6 +134,7 @@ import Network.Wai.Middleware.Throttle import Prelude hiding (log) +import Streaming.Prelude qualified as S import System.Clock import System.LogLevel @@ -141,6 +143,7 @@ import System.LogLevel import Chainweb.Backup import Chainweb.BlockHeader import Chainweb.BlockHeaderDB (BlockHeaderDb) +import Chainweb.BlockHeight (BlockHeight) import Chainweb.ChainId import Chainweb.Chainweb.ChainResources import Chainweb.Chainweb.Configuration @@ -168,6 +171,7 @@ import Chainweb.Payload.PayloadStore.RocksDB import Chainweb.RestAPI import Chainweb.RestAPI.NetworkID import Chainweb.Transaction +import Chainweb.TreeDB (getBranchIncreasing) import Chainweb.Utils import Chainweb.Utils.RequestLog import Chainweb.Version @@ -721,14 +725,24 @@ runChainweb cw nowServing = do mkValidationMiddleware else return id - concurrentlies_ + -- Get the minimum blockheight across all chains starting from the cut that the node starts with + cutHeaders <- readHighestCutHeaders (_chainwebVersion cw) (logFunctionText $ _chainwebLogger cw) (cutDb ^. cutDbWebBlockHeaderDb) (cutDb ^. cutDbStore) + minBlockHeight <- fmap (minimum . fmap (view blockHeight) . catMaybes) $ forM (HM.toList (cutDb ^. cutDbWebBlockHeaderDb ^. webBlockHeaderDb)) $ \(cid, blockHeaderDb) -> do + case cutHeaders ^? ix cid of + Nothing -> do + return Nothing + Just latestHeader -> do + getBranchIncreasing blockHeaderDb latestHeader 0 $ \branch -> do + S.head_ branch + concurrentlies_ -- 1. Start serving Rest API [ (if tls then serve else servePlain) $ httpLog . throttle (_chainwebPutPeerThrottler cw) . throttle (_chainwebMempoolThrottler cw) . throttle (_chainwebThrottler cw) + . minBlockHeightMiddleware minBlockHeight . p2pRequestSizeLimit . p2pValidationMiddleware @@ -740,6 +754,7 @@ runChainweb cw nowServing = do serveServiceApi $ serviceHttpLog . serviceRequestSizeLimit + . minBlockHeightMiddleware minBlockHeight . serviceApiValidationMiddleware ] @@ -966,3 +981,7 @@ runChainweb cw nowServing = do enabled conf = do logg Info "Mempool p2p sync enabled" return $ map (runMempoolSyncClient mgr conf (_chainwebPeer cw)) chainVals + + minBlockHeightMiddleware :: BlockHeight -> Middleware + minBlockHeightMiddleware minBlockHeight app req respond = app req $ \response -> + respond (mapResponseHeaders (("X-Min-Block-Height", sshow minBlockHeight) :) response) \ No newline at end of file diff --git a/test/unit/Chainweb/Test/RestAPI.hs b/test/unit/Chainweb/Test/RestAPI.hs index d1deea3e84..ac5fa69216 100644 --- a/test/unit/Chainweb/Test/RestAPI.hs +++ b/test/unit/Chainweb/Test/RestAPI.hs @@ -147,7 +147,7 @@ simpleSessionTests rdb tls = httpHeaderTests :: IO TestClientEnv_ -> ChainId -> TestTree httpHeaderTests envIO cid = - testGroup ("http header tests for chain " <> sshow cid) + testGroup ("http header tests for chain " <> T.unpack (chainIdToText cid)) [ testCase "headerClient" $ go $ \v h -> headerClient' v cid (key h) , testCase "headersClient" $ go $ \v _ -> headersClient' v cid Nothing Nothing Nothing Nothing , testCase "blocksClient" $ go $ \v _ -> blocksClient' v cid Nothing Nothing Nothing Nothing