Skip to content

Commit

Permalink
log: make tx failure logging into a counter
Browse files Browse the repository at this point in the history
Change-Id: I9986d5c9176c3c8f3aac803794b194c801c3514e
  • Loading branch information
edmundnoble committed May 30, 2024
1 parent 10b76b1 commit a622cd2
Show file tree
Hide file tree
Showing 16 changed files with 93 additions and 55 deletions.
2 changes: 1 addition & 1 deletion bench/Chainweb/Pact/Backend/ForkingBench.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
}
Expand Down
1 change: 1 addition & 0 deletions changes/2024-05-30T150001-0400.txt
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Failed transactions are logged at Debug rather than Info
58 changes: 33 additions & 25 deletions src/Chainweb/Chainweb.hs
Original file line number Diff line number Diff line change
Expand Up @@ -381,32 +381,40 @@ 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 60000000 {- 1 minute -}
logFunctionCounter logger Info . (:[]) =<<
roll txFailuresCounter
logg Info "start initializing chain resources"
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
Expand Down
7 changes: 5 additions & 2 deletions src/Chainweb/Chainweb/ChainResources.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}

-- |
-- Module: Chainweb.Chainweb.ChainResources
Expand Down Expand Up @@ -53,6 +54,7 @@ import Chainweb.Version
import Chainweb.WebPactExecutionService

import Chainweb.Storage.Table.RocksDB
import Chainweb.Counter

-- -------------------------------------------------------------------------- --
-- Single Chain Resources
Expand Down Expand Up @@ -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
Expand Down
15 changes: 10 additions & 5 deletions src/Chainweb/Pact/PactService.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DataKinds #-}

-- |
-- Module: Chainweb.Pact.PactService
Expand Down Expand Up @@ -117,22 +118,24 @@ import Chainweb.Utils hiding (check)
import Chainweb.Version
import Chainweb.Version.Guards
import Utils.Logging.Trace
import Chainweb.Counter

runPactService
:: Logger logger
=> CanReadablePayloadCas tbl
=> ChainwebVersion
-> ChainId
-> logger
-> Maybe (Counter "txFailures")
-> PactQueue
-> MemPoolAccess
-> BlockHeaderDb
-> PayloadDb tbl
-> 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

Expand All @@ -141,13 +144,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
Expand All @@ -166,6 +170,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

Expand Down Expand Up @@ -763,7 +768,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

Expand Down Expand Up @@ -1015,7 +1020,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
Expand Down
4 changes: 3 additions & 1 deletion src/Chainweb/Pact/PactService/ExecBlock.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
12 changes: 8 additions & 4 deletions src/Chainweb/Pact/Service/PactInProcApi.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module: Chainweb.Pact.Service.PactInProcApi
Expand Down Expand Up @@ -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
Expand All @@ -59,16 +61,17 @@ withPactService
=> ChainwebVersion
-> ChainId
-> logger
-> Maybe (Counter "txFailures")
-> MempoolConsensus
-> BlockHeaderDb
-> PayloadDb tbl
-> FilePath
-> 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

Expand All @@ -81,21 +84,22 @@ withPactService'
=> ChainwebVersion
-> ChainId
-> logger
-> Maybe (Counter "txFailures")
-> MemPoolAccess
-> BlockHeaderDb
-> PayloadDb tbl
-> SQLiteEnv
-> 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

Expand Down
20 changes: 13 additions & 7 deletions src/Chainweb/Pact/TransactionExec.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
Expand Down Expand Up @@ -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
Expand All @@ -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)
Expand Down Expand Up @@ -172,6 +174,7 @@ applyCmd
-- ^ Pact logger
-> Maybe logger
-- ^ Pact gas logger
-> Maybe (Counter "txFailures")
-> PactDbEnv p
-- ^ Pact db environment
-> Miner
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 []
Expand Down
Loading

0 comments on commit a622cd2

Please sign in to comment.