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