From 17baae4d3d59cba847473963bf4dd1573bff7d8c Mon Sep 17 00:00:00 2001 From: Edmund Noble Date: Sat, 25 May 2024 12:11:06 -0400 Subject: [PATCH] log: make tx failure logging into a counter Change-Id: I9986d5c9176c3c8f3aac803794b194c801c3514e --- bench/Chainweb/Pact/Backend/ForkingBench.hs | 2 +- changes/2024-05-30T150001-0400.txt | 1 + src/Chainweb/Chainweb.hs | 60 +++++++++++-------- src/Chainweb/Chainweb/ChainResources.hs | 7 ++- src/Chainweb/Pact/PactService.hs | 15 +++-- src/Chainweb/Pact/PactService/ExecBlock.hs | 4 +- src/Chainweb/Pact/Service/PactInProcApi.hs | 12 ++-- src/Chainweb/Pact/TransactionExec.hs | 20 ++++--- src/Chainweb/Pact/Types.hs | 6 ++ test/Chainweb/Test/Pact/Checkpointer.hs | 4 +- .../Test/Pact/ModuleCacheOnRestart.hs | 2 +- .../Chainweb/Test/Pact/PactSingleChainTest.hs | 4 +- test/Chainweb/Test/Pact/TransactionTests.hs | 2 +- test/Chainweb/Test/Pact/Utils.hs | 5 +- tools/cwtool/TxSimulator.hs | 4 +- tools/ea/Ea.hs | 2 +- 16 files changed, 94 insertions(+), 56 deletions(-) create mode 100644 changes/2024-05-30T150001-0400.txt diff --git a/bench/Chainweb/Pact/Backend/ForkingBench.hs b/bench/Chainweb/Pact/Backend/ForkingBench.hs index 99ecb79974..f5cbbee71e 100644 --- a/bench/Chainweb/Pact/Backend/ForkingBench.hs +++ b/bench/Chainweb/Pact/Backend/ForkingBench.hs @@ -318,7 +318,7 @@ withResources rdb trunkLength logLevel compact p f = C.envWithCleanup create des startPact version l bhdb pdb mempool sqlEnv = do reqQ <- newPactQueue pactQueueSize - a <- async $ runPactService version cid l reqQ mempool bhdb pdb sqlEnv testPactServiceConfig + a <- async $ runPactService version cid l Nothing reqQ mempool bhdb pdb sqlEnv testPactServiceConfig { _pactBlockGasLimit = 180_000 , _pactPersistIntraBlockWrites = p } diff --git a/changes/2024-05-30T150001-0400.txt b/changes/2024-05-30T150001-0400.txt new file mode 100644 index 0000000000..eadc84f327 --- /dev/null +++ b/changes/2024-05-30T150001-0400.txt @@ -0,0 +1 @@ +Failed transactions are logged at Debug rather than Info diff --git a/src/Chainweb/Chainweb.hs b/src/Chainweb/Chainweb.hs index 3c151b7d60..4c600e7c10 100644 --- a/src/Chainweb/Chainweb.hs +++ b/src/Chainweb/Chainweb.hs @@ -384,33 +384,41 @@ withChainwebInternal conf logger peer serviceSock rocksDb pactDbDir backupDir re logg Info "finished pruning databases" logFunctionJson logger Info InitializingChainResources + txFailuresCounter <- newCounter @"txFailures" + let monitorTxFailuresCounter = + runForever (logFunctionText logger) "monitor txFailuresCounter" $ do + approximateThreadDelay 60_000_000 {- 1 minute -} + logFunctionCounter logger Info . (:[]) =<< + roll txFailuresCounter logg Debug "start initializing chain resources" logFunctionText logger Info $ "opening pact db in directory " <> sshow pactDbDir - concurrentWith - -- initialize chains concurrently - (\cid x -> do - let mcfg = validatingMempoolConfig cid v (_configBlockGasLimit conf) (_configMinGasPrice conf) - -- NOTE: the gas limit may be set based on block height in future, so this approach may not be valid. - let maxGasLimit = fromIntegral <$> maxBlockGasLimit v maxBound - case maxGasLimit of - Just maxGasLimit' - | _configBlockGasLimit conf > maxGasLimit' -> - logg Warn $ T.unwords - [ "configured block gas limit is greater than the" - , "maximum for this chain; the maximum will be used instead" - ] - _ -> return () - withChainResources - v - cid - rocksDb - (chainLogger cid) - mcfg - payloadDb - pactDbDir - (pactConfig maxGasLimit) - x - ) + withAsync monitorTxFailuresCounter $ \_ -> + concurrentWith + -- initialize chains concurrently + (\cid x -> do + let mcfg = validatingMempoolConfig cid v (_configBlockGasLimit conf) (_configMinGasPrice conf) + -- NOTE: the gas limit may be set based on block height in future, so this approach may not be valid. + let maxGasLimit = fromIntegral <$> maxBlockGasLimit v maxBound + case maxGasLimit of + Just maxGasLimit' + | _configBlockGasLimit conf > maxGasLimit' -> + logg Warn $ T.unwords + [ "configured block gas limit is greater than the" + , "maximum for this chain; the maximum will be used instead" + ] + _ -> return () + withChainResources + v + cid + rocksDb + (chainLogger cid) + mcfg + payloadDb + pactDbDir + (pactConfig maxGasLimit) + txFailuresCounter + x + ) -- initialize global resources after all chain resources are initialized (\cs -> do @@ -805,7 +813,7 @@ runChainweb cw nowServing = do monitorConnectionsClosedByClient :: Counter "clientClosedConnections" -> IO () monitorConnectionsClosedByClient clientClosedConnectionsCounter = runForever logg "ConnectionClosedByClient.counter" $ do - approximateThreadDelay 60000000 {- 1 minute -} + approximateThreadDelay 60_000_000 {- 1 minute -} logFunctionCounter (_chainwebLogger cw) Info . (:[]) =<< roll clientClosedConnectionsCounter diff --git a/src/Chainweb/Chainweb/ChainResources.hs b/src/Chainweb/Chainweb/ChainResources.hs index 7646a48d15..94d120f32c 100644 --- a/src/Chainweb/Chainweb/ChainResources.hs +++ b/src/Chainweb/Chainweb/ChainResources.hs @@ -8,6 +8,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} -- | -- Module: Chainweb.Chainweb.ChainResources @@ -53,6 +54,7 @@ import Chainweb.Version import Chainweb.WebPactExecutionService import Chainweb.Storage.Table.RocksDB +import Chainweb.Counter -- -------------------------------------------------------------------------- -- -- Single Chain Resources @@ -88,16 +90,17 @@ withChainResources -> FilePath -- ^ database directory for checkpointer -> PactServiceConfig + -> Counter "txFailures" -> (ChainResources logger -> IO a) -> IO a withChainResources - v cid rdb logger mempoolCfg0 payloadDb pactDbDir pactConfig inner = + v cid rdb logger mempoolCfg0 payloadDb pactDbDir pactConfig txFailuresCounter inner = withBlockHeaderDb rdb v cid $ \cdb -> do pexMv <- newEmptyMVar let mempoolCfg = mempoolCfg0 pexMv Mempool.withInMemoryMempool_ (setComponent "mempool" logger) mempoolCfg v $ \mempool -> do mpc <- MPCon.mkMempoolConsensus mempool cdb $ Just payloadDb - withPactService v cid logger mpc cdb + withPactService v cid logger (Just txFailuresCounter) mpc cdb payloadDb pactDbDir pactConfig $ \requestQ -> do let pex = pes requestQ putMVar pexMv pex diff --git a/src/Chainweb/Pact/PactService.hs b/src/Chainweb/Pact/PactService.hs index 8860414f2a..1a6b9acad5 100644 --- a/src/Chainweb/Pact/PactService.hs +++ b/src/Chainweb/Pact/PactService.hs @@ -13,6 +13,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE DataKinds #-} -- | -- Module: Chainweb.Pact.PactService @@ -116,6 +117,7 @@ import Chainweb.Utils hiding (check) import Chainweb.Version import Chainweb.Version.Guards import Utils.Logging.Trace +import Chainweb.Counter runPactService :: Logger logger @@ -123,6 +125,7 @@ runPactService => ChainwebVersion -> ChainId -> logger + -> Maybe (Counter "txFailures") -> PactQueue -> MemPoolAccess -> BlockHeaderDb @@ -130,8 +133,8 @@ runPactService -> SQLiteEnv -> PactServiceConfig -> IO () -runPactService ver cid chainwebLogger reqQ mempoolAccess bhDb pdb sqlenv config = - void $ withPactService ver cid chainwebLogger bhDb pdb sqlenv config $ do +runPactService ver cid chainwebLogger txFailuresCounter reqQ mempoolAccess bhDb pdb sqlenv config = + void $ withPactService ver cid chainwebLogger txFailuresCounter bhDb pdb sqlenv config $ do initialPayloadState mempoolAccess ver cid serviceRequests mempoolAccess reqQ @@ -140,13 +143,14 @@ withPactService => ChainwebVersion -> ChainId -> logger + -> Maybe (Counter "txFailures") -> BlockHeaderDb -> PayloadDb tbl -> SQLiteEnv -> PactServiceConfig -> PactServiceM logger tbl a -> IO (T2 a PactServiceState) -withPactService ver cid chainwebLogger bhDb pdb sqlenv config act = +withPactService ver cid chainwebLogger txFailuresCounter bhDb pdb sqlenv config act = withProdRelationalCheckpointer checkpointerLogger (_pactModuleCacheLimit config) sqlenv (_pactPersistIntraBlockWrites config) ver cid $ \checkpointer -> do let !rs = readRewards let !pse = PactServiceEnv @@ -165,6 +169,7 @@ withPactService ver cid chainwebLogger bhDb pdb sqlenv config act = , _psGasLogger = gasLogger <$ guard (_pactLogGas config) , _psBlockGasLimit = _pactBlockGasLimit config , _psEnableLocalTimeout = _pactEnableLocalTimeout config + , _psTxFailuresCounter = txFailuresCounter } !pst = PactServiceState mempty @@ -772,7 +777,7 @@ execLocal cwtx preflight sigVerify rdepth = pactLabel "execLocal" $ do Right{} -> do let initialGas = initialGasOf $ P._cmdPayload cwtx T3 cr _mc warns <- liftIO $ applyCmd - _psVersion _psLogger _psGasLogger (_cpPactDbEnv dbEnv) + _psVersion _psLogger _psGasLogger Nothing (_cpPactDbEnv dbEnv) noMiner gasModel ctx spv cmd initialGas mc ApplyLocal @@ -1040,7 +1045,7 @@ execPreInsertCheckReq txs = pactLabel "execPreInsertCheckReq" $ do , P.FlagDisableHistoryInTransactionalMode ] ++ disableReturnRTC (ctxVersion pd) (ctxChainId pd) (ctxCurrentBlockHeight pd) - let buyGasEnv = TransactionEnv P.Transactional (_cpPactDbEnv dbEnv) l Nothing (ctxToPublicData pd) spv nid gasPrice rk gasLimit ec Nothing + let buyGasEnv = TransactionEnv P.Transactional (_cpPactDbEnv dbEnv) l Nothing (ctxToPublicData pd) spv nid gasPrice rk gasLimit ec Nothing Nothing cr <- liftIO $! catchesPactError l CensorsUnexpectedError diff --git a/src/Chainweb/Pact/PactService/ExecBlock.hs b/src/Chainweb/Pact/PactService/ExecBlock.hs index 5e1bce3a32..6a478b0a0c 100644 --- a/src/Chainweb/Pact/PactService/ExecBlock.hs +++ b/src/Chainweb/Pact/PactService/ExecBlock.hs @@ -423,6 +423,7 @@ applyPactCmd isGenesis miner txTimeLimit cmd = StateT $ \(T2 mcache maybeBlockGa logger <- view (psServiceEnv . psLogger) gasLogger <- view (psServiceEnv . psGasLogger) gasModel <- view (psServiceEnv . psGasModel) + txFailuresCounter <- view (psServiceEnv . psTxFailuresCounter) v <- view chainwebVersion let -- for errors so fatal that the tx doesn't make it in the block @@ -471,7 +472,8 @@ applyPactCmd isGenesis miner txTimeLimit cmd = StateT $ \(T2 mcache maybeBlockGa let txGas (T3 r _ _) = fromIntegral $ P._crGas r T3 r c _warns <- tracePactBlockM' "applyCmd" (J.toJsonViaEncode hsh) txGas $ do - liftIO $ txTimeout $ applyCmd v logger gasLogger (_cpPactDbEnv dbEnv) miner (gasModel txCtx) txCtx spv gasLimitedCmd initialGas mcache ApplySend + liftIO $ txTimeout $ + applyCmd v logger gasLogger txFailuresCounter (_cpPactDbEnv dbEnv) miner (gasModel txCtx) txCtx spv gasLimitedCmd initialGas mcache ApplySend pure $ T2 r c if isGenesis diff --git a/src/Chainweb/Pact/Service/PactInProcApi.hs b/src/Chainweb/Pact/Service/PactInProcApi.hs index 076e320471..1f9ecfdbff 100644 --- a/src/Chainweb/Pact/Service/PactInProcApi.hs +++ b/src/Chainweb/Pact/Service/PactInProcApi.hs @@ -8,6 +8,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} -- | -- Module: Chainweb.Pact.Service.PactInProcApi @@ -51,6 +52,7 @@ import Chainweb.Version import Data.LogMessage import GHC.Stack (HasCallStack) +import Chainweb.Counter (Counter) -- | Initialization for Pact (in process) Api withPactService @@ -59,6 +61,7 @@ withPactService => ChainwebVersion -> ChainId -> logger + -> Maybe (Counter "txFailures") -> MempoolConsensus -> BlockHeaderDb -> PayloadDb tbl @@ -66,9 +69,9 @@ withPactService -> PactServiceConfig -> (PactQueue -> IO a) -> IO a -withPactService ver cid logger mpc bhdb pdb pactDbDir config action = +withPactService ver cid logger txFailuresCounter mpc bhdb pdb pactDbDir config action = withSqliteDb cid logger pactDbDir (_pactResetDb config) $ \sqlenv -> - withPactService' ver cid logger mpa bhdb pdb sqlenv config action + withPactService' ver cid logger txFailuresCounter mpa bhdb pdb sqlenv config action where mpa = pactMemPoolAccess mpc $ addLabel ("sub-component", "MempoolAccess") logger @@ -81,6 +84,7 @@ withPactService' => ChainwebVersion -> ChainId -> logger + -> Maybe (Counter "txFailures") -> MemPoolAccess -> BlockHeaderDb -> PayloadDb tbl @@ -88,14 +92,14 @@ withPactService' -> PactServiceConfig -> (PactQueue -> IO a) -> IO a -withPactService' ver cid logger memPoolAccess bhDb pdb sqlenv config action = do +withPactService' ver cid logger txFailuresCounter memPoolAccess bhDb pdb sqlenv config action = do reqQ <- newPactQueue (_pactQueueSize config) race (concurrently_ (monitor reqQ) (server reqQ)) (action reqQ) >>= \case Left () -> error "Chainweb.Pact.Service.PactInProcApi: pact service terminated unexpectedly" Right a -> return a where server reqQ = runForever logg "pact-service" - $ PS.runPactService ver cid logger reqQ memPoolAccess bhDb pdb sqlenv config + $ PS.runPactService ver cid logger txFailuresCounter reqQ memPoolAccess bhDb pdb sqlenv config logg = logFunction logger monitor = runPactServiceQueueMonitor $ addLabel ("sub-component", "PactQueue") logger diff --git a/src/Chainweb/Pact/TransactionExec.hs b/src/Chainweb/Pact/TransactionExec.hs index 5814b9c3aa..844d642a3b 100644 --- a/src/Chainweb/Pact/TransactionExec.hs +++ b/src/Chainweb/Pact/TransactionExec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} @@ -68,7 +69,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Short as SB import Data.Decimal (Decimal, roundTo) import Data.Default (def) -import Data.Foldable (fold, for_) +import Data.Foldable (fold, for_, traverse_) import Data.IORef import qualified Data.HashMap.Strict as HM import qualified Data.List as List @@ -81,6 +82,7 @@ import qualified System.LogLevel as L -- internal Pact modules +import Chainweb.Counter import Chainweb.Pact.Backend.Types (_cpPactDbEnv) import Pact.Eval (eval, liftTerm) import Pact.Gas (freeGasEnv) @@ -172,6 +174,7 @@ applyCmd -- ^ Pact logger -> Maybe logger -- ^ Pact gas logger + -> Maybe (Counter "txFailures") -> PactDbEnv p -- ^ Pact db environment -> Miner @@ -191,7 +194,7 @@ applyCmd -> ApplyCmdExecutionContext -- ^ is this a local or send execution context? -> IO (T3 (CommandResult [TxLogJson]) ModuleCache (S.Set PactWarning)) -applyCmd v logger gasLogger pdbenv miner gasModel txCtx spv cmd initialGas mcache0 callCtx = do +applyCmd v logger gasLogger txFailuresCounter pdbenv miner gasModel txCtx spv cmd initialGas mcache0 callCtx = do T2 cr st <- runTransactionM cenv txst applyBuyGas let cache = _txCache st @@ -214,7 +217,7 @@ applyCmd v logger gasLogger pdbenv miner gasModel txCtx spv cmd initialGas mcach <> flagsFor v (ctxChainId txCtx) (ctxCurrentBlockHeight txCtx) cenv = TransactionEnv Transactional pdbenv logger gasLogger (ctxToPublicData txCtx) spv nid gasPrice - requestKey (fromIntegral gasLimit) executionConfigNoHistory quirkGasFee + requestKey (fromIntegral gasLimit) executionConfigNoHistory quirkGasFee txFailuresCounter !requestKey = cmdToRequestKey cmd !gasPrice = view cmdGasPrice cmd @@ -358,6 +361,7 @@ applyGenesisCmd logger dbEnv spv txCtx cmd = -- after the block height where pact4.4 is on. <> S.fromList [ FlagDisableInlineMemCheck, FlagDisablePact44 ] , _txQuirkGasFee = Nothing + , _txTxFailuresCounter = Nothing } txst = TransactionState { _txCache = mempty @@ -444,7 +448,7 @@ applyCoinbase v logger dbEnv (Miner mid mks@(MinerKeys mk)) reward@(ParsedDecima , flagsFor v (ctxChainId txCtx) (ctxCurrentBlockHeight txCtx) ] tenv = TransactionEnv Transactional dbEnv logger Nothing (ctxToPublicData txCtx) noSPVSupport - Nothing 0.0 rk 0 ec Nothing + Nothing 0.0 rk 0 ec Nothing Nothing txst = TransactionState mc mempty 0 Nothing (_geGasModel freeGasEnv) mempty initState = setModuleCache mc $ initCapabilities [magic_COINBASE] rk = RequestKey chash @@ -519,7 +523,7 @@ applyLocal logger gasLogger dbEnv gasModel txCtx spv cmdIn mc execConfig = !gasPrice = view cmdGasPrice cmd !gasLimit = view cmdGasLimit cmd tenv = TransactionEnv Local dbEnv logger gasLogger (ctxToPublicData txCtx) spv nid gasPrice - rk (fromIntegral gasLimit) execConfig Nothing + rk (fromIntegral gasLimit) execConfig Nothing Nothing txst = TransactionState mc mempty 0 Nothing gasModel mempty gas0 = initialGasOf (_cmdPayload cmdIn) currHeight = ctxCurrentBlockHeight txCtx @@ -581,7 +585,7 @@ readInitModules = do nid = Nothing chash = pactInitialHash tenv = TransactionEnv Local dbEnv logger Nothing (ctxToPublicData txCtx) noSPVSupport nid 0.0 - rk 0 def Nothing + rk 0 def Nothing Nothing txst = TransactionState mempty mempty 0 Nothing (_geGasModel freeGasEnv) mempty interp = defaultInterpreter die msg = throwM $ PactInternalError $ "readInitModules: " <> msg @@ -709,8 +713,10 @@ failTxWith err msg = do rk <- view txRequestKey l <- view txLogger - liftIO $ logFunction l L.Info + liftIO $ logFunction l L.Debug (TxFailureLog rk err msg) + liftIO . traverse_ inc + =<< view txTxFailuresCounter return $! CommandResult rk Nothing (PactResult (Left err)) gas (Just logs) Nothing Nothing [] diff --git a/src/Chainweb/Pact/Types.hs b/src/Chainweb/Pact/Types.hs index 9c5c8097c8..cffb940637 100644 --- a/src/Chainweb/Pact/Types.hs +++ b/src/Chainweb/Pact/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} @@ -63,6 +64,7 @@ module Chainweb.Pact.Types , txRequestKey , txExecutionConfig , txQuirkGasFee + , txTxFailuresCounter -- * Transaction Execution Monad , TransactionM(..) @@ -87,6 +89,7 @@ module Chainweb.Pact.Types , psAllowReadsInLocal , psBlockGasLimit , psEnableLocalTimeout + , psTxFailuresCounter -- * TxContext , TxContext(..) @@ -213,6 +216,7 @@ import Chainweb.BlockHeader import Chainweb.BlockHeight import Chainweb.BlockHeaderDB import Chainweb.ChainId +import Chainweb.Counter import Chainweb.Mempool.Mempool (TransactionHash) import Chainweb.Miner.Pact import Chainweb.Logger @@ -338,6 +342,7 @@ data TransactionEnv logger db = TransactionEnv , _txGasLimit :: !Gas , _txExecutionConfig :: !ExecutionConfig , _txQuirkGasFee :: !(Maybe Gas) + , _txTxFailuresCounter :: !(Maybe (Counter "txFailures")) } makeLenses ''TransactionEnv @@ -440,6 +445,7 @@ data PactServiceEnv logger tbl = PactServiceEnv , _psBlockGasLimit :: !GasLimit , _psEnableLocalTimeout :: !Bool + , _psTxFailuresCounter :: !(Maybe (Counter "txFailures")) } makeLenses ''PactServiceEnv diff --git a/test/Chainweb/Test/Pact/Checkpointer.hs b/test/Chainweb/Test/Pact/Checkpointer.hs index 0d12322941..9f2360b210 100644 --- a/test/Chainweb/Test/Pact/Checkpointer.hs +++ b/test/Chainweb/Test/Pact/Checkpointer.hs @@ -665,7 +665,7 @@ runExec cp pactdbenv eData eCode = do h' = H.toUntypedHash (H.hash "" :: H.PactHash) cmdenv :: TransactionEnv logger (BlockEnv logger) cmdenv = TransactionEnv Transactional pactdbenv (_cpLogger $ _cpReadCp cp) Nothing def - noSPVSupport Nothing 0.0 (RequestKey h') 0 def Nothing + noSPVSupport Nothing 0.0 (RequestKey h') 0 def Nothing Nothing cmdst = TransactionState mempty mempty 0 Nothing (_geGasModel freeGasEnv) mempty runCont :: Logger logger => Checkpointer logger -> ChainwebPactDbEnv logger -> PactId -> Int -> IO EvalResult @@ -677,7 +677,7 @@ runCont cp pactdbenv pactId step = do h' = H.toUntypedHash (H.hash "" :: H.PactHash) cmdenv = TransactionEnv Transactional pactdbenv (_cpLogger $ _cpReadCp cp) Nothing def - noSPVSupport Nothing 0.0 (RequestKey h') 0 def Nothing + noSPVSupport Nothing 0.0 (RequestKey h') 0 def Nothing Nothing cmdst = TransactionState mempty mempty 0 Nothing (_geGasModel freeGasEnv) mempty -- -------------------------------------------------------------------------- -- diff --git a/test/Chainweb/Test/Pact/ModuleCacheOnRestart.hs b/test/Chainweb/Test/Pact/ModuleCacheOnRestart.hs index c0763851f7..4ce16ca60a 100644 --- a/test/Chainweb/Test/Pact/ModuleCacheOnRestart.hs +++ b/test/Chainweb/Test/Pact/ModuleCacheOnRestart.hs @@ -295,7 +295,7 @@ withPact' bdbio ioSqlEnv r (ps, cacheTest) tastylog = do let pdb = _bdbPayloadDb bdb sqlEnv <- ioSqlEnv T2 _ pstate <- withPactService - testVer testChainId logger bhdb pdb sqlEnv testPactServiceConfig ps + testVer testChainId logger Nothing bhdb pdb sqlEnv testPactServiceConfig ps cacheTest r (_psInitCache pstate) where logger = genericLogger Quiet (tastylog . T.unpack) diff --git a/test/Chainweb/Test/Pact/PactSingleChainTest.hs b/test/Chainweb/Test/Pact/PactSingleChainTest.hs index eadec4b63a..d288584fd1 100644 --- a/test/Chainweb/Test/Pact/PactSingleChainTest.hs +++ b/test/Chainweb/Test/Pact/PactSingleChainTest.hs @@ -273,7 +273,7 @@ rosettaFailsWithoutFullHistory rdb = let payloadDb = _bdbPayloadDb blockDb let cfg = testPactServiceConfig { _pactFullHistoryRequired = True } let logger = genericLogger System.LogLevel.Error (\_ -> return ()) - e <- try $ runPactService testVersion cid logger pactQueue mempool bhDb payloadDb sqlEnv cfg + e <- try $ runPactService testVersion cid logger Nothing pactQueue mempool bhDb payloadDb sqlEnv cfg case e of Left (FullHistoryRequired {}) -> do pure () @@ -980,7 +980,7 @@ compactionSetup pat rdb pactCfg f = let logger = genericLogger System.LogLevel.Error (\_ -> return ()) - void $ forkIO $ runPactService testVersion cid logger pactQueue mempool bhDb payloadDb sqlEnv pactCfg + void $ forkIO $ runPactService testVersion cid logger Nothing pactQueue mempool bhDb payloadDb sqlEnv pactCfg setOneShotMempool mempoolRef goldenMemPool diff --git a/test/Chainweb/Test/Pact/TransactionTests.hs b/test/Chainweb/Test/Pact/TransactionTests.hs index c41effef38..d65d9d9b12 100644 --- a/test/Chainweb/Test/Pact/TransactionTests.hs +++ b/test/Chainweb/Test/Pact/TransactionTests.hs @@ -261,7 +261,7 @@ testCoinbase797DateFix = testCaseSteps "testCoinbase791Fix" $ \step -> do let h = H.toUntypedHash (H.hash "" :: H.PactHash) tenv = TransactionEnv Transactional pdb logger Nothing def - noSPVSupport Nothing 0.0 (RequestKey h) 0 def Nothing + noSPVSupport Nothing 0.0 (RequestKey h) 0 def Nothing Nothing txst = TransactionState mempty mempty 0 Nothing (_geGasModel freeGasEnv) mempty CommandResult _ _ (PactResult pr) _ _ _ _ _ <- evalTransactionM tenv txst $! diff --git a/test/Chainweb/Test/Pact/Utils.hs b/test/Chainweb/Test/Pact/Utils.hs index 0b860cb152..f6331bf67b 100644 --- a/test/Chainweb/Test/Pact/Utils.hs +++ b/test/Chainweb/Test/Pact/Utils.hs @@ -705,6 +705,7 @@ testPactCtxSQLite logger v cid bhdb pdb sqlenv conf gasmodel = do , _psBlockGasLimit = _pactBlockGasLimit conf , _psEnableLocalTimeout = False + , _psTxFailuresCounter = Nothing } freeGasModel :: TxContext -> GasModel @@ -909,7 +910,7 @@ withPactTestBlockDb' version cid rdb sqlEnvIO mempoolIO pactConfig f = bhdb <- getWebBlockHeaderDb (_bdbWebBlockHeaderDb bdb) cid let pdb = _bdbPayloadDb bdb a <- async $ runForever (\_ _ -> return ()) "Chainweb.Test.Pact.Utils.withPactTestBlockDb" $ - runPactService version cid logger reqQ mempool bhdb pdb sqlEnv pactConfig + runPactService version cid logger Nothing reqQ mempool bhdb pdb sqlEnv pactConfig return (a, (sqlEnv,reqQ,bdb)) stopPact (a, _) = cancel a @@ -965,7 +966,7 @@ withPactTestBlockDb version cid rdb mempoolIO pactConfig f = let pdb = _bdbPayloadDb bdb sqlEnv <- startSqliteDb cid logger dir False a <- async $ runForever (\_ _ -> return ()) "Chainweb.Test.Pact.Utils.withPactTestBlockDb" $ - runPactService version cid logger reqQ mempool bhdb pdb sqlEnv pactConfig + runPactService version cid logger Nothing reqQ mempool bhdb pdb sqlEnv pactConfig return (a, (sqlEnv,reqQ,bdb)) stopPact (a, (sqlEnv, _, _)) = cancel a >> stopSqliteDb sqlEnv diff --git a/tools/cwtool/TxSimulator.hs b/tools/cwtool/TxSimulator.hs index dbf95dfc6d..3a08fa3d4e 100644 --- a/tools/cwtool/TxSimulator.hs +++ b/tools/cwtool/TxSimulator.hs @@ -141,13 +141,14 @@ simulate sc@(SimConfig dbDir txIdx' _ _ cid ver gasLog doTypecheck) = do , _psGasLogger = gasLogger , _psBlockGasLimit = testBlockGasLimit , _psEnableLocalTimeout = False + , _psTxFailuresCounter = Nothing } evalPactServiceM (PactServiceState mempty) psEnv $ readFrom (Just parent) $ do mc <- readInitModules T3 !cr _mc _ <- do dbEnv <- view psBlockDbEnv liftIO $ trace (logFunction cwLogger) "applyCmd" () 1 $ - applyCmd ver logger gasLogger (_cpPactDbEnv dbEnv) miner (getGasModel txc) + applyCmd ver logger gasLogger Nothing (_cpPactDbEnv dbEnv) miner (getGasModel txc) txc noSPVSupport cmd (initGas cmdPwt) mc ApplySend liftIO $ T.putStrLn (J.encodeText (J.Array <$> cr)) (_,True) -> do @@ -200,6 +201,7 @@ simulate sc@(SimConfig dbDir txIdx' _ _ cid ver gasLog doTypecheck) = do , _psGasLogger = gasLogger , _psBlockGasLimit = testBlockGasLimit , _psEnableLocalTimeout = False + , _psTxFailuresCounter = Nothing } pss = PactServiceState { _psInitCache = mempty diff --git a/tools/ea/Ea.hs b/tools/ea/Ea.hs index bce1bef14c..55089c4233 100644 --- a/tools/ea/Ea.hs +++ b/tools/ea/Ea.hs @@ -179,7 +179,7 @@ genPayloadModule v tag cid cwTxs = pdb <- newPayloadDb withSystemTempDirectory "ea-pact-db" $ \pactDbDir -> do T2 payloadWO _ <- withSqliteDb cid logger pactDbDir False $ \env -> - withPactService v cid logger bhdb pdb env testPactServiceConfig $ + withPactService v cid logger Nothing bhdb pdb env testPactServiceConfig $ execNewGenesisBlock noMiner (V.fromList cwTxs) return $ TL.toStrict $ TB.toLazyText $ payloadModuleCode tag payloadWO