diff --git a/cabal.project b/cabal.project index 22a196faf0..d2b9833668 100644 --- a/cabal.project +++ b/cabal.project @@ -101,8 +101,8 @@ source-repository-package source-repository-package type: git location: https://github.com/kadena-io/pact-5.git - tag: 87c2d748ce18331cd8e0ad45af11c93b64684323 - --sha256: 1w0rmid741c6amvcgcla21yvliilp09aixcr9rzhvj4gc6mfbflc + tag: ebb66271ecce7cac1a7901a15658ad1b8233743a + --sha256: 1c362q6jpiq7gndypxci5bdpcm7hxbpg90fim4c977pxphsbiv1k source-repository-package type: git diff --git a/chainweb.cabal b/chainweb.cabal index 1f2fcddba5..516b413c46 100644 --- a/chainweb.cabal +++ b/chainweb.cabal @@ -661,6 +661,7 @@ test-suite chainweb-tests Chainweb.Test.Pact5.RemotePactTest Chainweb.Test.Pact5.SPVTest Chainweb.Test.Pact5.TransactionExecTest + Chainweb.Test.Pact5.TransactionTests Chainweb.Test.RestAPI Chainweb.Test.Roundtrips Chainweb.Test.SPV @@ -725,6 +726,7 @@ test-suite chainweb-tests , pact-tng , pact-tng:pact-request-api , pact-tng:test-utils + , pact-tng:pact-repl , patience >= 0.3 , prettyprinter , property-matchers ^>= 0.4 diff --git a/node/src/ChainwebNode.hs b/node/src/ChainwebNode.hs index 6ded0f6f06..79c009ef68 100644 --- a/node/src/ChainwebNode.hs +++ b/node/src/ChainwebNode.hs @@ -86,6 +86,7 @@ import Chainweb.Chainweb.CutResources import Chainweb.Counter import Chainweb.Cut.CutHashes import Chainweb.CutDB +import Chainweb.Difficulty import Chainweb.Logger import Chainweb.Logging.Config import Chainweb.Logging.Miner @@ -223,6 +224,7 @@ data BlockUpdate = BlockUpdate { _blockUpdateBlockHeader :: !(ObjectEncoded BlockHeader) , _blockUpdateOrphaned :: !Bool , _blockUpdateTxCount :: !Int + , _blockUpdateDifficultyDouble :: !Double } deriving (Show, Eq, Ord, Generic, NFData) @@ -231,10 +233,12 @@ instance ToJSON BlockUpdate where $ "header" .= _blockUpdateBlockHeader o <> "orphaned" .= _blockUpdateOrphaned o <> "txCount" .= _blockUpdateTxCount o + <> "difficultyDouble" .= _blockUpdateDifficultyDouble o toJSON o = object [ "header" .= _blockUpdateBlockHeader o , "orphaned" .= _blockUpdateOrphaned o , "txCount" .= _blockUpdateTxCount o + , "difficultyDouble" .= _blockUpdateDifficultyDouble o ] {-# INLINE toEncoding #-} @@ -261,10 +265,12 @@ runBlockUpdateMonitor logger db = L.withLoggerLabel ("component", "block-update- <$> pure (ObjectEncoded bh) -- _blockUpdateBlockHeader <*> pure False -- _blockUpdateOrphaned <*> txCount bh -- _blockUpdateTxCount + <*> pure (difficultyToDouble (targetToDifficulty (view blockTarget bh))) -- _blockUpdateDifficultyDouble toUpdate (Left bh) = BlockUpdate <$> pure (ObjectEncoded bh) -- _blockUpdateBlockHeader <*> pure True -- _blockUpdateOrphaned <*> ((0 -) <$> txCount bh) -- _blockUpdateTxCount + <*> pure (difficultyToDouble (targetToDifficulty (view blockTarget bh))) -- _blockUpdateDifficultyDouble -- type CutLog = HM.HashMap ChainId (ObjectEncoded BlockHeader) diff --git a/pact/pact5/coin-contract/coin.repl b/pact/pact5/coin-contract/coin.repl new file mode 100644 index 0000000000..e3cf96bff7 --- /dev/null +++ b/pact/pact5/coin-contract/coin.repl @@ -0,0 +1,1176 @@ +;; Enable the table gas model +(env-gasmodel "table") +(env-gaslimit 150000) + +(begin-tx) +(env-gas 0) (env-gaslog) +(load "../../coin-contract/v2/fungible-v2.pact") +(env-gaslog) +(expect + "Gas cost of loading fungible contract" + 918 (env-gas)) +(commit-tx) + +; we disable pact 44 to allow using un-namespaced keysets +(env-exec-config ["DisablePact44"]) +(env-gasmodel "table") +(env-gas 0) (env-gaslog) +(begin-tx) +(load "../../coin-contract/v4/fungible-xchain-v1.pact") +(env-gaslog) +(expect + "Gas cost of loading fungible-xchain contract" + 371 (env-gas)) +(commit-tx) +(begin-tx) +(load "../../coin-contract/coin.pact") +(env-gaslog) +(expect + "Gas cost of loading coin contract" + 21122 + (env-gas)) + +(create-table coin.coin-table) +(create-table coin.allocation-table) + +(commit-tx) + +;(verify 'coin) + +;; Account creation and account details unit tests + +(begin-tx) +(env-data { "emily" : ["keys1"], "doug": ["keys2"], "stuart": ["keys3"] }) +(env-keys ["keys1", "keys2", "keys3", "keys4"]) +(define-keyset 'emily (read-keyset "emily")) +(define-keyset 'doug (read-keyset "doug")) +(define-keyset 'stuart (read-keyset "stuart")) + +(env-gas 0) (env-gaslog) +(use coin) +(env-gaslog) +(expect + "Gas cost of using the coin contract" + 24 (env-gas)) + +;; account balance for emily does not exist, because account does not exist yet +(expect-failure + "account does not exist yet" + (get-balance 'emily)) + +;; create accounts should succeed and initialize with correct amounts and guards +(env-gas 0) (env-gaslog) +(create-account 'emily (read-keyset 'emily)) +(env-gaslog) +(expect + "Gas cost of coin contract account creation" + 42 (env-gas)) + +(create-account 'doug (read-keyset 'doug)) + + +; accounts conform to account structure +(expect-failure + "non-latin1+ascii account names fail to create" + "charset" + (create-account "emilyπ" (read-keyset 'emily))) + +(expect-failure + "empty account names fail to create" + "min length" + (create-account "" (read-keyset 'doug))) + +(expect-failure + "account names not >= 3 chars fail" + "min length" + (create-account "jo" (read-keyset 'stuart))) + +(expect-failure + "account names not <= 256 chars fail" + "max length" + (create-account + "Before getting down to business, let us ask why it should be that category theory has such far-reaching applications. \ + \Well, we said that it's the abstract theory of functions; so the answer is simply this: Functions are everywhere! \ + \And everywhere that functions are, there are categories. Indeed, the subject might better have been called abstract \ + \function theory, or perhaps even better: archery." + (read-keyset 'emily))) + +; check account balances for newly created accounts +(env-gas 0) (env-gaslog) +(expect + "initial balance at 0.0" + 0.0 + (get-balance 'emily)) +(env-gaslog) +(expect + "Gas cost of querying an account's balance" + 9 (env-gas)) + +; account information checks out for new accounts +(env-gas 0) (env-gaslog) +(expect + "details reflects the correct balance and guard information" + {"account" : "doug", "balance": 0.0, "guard": (read-keyset 'doug)} + (details 'doug)) +(env-gaslog) +(expect + "Gas cost of querying the details of an account" + 10 (env-gas)) + +(commit-tx) + +;; credits + debits should succeed. Both should reflect the correct balance + +(begin-tx) + +(use coin) + +; w/o capability +(expect-failure + "direct call to credit fails" + "not granted" + (credit 'emily (read-keyset 'emily) 1.0)) + +(expect-failure + "direct call to debit fails" + "not granted" + (debit 'emily 1.0)) + +(env-gas 0) (env-gaslog) +(test-capability (DEBIT 'emily)) +(env-gaslog) +(expect + "Gas cost of testing the DEBIT capability" + 12 (env-gas)) + +; debit tests +(expect-failure + "debit not > 0.0 quantities fail fast" + "must be positive" + (debit 'emily 0.0)) + +(expect-failure + "debit not > 0.0 quantities fail fast" + "must be positive" + (debit 'emily (- 1.0))) + +(expect-failure + "debit from account with 0.0 in it yields failure" + "Insufficient funds" + (debit 'emily 1.0)) + +(expect-failure + "cannot debit to poorly formatted accounts: charset" + "charset" + (debit "emilyπ" 1.0)) + +(expect-failure + "cannot debit to poorly formatted accounts: min length" + "min length" + (debit "l" 1.0)) + +(expect-failure + "cannot debit to poorly formatted accounts: max length" + "max length" + (debit "a mathematical object X is best thought of in the context of a category surrounding it, \ + \and is determined by the network of relations it enjoys with all the objects of that category. \ + \Moreover, to understand X it might be more germane to deal directly with the functor representing it" 1.0)) + +; credit tests +(test-capability (CREDIT "emily")) +(credit 'emily (read-keyset 'emily) 1.0) + +(expect + "account balance reflects credit" + 1.0 + (get-balance 'emily)) + +(expect-failure + "cannot credit to poorly formatted accounts: charset" + "charset" + (credit "emilyπ" (read-keyset 'emily) 1.0)) + +(expect-failure + "cannot credit to poorly formatted accounts: min length" + "min length" + (credit "l" (read-keyset 'emily) 1.0)) + +(expect-failure + "cannot credit to poorly formatted accounts: max length" + "max length" + (credit "The aim of theory really is, to a great extent, that of systematically organizing past experience in such a way that the next generation, our students and their students and so on, will be able to absorb the essential aspects in as painless a way as possible, and this is the only way in which you can go on cumulatively building up any kind of scientific activity without eventually coming to a dead end." (read-keyset 'emily) 1.0)) + +(test-capability (DEBIT "emily")) +(debit 'emily 1.0) + +(expect + "debiting funds now succeeds when there's enough funds" + 0.0 + (get-balance 'emily)) + +;; crediting non-existing accounts with guard should have supplied keys +(test-capability (CREDIT "stuart")) + +(expect-failure + "crediting trivial or negative funds fails fast" + "positive" + (credit 'stuart (read-keyset 'stuart) 0.0)) + +(expect-failure + "crediting trivial or negative funds fails fast" + "positive" + (credit 'stuart (read-keyset 'stuart) (- 1.0))) + +(credit 'stuart (read-keyset 'stuart) 1.0) + +(expect + "crediting funds to new account succeeds with correct balance" + 1.0 + (get-balance 'stuart)) + +(expect-failure + "cannot update a keyset for an existing account with wrong keyset" + "account guards do not match" + (credit 'stuart (read-keyset 'doug) 1.0)) + +(commit-tx) + +;; fund-tx should require GAS capability in scope, and all funds should succeed +;; when available and reflect correct balances + +(begin-tx) + +(use coin) + +(expect-failure + "fund-tx should fail when GAS is not in scope" + "not granted: (coin.GAS)" + (fund-tx 'emily 'doug (read-keyset 'doug) 1.0)) + +(test-capability (GAS)) +(env-keys []) + +(expect-failure + "fund-tx fails without signature" + "Keyset failure" + (fund-tx 'emily 'doug (read-keyset 'doug) 1.0)) + +(env-sigs [{"key": "keys1", "caps": [(TRANSFER "emily" "doug" 1.0)]}]) + +(expect-failure + "fund-tx fails for no gas cap" + "Keyset failure" + (fund-tx 'emily 'doug (read-keyset 'doug) 1.0)) + +(expect-failure + "fund-tx fails for trivial or negative quantities" + "positive" + (fund-tx 'emily 'doug (read-keyset 'doug) 0.0)) + +(expect-failure + "fund-tx fails for trivial or negative quantities" + "positive" + (fund-tx 'emily 'doug (read-keyset 'doug) (- 1.0))) + +(env-sigs [{"key": "keys1", "caps": [(GAS), (DEBIT "emily")]}]) + +(expect-failure + "fund-tx fails for insufficient funds" + "Insufficient funds" + (fund-tx 'emily 'doug (read-keyset 'doug) 1.0)) + +(env-keys ["keys1"]) +(test-capability (CREDIT "emily")) +(credit "emily" (read-keyset "emily") 3.0) +(env-sigs [{"key": "keys1", "caps": [(GAS), (DEBIT "emily")]}]) +(expect + "fund-tx succeeds with gas cap" + "Write succeeded" + (fund-tx 'emily 'doug (read-keyset 'doug) 1.0)) + +(pact-state true) + +(env-sigs [{"key": "keys1", "caps": [(GAS),(TRANSFER "emily" "doug" 1.0), (DEBIT "emily")]}]) + +(expect + "fund-tx succeeds with gas cap and other cap" + "Write succeeded" + (fund-tx 'emily 'doug (read-keyset 'doug) 1.0)) + +(pact-state true) + +(env-keys ["keys1"]) +(expect + "fund-tx succeeds with no caps" + "Write succeeded" + (fund-tx 'emily 'doug (read-keyset 'doug) 1.0)) + +(env-data { "fee" : 1.0 , "miner" : ["miner"] }) + +(expect + "redeem-gas succeeds when fee is in scope" + "Write succeeded" + (redeem-gas "miner" (read-keyset "miner") "emily" 1.0)) + +(commit-tx) + +;;; GAS (gas buying) tests + +(begin-tx) + +(use coin) + +;; setup for next txs +(env-data { "emily" : ["keys1"] }) +(env-keys ["keys1"]) +(test-capability (CREDIT "emily")) +(credit "emily" (read-keyset "emily") 1.0) + +(env-data { "fee" : 0.0, "emily" : ["keys1"], "doug": ["keys2"] }) +(env-keys ["keys1", "keys2"]) + +(test-capability (GAS)) + +(fund-tx 'emily 'doug (read-keyset 'doug) 1.0) + +(expect + "doug should now have 0.0 coins having mined the tx due to 0 gas" + 0.0 + (get-balance 'doug)) + +(expect + "emily should now have 0.0 coins after paying miner" + 0.0 + (get-balance 'emily)) + +(rollback-tx) + +;; credit to seed next tests +(begin-tx) + +(env-data { "fee" : 0.4, "emily" : ["keys1"], "doug": ["keys2"], "will": ["keys4"] }) +(env-keys ["keys1", "keys2", "keys4"]) + +(test-capability (coin.CREDIT "emily")) +(coin.credit "emily" (read-keyset "emily") 1.0) + +(commit-tx) + +; Test capabilities interactions with transfers +(begin-tx) + +(use coin) + +(env-data { "fee" : 0.4, "emily" : ["keys1"], "doug": ["keys2"], "will": ["keys4"] }) +(env-keys ["keys1", "keys2", "keys4"]) + +(test-capability (GAS)) + +(coin.fund-tx 'emily 'doug (read-keyset 'doug) 1.0) + +(continue-pact 1) +(expect + "doug should now have 0.4 coins after mining 0.4 coin fee" + 0.4 + (get-balance 'doug)) + +(expect + "emily should now have 0.6 coins after paying for 0.4 coin fee" + 0.6 + (get-balance 'emily)) + +;; transfers should respect balances as intended +(test-capability (CREDIT "emily")) +(credit 'emily (read-keyset 'emily) 1.0) + +(commit-tx) +(begin-tx) +(use coin) + +(expect-failure + "transfers of trivial or negative quantities fails fast" + "positive" + (transfer 'emily 'doug 0.0)) + +(expect-failure "can't install negative" + "Positive amount" + (test-capability (coin.TRANSFER "emily" "doug" -1.0))) + +(expect-failure + "Transfer fails without managed cap installed" + "not installed" + (transfer 'emily 'doug 1.0)) + +(test-capability (coin.TRANSFER "emily" "doug" 1.0)) +(env-gas 0) (env-gaslog) +(expect + "roundtrip 1.0 transfer succeeds" "Write succeeded" + (transfer 'emily 'doug 1.0)) +(env-gaslog) +(expect + "Gas cost of transfer" + 121 (env-gas)) + +(expect-failure "emily->doug capability used up" + "TRANSFER exceeded" + (transfer 'emily 'doug 1.0)) + +(expect + "emily now has 0.6 coins after transfer to 'doug" + 0.6 + (get-balance 'emily)) + +(expect + "doug now has 1.4 coins after transfer from 'emily" + 1.4 + (get-balance 'doug)) + +(commit-tx) +(begin-tx) +(use coin) + +(test-capability (coin.TRANSFER "emily" "doug" 1.0)) +(expect-failure + "emily now has insufficient funds and cannot transfer" + "Insufficient funds" + (transfer 'emily 'doug 1.0)) + +(expect-failure "No account for will" + "No value found in table coin_coin-table for key: will" + (get-balance 'will)) + +(test-capability (TRANSFER 'doug 'will 1.0)) +(env-gas 0) (env-gaslog) +(expect "transfer-create to new account succeeds" + "Write succeeded" + (transfer-create 'doug 'will (read-keyset 'will) 1.0)) +(env-gaslog) +(expect + "Gas cost of transfer-create" 108 (env-gas)) + +(expect + "doug now has 0.4 coins" + 0.4 + (get-balance 'doug)) + +(expect + "will now has 1.0 coins" + 1.0 + (get-balance 'will)) + +(expect + "details reflects the correct balance and guard information" + {"account" : "will", "balance": 1.0, "guard": (read-keyset 'will)} + (details 'will)) + +;; coinbase should fail when 'COINBASE' capability is not in scope +;; and should magically create tokens for users and reflect correct balance + +(commit-tx) +(begin-tx) +(use coin) + +(expect-failure + "coinbase fails when capability is not in scope" + "not granted" + (coinbase 'emily (read-keyset 'emily) 0.0)) + +(test-capability (COINBASE)) + +(coinbase 'emily (read-keyset 'emily) 1.0) + +(test-capability (COINBASE)) +(expect-failure + "coinbasing trivial or negative amounts fails fast" + "positive" + (coinbase 'emily (read-keyset 'emily) 0.0)) + +(test-capability (COINBASE)) +(expect-failure + "coinbasing trivial or negative amounts fails fast" + "positive" + (coinbase 'emily (read-keyset 'emily) (- 1.0))) + +(expect + "after coinbase, emily should have 1.6 coins in its account" + 1.6 + (get-balance 'emily)) + + +(env-data { "miner2": ["miner2"] }) + +(expect-failure "no account for miner2" + "No value found in table coin_coin-table for key: miner2" + (get-balance 'miner2)) + +(test-capability (COINBASE)) +(coinbase 'miner2 (read-keyset 'miner2) 1.0) + +(expect + "coinbase should create accounts and credit them some amount" + 1.0 (get-balance 'miner2)) + +(commit-tx) + +;; test burn-creates on new chains + +(begin-tx) + +(use coin) +(env-chain-data { "chain-id" : "0" }) +(env-hash (hash "burn-create")) +(env-data {"doug": ["keys2"]}) +;(test-capability (coin.TRANSFER_XCHAIN "emily" "doug" 1.0 "1")) +(expect-failure + "cross-chain transfers fail without keys" + "Managed capability not installed" + (transfer-crosschain 'emily 'doug (read-keyset 'doug) "1" 0.0)) + +(env-sigs [{ 'key: "other", 'caps: [(coin.TRANSFER_XCHAIN 'emily 'doug 1.0 "1")]}]) + +(expect-failure + "cross-chain transfers fail wrong key" + "Keyset failure" + (transfer-crosschain 'emily 'doug (read-keyset 'doug) "1" 1.0)) + +(env-sigs [{ 'key: "keys1", 'caps: [(coin.TRANSFER_XCHAIN 'emily 'doug 1.0 "1")]}]) + +(expect-failure + "cross-chain transfers fail for trivial or negative quantities" + "positive" + (transfer-crosschain 'emily 'doug (read-keyset 'doug) "1" 0.0)) + +(expect-failure + "cross-chain transfers fail for trivial or negative quantities" + "positive" + (transfer-crosschain 'emily 'doug (read-keyset 'doug) "1" (- 1.0))) + +(expect + "burn side of cross-chain transfers succeed" + "success" + (let + ((p + (transfer-crosschain 'emily 'doug (read-keyset 'doug) "1" 1.0))) + "success")) + +; make sure chain-id is enforced in the yield +; using Pact40 error messages +(expect-failure + "create side of cross-chain transfer fails yield on wrong chain" + "Yield provenance does not match" + (continue-pact 1 false (hash "burn-create") + { "create-account": 'doug + , "create-account-guard": (read-keyset 'doug) + , "quantity": 1.0 + })) + +; successful path +(env-chain-data { "chain-id" : "1" }) + +(expect + "create side of cross-chain transfer succeeds" + "Write succeeded" + (continue-pact 1 false (hash "burn-create"))) + +; double spends are disallowed by construction +(expect-failure + "cross-chain transfer pact prevents double spends" + "Requested defpact already completed: defpact id:UT9N17TRzn2FmWlZdT_S7y-AC1A_yOugNbfRSz4VFPE" + (continue-pact 1 false (hash "burn-create"))) + +; account guard rotation +(expect + "account info for 'emily uses 'emily keyset pre-rotation" + "Account: 0.6 Guard: KeySet {keys: [keys1],pred: keys-all}" + (let + ((i (details 'emily))) + (format "Account: {} Guard: {}" [(at 'balance i) (at 'guard i)]))) + +; account details will now feature rotated guard +(env-keys ["keys1", "keys2"]) +(expect-failure + "guard rotation fails when ROTATE is not scoped" + "Managed capability not installed" + (rotate 'emily (read-keyset 'doug))) + +(env-sigs [{'key: "keys1", 'caps: [(coin.ROTATE "emily")]}]) +(install-capability (ROTATE "emily")) + +(expect + "guard rotation succeeds when ROTATE is scoped" + "Write succeeded" + (rotate 'emily (read-keyset 'doug))) + +(expect + "account info for 'emily uses 'doug keyset after rotation" + "Account: 0.6 Guard: KeySet {keys: [keys2],pred: keys-all}" + (let ((i (details 'emily))) + (format "Account: {} Guard: {}" [(at 'balance i) (at 'guard i)]))) + +(commit-tx) + +;; cover enforce-unit + +(begin-tx) + +(module T G + (defcap G () true) + (defconst UNIT_BAD 0.0000000000001) + (defconst UNIT_GOOD 0.000000000001)) + +(commit-tx) +(begin-tx) + +(use coin) +(use T) + +(expect + "valid unit" + true + (enforce-unit 1.234)) + +(expect-failure + "invalid precision" + "minimum precision" + (enforce-unit 1.1234567890123)) + +(expect-failure + "too small" + "minimum precision" + (enforce-unit UNIT_BAD)) + +(expect + "min value ok" + true + (enforce-unit UNIT_GOOD)) + +(env-keys ["keys1", "keys2"]) + +(test-capability (TRANSFER "emily" "doug" UNIT_GOOD)) +;; Transfer +(expect + "min transfer ok" + "Write succeeded" + (transfer 'emily 'doug UNIT_GOOD)) + + (expect-failure + "bad transfer fails" + "precision" + (transfer 'emily 'doug UNIT_BAD)) + +;; transfer-create +(expect-failure + "TRANSFER capability fails when paid amount is exceeded" + "TRANSFER exceeded" + (transfer-create 'emily 'doug (read-keyset 'doug) UNIT_GOOD)) +(commit-tx) +(begin-tx) + +(use coin) +(use T) + +(test-capability (TRANSFER "emily" "doug" (* 2 UNIT_GOOD))) +(expect + "min transfer-create ok" + "Write succeeded" + (transfer-create 'emily 'doug (read-keyset 'doug) UNIT_GOOD)) + +(expect-failure + "bad transfer-create fails" + "minimum precision" + (transfer-create 'emily 'doug (read-keyset 'doug) UNIT_BAD)) + +;;transfer-crosschain (step 0 only covered) + +(test-capability (TRANSFER_XCHAIN "emily" "doug" (* 2 UNIT_GOOD) "0")) +(expect + "min transfer-crosschain step 1 succeeds" + "success" + (let ((s "success")) + (transfer-crosschain 'emily 'doug (read-keyset 'doug) "0" UNIT_GOOD) + s)) + +(commit-tx) +(begin-tx) + +(use coin) +(use T) + +(test-capability (TRANSFER_XCHAIN "emily" "doug" (* 2 UNIT_GOOD) "0")) +(expect-failure + "bad transfer-crosschain fails" + "minimum precision" + (transfer-crosschain 'emily 'doug (read-keyset 'doug) "0" UNIT_BAD)) + +;;coinbase +(test-capability (COINBASE)) +(expect + "min coinbase succeeds" + "Write succeeded" + (coinbase 'doug (read-keyset 'doug) UNIT_GOOD)) + +(expect-failure + "bad coinbase fails" + "minimum precision" + (coinbase 'doug (read-keyset 'doug) UNIT_BAD)) + +;;buy-gas +(test-capability (GAS)) +(expect + "min buy-gas succeeds" + "Write succeeded" + (buy-gas 'emily UNIT_GOOD)) + +(expect-failure + "bad buy-gas fails" + "minimum precision" + (buy-gas 'emily UNIT_BAD)) + +;;redeem-gas +(env-data { "fee" : UNIT_GOOD, "doug": ["keys2"]}) + +(expect + "min redeem-gas succeeds" + "Write succeeded" + (redeem-gas 'doug (read-keyset 'doug) 'emily UNIT_GOOD)) + +(env-data { "fee" : UNIT_BAD, "doug": ["keys2"]}) + +(expect-failure + "bad redeem-gas fails" + "minimum precision" + (redeem-gas 'doug (read-keyset 'doug) 'emily UNIT_BAD)) + +(commit-tx) + +;; Coin allocation tests + +(begin-tx) + +(use coin) + +; account creation + +(expect-failure + "allocation account creation only occurs at genesis" + "not granted: (coin.GENESIS)" + (create-allocation-account "brandon" (time "1900-10-31T00:00:00Z") "brandon" 200000.0)) + +(test-capability (GENESIS)) + +(expect-failure + "all allocation amounts must be positive" + "non-negative" + (create-allocation-account "brandon" (time "1900-10-31T00:00:00Z") "brandon" -200000.0)) + +(expect-failure + "all allocation accounts must satisfy coin contract account min chars" + "min length" + (create-allocation-account "br" (time "1900-10-31T00:00:00Z") "brandon" 200000.0)) + +(expect-failure + "all allocation accounts must satisfy coin contract account max chars" + "max length" + (create-allocation-account + "There he met Saunders Mac Lane. Mac Lane, then visiting Paris, was anxious \ + \to learn from Yoneda, and commenced an interview with Yoneda in a cafe at \ + \Gare du Nord. The interview was continued on Yoneda's train until its \ + \departure. In its course, Mac Lane learned about the lemma and \ + \subsequently baptized it." + (time "1900-10-31T00:00:00Z") "brandon" 200000.0)) + +(expect-failure + "account creation fails when no keyset corresponds with keyset ref" + "Cannot find keyset in database: 'brandon" + (create-allocation-account "brandon" (time "2020-10-31T00:00:00Z") "brandon" 200000.0)) + +; successful keyset refs require defined keyset + +(env-data { "brandon" : ["brandon"]}) +(define-keyset "brandon" (read-keyset "brandon")) + +(expect + "allocating coin accounts succeeds" + "Write succeeded" + (create-allocation-account "brandon" (time "2020-10-31T00:00:00Z") "brandon" 10.0)) + +(expect + "allocation creates empty account" + {"account" : "brandon", "balance":0.0, "guard":(keyset-ref-guard "brandon")} + (details "brandon")) + +; release-allocation + +(expect-failure + "allocation coins fails since release date is not >= current time" + "funds locked until" + (release-allocation "brandon")) + +(env-chain-data { "block-time" : (time "2020-10-31T00:00:00Z") }) + +(expect-failure + "allocation release fails when keys are not in scope" + "Keyset failure" + (release-allocation "brandon")) + +(env-keys ["brandon"]) + +(expect + "successfully allocates funds for correct amounts and date" + "Allocation successfully released to main ledger" + (release-allocation "brandon")) + +(expect-failure + "releases fail when funds have been redeemed" + "funds have already been redeemed" + (release-allocation "brandon")) + +(expect + "brandon has 10 coins released to his account in coin contract" + 10.0 (get-balance 'brandon)) + +(commit-tx) + +(begin-tx) + +(use coin) + +(expect-failure + "gas-only fails without the presence of GAS" + "not granted: (coin.GAS)" + (gas-only)) + +(expect-failure + "gas-guard fails when GAS is not present" + "Enforce either the presence of a GAS cap or keyset" + (gas-guard (keyset-ref-guard "emily"))) + +(test-capability (GAS)) + +(expect + "gas-only succeeds with the presence of GAS" + true + (gas-only)) + +(expect + "gas-guard succeeds when one of Gas or keyset are present" + true + (gas-guard (keyset-ref-guard "emily"))) + +(commit-tx) + +(begin-tx) + +(use coin) + +(env-data { "bez" : ["bez"] }) +(env-keys ["bez"]) +(define-keyset "bez" (read-keyset "bez")) + +(expect + "gas-guard succeeds when GAS not present, but keyset is" + true + (gas-guard (keyset-ref-guard "bez"))) + +(commit-tx) + +(begin-tx) + +(use coin) + +(expect-failure + "Remediations fail without the presence of REMEDIATE" + "not granted" + (remediate "brandon" 1.0)) + +(test-capability (REMEDIATE)) + +(expect + "Remediations succeed in the presence of REMEDIATE" + "Write succeeded" + (remediate "brandon" 1.0)) + +(expect-failure + "Cannot remediate negative amounts" + "Remediation amount must be positive" + (remediate "brandon" -1.0)) + +(expect-failure + "Cannot remediate amounts that don't conform to unit standards" + "Amount violates minimum precision" + (remediate "brandon" 1.0000000000001)) + +(expect-failure + "Cannot remediate accounts that are too small" + "Account name does not conform to the min length requirement" + (remediate "br" 1.0)) + +(expect-failure + "Cannot remediate accounts that are too large" + "Account name does not conform to the max length requirement" + (remediate "Classically, category theory is a useful tool not so much because of the light it sheds on any particular mathematical discipline but instead because categories are so ubiquitous: mathematical objects in many different settings (sets, groups, smooth manifolds, and so on) can be organized into categories. Moreover, many elementary mathematical concepts can be described in purely categorical terms and therefore make sense in each of these settings." 1.0)) +(commit-tx) + +;; ====================================================== +;; test transfer, gas events +;; ====================================================== + +(begin-tx) +(env-events true) +;; "keys2" is a weird key value but don't want to change original test +(env-data {'k: ['keys2]}) +(env-sigs + [{ 'key: 'keys2, + 'caps: [(coin.TRANSFER 'doug 'emily 0.001),(coin.GAS)]}]) + +(coin.transfer 'doug 'emily 0.0001) +(expect "transfer event" + [{"name": "coin.TRANSFER","params": ["doug" "emily" 0.0001]}] + (map (remove 'module-hash) (env-events true))) + +(coin.transfer-create 'doug 'emily (read-keyset 'k) 0.0002) +(expect "transfer-create event" + [{"name": "coin.TRANSFER","params": ["doug" "emily" 0.0002]}] + (map (remove 'module-hash) (env-events true))) + +(env-sigs + [{"key":"keys2", "caps":[(coin.GAS), (coin.DEBIT "doug")]}]) +(test-capability (coin.GAS)) +(coin.fund-tx 'doug 'emily (read-keyset 'k) 0.0005) +(env-data { 'fee: 0.0004 }) +(continue-pact 1) +(expect "gas event" + [{"name": "coin.TRANSFER","params": ["doug" "emily" 0.0004]}] + (map (remove 'module-hash) (env-events true))) +(rollback-tx) + +;; ====================================================== +;; test xchain +;; ====================================================== + +(begin-tx) +(env-data {'k: ['keys2]}) +(env-keys ['keys2]) +(env-chain-data {'chain-id: "0"}) + +(test-capability (coin.TRANSFER_XCHAIN "emily" "doug" 0.00001 "1")) +(coin.transfer-crosschain 'emily 'doug (read-keyset 'k) "1" 0.00001) +(expect "xchain send events" + [ {"name": "coin.TRANSFER_XCHAIN" + ,"params": ["emily" "doug" 0.00001 "1"] + } + + {"name": "coin.TRANSFER" + ,"params": ["emily" "" 0.00001] + } + { "name": "pact.X_YIELD" + , "params": ["1" "coin.transfer-crosschain" ["emily" "doug" (read-keyset 'k) "1" 0.00001]] + } + ] + (map (remove 'module-hash) (env-events true))) + +(env-chain-data {'chain-id: "1"}) +(continue-pact 1) +(expect "xchain send events" + [ {"name": "coin.TRANSFER" + ,"params": ["" "doug" 0.00001] + } + {"name": "coin.TRANSFER_XCHAIN_RECD" + ,"params": ["" "doug" 0.00001 "0"] + } + { "name": "pact.X_RESUME" + , "params": ["0" "coin.transfer-crosschain" ["emily" "doug" (read-keyset 'k) "1" 0.00001]] + } + ] + (map (remove 'module-hash) (env-events true))) +(rollback-tx) + + +;; ====================================================== +;; test allocation release +;; ====================================================== + +(begin-tx) +(test-capability (coin.GENESIS)) +(env-data {'alloc:['alloc]}) +(define-keyset 'alloc) +(coin.create-allocation-account + "alloc" (time "2020-10-31T00:00:00Z") "alloc" 10.0) +(env-sigs + [{'key: 'alloc, 'caps: [(coin.RELEASE_ALLOCATION 'alloc 10.0)]}]) +(coin.release-allocation "alloc") +(expect "release-allocation events" + [{"name": "coin.RELEASE_ALLOCATION","params": ["alloc" 10.0]} + {"name": "coin.TRANSFER","params": ["" "alloc" 10.0]}] + (map (remove 'module-hash) (env-events true))) +(rollback-tx) + +;; ====================================================== +;; test chainweb single-key naming protocol +;; ====================================================== + +(begin-tx) +(env-data + {'k: ["5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4"] + ,'k2: + {'keys:["5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4"] + ,'pred:"keys-any"} + ,'multi: + { 'keys: + ["5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4" + "732f3118c452e0eb741c7b9c168e2c99a37a277d50aa2526147440cbe334a9fd" + ] + ,'pred:"keys-any"} + ,'multi2: + { 'keys: + ["5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4" + "732f3118c452e0eb741c7b9c168e2c99a37a277d50aa2526147440cbe334a9fd" + ] + ,'pred:"keys-all"} + }) +(env-sigs + [{'key:'keys2 + ,'caps: + [(coin.TRANSFER 'emily + "k:5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f3" + 0.02) + ,(coin.TRANSFER 'emily + "k:5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4" + 0.02) + ,(coin.TRANSFER 'emily + "w:rMKJaEs5vWJ5q6828DZNXbl66AGJUrtSoyR011AGusA:keys-any" + 0.02) + ,(coin.TRANSFER 'emily + "w:rMKJaEs5vWJ5q6828DZNXbl66AGJUrtSoyR011AGusA:keys-all" + 0.02)] + }]) +(length "k:5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f3") + +(expect-failure + "single-key mismatch, create-account" + "Single-key account protocol violation" + (coin.create-account + "k:5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f3" + (read-keyset 'k))) + +(expect-failure + "single-key mismatch, transfer-create" + "Single-key account protocol violation" + (coin.transfer-create + 'emily + "k:5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f3" + (read-keyset 'k) + 0.02)) + +(expect-failure + "single-key pred mismatch, create-account" + "Single-key account protocol violation" + (coin.create-account + "k:5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4" + (read-keyset 'k2))) + +(expect-failure + "single-key pred mismatch, transfer-create" + "Single-key account protocol violation" + (coin.transfer-create + 'emily + "k:5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4" + (read-keyset 'k2) + 0.02)) + +(expect-failure + "multi-sig hash mismatch, create-account" + "Reserved protocol guard violation: w" + (coin.create-account + "w:rMKJaEs5vWJ5q6828DZNXbl66AGJUrtSoyR011AGusB:keys-any" + (read-keyset 'multi))) + +(expect-failure + "multi-sig pred + hash mismatch, create-account" + "Reserved protocol guard violation: w" + (coin.create-account + "w:rMKJaEs5vWJ5q6828DZNXbl66AGJUrtSoyR011AGusA:keys-any" + (read-keyset 'multi2))) + +(expect-failure + "multi-sig pred mismatch, transfer-create" + "Reserved protocol guard violation: w" + (coin.transfer-create + 'emily + "w:rMKJaEs5vWJ5q6828DZNXbl66AGJUrtSoyR011AGusA:keys-all" + (read-keyset 'multi) + 0.02)) + +(expect-failure + "bad protocol, create-account" + "Reserved protocol guard violation: c" + (coin.create-account + "c:5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4" + (read-keyset 'k2))) + +(expect + "single-key success, create-account" + "Write succeeded" + (coin.create-account + "k:5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4" + (read-keyset 'k))) + +(expect + "multi-sig success, create-account" + "Write succeeded" + (coin.create-account + "w:rMKJaEs5vWJ5q6828DZNXbl66AGJUrtSoyR011AGusA:keys-any" + (read-keyset 'multi))) + +(rollback-tx) +(begin-tx) +(env-data + {'k: ["5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4"]}) +(env-sigs + [{'key:'keys2 + ,'caps: + [(coin.TRANSFER 'emily + "k:5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4" + 0.02)]}]) + +(expect + "single-key success, transfer-create" + "Write succeeded" + (coin.transfer-create + 'emily + "k:5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4" + (read-keyset 'k) + 0.02)) +(rollback-tx) +;;TODO cover crosschain + +; Test non-principal account rotating a guard is rejected +(begin-tx) +(env-data + {'k: ["5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4"] + , "jose":["greg"] + , "k1":["keys1"]} + + ) +(env-sigs + [{ "key":"5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4" + , "caps":[(coin.ROTATE "k:5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4")]} + ,{"key":"keys1" + , "caps":[(coin.ROTATE "emily")]} + ,{"key":"keys2" + , "caps":[(coin.ROTATE "emily")]}]) + +(coin.create-account "k:5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4" (read-keyset "k")) + +(expect-failure "rotate fails for k: account" + (coin.rotate "k:5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4" (read-keyset "jose"))) + +(expect "rotate works for same k:account with the corresponding principal guard" + "Write succeeded" + (coin.rotate "k:5b4c9fc5207fcf700a5fbcb48c261820149c8ecd52e005282ed9e3f5febcd1f4" (read-keyset "k"))) + +(expect "coin rotation works for vanity accounts" + "Write succeeded" + (coin.rotate "emily" (read-keyset "k1"))) + +(rollback-tx) diff --git a/pact/pact5/namespaces/ns.repl b/pact/pact5/namespaces/ns.repl new file mode 100644 index 0000000000..512bd7db6d --- /dev/null +++ b/pact/pact5/namespaces/ns.repl @@ -0,0 +1,210 @@ +(env-exec-config ["DisablePact44", "DisablePact45"]) +(begin-tx) + +(env-data + { 'ns-admin-keyset: ["admin"] + , 'ns-operate-keyset: ["operate"] + , 'ns-genesis-keyset: { "keys": [], "pred": "="} }) + +(load "../../namespaces/v1/ns.pact") + +(commit-tx) +(begin-tx) + +;; Test that we can upgrade ns.pact only when appropriate keys +;; are in scope. +(expect-failure + "Cannot upgrade the namespace contract due to governance failure" + "tx failure on upgrade" + (try (enforce false "tx failure on upgrade") (acquire-module-admin ns))) + +(env-keys ['admin]) +(load "../../namespaces/ns.pact") + +(commit-tx) +(begin-tx) + +(env-namespace-policy false (ns.validate)) + +(namespace 'user) +(env-keys []) + +(module mod G + (defcap G () (enforce false "disabled")) + (defun foo () 1)) + +(namespace 'free) + +(module mod G + (defcap G () (enforce false "disabled")) + (defun foo () 2)) + +; Note: This behavior was removed in pact 4.7 +; (expect-failure +; "Cannot bring kadena ns into scope w/o operate admin" +; (namespace 'kadena)) + +(env-keys ["operate"]) + +(namespace 'kadena) + +(module mod G + (defcap G () (enforce false "disabled")) + (defun foo () 3)) + +(commit-tx) + +(expect "user.mod works" 1 (user.mod.foo)) +(expect "free.mod works" 2 (free.mod.foo)) +(expect "kadena.mod works" 3 (kadena.mod.foo)) + +(begin-tx) +(env-keys ["operate"]) +(env-data + { 'ns-admin-keyset: ["admin"] + , 'ns-operate-keyset: ["operate"] }) + +(expect-failure "cannot redefine user" + (define-namespace 'user ns.GUARD_FAILURE ns.GUARD_FAILURE)) +(expect-failure "cannot redefine free" + (define-namespace 'free ns.GUARD_FAILURE ns.GUARD_FAILURE)) +(expect "can redefine kadena" + "Namespace defined: kadena" + (define-namespace 'kadena ns.GUARD_SUCCESS ns.GUARD_FAILURE)) + +(commit-tx) + +(begin-tx) +(env-keys []) + +(namespace 'kadena) + +(module mod2 G + (defcap G () (enforce false "disabled")) + (defun foo () 4)) +(commit-tx) +(begin-tx) + +(expect "kadena.mod2 works" 4 (kadena.mod2.foo)) + +(use ns) +(env-keys ["operate"]) +(expect-failure + "cannot register empty name" + (write-registry "" GUARD_SUCCESS true)) + +(expect-failure + "cannot register >64 length name" + (write-registry + "1234567890123456789012345678901234567890123456789012345678901234567890" + GUARD_SUCCESS true)) + +(expect-failure + "must be latin1 charset" + (write-registry "emilyπ" GUARD_SUCCESS true)) + +(commit-tx) +(begin-tx) + +(env-exec-config []) +(env-data + { 'single : + ["70c787fcfe6c6f4ec23d13c2e94682bc90952f7cec06c7dbac1c012b0b6678b9"] + , 'multi : ["a", "b"] + }) + +(expect + "single principal ns" + "n_c1a583206e24450af26de41110042b019695db8c" + (ns.create-principal-namespace (read-keyset 'single))) + +(expect + "multi principal ns" + "n_64bfdef1c668b167c87f7cf329454c572e284664" + (ns.create-principal-namespace (read-keyset 'multi))) + +(expect-failure + "Principal of other than admin keyset fails" + "Inactive or unregistered namespace" + (define-namespace + "n_c1a583206e24450af26de41110042b019695db8c" + (read-keyset 'single) + (read-keyset 'multi)) +) + +(define-namespace + "n_c1a583206e24450af26de41110042b019695db8c" + (read-keyset 'single) + (read-keyset 'single)) + +(define-namespace + "n_64bfdef1c668b167c87f7cf329454c572e284664" + (read-keyset 'multi) + (read-keyset 'multi)) + +(commit-tx) + +(begin-tx "test rotation") +(env-keys + [ "70c787fcfe6c6f4ec23d13c2e94682bc90952f7cec06c7dbac1c012b0b6678b9" ]) +;; rotate to multi/multi +(define-namespace + "n_c1a583206e24450af26de41110042b019695db8c" + (read-keyset 'multi) + (read-keyset 'multi)) +;; rotate to multi/single +(env-keys ["a","b"]) +(define-namespace + "n_c1a583206e24450af26de41110042b019695db8c" + (read-keyset 'multi) + (read-keyset 'single)) +(rollback-tx) + + +(begin-tx) +(env-exec-config []) +(env-keys + [ "70c787fcfe6c6f4ec23d13c2e94682bc90952f7cec06c7dbac1c012b0b6678b9" + , "a" + , "b" + ] + ) + +(namespace "n_c1a583206e24450af26de41110042b019695db8c") +(module modK G + (defcap G () true) + (defun f () 1)) + +(namespace "n_64bfdef1c668b167c87f7cf329454c572e284664") +(module modW G + (defcap G () true) + (defun f () 2)) + +(commit-tx) +(begin-tx) + +(expect + "k: principal namespaces work" + 1 + (n_c1a583206e24450af26de41110042b019695db8c.modK.f)) + +(expect + "w: principal namespaces work" + 2 + (n_64bfdef1c668b167c87f7cf329454c572e284664.modW.f)) + +(commit-tx) +(begin-tx) + +(env-data + { "n_c1a583206e24450af26de41110042b019695db8c.failure": ['k] + }) + +(namespace "n_c1a583206e24450af26de41110042b019695db8c") +(define-keyset "n_c1a583206e24450af26de41110042b019695db8c.failure") + +(expect-failure + "r: principal namespaces do not work" + "Unsupported guard protocol: r:" + (ns.create-principal-namespace + (keyset-ref-guard "n_c1a583206e24450af26de41110042b019695db8c.failure"))) diff --git a/pact/pact5/namespaces/v1/ns.repl b/pact/pact5/namespaces/v1/ns.repl new file mode 100644 index 0000000000..bd98ccabb4 --- /dev/null +++ b/pact/pact5/namespaces/v1/ns.repl @@ -0,0 +1,87 @@ +(begin-tx) +(env-data + { 'ns-admin-keyset: ["admin"] + , 'ns-operate-keyset: ["operate"] + , 'ns-genesis-keyset: { "keys": [], "pred": "="} }) + +(load "../../../namespaces/v1/ns.pact") +(commit-tx) + +(env-namespace-policy false (ns.validate)) + +(begin-tx) +(namespace 'user) +(env-keys []) + +(module mod G + (defcap G () (enforce false "disabled")) + (defun foo () 1)) + +(namespace 'free) + +(module mod G + (defcap G () (enforce false "disabled")) + (defun foo () 2)) + +; Note: this behavior was patched out in pact 4.7 +; (expect-failure +; "Cannot bring kadena ns into scope w/o operate admin" +; (namespace 'kadena)) + +(env-keys ["operate"]) + +(namespace 'kadena) + +(module mod G + (defcap G () (enforce false "disabled")) + (defun foo () 3)) + +(commit-tx) + +(expect "user.mod works" 1 (user.mod.foo)) +(expect "free.mod works" 2 (free.mod.foo)) +(expect "kadena.mod works" 3 (kadena.mod.foo)) + +(begin-tx) +(env-keys ["operate"]) +(env-data + { 'ns-admin-keyset: ["admin"] + , 'ns-operate-keyset: ["operate"] }) + +(expect-failure "cannot redefine user" + (define-namespace 'user ns.GUARD_FAILURE ns.GUARD_FAILURE)) +(expect-failure "cannot redefine free" + (define-namespace 'free ns.GUARD_FAILURE ns.GUARD_FAILURE)) +(expect "can redefine kadena" + "Namespace defined: kadena" + (define-namespace 'kadena ns.GUARD_SUCCESS ns.GUARD_FAILURE)) + +(commit-tx) + +(begin-tx) +(env-keys []) + +(namespace 'kadena) + +(module mod2 G + (defcap G () (enforce false "disabled")) + (defun foo () 4)) +(commit-tx) + +(expect "kadena.mod2 works" 4 (kadena.mod2.foo)) + +(use ns) +(env-keys ["operate"]) +(expect-failure + "cannot register empty name" + (write-registry "" GUARD_SUCCESS true)) + +(expect-failure + "cannot register >64 length name" + (write-registry + "1234567890123456789012345678901234567890123456789012345678901234567890" + GUARD_SUCCESS true)) + +(expect-failure + "must be latin1 charset" + (write-registry "emilyπ" GUARD_SUCCESS true)) diff --git a/src/Chainweb/BlockWeight.hs b/src/Chainweb/BlockWeight.hs index 28557e29aa..59604a3085 100644 --- a/src/Chainweb/BlockWeight.hs +++ b/src/Chainweb/BlockWeight.hs @@ -22,6 +22,7 @@ module Chainweb.BlockWeight ( -- * Block Weight BlockWeight(..) +, blockWeightToDouble , encodeBlockWeight , decodeBlockWeight , encodeBlockWeightBe @@ -66,6 +67,9 @@ instance MerkleHashAlgorithm a => IsMerkleLogEntry a ChainwebHashTag BlockWeight {-# INLINE toMerkleNode #-} {-# INLINE fromMerkleNode #-} +blockWeightToDouble :: BlockWeight -> Double +blockWeightToDouble (BlockWeight diff) = difficultyToDouble diff + encodeBlockWeight :: BlockWeight -> Put encodeBlockWeight (BlockWeight w) = encodeHashDifficulty w {-# INLINE encodeBlockWeight #-} @@ -81,4 +85,3 @@ encodeBlockWeightBe (BlockWeight w) = encodeHashDifficultyBe w decodeBlockWeightBe :: Get BlockWeight decodeBlockWeightBe = BlockWeight <$> decodeHashDifficultyBe {-# INLINE decodeBlockWeightBe #-} - diff --git a/src/Chainweb/Difficulty.hs b/src/Chainweb/Difficulty.hs index 72345ffa78..2d792fb64d 100644 --- a/src/Chainweb/Difficulty.hs +++ b/src/Chainweb/Difficulty.hs @@ -14,6 +14,7 @@ {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE TypeApplications #-} -- | -- Module: Chainweb.Difficulty @@ -32,6 +33,7 @@ module Chainweb.Difficulty -- * PowHashNat , PowHashNat(..) , powHashNat +, powHashNatToDouble , encodePowHashNat , decodePowHashNat , encodePowHashNatBe @@ -50,6 +52,7 @@ module Chainweb.Difficulty -- * HashDifficulty , HashDifficulty(..) +, difficultyToDouble , encodeHashDifficulty , decodeHashDifficulty , encodeHashDifficultyBe @@ -89,6 +92,7 @@ import Chainweb.Utils import Chainweb.Utils.Serialization import Numeric.Additive +import Data.Ratio -- -------------------------------------------------------------------------- -- -- Large Word Orphans @@ -141,6 +145,12 @@ powHashToWord256 :: (32 <= PowHashBytesCount) => PowHash -> Word256 powHashToWord256 = either error id . runGetEitherS decodeWordLe . SB.fromShort . powHashBytes {-# INLINE powHashToWord256 #-} +-- Strictly for presenting difficulty approximately to interfaces that can't understand Word256. +powHashNatToDouble :: PowHashNat -> Double +powHashNatToDouble (PowHashNat w) = realToFrac $ + (fromIntegral w :: Integer) % (fromIntegral (maxBound @Word256) :: Integer) +{-# INLINE powHashNatToDouble #-} + encodePowHashNat :: PowHashNat -> Put encodePowHashNat (PowHashNat n) = encodeWordLe n {-# INLINE encodePowHashNat #-} @@ -257,6 +267,10 @@ newtype HashDifficulty = HashDifficulty PowHashNat deriving newtype (AdditiveSemigroup, AdditiveAbelianSemigroup) deriving newtype (Num, Integral, Real) +-- Strictly for presenting difficulty approximately to interfaces that can't understand Word256. +difficultyToDouble :: HashDifficulty -> Double +difficultyToDouble (HashDifficulty phn) = powHashNatToDouble phn + encodeHashDifficulty :: HashDifficulty -> Put encodeHashDifficulty (HashDifficulty x) = encodePowHashNat x {-# INLINE encodeHashDifficulty #-} @@ -347,4 +361,3 @@ legacyAdjust (BlockDelay bd) (WindowWidth ww) (TimeSpan delta) (HashTarget oldTa newTarget :: HashTarget newTarget = HashTarget . PowHashNat $ maxTargetWord `div` ceiling newDiff - diff --git a/test/unit/Chainweb/Test/Pact5/TransactionTests.hs b/test/unit/Chainweb/Test/Pact5/TransactionTests.hs new file mode 100644 index 0000000000..9eb7b212a9 --- /dev/null +++ b/test/unit/Chainweb/Test/Pact5/TransactionTests.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Chainweb.Test.Pact5.TransactionTests (tests) where + +import Test.Tasty +import Test.Tasty.HUnit + +import Control.Lens hiding ((.=)) + +import Data.Foldable +import Data.Text (unpack) +import qualified Data.Map.Strict as Map + +-- internal pact modules + +import Pact.Core.Repl +import Pact.Core.Pretty +import Pact.Core.Environment +import Pact.Core.Errors +import Pact.Core.Info +import Pact.Core.Repl.Utils + +-- ---------------------------------------------------------------------- -- +-- Global settings + +coinReplV6 :: FilePath +coinReplV6 = "pact/pact5/coin-contract/coin.repl" + +nsReplV1 :: FilePath +nsReplV1 = "pact/pact5/namespaces/v1/ns.repl" + +nsReplV2 :: FilePath +nsReplV2 = "pact/pact5/namespaces/ns.repl" + +runReplTest :: FilePath -> Assertion +runReplTest file = do + (scriptout, rstate) <- execScript False file + case scriptout of + Left e -> failWithErr rstate e + Right _ -> do + traverse_ (ensurePassing rstate) (reverse (_replTestResults rstate)) + where + failWithErr rstate err = do + let (FileLocSpanInfo f _) = err ^. peInfo + case Map.lookup f (_replLoadedFiles rstate) of + Just src -> do + assertFailure $ unpack $ replError src err + Nothing -> do + assertFailure $ renderCompactString err + ensurePassing rstate (ReplTestResult _testName _loc res) = case res of + ReplTestPassed -> pure () + ReplTestFailed msg -> + failWithErr rstate (PEExecutionError (EvalError msg) [] _loc) + +tests :: TestTree +tests = testGroup "Chainweb.Test.Pact5.TransactionTests" + [ testCase "coin contract v6" $ runReplTest coinReplV6 + , testCase "namespace v1" $ runReplTest nsReplV1 + , testCase "namespace v2" $ runReplTest nsReplV2 + ] diff --git a/test/unit/ChainwebTests.hs b/test/unit/ChainwebTests.hs index f11aba2784..499d22be7d 100644 --- a/test/unit/ChainwebTests.hs +++ b/test/unit/ChainwebTests.hs @@ -79,6 +79,7 @@ import qualified Chainweb.Test.Pact5.PactServiceTest import qualified Chainweb.Test.Pact5.RemotePactTest import qualified Chainweb.Test.Pact5.SPVTest import qualified Chainweb.Test.Pact5.TransactionExecTest +import qualified Chainweb.Test.Pact5.TransactionTests import qualified Chainweb.Test.RestAPI (tests) import qualified Chainweb.Test.Roundtrips (tests) import qualified Chainweb.Test.SPV (tests) @@ -164,6 +165,7 @@ suite rdb = , Chainweb.Test.Pact5.SPVTest.tests rdb , Chainweb.Test.Pact5.RemotePactTest.tests rdb , Chainweb.Test.Pact5.HyperlanePluginTests.tests rdb + , Chainweb.Test.Pact5.TransactionTests.tests , Chainweb.Test.Roundtrips.tests , Chainweb.Test.RestAPI.tests rdb , testGroup "SPV"