From cee052c5aaece0aa9acd22b6b2c0e9b8fff7b12c Mon Sep 17 00:00:00 2001 From: Edmund Noble Date: Tue, 28 Jan 2025 20:36:39 -0500 Subject: [PATCH] Update to newer Pact 5 This provides us with a more compatible format for errors in CommandResults, avoiding some breakage to wallets, in particular Chainweaver. Change-Id: Id0000000525b3f854ef3d89b28a22593fcc39612 --- bench/Chainweb/Utils/Bench.hs | 8 ----- cabal.project | 4 +-- src/Chainweb/Pact/PactService.hs | 16 ++++++--- src/Chainweb/Pact/RestAPI/Server.hs | 20 ++++++----- src/Chainweb/Pact/Types.hs | 15 ++++---- test/lib/Chainweb/Test/Utils.hs | 3 +- .../Test/Pact5/HyperlanePluginTests.hs | 35 +++++++++---------- .../Chainweb/Test/Pact5/RemotePactTest.hs | 28 ++++++++------- .../Test/Pact5/TransactionExecTest.hs | 23 ++++++++++++ 9 files changed, 89 insertions(+), 63 deletions(-) diff --git a/bench/Chainweb/Utils/Bench.hs b/bench/Chainweb/Utils/Bench.hs index 9abe6ca78..d2c3a8850 100644 --- a/bench/Chainweb/Utils/Bench.hs +++ b/bench/Chainweb/Utils/Bench.hs @@ -64,14 +64,6 @@ instance NFData (MempoolBackend a) where instance NFData PactQueue where rnf !_ = () -instance (NFData info) => NFData (PactErrorCompat info) where - rnf = \case - PEPact5Error errorCode -> rnf errorCode - PELegacyError legacyError -> rnf legacyError - -instance (NFData info) => NFData (PactErrorCode info) where - rnf (PactErrorCode a b c) = rnf a `seq` rnf b `seq` rnf c - deriving newtype instance NFData ErrorCode instance NFData (BoundedText k) where diff --git a/cabal.project b/cabal.project index eacea1101..e4ecb5f9c 100644 --- a/cabal.project +++ b/cabal.project @@ -101,8 +101,8 @@ source-repository-package source-repository-package type: git location: https://github.com/kadena-io/pact-5.git - tag: c1e4b32e23c38602313f2018e57481b230e948d0 - --sha256: 1n3n3h9lzw6yzbh4hi2ff05k04zi83nzr3jkhv8h8zr870yizwlq + tag: 65918ff881f7a2d44a08bf55ac2a1d3bb59319f9 + --sha256: 1swp7gkjvsg0hiciczdm3c8j4a5s86d69mjl0wkdynckclgim6xm source-repository-package type: git diff --git a/src/Chainweb/Pact/PactService.hs b/src/Chainweb/Pact/PactService.hs index 92c3417df..443ec5ad7 100644 --- a/src/Chainweb/Pact/PactService.hs +++ b/src/Chainweb/Pact/PactService.hs @@ -866,7 +866,8 @@ execLocal cwtx preflight sigVerify rdepth = pactLabel "execLocal" $ do earlyReturn $ Pact5LocalResultLegacy Pact5.CommandResult { _crReqKey = pact5RequestKey , _crTxId = Nothing - , _crResult = Pact5.PactResultErr $ Pact5.PELegacyError $ Pact5.toPrettyLegacyError parseError + , _crResult = Pact5.PactResultErr $ + Pact5.pactErrorToOnChainError parseError , _crGas = Pact5.Gas $ fromIntegral $ cmd ^. Pact4.cmdPayload . Pact4.pMeta . Pact4.pmGasLimit , _crLogs = Nothing , _crContinuation = Nothing @@ -913,8 +914,13 @@ execLocal cwtx preflight sigVerify rdepth = pactLabel "execLocal" $ do earlyReturn $ Pact5LocalResultWithWarns Pact5.CommandResult { _crReqKey = Pact5.RequestKey (Pact5.Hash $ Pact4.unHash $ Pact4.toUntypedHash $ Pact4._cmdHash cwtx) , _crTxId = Nothing - , _crResult = Pact5.PactResultErr $ Pact5.PELegacyError $ - Pact5.LegacyPactError Pact5.LegacyGasError "" [] (prettyPact5GasPurchaseFailure err) + , _crResult = Pact5.PactResultErr $ + Pact5.PactOnChainError + -- the only legal error type, once chainweaver is really gone, we + -- can use a real error type + (Pact5.ErrorType "EvalError") + (Pact5.mkBoundedText $ prettyPact5GasPurchaseFailure err) + (Pact5.LocatedErrorInfo Pact5.TopLevelErrorOrigin Pact5.noInfo) , _crGas = Pact5.Gas $ fromIntegral $ cmd ^. Pact4.cmdPayload . Pact4.pMeta . Pact4.pmGasLimit , _crLogs = Nothing , _crContinuation = Nothing @@ -928,13 +934,13 @@ execLocal cwtx preflight sigVerify rdepth = pactLabel "execLocal" $ do let commandResult' = hashPact5TxLogs $ set Pact5.crMetaData (Just metadata) commandResult -- TODO: once Pact 5 has warnings, include them here. pure $ Pact5LocalResultWithWarns - (Pact5.PELegacyError . Pact5.toPrettyLegacyError <$> commandResult') + (Pact5.pactErrorToOnChainError <$> commandResult') [] _ -> lift $ do -- default is legacy mode: use applyLocal, don't buy gas, don't do any -- metadata checks beyond signature and hash checking cr <- Pact5.pactTransaction Nothing $ \dbEnv -> do - fmap convertPact5Error <$> Pact5.applyLocal _psLogger _psGasLogger dbEnv txCtx spvSupport (view Pact5.payloadObj <$> pact5Cmd) + fmap Pact5.pactErrorToOnChainError <$> Pact5.applyLocal _psLogger _psGasLogger dbEnv txCtx spvSupport (view Pact5.payloadObj <$> pact5Cmd) pure $ Pact5LocalResultLegacy (hashPact5TxLogs cr) let doLocal = Checkpointer.readFromNthParent (fromIntegral rewindDepth) diff --git a/src/Chainweb/Pact/RestAPI/Server.hs b/src/Chainweb/Pact/RestAPI/Server.hs index c4672db1b..c328d623a 100644 --- a/src/Chainweb/Pact/RestAPI/Server.hs +++ b/src/Chainweb/Pact/RestAPI/Server.hs @@ -132,10 +132,10 @@ import qualified Pact.Types.Hash as Pact4 import qualified Pact.Core.Command.Types as Pact5 import qualified Pact.Core.Pretty as Pact5 import qualified Chainweb.Pact5.Transaction as Pact5 +import qualified Chainweb.Pact5.Types as Pact5 import qualified Chainweb.Pact5.Validations as Pact5 import Data.Coerce import qualified Pact.Core.Command.Server as Pact5 -import qualified Pact.Core.Evaluate as Pact5 import qualified Pact.Core.Errors as Pact5 import qualified Pact.Core.Hash as Pact5 import qualified Pact.Core.Gas as Pact5 @@ -614,7 +614,7 @@ internalPoll -> PactExecutionService -> Maybe ConfirmationDepth -> NonEmpty Pact5.RequestKey - -> IO (HashMap Pact5.RequestKey (Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info)))) + -> IO (HashMap Pact5.RequestKey (Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError)) internalPoll logger pdb bhdb mempool pactEx confDepth requestKeys0 = do let dbg txt = logFunctionText logger Debug txt -- get leaf block header for our chain from current best cut @@ -639,14 +639,14 @@ internalPoll logger pdb bhdb mempool pactEx confDepth requestKeys0 = do lookup :: (Pact5.RequestKey, T2 BlockHeight BlockHash) - -> IO (Either String (Maybe (Pact5.RequestKey, Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info))))) + -> IO (Either String (Maybe (Pact5.RequestKey, Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError))) lookup (key, T2 _ ha) = (fmap . fmap . fmap) (key,) $ lookupRequestKey key ha -- TODO: group by block for performance (not very important right now) lookupRequestKey :: Pact5.RequestKey -> BlockHash - -> IO (Either String (Maybe (Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info))))) + -> IO (Either String (Maybe (Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError))) lookupRequestKey key bHash = runExceptT $ do let pactHash = Pact5.unRequestKey key let matchingHash = (== pactHash) . Pact5._cmdHash . fst @@ -678,7 +678,7 @@ internalPoll logger pdb bhdb mempool pactEx confDepth requestKeys0 = do (\decodeErr -> "Transaction failed to decode: " <> decodeErr) return (tx', out) - checkBadList :: Vector Pact5.RequestKey -> IO (Vector (Pact5.RequestKey, Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info)))) + checkBadList :: Vector Pact5.RequestKey -> IO (Vector (Pact5.RequestKey, Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError)) checkBadList rkeys = do let !hashes = V.map pact5RequestKeyToTransactionHash rkeys out <- mempoolCheckBadList mempool hashes @@ -686,11 +686,15 @@ internalPoll logger pdb bhdb mempool pactEx confDepth requestKeys0 = do V.filter snd $ V.zip hashes out return $! V.map hashIsOnBadList bad - hashIsOnBadList :: Pact5.RequestKey -> (Pact5.RequestKey, Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info))) + hashIsOnBadList :: Pact5.RequestKey -> (Pact5.RequestKey, Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError) hashIsOnBadList rk = let res = Pact5.PactResultErr err - err = Pact5.PELegacyError $ - Pact5.LegacyPactError Pact5.LegacyTxFailure "" [] "Transaction is badlisted because it previously failed to validate." + err = Pact5.PactOnChainError + -- the only legal error type, once chainweaver is really gone, we + -- can use a real error type + (Pact5.ErrorType "EvalError") + (Pact5.mkBoundedText "Transaction is badlisted because it previously failed to validate.") + (Pact5.LocatedErrorInfo Pact5.TopLevelErrorOrigin Pact5.noInfo) !cr = Pact5.CommandResult rk Nothing res (mempty :: Pact5.Gas) Nothing Nothing Nothing [] in (rk, cr) diff --git a/src/Chainweb/Pact/Types.hs b/src/Chainweb/Pact/Types.hs index 839c73a2d..c7c4d4e58 100644 --- a/src/Chainweb/Pact/Types.hs +++ b/src/Chainweb/Pact/Types.hs @@ -860,11 +860,11 @@ _Pact4LocalResultLegacy = prism' Pact4LocalResultLegacy $ \case _ -> Nothing pattern Pact5LocalResultLegacy - :: Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info)) + :: Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError -> LocalResult pattern Pact5LocalResultLegacy cr <- ConvertLocalResultLegacy cr where Pact5LocalResultLegacy cr = ConvertLocalResultLegacy cr -_Pact5LocalResultLegacy :: Prism' LocalResult (Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info))) +_Pact5LocalResultLegacy :: Prism' LocalResult (Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError) _Pact5LocalResultLegacy = prism' Pact5LocalResultLegacy $ \case Pact5LocalResultLegacy cr -> Just cr _ -> Nothing @@ -885,12 +885,12 @@ _Pact4LocalResultWithWarns = prism' (uncurry Pact4LocalResultWithWarns) $ \case _ -> Nothing pattern Pact5LocalResultWithWarns - :: Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info)) + :: Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError -> [Text] -> LocalResult pattern Pact5LocalResultWithWarns cr warns <- ConvertLocalResultWithWarns cr warns where Pact5LocalResultWithWarns cr warns = ConvertLocalResultWithWarns cr warns -_Pact5LocalResultWithWarns :: Prism' LocalResult (Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info)), [Text]) +_Pact5LocalResultWithWarns :: Prism' LocalResult (Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError, [Text]) _Pact5LocalResultWithWarns = prism' (uncurry Pact5LocalResultWithWarns) $ \case Pact5LocalResultWithWarns cr warns -> Just (cr, warns) _ -> Nothing @@ -1244,12 +1244,11 @@ pact5CommandToBytes tx = Transaction -- be stored on-chain. pact5CommandResultToBytes :: Pact5.CommandResult Pact5.Hash (Pact5.PactError Pact5.Info) -> ByteString pact5CommandResultToBytes cr = - J.encodeStrict (fmap convertPact5Error cr) + J.encodeStrict (fmap Pact5.pactErrorToOnChainError cr) -convertPact5Error :: Pact5.PactError Pact5.Info -> Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info) +convertPact5Error :: Pact5.PactError Pact5.Info -> Pact5.PactOnChainError convertPact5Error err = - Pact5.PEPact5Error $ - Pact5.pactErrorToLocatedErrorCode err + Pact5.pactErrorToOnChainError err hashPact5TxLogs :: Pact5.CommandResult [Pact5.TxLog ByteString] err -> Pact5.CommandResult Pact5.Hash err hashPact5TxLogs cr = cr & over (Pact5.crLogs . _Just) diff --git a/test/lib/Chainweb/Test/Utils.hs b/test/lib/Chainweb/Test/Utils.hs index 692df8935..2600a34b8 100644 --- a/test/lib/Chainweb/Test/Utils.hs +++ b/test/lib/Chainweb/Test/Utils.hs @@ -253,7 +253,6 @@ import Data.Semigroup import qualified Pact.Core.Command.Types as Pact5 import qualified Data.Aeson as Aeson import qualified Pact.Core.Errors as Pact5 -import qualified Pact.Core.Info as Pact5 import qualified Pact.Types.Command as Pact4 import qualified Pact.Core.Hash as Pact5 import qualified Pact.Types.Hash as Pact4 @@ -1186,7 +1185,7 @@ independentSequentialTestGroup tn tts = unsafeHeadOf :: HasCallStack => Getting (Endo a) s a -> s -> a unsafeHeadOf l s = s ^?! l -type TestPact5CommandResult = Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.LineInfo)) +type TestPact5CommandResult = Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError toPact4RequestKey :: Pact5.RequestKey -> Pact4.RequestKey toPact4RequestKey = \case diff --git a/test/unit/Chainweb/Test/Pact5/HyperlanePluginTests.hs b/test/unit/Chainweb/Test/Pact5/HyperlanePluginTests.hs index 4cf8f09e0..f71000cfe 100644 --- a/test/unit/Chainweb/Test/Pact5/HyperlanePluginTests.hs +++ b/test/unit/Chainweb/Test/Pact5/HyperlanePluginTests.hs @@ -140,8 +140,8 @@ hyperlaneValidatorAnnouncementTest baseRdb step = runResourceT $ do poll fx v chain0 [cmdToRequestKey useBadSignature] >>= P.list [ P.match _Just ? P.checkAll - [ P.fun _crResult ? P.match (_PactResultErr . _PEPact5Error) ? P.checkAll - [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280) + [ P.fun _crResult ? P.match _PactResultErr ? P.checkAll + [ P.fun _peType ? P.equals (ErrorType "EvalError") , P.fun _peMsg ? P.equals "Failed to recover the address from the signature" ] , P.fun _crGas ? P.equals (Gas 100000) @@ -191,8 +191,8 @@ hyperlaneValidatorAnnouncementTest baseRdb step = runResourceT $ do poll fx v chain0 [cmdToRequestKey useWrongSigner] >>= P.list [ P.match _Just ? P.checkAll - [ P.fun _crResult ? P.match (_PactResultErr . _PEPact5Error) ? P.checkAll - [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280) + [ P.fun _crResult ? P.match _PactResultErr ? P.checkAll + [ P.fun _peType ? P.equals (ErrorType "EvalError") , P.fun _peMsg ? P.equals "Incorrect signer. Expected: PLiteral (LString {_lString = \"0x6c414e7a15088023e28af44ad0e1d593671e4b15\"}) but got PLiteral (LString {_lString = \"0x5c414e7a15088023e28af44ad0e1d593671e4b15\"})" ] , P.fun _crGas ? P.equals (Gas 100000) @@ -357,9 +357,8 @@ checkVerifierNotInTx fx pluginName = do [ P.match _Just ? P.fun _crResult ? P.match _PactResultErr - ? P.match _PEPact5Error ? P.checkAll - [ P.fun _peCode ? P.equals (ErrorCode 1133596488237056) + [ P.fun _peType ? P.equals (ErrorType "TxFailure") , P.fun _peMsg ? P.fun _boundedText ? P.equals ("Verifier " <> pluginName <> " failed with the message: not in transaction") ] @@ -451,9 +450,9 @@ hyperlaneVerifyThresholdZeroError baseRdb step = runResourceT $ do [ P.match _Just ? P.checkAll [ P.fun _crResult - ? P.match (_PactResultErr . _PEPact5Error) + ? P.match _PactResultErr ? P.checkAll - [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280) + [ P.fun _peType ? P.equals (ErrorType "EvalError") , P.fun _peMsg ? P.equals "Threshold should be greater than 0" ] , P.fun _crGas ? P.equals (Gas 20000) @@ -476,9 +475,9 @@ hyperlaneVerifyWrongSignersFailure baseRdb step = runResourceT $ do [ P.match _Just ? P.checkAll [ P.fun _crResult - ? P.match (_PactResultErr . _PEPact5Error) + ? P.match _PactResultErr ? P.checkAll - [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280) + [ P.fun _peType ? P.equals (ErrorType "EvalError") , P.fun _peMsg ? P.equals "Verification failed" ] , P.fun _crGas ? P.equals (Gas 20000) @@ -503,9 +502,9 @@ hyperlaneVerifyNotEnoughRecoveredSignaturesFailure baseRdb step = runResourceT $ [ P.match _Just ? P.checkAll [ P.fun _crResult - ? P.match (_PactResultErr . _PEPact5Error) + ? P.match _PactResultErr ? P.checkAll - [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280) + [ P.fun _peType ? P.equals (ErrorType "EvalError") , P.fun _peMsg ? P.equals "The number of signatures can't be less than threshold" ] , P.fun _crGas ? P.equals (Gas 20000) @@ -533,9 +532,9 @@ hyperlaneVerifyNotEnoughCapabilitySignaturesFailure baseRdb step = runResourceT [ P.match _Just ? P.checkAll [ P.fun _crResult - ? P.match (_PactResultErr . _PEPact5Error) + ? P.match _PactResultErr ? P.checkAll - [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280) + [ P.fun _peType ? P.equals (ErrorType "EvalError") , P.fun _peMsg ? P.equals "Verification failed" ] , P.fun _crGas ? P.equals (Gas 40000) @@ -562,9 +561,9 @@ hyperlaneVerifyMerkleIncorrectProofFailure baseRdb step = runResourceT $ do [ P.match _Just ? P.checkAll [ P.fun _crResult - ? P.match (_PactResultErr . _PEPact5Error) + ? P.match _PactResultErr ? P.checkAll - [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280) + [ P.fun _peType ? P.equals (ErrorType "EvalError") , P.fun _peMsg ? P.equals "Verification failed" ] , P.fun _crGas ? P.equals (Gas 20000) @@ -594,9 +593,9 @@ hyperlaneVerifyFailureNotEnoughSignaturesToPassThreshold baseRdb step = runResou [ P.match _Just ? P.checkAll [ P.fun _crResult - ? P.match (_PactResultErr . _PEPact5Error) + ? P.match _PactResultErr ? P.checkAll - [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280) + [ P.fun _peType ? P.equals (ErrorType "EvalError") , P.fun _peMsg ? P.equals "Verification failed" ] , P.fun _crGas ? P.equals (Gas 40000) diff --git a/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs b/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs index 680353ed9..a9f8be286 100644 --- a/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs +++ b/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs @@ -588,9 +588,13 @@ allocationTest rdb step = runResourceT $ do $ set cbSigners [mkEd25519Signer' allocation01KeyPair [], mkEd25519Signer' sender00 []] $ defaultCmd cid) >>= local fx v cid Nothing Nothing Nothing - >>= P.match _Pact5LocalResultLegacy ? - P.fun _crResult ? P.match (_PactResultErr . _PEPact5Error . to _peMsg) ? - P.fun _boundedText ? textContains "funds locked until \"2100-10-31T18:00:00Z\"." + >>= P.match _Pact5LocalResultLegacy + ? P.fun _crResult + ? P.match _PactResultErr + ? P.checkAll + [ P.fun _peType ? P.equals ? ErrorType "TxFailure" + , P.fun _peMsg ? P.fun _boundedText ? textContains "funds locked until \"2100-10-31T18:00:00Z\"." + ] buildTextCmd v (set cbRPC @@ -599,10 +603,10 @@ allocationTest rdb step = runResourceT $ do $ defaultCmd cid) >>= local fx v cid (Just PreflightSimulation) Nothing Nothing >>= P.match (_Pact5LocalResultWithWarns . _1) ? - P.fun _crResult ? P.match (_PactResultErr . _PELegacyError) ? + P.fun _crResult ? P.match _PactResultErr ? P.checkAll - [ P.fun _leMessage ? textContains "funds locked until \"2100-10-31T18:00:00Z\"." - , P.fun _leType ? P.equals LegacyTxFailure + [ P.fun _peType ? P.equals ? ErrorType "TxFailure" + , P.fun _peMsg ? P.fun _boundedText ? textContains "funds locked until \"2100-10-31T18:00:00Z\"." ] step "allocation02" @@ -666,10 +670,10 @@ gasPurchaseFailureMessages rdb _step = runResourceT $ do >>= P.match _Pact5LocalResultWithWarns ? P.fun fst ? P.fun _crResult - ? P.match (_PactResultErr . _PELegacyError) + ? P.match _PactResultErr ? P.checkAll - [ P.fun _leType ? P.equals LegacyGasError - , P.fun _leMessage ? textContains "Failed to buy gas: Insufficient funds" + [ P.fun _peType ? P.equals ? ErrorType "EvalError" + , P.fun _peMsg ? P.fun _boundedText ? textContains "Failed to buy gas: Insufficient funds" ] send fx v cid [cmd] @@ -696,10 +700,10 @@ gasPurchaseFailureMessages rdb _step = runResourceT $ do >>= P.match _Pact5LocalResultWithWarns ? P.fun fst ? P.fun _crResult - ? P.match (_PactResultErr . _PELegacyError) + ? P.match _PactResultErr ? P.checkAll - [ P.fun _leType ? P.equals LegacyGasError - , P.fun _leMessage ? textContains "Failed to buy gas: Multiple gas payer capabilities" + [ P.fun _peType ? P.equals ? ErrorType "EvalError" + , P.fun _peMsg ? P.fun _boundedText ? textContains "Failed to buy gas: Multiple gas payer capabilities" ] send fx v cid [cmd] diff --git a/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs b/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs index fd686bf44..73c9d85fa 100644 --- a/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs +++ b/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs @@ -97,6 +97,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest" , testCase "writes from failed transaction should not make it into the db" (testWritesFromFailedTxDontMakeItIn baseRdb) , testCase "quirk spec" (quirkSpec baseRdb) , testCase "test writes to nonexistent tables" (testWritesToNonExistentTables baseRdb) + , testCase "test CommandResult 5 is valid for 4" (testCommandResult5To4 baseRdb) ] -- | Run with the context being that the parent block is the genesis block @@ -920,6 +921,28 @@ testWritesToNonExistentTables rdb = readFromAfterGenesis v rdb $ do ? P.match (_PactResultErr . _PEExecutionError . _1) ? P.equals (DbOpFailure (NoSuchTable (TableName "t" (ModuleName "m" (Just "free"))))) +testCommandResult5To4 :: RocksDb -> IO () +testCommandResult5To4 rdb = readFromAfterGenesis v rdb $ do + txCtx <- TxContext <$> view psParentHeader <*> pure noMiner + pactTransaction Nothing $ \pactDb -> do + cmd <- buildCwCmd v + $ set cbRPC (mkExec' "(+ 1 'hello)") + $ defaultCmd cid + + logger <- testLogger + applyCmd logger Nothing pactDb txCtx (TxBlockIdx 0) noSPVSupport (Gas 1) (view payloadObj <$> cmd) + >>= P.checkAll + [ P.match _Right + ? P.fun _crResult + ? P.match _PactResultErr + ? P.succeed + , P.match _Right + ? P.fun (fmap pactErrorToOnChainError) + ? P.fun hashPact5TxLogs + ? P.fun toPact4CommandResult + ? P.forced + ] + cid :: ChainId cid = unsafeChainId 0