Skip to content

Commit 5750d4a

Browse files
larskuhtzedmundnoble
larskuhtz
authored and
edmundnoble
committed
be lenient during rewind when reintroducing transactions
1 parent f920656 commit 5750d4a

File tree

2 files changed

+76
-83
lines changed

2 files changed

+76
-83
lines changed

‎src/Chainweb/Pact/PactService.hs

Lines changed: 69 additions & 74 deletions
Original file line numberDiff line numberDiff line change
@@ -40,90 +40,79 @@ module Chainweb.Pact.PactService
4040
) where
4141

4242
import Control.Concurrent.Async
43-
import Control.Concurrent.STM
44-
import Control.Exception.Safe (mask)
45-
import Control.Lens hiding ((:>))
46-
import Control.Monad
47-
import Control.Monad.Cont (evalContT)
48-
import Control.Monad.Except
49-
import Control.Monad.Reader
50-
import Control.Monad.State.Strict
51-
import Control.Monad.Trans.Resource
52-
53-
import Data.Either
54-
import Data.Foldable (traverse_)
55-
import qualified Data.HashMap.Strict as HM
56-
import Data.Maybe
57-
import Data.Monoid
58-
import Data.Pool (Pool)
59-
import qualified Data.Text as Text
60-
import Data.Vector (Vector)
61-
import qualified Data.Vector as V
62-
63-
import System.IO
64-
import System.LogLevel
65-
66-
import Prelude hiding (lookup)
67-
68-
import qualified Pact.JSON.Encode as J
69-
70-
import qualified Pact.Core.Gas as Pact
71-
72-
import qualified Chainweb.Pact.TransactionExec as Pact
73-
import qualified Chainweb.Pact.Validations as Pact
74-
7543
import Chainweb.BlockHash
7644
import Chainweb.BlockHeader
7745
import Chainweb.BlockHeight
7846
import Chainweb.ChainId
47+
import Chainweb.Core.Brief
48+
import Chainweb.Counter
7949
import Chainweb.Logger
8050
import Chainweb.Mempool.Mempool as Mempool
8151
import Chainweb.Miner.Pact
82-
52+
import Chainweb.Pact.Backend.ChainwebPactDb qualified as ChainwebPactDb
53+
import Chainweb.Pact.Backend.ChainwebPactDb qualified as Pact
54+
import Chainweb.Pact.Backend.Types
55+
import Chainweb.Pact.Backend.Utils (withSavepoint, SavepointName (..))
56+
import Chainweb.Pact.NoCoinbase qualified as Pact
57+
import Chainweb.Pact.PactService.Checkpointer qualified as Checkpointer
8358
import Chainweb.Pact.PactService.ExecBlock
84-
import qualified Chainweb.Pact.Backend.ChainwebPactDb as Pact
59+
import Chainweb.Pact.PactService.ExecBlock qualified as Pact
60+
import Chainweb.Pact.Transaction qualified as Pact
61+
import Chainweb.Pact.TransactionExec qualified as Pact
8562
import Chainweb.Pact.Types
86-
-- import Chainweb.Pact.SPV qualified as Pact
63+
import Chainweb.Pact.Validations qualified as Pact
8764
import Chainweb.Parent
8865
import Chainweb.Payload
8966
import Chainweb.Payload.PayloadStore
67+
import Chainweb.PayloadProvider
68+
import Chainweb.PayloadProvider.P2P
69+
import Chainweb.PayloadProvider.P2P.RestAPI.Client qualified as Rest
70+
import Chainweb.Ranked
71+
import Chainweb.Storage.Table
72+
import Chainweb.Storage.Table.Map qualified as MapTable
9073
import Chainweb.Time
91-
import qualified Chainweb.Pact.Transaction as Pact
9274
import Chainweb.Utils hiding (check)
9375
import Chainweb.Version
94-
import Chainweb.Counter
95-
import Pact.Core.Command.Types qualified as Pact
96-
import Pact.Core.Hash qualified as Pact
76+
import Control.Concurrent.STM
77+
import Control.Exception.Safe (mask)
78+
import Control.Lens hiding ((:>))
79+
import Control.Monad
80+
import Control.Monad.Cont (evalContT)
81+
import Control.Monad.Except
82+
import Control.Monad.Reader
83+
import Control.Monad.State.Strict
84+
import Control.Monad.Trans.Resource
85+
import Control.Parallel.Strategies qualified as Strategies
86+
import Data.Align
9787
import Data.ByteString.Short qualified as SB
9888
import Data.Coerce (coerce)
89+
import Data.DList qualified as DList
90+
import Data.Either
91+
import Data.Foldable (traverse_)
92+
import Data.HashMap.Strict qualified as HM
93+
import Data.List.NonEmpty qualified as NEL
94+
import Data.List.NonEmpty qualified as NonEmpty
95+
import Data.Maybe
96+
import Data.Monoid
97+
import Data.Pool (Pool)
98+
import Data.Pool qualified as Pool
99+
import Data.Text qualified as Text
100+
import Data.Vector (Vector)
101+
import Data.Vector qualified as V
99102
import Data.Void
100-
import Chainweb.Pact.PactService.ExecBlock qualified as Pact
101-
import qualified Pact.Core.Evaluate as Pact
102-
import qualified Pact.Core.Errors as Pact
103-
import Chainweb.Pact.Backend.Types
104-
import qualified Chainweb.Pact.PactService.Checkpointer as Checkpointer
105-
import qualified Pact.Core.StableEncoding as Pact
106-
import qualified Data.List.NonEmpty as NonEmpty
107-
import Chainweb.PayloadProvider
108-
import Chainweb.Storage.Table
109-
import qualified Chainweb.Storage.Table.Map as MapTable
110-
import Chainweb.PayloadProvider.P2P
111-
import P2P.TaskQueue (Priority(..))
112-
import qualified Network.HTTP.Client as HTTP
113-
import qualified Chainweb.PayloadProvider.P2P.RestAPI.Client as Rest
114-
import Chainweb.Pact.Backend.Utils (withSavepoint, SavepointName (..))
115-
import qualified Data.DList as DList
116-
import Chainweb.Ranked
117-
import qualified Chainweb.Pact.Backend.ChainwebPactDb as ChainwebPactDb
118-
import qualified Pact.Core.ChainData as Pact
119103
import GHC.Stack (HasCallStack)
120-
import qualified Data.Pool as Pool
121-
import qualified Data.List.NonEmpty as NEL
122-
import qualified Control.Parallel.Strategies as Strategies
123-
import qualified Chainweb.Pact.NoCoinbase as Pact
124-
import Chainweb.Core.Brief
125-
import Data.Align
126-
import qualified Data.List.NonEmpty as NE
104+
import Network.HTTP.Client qualified as HTTP
105+
import P2P.TaskQueue (Priority(..))
106+
import Pact.Core.ChainData qualified as Pact
107+
import Pact.Core.Command.Types qualified as Pact
108+
import Pact.Core.Errors qualified as Pact
109+
import Pact.Core.Evaluate qualified as Pact
110+
import Pact.Core.Gas qualified as Pact
111+
import Pact.Core.Hash qualified as Pact
112+
import Pact.Core.StableEncoding qualified as Pact
113+
import Pact.JSON.Encode qualified as J
114+
import Prelude hiding (lookup)
115+
import System.LogLevel
127116

128117
withPactService
129118
:: (Logger logger, CanPayloadCas tbl)
@@ -562,7 +551,7 @@ syncToFork logger serviceEnv hints forkInfo = do
562551
let validatedTxs = msum blockResults
563552
Checkpointer.setConsensusState sql forkInfo._forkInfoTargetState
564553
return (rewoundTxs, validatedTxs, forkInfo._forkInfoTargetState)
565-
liftIO $ mpaProcessFork memPoolAccess (rewoundTxs, validatedTxs)
554+
liftIO $ mpaProcessFork memPoolAccess (V.concat rewoundTxs, validatedTxs)
566555
case forkInfo._forkInfoNewBlockCtx of
567556
Just newBlockCtx
568557
| Just _ <- _psMiner serviceEnv
@@ -630,16 +619,22 @@ syncToFork logger serviceEnv hints forkInfo = do
630619

631620
-- remember to call this *before* executing the actual rewind,
632621
-- and only alter the mempool *after* the db transaction is done.
633-
getRewoundTxs :: Parent BlockHeight -> IO (Vector Pact.Transaction)
622+
getRewoundTxs :: Parent BlockHeight -> IO [Vector Pact.Transaction]
634623
getRewoundTxs rewindTargetHeight = do
635624
rewoundPayloadHashes <- Checkpointer.getPayloadsAfter sql rewindTargetHeight
636-
rewoundPayloads <- liftIO $ fmap fromJuste <$>
637-
lookupPayloadDataWithHeightBatch
638-
(_payloadStoreTable pdb)
639-
[(Just (rank rbph), _ranked rbph) | rbph <- rewoundPayloadHashes]
640-
V.concat <$> traverse
641-
(fmap (fromRight (error "invalid payload in database")) . runExceptT . pact5TransactionsFromPayload)
642-
rewoundPayloads
625+
rewoundPayloads <- lookupPayloadDataWithHeightBatch
626+
(_payloadStoreTable pdb)
627+
[(Just (rank rbph), _ranked rbph) | rbph <- rewoundPayloadHashes]
628+
forM (zip rewoundPayloadHashes rewoundPayloads) $ \case
629+
(rbph, Nothing) -> do
630+
logFunctionText logger Error $ "missing payload in database: " <> brief rbph
631+
return V.empty
632+
(rbph, Just payload) -> case pact5TransactionsFromPayload payload of
633+
Right txs -> do
634+
return txs
635+
Left err -> do
636+
logFunctionText logger Error $ "invalid payload in database (" <> brief rbph <> "): " <> sshow err
637+
return V.empty
643638

644639
-- | Start a thread that makes fresh payloads periodically
645640
startPayloadRefresher :: Logger logger => HasVersion => logger -> ServiceEnv tbl -> BlockInProgress -> IO ()

‎src/Chainweb/Pact/PactService/ExecBlock.hs

Lines changed: 7 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -488,22 +488,20 @@ validateParsedChainwebTx _logger blockEnv tx
488488
signers = Pact._pSigners $ view Pact.payloadObj $ Pact._cmdPayload t
489489

490490
pact5TransactionsFromPayload
491-
:: forall m
492-
. MonadIO m
493-
=> PayloadData
494-
-> ExceptT BlockInvalidError m (Vector Pact.Transaction)
491+
:: PayloadData
492+
-> Either BlockInvalidError (Vector Pact.Transaction)
495493
pact5TransactionsFromPayload plData = do
496-
vtrans <- liftIO $
497-
mapM toCWTransaction $
498-
toList (view payloadDataTransactions plData)
494+
let vtrans =
495+
map toCWTransaction $
496+
toList (view payloadDataTransactions plData)
499497
let (theLefts, theRights) = partitionEithers vtrans
500498
unless (null theLefts) $ do
501499
let ls = map T.pack theLefts
502500
throwError $ BlockInvalidDueToTxDecodeFailure ls
503501
return $! V.fromList theRights
504502
where
505503
toCWTransaction bs =
506-
evaluate (force (codecDecode commandCodec $ _transactionBytes bs))
504+
codecDecode commandCodec (_transactionBytes bs)
507505

508506
execExistingBlock
509507
:: (CanReadablePayloadCas tbl, Logger logger)
@@ -517,7 +515,7 @@ execExistingBlock logger serviceEnv blockEnv payload = do
517515
let blockCtx = _psBlockCtx blockEnv
518516
let plData = checkablePayloadToPayloadData payload
519517
miner :: Miner <- decodeStrictOrThrow (_minerData $ view payloadDataMiner plData)
520-
txs <- lift $ pact5TransactionsFromPayload plData
518+
txs <- liftEither $ pact5TransactionsFromPayload plData
521519
let
522520
errors <- liftIO $ flip foldMap txs $ \tx -> do
523521
errorOrSuccess <- runExceptT $

0 commit comments

Comments
 (0)