From 334d604291bcbc79e1097f323fa841ae1f8a5589 Mon Sep 17 00:00:00 2001 From: KadenaFriend <241389759+kdafriend@users.noreply.github.com> Date: Fri, 16 Jan 2026 17:13:54 +0000 Subject: [PATCH 1/4] Implement InitialGasModel --- chainweb.cabal | 1 + src/Chainweb/Pact/PactService.hs | 2 +- .../Pact/PactService/Pact5/ExecBlock.hs | 3 +- src/Chainweb/Pact5/InitialGasModel.hs | 77 +++++++++++++++++++ src/Chainweb/Pact5/TransactionExec.hs | 47 +++++------ src/Chainweb/Version.hs | 4 + src/Chainweb/Version/Development.hs | 2 + src/Chainweb/Version/Guards.hs | 8 ++ src/Chainweb/Version/Mainnet.hs | 5 ++ src/Chainweb/Version/RecapDevelopment.hs | 7 ++ src/Chainweb/Version/Testnet04.hs | 5 ++ test/lib/Chainweb/Test/TestVersions.hs | 4 + 12 files changed, 137 insertions(+), 28 deletions(-) create mode 100644 src/Chainweb/Pact5/InitialGasModel.hs diff --git a/chainweb.cabal b/chainweb.cabal index 6539136bd4..ff344feee1 100644 --- a/chainweb.cabal +++ b/chainweb.cabal @@ -343,6 +343,7 @@ library , Chainweb.Pact5.TransactionExec , Chainweb.Pact5.Types , Chainweb.Pact5.Validations + , Chainweb.Pact5.InitialGasModel , Chainweb.Pact.Transactions.FungibleV2Transactions , Chainweb.Pact.Transactions.CoinV3Transactions , Chainweb.Pact.Transactions.CoinV4Transactions diff --git a/src/Chainweb/Pact/PactService.hs b/src/Chainweb/Pact/PactService.hs index 0852ac0c3f..2227666bcd 100644 --- a/src/Chainweb/Pact/PactService.hs +++ b/src/Chainweb/Pact/PactService.hs @@ -918,7 +918,7 @@ execLocal cwtx preflight sigVerify rdepth = pactLabel "execLocal" $ do lift (Pact5.liftPactServiceM (Pact5.assertPreflightMetadata (view Pact5.payloadObj <$> pact5Cmd) txCtx sigVerify)) >>= \case Left err -> earlyReturn $ review _MetadataValidationFailure err Right () -> return () - let initialGas = Pact5.initialGasOf v cid (Pact5.ctxCurrentBlockHeight txCtx) $ Pact5._cmdPayload pact5Cmd + let initialGas = Pact5.initialGasOf v cid (Pact5.ctxCurrentBlockHeight txCtx) (Pact5.ctxParentForkNumber txCtx) pact5Cmd applyCmdResult <- lift $ Pact5.pactTransaction Nothing (\dbEnv -> Pact5.applyCmd _psLogger _psGasLogger dbEnv diff --git a/src/Chainweb/Pact/PactService/Pact5/ExecBlock.hs b/src/Chainweb/Pact/PactService/Pact5/ExecBlock.hs index 44f5bc2b50..567da7aa93 100644 --- a/src/Chainweb/Pact/PactService/Pact5/ExecBlock.hs +++ b/src/Chainweb/Pact/PactService/Pact5/ExecBlock.hs @@ -359,7 +359,8 @@ applyPactCmd env miner txIdxInBlock tx = StateT $ \(blockHandle, blockGasRemaini (unsafeApplyPactCmd blockHandle (initialGasOf (_chainwebVersion env) (Chainweb.Version._chainId env) (env ^. psParentHeader . parentHeader . blockHeight) - (tx ^. Pact5.cmdPayload)) + (env ^. psParentHeader . parentHeader . blockForkNumber) + tx) alteredTx) env case resultOrGasError of diff --git a/src/Chainweb/Pact5/InitialGasModel.hs b/src/Chainweb/Pact5/InitialGasModel.hs new file mode 100644 index 0000000000..80403385c1 --- /dev/null +++ b/src/Chainweb/Pact5/InitialGasModel.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE BangPatterns #-} + +module Chainweb.Pact5.InitialGasModel + ( InitialGasModel(..) + , pre31GasModel + , post31GasModel + , post32GasModel + -- Lenses + , feePerByte + , rawPayloadSizeFactor + , proofSizeFactor + , signatureSizeFactor + , sizePenalty + , signatureCost + ) where + +import Control.DeepSeq +import Pact.Core.Scheme +import Control.Lens + + +data InitialGasModel = InitialGasModel + { _feePerByte :: Rational + -- ^ Base Price charged per byte + , _rawPayloadSizeFactor :: Rational + -- ^ Multiplier for the raw payload (without continuation proof) size + , _proofSizeFactor :: Rational + -- ^ Multiplier for the proof size + , _signatureSizeFactor :: Rational + -- ^ Multiplier for signatures size + , _sizePenalty :: Rational -> Rational + -- ^ Function used to compute a penalty for big transactions + , _signatureCost :: PPKScheme -> Rational + -- ^ Function used to compute a fixed amount of gas per signature + } + +-- Required to be used as a rule +instance NFData InitialGasModel where + rnf (InitialGasModel {}) = () + +makeLenses ''InitialGasModel + +pre31GasModel :: InitialGasModel +pre31GasModel = InitialGasModel + { _feePerByte = 0.01 + , _rawPayloadSizeFactor = 1.0 + , _proofSizeFactor = 0.0 + , _signatureSizeFactor = 0.0 + , _sizePenalty = \x -> (x / 512) ^ (7 :: Integer) + , _signatureCost = const 0.0 + } + + +post31GasModel :: InitialGasModel +post31GasModel = InitialGasModel + { _feePerByte = 0.01 + , _rawPayloadSizeFactor = 1.0 + , _proofSizeFactor = 1.0 + , _signatureSizeFactor = 0.0 + , _sizePenalty = \x -> (x / 512) ^ (7 :: Integer) + , _signatureCost = const 0.0 + } + + +post32GasModel :: InitialGasModel +post32GasModel = InitialGasModel + { _feePerByte = 0.01 + , _rawPayloadSizeFactor = 1.0 + , _proofSizeFactor = 1.0 + , _signatureSizeFactor = 1.0 + , _sizePenalty = \x -> (x / 512) ^ (7 :: Integer) + , _signatureCost = \case + ED25519 -> 10.0 -- | TODO => Needs to be benchmarked + WebAuthn -> 10.0 -- | + } diff --git a/src/Chainweb/Pact5/TransactionExec.hs b/src/Chainweb/Pact5/TransactionExec.hs index 3be1e01d5b..eb21f7933c 100644 --- a/src/Chainweb/Pact5/TransactionExec.hs +++ b/src/Chainweb/Pact5/TransactionExec.hs @@ -86,6 +86,7 @@ import Pact.Core.Hash import Pact.Core.Info import Pact.Core.Names import Pact.Core.Namespace +import Pact.Core.Scheme (defPPKScheme) import Pact.Core.PactValue import Pact.Core.Persistence.Types hiding (GasM(..)) import Pact.Core.Persistence.Utils (ignoreGas) @@ -103,11 +104,13 @@ import Chainweb.BlockCreationTime import Chainweb.BlockHash import Chainweb.BlockHeader import Chainweb.BlockHeight +import Chainweb.ForkState import Chainweb.Logger import Chainweb.Miner.Pact import Chainweb.Pact.Types import Chainweb.Pact5.Templates import Chainweb.Pact5.Types +import Chainweb.Pact5.InitialGasModel import Chainweb.Time import Chainweb.Pact5.Transaction @@ -977,33 +980,25 @@ redeemGas logger db txCtx gasUsed maybeFundTxPactId cmd -- -- Utilities -- | Initial gas charged for transaction size --- ignoring the size of a continuation proof, if present --- -initialGasOf :: ChainwebVersion -> V.ChainId -> BlockHeight -> PayloadWithText meta ParsedCode -> Gas -initialGasOf v cid bh payload = Gas gasFee - where - feePerByte :: Rational = 0.01 - - contProofSize = - case payload ^. payloadObj . pPayload of - Continuation (ContMsg _ _ _ _ (Just (ContProof p))) -> B.length p - _ -> 0 - txSize - | chainweb31 v cid bh = SB.length (payload ^. payloadBytes) - | otherwise = SB.length (payload ^. payloadBytes) - contProofSize - - costPerByte = fromIntegral txSize * feePerByte - sizePenalty = txSizeAccelerationFee costPerByte - gasFee = ceiling (costPerByte + sizePenalty) -{-# INLINE initialGasOf #-} - -txSizeAccelerationFee :: Rational -> Rational -txSizeAccelerationFee costPerByte = total +initialGasOf :: ChainwebVersion -> V.ChainId -> BlockHeight -> ForkNumber -> Transaction -> Gas +initialGasOf v cid bh fn tx = Gas $ ceiling $ sizeCost + sizePenaltyCost + sigsCost where - total = (costPerByte / bytePenalty) ^ power - bytePenalty = 512 - power :: Integer = 7 -{-# INLINE txSizeAccelerationFee #-} + model = activeInitialGasModel v cid fn bh + proofSize = case tx ^. cmdPayload . payloadObj . pPayload of + Continuation (ContMsg _ _ _ _ (Just (ContProof p))) -> B.length p + _ -> 0 + + rawSize = SB.length (tx ^. cmdPayload . payloadBytes) - proofSize + sigsSize = sum $ map (B.length . J.encodeStrict) $ tx ^. cmdSigs + + sizeCost = model ^. feePerByte * ( model ^. rawPayloadSizeFactor * fromIntegral rawSize + + model ^. proofSizeFactor * fromIntegral proofSize + + model ^. signatureSizeFactor * fromIntegral sigsSize) + sizePenaltyCost = (model ^. sizePenalty) sizeCost + + sigsCost = sum $ map ((model ^. signatureCost) . fromMaybe defPPKScheme . view siScheme) + $ tx ^. cmdPayload . payloadObj . pSigners + -- | Chainweb's namespace policy for ordinary transactions. -- Doesn't allow installing modules in the root namespace. diff --git a/src/Chainweb/Version.hs b/src/Chainweb/Version.hs index 0319d7610d..521ac02e07 100644 --- a/src/Chainweb/Version.hs +++ b/src/Chainweb/Version.hs @@ -70,6 +70,7 @@ module Chainweb.Version , versionGraphs , versionHeaderBaseSizeBytes , versionMaxBlockGasLimit + , versionInitialGasModel , versionSpvProofRootValidWindow , versionName , versionWindow @@ -184,6 +185,7 @@ import Chainweb.MerkleUniverse import Chainweb.Payload import Chainweb.Pact4.Transaction qualified as Pact4 import Chainweb.Pact5.Transaction qualified as Pact5 +import Chainweb.Pact5.InitialGasModel import Chainweb.ForkState import Chainweb.Utils import Chainweb.Utils.Rule @@ -539,6 +541,8 @@ data ChainwebVersion , _versionSpvProofRootValidWindow :: Rule ForkHeight (Maybe Word64) -- ^ The minimum number of block headers a chainweb node should -- retain in its history at all times. + , _versionInitialGasModel :: ChainMap (Rule ForkHeight (InitialGasModel)) + -- ^ The initial gas model used for Pact 5 transactions processing , _versionBootstraps :: [PeerInfo] -- ^ The locations of the bootstrap peers. , _versionGenesis :: VersionGenesis diff --git a/src/Chainweb/Version/Development.hs b/src/Chainweb/Version/Development.hs index 9084dd81e3..93541028d5 100644 --- a/src/Chainweb/Version/Development.hs +++ b/src/Chainweb/Version/Development.hs @@ -12,6 +12,7 @@ import qualified Data.Set as Set import Chainweb.BlockCreationTime import Chainweb.ChainId import Chainweb.Difficulty +import Chainweb.Pact5.InitialGasModel import Chainweb.Graph import Chainweb.Time import Chainweb.Utils @@ -52,6 +53,7 @@ devnet = ChainwebVersion -- defaultChainwebConfiguration._configBlockGasLimit , _versionMaxBlockGasLimit = Bottom (minBound, Nothing) , _versionSpvProofRootValidWindow = Bottom (minBound, Nothing) + , _versionInitialGasModel = AllChains $ Bottom (minBound, post32GasModel) , _versionCheats = VersionCheats { _disablePow = True , _fakeFirstEpochStart = True diff --git a/src/Chainweb/Version/Guards.hs b/src/Chainweb/Version/Guards.hs index 3c1e631409..5335586fac 100644 --- a/src/Chainweb/Version/Guards.hs +++ b/src/Chainweb/Version/Guards.hs @@ -57,6 +57,7 @@ module Chainweb.Version.Guards , pact4ParserVersion , maxBlockGasLimit , minimumBlockHeaderHistory + , activeInitialGasModel , validPPKSchemes , isWebAuthnPrefixLegal , validKeyFormats @@ -75,6 +76,7 @@ import Chainweb.Pact4.Transaction qualified as Pact4 import Chainweb.Utils.Rule import Chainweb.ForkState import Chainweb.Version +import Chainweb.Pact5.InitialGasModel import Control.Lens import Data.Word (Word64) import Numeric.Natural @@ -348,6 +350,12 @@ minimumBlockHeaderHistory v fn bh = snd $ ruleZipperHere $ snd where searchKey = ForkAtBlockHeight bh `max` ForkAtForkNumber fn +activeInitialGasModel :: ChainwebVersion -> ChainId -> ForkNumber -> BlockHeight -> InitialGasModel +activeInitialGasModel v cid fn bh = snd $ ruleZipperHere $ snd + $ ruleSeek (\h _ -> searchKey >= h) $ v ^?! versionInitialGasModel . atChain cid + where + searchKey = ForkAtBlockHeight bh `max` ForkAtForkNumber fn + -- | Different versions of Chainweb allow different PPKSchemes. -- validPPKSchemes :: ChainwebVersion -> ChainId -> BlockHeight -> [PPKScheme] diff --git a/src/Chainweb/Version/Mainnet.hs b/src/Chainweb/Version/Mainnet.hs index d7a460da7e..16c24730f1 100644 --- a/src/Chainweb/Version/Mainnet.hs +++ b/src/Chainweb/Version/Mainnet.hs @@ -16,6 +16,7 @@ import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Difficulty import Chainweb.Graph +import Chainweb.Pact5.InitialGasModel import Chainweb.Time import Chainweb.Utils import Chainweb.Utils.Rule @@ -166,6 +167,10 @@ mainnet = ChainwebVersion , _versionMaxBlockGasLimit = (succByHeight $ mainnet ^?! versionForks . at Chainweb216Pact . _Just . atChain (unsafeChainId 0), Just 180_000) `Above` Bottom (minBound, Nothing) + , _versionInitialGasModel = AllChains $ + (ForkNever, post32GasModel) `Above` + (succByHeight $ mainnet ^?! versionForks . at Chainweb231Pact . _Just . atChain (unsafeChainId 0), post31GasModel) `Above` + Bottom (minBound, pre31GasModel) , _versionSpvProofRootValidWindow = (succByHeight $ mainnet ^?! versionForks . at Chainweb31 . _Just . atChain (unsafeChainId 0), Nothing) `Above` (succByHeight $ mainnet ^?! versionForks . at Chainweb231Pact . _Just . atChain (unsafeChainId 0) , Just 20_000) `Above` diff --git a/src/Chainweb/Version/RecapDevelopment.hs b/src/Chainweb/Version/RecapDevelopment.hs index a21a423cbb..dd5ceeb248 100644 --- a/src/Chainweb/Version/RecapDevelopment.hs +++ b/src/Chainweb/Version/RecapDevelopment.hs @@ -9,10 +9,12 @@ module Chainweb.Version.RecapDevelopment(recapDevnet, pattern RecapDevelopment) import qualified Data.HashMap.Strict as HM import qualified Data.Set as Set +import Control.Lens import Chainweb.BlockCreationTime import Chainweb.BlockHeight import Chainweb.ChainId +import Chainweb.Pact5.InitialGasModel import Chainweb.Difficulty import Chainweb.Graph import Chainweb.Time @@ -113,6 +115,11 @@ recapDevnet = ChainwebVersion } , _versionMaxBlockGasLimit = Bottom (minBound, Just 180_000) + , _versionInitialGasModel = AllChains $ + (ForkNever, post32GasModel) `Above` + (succByHeight $ recapDevnet ^?! versionForks . at Chainweb231Pact . _Just . atChain (unsafeChainId 0), post31GasModel) `Above` + Bottom (minBound, pre31GasModel) + , _versionSpvProofRootValidWindow = Bottom (minBound, Nothing) , _versionCheats = VersionCheats { _disablePow = False diff --git a/src/Chainweb/Version/Testnet04.hs b/src/Chainweb/Version/Testnet04.hs index ef5ffe7b59..a98d9d4b33 100644 --- a/src/Chainweb/Version/Testnet04.hs +++ b/src/Chainweb/Version/Testnet04.hs @@ -16,6 +16,7 @@ import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Difficulty import Chainweb.Graph +import Chainweb.Pact5.InitialGasModel import Chainweb.Time import Chainweb.Utils import Chainweb.Utils.Rule @@ -146,6 +147,10 @@ testnet04 = ChainwebVersion , _versionMaxBlockGasLimit = (succByHeight $ testnet04 ^?! versionForks . at Chainweb216Pact . _Just . atChain (unsafeChainId 0) , Just 180_000) `Above` Bottom (minBound, Nothing) + , _versionInitialGasModel = AllChains $ + (ForkNever, post32GasModel) `Above` + (succByHeight $ testnet04 ^?! versionForks . at Chainweb231Pact . _Just . atChain (unsafeChainId 0), post31GasModel) `Above` + Bottom (minBound, pre31GasModel) , _versionSpvProofRootValidWindow = (succByHeight $ testnet04 ^?! versionForks . at Chainweb231Pact . _Just . atChain (unsafeChainId 0) , Just 20_000) `Above` Bottom (minBound, Nothing) diff --git a/test/lib/Chainweb/Test/TestVersions.hs b/test/lib/Chainweb/Test/TestVersions.hs index 8f24d89ac9..f19f03d63e 100644 --- a/test/lib/Chainweb/Test/TestVersions.hs +++ b/test/lib/Chainweb/Test/TestVersions.hs @@ -51,6 +51,7 @@ import Chainweb.Difficulty import Chainweb.ForkState import Chainweb.Graph import Chainweb.HostAddress +import Chainweb.Pact5.InitialGasModel import Chainweb.Pact.Utils import Chainweb.Time import Chainweb.Utils @@ -166,6 +167,7 @@ testVersionTemplate v = v & versionWindow .~ WindowWidth 120 & versionMaxBlockGasLimit .~ Bottom (minBound, Just 2_000_000) & versionSpvProofRootValidWindow .~ Bottom (minBound, Just 20) + & versionInitialGasModel .~ AllChains (Bottom (minBound, pre31GasModel)) & versionBootstraps .~ [testBootstrapPeerInfos] & versionVerifierPluginNames .~ AllChains (Bottom (minBound, mempty)) & versionForkNumber .~ 0 @@ -478,6 +480,8 @@ pact5InstantCpmTestVersion :: Bool -> ChainGraph -> ChainwebVersion pact5InstantCpmTestVersion migrate g = buildTestVersion $ \v -> v & cpmTestVersion g & versionName .~ ChainwebVersionName ("instant-pact5-CPM-" <> toText g <> if migrate then "-migrate" else "") + -- Used to check gas for xChain -- + & versionInitialGasModel .~ AllChains (Bottom (minBound, post31GasModel)) & versionForks .~ tabulateHashMap (\case -- SPV Bridge is not in effect for Pact 5 yet. SPVBridge -> AllChains ForkNever From 4547ae1849978a65fd7cbc743a9399c94a689492 Mon Sep 17 00:00:00 2001 From: KadenaFriend <241389759+kdafriend@users.noreply.github.com> Date: Wed, 4 Feb 2026 12:23:40 +0000 Subject: [PATCH 2/4] Allow PactServicesTests to handle multi-chains tests --- .../Chainweb/Test/Pact5/PactServiceTest.hs | 41 ++++++++++++------- 1 file changed, 26 insertions(+), 15 deletions(-) diff --git a/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs b/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs index bebdab284d..44f7d31920 100644 --- a/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs +++ b/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs @@ -27,7 +27,7 @@ import Chainweb.BlockHeader import Chainweb.ChainId import Chainweb.Chainweb import Chainweb.Cut -import Chainweb.Graph (singletonChainGraph) +import Chainweb.Graph (singletonChainGraph, pairChainGraph) import Chainweb.Logger import Chainweb.Mempool.Consensus import Chainweb.Mempool.InMem @@ -45,7 +45,7 @@ import Chainweb.Payload import Chainweb.Storage.Table.RocksDB import Chainweb.Test.Cut.TestBlockDb (TestBlockDb (_bdbPayloadDb, _bdbWebBlockHeaderDb), addTestBlockDb, getCutTestBlockDb, getParentTestBlockDb, mkTestBlockDb, setCutTestBlockDb) import Chainweb.Test.Pact5.CmdBuilder -import Chainweb.Test.Pact5.Utils hiding (withTempSQLiteResource) +import Chainweb.Test.Pact5.Utils hiding (withInMemSQLiteResource) import Chainweb.Test.TestVersions import Chainweb.Test.Utils import Chainweb.Time @@ -86,31 +86,34 @@ import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase) import Text.Printf (printf) data Fixture = Fixture - { _fixtureBlockDb :: TestBlockDb + { _fixtureChains :: [ChainId] + , _fixtureBlockDb :: TestBlockDb , _fixtureMempools :: ChainMap (MempoolBackend Pact4.UnparsedTransaction) , _fixturePactQueues :: ChainMap PactQueue } -mkFixtureWith :: PactServiceConfig -> RocksDb -> ResourceT IO Fixture -mkFixtureWith pactServiceConfig baseRdb = do - sqlite <- withTempSQLiteResource - tdb <- mkTestBlockDb v baseRdb - perChain <- iforM (HashSet.toMap (chainIds v)) $ \chain () -> do +mkFixtureWith :: PactServiceConfig -> ChainwebVersion -> RocksDb -> ResourceT IO Fixture +mkFixtureWith pactServiceConfig v' baseRdb = do + + tdb <- mkTestBlockDb v' baseRdb + perChain <- iforM (HashSet.toMap (chainIds v')) $ \chain () -> do + sqlite <- withInMemSQLiteResource bhdb <- liftIO $ getWebBlockHeaderDb (_bdbWebBlockHeaderDb tdb) chain pactQueue <- liftIO $ newPactQueue 2_000 pactExecutionServiceVar <- liftIO $ newMVar (mkPactExecutionService pactQueue) - let mempoolCfg = validatingMempoolConfig chain v (Pact4.GasLimit 150_000) (Pact4.GasPrice 1e-8) pactExecutionServiceVar + let mempoolCfg = validatingMempoolConfig chain v' (Pact4.GasLimit 150_000) (Pact4.GasPrice 1e-8) pactExecutionServiceVar logLevel <- liftIO getTestLogLevel let logger = genericLogger logLevel Text.putStrLn mempool <- liftIO $ startInMemoryMempoolTest mempoolCfg mempoolConsensus <- liftIO $ mkMempoolConsensus mempool bhdb (Just (_bdbPayloadDb tdb)) let mempoolAccess = pactMemPoolAccess mempoolConsensus logger _ <- Resource.allocate - (forkIO $ runPactService v chain logger Nothing pactQueue mempoolAccess bhdb (_bdbPayloadDb tdb) sqlite pactServiceConfig) + (forkIO $ runPactService v' chain logger Nothing pactQueue mempoolAccess bhdb (_bdbPayloadDb tdb) sqlite pactServiceConfig) (\tid -> throwTo tid ThreadKilled) return (mempool, pactQueue) let fixture = Fixture - { _fixtureBlockDb = tdb + { _fixtureChains = HashSet.toList $ chainIds v' + , _fixtureBlockDb = tdb , _fixtureMempools = OnChains $ fst <$> perChain , _fixturePactQueues = OnChains $ snd <$> perChain } @@ -121,8 +124,10 @@ mkFixtureWith pactServiceConfig baseRdb = do return fixture mkFixture :: RocksDb -> ResourceT IO Fixture -mkFixture baseRdb = do - mkFixtureWith testPactServiceConfig baseRdb +mkFixture = mkFixtureWith testPactServiceConfig v + +mkFixtureDual :: RocksDb -> ResourceT IO Fixture +mkFixtureDual = mkFixtureWith testPactServiceConfig vPair tests :: RocksDb -> TestTree tests baseRdb = testGroup "Pact5 PactServiceTest" @@ -242,7 +247,7 @@ newBlockTimeoutSpec baseRdb = runResourceT $ do -- it should be long enough that `timeoutTx` times out -- but neither `tx1` nor `tx2` time out. } - fixture <- mkFixtureWith pactServiceConfig baseRdb + fixture <- mkFixtureWith pactServiceConfig v baseRdb liftIO $ do tx1 <- buildCwCmd v (defaultCmd chain0) @@ -585,9 +590,15 @@ tests = do chain0 :: ChainId chain0 = unsafeChainId 0 +chain1 :: ChainId +chain1 = unsafeChainId 1 + v :: ChainwebVersion v = pact5InstantCpmTestVersion False singletonChainGraph +vPair :: ChainwebVersion +vPair = pact5InstantCpmTestVersion False pairChainGraph + advanceAllChainsWithTxs :: Fixture -> ChainMap [Pact5.Transaction] -> IO (ChainMap (Vector TestPact5CommandResult)) advanceAllChainsWithTxs fixture txsPerChain = advanceAllChains fixture $ @@ -606,7 +617,7 @@ advanceAllChains :: () -> IO (ChainMap (Vector TestPact5CommandResult)) advanceAllChains Fixture{..} blocks = do commandResults <- - forConcurrently (HashSet.toList (chainIds v)) $ \c -> do + forConcurrently _fixtureChains $ \c -> do ph <- getParentTestBlockDb _fixtureBlockDb c creationTime <- getCurrentTimeIntegral let pactQueue = _fixturePactQueues ^?! atChain c From d5b6a8b0267691fdf8c20fffd1ecc9ee7369d599 Mon Sep 17 00:00:00 2001 From: KadenaFriend <241389759+kdafriend@users.noreply.github.com> Date: Wed, 4 Feb 2026 12:59:03 +0000 Subject: [PATCH 3/4] Initial Gas Model Unit tests --- test/lib/Chainweb/Test/TestVersions.hs | 4 +- .../Chainweb/Test/Pact5/PactServiceTest.hs | 158 +++++++++++++++++- .../Chainweb/Test/Pact5/RemotePactTest.hs | 2 +- 3 files changed, 161 insertions(+), 3 deletions(-) diff --git a/test/lib/Chainweb/Test/TestVersions.hs b/test/lib/Chainweb/Test/TestVersions.hs index f19f03d63e..b6399308f1 100644 --- a/test/lib/Chainweb/Test/TestVersions.hs +++ b/test/lib/Chainweb/Test/TestVersions.hs @@ -481,7 +481,9 @@ pact5InstantCpmTestVersion migrate g = buildTestVersion $ \v -> v & cpmTestVersion g & versionName .~ ChainwebVersionName ("instant-pact5-CPM-" <> toText g <> if migrate then "-migrate" else "") -- Used to check gas for xChain -- - & versionInitialGasModel .~ AllChains (Bottom (minBound, post31GasModel)) + & versionInitialGasModel .~ AllChains ( (ForkAtBlockHeight 5, post32GasModel) `Above` + (ForkAtBlockHeight 4, post31GasModel) `Above` + Bottom (minBound, pre31GasModel)) & versionForks .~ tabulateHashMap (\case -- SPV Bridge is not in effect for Pact 5 yet. SPVBridge -> AllChains ForkNever diff --git a/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs b/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs index 44f7d31920..fa5f3da7f3 100644 --- a/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs +++ b/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs @@ -24,6 +24,7 @@ import Data.List qualified as List import "pact" Pact.Types.Command qualified as Pact4 import "pact" Pact.Types.Hash qualified as Pact4 import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Chainweb import Chainweb.Cut @@ -50,6 +51,8 @@ import Chainweb.Test.TestVersions import Chainweb.Test.Utils import Chainweb.Time import Chainweb.Utils +import qualified Data.ByteString.Base64.URL as B64U +import Chainweb.SPV.CreateProof import Chainweb.Version import Chainweb.WebBlockHeaderDB (getWebBlockHeaderDb) import Chainweb.WebPactExecutionService @@ -67,6 +70,8 @@ import Data.Decimal import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet import Data.Maybe (fromMaybe) +import Pact.Core.Command.RPC (ContMsg (..)) +import Pact.Core.SPV (ContProof(..)) import Data.Text qualified as T import Data.Text.IO qualified as Text import Data.Vector (Vector) @@ -74,6 +79,7 @@ import Data.Vector qualified as Vector import Pact.Core.Capabilities import Pact.Core.ChainData hiding (ChainId, _chainId) import Pact.Core.Command.Types +import Pact.Core.DefPacts.Types import Pact.Core.Gas.Types import Pact.Core.Hash qualified as Pact5 import Pact.Core.Names @@ -82,7 +88,7 @@ import Pact.Types.Gas qualified as Pact4 import PropertyMatchers ((?)) import PropertyMatchers qualified as P import Test.Tasty -import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase) +import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase, (@?=)) import Text.Printf (printf) data Fixture = Fixture @@ -140,6 +146,7 @@ tests baseRdb = testGroup "Pact5 PactServiceTest" , testCase "failed txs should go into blocks" (failedTxsShouldGoIntoBlocks baseRdb) , testCase "modules with higher level transitive dependencies (simple)" (modulesWithHigherLevelTransitiveDependenciesSimple baseRdb) , testCase "modules with higher level transitive dependencies (complex)" (modulesWithHigherLevelTransitiveDependenciesComplex baseRdb) + , testCase "apply intial gas model" (testIntialGasModel baseRdb) ] simpleEndToEnd :: RocksDb -> IO () @@ -564,6 +571,155 @@ modulesWithHigherLevelTransitiveDependenciesComplex baseRdb = runResourceT $ do return () +-- A simple test module that increments an integer, on a single chain or cross-chain +testModule:: T.Text +testModule = "(namespace 'free) \ + \ (module m G (defcap G () true) \ + \ (defun inc (arg) \ + \ (+ arg 1)) \ + \ (defpact inc-x-chain (arg dest-chain) \ + \ (step (yield { \"a\" : (+ arg 1)} dest-chain )) \ + \ (step (resume { \"a\" := a } a)) \ + \ ) \ + \ )" + +assertCutHeight :: Fixture -> BlockHeight -> IO () +assertCutHeight fixt bh = do + cut <- getCut fixt + view cutMinHeight cut @?= bh + view cutMaxHeight cut @?= bh + +makeProof :: Fixture -> ChainId -> ChainId -> BlockHeight -> Int -> IO ContProof +makeProof Fixture{..} cidT cidS bh i = (ContProof . B64U.encode . encodeToByteString) <$> + createTransactionOutputProof_ (_bdbWebBlockHeaderDb _fixtureBlockDb) ( _bdbPayloadDb _fixtureBlockDb) + cidT cidS bh i + +testIntialGasModel :: RocksDb -> IO () +testIntialGasModel baseRdb = runResourceT $ do + fixture <- mkFixtureDual baseRdb + + liftIO $ do + -- Confirm We are here at height 1 + assertCutHeight fixture $ BlockHeight 1 + + -- Deploy the module on both chains and initiate two defpact Txs on Chain 0 + cmdDeployChain0 <- buildCwCmd vPair (defaultCmd chain0) + { _cbRPC = mkExec' testModule + , _cbGasPrice = GasPrice 0.0004} + + cmdDeployChain1 <- buildCwCmd vPair (defaultCmd chain1) + { _cbRPC = mkExec' testModule + , _cbGasPrice = GasPrice 0.0004} + + cmdDefPact1 <- buildCwCmd vPair (defaultCmd chain0) + { _cbRPC = mkExec' "(free.m.inc-x-chain 0 \"1\")" + , _cbGasPrice = GasPrice 0.0003} + + cmdDefPact2 <- buildCwCmd vPair (defaultCmd chain0) + { _cbRPC = mkExec' "(free.m.inc-x-chain 1 \"1\")" + , _cbGasPrice = GasPrice 0.0002} + + cmdDefPact3 <- buildCwCmd vPair (defaultCmd chain0) + { _cbRPC = mkExec' "(free.m.inc-x-chain 2 \"1\")" + , _cbGasPrice = GasPrice 0.0001} + + resBlock2 <- advanceAllChainsWithTxs fixture $ onChains [ (chain0, [cmdDeployChain0, cmdDefPact1, cmdDefPact2, cmdDefPact3]) + , (chain1, [cmdDeployChain1]) ] + + -- Check That all transactions are successful + resBlock2 & + P.alignExact ? onChains [ (chain0, P.alignExact $ Vector.fromList [successfulTx, successfulTx, successfulTx, successfulTx]) + , (chain1, P.alignExact $ Vector.fromList [successfulTx])] + + -- Increase the height to allow SPV retrieval + _ <- advanceAllChainsWithTxs fixture $ AllChains [] + + ------------------------------------------------------------------------------------------------------------- + ----------------------------------- HEIGHT 4 - pre31GasModel ----------------------------------------------- + putStrLn "Test pre31GasModel" + -- Confirm We are here at height 3 + -- We use the pre31GasModel + assertCutHeight fixture $ BlockHeight 3 + + prf1 <- makeProof fixture chain1 chain0 (BlockHeight 2) 1 + cmdCont1 <- buildCwCmd vPair (defaultCmd chain1) + { _cbRPC = mkCont $ ContMsg { _cmPactId = resBlock2 ^?! ixg chain0 . ix 1 . crContinuation . _Just . peDefPactId + , _cmStep = 1 + , _cmRollback = False + , _cmData = PObject mempty + , _cmProof = Just prf1 + } + , _cbGasPrice = GasPrice 0.0001} + + cmd1 <- buildCwCmd vPair (defaultCmd chain0) + { _cbRPC = mkExec' "(free.m.inc 0)" + } + + resBlock4 <- advanceAllChainsWithTxs fixture $ onChains [ (chain0, [cmd1]) + , (chain1, [cmdCont1]) ] + resBlock4 & + P.alignExact ? onChains [ (chain0, P.alignExact $ Vector.fromList [P.fun _crGas ? P.equals (Gas 74)]) + , (chain1, P.alignExact $ Vector.fromList [P.fun _crGas ? P.equals (Gas 100)]) + ] + + ------------------------------------------------------------------------------------------------------------- + ----------------------------------- HEIGHT 4 - post31GasModel ----------------------------------------------- + putStrLn "Test post31GasModel" + -- Confirm We are here at height 4 + assertCutHeight fixture $ BlockHeight 4 + + prf2 <- makeProof fixture chain1 chain0 (BlockHeight 2) 2 + cmdCont2 <- buildCwCmd vPair (defaultCmd chain1) + { _cbRPC = mkCont $ ContMsg { _cmPactId = resBlock2 ^?! ixg chain0 . ix 2 . crContinuation . _Just . peDefPactId + , _cmStep = 1 + , _cmRollback = False + , _cmData = PObject mempty + , _cmProof = Just prf2 + } + , _cbGasPrice = GasPrice 0.0001} + + cmd2 <- buildCwCmd vPair (defaultCmd chain0) + { _cbRPC = mkExec' "(free.m.inc 1)" + } + + resBlock5 <- advanceAllChainsWithTxs fixture $ onChains [ (chain0, [cmd2]) + , (chain1, [cmdCont2]) ] + + -- Check that now, with the post31GasModel => continuation proofs are charged + resBlock5 & + P.alignExact ? onChains [ (chain0, P.alignExact $ Vector.fromList [P.fun _crGas ? P.equals (Gas 74)]) + , (chain1, P.alignExact $ Vector.fromList [P.fun _crGas ? P.equals (Gas 124)]) + ] + + ------------------------------------------------------------------------------------------------------------- + ----------------------------------- HEIGHT 5 - post32GasModel ----------------------------------------------- + putStrLn "Test post32GasModel" + -- Confirm We are here at height 5 + assertCutHeight fixture $ BlockHeight 5 + + prf3 <- makeProof fixture chain1 chain0 (BlockHeight 2) 3 + cmdCont3 <- buildCwCmd vPair (defaultCmd chain1) + { _cbRPC = mkCont $ ContMsg { _cmPactId = resBlock2 ^?! ixg chain0 . ix 3 . crContinuation . _Just . peDefPactId + , _cmStep = 1 + , _cmRollback = False + , _cmData = PObject mempty + , _cmProof = Just prf3 + } + } + + cmd3 <- buildCwCmd vPair (defaultCmd chain0) + { _cbRPC = mkExec' "(free.m.inc 2)"} + + resBlock6 <- advanceAllChainsWithTxs fixture $ onChains [ (chain0, [cmd3]) + , (chain1, [cmdCont3]) ] + + -- Check that now, with the post32GasModel => continuation proofs + Signatures are charged + resBlock6 & + P.alignExact ? onChains [ (chain0, P.alignExact $ Vector.fromList [P.fun _crGas ? P.equals (Gas 85)]) + , (chain1, P.alignExact $ Vector.fromList [P.fun _crGas ? P.equals (Gas 134)]) + ] + + {- tests = do -- * test that ValidateBlock does a destructive rewind to the parent of the block being validated diff --git a/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs b/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs index c6db34af54..321d85122a 100644 --- a/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs +++ b/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs @@ -346,7 +346,7 @@ crosschainTest baseRdb step = runResourceT $ do , P.fun _peName ? P.equals "X_RESUME" , P.succeed ] - , P.fun _crGas ? P.equals (Gas 234) + , P.fun _crGas ? P.equals (Gas 245) ] , P.match _Just ? P.fun _crResult ? P.match _PactResultErr ? P.fun _peMsg ? P.fun _boundedText ? P.equals ("Requested defpact execution already completed for defpact id: " <> T.take 20 (renderDefPactId $ _peDefPactId cont) <> "...") From 96364fe135721b4a82d381a7b326e2bf23fed27a Mon Sep 17 00:00:00 2001 From: KadenaFriend <241389759+kdafriend@users.noreply.github.com> Date: Sat, 7 Feb 2026 12:40:16 +0000 Subject: [PATCH 4/4] Adjust signatures prices according to benchmarks --- src/Chainweb/Pact5/InitialGasModel.hs | 4 ++-- test/unit/Chainweb/Test/Pact5/PactServiceTest.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Chainweb/Pact5/InitialGasModel.hs b/src/Chainweb/Pact5/InitialGasModel.hs index 80403385c1..6027a0b581 100644 --- a/src/Chainweb/Pact5/InitialGasModel.hs +++ b/src/Chainweb/Pact5/InitialGasModel.hs @@ -72,6 +72,6 @@ post32GasModel = InitialGasModel , _signatureSizeFactor = 1.0 , _sizePenalty = \x -> (x / 512) ^ (7 :: Integer) , _signatureCost = \case - ED25519 -> 10.0 -- | TODO => Needs to be benchmarked - WebAuthn -> 10.0 -- | + ED25519 -> 21.0 -- | Benchmarked at 52 ns + WebAuthn -> 526.0 -- | Benchmarked at 1.315 ms (worst case) } diff --git a/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs b/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs index fa5f3da7f3..b9c8f3da9e 100644 --- a/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs +++ b/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs @@ -715,8 +715,8 @@ testIntialGasModel baseRdb = runResourceT $ do -- Check that now, with the post32GasModel => continuation proofs + Signatures are charged resBlock6 & - P.alignExact ? onChains [ (chain0, P.alignExact $ Vector.fromList [P.fun _crGas ? P.equals (Gas 85)]) - , (chain1, P.alignExact $ Vector.fromList [P.fun _crGas ? P.equals (Gas 134)]) + P.alignExact ? onChains [ (chain0, P.alignExact $ Vector.fromList [P.fun _crGas ? P.equals (Gas 96)]) + , (chain1, P.alignExact $ Vector.fromList [P.fun _crGas ? P.equals (Gas 145)]) ]