diff --git a/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs b/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs index f753d49882..8631c55f60 100644 --- a/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs +++ b/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs @@ -62,7 +62,7 @@ import GHC.Stack import Network.Connection qualified as HTTP import Network.HTTP.Client (Manager) import Network.HTTP.Client.TLS qualified as HTTP -import Network.HTTP.Types.Status (notFound404) +import Network.HTTP.Types.Status (notFound404, badRequest400) import Network.Socket qualified as Network import Network.TLS qualified as TLS import Network.Wai.Handler.Warp qualified as W @@ -113,6 +113,7 @@ import Chainweb.Test.Utils (TestPact5CommandResult, deadbeef, withResource', wit import Chainweb.Utils import Chainweb.Version import Chainweb.WebPactExecutionService +import Chainweb.Version.Mainnet (mainnet) data Fixture = Fixture { _cutFixture :: CutFixture.Fixture @@ -165,6 +166,11 @@ withFixture' fixture tests = withDict @HasFixture fixture $ CutFixture.withFixture' (_cutFixture <$> remotePactTestFixture) tests +withSharedFixture :: ResourceT IO Fixture -> ((CutFixture.HasFixture, HasFixture) => TestTree) -> TestTree +withSharedFixture mk tests = + withResourceT mk $ \fixture -> + withFixture' fixture tests + withFixture :: Fixture -> ((CutFixture.HasFixture, HasFixture) => a) -> a withFixture fixture tests = withFixture' (return fixture) tests @@ -190,6 +196,7 @@ tests rdb = withResource' (evaluate httpManager >> evaluate cert) $ \_ -> , testCaseSteps "allocationTest" (allocationTest rdb) , testCaseSteps "webAuthnSignatureTest" (webAuthnSignatureTest rdb) , testCaseSteps "localContTest" (localContTest rdb) + , localPreflightSimTest rdb ] pollingInvalidRequestKeyTest :: RocksDb -> Step -> IO () @@ -341,7 +348,7 @@ spvTest baseRdb step = runResourceT $ do invalidTxsTest :: RocksDb -> TestTree -invalidTxsTest rdb = withResourceT (mkFixture v rdb) $ \fixtureIO -> withFixture' fixtureIO $ +invalidTxsTest rdb = withSharedFixture (mkFixture v rdb) $ sequentialTestGroup "invalid txs tests" AllSucceed [ testCase "syntax error" $ do cmdParseFailure <- buildTextCmd v @@ -649,6 +656,72 @@ localContTest baseRdb _step = runResourceT $ do >>= P.match _Pact5LocalResultLegacy ? P.fun _crResult ? P.match _PactResultOk ? P.equals (PInteger 2) + +localPreflightSimTest :: RocksDb -> TestTree +localPreflightSimTest baseRdb = let + v = pact5InstantCpmTestVersion petersonChainGraph + cid = unsafeChainId 0 + in withSharedFixture (mkFixture v baseRdb) $ testGroup "preflight sim test" + [ testCase "ordinary txs" $ do + buildTextCmd v (defaultCmd cid) + >>= local v cid (Just PreflightSimulation) Nothing Nothing + >>= P.match _Pact5LocalResultWithWarns ? P.fun fst ? successfulTx + + buildTextCmd v (defaultCmd cid) + >>= local v cid (Just PreflightSimulation) (Just NoVerify) Nothing + >>= P.match _Pact5LocalResultWithWarns ? P.fun fst ? successfulTx + + -- TODO(?) + -- step "Execute preflight /local tx - unparseable chain id" + -- sigs0 <- testKeyPairs sender00 Nothing + -- cmd1 <- mkRawTx mv (Pact.ChainId "fail") sigs0 + -- runClientFailureAssertion sid cenv cmd1 "Unparseable transaction chain id" + + -- TODO: check that NoVerify actually works + + , testCase "invalid metadata" $ do + buildTextCmd v (defaultCmd $ unsafeChainId maxBound) + >>= local v cid (Just PreflightSimulation) Nothing Nothing + & fails ? P.match _FailureResponse ? P.allTrue + [ P.fun responseStatusCode ? P.equals badRequest400 + , P.fun responseBody ? P.equals "Metadata validation failed: [\"Chain id mismatch\"]" + ] + + buildTextCmd v (set cbGasLimit (GasLimit $ Gas 100000000000000) $ defaultCmd cid) + >>= local v cid (Just PreflightSimulation) Nothing Nothing + & fails ? P.match _FailureResponse ? P.allTrue + [ P.fun responseStatusCode ? P.equals badRequest400 + , P.fun responseBody ? P.equals "Metadata validation failed: [\"Transaction Gas limit exceeds block gas limit\"]" + ] + + buildTextCmd v (set cbGasPrice (GasPrice 0.00000000000000001) $ defaultCmd cid) + >>= local v cid (Just PreflightSimulation) Nothing Nothing + & fails ? P.match _FailureResponse ? P.allTrue + [ P.fun responseStatusCode ? P.equals badRequest400 + , P.fun responseBody ? P.equals "Metadata validation failed: [\"Gas price decimal precision too high\"]" + ] + + buildTextCmd mainnet (defaultCmd cid) + >>= local v cid (Just PreflightSimulation) Nothing Nothing + & fails ? P.match _FailureResponse ? P.allTrue + [ P.fun responseStatusCode ? P.equals badRequest400 + , P.fun responseBody ? P.equals "Metadata validation failed: [\"Network id mismatch\"]" + ] + + let sigs' = replicate 101 $ mkEd25519Signer' sender00 [] + buildTextCmd v (defaultCmd cid & set cbSigners sigs') + >>= local v cid (Just PreflightSimulation) Nothing Nothing + & fails ? P.match _FailureResponse ? P.allTrue + [ P.fun responseStatusCode ? P.equals badRequest400 + , P.fun responseBody ? P.equals "Metadata validation failed: [\"Signature list size too big\"]" + ] + ] + + -- TODO: check metadata especially block height + + -- TODO: check runLocalWithDepth + + {- recvPwos <- runCutWithTx v pacts targetMempoolRef blockDb $ \_n _bHeight _bHash bHeader -> do buildCwCmd "transfer-crosschain" v