From 893efb2cc06ecf8862419e9cc2e403f8755bb48f Mon Sep 17 00:00:00 2001 From: Edmund Noble Date: Sat, 14 Dec 2024 19:18:00 -0500 Subject: [PATCH] Migrate to property-matchers This comes with a few API changes, and uses a version that hackage hasn't yet published in the index, but will soon. --- cabal.project | 12 +- chainweb.cabal | 2 +- .../Chainweb/Test/Pact5/PactServiceTest.hs | 29 +- .../Chainweb/Test/Pact5/RemotePactTest.hs | 30 +- test/unit/Chainweb/Test/Pact5/SPVTest.hs | 7 +- .../Test/Pact5/TransactionExecTest.hs | 403 +++++++++--------- 6 files changed, 245 insertions(+), 238 deletions(-) diff --git a/cabal.project b/cabal.project index a5a7ab87b..ac3fe394b 100644 --- a/cabal.project +++ b/cabal.project @@ -86,6 +86,12 @@ package yet-another-logger -- -- nix-prefetch-git --url --rev +source-repository-package + type: git + location: https://gitlab.com/edmundnoble/property-matchers.git + tag: bb123833a2b11934cac366df62681bc2c24bd82f + --sha256: 18xgvzb3p8chch85747ln9a2191df09vwwrv9v3njr2h69n3rhxj + source-repository-package type: git location: https://github.com/kadena-io/pact.git @@ -150,12 +156,6 @@ source-repository-package tag: 90247042ab3b8662809210af2a78e6dee0f9b4ac --sha256: 0dqsrjxm0cm35xcihm49dhwdvmz79vsv4sd5qs2izc4sbnd0d8n6 -source-repository-package - type: git - location: https://gitlab.com/edmundnoble/predicate-transformers - tag: 67c77e68ade204f56d91ad5952fe432188b40d23 - --sha256: 0q7nwl56lgic5andc956zv4zipdv5rxjkalm21cxr75r6grkzfmy - -- -------------------------------------------------------------------------- -- -- Relaxed Bounds diff --git a/chainweb.cabal b/chainweb.cabal index 33331e493..79578551c 100644 --- a/chainweb.cabal +++ b/chainweb.cabal @@ -725,7 +725,7 @@ test-suite chainweb-tests , pact-tng:pact-request-api , pact-tng:test-utils , patience >= 0.3 - , predicate-transformers == 0.15.0.0 + , property-matchers ^>= 0.2 , pretty-show , quickcheck-instances >= 0.3 , random >= 1.2 diff --git a/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs b/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs index 343aa72b9..d65ab2e0c 100644 --- a/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs +++ b/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs @@ -79,7 +79,8 @@ import Pact.Core.Hash qualified as Pact5 import Pact.Core.Names import Pact.Core.PactValue import Pact.Types.Gas qualified as Pact4 -import PredicateTransformers as PT +import PropertyMatchers ((?)) +import PropertyMatchers qualified as P import Test.Tasty import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase) import Text.Printf (printf) @@ -134,8 +135,8 @@ tests baseRdb = testGroup "Pact5 PactServiceTest" , testCase "failed txs should go into blocks" (failedTxsShouldGoIntoBlocks baseRdb) ] -successfulTx :: Predicatory p => Pred p (CommandResult log err) -successfulTx = pt _crResult ? match _PactResultOk something +successfulTx :: P.Prop (CommandResult log err) +successfulTx = P.fun _crResult ? P.match _PactResultOk P.succeed simpleEndToEnd :: RocksDb -> IO () simpleEndToEnd baseRdb = runResourceT $ do @@ -148,8 +149,8 @@ simpleEndToEnd baseRdb = runResourceT $ do -- we only care that they succeed; specifics regarding their outputs are in TransactionExecTest results & - predful ? onChain cid ? - predful ? Vector.replicate 2 successfulTx + P.propful ? onChain cid ? + P.propful ? Vector.replicate 2 successfulTx newBlockEmpty :: RocksDb -> IO () newBlockEmpty baseRdb = runResourceT $ do @@ -171,8 +172,8 @@ newBlockEmpty baseRdb = runResourceT $ do return $ finalizeBlock nonEmptyBip results & - predful ? onChain cid ? - predful ? Vector.replicate 1 successfulTx + P.propful ? onChain cid ? + P.propful ? Vector.replicate 1 successfulTx continueBlockSpec :: RocksDb -> IO () continueBlockSpec baseRdb = runResourceT $ do @@ -194,8 +195,8 @@ continueBlockSpec baseRdb = runResourceT $ do return $ finalizeBlock bipAllAtOnce -- assert that 3 successful txs are in the block allAtOnceResults & - predful ? onChain cid ? - predful ? Vector.replicate 3 successfulTx + P.propful ? onChain cid ? + P.propful ? Vector.replicate 3 successfulTx -- reset back to the empty block for the next phase -- next, produce the same block by repeatedly extending a block @@ -231,7 +232,7 @@ continueBlockSpec baseRdb = runResourceT $ do return $ finalizeBlock bipFinal -- assert that the continued results are equal to doing it all at once - continuedResults & equals allAtOnceResults + continuedResults & P.equals allAtOnceResults -- * test that the NewBlock timeout works properly and doesn't leave any extra state from a timed-out transaction newBlockTimeoutSpec :: RocksDb -> IO () @@ -276,10 +277,10 @@ newBlockTimeoutSpec baseRdb = runResourceT $ do newBlock noMiner NewBlockFill (ParentHeader ph) pactQueue -- Mempool orders by GasPrice. 'buildCwCmd' sets the gas price to the transfer amount. -- We hope for 'timeoutTx' to fail, meaning that only 'txTransfer2' is in the block. - bip & pt _blockInProgressTransactions ? pt _transactionPairs - ? predful ? Vector.fromList - [ pair - (pt _cmdHash ? equals (_cmdHash tx2)) + bip & P.fun _blockInProgressTransactions ? P.fun _transactionPairs + ? P.propful ? Vector.fromList + [ P.pair + (P.fun _cmdHash ? P.equals (_cmdHash tx2)) successfulTx ] return $ finalizeBlock bip diff --git a/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs b/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs index 3aeebb4bb..0694c36c5 100644 --- a/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs +++ b/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs @@ -64,7 +64,7 @@ import Chainweb.Test.Pact5.CmdBuilder import Chainweb.Test.Pact5.CutFixture qualified as CutFixture import Chainweb.Test.Pact5.Utils import Chainweb.Test.TestVersions -import Chainweb.Test.Utils (deadbeef) +import Chainweb.Test.Utils (deadbeef, TestPact5CommandResult) import Chainweb.Test.Utils (testRetryPolicy) import Chainweb.Utils import Chainweb.Version @@ -93,7 +93,8 @@ import Pact.Core.Errors import Pact.Core.Gas.Types import Pact.Core.Hash qualified as Pact5 import Pact.JSON.Encode qualified as J -import PredicateTransformers as PT +import PropertyMatchers ((?)) +import PropertyMatchers qualified as P import Servant.Client import Test.Tasty import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase) @@ -276,21 +277,20 @@ spvTest baseRdb = runResourceT $ do _ <- CutFixture.advanceAllChains v (fixture ^. cutFixture) recvCr <- fmap (HashMap.! recvReqKey) $ polling v targetChain clientEnv (NE.singleton recvReqKey) recvCr - & allTrue - [ pt _crResult ? match _PactResultOk something - , pt _crEvents ? predful - [ something - , allTrue - [ pt _peName ? equals "TRANSFER_XCHAIN_RECD" - , pt _peArgs ? traceFailShow ? equals + & P.allTrue + [ P.fun _crResult ? P.match _PactResultOk P.succeed + , P.fun _crEvents ? P.propful + [ P.succeed + , P.allTrue + [ P.fun _peName ? P.equals "TRANSFER_XCHAIN_RECD" + , P.fun _peArgs ? P.equals [PString "", PString "sender01", PDecimal 1.0, PString (chainIdToText srcChain)] ] - , pt _peName ? equals "X_RESUME" - , something + , P.fun _peName ? P.equals "X_RESUME" + , P.succeed ] ] - pure () pure () @@ -419,11 +419,9 @@ trivialTx cid n = defaultCmd , _cbGasLimit = GasLimit (Gas 1_000) } -_successfulTx :: Predicatory p => Pred p (CommandResult log err) -_successfulTx = pt _crResult ? match _PactResultOk something +_successfulTx :: P.Prop (CommandResult log err) +_successfulTx = P.fun _crResult ? P.match _PactResultOk P.succeed pactDeadBeef :: RequestKey pactDeadBeef = case deadbeef of TransactionHash bytes -> RequestKey (Pact5.Hash bytes) - -type TestPact5CommandResult = CommandResult Pact5.Hash (PactErrorCompat (LocatedErrorInfo Info)) \ No newline at end of file diff --git a/test/unit/Chainweb/Test/Pact5/SPVTest.hs b/test/unit/Chainweb/Test/Pact5/SPVTest.hs index 8330147f0..c42a6bfbe 100644 --- a/test/unit/Chainweb/Test/Pact5/SPVTest.hs +++ b/test/unit/Chainweb/Test/Pact5/SPVTest.hs @@ -157,7 +157,8 @@ import Pact.Core.Serialise import Pact.Core.StableEncoding (encodeStable) import Pact.Core.Verifiers import Pact.Types.Gas qualified as Pact4 -import PredicateTransformers as PT +import PropertyMatchers ((?)) +import PropertyMatchers qualified as P import Streaming.Prelude qualified as Stream import System.LogLevel import System.LogLevel (LogLevel (..)) @@ -252,8 +253,8 @@ tests baseRdb = testGroup "Pact5 SPVTest" [ --testCase "simple end to end" (simpleEndToEnd baseRdb) ] -successfulTx :: Predicatory p => Pred p (CommandResult log err) -successfulTx = pt _crResult ? match _PactResultOk something +successfulTx :: P.Prop (CommandResult log err) +successfulTx = P.fun _crResult ? P.match _PactResultOk P.succeed cid = unsafeChainId 0 v = pact5InstantCpmTestVersion singletonChainGraph diff --git a/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs b/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs index d2f44161a..20c6f03e4 100644 --- a/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs +++ b/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs @@ -64,7 +64,8 @@ import Pact.Core.SPV (noSPVSupport) import Pact.Core.Signer import Pact.Core.Verifiers import Pact.JSON.Encode qualified as J -import PredicateTransformers as PT +import PropertyMatchers ((?)) +import PropertyMatchers qualified as P import Test.Tasty import Test.Tasty.HUnit (assertBool, assertEqual, testCase) import Text.Printf @@ -75,11 +76,15 @@ coinModuleName :: ModuleName coinModuleName = ModuleName "coin" Nothing -- usually we don't want to check the module hash -event :: Predicatory p => Pred p Text -> Pred p [PactValue] -> Pred p ModuleName -> Pred p (PactEvent PactValue) -event n args modName = satAll - [ pt _peName n - , pt _peArgs args - , pt _peModule modName +event + :: P.Prop Text + -> P.Prop [PactValue] + -> P.Prop ModuleName + -> P.Prop (PactEvent PactValue) +event n args modName = P.allTrue + [ P.fun _peName n + , P.fun _peArgs args + , P.fun _peModule modName ] tests :: RocksDb -> TestTree @@ -170,9 +175,9 @@ buyGasFailures rdb = readFromAfterGenesis v rdb $ do gasEnv <- mkTableGasEnv (MilliGasLimit mempty) GasLogsEnabled logger <- testLogger buyGas logger gasEnv pactDb txCtx' (view payloadObj <$> cmd) - >>= match (_Left . _BuyGasPactError . _PEUserRecoverableError) - ? pt (view _1) - ? equals (UserEnforceError "Insufficient funds") + >>= P.match (_Left . _BuyGasPactError . _PEUserRecoverableError) + ? P.fun (view _1) + ? P.equals (UserEnforceError "Insufficient funds") -- multiple gas payer caps should lead to an error, because it's unclear -- which module will pay for gas @@ -194,7 +199,7 @@ buyGasFailures rdb = readFromAfterGenesis v rdb $ do gasEnv <- mkTableGasEnv (MilliGasLimit mempty) GasLogsEnabled logger <- testLogger buyGas logger gasEnv pactDb txCtx' (view payloadObj <$> cmd) - >>= equals ? Left BuyGasMultipleGasPayerCaps + >>= P.equals ? Left BuyGasMultipleGasPayerCaps redeemGasShouldGiveGasTokensToTheTransactionSenderAndMiner :: RocksDb -> IO () redeemGasShouldGiveGasTokensToTheTransactionSenderAndMiner rdb = readFromAfterGenesis v rdb $ do @@ -220,7 +225,7 @@ redeemGasShouldGiveGasTokensToTheTransactionSenderAndMiner rdb = readFromAfterGe -- TODO: should we be throwing some predicates at the redeem gas result? logger <- testLogger redeemGas logger pactDb txCtx (Gas 3) Nothing (view payloadObj <$> cmd) - >>= match _Right ? something + >>= P.match _Right ? P.succeed endSender00Bal <- readBal pactDb "sender00" assertEqual "balance after redeeming gas" (Just $ 100_000_000 + (10 - 3) * 2) endSender00Bal endMinerBal <- readBal pactDb "NoMiner" @@ -248,26 +253,27 @@ payloadFailureShouldPayAllGasToTheMinerTypeError rdb = readFromAfterGenesis v rd let txCtx = TxContext {_tcParentHeader = ParentHeader (gh v cid), _tcMiner = noMiner} logger <- testLogger applyCmd logger Nothing pactDb txCtx noSPVSupport (Gas 1) (view payloadObj <$> cmd) - >>= match _Right - ? satAll - [ pt _crResult - ? soleElementOf (_PactResultErr . _PEExecutionError . _1) - ? match _NativeArgumentsError something - , pt _crEvents ? soleElement ? - event - (equals "TRANSFER") - (equals [PString "sender00", PString "NoMiner", PDecimal 2000.0]) - (equals coinModuleName) - , pt _crGas ? equals ? Gas 1_000 - , pt _crLogs ? match _Just ? - PT.list - [ satAll - [ pt _txDomain ? equals "coin_coin-table" - , pt _txKey ? equals "sender00" + >>= P.match _Right + ? P.allTrue + [ P.fun _crResult + ? P.match (_PactResultErr . _PEExecutionError . _1) + ? P.match _NativeArgumentsError P.succeed + , P.fun _crEvents ? P.list + [ event + (P.equals "TRANSFER") + (P.equals [PString "sender00", PString "NoMiner", PDecimal 2000.0]) + (P.equals coinModuleName) + ] + , P.fun _crGas ? P.equals ? Gas 1_000 + , P.fun _crLogs ? P.match _Just ? + P.list + [ P.allTrue + [ P.fun _txDomain ? P.equals "coin_coin-table" + , P.fun _txKey ? P.equals "sender00" ] - , satAll - [ pt _txDomain ? equals "coin_coin-table" - , pt _txKey ? equals "NoMiner" + , P.allTrue + [ P.fun _txDomain ? P.equals "coin_coin-table" + , P.fun _txKey ? P.equals "NoMiner" ] ] ] @@ -303,27 +309,28 @@ payloadFailureShouldPayAllGasToTheMinerInsufficientFunds rdb = readFromAfterGene let txCtx = TxContext {_tcParentHeader = ParentHeader (gh v cid), _tcMiner = noMiner} logger <- testLogger applyCmd logger Nothing pactDb txCtx noSPVSupport (Gas 1) (view payloadObj <$> cmd) - >>= match _Right - ? satAll - [ pt _crResult - ? soleElementOf (_PactResultErr . _PEUserRecoverableError . _1) - ? equals (UserEnforceError "Insufficient funds") - , pt _crEvents - ? soleElement - ? event - (equals "TRANSFER") - (equals [PString "sender00", PString "NoMiner", PDecimal 2000.0]) - (equals coinModuleName) - , pt _crGas ? equals ? Gas 1_000 - , pt _crLogs ? match _Just ? - PT.list - [ satAll - [ pt _txDomain ? equals ? "coin_coin-table" - , pt _txKey ? equals ? "sender00" + >>= P.match _Right + ? P.allTrue + [ P.fun _crResult + ? P.match (_PactResultErr . _PEUserRecoverableError . _1) + ? P.equals (UserEnforceError "Insufficient funds") + , P.fun _crEvents + ? P.list + [ event + (P.equals "TRANSFER") + (P.equals [PString "sender00", PString "NoMiner", PDecimal 2000.0]) + (P.equals coinModuleName) + ] + , P.fun _crGas ? P.equals ? Gas 1_000 + , P.fun _crLogs ? P.match _Just ? + P.list + [ P.allTrue + [ P.fun _txDomain ? P.equals ? "coin_coin-table" + , P.fun _txKey ? P.equals ? "sender00" ] - , satAll - [ pt _txDomain ? equals ? "coin_coin-table" - , pt _txKey ? equals ? "NoMiner" + , P.allTrue + [ P.fun _txDomain ? P.equals ? "coin_coin-table" + , P.fun _txKey ? P.equals ? "NoMiner" ] ] ] @@ -358,14 +365,14 @@ runPayloadShouldReturnEvalResultRelatedToTheInputCommand rdb = readFromAfterGene assertEqual "runPayload gas used" (MilliGas 3_750) gasUsed - pure payloadResult >>= match _Right ? satAll - [ pt _erOutput ? equals [InterpretValue (PInteger 15) noInfo] - , pt _erEvents ? equals [] - , pt _erLogs ? equals [] - , pt _erExec ? equals Nothing - , pt _erGas ? traceFailShow ? equals ? Gas 2 - , pt _erLoadedModules ? equals mempty - , pt _erTxId ? equals ? Just (TxId 9) + pure payloadResult >>= P.match _Right ? P.allTrue + [ P.fun _erOutput ? P.equals [InterpretValue (PInteger 15) noInfo] + , P.fun _erEvents ? P.equals [] + , P.fun _erLogs ? P.equals [] + , P.fun _erExec ? P.equals Nothing + , P.fun _erGas ? P.equals ? Gas 2 + , P.fun _erLoadedModules ? P.equals mempty + , P.fun _erTxId ? P.equals ? Just (TxId 9) -- TODO: test _erLogGas? ] @@ -388,16 +395,16 @@ applyLocalSpec rdb = readFromAfterGenesis v rdb $ let txCtx = TxContext {_tcParentHeader = ParentHeader (gh v cid), _tcMiner = noMiner} logger <- testLogger applyLocal logger Nothing pactDb txCtx noSPVSupport (view payloadObj <$> cmd) - >>= satAll + >>= P.allTrue -- Local has no buy gas, therefore -- no gas buy event - [ pt _crEvents ? equals ? [] - , pt _crResult ? equals ? PactResultOk (PInteger 15) + [ P.fun _crEvents ? P.equals ? [] + , P.fun _crResult ? P.equals ? PactResultOk (PInteger 15) -- reflects payload gas usage - , pt _crGas ? traceFailShow ? equals ? Gas 4 - , pt _crContinuation ? equals ? Nothing - , pt _crLogs ? equals ? Just [] - , pt _crMetaData ? match _Just continue + , P.fun _crGas ? P.equals ? Gas 4 + , P.fun _crContinuation ? P.equals ? Nothing + , P.fun _crLogs ? P.equals ? Just [] + , P.fun _crMetaData ? P.match _Just P.succeed ] endSender00Bal <- readBal pactDb "sender00" @@ -428,34 +435,35 @@ applyCmdSpec rdb = readFromAfterGenesis v rdb $ let expectedGasConsumed = 116 logger <- testLogger applyCmd logger Nothing pactDb txCtx noSPVSupport (Gas 1) (view payloadObj <$> cmd) - >>= match _Right - ? satAll + >>= P.match _Right + ? P.allTrue -- only the event reflecting the final transfer to the miner for gas used - [ pt _crEvents ? soleElement ? - event - (equals "TRANSFER") - (traceFailShow (equals [PString "sender00", PString "NoMiner", PDecimal 232.0])) - (equals coinModuleName) - , pt _crResult ? equals ? PactResultOk (PInteger 15) + [ P.fun _crEvents ? P.list + [ event + (P.equals "TRANSFER") + (P.equals [PString "sender00", PString "NoMiner", PDecimal 232.0]) + (P.equals coinModuleName) + ] + , P.fun _crResult ? P.equals ? PactResultOk (PInteger 15) -- reflects buyGas gas usage, as well as that of the payload - , pt _crGas ? traceFailShow ? equals ? Gas expectedGasConsumed - , pt _crContinuation ? equals ? Nothing - , pt _crLogs ? match _Just ? - PT.list - [ satAll - [ pt _txDomain ? equals ? "coin_coin-table" - , pt _txKey ? equals ? "sender00" + , P.fun _crGas ? P.equals ? Gas expectedGasConsumed + , P.fun _crContinuation ? P.equals ? Nothing + , P.fun _crLogs ? P.match _Just ? + P.list + [ P.allTrue + [ P.fun _txDomain ? P.equals ? "coin_coin-table" + , P.fun _txKey ? P.equals ? "sender00" -- TODO: test the values here? -- here, we're only testing that the write pattern matches -- gas buy and redeem, not the contents of the writes. ] - , satAll - [ pt _txDomain ? equals ? "coin_coin-table" - , pt _txKey ? equals ? "sender00" + , P.allTrue + [ P.fun _txDomain ? P.equals ? "coin_coin-table" + , P.fun _txKey ? P.equals ? "sender00" ] - , satAll - [ pt _txDomain ? equals ? "coin_coin-table" - , pt _txKey ? equals ? "NoMiner" + , P.allTrue + [ P.fun _txDomain ? P.equals ? "coin_coin-table" + , P.fun _txKey ? P.equals ? "NoMiner" ] ] ] @@ -492,19 +500,19 @@ applyCmdVerifierSpec rdb = readFromAfterGenesis v rdb $ let txCtx = TxContext {_tcParentHeader = ParentHeader (gh v cid), _tcMiner = noMiner} logger <- testLogger applyCmd logger Nothing pactDb txCtx noSPVSupport (Gas 1) (view payloadObj <$> cmd) - >>= match _Right - ? satAll + >>= P.match _Right + ? P.allTrue -- gas buy event - [ pt _crEvents ? PT.list + [ P.fun _crEvents ? P.list [ event - (equals "TRANSFER") - (traceFailShow (equals [PString "sender00", PString "NoMiner", PDecimal 904])) - (equals coinModuleName) + (P.equals "TRANSFER") + (P.equals [PString "sender00", PString "NoMiner", PDecimal 904]) + (P.equals coinModuleName) ] - , pt _crResult ? traceFailShow ? equals ? PactResultOk (PString "Loaded module free.m, hash Uj0lQPPu9CKvw13K4VP4DZoaPKOphk_-vuq823hLSLo") + , P.fun _crResult ? P.equals ? PactResultOk (PString "Loaded module free.m, hash Uj0lQPPu9CKvw13K4VP4DZoaPKOphk_-vuq823hLSLo") -- reflects buyGas gas usage, as well as that of the payload - , pt _crGas ? traceFailShow ? equals ? Gas 452 - , pt _crContinuation ? equals ? Nothing + , P.fun _crGas ? P.equals ? Gas 452 + , P.fun _crContinuation ? P.equals ? Nothing ] let baseCmd = defaultCmd @@ -525,22 +533,22 @@ applyCmdVerifierSpec rdb = readFromAfterGenesis v rdb $ let txCtx = TxContext {_tcParentHeader = ParentHeader (gh v cid), _tcMiner = noMiner} logger <- testLogger applyCmd logger Nothing pactDb txCtx noSPVSupport (Gas 1) (view payloadObj <$> cmd) - >>= match _Right - ? satAll + >>= P.match _Right + ? P.allTrue -- gas buy event - [ pt _crResult - ? soleElementOf (_PactResultErr . _PEUserRecoverableError . _1) - ? equals ? VerifierFailure (VerifierName "allow") "not in transaction" - , pt _crEvents ? PT.list - [ satAll - [ pt _peName ? equals ? "TRANSFER" - , pt _peArgs ? equals ? [PString "sender00", PString "NoMiner", PDecimal 600] - , pt _peModule ? equals ? ModuleName "coin" Nothing + [ P.fun _crResult + ? P.match (_PactResultErr . _PEUserRecoverableError . _1) + ? P.equals ? VerifierFailure (VerifierName "allow") "not in transaction" + , P.fun _crEvents ? P.list + [ P.allTrue + [ P.fun _peName ? P.equals ? "TRANSFER" + , P.fun _peArgs ? P.equals ? [PString "sender00", PString "NoMiner", PDecimal 600] + , P.fun _peModule ? P.equals ? ModuleName "coin" Nothing ] ] -- reflects buyGas gas usage, as well as that of the payload - , pt _crGas ? equals ? Gas 300 - , pt _crContinuation ? equals ? Nothing + , P.fun _crGas ? P.equals ? Gas 300 + , P.fun _crContinuation ? P.equals ? Nothing ] -- Invoke module when verifier capability is present. Should succeed. @@ -559,20 +567,20 @@ applyCmdVerifierSpec rdb = readFromAfterGenesis v rdb $ let txCtx = TxContext {_tcParentHeader = ParentHeader (gh v cid), _tcMiner = noMiner} logger <- testLogger applyCmd logger Nothing pactDb txCtx noSPVSupport (Gas 1) (view payloadObj <$> cmd) - >>= match _Right - ? satAll + >>= P.match _Right + ? P.allTrue -- gas buy event - [ pt _crEvents ? PT.list + [ P.fun _crEvents ? P.list [ event - (equals "TRANSFER") - (traceFailShow ? equals [PString "sender00", PString "NoMiner", PDecimal 264]) - (equals coinModuleName) + (P.equals "TRANSFER") + (P.equals [PString "sender00", PString "NoMiner", PDecimal 264]) + (P.equals coinModuleName) ] - , pt _crResult ? equals ? PactResultOk (PInteger 1) + , P.fun _crResult ? P.equals ? PactResultOk (PInteger 1) -- reflects buyGas gas usage, as well as that of the payload - , pt _crGas ? traceFailShow ? equals ? Gas 132 - , pt _crContinuation ? equals ? Nothing - , pt _crMetaData ? equals ? Nothing + , P.fun _crGas ? P.equals ? Gas 132 + , P.fun _crContinuation ? P.equals ? Nothing + , P.fun _crMetaData ? P.equals ? Nothing ] applyCmdFailureSpec :: RocksDb -> IO () @@ -597,31 +605,31 @@ applyCmdFailureSpec rdb = readFromAfterGenesis v rdb $ let expectedGasConsumed = 500 logger <- testLogger applyCmd logger Nothing pactDb txCtx noSPVSupport (Gas 1) (view payloadObj <$> cmd) - >>= match _Right - ? satAll + >>= P.match _Right + ? P.allTrue -- gas buy event - [ pt _crEvents - ? PT.list + [ P.fun _crEvents + ? P.list [ event - (equals "TRANSFER") - (equals [PString "sender00", PString "NoMiner", PDecimal 1000]) - (equals coinModuleName) + (P.equals "TRANSFER") + (P.equals [PString "sender00", PString "NoMiner", PDecimal 1000]) + (P.equals coinModuleName) ] -- tx errored - , pt _crResult ? match _PactResultErr continue + , P.fun _crResult ? P.match _PactResultErr P.succeed -- reflects buyGas gas usage, as well as that of the payload - , pt _crGas ? equals ? Gas expectedGasConsumed - , pt _crContinuation ? equals ? Nothing - , pt _crLogs ? match _Just ? - PT.list - [ satAll - [ pt _txDomain ? equals ? "coin_coin-table" - , pt _txKey ? equals ? "sender00" + , P.fun _crGas ? P.equals ? Gas expectedGasConsumed + , P.fun _crContinuation ? P.equals ? Nothing + , P.fun _crLogs ? P.match _Just ? + P.list + [ P.allTrue + [ P.fun _txDomain ? P.equals ? "coin_coin-table" + , P.fun _txKey ? P.equals ? "sender00" ] - , satAll - [ pt _txDomain ? equals ? "coin_coin-table" - , pt _txKey ? equals ? "NoMiner" + , P.allTrue + [ P.fun _txDomain ? P.equals ? "coin_coin-table" + , P.fun _txKey ? P.equals ? "NoMiner" ] ] ] @@ -657,47 +665,47 @@ applyCmdCoinTransfer rdb = readFromAfterGenesis v rdb $ do let expectedGasConsumed = 344 logger <- testLogger e <- applyCmd logger (Just logger) pactDb txCtx noSPVSupport (Gas 1) (view payloadObj <$> cmd) - e & match _Right - ? satAll - [ pt _crEvents ? PT.list + e & P.match _Right + ? P.allTrue + [ P.fun _crEvents ? P.list -- transfer event and gas redeem event [ event - (equals "TRANSFER") - (traceFailShow (equals [PString "sender00", PString "sender01", PDecimal 420])) - (equals coinModuleName) + (P.equals "TRANSFER") + (P.equals [PString "sender00", PString "sender01", PDecimal 420]) + (P.equals coinModuleName) , event - (equals "TRANSFER") - (traceFailShow (equals [PString "sender00", PString "NoMiner", PDecimal 34.4])) - (equals coinModuleName) + (P.equals "TRANSFER") + (P.equals [PString "sender00", PString "NoMiner", PDecimal 34.4]) + (P.equals coinModuleName) ] - , pt _crResult ? traceFailShow ? equals ? PactResultOk (PString "Write succeeded") + , P.fun _crResult ? P.equals ? PactResultOk (PString "Write succeeded") -- reflects buyGas gas usage, as well as that of the payload - , pt _crGas ? traceFailShow ? equals ? Gas expectedGasConsumed - , pt _crContinuation ? equals ? Nothing - , pt _crLogs ? match _Just ? - PT.list - [ satAll - [ pt _txDomain ? equals ? "coin_coin-table" - , pt _txKey ? equals ? "sender00" + , P.fun _crGas ? P.equals ? Gas expectedGasConsumed + , P.fun _crContinuation ? P.equals ? Nothing + , P.fun _crLogs ? P.match _Just ? + P.list + [ P.allTrue + [ P.fun _txDomain ? P.equals ? "coin_coin-table" + , P.fun _txKey ? P.equals ? "sender00" -- TODO: test the values here? -- here, we're only testing that the write pattern matches -- gas buy and redeem, not the contents of the writes. ] - , satAll - [ pt _txDomain ? equals ? "coin_coin-table" - , pt _txKey ? equals ? "sender00" + , P.allTrue + [ P.fun _txDomain ? P.equals ? "coin_coin-table" + , P.fun _txKey ? P.equals ? "sender00" ] - , satAll - [ pt _txDomain ? equals ? "coin_coin-table" - , pt _txKey ? equals ? "sender01" + , P.allTrue + [ P.fun _txDomain ? P.equals ? "coin_coin-table" + , P.fun _txKey ? P.equals ? "sender01" ] - , satAll - [ pt _txDomain ? equals ? "coin_coin-table" - , pt _txKey ? equals ? "sender00" + , P.allTrue + [ P.fun _txDomain ? P.equals ? "coin_coin-table" + , P.fun _txKey ? P.equals ? "sender00" ] - , satAll - [ pt _txDomain ? equals ? "coin_coin-table" - , pt _txKey ? equals ? "NoMiner" + , P.allTrue + [ P.fun _txDomain ? P.equals ? "coin_coin-table" + , P.fun _txKey ? P.equals ? "NoMiner" ] ] ] @@ -717,21 +725,22 @@ applyCoinbaseSpec rdb = readFromAfterGenesis v rdb $ let txCtx = TxContext {_tcParentHeader = ParentHeader (gh v cid), _tcMiner = noMiner} logger <- testLogger applyCoinbase logger pactDb 5 txCtx - >>= match _Right - ? satAll - [ pt _crResult ? equals ? PactResultOk (PString "Write succeeded") - , pt _crGas ? equals ? Gas 0 - , pt _crLogs ? match _Just ? PT.list - [ satAll - [ pt _txDomain ? equals ? "coin_coin-table" - , pt _txKey ? equals ? "NoMiner" + >>= P.match _Right + ? P.allTrue + [ P.fun _crResult ? P.equals ? PactResultOk (PString "Write succeeded") + , P.fun _crGas ? P.equals ? Gas 0 + , P.fun _crLogs ? P.match _Just ? P.list + [ P.allTrue + [ P.fun _txDomain ? P.equals ? "coin_coin-table" + , P.fun _txKey ? P.equals ? "NoMiner" ] ] - , pt _crEvents ? soleElement ? - event - (equals "TRANSFER") - (equals [PString "", PString "NoMiner", PDecimal 5.0]) - (equals coinModuleName) + , P.fun _crEvents ? P.list + [ event + (P.equals "TRANSFER") + (P.equals [PString "", PString "NoMiner", PDecimal 5.0]) + (P.equals coinModuleName) + ] ] endMinerBal <- readBal pactDb "NoMiner" assertEqual "miner balance should include block reward" @@ -745,12 +754,12 @@ testCoinUpgrade rdb = readFromAfterGenesis vUpgrades rdb $ do logger <- testLogger getCoinModuleHash logger txCtx pactDb - >>= traceFailShow ? equals ? PactResultOk (PString "wOTjNC3gtOAjqgCY8S9hQ-LBiwcPUE7j4iBDE0TmdJo") + >>= P.equals ? PactResultOk (PString "wOTjNC3gtOAjqgCY8S9hQ-LBiwcPUE7j4iBDE0TmdJo") applyUpgrades logger pactDb txCtx getCoinModuleHash logger txCtx pactDb - >>= equals ? PactResultOk (PString "3iIBQdJnst44Z2ZgXoHPkAauybJ0h85l_en_SGHNibE") + >>= P.equals ? PactResultOk (PString "3iIBQdJnst44Z2ZgXoHPkAauybJ0h85l_en_SGHNibE") where getCoinModuleHash logger txCtx pactDb = do cmd <- buildCwCmd vUpgrades defaultCmd @@ -784,21 +793,21 @@ testEventOrdering rdb = readFromAfterGenesis v rdb $ logger <- testLogger e <- applyCmd logger Nothing pactDb txCtx noSPVSupport (Gas 1) (view payloadObj <$> cmd) - e & match _Right - ? satAll - [ pt _crEvents ? PT.list + e & P.match _Right + ? P.allTrue + [ P.fun _crEvents ? P.list [ event - (equals "TRANSFER") - (equals [PString "sender00", PString "sender01", PDecimal 420]) - (equals coinModuleName) + (P.equals "TRANSFER") + (P.equals [PString "sender00", PString "sender01", PDecimal 420]) + (P.equals coinModuleName) , event - (equals "TRANSFER") - (equals [PString "sender00", PString "sender01", PDecimal 69]) - (equals coinModuleName) + (P.equals "TRANSFER") + (P.equals [PString "sender00", PString "sender01", PDecimal 69]) + (P.equals coinModuleName) , event - (equals "TRANSFER") - (traceFailShow (equals [PString "sender00", PString "NoMiner", PDecimal 1156])) - (equals coinModuleName) + (P.equals "TRANSFER") + (P.equals [PString "sender00", PString "NoMiner", PDecimal 1156]) + (P.equals coinModuleName) ] ] @@ -821,15 +830,13 @@ testLocalOnlyFailsOutsideOfLocal rdb = readFromAfterGenesis v rdb $ do logger <- testLogger -- should succeed in local applyLocal logger Nothing pactDb txCtx noSPVSupport (view payloadObj <$> cmd) - >>= pt _crResult (match _PactResultOk something) + >>= P.fun _crResult (P.match _PactResultOk P.succeed) -- should fail in non-local applyCmd logger Nothing pactDb txCtx noSPVSupport (Gas 1) (view payloadObj <$> cmd) - >>= match _Right - ? pt _crResult - ? soleElementOf - (_PactResultErr . _PEExecutionError . _1 . _OperationIsLocalOnly) - ? something + >>= P.match _Right + ? P.fun _crResult + ? P.match (_PactResultErr . _PEExecutionError . _1 . _OperationIsLocalOnly) P.succeed testLocalOnly "(describe-module \"coin\")" @@ -852,7 +859,7 @@ testWritesFromFailedTxDontMakeItIn rdb = readFromAfterGenesis v rdb $ do logger <- testLogger e <- applyCmd logger Nothing pactDb txCtx noSPVSupport (Gas 1) (view payloadObj <$> moduleDeploy) - e & match _Right ? something + e & P.match _Right ? P.succeed finalHandle <- use pbBlockHandle