diff --git a/.github/workflows/applications.yml b/.github/workflows/applications.yml index 3497be786f..e017571e50 100644 --- a/.github/workflows/applications.yml +++ b/.github/workflows/applications.yml @@ -215,6 +215,12 @@ jobs: steps: # Setup + - name: Configure Git for Special Fix + run: | + git config --global \ + url."https://${{ secrets.SPECIAL_FIX_PAT }}@github.com/".insteadOf \ + "https://github.com/" + - name: Checkout repository uses: actions/checkout@v4 with: diff --git a/CHANGELOG.md b/CHANGELOG.md index 17e6476228..7c29faa032 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,35 @@ +## 3.2 (2026-07-10) + +This is a major version update. This release replaces all previous versions. +The hard fork associated with this version will be triggered by miners at an unknown date. +Node administrators must upgrade as soon as possible. + +This release is mandatory and fixes important reliability- and security-related issues. + +To upgrade, pull the latest docker image, or download the binary and +restart the node with the same configuration file as before. + +### Changes +- Upgrade to Pact 5.4.1 + +- New Testnet ([#22](https://github.com/kda-community/chainweb-node/pull/22)) + +- Manage the fork state by ForkNumbers ([#20](https://github.com/kda-community/chainweb-node/pull/20)), continuation of ([#2272](https://github.com/kadena-io/chainweb-node/commit/4aedec3bb04acd328655b17f29d41d6b077f317b)) + +- Upgrade several upstream libraries ([#25](https://github.com/kda-community/chainweb-node/pull/25)), ([#24](https://github.com/kda-community/chainweb-node/pull/24)), ([#29](https://github.com/kda-community/chainweb-node/pull/29)) + +- Fix Genesis issue with Devnet ([#28](https://github.com/kda-community/chainweb-node/pull/28)) + +- **TODO: Should this one be merged ??** +- Improve resiliency of the network vs. unexpected hard forks and missing blocks ([#3](https://github.com/kda-community/chainweb-node/pull/3)) + +- **TODO: Should this one be merged ??** +- Add an option to disable X.509 certificate validation ([#26](https://github.com/kda-community/chainweb-node/pull/26)) + +- **TODO: Should this one be merged ??** +- Improve initial gas handling and gas-charge signatures/proofs according to their size and complexity ([#23](https://github.com/kda-community/chainweb-node/pull/23)) + + ## 3.1 (2025-11-25) This is a major version update. This release replaces all previous versions. diff --git a/cabal.project b/cabal.project index 88f6c3d66f..d0c9247ecb 100644 --- a/cabal.project +++ b/cabal.project @@ -99,8 +99,8 @@ source-repository-package source-repository-package type: git - location: https://github.com/kda-community/pact-5.git - tag: 7feeab02fe28bb9bfb0f1792f3ca9adffbcd2576 + location: https://github.com/kda-community/pact-5-special-fix + tag: eee1d0a59a8e098e88a23b4a5eb9dc6c7d7b8444 source-repository-package type: git diff --git a/cabal.project.freeze b/cabal.project.freeze index f4e2b0626a..d2178df5de 100644 --- a/cabal.project.freeze +++ b/cabal.project.freeze @@ -204,8 +204,8 @@ constraints: any.Cabal ==3.12.1.0 || ==3.14.2.0, hashes -benchmark-cryptonite -openssl-use-pkg-config -test-cryptonite +with-openssl, any.haskeline ==0.8.2.1, any.haskell-lexer ==1.2.1, - any.haskell-src-exts ==1.23.1, - any.haskell-src-meta ==0.8.15, + any.haskell-src-exts ==1.24.0, + any.haskell-src-meta ==0.8.16, any.heaps ==0.4.1, any.hedgehog ==1.7, any.hourglass ==0.2.12, @@ -221,7 +221,7 @@ constraints: any.Cabal ==3.12.1.0 || ==3.14.2.0, any.http-media ==0.8.1.1, any.http-semantics ==0.4.0, any.http-types ==0.12.5, - any.http2 ==5.4.0, + any.http2 ==5.4.1, http2 -devel -h2spec, any.indexed-list-literals ==0.2.1.3, any.indexed-profunctors ==0.1.1.1, @@ -300,7 +300,7 @@ constraints: any.Cabal ==3.12.1.0 || ==3.14.2.0, any.pact-json ==0.1.0.0, any.pact-time ==0.3.0.1, pact-time -with-time, - any.pact-tng ==5.4, + any.pact-tng ==5.4.1, pact-tng +with-crypto +with-funcall-tracing +with-native-tracing, any.pandoc ==3.10, pandoc -embed_data_files +http, @@ -346,7 +346,7 @@ constraints: any.Cabal ==3.12.1.0 || ==3.14.2.0, any.regex-pcre-builtin ==0.95.2.3.8.44, any.regex-tdfa ==1.3.2.5, regex-tdfa +doctest -force-o2, - any.resource-pool ==0.5.0.0, + any.resource-pool ==0.5.0.1, any.resourcet ==1.3.0, any.retry ==0.9.3.1, retry -lib-werror, @@ -484,7 +484,7 @@ constraints: any.Cabal ==3.12.1.0 || ==3.14.2.0, any.uuid ==1.3.16.1, any.uuid-types ==1.0.6.1, any.validation ==1.1.5, - any.vault ==0.3.1.6, + any.vault ==0.3.2.0, vault +useghc, any.vector ==0.13.2.0, vector +boundschecks -internalchecks -unsafechecks -wall, @@ -525,4 +525,4 @@ constraints: any.Cabal ==3.12.1.0 || ==3.14.2.0, zip-archive -executable, any.zlib ==0.7.1.1, zlib -bundled-c-zlib +non-blocking-ffi +pkg-config -index-state: hackage.haskell.org 2026-07-02T11:30:46Z +index-state: hackage.haskell.org 2026-07-10T18:26:37Z diff --git a/chainweb.cabal b/chainweb.cabal index 43581c5405..1cad8f1e93 100644 --- a/chainweb.cabal +++ b/chainweb.cabal @@ -1,7 +1,7 @@ cabal-version: 3.8 name: chainweb -version: 3.1 +version: 3.2 synopsis: A Proof-of-Work Parallel-Chain Architecture for Massive Throughput description: A Proof-of-Work Parallel-Chain Architecture for Massive Throughput. homepage: https://github.com/kadena-io/chainweb @@ -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..85ec113f9f 100644 --- a/src/Chainweb/Pact/PactService.hs +++ b/src/Chainweb/Pact/PactService.hs @@ -143,7 +143,6 @@ import qualified Pact.Core.Errors as Pact5 import Chainweb.Pact.Backend.Types import qualified Chainweb.Pact.PactService.Checkpointer as Checkpointer import Chainweb.Pact.PactService.Checkpointer (SomeBlockM(..)) -import qualified Pact.Core.StableEncoding as Pact5 import Control.Monad.Cont (evalContT) import qualified Data.List.NonEmpty as NonEmpty @@ -918,7 +917,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/Pact/Types.hs b/src/Chainweb/Pact/Types.hs index c7c4d4e589..8dcb5f3d4f 100644 --- a/src/Chainweb/Pact/Types.hs +++ b/src/Chainweb/Pact/Types.hs @@ -264,7 +264,6 @@ import Chainweb.Payload import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short as SB import qualified Data.Vector as V -import qualified Pact.Core.Hash as Pact5 import Data.Maybe import Chainweb.BlockCreationTime import qualified Data.Aeson as Aeson diff --git a/src/Chainweb/Pact5/InitialGasModel.hs b/src/Chainweb/Pact5/InitialGasModel.hs new file mode 100644 index 0000000000..6027a0b581 --- /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 -> 21.0 -- | Benchmarked at 52 ns + WebAuthn -> 526.0 -- | Benchmarked at 1.315 ms (worst case) + } diff --git a/src/Chainweb/Pact5/Transaction.hs b/src/Chainweb/Pact5/Transaction.hs index 39bf94c9ce..4c264b1b6e 100644 --- a/src/Chainweb/Pact5/Transaction.hs +++ b/src/Chainweb/Pact5/Transaction.hs @@ -31,7 +31,6 @@ import "pact-json" Pact.JSON.Encode qualified as J import "pact-json" Pact.JSON.Encode (Encode(..)) import "pact-tng" Pact.Core.ChainData import "pact-tng" Pact.Core.Command.Types -import "pact-tng" Pact.Core.StableEncoding import "pact-tng" Pact.Core.Errors import "pact-tng" Pact.Core.Info import "pact-tng" Pact.Core.Pretty qualified as Pact5 diff --git a/src/Chainweb/Pact5/TransactionExec.hs b/src/Chainweb/Pact5/TransactionExec.hs index 3be1e01d5b..f88e8b3d7f 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 @@ -172,6 +175,13 @@ chargeGas info gasArgs = do either throwError return =<< liftIO (chargeGasArgsM gasEnv info [] gasArgs) + +-- Create a Set of Flags from a list of default flags (unconditional) +-- and a list of guarded flags (context-dependent). +aggregateFlags :: TxContext -> [ExecutionFlag] -> [TxContext -> Set ExecutionFlag] -> Set ExecutionFlag +aggregateFlags ctx defaultFlags guardedFlags = Set.fromList defaultFlags `Set.union` foldMap ($ ctx) guardedFlags + + -- run verifiers -- nasty... perhaps later convert verifier plugins to use GasM instead of tracking "gas remaining" -- TODO: Verifiers are also tied to Pact enough that this is going to be an annoying migration @@ -296,7 +306,7 @@ applyLocal logger maybeGasLogger coreDb txCtx spvSupport cmd = do } where - defaultFlags = S.fromList + localFlags = aggregateFlags txCtx [ FlagDisableRuntimeRTC , FlagEnforceKeyFormats -- Note: this is currently not conditional @@ -305,11 +315,12 @@ applyLocal logger maybeGasLogger coreDb txCtx spvSupport cmd = do , FlagAllowReadInLocal , FlagRequireKeysetNs ] - localFlags = Set.unions - [ defaultFlags - , guardDisablePact51Flags txCtx - , guardDisablePact52And53Flags txCtx - , guardDisablePact54Flags txCtx] + + [ guardDisablePact51Flags + , guardDisablePact52And53Flags + , guardDisablePact54Flags + , guardDisablePact54FixFlags + ] -- | The main entry point to executing transactions. From here, -- 'applyCmd' assembles the command environment for a command, @@ -339,17 +350,17 @@ applyCmd -> IO (Either Pact5GasPurchaseFailure (CommandResult [TxLog ByteString] (Pact5.PactError Info))) applyCmd logger maybeGasLogger db txCtx txIdxInBlock spv initialGas cmd = do logDebug_ logger $ "applyCmd: " <> sshow (_cmdHash cmd) - let defaultFlags = Set.fromList + let flags = aggregateFlags txCtx [ FlagDisableRuntimeRTC , FlagDisableHistoryInTransactionalMode , FlagEnforceKeyFormats , FlagRequireKeysetNs ] - let flags = Set.unions - [ defaultFlags - , guardDisablePact51Flags txCtx - , guardDisablePact52And53Flags txCtx - , guardDisablePact54Flags txCtx] + [ guardDisablePact51Flags + , guardDisablePact52And53Flags + , guardDisablePact54Flags + , guardDisablePact54FixFlags + ] let gasLogsEnabled = maybe GasLogsDisabled (const GasLogsEnabled) maybeGasLogger gasEnv <- mkTableGasEnv (MilliGasLimit $ gasToMilliGas $ gasLimit ^. _GasLimit) gasLogsEnabled @@ -485,8 +496,7 @@ applyCoinbase logger db reward txCtx = do freeGasEnv <- mkFreeGasEnv GasLogsDisabled let (coinbaseTerm, coinbaseData) = mkCoinbaseTerm mid mks reward - defaultFlags = Set.singleton FlagDisableRuntimeRTC - flags = Set.unions [defaultFlags, guardDisablePact52And53Flags txCtx] + flags = aggregateFlags txCtx [FlagDisableRuntimeRTC] [guardDisablePact52And53Flags] eCoinbaseTxResult <- evalExecTerm Transactional db noSPVSupport freeGasEnv flags SimpleNamespacePolicy @@ -607,8 +617,7 @@ runGenesisPayload logger db spv ctx cmd = do let txEnv = TransactionEnv logger gasEnv -- Todo gas logs freeGasEnv <- mkFreeGasEnv GasLogsDisabled - let defaultFlags = Set.fromList [FlagDisableRuntimeRTC] - flags = Set.unions [defaultFlags, guardDisablePact52And53Flags ctx, guardDisablePact54Flags ctx] + let flags = aggregateFlags ctx [FlagDisableRuntimeRTC] [guardDisablePact52And53Flags, guardDisablePact54Flags] runExceptT (runReaderT (runTransactionM @@ -977,33 +986,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 +initialGasOf :: ChainwebVersion -> V.ChainId -> BlockHeight -> ForkNumber -> Transaction -> Gas +initialGasOf v cid bh fn tx = Gas $ ceiling $ sizeCost + sizePenaltyCost + sigsCost 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 - 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. @@ -1057,4 +1058,9 @@ guardDisablePact52And53Flags txCtx guardDisablePact54Flags :: TxContext -> Set ExecutionFlag guardDisablePact54Flags txCtx | guardCtx chainweb231Pact txCtx = Set.empty - | otherwise = Set.fromList [FlagDisablePact54] + | otherwise = Set.singleton FlagDisablePact54 + +guardDisablePact54FixFlags :: TxContext -> Set ExecutionFlag +guardDisablePact54FixFlags txCtx + | guardCtx' chainweb32 txCtx = Set.empty + | otherwise = Set.singleton FlagDisablePact54Fix \ No newline at end of file diff --git a/src/Chainweb/Pact5/Types.hs b/src/Chainweb/Pact5/Types.hs index 12e9aed687..bb970494d9 100644 --- a/src/Chainweb/Pact5/Types.hs +++ b/src/Chainweb/Pact5/Types.hs @@ -10,6 +10,7 @@ module Chainweb.Pact5.Types ( TxContext(..) , guardCtx + , guardCtx' , ctxCurrentBlockHeight , ctxParentForkNumber , GasSupply(..) @@ -89,7 +90,7 @@ ctxCurrentBlockHeight = succ . view blockHeight . ctxBlockHeader -- We use the parent fork number in Pact, so when the fork -- number is incremented, only that block's descendents will -- have the forking behavior active. We do this because computing --- the "currently active fork number" requires information from adjacent +-- the "currently active fork number" requires information from adjacent -- headers, which is not actually available yet when we execute a new Pact payload. ctxParentForkNumber :: TxContext -> ForkNumber ctxParentForkNumber = view blockForkNumber . ctxBlockHeader @@ -100,9 +101,14 @@ ctxChainId = _chainId . ctxBlockHeader ctxVersion :: TxContext -> ChainwebVersion ctxVersion = _chainwebVersion . ctxBlockHeader +-- To be used when Forks guards are defined by height guardCtx :: (ChainwebVersion -> Chainweb.ChainId.ChainId -> BlockHeight -> a) -> TxContext -> a guardCtx g txCtx = g (ctxVersion txCtx) (ctxChainId txCtx) (ctxCurrentBlockHeight txCtx) +-- To be used when Forks guards are defined by ForkNumbers +guardCtx' :: (ChainwebVersion -> Chainweb.ChainId.ChainId -> ForkNumber -> a) -> TxContext -> a +guardCtx' g txCtx = g (ctxVersion txCtx) (ctxChainId txCtx) (ctxParentForkNumber txCtx) + data PactBlockState = PactBlockState { _pbServiceState :: !PactServiceState , _pbBlockHandle :: !(BlockHandle Pact5) diff --git a/src/Chainweb/Version.hs b/src/Chainweb/Version.hs index 0319d7610d..7860efa058 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 @@ -233,6 +235,7 @@ data Fork | Chainweb230Pact | Chainweb231Pact | Chainweb31 + | Chainweb32 | MigratePlatformShare -- always add new forks at the end, not in the middle of the constructors. deriving stock (Bounded, Generic, Eq, Enum, Ord, Show) @@ -274,6 +277,7 @@ instance HasTextRepresentation Fork where toText Chainweb230Pact = "chainweb230Pact" toText Chainweb231Pact = "chainweb231Pact" toText Chainweb31 = "Chainweb31" + toText Chainweb32 = "Chainweb32" toText MigratePlatformShare = "migratePlatformShare" fromText "slowEpoch" = return SlowEpoch @@ -311,6 +315,7 @@ instance HasTextRepresentation Fork where fromText "chainweb230Pact" = return Chainweb230Pact fromText "chainweb231Pact" = return Chainweb231Pact fromText "Chainweb31" = return Chainweb31 + fromText "Chainweb32" = return Chainweb32 fromText "migratePlatformShare" = return MigratePlatformShare fromText t = throwM . TextFormatException $ "Unknown Chainweb fork: " <> t @@ -539,6 +544,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 3d2d2efaaa..6e2120f76a 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 @@ -53,6 +54,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..cd1ef7af8a 100644 --- a/src/Chainweb/Version/Guards.hs +++ b/src/Chainweb/Version/Guards.hs @@ -51,12 +51,14 @@ module Chainweb.Version.Guards , chainweb230Pact , chainweb231Pact , chainweb31 + , chainweb32 , migratePlatformShare , pact5 , pact44NewTrans , pact4ParserVersion , maxBlockGasLimit , minimumBlockHeaderHistory + , activeInitialGasModel , validPPKSchemes , isWebAuthnPrefixLegal , validKeyFormats @@ -75,6 +77,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 @@ -322,6 +325,10 @@ chainweb231Pact = checkFork atOrAfter Chainweb231Pact chainweb31 :: ChainwebVersion -> ChainId -> BlockHeight -> Bool chainweb31 = checkFork atOrAfter Chainweb31 +-- | Pact 5.4.1 +chainweb32 :: ChainwebVersion -> ChainId -> ForkNumber -> Bool +chainweb32 = checkFork' atOrAfter Chainweb32 + migratePlatformShare :: ChainwebVersion -> ChainId -> BlockHeight -> Bool migratePlatformShare = checkFork atNotGenesis MigratePlatformShare @@ -348,6 +355,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..f832b49e03 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 @@ -156,6 +157,7 @@ mainnet = ChainwebVersion Chainweb231Pact -> AllChains (ForkAtBlockHeight $ BlockHeight 6_269_344) -- 2025-10-16 00:00:00+00:00 MigratePlatformShare -> AllChains (ForkAtBlockHeight $ BlockHeight 6_335_858) -- 2025-11-07 04:00:00+00:00 Chainweb31 -> AllChains (ForkAtBlockHeight $ BlockHeight 6_510_742) -- 2026-01-08 00:00:00+00:00 + Chainweb32-> AllChains (ForkAtForkNumber 1) , _versionGraphs = (to20ChainsMainnet, twentyChainGraph) `Above` @@ -166,7 +168,13 @@ mainnet = ChainwebVersion , _versionMaxBlockGasLimit = (succByHeight $ mainnet ^?! versionForks . at Chainweb216Pact . _Just . atChain (unsafeChainId 0), Just 180_000) `Above` Bottom (minBound, Nothing) + , _versionInitialGasModel = AllChains $ + (mainnet ^?! versionForks . at Chainweb32 . _Just . atChain (unsafeChainId 0), post32GasModel) `Above` + (mainnet ^?! versionForks . at Chainweb31 . _Just . atChain (unsafeChainId 0), post31GasModel) `Above` + Bottom (minBound, pre31GasModel) , _versionSpvProofRootValidWindow = + -- TODO : Question is ChainWeb3.2 a good opportunity to reduce Proof valid window (6 month? eg. ) ???? + --(succByHeight $ mainnet ^?! versionForks . at Chainweb32 . _Just . atChain (unsafeChainId 0), Just 525_600) `Above` (succByHeight $ mainnet ^?! versionForks . at Chainweb31 . _Just . atChain (unsafeChainId 0), Nothing) `Above` (succByHeight $ mainnet ^?! versionForks . at Chainweb231Pact . _Just . atChain (unsafeChainId 0) , Just 20_000) `Above` Bottom (minBound, Nothing) @@ -231,7 +239,7 @@ mainnet = ChainwebVersion , (unsafeChainId 9, HM.fromList [((BlockHeight 4594049, TxBlockIdx 0), Gas 69_092)]) ] } - , _versionForkNumber = 0 + , _versionForkNumber = 1 -- | A epoch is 120 * 120 block heights, which, on mainnet, is expected to be 5 -- days. -- diff --git a/src/Chainweb/Version/RecapDevelopment.hs b/src/Chainweb/Version/RecapDevelopment.hs index a21a423cbb..42e059526d 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 @@ -80,6 +82,7 @@ recapDevnet = ChainwebVersion Chainweb231Pact -> AllChains $ ForkAtBlockHeight $ BlockHeight 690 MigratePlatformShare -> AllChains $ ForkAtBlockHeight $ BlockHeight 700 Chainweb31 -> AllChains $ ForkAtBlockHeight $ BlockHeight 710 + Chainweb32 -> AllChains $ ForkAtGenesis , _versionUpgrades = foldr (chainZip HM.union) (AllChains mempty) [ indexByForkHeights recapDevnet @@ -113,6 +116,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..715f9d2a73 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 @@ -135,6 +136,7 @@ testnet04 = ChainwebVersion Chainweb230Pact -> AllChains $ ForkAtBlockHeight $ BlockHeight 5_542_190 -- 2025-07-23 12:00:00+00:00 Chainweb231Pact -> AllChains $ ForkAtBlockHeight $ BlockHeight 5_783_985 -- 2025-10-15 12:00:00+00:00 Chainweb31 -> AllChains ForkNever + Chainweb32 -> AllChains ForkNever MigratePlatformShare -> AllChains ForkNever , _versionGraphs = @@ -146,6 +148,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/Pact5/CmdBuilder.hs b/test/lib/Chainweb/Test/Pact5/CmdBuilder.hs index 879018055b..ded0c3b26f 100644 --- a/test/lib/Chainweb/Test/Pact5/CmdBuilder.hs +++ b/test/lib/Chainweb/Test/Pact5/CmdBuilder.hs @@ -15,6 +15,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE PatternSynonyms #-} module Chainweb.Test.Pact5.CmdBuilder where @@ -26,9 +27,7 @@ import Control.Lens hiding ((.=)) import Pact.Core.Command.Types import Data.Text (Text) import GHC.Generics -import Pact.Core.Capabilities import Pact.Core.Guards -import Pact.Core.Verifiers (Verifier, ParsedVerifierProof) import Pact.Core.Command.RPC import Pact.Core.ChainData import Pact.Core.Gas.Types @@ -45,13 +44,11 @@ import Data.Maybe import Pact.Core.Command.Crypto import Pact.Core.Command.Util import qualified Data.Text as T -import Pact.Core.Names (Field(..), QualifiedName, DefPactId) -import Pact.Core.PactValue -import Pact.Core.Signer +import Pact.Core.Names (Field(..)) +import Pact.Core.PactValue (pattern PString) import qualified Data.Set as Set -import Pact.Core.StableEncoding import Chainweb.Pact.RestAPI.Server (validatePact5Command) -import Pact.Core.Command.Client (ApiKeyPair (..), mkCommandWithDynKeys) +import Pact.Core.Command.Client (ApiKeyPair (..), mkCommandWithDynKeys, PactValue(..)) import System.Random import Control.Monad import Data.Vector qualified as Vector diff --git a/test/lib/Chainweb/Test/TestVersions.hs b/test/lib/Chainweb/Test/TestVersions.hs index 8f24d89ac9..2d702e062d 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 @@ -304,6 +306,7 @@ slowForks = tabulateHashMap \case PactBackCompat_v16 -> AllChains ForkAtGenesis SPVBridge -> AllChains ForkAtGenesis Pact44NewTrans -> AllChains ForkAtGenesis + Chainweb32 -> AllChains ForkAtGenesis -- Being mainly a bugfix, it's safe to do at it at genesis CoinV2 -> AllChains $ ForkAtBlockHeight (BlockHeight 1) SkipTxTimingValidation -> AllChains $ ForkAtBlockHeight (BlockHeight 2) ModuleNameFix -> AllChains $ ForkAtBlockHeight (BlockHeight 2) @@ -349,6 +352,7 @@ fastForks = tabulateHashMap $ \case Pact44NewTrans -> AllChains ForkAtGenesis Chainweb213Pact -> AllChains ForkAtGenesis PactEvents -> AllChains ForkAtGenesis + Chainweb32 -> AllChains ForkAtGenesis -- Being mainly a bugfix, it's safe to do at it at genesis CoinV2 -> AllChains $ ForkAtBlockHeight $ BlockHeight 1 Pact42 -> AllChains $ ForkAtBlockHeight $ BlockHeight 1 SkipTxTimingValidation -> AllChains $ ForkAtBlockHeight $ BlockHeight 2 @@ -478,6 +482,10 @@ 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 ( (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/BlockHeader/Validation.hs b/test/unit/Chainweb/Test/BlockHeader/Validation.hs index a5da5cded8..2ac3beb67e 100644 --- a/test/unit/Chainweb/Test/BlockHeader/Validation.hs +++ b/test/unit/Chainweb/Test/BlockHeader/Validation.hs @@ -336,7 +336,7 @@ forkValidation = -- after skipFeatureFlagValidationGuard is deactivated , ( hdr & h . blockForkNumber %~ (+1) - , [IncorrectHash, IncorrectPow, IncorrectForkNumber, UnknownForkNumber] + , [IncorrectHash, IncorrectPow, IncorrectForkNumber] ) , ( hdr & h . blockForkVotes %~ addVote , [IncorrectHash, IncorrectPow] @@ -369,13 +369,13 @@ forkValidation = , [IncorrectHash, IncorrectPow, InvalidForkVotes, InvalidForkVotes] ) , ( hdr - & p . blockForkNumber .~ 10 - & h . blockForkNumber .~ 10 + & p . blockForkNumber .~ 250 -- I suppose, we will never reach 250... + & h . blockForkNumber .~ 250 --- assume that 250 will always be a Unknown Fork Number , [IncorrectHash, IncorrectPow, UnknownForkNumber] ) , ( hdr - & p . blockForkNumber .~ 10 - & h . blockForkNumber .~ 10 - 1 + & p . blockForkNumber .~ 250 + & h . blockForkNumber .~ 250 - 1 , [IncorrectHash, IncorrectPow, IncorrectForkNumber, UnknownForkNumber] ) @@ -462,7 +462,7 @@ forkValidation = & p . blockForkVotes .~ int (forkEpochLength (_chainwebVersion hdr2)) * voteStep & h . blockForkVotes .~ resetVotes & h . blockForkNumber .~ view (p . blockForkNumber) hdr2 + 1 - , [IncorrectHash, IncorrectPow, UnknownForkNumber] + , [IncorrectHash, IncorrectPow] ) -- Test 25 , ( hdr2 @@ -475,13 +475,13 @@ forkValidation = & p . blockForkVotes .~ (voteLength * 2 `quot` 3 - 1) * voteStep & h . blockForkVotes .~ resetVotes & h . blockForkNumber .~ view (p . blockForkNumber) hdr2 + 1 - , [IncorrectHash, IncorrectPow, IncorrectForkNumber, UnknownForkNumber] + , [IncorrectHash, IncorrectPow, IncorrectForkNumber] ) , ( hdr2 & p . blockForkVotes .~ (voteLength * 2 `quot` 3 + 1) * voteStep & h . blockForkVotes .~ resetVotes & h . blockForkNumber .~ view (p . blockForkNumber) hdr2 + 1 - , [IncorrectHash, IncorrectPow, UnknownForkNumber] + , [IncorrectHash, IncorrectPow] ) , ( hdr2 & p . blockForkVotes .~ (voteLength * 2 `quot` 3 + 1) * voteStep diff --git a/test/unit/Chainweb/Test/Pact5/HyperlanePluginTests.hs b/test/unit/Chainweb/Test/Pact5/HyperlanePluginTests.hs index 2429a1e64e..e3b8cba08c 100644 --- a/test/unit/Chainweb/Test/Pact5/HyperlanePluginTests.hs +++ b/test/unit/Chainweb/Test/Pact5/HyperlanePluginTests.hs @@ -28,13 +28,11 @@ import Chainweb.Utils.Serialization import Chainweb.VerifierPlugin.Hyperlane.Binary import Chainweb.VerifierPlugin.Hyperlane.Utils import Chainweb.Version -import Pact.Core.Command.Types +import Pact.Core.Command.Types hiding (ChainId) import Pact.Core.Gas import Pact.Core.Names import Pact.Core.PactValue -import Pact.Core.Capabilities import Pact.Core.Verifiers -import Pact.Core.Signer import Pact.Core.Errors tests :: RocksDb -> TestTree diff --git a/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs b/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs index bebdab284d..f1d605073f 100644 --- a/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs +++ b/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs @@ -24,10 +24,11 @@ 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 -import Chainweb.Graph (singletonChainGraph) +import Chainweb.Graph (singletonChainGraph, pairChainGraph) import Chainweb.Logger import Chainweb.Mempool.Consensus import Chainweb.Mempool.InMem @@ -45,11 +46,13 @@ 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 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,50 +70,56 @@ 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) 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.Command.Types hiding (ChainId) +import Pact.Core.DefPacts.Types import Pact.Core.Gas.Types import Pact.Core.Hash qualified as Pact5 import Pact.Core.Names +import Pact.Core.ChainData (TxCreationTime(..)) import Pact.Core.PactValue 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 - { _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 +130,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" @@ -135,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 initial gas model" (testIntialGasModel baseRdb) ] simpleEndToEnd :: RocksDb -> IO () @@ -242,7 +254,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) @@ -559,6 +571,152 @@ 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 ----------------------------------------------- + -- 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 ----------------------------------------------- + -- 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 ----------------------------------------------- + -- 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 96)]) + , (chain1, P.alignExact ? Vector.fromList [P.fun _crGas ? P.equals (Gas 145)]) + ] + + {- tests = do -- * test that ValidateBlock does a destructive rewind to the parent of the block being validated @@ -585,9 +743,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 +770,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 diff --git a/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs b/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs index 84c85061ab..7c4f2c7cf3 100644 --- a/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs +++ b/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs @@ -93,7 +93,7 @@ import Pact.Core.ChainData (TxCreationTime(..)) import Pact.Core.Command.Crypto (signEd25519, exportEd25519Signature, importEd25519KeyPair, PrivateKeyBS (..)) import Pact.Core.Command.RPC (ContMsg (..)) import Pact.Core.Command.Server qualified as Pact5 -import Pact.Core.Command.Types +import Pact.Core.Command.Types hiding (ChainId) import Pact.Core.DefPacts.Types import Pact.Core.Errors import Pact.Core.Gas.Types @@ -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 256) ] , 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) <> "...") diff --git a/test/unit/Chainweb/Test/Pact5/SignedListPluginTests.hs b/test/unit/Chainweb/Test/Pact5/SignedListPluginTests.hs index c90b815387..9f02a3d7c3 100644 --- a/test/unit/Chainweb/Test/Pact5/SignedListPluginTests.hs +++ b/test/unit/Chainweb/Test/Pact5/SignedListPluginTests.hs @@ -31,13 +31,11 @@ import Chainweb.Test.TestVersions import Chainweb.Test.Utils import Chainweb.Version -import Pact.Core.Command.Types +import Pact.Core.Command.Types hiding (ChainId) import Pact.Core.Gas import Pact.Core.Names import Pact.Core.PactValue -import Pact.Core.Capabilities import Pact.Core.Verifiers -import Pact.Core.Signer -- | Test suite diff --git a/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs b/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs index 51b9d351aa..6561e9a0a4 100644 --- a/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs +++ b/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs @@ -51,7 +51,7 @@ import Data.Text.IO qualified as T import Chainweb.Test.Pact5.Utils hiding (withTempSQLiteResource) import GHC.Stack import Pact.Core.Capabilities -import Pact.Core.Command.Types +import Pact.Core.Command.Types hiding (ChainId) import Pact.Core.Compile(CompileValue(..)) import Pact.Core.Errors import Pact.Core.Evaluate @@ -62,7 +62,6 @@ import Pact.Core.Names import Pact.Core.PactValue import Pact.Core.Persistence hiding (pactDb) import Pact.Core.SPV (noSPVSupport) -import Pact.Core.Signer import Pact.Core.Verifiers import Pact.Types.KeySet qualified as Pact4 import Pact.JSON.Encode qualified as J