This repository has been archived by the owner on Dec 2, 2024. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 213
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Minting doesn't need special treatment after all (#267)
* Minting doesn't need special treatment after all * Separate out balancing tests
- Loading branch information
1 parent
3ef1be7
commit 51da951
Showing
8 changed files
with
170 additions
and
125 deletions.
There are no files selected for viewing
1 change: 1 addition & 0 deletions
1
nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-contract.nix
Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.
Oops, something went wrong.
1 change: 1 addition & 0 deletions
1
nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-contract.nix
Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.
Oops, something went wrong.
1 change: 1 addition & 0 deletions
1
nix/pkgs/haskell/materialized-windows/.plan.nix/plutus-contract.nix
Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,143 @@ | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE OverloadedStrings #-} | ||
| {-# LANGUAGE ScopedTypeVariables #-} | ||
| {-# LANGUAGE TemplateHaskell #-} | ||
| {-# LANGUAGE TypeApplications #-} | ||
| module Spec.Balancing(tests) where | ||
|
|
||
| import Control.Lens hiding ((.>)) | ||
| import Control.Monad (void) | ||
| import Data.Map qualified as Map | ||
| import Data.Void (Void) | ||
| import Test.Tasty (TestTree, testGroup) | ||
|
|
||
| import Ledger (Address, Validator, validatorHash) | ||
| import Ledger qualified | ||
| import Ledger.Ada qualified as Ada | ||
| import Ledger.Constraints qualified as Constraints | ||
| import Ledger.Scripts (mintingPolicyHash, unitDatum, unitRedeemer) | ||
| import Ledger.Typed.Scripts.MonetaryPolicies qualified as MPS | ||
| import Ledger.Value qualified as Value | ||
| import Plutus.Contract as Con | ||
| import Plutus.Contract.Test (assertAccumState, assertNoFailedTransactions, changeInitialWalletValue, checkPredicate, | ||
| checkPredicateOptions, defaultCheckOptions, w1, w2) | ||
| import Plutus.Trace qualified as Trace | ||
| import Plutus.V1.Ledger.Scripts (Datum (Datum)) | ||
| import PlutusTx qualified | ||
| import Prelude hiding (not) | ||
| import Wallet.Emulator qualified as EM | ||
|
|
||
| tests :: TestTree | ||
| tests = | ||
| testGroup "balancing" | ||
| [ balanceTxnMinAda | ||
| , balanceTxnMinAda2 | ||
| , balanceTxnNoExtraOutput | ||
| ] | ||
|
|
||
| balanceTxnMinAda :: TestTree | ||
| balanceTxnMinAda = | ||
| let ee = Value.singleton "ee" "ee" 1 | ||
| ff = Value.singleton "ff" "ff" 1 | ||
| options = defaultCheckOptions | ||
| & changeInitialWalletValue w1 (Value.scale 1000 (ee <> ff) <>) | ||
| vHash = validatorHash someValidator | ||
|
|
||
| contract :: Contract () EmptySchema ContractError () | ||
| contract = do | ||
| let constraints1 = Constraints.mustPayToOtherScript vHash unitDatum (Value.scale 100 ff <> Ada.toValue Ledger.minAdaTxOut) | ||
| utx1 = either (error . show) id $ Constraints.mkTx @Void mempty constraints1 | ||
| submitTxConfirmed utx1 | ||
| utxo <- utxosAt someAddress | ||
| let txOutRef = head (Map.keys utxo) | ||
| constraints2 = Constraints.mustSpendScriptOutput txOutRef unitRedeemer | ||
| <> Constraints.mustPayToOtherScript vHash unitDatum (Value.scale 200 ee) | ||
| lookups2 = Constraints.unspentOutputs utxo <> Constraints.otherScript someValidator | ||
| utx2 = Constraints.adjustUnbalancedTx $ either (error . show) id $ Constraints.mkTx @Void lookups2 constraints2 | ||
| submitTxConfirmed utx2 | ||
|
|
||
| trace = do | ||
| void $ Trace.activateContractWallet w1 contract | ||
| void $ Trace.waitNSlots 2 | ||
|
|
||
| in checkPredicateOptions options "balancing doesn't create outputs with no Ada" assertNoFailedTransactions (void trace) | ||
|
|
||
| balanceTxnMinAda2 :: TestTree | ||
| balanceTxnMinAda2 = | ||
| let vA n = Value.singleton "ee" "A" n | ||
| vB n = Value.singleton "ff" "B" n | ||
| mps = MPS.mkForwardingMintingPolicy vHash | ||
| vL n = Value.singleton (Value.mpsSymbol $ mintingPolicyHash mps) "L" n | ||
| options = defaultCheckOptions | ||
| & changeInitialWalletValue w1 (<> vA 1 <> vB 2) | ||
| vHash = validatorHash someValidator | ||
| payToWallet w = Constraints.mustPayToPubKey (EM.mockWalletPaymentPubKeyHash w) | ||
| mkTx lookups constraints = Constraints.adjustUnbalancedTx . either (error . show) id $ Constraints.mkTx @Void lookups constraints | ||
|
|
||
| setupContract :: Contract () EmptySchema ContractError () | ||
| setupContract = do | ||
| -- Make sure there is a utxo with 1 A, 1 B, and 4 ada at w2 | ||
| submitTxConfirmed $ mkTx mempty (payToWallet w2 (vA 1 <> vB 1 <> Value.scale 2 (Ada.toValue Ledger.minAdaTxOut))) | ||
| -- Make sure there is a UTxO with 1 B and datum () at the script | ||
| submitTxConfirmed $ mkTx mempty (Constraints.mustPayToOtherScript vHash unitDatum (vB 1)) | ||
| -- utxo0 @ wallet2 = 1 A, 1 B, 4 Ada | ||
| -- utxo1 @ script = 1 B, 2 Ada | ||
|
|
||
| wallet2Contract :: Contract () EmptySchema ContractError () | ||
| wallet2Contract = do | ||
| utxos <- utxosAt someAddress | ||
| let txOutRef = head (Map.keys utxos) | ||
| lookups = Constraints.unspentOutputs utxos | ||
| <> Constraints.otherScript someValidator | ||
| <> Constraints.mintingPolicy mps | ||
| constraints = Constraints.mustSpendScriptOutput txOutRef unitRedeemer -- spend utxo1 | ||
| <> Constraints.mustPayToOtherScript vHash unitDatum (vB 1) -- 2 ada and 1 B to script | ||
| <> Constraints.mustPayToOtherScript vHash (Datum $ PlutusTx.toBuiltinData (0 :: Integer)) (vB 1) -- 2 ada and 1 B to script (different datum) | ||
| <> Constraints.mustMintValue (vL 1) -- 1 L and 2 ada to wallet2 | ||
| submitTxConfirmed $ mkTx lookups constraints | ||
|
|
||
| trace = do | ||
| void $ Trace.activateContractWallet w1 setupContract | ||
| void $ Trace.waitNSlots 10 | ||
| void $ Trace.activateContractWallet w2 wallet2Contract | ||
| void $ Trace.waitNSlots 10 | ||
|
|
||
| in checkPredicateOptions options "balancing doesn't create outputs with no Ada (2)" assertNoFailedTransactions (void trace) | ||
|
|
||
| balanceTxnNoExtraOutput :: TestTree | ||
| balanceTxnNoExtraOutput = | ||
| let vL n = Value.singleton (Ledger.scriptCurrencySymbol coinMintingPolicy) "coinToken" n | ||
| mkTx lookups constraints = either (error . show) id $ Constraints.mkTx @Void lookups constraints | ||
|
|
||
| mintingOperation :: Contract [Int] EmptySchema ContractError () | ||
| mintingOperation = do | ||
| pkh <- Con.ownPaymentPubKeyHash | ||
|
|
||
| let val = vL 200 | ||
| lookups = Constraints.mintingPolicy coinMintingPolicy | ||
| constraints = Constraints.mustMintValue val | ||
| <> Constraints.mustPayToPubKey pkh (val <> Ada.toValue Ledger.minAdaTxOut) | ||
|
|
||
| tx <- submitUnbalancedTx $ mkTx lookups constraints | ||
| tell [length $ Ledger.getCardanoTxOutRefs tx] | ||
|
|
||
| trace = do | ||
| void $ Trace.activateContract w1 mintingOperation "instance 1" | ||
| void $ Trace.waitNSlots 2 | ||
| tracePred = assertAccumState mintingOperation "instance 1" (== [2]) "has 2 outputs" | ||
|
|
||
| in checkPredicate "balancing doesn't create extra output" tracePred (void trace) | ||
|
|
||
| someAddress :: Address | ||
| someAddress = Ledger.scriptAddress someValidator | ||
|
|
||
| someValidator :: Validator | ||
| someValidator = Ledger.mkValidatorScript $$(PlutusTx.compile [|| \(_ :: PlutusTx.BuiltinData) (_ :: PlutusTx.BuiltinData) (_ :: PlutusTx.BuiltinData) -> () ||]) | ||
|
|
||
| {-# INLINABLE mkPolicy #-} | ||
| mkPolicy :: () -> Ledger.ScriptContext -> Bool | ||
| mkPolicy _ _ = True | ||
|
|
||
| coinMintingPolicy :: Ledger.MintingPolicy | ||
| coinMintingPolicy = Ledger.mkMintingPolicyScript | ||
| $$(PlutusTx.compile [|| MPS.wrapMintingPolicy mkPolicy ||]) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters