diff --git a/cabal.project b/cabal.project index 5da6bed9a4..41730110e3 100644 --- a/cabal.project +++ b/cabal.project @@ -86,8 +86,8 @@ source-repository-package source-repository-package type: git location: https://github.com/kadena-io/pact-5.git - tag: c929b9ea9bfd8e86e765c0e569d74797c1b0c7a8 - --sha256: 0nv6rrk2vvyzsd2ia54cx6wp02nrj2fn0c2s45bhmpsb8c25q6jm + tag: 0234d4fde21c219fedb9cdc58684291f8bb42fd9 + --sha256: 15y7fji71v3pnvw0l3000wmv49zidbjl81d3f9443nm9d2i4p22v source-repository-package type: git diff --git a/src/Chainweb/Pact5/TransactionExec.hs b/src/Chainweb/Pact5/TransactionExec.hs index 865f79b04f..41fc127417 100644 --- a/src/Chainweb/Pact5/TransactionExec.hs +++ b/src/Chainweb/Pact5/TransactionExec.hs @@ -164,6 +164,7 @@ import Data.Set (Set) import Control.Monad.Except (MonadError(..), liftEither) import qualified Pact.Core.Syntax.ParseTree as Lisp import Pact.Core.Command.Types (Payload(_pSigners)) +import Pact.Core.StableEncoding import Chainweb.BlockHeaderDB (BlockHeaderDb) import Chainweb.Pact.SPV (pact5SPV) import Data.Void @@ -330,7 +331,7 @@ applyLocal logger maybeGasLogger coreDb txCtx spvSupport cmd = do , _crLogs = Just $ _erLogs payloadResult , _crContinuation = _erExec payloadResult , _crEvents = _erEvents payloadResult - , _crMetaData = Nothing + , _crMetaData = Just (J.toJsonViaEncode $ StableEncoding $ ctxToPublicData (cmd ^. cmdPayload . pMeta) txCtx) } where @@ -422,7 +423,7 @@ applyCmd logger maybeGasLogger pact5Db txCtx spv cmd initialGas = do , _crResult = PactResultErr err -- all gas is used when a command fails , _crGas = cmd ^. cmdPayload . pMeta . pmGasLimit . _GasLimit - , _crLogs = Nothing + , _crLogs = Just $ _erLogs buyGasResult <> _erLogs redeemGasResult , _crContinuation = Nothing , _crEvents = _erEvents buyGasResult <> _erEvents redeemGasResult , _crMetaData = Nothing diff --git a/test/Chainweb/Test/Pact5/TransactionExecTest.hs b/test/Chainweb/Test/Pact5/TransactionExecTest.hs index a9dd1ebb90..0d89e390be 100644 --- a/test/Chainweb/Test/Pact5/TransactionExecTest.hs +++ b/test/Chainweb/Test/Pact5/TransactionExecTest.hs @@ -350,6 +350,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest" , pt _crGas . equals $ Gas 1 , pt _crContinuation . equals $ Nothing , pt _crLogs . equals $ Just [] + , pt _crMetaData $ allOf1 _Just continue ] @@ -533,7 +534,17 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest" -- reflects buyGas gas usage, as well as that of the payload , pt _crGas . equals $ Gas 300 , pt _crContinuation . equals $ Nothing - , pt _crLogs . equals $ Nothing --Just [] + , pt _crLogs . soleElementOf _Just $ + PT.list + [ satAll + [ pt _txDomain . equals $ "USER_coin_coin-table" + , pt _txKey . equals $ "sender00" + ] + , satAll + [ pt _txDomain . equals $ "USER_coin_coin-table" + , pt _txKey . equals $ "NoMiner" + ] + ] ] -- Invoke module when verifier capability is present. Should succeed. @@ -563,6 +574,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest" -- reflects buyGas gas usage, as well as that of the payload , pt _crGas . equals $ Gas 168 , pt _crContinuation . equals $ Nothing + , pt _crMetaData . equals $ Nothing , pt _crLogs . soleElementOf _Just $ PT.list [ satAll @@ -583,6 +595,71 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest" return () + , testCase "applyCmd failure spec" $ runResourceT $ do + sql <- withTempSQLiteResource + liftIO $ do + cp <- initCheckpointer v cid sql + tdb <- mkTestBlockDb v =<< testRocksDb "testApplyPayload" baseRdb + bhdb <- getWebBlockHeaderDb (_bdbWebBlockHeaderDb tdb) cid + T2 () _finalPactState <- withPactService v cid stdoutDummyLogger Nothing bhdb (_bdbPayloadDb tdb) sql testPactServiceConfig $ do + initialPayloadState v cid + (throwIfNoHistory =<<) $ readFrom (Just $ ParentHeader gh) $ do + db <- view psBlockDbEnv + liftIO $ do + pactDb <- assertDynamicPact5Db (_cpPactDbEnv db) + startSender00Bal <- readBal pactDb "sender00" + assertEqual "starting balance" (Just 100_000_000) startSender00Bal + startMinerBal <- readBal pactDb "NoMiner" + + cmd <- buildCwCmd "nonce" v defaultCmd + { _cbRPC = mkExec' "(+ 1 \"abc\")" + , _cbSigners = + [ mkEd25519Signer' sender00 + [ CapToken (QualifiedName "GAS" (ModuleName "coin" Nothing)) [] ] + ] + , _cbSender = "sender00" + , _cbChainId = cid + , _cbGasPrice = GasPrice 2 + , _cbGasLimit = GasLimit (Gas 500) + } + let txCtx = TxContext {_tcParentHeader = ParentHeader gh, _tcMiner = noMiner} + let expectedGasConsumed = 500 + commandResult <- applyCmd stdoutDummyLogger Nothing pactDb txCtx noSPVSupport (_payloadObj <$> cmd) (Gas 1) + () <- commandResult & satAll + -- gas buy event + + [ pt _crEvents ? PT.list [ event + (equals "TRANSFER") + (equals [PString "sender00", PString "NoMiner", PDecimal 1000]) + (equals coinModule) + ] + -- tx errored + , pt _crResult ? allOf1 _PactResultErr continue + -- reflects buyGas gas usage, as well as that of the payload + , pt _crGas . equals $ Gas expectedGasConsumed + , pt _crContinuation . equals $ Nothing + , pt _crLogs . soleElementOf _Just $ + PT.list + [ satAll + [ pt _txDomain . equals $ "USER_coin_coin-table" + , pt _txKey . equals $ "sender00" + ] + , satAll + [ pt _txDomain . equals $ "USER_coin_coin-table" + , pt _txKey . equals $ "NoMiner" + ] + ] + ] + + endSender00Bal <- readBal pactDb "sender00" + assertEqual "ending balance should be less gas money" (Just 99_999_000) endSender00Bal + endMinerBal <- readBal pactDb "NoMiner" + assertEqual "miner balance after redeeming gas should have increased" + (Just $ fromMaybe 0 startMinerBal + (fromIntegral expectedGasConsumed) * 2) + endMinerBal + + return () + , testCase "applyCmd coin.transfer" $ runResourceT $ do sql <- withTempSQLiteResource liftIO $ do diff --git a/tools/cwtool/TxSimulator.hs b/tools/cwtool/TxSimulator.hs index 8a652d479d..108d1ebf10 100644 --- a/tools/cwtool/TxSimulator.hs +++ b/tools/cwtool/TxSimulator.hs @@ -40,7 +40,7 @@ import Chainweb.Pact.PactService.Checkpointer import Chainweb.Pact.PactService.Pact4.ExecBlock import Chainweb.Pact.RestAPI.Server import Chainweb.Pact.Service.Types -import Chainweb.Pact.TransactionExec +import Chainweb.Pact4.TransactionExec import Chainweb.Pact.Types import Chainweb.Payload import Chainweb.Payload.PayloadStore @@ -119,7 +119,7 @@ simulate sc@(SimConfig dbDir txIdx' _ _ cid ver gasLog doTypecheck) = do Left _ -> error "bad cmd" Right cmdPwt -> do let cmd = Pact4.payloadObj <$> cmdPwt - let txc = TxContext parent $ publicMetaOf cmd + let txc = undefined -- TxContext parent $ publicMetaOf cmd -- This rocksdb isn't actually used, it's just to satisfy -- PactServiceEnv withTempRocksDb "txsim-rocksdb" $ \rdb -> do @@ -147,19 +147,20 @@ simulate sc@(SimConfig dbDir txIdx' _ _ cid ver gasLog doTypecheck) = do $ (throwIfNoHistory =<<) $ readFrom (Just parent) $ do - mc <- readInitModules + mc <- undefined -- readInitModules T3 !cr _mc _ <- do - dbEnv <- view psBlockDbEnv + dbEnv <- undefined -- view psBlockDbEnv liftIO $ trace (logFunction cwLogger) "applyCmd" () 1 $ - applyCmd ver logger gasLogger Nothing (_cpPactDbEnv dbEnv) miner (getGasModel txc) + applyCmd ver logger gasLogger Nothing (_cpPactDbEnv dbEnv) miner undefined -- (getGasModel txc) txc noSPVSupport cmd (initGas cmdPwt) mc ApplySend liftIO $ T.putStrLn (J.encodeText (J.Array <$> cr)) (_,True) -> do (throwIfNoHistory =<<) $ _cpReadFrom (_cpReadCp cp) (Just parent) $ \dbEnv -> do let refStore = RefStore nativeDefs - pd = ctxToPublicData $ TxContext parent def + pd = ctxToPublicData $ undefined -- TxContext parent def loadMod = fmap inlineModuleData . getModule (def :: Info) - ee <- setupEvalEnv (_cpPactDbEnv dbEnv) Nothing Local (initMsgData pactInitialHash) refStore freeGasEnv + -- ee <- setupEvalEnv (_cpPactDbEnv dbEnv) Nothing Local (initMsgData pactInitialHash) refStore freeGasEnv + ee <- setupEvalEnv undefined Nothing Local (initMsgData pactInitialHash) refStore freeGasEnv permissiveNamespacePolicy noSPVSupport pd def void $ runEval def ee $ do mods <- keys def Modules @@ -229,10 +230,10 @@ simulate sc@(SimConfig dbDir txIdx' _ _ cid ver gasLog doTypecheck) = do doBlock initMC parent ((hdr,pwo):rest) = do (throwIfNoHistory =<<) $ readFrom (Just parent) $ do when initMC $ do - mc <- readInitModules + mc <- undefined -- readInitModules updateInitCacheM mc - void $ trace (logFunction cwLogger) "execBlock" () 1 $ - execBlock hdr (CheckablePayloadWithOutputs pwo) + void $ trace (logFunction cwLogger) "execBlock" () 1 $ undefined + -- execBlock hdr (CheckablePayloadWithOutputs pwo) doBlock False (ParentHeader hdr) rest -- | Block-scoped SPV mock by matching cont proofs to payload txs. @@ -246,7 +247,7 @@ spvSim sc bh pwo = do go mv cp = modifyMVar mv $ searchOuts cp searchOuts _ [] = return ([],Left "spv: proof not found") searchOuts cp@(ContProof pf) ((Transaction ti,TransactionOutput _o):txs) = - case codecDecode (Pact4.payloadCodec (pactParserVersion (scVersion sc) (_chainId bh) (_blockHeight bh))) ti of + case codecDecode (Pact4.payloadCodec (undefined (scVersion sc) (_chainId bh) (_blockHeight bh))) ti of Left {} -> internalError "input decode failed" Right cmd -> case _pPayload $ Pact4.payloadObj $ _cmdPayload cmd of Continuation cm | _cmProof cm == Just cp -> do diff --git a/tools/ea/Ea.hs b/tools/ea/Ea.hs index 41814c4b82..8e93e14bd1 100644 --- a/tools/ea/Ea.hs +++ b/tools/ea/Ea.hs @@ -56,13 +56,13 @@ import Chainweb.Pact.Backend.Utils import Chainweb.Pact.PactService import Chainweb.Pact.Types (testPactServiceConfig) import Chainweb.Pact.Utils (toTxCreationTime) -import Chainweb.Pact.Validations (defaultMaxTTL) +import Chainweb.Pact4.Validations (defaultMaxTTL) import Chainweb.Payload import Chainweb.Payload.PayloadStore.InMemory import Chainweb.Storage.Table.RocksDB import Chainweb.Time import qualified Chainweb.Pact4.Transaction as Pact4 - (Pact4.Transaction, Pact4.payloadCodec, mkPayloadWithTextOld) + (Transaction,payloadCodec, mkPayloadWithTextOld) import Chainweb.Utils import Chainweb.Version @@ -200,7 +200,7 @@ mkChainwebTxs' rawTxs = f@ProcFail{} -> fail (show f) ProcSucc c -> do let t = toTxCreationTime (Time (TimeSpan 0)) - return $! mkPayloadWithTextOld <$> (c & setTxTime t & setTTL defaultMaxTTL) + return $! Pact4.mkPayloadWithTextOld <$> (c & setTxTime t & setTTL defaultMaxTTL) where setTxTime = set (cmdPayload . pMeta . pmCreationTime) setTTL = set (cmdPayload . pMeta . pmTTL)