Skip to content

Commit

Permalink
buyGas failure test
Browse files Browse the repository at this point in the history 
Change-Id: I9681fc5a64164aa9f2b0ecc10eafc680ddb7f37c
  • Loading branch information
@chessai
chessai committed Jul 24, 2024
1 parent 8608bb3 commit 7b8beb0
Showing 1 changed file with 25 additions and 22 deletions.
47 changes: 25 additions & 22 deletions test/Chainweb/Test/Pact5/TransactionExecTest.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -63,7 +63,7 @@ import qualified Chainweb.Pact5.TransactionExec
import qualified Chainweb.Pact5.TransactionExec as Pact5
import Chainweb.Pact5.Types (TxContext (..))
import Chainweb.Payload (PayloadWithOutputs_ (_payloadWithOutputsPayloadHash), Transaction (Transaction))
import Chainweb.Test.Pact4.Utils (dummyLogger, stdoutDummyLogger, withBlockHeaderDb)
import Chainweb.Test.Pact4.Utils (stdoutDummyLogger, stdoutDummyLogger, withBlockHeaderDb)
import Chainweb.Test.TestVersions
import Chainweb.Test.Utils
import Chainweb.Time
Expand Down Expand Up @@ -136,7 +136,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
cp <- initCheckpointer v cid sql
tdb <- mkTestBlockDb v =<< testRocksDb "testBuyGas" baseRdb
bhdb <- getWebBlockHeaderDb (_bdbWebBlockHeaderDb tdb) cid
T2 () _finalPactState <- withPactService v cid dummyLogger Nothing bhdb (_bdbPayloadDb tdb) sql testPactServiceConfig $ do
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
Expand All @@ -157,7 +157,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
}

let txCtx = TxContext {_tcParentHeader = ParentHeader gh, _tcMiner = noMiner}
buyGas dummyLogger pactDb txCtx (_payloadObj <$> cmd)
buyGas stdoutDummyLogger pactDb txCtx (_payloadObj <$> cmd)

endSender00Bal <- readBal pactDb "sender00"
assertEqual "balance after buying gas" (Just $ 100_000_000 - 200 * 2) endSender00Bal
Expand All @@ -169,7 +169,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
cp <- initCheckpointer v cid sql
tdb <- mkTestBlockDb v =<< testRocksDb "testBuyGas" baseRdb
bhdb <- getWebBlockHeaderDb (_bdbWebBlockHeaderDb tdb) cid
T2 () _finalPactState <- withPactService v cid dummyLogger Nothing bhdb (_bdbPayloadDb tdb) sql testPactServiceConfig $ do
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
Expand All @@ -190,9 +190,12 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
, _cbGasLimit = GasLimit (Gas 100_000)
}
let txCtx' = TxContext {_tcParentHeader = ParentHeader gh, _tcMiner = noMiner}
e <- try @_ @SomeException $ buyGas dummyLogger pactDb txCtx' (_payloadObj <$> cmd)
e <- buyGas stdoutDummyLogger pactDb txCtx' (_payloadObj <$> cmd)
case e of
_ -> print e
Left (PEUserRecoverableError (UserEnforceError "Insufficient funds") _ _) -> do
pure ()
r -> do
assertFailure $ "Expected Insufficient funds error, but got: " ++ show r

pure ()

Expand All @@ -202,7 +205,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
cp <- initCheckpointer v cid sql
tdb <- mkTestBlockDb v =<< testRocksDb "testBuyGas" baseRdb
bhdb <- getWebBlockHeaderDb (_bdbWebBlockHeaderDb tdb) cid
T2 () _finalPactState <- withPactService v cid dummyLogger Nothing bhdb (_bdbPayloadDb tdb) sql testPactServiceConfig $ do
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
Expand All @@ -225,7 +228,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
let txCtx = TxContext {_tcParentHeader = ParentHeader gh, _tcMiner = noMiner}
-- redeeming gas with 3 gas used, with a limit of 10, should return 7 gas worth of tokens
-- to the gas payer
redeemGasResult <- redeemGas dummyLogger pactDb txCtx (Gas 3) Nothing (_payloadObj <$> cmd)
redeemGasResult <- redeemGas stdoutDummyLogger pactDb txCtx (Gas 3) Nothing (_payloadObj <$> cmd)
endSender00Bal <- readBal pactDb "sender00"
assertEqual "balance after redeeming gas" (Just $ 100_000_000 + (10 - 3) * 2) endSender00Bal
endMinerBal <- readBal pactDb "NoMiner"
Expand All @@ -238,7 +241,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
cp <- initCheckpointer v cid sql
tdb <- mkTestBlockDb v =<< testRocksDb "testApplyPayload" baseRdb
bhdb <- getWebBlockHeaderDb (_bdbWebBlockHeaderDb tdb) cid
T2 () _finalPactState <- withPactService v cid dummyLogger Nothing bhdb (_bdbPayloadDb tdb) sql testPactServiceConfig $ do
T2 () _finalPactState <- withPactService v cid stdoutDummyLogger Nothing bhdb (_bdbPayloadDb tdb) sql testPactServiceConfig $ do
initialPayloadState v cid
payloadResult <- (throwIfNoHistory =<<) $ readFrom (Just $ ParentHeader gh) $ do
db <- view psBlockDbEnv
Expand Down Expand Up @@ -268,7 +271,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
payloadResult <- runExceptT $
runReaderT
(runTransactionM (runPayload Transactional pactDb noSPVSupport txCtx (_payloadObj <$> cmd)))
(TransactionEnv dummyLogger gasEnv)
(TransactionEnv stdoutDummyLogger gasEnv)
gasUsed <- readIORef gasRef
return (gasUsed, payloadResult)

Expand All @@ -293,7 +296,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
cp <- initCheckpointer v cid sql
tdb <- mkTestBlockDb v =<< testRocksDb "testApplyPayload" baseRdb
bhdb <- getWebBlockHeaderDb (_bdbWebBlockHeaderDb tdb) cid
T2 () _finalPactState <- withPactService v cid dummyLogger Nothing bhdb (_bdbPayloadDb tdb) sql testPactServiceConfig $ do
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
Expand All @@ -312,7 +315,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
, _cbGasLimit = GasLimit (Gas 500)
}
let txCtx = TxContext {_tcParentHeader = ParentHeader gh, _tcMiner = noMiner}
commandResult <- applyLocal dummyLogger Nothing pactDb txCtx noSPVSupport (_payloadObj <$> cmd)
commandResult <- applyLocal stdoutDummyLogger Nothing pactDb txCtx noSPVSupport (_payloadObj <$> cmd)
assertEqual "applyLocal output should reflect evaluation of the transaction code"
(PactResultOk $ PInteger 15)
(_crResult commandResult)
Expand Down Expand Up @@ -341,7 +344,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
cp <- initCheckpointer v cid sql
tdb <- mkTestBlockDb v =<< testRocksDb "testApplyPayload" baseRdb
bhdb <- getWebBlockHeaderDb (_bdbWebBlockHeaderDb tdb) cid
T2 () _finalPactState <- withPactService v cid dummyLogger Nothing bhdb (_bdbPayloadDb tdb) sql testPactServiceConfig $ do
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
Expand All @@ -364,7 +367,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
}
let txCtx = TxContext {_tcParentHeader = ParentHeader gh, _tcMiner = noMiner}
let expectedGasConsumed = 159
commandResult <- applyCmd dummyLogger Nothing pactDb txCtx noSPVSupport (_payloadObj <$> cmd) (Gas 1)
commandResult <- applyCmd stdoutDummyLogger Nothing pactDb txCtx noSPVSupport (_payloadObj <$> cmd) (Gas 1)
() <- commandResult & satAll
-- gas buy event

Expand Down Expand Up @@ -412,7 +415,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
cp <- initCheckpointer v cid sql
tdb <- mkTestBlockDb v =<< testRocksDb "testApplyPayload" baseRdb
bhdb <- getWebBlockHeaderDb (_bdbWebBlockHeaderDb tdb) cid
T2 () _finalPactState <- withPactService v cid dummyLogger Nothing bhdb (_bdbPayloadDb tdb) sql testPactServiceConfig $ do
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
Expand All @@ -439,7 +442,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
, _cbGasLimit = GasLimit (Gas 70_000)
}
let txCtx = TxContext {_tcParentHeader = ParentHeader gh, _tcMiner = noMiner}
commandResult <- applyCmd dummyLogger Nothing pactDb txCtx noSPVSupport (_payloadObj <$> cmd) (Gas 1)
commandResult <- applyCmd stdoutDummyLogger Nothing pactDb txCtx noSPVSupport (_payloadObj <$> cmd) (Gas 1)
commandResult & satAll @(IO ()) @_
-- gas buy event
[ pt _crEvents $ PT.list
Expand Down Expand Up @@ -489,7 +492,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
do
cmd <- buildCwCmd "nonce" v baseCmd
let txCtx = TxContext {_tcParentHeader = ParentHeader gh, _tcMiner = noMiner}
commandResult <- applyCmd dummyLogger Nothing pactDb txCtx noSPVSupport (_payloadObj <$> cmd) (Gas 1)
commandResult <- applyCmd stdoutDummyLogger Nothing pactDb txCtx noSPVSupport (_payloadObj <$> cmd) (Gas 1)
case _crResult commandResult of
PactResultErr (TxPactError (PEUserRecoverableError userRecoverableError _ _)) -> do
assertEqual "verifier failure" userRecoverableError (VerifierFailure (VerifierName "allow") "not in transaction")
Expand Down Expand Up @@ -525,7 +528,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
]
}
let txCtx = TxContext {_tcParentHeader = ParentHeader gh, _tcMiner = noMiner}
commandResult <- applyCmd dummyLogger Nothing pactDb txCtx noSPVSupport (_payloadObj <$> cmd) (Gas 1)
commandResult <- applyCmd stdoutDummyLogger Nothing pactDb txCtx noSPVSupport (_payloadObj <$> cmd) (Gas 1)
commandResult & satAll @(IO ()) @_
-- gas buy event
[ pt _crEvents $ PT.list
Expand Down Expand Up @@ -564,7 +567,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
cp <- initCheckpointer v cid sql
tdb <- mkTestBlockDb v =<< testRocksDb "testApplyPayload" baseRdb
bhdb <- getWebBlockHeaderDb (_bdbWebBlockHeaderDb tdb) cid
T2 () _finalPactState <- withPactService v cid dummyLogger Nothing bhdb (_bdbPayloadDb tdb) sql testPactServiceConfig $ do
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
Expand All @@ -589,7 +592,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
let txCtx = TxContext {_tcParentHeader = ParentHeader gh, _tcMiner = noMiner}
-- Note: if/when core changes gas prices, tweak here.
let expectedGasConsumed = 509
commandResult <- applyCmd dummyLogger Nothing pactDb txCtx noSPVSupport (_payloadObj <$> cmd) (Gas 1)
commandResult <- applyCmd stdoutDummyLogger Nothing pactDb txCtx noSPVSupport (_payloadObj <$> cmd) (Gas 1)
() <- commandResult & satAll
-- gas buy event
[ pt _crEvents $ PT.list
Expand Down Expand Up @@ -649,7 +652,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
cp <- initCheckpointer v cid sql
tdb <- mkTestBlockDb v =<< testRocksDb "testApplyPayload" baseRdb
bhdb <- getWebBlockHeaderDb (_bdbWebBlockHeaderDb tdb) cid
T2 () _finalPactState <- withPactService v cid dummyLogger Nothing bhdb (_bdbPayloadDb tdb) sql testPactServiceConfig $ do
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
Expand All @@ -658,7 +661,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
startMinerBal <- readBal pactDb "NoMiner"

let txCtx = TxContext {_tcParentHeader = ParentHeader gh, _tcMiner = noMiner}
r <- applyCoinbase dummyLogger pactDb 5 txCtx
r <- applyCoinbase stdoutDummyLogger pactDb 5 txCtx
() <- r & satAll
[ pt _crResult . equals $ PactResultOk (PString "Write succeeded")
, pt _crGas . equals $ Gas 0
Expand Down

0 comments on commit 7b8beb0

Please sign in to comment.