From 0148317b68f2fcd3e0cbf6c6f932fdfdb3b80a3d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Robert=20S=C3=B6ldner?= Date: Thu, 11 Sep 2025 09:45:28 +0200 Subject: [PATCH] pact service enforce minimal chainweb version at startup, if required --- chainweb.cabal | 1 + src/Chainweb/Pact/Backend/ChainwebPactDb.hs | 8 + src/Chainweb/Pact/PactService.hs | 24 ++- .../Test/PayloadProvider/StartupTest.hs | 139 ++++++++++++++++++ test/unit/ChainwebTests.hs | 3 + 5 files changed, 174 insertions(+), 1 deletion(-) create mode 100644 test/unit/Chainweb/Test/PayloadProvider/StartupTest.hs diff --git a/chainweb.cabal b/chainweb.cabal index 8dc2706bbc..6a26239283 100644 --- a/chainweb.cabal +++ b/chainweb.cabal @@ -665,6 +665,7 @@ test-suite chainweb-tests Chainweb.Test.TreeDB.RemoteDB Chainweb.Test.Version Test.Chainweb.SPV.Argument + Chainweb.Test.PayloadProvider.StartupTest -- Data Data.Test.PQueue diff --git a/src/Chainweb/Pact/Backend/ChainwebPactDb.hs b/src/Chainweb/Pact/Backend/ChainwebPactDb.hs index ac322d8933..c4804ec3f6 100644 --- a/src/Chainweb/Pact/Backend/ChainwebPactDb.hs +++ b/src/Chainweb/Pact/Backend/ChainwebPactDb.hs @@ -810,6 +810,7 @@ getConsensusState db = do initSchema :: SQLiteEnv -> IO () initSchema sql = withSavepoint sql InitSchemaSavePoint $ throwOnDbError $ do + createChainwebMetaTable createConsensusStateTable createBlockHistoryTable createTableCreationTable @@ -824,6 +825,13 @@ initSchema sql = create tablename = do createVersionedTable tablename sql + createChainwebMetaTable :: ExceptT LocatedSQ3Error IO () + createChainwebMetaTable = do + exec_ sql + "CREATE TABLE IF NOT EXISTS ChainwebMeta \ + \(minMajorVersion INTEGER NOT NULL, \ + \ minMinorVersion INTEGER NOT NULL);" + createConsensusStateTable :: ExceptT LocatedSQ3Error IO () createConsensusStateTable = do exec_ sql diff --git a/src/Chainweb/Pact/PactService.hs b/src/Chainweb/Pact/PactService.hs index 2d7b9b28eb..c4d964f3d6 100644 --- a/src/Chainweb/Pact/PactService.hs +++ b/src/Chainweb/Pact/PactService.hs @@ -52,7 +52,7 @@ import Chainweb.Miner.Pact import Chainweb.Pact.Backend.ChainwebPactDb qualified as ChainwebPactDb import Chainweb.Pact.Backend.ChainwebPactDb qualified as Pact import Chainweb.Pact.Backend.Types -import Chainweb.Pact.Backend.Utils (withSavepoint, SavepointName (..)) +import Chainweb.Pact.Backend.Utils (withSavepoint, SavepointName (..), LocatedSQ3Error) import Chainweb.Pact.NoCoinbase qualified as Pact import Chainweb.Pact.PactService.Checkpointer qualified as Checkpointer import Chainweb.Pact.PactService.ExecBlock @@ -98,6 +98,8 @@ import Data.Monoid import Data.Pool (Pool) import Data.Pool qualified as Pool import Data.Text qualified as Text +import Data.Version (Version(..)) +import Paths_chainweb (version) import Data.Vector (Vector) import Data.Vector qualified as V import Data.Void @@ -117,6 +119,8 @@ import System.LogLevel import Chainweb.Version.Guards (pact5) import Control.Concurrent.MVar (newMVar) import Chainweb.Pact.Payload.RestAPI.Client (payloadClient) +import Pact.Types.SQLite + withPactService :: (Logger logger, CanPayloadCas tbl) @@ -141,6 +145,17 @@ withPactService cid http memPoolAccess chainwebLogger txFailuresCounter pdb read ) liftIO $ ChainwebPactDb.initSchema readWriteSqlenv + + -- Check if the SQLiteEnv requires a minimal version of chainweb to work properly + mMinChainwebVersion <- liftIO $ getMinChainwebVersion readWriteSqlenv + case mMinChainwebVersion of + Nothing -> pure () + Just minVersion -> + if version >= minVersion + then pure () + else error $ "PactService required at least version: " <> show minVersion <> ", currently at: " <> show version + + candidatePdb <- liftIO MapTable.emptyTable moduleInitCacheVar <- liftIO $ newMVar mempty @@ -175,6 +190,13 @@ withPactService cid http memPoolAccess chainwebLogger txFailuresCounter pdb read _ -> liftIO $ initialPayloadState chainwebLogger pse return pse + where + getMinChainwebVersion :: SQLiteEnv -> IO (Maybe Version) + getMinChainwebVersion sql = qry_ sql "SELECT minMajorVersion, minMinorVersion from ChainwebMeta limit 1" [RInt, RInt] >>= \case + [[SInt major, SInt minor]] -> pure $ Just $ Version [fromIntegral major, fromIntegral minor] [] + [] -> pure Nothing + _ -> error "getMinChainwebVersion: incorrect column types" + initialPayloadState :: Logger logger => HasVersion diff --git a/test/unit/Chainweb/Test/PayloadProvider/StartupTest.hs b/test/unit/Chainweb/Test/PayloadProvider/StartupTest.hs new file mode 100644 index 0000000000..9f088d02ce --- /dev/null +++ b/test/unit/Chainweb/Test/PayloadProvider/StartupTest.hs @@ -0,0 +1,139 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Chainweb.Test.PayloadProvider.StartupTest + ( tests + ) where + +import Chainweb.ChainId +import Chainweb.Graph (singletonChainGraph) +import Chainweb.Logger +import Chainweb.Pact.Backend.ChainwebPactDb qualified as ChainwebPactDb +import Chainweb.Pact.Backend.Types +import Chainweb.Pact.PactService +import Chainweb.Pact.Payload.PayloadStore.InMemory +import Chainweb.Pact.Types +import Chainweb.Test.Pact.Utils +import Chainweb.Test.TestVersions +import Chainweb.Test.Utils +import Chainweb.Version +import Control.Exception (try, displayException) +import Control.Exception.Safe (SomeException) +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Trans.Resource +import Data.List +import Data.Maybe +import Data.Version (Version(..)) +import Pact.Types.SQLite +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = testGroup "PayloadProvider.Startup" + [ testMinChainwebVersionValidation + ] + +-- | Helper function for setting up tests with loggerand sqlite +withStartupTestSetup + :: TestName + -> (GenericLogger -> SQLiteEnv -> IO ()) + -> (HasVersion => GenericLogger -> SQLiteEnv -> IO ()) + -> TestTree +withStartupTestSetup name setup action = withResourceT (withTempChainSqlite cid) $ \sqlIO -> do + testCase name $ do + logger <- getTestLogger + (sql, _sqlReadPool) <- sqlIO + + setup logger sql + + withVersion v $ runResourceT $ do + liftIO $ action logger sql + where + cid = unsafeChainId 0 + v = instantCpmTestVersion singletonChainGraph + +-- | Initialize schema for tests +initStartupTestSchema :: GenericLogger -> SQLiteEnv -> IO () +initStartupTestSchema _logger sql = ChainwebPactDb.initSchema sql + +-- | Test that the minimum chainweb version validation works correctly +testMinChainwebVersionValidation :: TestTree +testMinChainwebVersionValidation = withStartupTestSetup "minimum chainweb version validation" + initStartupTestSchema + $ \logger sql -> do + -- Test with no existing version - should succeed + pdb <- newPayloadDb + + result1 <- try @SomeException $ runResourceT $ withPactService cid Nothing mempty logger Nothing pdb pool sql cfg genesis + case result1 of + Left e + | "PactService required at least version:" `isInfixOf` displayException e -> + liftIO $ assertFailure $ "PactService should start successfully when no minimum version is set: " <> displayException e + _ -> return () + + let version2 = Version [2, 2] [] + setMinChainwebVersion sql version2 + + version2' <- getMinChainwebVersion sql + liftIO $ assertEqual "Should return the set version" (Just version2) version2' + + + result2 <- try @SomeException $ runResourceT $ withPactService cid Nothing mempty logger Nothing pdb pool sql cfg genesis + case result2 of + Left e + | "PactService required at least version:" `isInfixOf` displayException e -> + liftIO $ assertFailure $ "PactService should start successfully when no minimum version is set: " <> displayException e + _ -> return () + + let version3 = Version [200, 2] [] + setMinChainwebVersion sql version3 + + version3' <- getMinChainwebVersion sql + liftIO $ assertEqual "Should return the set version" (Just version3) version3' + + result3 <- try @SomeException $ runResourceT $ withPactService cid Nothing mempty logger Nothing pdb pool sql cfg genesis + case result3 of + Left e + | "PactService required at least version:" `isInfixOf` displayException e -> + pure () + _ -> liftIO $ assertFailure $ "PactService should not start successfully when minimum version is not reached" + + where + cid = unsafeChainId 0 + cfg = defaultPactServiceConfig + genesis = GeneratingGenesis + pool = error "Pool not needed for this test" + + +-- Helper functions (copied from PactService.hs local where clause) +getMinChainwebVersion :: SQLiteEnv -> IO (Maybe Version) +getMinChainwebVersion sql = qry_ sql "SELECT minMajorVersion, minMinorVersion from ChainwebMeta limit 1" [RInt, RInt] >>= \case + [[SInt major, SInt minor]] -> pure $ Just $ Version [fromIntegral major, fromIntegral minor] [] + [] -> pure Nothing + _ -> error "incorrect column types" + +setMinChainwebVersion :: SQLiteEnv -> Version -> IO () +setMinChainwebVersion sql (Version (major:minor:_) _) = do + mMinVersion <- getMinChainwebVersion sql + if isJust mMinVersion + then + void $ qry sql + "UPDATE ChainwebMeta \ + \SET minMajorVersion = ?, minMinorVersion = ?" + [SInt (fromIntegral major), SInt (fromIntegral minor)] [RInt] + else + void $ qry sql + "INSERT INTO ChainwebMeta (minMajorVersion, minMinorVersion) VALUES (?, ?)" + [SInt (fromIntegral major), SInt (fromIntegral minor)] [RInt] +setMinChainwebVersion _ (Version _ _) = + error "version formatting does not match" diff --git a/test/unit/ChainwebTests.hs b/test/unit/ChainwebTests.hs index a1180373f2..7eb2660614 100644 --- a/test/unit/ChainwebTests.hs +++ b/test/unit/ChainwebTests.hs @@ -46,6 +46,7 @@ import Chainweb.Test.Pact4.RewardsTest qualified import Chainweb.Test.Pact4.SQLite qualified import Chainweb.Test.Pact4.TransactionTests qualified import Chainweb.Test.Pact4.VerifierPluginTest qualified +import Chainweb.Test.PayloadProvider.StartupTest qualified (tests) import Chainweb.Test.RestAPI qualified (tests) import Chainweb.Test.Roundtrips qualified (tests) import Chainweb.Test.Sync.WebBlockHeaderStore qualified (properties) @@ -65,6 +66,7 @@ import Test.Tasty import Test.Tasty.JsonReporter import Test.Tasty.QuickCheck + setTestLogLevel :: LogLevel -> IO () setTestLogLevel l = setEnv "CHAINWEB_TEST_LOG_LEVEL" (show l) @@ -131,6 +133,7 @@ suite rdb = , Chainweb.Test.BlockHeader.Genesis.tests , Chainweb.Test.BlockHeader.Validation.tests , Chainweb.Test.Version.tests + , Chainweb.Test.PayloadProvider.StartupTest.tests , testProperties "Chainweb.Test.Chainweb.Utils.Paging" Chainweb.Test.Chainweb.Utils.Paging.properties , testProperties "Chainweb.Test.HostAddress" Chainweb.Test.HostAddress.properties , testProperties "Chainweb.Test.Sync.WebBlockHeaderStore" Chainweb.Test.Sync.WebBlockHeaderStore.properties