diff --git a/tests/PactContinuationSpec.hs b/tests/PactContinuationSpec.hs index 758cfadc3..4cd7fc017 100644 --- a/tests/PactContinuationSpec.hs +++ b/tests/PactContinuationSpec.hs @@ -149,16 +149,16 @@ testManagedCaps = do mhash <- mkModuleHash "HniQBJ-NUJan20k4t6MiqpzhqkSsKmIzN5ef76pcLCU" runResults allResults $ do - sysModuleCmd `succeedsWith` textVal "system module loaded" - acctModuleCmd `succeedsWith` textVal "TableCreated" - createAcctCmd `succeedsWith` Nothing -- Alice should be funded with $100 + sysModuleCmd `succeedsWith` (`shouldBe` textVal "system module loaded") + acctModuleCmd `succeedsWith` (`shouldBe` textVal "TableCreated") + succeeds createAcctCmd managedPay `succeedsWith'` - (Just $ (textVal' "Transfer succeeded", + (`shouldBe` (textVal "Transfer succeeded", [PactEvent "PAY" - [textVal' "Alice",textVal' "Bob",decValue' 0.9] + [textVal "Alice",textVal "Bob",decValue 0.9] "accounts" mhash])) - managedPayFails `failsWith` Just "insufficient balance" + managedPayFails `failsWith` (`shouldBe` "insufficient balance") -- | allows passing e.g. "-m CrossChain" to match only `testCrossChainYield` in ghci @@ -176,8 +176,8 @@ testOldNestedPacts = do allResults <- runAll [moduleCmd, nestedExecPactCmd] runResults allResults $ do - moduleCmd `succeedsWith` Nothing - nestedExecPactCmd `failsWith` (Just "Multiple or nested pact exec found") + succeeds moduleCmd + nestedExecPactCmd `failsWith` (`shouldBe` "Multiple or nested pact exec found") -- CONTINUATIONS TESTS @@ -257,10 +257,10 @@ testCorrectNextStep code command flags = do allResults <- runAll' [moduleCmd, executePactCmd, contNextStepCmd, checkStateCmd] noSPVSupport flags runResults allResults $ do - moduleCmd `succeedsWith` Nothing - executePactCmd `succeedsWith` textVal "step 0" - contNextStepCmd `succeedsWith` textVal "step 1" - checkStateCmd `failsWith` stepMisMatchMsg False 1 1 + succeeds moduleCmd + executePactCmd `succeedsWith` (`shouldBe` textVal "step 0") + contNextStepCmd `succeedsWith` (`shouldBe` textVal "step 1") + checkStateCmd `failsWith` (`shouldBe` stepMisMatchMsg False 1 1) threeStepPactCode :: T.Text -> T.Text @@ -349,10 +349,10 @@ testIncorrectNextStep code command flags = do allResults <- runAll' [moduleCmd, executePactCmd, incorrectStepCmd, checkStateCmd] noSPVSupport flags runResults allResults $ do - moduleCmd `succeedsWith` Nothing - executePactCmd `succeedsWith` textVal "step 0" - incorrectStepCmd `failsWith` stepMisMatchMsg False 2 0 - checkStateCmd `succeedsWith` textVal "step 1" + succeeds moduleCmd + executePactCmd `succeedsWith` (`shouldBe` textVal "step 0") + incorrectStepCmd `failsWith` (`shouldBe` stepMisMatchMsg False 2 0) + checkStateCmd `succeedsWith` (`shouldBe` textVal "step 1") testLastStep :: Text -> Text -> [ExecutionFlag] -> Expectation @@ -371,12 +371,12 @@ testLastStep code command flags = do contNextStep2Cmd, checkStateCmd] noSPVSupport flags runResults allResults $ do - moduleCmd `succeedsWith` Nothing - executePactCmd `succeedsWith` textVal "step 0" - contNextStep1Cmd `succeedsWith` textVal "step 1" - contNextStep2Cmd `succeedsWith` textVal "step 2" + succeeds moduleCmd + executePactCmd `succeedsWith` (`shouldBe` textVal "step 0") + contNextStep1Cmd `succeedsWith` (`shouldBe` textVal "step 1") + contNextStep2Cmd `succeedsWith` (`shouldBe` textVal "step 2") checkStateCmd `failsWith` - pactIdNotFoundMsg executePactCmd + (`shouldBe` pactIdNotFoundMsg executePactCmd) @@ -394,10 +394,10 @@ testErrStep code command flags = do allResults <- runAll' [moduleCmd, executePactCmd, contErrStepCmd, checkStateCmd] noSPVSupport flags runResults allResults $ do - moduleCmd `succeedsWith` Nothing - executePactCmd `succeedsWith` textVal "step 0" - contErrStepCmd `failsWith` Nothing - checkStateCmd `failsWith` stepMisMatchMsg False 2 0 + succeeds moduleCmd + executePactCmd `succeedsWith` (`shouldBe` textVal "step 0") + fails contErrStepCmd + checkStateCmd `failsWith` (`shouldBe` stepMisMatchMsg False 2 0) errorStepPactCode :: T.Text -> T.Text @@ -483,12 +483,12 @@ testCorrectRollbackStep = do rollbackStepCmd, checkStateCmd] runResults allResults $ do - moduleCmd `succeedsWith` Nothing - executePactCmd `succeedsWith` textVal "step 0" - contNextStepCmd `succeedsWith` textVal "step 1" - rollbackStepCmd `succeedsWith` textVal "rollback 1" + succeeds moduleCmd + executePactCmd `succeedsWith` (`shouldBe` textVal "step 0") + contNextStepCmd `succeedsWith` (`shouldBe` textVal "step 1") + rollbackStepCmd `succeedsWith` (`shouldBe` textVal "rollback 1") checkStateCmd `failsWith` - pactIdNotFoundMsg executePactCmd + (`shouldBe` pactIdNotFoundMsg executePactCmd) @@ -522,11 +522,11 @@ testIncorrectRollbackStep = do incorrectRbCmd, checkStateCmd] runResults allResults $ do - moduleCmd `succeedsWith` Nothing - executePactCmd `succeedsWith` textVal "step 0" - contNextStepCmd `succeedsWith` textVal "step 1" - incorrectRbCmd `failsWith` stepMisMatchMsg True 2 1 - checkStateCmd `succeedsWith` textVal "step 2" + succeeds moduleCmd + executePactCmd `succeedsWith` (`shouldBe` textVal "step 0") + contNextStepCmd `succeedsWith` (`shouldBe` textVal "step 1") + incorrectRbCmd `failsWith` (`shouldBe` stepMisMatchMsg True 2 1) + checkStateCmd `succeedsWith` (`shouldBe` textVal "step 2") testRollbackErr :: Expectation @@ -547,11 +547,11 @@ testRollbackErr = do rollbackErrCmd, checkStateCmd] runResults allResults $ do - moduleCmd `succeedsWith` Nothing - executePactCmd `succeedsWith` textVal "step 0" - contNextStepCmd `succeedsWith` textVal "step 1" - rollbackErrCmd `failsWith` Nothing - checkStateCmd `succeedsWith` textVal "step 2" + succeeds moduleCmd + executePactCmd `succeedsWith` (`shouldBe` textVal "step 0") + contNextStepCmd `succeedsWith` (`shouldBe` textVal "step 1") + fails rollbackErrCmd + checkStateCmd `succeedsWith` (`shouldBe` textVal "step 2") pactWithRollbackErrCode :: T.Text -> T.Text @@ -584,11 +584,11 @@ testNoRollbackFunc = do noRollbackCmd, checkStateCmd] runResults allResults $ do - moduleCmd `succeedsWith` Nothing - executePactCmd `succeedsWith` textVal "step 0" - contNextStepCmd `succeedsWith` textVal "step 1" - noRollbackCmd `failsWith` Just "Rollback requested but none in step" - checkStateCmd `succeedsWith` textVal "step 2" + succeeds moduleCmd + executePactCmd `succeedsWith` (`shouldBe` textVal "step 0") + contNextStepCmd `succeedsWith` (`shouldBe` textVal "step 1") + noRollbackCmd `failsWith` (`shouldBe` "Rollback requested but none in step") + checkStateCmd `succeedsWith` (`shouldBe` textVal "step 2") @@ -678,16 +678,16 @@ testNestedPactYield = do mhash <- mkModuleHash "mGbCL-I0xXho_dxYfYAVmHfSfj3o43gbJ3ZgLHpaq14" runResults chain0Results $ do - moduleCmd `succeedsWith` Nothing + succeeds moduleCmd executePactCmd `succeedsWith'` - Just (textVal' "jose->A", + (`shouldBe` (textVal "jose->A", [PactEvent "X_YIELD" - [ textVal' "" - , textVal' "cross-chain-tester.cross-chain" - , PList $ V.fromList [ textVal' "jose" ]] + [ textVal "" + , textVal "cross-chain-tester.cross-chain" + , PList $ V.fromList [ textVal "jose" ]] "pact" - mhash]) + mhash])) shouldMatch executePactCmd $ ExpectResult $ \cr -> preview (crContinuation . _Just . peYield . _Just . ySourceChain . _Just) cr `shouldBe` @@ -728,17 +728,17 @@ testNestedPactYield = do "resumePact: pact completed: " ++ showPretty (_cmdHash executePactCmd) runResults chain1Results $ do - moduleCmd `succeedsWith` Nothing + succeeds moduleCmd chain1Cont `succeedsWith'` - Just (textVal' "jose->A->B", + (`shouldBe` (textVal "jose->A->B", [PactEvent "X_RESUME" - [ textVal' "" - , textVal' "cross-chain-tester.cross-chain" - , PList $ V.fromList [ textVal' "jose" ]] + [ textVal "" + , textVal "cross-chain-tester.cross-chain" + , PList $ V.fromList [ textVal "jose" ]] "pact" - mhash]) - chain1ContDupe `failsWith` Just completedPactMsg + mhash])) + chain1ContDupe `failsWith` (`shouldBe` completedPactMsg) testValidYield :: Text -> (Text -> Text) -> [ExecutionFlag] -> Expectation @@ -758,12 +758,12 @@ testValidYield moduleName mkCode flags = do resumeOnlyCmd, checkStateCmd] noSPVSupport flags runResults allResults $ do - moduleCmd `succeedsWith` Nothing - executePactCmd `succeedsWith` textVal "testing->Step0" - resumeAndYieldCmd `succeedsWith` textVal "testing->Step0->Step1" - resumeOnlyCmd `succeedsWith` textVal "testing->Step0->Step1->Step2" + succeeds moduleCmd + executePactCmd `succeedsWith` (`shouldBe` textVal "testing->Step0") + resumeAndYieldCmd `succeedsWith` (`shouldBe` textVal "testing->Step0->Step1") + resumeOnlyCmd `succeedsWith` (`shouldBe` textVal "testing->Step0->Step1->Step2") checkStateCmd `failsWith` - pactIdNotFoundMsg executePactCmd + (`shouldBe` pactIdNotFoundMsg executePactCmd) pactWithYield :: T.Text -> T.Text @@ -842,11 +842,11 @@ testNoYield moduleName mkCode flags = do resumeErrCmd, checkStateCmd] noSPVSupport flags runResults allResults $ do - moduleCmd `succeedsWith` Nothing - executePactCmd `succeedsWith` textVal "testing->Step0" - noYieldStepCmd `succeedsWith` textVal "step 1 has no yield" - resumeErrCmd `failsWith` Nothing - checkStateCmd `failsWith` stepMisMatchMsg False 1 1 + succeeds moduleCmd + executePactCmd `succeedsWith` (`shouldBe` textVal "testing->Step0") + noYieldStepCmd `succeedsWith` (`shouldBe` textVal "step 1 has no yield") + fails resumeErrCmd + checkStateCmd `failsWith` (`shouldBe` stepMisMatchMsg False 1 1) pactWithYieldErr :: T.Text -> T.Text @@ -914,12 +914,12 @@ testResetYield moduleName mkCode flags = do resumeStepCmd, checkStateCmd] noSPVSupport flags runResults allResults $ do - moduleCmd `succeedsWith` Nothing - executePactCmd `succeedsWith` textVal "step 0" - yieldSameKeyCmd `succeedsWith` textVal "step 1" - resumeStepCmd `succeedsWith` textVal "step 1" + succeeds moduleCmd + executePactCmd `succeedsWith` (`shouldBe` textVal "step 0") + yieldSameKeyCmd `succeedsWith` (`shouldBe` textVal "step 1") + resumeStepCmd `succeedsWith` (`shouldBe` textVal "step 1") checkStateCmd `failsWith` - pactIdNotFoundMsg executePactCmd + (`shouldBe` pactIdNotFoundMsg executePactCmd) @@ -1014,17 +1014,17 @@ testCrossChainYield blessCode expectFailure mkSpvSupport backCompat spvFlags = s mhash <- mkModuleHash "_9xPxvYomOU0iEqXpcrChvoA-E9qoaE1TqU460xN1xc" runResults chain0Results $ do - moduleCmd `succeedsWith` Nothing + succeeds moduleCmd executePactCmd `succeedsWith'` - Just (textVal' "emily->A", + (`shouldBe` (textVal "emily->A", if backCompat then [] else [PactEvent "X_YIELD" - [ textVal' "" - , textVal' "cross-chain-tester.cross-chain" - , PList $ V.fromList [ textVal' "emily" ]] + [ textVal "" + , textVal "cross-chain-tester.cross-chain" + , PList $ V.fromList [ textVal "emily" ]] "pact" - mhash]) + mhash])) shouldMatch executePactCmd $ ExpectResult $ \cr -> preview (crContinuation . _Just . peYield . _Just . ySourceChain . _Just) cr `shouldBe` @@ -1059,21 +1059,21 @@ testCrossChainYield blessCode expectFailure mkSpvSupport backCompat spvFlags = s "resumePact: pact completed: " ++ showPretty (_cmdHash executePactCmd) runResults chain1Results $ do - moduleCmd `succeedsWith` Nothing + succeeds moduleCmd case expectFailure of Nothing -> do -- chain1Cont `succeedsWith` textVal "emily->A->B" chain1Cont `succeedsWith'` - Just (textVal' "emily->A->B", - if backCompat then [] else - [PactEvent - "X_RESUME" - [ textVal' "" - , textVal' "cross-chain-tester.cross-chain" - , PList $ V.fromList [ textVal' "emily" ]] - "pact" - mhash]) - chain1ContDupe `failsWith` Just completedPactMsg + (`shouldBe` (textVal "emily->A->B", + if backCompat then [] else + [PactEvent + "X_RESUME" + [ textVal "" + , textVal "cross-chain-tester.cross-chain" + , PList $ V.fromList [ textVal "emily" ]] + "pact" + mhash])) + chain1ContDupe `failsWith` (`shouldBe` completedPactMsg) Just expected -> chain1ContDupe `failsWith'` expected @@ -1186,20 +1186,17 @@ twoPartyEscrow testCmds act = do allResults <- runAll allCmds runResults allResults $ do - sysModuleCmd `succeedsWith` textVal "system module loaded" - acctModuleCmd `succeedsWith` textVal "TableCreated" - testModuleCmd `succeedsWith` textVal "test module loaded" - createAcctCmd `succeedsWith` Nothing -- Alice should be funded with $100 - resetTimeCmd `succeedsWith` Nothing - runEscrowCmd `succeedsWith` Nothing - balanceCmd `succeedsWith` decValue 98.00 + sysModuleCmd `succeedsWith` (`shouldBe` textVal "system module loaded") + acctModuleCmd `succeedsWith` (`shouldBe` textVal "TableCreated") + testModuleCmd `succeedsWith` (`shouldBe` textVal "test module loaded") + succeeds createAcctCmd -- Alice should be funded with $100 + succeeds resetTimeCmd + succeeds runEscrowCmd + balanceCmd `succeedsWith` (`shouldBe` decValue 98.00) act (_cmdHash runEscrowCmd) -decValue :: Decimal -> Maybe PactValue -decValue = Just . decValue' - -decValue' :: Decimal -> PactValue -decValue' = PLiteral . LDecimal +decValue :: Decimal -> PactValue +decValue = PLiteral . LDecimal checkContHash :: HasCallStack @@ -1228,8 +1225,8 @@ testDebtorPreTimeoutCancel = do " creditor, or debitor after timeout" twoPartyEscrow allCmds $ checkContHash [req] $ do - tryCancelCmd `failsWith` Just cancelMsg - checkStillEscrowCmd `succeedsWith` decValue 98.00 + tryCancelCmd `failsWith` (`shouldBe` cancelMsg) + checkStillEscrowCmd `succeedsWith` (`shouldBe` decValue 98.00) testDebtorPostTimeoutCancel :: Expectation @@ -1242,9 +1239,9 @@ testDebtorPostTimeoutCancel = do let allCmds = [setTimeCmd, tryCancelCmd, checkStillEscrowCmd] twoPartyEscrow allCmds $ checkContHash [req] $ do - setTimeCmd `succeedsWith` Nothing - tryCancelCmd `succeedsWith` Nothing - checkStillEscrowCmd `succeedsWith` decValue 100.00 + succeeds setTimeCmd + succeeds tryCancelCmd + checkStillEscrowCmd `succeedsWith` (`shouldBe` decValue 100.00) testCreditorCancel :: Expectation @@ -1257,9 +1254,9 @@ testCreditorCancel = do let allCmds = [resetTimeCmd, credCancelCmd, checkStillEscrowCmd] twoPartyEscrow allCmds $ checkContHash [req] $ do - resetTimeCmd `succeedsWith` Nothing - credCancelCmd `succeedsWith` Nothing - checkStillEscrowCmd `succeedsWith` decValue 100.00 + succeeds resetTimeCmd + succeeds credCancelCmd + checkStillEscrowCmd `succeedsWith` (`shouldBe` decValue 100.00) testFinishAlone :: Expectation @@ -1273,9 +1270,9 @@ testFinishAlone = do twoPartyEscrow allCmds $ checkContHash [r1, r2] $ do tryCredAloneCmd `failsWith` - (Just "Keyset failure (keys-all): [7d0c9ba1...]") + (`shouldBe` "Keyset failure (keys-all): [7d0c9ba1...]") tryDebAloneCmd `failsWith` - (Just "Keyset failure (keys-all): [ac69d985...]") + (`shouldBe` "Keyset failure (keys-all): [ac69d985...]") testPriceNegUp :: Expectation @@ -1284,7 +1281,7 @@ testPriceNegUp = do (req, tryNegUpCmd) <- mkApiReq (testPath ++ "01-cont.yaml") twoPartyEscrow [tryNegUpCmd] $ checkContHash [req] $ do - tryNegUpCmd `failsWith` (Just "Price cannot negotiate up") + tryNegUpCmd `failsWith` (`shouldBe` "Price cannot negotiate up") testValidEscrowFinish :: Expectation @@ -1298,9 +1295,9 @@ testValidEscrowFinish = do twoPartyEscrow allCmds $ checkContHash [req] $ do tryNegDownCmd `succeedsWith` - (textVal "Escrow completed with 1.75 paid and 0.25 refunded") - credBalanceCmd `succeedsWith` decValue 1.75 - debBalanceCmd `succeedsWith` decValue 98.25 + (`shouldBe` textVal "Escrow completed with 1.75 paid and 0.25 refunded") + credBalanceCmd `succeedsWith` (`shouldBe` decValue 1.75) + debBalanceCmd `succeedsWith` (`shouldBe` decValue 98.25) testPriceNegDownBadCaps :: Expectation testPriceNegDownBadCaps = do @@ -1308,7 +1305,7 @@ testPriceNegDownBadCaps = do (req, tryNegUpCmd) <- mkApiReq (testPath ++ "01-cont-badcaps.yaml") twoPartyEscrow [tryNegUpCmd] $ checkContHash [req] $ do - tryNegUpCmd `failsWith` (Just "Keyset failure (keys-all): [7d0c9ba1...]") + tryNegUpCmd `failsWith` (`shouldBe` "Keyset failure (keys-all): [7d0c9ba1...]") @@ -1330,23 +1327,25 @@ shouldMatch' CommandResultCheck{..} results = checkResult _crcExpect apiRes Nothing -> expectationFailure $ "Failed to find ApiResult for " ++ show _crcReqKey Just cr -> crTest cr +succeeds :: HasCallStack => Command Text -> + ReaderT (HM.HashMap RequestKey (CommandResult Hash)) IO () +succeeds cmd = cmd `succeedsWith` (\_ -> pure ()) - -shouldBeIfPresent :: (Show a, Eq a) => a -> Maybe a -> Expectation -shouldBeIfPresent _ Nothing = return () -shouldBeIfPresent actual (Just expected) = actual `shouldBe` expected - -succeedsWith :: HasCallStack => Command Text -> Maybe PactValue -> +succeedsWith :: HasCallStack => Command Text -> (PactValue -> Expectation) -> ReaderT (HM.HashMap RequestKey (CommandResult Hash)) IO () -succeedsWith cmd r = succeedsWith' cmd ((,[]) <$> r) +succeedsWith cmd r = succeedsWith' cmd (\(pv,es) -> (es `shouldBe` []) *> r pv) -succeedsWith' :: HasCallStack => Command Text -> Maybe (PactValue,[PactEvent]) -> +succeedsWith' :: HasCallStack => Command Text -> ((PactValue,[PactEvent]) -> Expectation) -> ReaderT (HM.HashMap RequestKey (CommandResult Hash)) IO () -succeedsWith' cmd r = shouldMatch cmd (resultShouldBe $ Right (`shouldBeIfPresent` r)) +succeedsWith' cmd r = shouldMatch cmd (resultShouldBe $ Right r) + +fails :: HasCallStack => Command Text -> + ReaderT (HM.HashMap RequestKey (CommandResult Hash)) IO () +fails cmd = cmd `failsWith` (\_ -> pure ()) -failsWith :: HasCallStack => Command Text -> Maybe String -> +failsWith :: HasCallStack => Command Text -> (String -> Expectation) -> ReaderT (HM.HashMap RequestKey (CommandResult Hash)) IO () -failsWith cmd r = failsWith' cmd ((`shouldBeIfPresent` r) . show . peDoc) +failsWith cmd r = failsWith' cmd (\e -> r (show (peDoc e))) failsWith' :: HasCallStack => Command Text -> (PactError -> Expectation) -> ReaderT (HM.HashMap RequestKey (CommandResult Hash)) IO () @@ -1391,27 +1390,23 @@ makeContCmd' makeContCmd' contProofM keyPairs isRollback cmdData pactExecCmd step nonce = mkCont (getPactId pactExecCmd) step isRollback cmdData def [(keyPairs,[])] (Just nonce) contProofM Nothing -textVal :: Text -> Maybe PactValue -textVal = Just . textVal' - -textVal' :: Text -> PactValue -textVal' = PLiteral . LString +textVal :: Text -> PactValue +textVal = PLiteral . LString getPactId :: Command Text -> PactId getPactId cmd = toPactId hsh where hsh = (toUntypedHash . _cmdHash) cmd -pactIdNotFoundMsg :: Command Text -> Maybe String -pactIdNotFoundMsg cmd = Just msg +pactIdNotFoundMsg :: Command Text -> String +pactIdNotFoundMsg cmd = "resumePact: pact completed: " <> txtPact where txtPact = unpack (asString (getPactId cmd)) - msg = "resumePact: pact completed: " <> txtPact -stepMisMatchMsg :: Bool -> Int -> Int -> Maybe String -stepMisMatchMsg isRollback attemptStep currStep = Just msg +stepMisMatchMsg :: Bool -> Int -> Int -> String +stepMisMatchMsg isRollback attemptStep currStep = + "resumePactExec: " <> typeOfStep <> " step mismatch with context: (" + <> show attemptStep <> ", " <> show currStep <> ")" where typeOfStep = if isRollback then "rollback" else "exec" - msg = "resumePactExec: " <> typeOfStep <> " step mismatch with context: (" - <> show attemptStep <> ", " <> show currStep <> ")" newtype ExpectResult = ExpectResult (CommandResult Hash -> Expectation) deriving (Semigroup)