From 035b43617a66e8a1e8fb9230fdf768a2d259918b Mon Sep 17 00:00:00 2001 From: zeme-iohk Date: Fri, 29 Jul 2022 15:06:31 +0200 Subject: [PATCH 01/10] Remove old references to hysterical-screams (#635) --- cabal.project | 5 ----- nix/pkgs/haskell/sha256map.nix | 1 - plutus-chain-index/app/Marconi.hs | 2 +- plutus-chain-index/app/Marconi/Index/Datum.hs | 4 ++-- plutus-chain-index/app/Marconi/Index/Utxo.hs | 4 ++-- plutus-chain-index/plutus-chain-index.cabal | 2 +- plutus-hysterical-screams/README.md | 2 -- 7 files changed, 6 insertions(+), 14 deletions(-) diff --git a/cabal.project b/cabal.project index 8ee9011e1b..ab7f51f25a 100644 --- a/cabal.project +++ b/cabal.project @@ -301,11 +301,6 @@ source-repository-package location: https://github.com/input-output-hk/Win32-network tag: 3825d3abf75f83f406c1f7161883c438dac7277d --- Temporary indexing -source-repository-package - type: git - location: https://github.com/raduom/hysterical-screams - tag: 4c523469e9efd3f0d10d17da3304923b7b0e0674 source-repository-package type: git diff --git a/nix/pkgs/haskell/sha256map.nix b/nix/pkgs/haskell/sha256map.nix index 661c32f788..1d2f00cc7d 100644 --- a/nix/pkgs/haskell/sha256map.nix +++ b/nix/pkgs/haskell/sha256map.nix @@ -16,6 +16,5 @@ "https://github.com/input-output-hk/servant-purescript"."44e7cacf109f84984cd99cd3faf185d161826963" = "10pb0yfp80jhb9ryn65a4rha2lxzsn2vlhcc6xphrrkf4x5lhzqc"; "https://github.com/input-output-hk/Win32-network"."3825d3abf75f83f406c1f7161883c438dac7277d" = "19wahfv726fa3mqajpqdqhnl9ica3xmf68i254q45iyjcpj1psqx"; "https://github.com/Quid2/flat"."ee59880f47ab835dbd73bea0847dab7869fc20d8" = "1lrzknw765pz2j97nvv9ip3l1mcpf2zr4n56hwlz0rk7wq7ls4cm"; - "https://github.com/raduom/hysterical-screams"."4c523469e9efd3f0d10d17da3304923b7b0e0674" = "0w118v4vffrsjxfmwfv8qcn2qxmxpd1gxwcjnda91qz09jnpg0vp"; "https://github.com/input-output-hk/quickcheck-dynamic"."c272906361471d684440f76c297e29ab760f6a1e" = "sha256-TioJQASNrQX6B3n2Cv43X2olyT67//CFQqcpvNW7N60="; } diff --git a/plutus-chain-index/app/Marconi.hs b/plutus-chain-index/app/Marconi.hs index f8a5593fc1..744496b6e0 100644 --- a/plutus-chain-index/app/Marconi.hs +++ b/plutus-chain-index/app/Marconi.hs @@ -28,7 +28,6 @@ import Data.Proxy (Proxy (Proxy)) import Data.Set (Set) import Data.Set qualified as Set import Data.String (IsString) -import Index.VSplit qualified as Ix import Ledger (TxIn (..), TxOut (..), TxOutRef (..)) import Ledger.Tx.CardanoAPI (fromCardanoTxId, fromCardanoTxIn, fromCardanoTxOut, fromTxScriptValidity, scriptDataFromCardanoTxBody) @@ -39,6 +38,7 @@ import Marconi.Index.Utxo qualified as Utxo import Marconi.Logging (logging) import Options.Applicative (Mod, OptionFields, Parser, auto, execParser, flag', help, helper, info, long, maybeReader, metavar, option, readerError, strOption, (<**>), (<|>)) +import Plutus.HystericalScreams.Index.VSplit qualified as Ix import Plutus.Streaming (ChainSyncEvent (RollBackward, RollForward), ChainSyncEventException (NoIntersectionFound), withChainSyncEventStream) import Plutus.V1.Ledger.Api (Datum, DatumHash) diff --git a/plutus-chain-index/app/Marconi/Index/Datum.hs b/plutus-chain-index/app/Marconi/Index/Datum.hs index b334517669..594925b7bc 100644 --- a/plutus-chain-index/app/Marconi/Index/Datum.hs +++ b/plutus-chain-index/app/Marconi/Index/Datum.hs @@ -26,8 +26,8 @@ import Database.SQLite.Simple.FromField (FromField (fromField), ResultError (Con import Database.SQLite.Simple.ToField (ToField (toField)) import Cardano.Api (SlotNo (SlotNo)) -import Index.VSqlite (SqliteIndex) -import Index.VSqlite qualified as Ix +import Plutus.HystericalScreams.Index.VSqlite (SqliteIndex) +import Plutus.HystericalScreams.Index.VSqlite qualified as Ix import Plutus.V1.Ledger.Api (Datum, DatumHash) type Event = [(SlotNo, (DatumHash, Datum))] diff --git a/plutus-chain-index/app/Marconi/Index/Utxo.hs b/plutus-chain-index/app/Marconi/Index/Utxo.hs index c93886237f..8931c63418 100644 --- a/plutus-chain-index/app/Marconi/Index/Utxo.hs +++ b/plutus-chain-index/app/Marconi/Index/Utxo.hs @@ -42,8 +42,8 @@ import Ledger (Address, TxId, TxOut, TxOutRef (TxOutRef, txOutRefId, txOutRefIdx import Ledger qualified as Ledger import System.Random.MWC (createSystemRandom, uniformR) -import Index.VSqlite (SqliteIndex) -import Index.VSqlite qualified as Ix +import Plutus.HystericalScreams.Index.VSqlite (SqliteIndex) +import Plutus.HystericalScreams.Index.VSqlite qualified as Ix data UtxoUpdate = UtxoUpdate { _inputs :: !(Set TxOutRef) diff --git a/plutus-chain-index/plutus-chain-index.cabal b/plutus-chain-index/plutus-chain-index.cabal index bd2c5b0d6b..fb6133b837 100644 --- a/plutus-chain-index/plutus-chain-index.cabal +++ b/plutus-chain-index/plutus-chain-index.cabal @@ -126,7 +126,7 @@ executable marconi -- Local components -------------------- build-depends: - , hysterical-screams + , plutus-hysterical-screams , plutus-ledger , plutus-streaming diff --git a/plutus-hysterical-screams/README.md b/plutus-hysterical-screams/README.md index b7930ce13c..559ed4b826 100644 --- a/plutus-hysterical-screams/README.md +++ b/plutus-hysterical-screams/README.md @@ -1,7 +1,5 @@ # historical-streams -[![Haskell-CI](https://github.com/raduom/hysterical-screams/actions/workflows/haskell-ci.yml/badge.svg)](https://github.com/raduom/hysterical-screams/actions/workflows/haskell-ci.yml) - # A study of algebraic specification. ## Define a simplified model. From 6e69848ba880dde65b1a106645451fa6463c8206 Mon Sep 17 00:00:00 2001 From: Szabo Gergely Date: Fri, 29 Jul 2022 17:23:50 +0200 Subject: [PATCH 02/10] ADR-0004 Common PAB API document (#586) Co-authored-by: Konstantinos Lambrou-Latreille --- doc/adr/0006-common-contract-api.rst | 83 ++++++++++++++++++++++++++++ doc/adr/index.rst | 1 + 2 files changed, 84 insertions(+) create mode 100644 doc/adr/0006-common-contract-api.rst diff --git a/doc/adr/0006-common-contract-api.rst b/doc/adr/0006-common-contract-api.rst new file mode 100644 index 0000000000..e704f11eaf --- /dev/null +++ b/doc/adr/0006-common-contract-api.rst @@ -0,0 +1,83 @@ +.. _common_pab_api: + +ADR 6: Common Contract API +========================== + +Date: 2022-07-12 + +Authors +------- + +Gergely Szabo + +koslambrou + +Status +------ + +Proposed + +Context +------- + +There are multiple implementations of a Plutus Application Backend (PAB) external of IO Global, and also other tools related to Plutus smart contracts. +Some of them are using the same contract interface as the official implementation, but some of them use a different interface. +However, as the ecosystem evolves, it would be beneficial to create a well defined standard, that other off-chain tools can use as a reference, or as an interface to implement. + +Currently, as we are getting close to the Vasil hardfork, testing tools and Plutus Application backend tools are at a hurry to update their dependencies and get to a Vasil compliant/compatible state. +However, tools that are depending on `plutus-apps` are blocked by the PAB development. +This initiative was born out of this context, but could solve other problems as well. + +The Contract API (defined in `plutus-apps/plutus-contract`) is using the `freer-simple` effect system to define all the contract effects. +This already allows us to separate the interface from the implementation, and to have multiple implementations/interpreters for one interface. +Currently, there are two implementations for the Contract API: + +* one for the plutus-apps emulator (inside `plutus-apps/plutus-contract`) +* one for plutus-apps' Plutus Application Backend (inside `plutus-apps/plutus-pab`) + +Therefore, we can leverage this separatation of interface and implementation in order to move the interface out of `plutus-apps`. + +Decision +-------- + +* We will split the `plutus-apps/plutus-contract` package into two parts: the Contract API (`plutus-contract`) and the emulator (`plutus-contract-emulator`). + +* We will create effects for the constraints-based transaction builder library (`plutus-apps/plutus-ledger-constraints`) in the Contract API. + Currently, the interface and the implementation in the transaction builder library are tightly coupled. + Therefore, we need to decouple them. + +* We will create a separate repository with the contract effects and types (the splitted `plutus-contract`). + By moving the Contract API out of the plutus-apps monorepository, any tool could update to newer version to their discretion. + Without many dependencies, many tools could utilize the Contract API without having to depend on the whole plutus-apps monorepo. + +* We (the Plutus Tools at IO Global) will continue to be the main maintainers of this new repository. + However, a new ADR will need to be created if we ever decide to make this a community driven project. + +* TODO: What about governance? How do we decide which interface changes are accepted? ADRs? Who ultimately accepts and rejects them? + +Argument +-------- + +We speed up the development of off-chain tools, by loosening up some of tightly coupled dependencies, so these external projects can move more freely. +This would also mean that the cost of the interface update would be reduced, so we could see more features added to the standard, and the PAB API following the capabilities of Cardano more closely. +As an added benefit, community involvement with the API could also greatly improve. + +A standard API for all Plutus contacts would help keeping the ecosystem on the same track with their implementation. +As more and more off-chain tools implement the same contract interface in the future, it will be relatively easy to switch between different Plutus Application Backend implementations, or to use multiple of these tools at the same time without a need for serious code rewrites. + +The implementation of the Contract API interface would track a specific version of the Contract API interface. +We would then need to regularly update the implementation given any interface changes. + +Implications +------------ + +* We will need to decide if we should make this a community driven project. + If so, we will also need to make a decision about governance. + How do we decide which interface changes are accepted? + Do we use ADRs? + Who ultimately accepts and rejects them? + +Notes +----- + +This ADR has been discussed here: `#586 `_. diff --git a/doc/adr/index.rst b/doc/adr/index.rst index 0bfd4fb84f..c51bdc8fdd 100644 --- a/doc/adr/index.rst +++ b/doc/adr/index.rst @@ -35,3 +35,4 @@ The general process for creating an ADR is: 0003-marconi-monorepo 0004-marconi-initiative 0005-pab-indexing-solution-integration + 0006-common-contract-api From d7423d3090d076056e9f0b09de04bf1b2c58e233 Mon Sep 17 00:00:00 2001 From: koslambrou Date: Tue, 2 Aug 2022 10:35:38 -0400 Subject: [PATCH 03/10] cardano-ledger validation rules are prioritized over our custom validation rules when validating transaction in the emulator (#639) --- plutus-contract/src/Wallet/Emulator/Chain.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plutus-contract/src/Wallet/Emulator/Chain.hs b/plutus-contract/src/Wallet/Emulator/Chain.hs index bcbe804ee4..f3621f981f 100644 --- a/plutus-contract/src/Wallet/Emulator/Chain.hs +++ b/plutus-contract/src/Wallet/Emulator/Chain.hs @@ -205,7 +205,7 @@ validateEm h cUtxoIndex txn = do let (e, events) = txn & mergeCardanoTxWith (\tx -> Index.runValidation (Index.validateTransaction h tx) ctx) (\tx -> validateL params h cUtxoIndex tx) - (\(e1, sve1) (e2, sve2) -> (e1 <|> e2, sve1 ++ sve2)) + (\(e1, sve1) (e2, sve2) -> (e2 <|> e1, sve2 ++ sve1)) idx' = case e of Just (Index.Phase1, _) -> idx Just (Index.Phase2, _) -> Index.insertCollateral txn idx From d098bfab2689cd3c85d864de235c1c0a648a1010 Mon Sep 17 00:00:00 2001 From: Sjoerd Visscher Date: Thu, 4 Aug 2022 00:23:19 +0200 Subject: [PATCH 04/10] PLT-80: Fix "Output doesn't have the minimum required Ada" error while balancing (#600) * Calculate minAda on the change output when balancing * Better coin selection algorithm * Add more explanation * Re-enable prop_Uniswap * Disabled prop_Uniswap again This reverts commit eceb8c39969f752aaa92818a8d92874187ea9daf. * PR feedback --- .../src/Wallet/Emulator/MultiAgent.hs | 10 +- plutus-contract/src/Wallet/Emulator/Wallet.hs | 223 +++++++++--------- .../src/Ledger/Constraints/OffChain.hs | 19 +- .../src/Ledger/Constraints/OnChain/V1.hs | 4 +- plutus-ledger/src/Ledger/Index.hs | 18 +- plutus-use-cases/test/Spec/renderGuess.txt | 8 +- 6 files changed, 148 insertions(+), 134 deletions(-) diff --git a/plutus-contract/src/Wallet/Emulator/MultiAgent.hs b/plutus-contract/src/Wallet/Emulator/MultiAgent.hs index 7ab9e01f1a..c0c095b3a5 100644 --- a/plutus-contract/src/Wallet/Emulator/MultiAgent.hs +++ b/plutus-contract/src/Wallet/Emulator/MultiAgent.hs @@ -38,6 +38,7 @@ import Ledger hiding (to, value) import Ledger.Ada qualified as Ada import Ledger.AddressMap qualified as AM import Ledger.Index qualified as Index +import Ledger.Value qualified as Value import Plutus.ChainIndex.Emulator qualified as ChainIndex import Plutus.Contract.Error (AssertionError (GenericAssertion)) import Plutus.Trace.Emulator.Types (ContractInstanceLog, EmulatedWalletEffects, EmulatedWalletEffects', UserThreadMsg) @@ -302,12 +303,13 @@ emulatorStateInitialDist mp = emulatorStatePool [EmulatorTx tx] where , txData = mempty } -- See [Creating wallets with multiple outputs] - mkOutputs (key, vl) = mkOutput key <$> splitHeadinto10 (Wallet.splitOffAdaOnlyValue vl) - splitHeadinto10 [] = [] - splitHeadinto10 (vl:vls) = replicate (fromIntegral count) (Ada.toValue . (`div` count) . Ada.fromValue $ vl) ++ vls + mkOutputs (key, vl) = mkOutput key <$> splitInto10 vl + splitInto10 vl = replicate (fromIntegral count) (Ada.toValue (ada `div` count)) ++ remainder where + ada = if Value.isAdaOnlyValue vl then Ada.fromValue vl else Ada.fromValue vl - minAdaTxOut -- Make sure we don't make the outputs too small - count = min 10 $ Ada.fromValue vl `div` minAdaTxOut + count = min 10 $ ada `div` minAdaTxOut + remainder = [ vl <> Ada.toValue (-ada) | not (Value.isAdaOnlyValue vl) ] mkOutput key vl = pubKeyHashTxOut vl (unPaymentPubKeyHash key) type MultiAgentEffs = diff --git a/plutus-contract/src/Wallet/Emulator/Wallet.hs b/plutus-contract/src/Wallet/Emulator/Wallet.hs index 62a289cac9..be4565b94e 100644 --- a/plutus-contract/src/Wallet/Emulator/Wallet.hs +++ b/plutus-contract/src/Wallet/Emulator/Wallet.hs @@ -16,6 +16,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -33,22 +34,23 @@ import Control.Monad.Freer.TH (makeEffect) import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), ToJSONKey) import Data.Aeson qualified as Aeson import Data.Bifunctor (bimap, first, second) -import Data.Data +import Data.Data (Data) import Data.Default (Default (def)) import Data.Foldable (Foldable (fold), find, foldl') +import Data.List (sortOn, (\\)) import Data.Map qualified as Map import Data.Maybe (catMaybes, fromMaybe, isNothing, listToMaybe) import Data.OpenApi.Schema qualified as OpenApi +import Data.Ord (Down (Down)) import Data.Set qualified as Set import Data.String (IsString (fromString)) import Data.Text qualified as T import Data.Text.Class (fromText, toText) import GHC.Generics (Generic) import Ledger (Address (addressCredential), CardanoTx, ChainIndexTxOut, Params (..), - PaymentPrivateKey (PaymentPrivateKey, unPaymentPrivateKey), - PaymentPubKey (PaymentPubKey, unPaymentPubKey), - PaymentPubKeyHash (PaymentPubKeyHash, unPaymentPubKeyHash), PrivateKey, PubKeyHash, SomeCardanoApiTx, - StakePubKey, Tx (txFee, txMint), TxIn (TxIn, txInRef), TxOutRef, UtxoIndex (..), Value) + PaymentPrivateKey (PaymentPrivateKey, unPaymentPrivateKey), PaymentPubKey, + PaymentPubKeyHash (PaymentPubKeyHash), PrivateKey, PubKeyHash, SomeCardanoApiTx, Tx (txFee, txMint), + TxIn (TxIn, txInRef), TxOut (..), TxOutRef, UtxoIndex (..), Value) import Ledger qualified import Ledger.Ada qualified as Ada import Ledger.CardanoWallet (MockWallet, WalletNumber) @@ -163,26 +165,25 @@ walletToMockWallet :: Wallet -> Maybe MockWallet walletToMockWallet (Wallet _ wid) = find ((==) wid . WalletId . Cardano.Wallet.WalletId . CW.mwWalletId) CW.knownMockWallets --- | The public key of a mock wallet. (Fails if the wallet is not a mock wallet). -mockWalletPaymentPubKey :: Wallet -> PaymentPubKey -mockWalletPaymentPubKey w = - CW.paymentPubKey - $ fromMaybe (error $ "Wallet.Emulator.Wallet.walletPubKey: Wallet " +-- | The same as @walletToMockWallet@ but fails with an error instead of returning @Nothing@. +walletToMockWallet' :: Wallet -> MockWallet +walletToMockWallet' w = + fromMaybe (error $ "Wallet.Emulator.Wallet.walletToMockWallet': Wallet " <> show w <> " is not a mock wallet") - $ walletToMockWallet w + $ walletToMockWallet w + +-- | The public key of a mock wallet. (Fails if the wallet is not a mock wallet). +mockWalletPaymentPubKey :: Wallet -> PaymentPubKey +mockWalletPaymentPubKey = CW.paymentPubKey . walletToMockWallet' -- | The payment public key hash of a mock wallet. (Fails if the wallet is not a mock wallet). mockWalletPaymentPubKeyHash :: Wallet -> PaymentPubKeyHash -mockWalletPaymentPubKeyHash = - PaymentPubKeyHash - . Ledger.pubKeyHash - . unPaymentPubKey - . mockWalletPaymentPubKey +mockWalletPaymentPubKeyHash = CW.paymentPubKeyHash . walletToMockWallet' -- | Get the address of a mock wallet. (Fails if the wallet is not a mock wallet). mockWalletAddress :: Wallet -> Address -mockWalletAddress w = Ledger.pubKeyHashAddress (mockWalletPaymentPubKeyHash w) Nothing +mockWalletAddress = CW.mockWalletAddress . walletToMockWallet' data WalletEvent = GenericLog T.Text @@ -221,11 +222,7 @@ ownPaymentPublicKey = CW.paymentPubKey . _mockWallet -- | Get the user's own payment public-key address. ownAddress :: WalletState -> Address -ownAddress = flip Ledger.pubKeyAddress Nothing - . PaymentPubKey - . Ledger.toPublicKey - . unPaymentPrivateKey - . ownPaymentPrivateKey +ownAddress = flip Ledger.pubKeyAddress Nothing . ownPaymentPublicKey -- | An empty wallet using the given private key. -- for that wallet as the sole watched address. @@ -340,8 +337,8 @@ handleBalance utx' = do cTx <- handleError (Right tx) $ fromPlutusTx params cUtxoIndex requiredSigners tx pure $ Tx.Both tx (Tx.CardanoApiEmulatorEraTx cTx) Left txBodyContent -> do - ownPaymentPubKey <- gets ownPaymentPublicKey - cTx <- handleError eitherTx $ makeAutoBalancedTransaction params cUtxoIndex txBodyContent (Ledger.pubKeyAddress ownPaymentPubKey Nothing) + ownAddr <- gets ownAddress + cTx <- handleError eitherTx $ makeAutoBalancedTransaction params cUtxoIndex txBodyContent ownAddr pure $ Tx.CardanoApiTx (Tx.CardanoApiEmulatorEraTx cTx) where handleError tx (Left (Left (ph, ve))) = do @@ -394,14 +391,14 @@ ownOutputs WalletState{_mockWallet} = do refs <- allUtxoSet (Just def) Map.fromList . catMaybes <$> traverse txOutRefTxOutFromRef refs where - cred :: Credential - cred = PubKeyCredential (unPaymentPubKeyHash $ CW.paymentPubKeyHash _mockWallet) + addr :: Address + addr = CW.mockWalletAddress _mockWallet -- Accumulate all unspent 'TxOutRef's from the resulting pages. allUtxoSet :: Maybe (PageQuery TxOutRef) -> Eff effs [TxOutRef] allUtxoSet Nothing = pure [] allUtxoSet (Just pq) = do - refPage <- page <$> ChainIndex.utxoSetAtAddress pq cred + refPage <- page <$> ChainIndex.utxoSetAtAddress pq (addressCredential addr) nextItems <- allUtxoSet (ChainIndex.nextPageQuery refPage) pure $ ChainIndex.pageItems refPage ++ nextItems @@ -434,11 +431,10 @@ handleBalanceTx :: -> UnbalancedTx -> Eff effs Tx handleBalanceTx utxo utx = do - Params { pProtocolParams } <- WAPI.getClientParams + params@Params { pProtocolParams } <- WAPI.getClientParams let filteredUnbalancedTxTx = removeEmptyOutputs (view U.tx utx) let txInputs = Set.toList $ Tx.txInputs filteredUnbalancedTxTx - ownPaymentPubKey <- gets ownPaymentPublicKey - let ownStakePubKey = Nothing + ownAddr <- gets ownAddress inputValues <- traverse lookupValue (Set.toList $ Tx.txInputs filteredUnbalancedTxTx) collateral <- traverse lookupValue (Set.toList $ Tx.txCollateral filteredUnbalancedTxTx) let fees = txFee filteredUnbalancedTxTx @@ -447,7 +443,13 @@ handleBalanceTx utxo utx = do collFees = Ada.toValue $ (Ada.fromValue fees * maybe 100 fromIntegral (protocolParamCollateralPercent pProtocolParams)) `Ada.divide` 100 remainingCollFees = collFees PlutusTx.- fold collateral balance = left PlutusTx.- right - (neg, pos) = adjustBalanceWithMissingLovelace $ Value.split balance + -- filter out inputs from utxo that are already in unBalancedTx + inputsOutRefs = map Tx.txInRef txInputs + filteredUtxo = flip Map.filterWithKey utxo $ \txOutRef _ -> + txOutRef `notElem` inputsOutRefs + outRefsWithValue = second (view Ledger.ciTxOutValue) <$> Map.toList filteredUtxo + + ((neg, newTxIns), (pos, newTxOuts)) <- calculateTxChanges params ownAddr outRefsWithValue $ Value.split balance tx' <- if Value.isZero pos then do @@ -455,7 +457,7 @@ handleBalanceTx utxo utx = do pure filteredUnbalancedTxTx else do logDebug $ AddingPublicKeyOutputFor pos - pure $ addOutput ownPaymentPubKey ownStakePubKey pos filteredUnbalancedTxTx + pure $ filteredUnbalancedTxTx & over Tx.outputs (++ newTxOuts) tx'' <- if Value.isZero neg then do @@ -463,11 +465,7 @@ handleBalanceTx utxo utx = do pure tx' else do logDebug $ AddingInputsFor neg - -- filter out inputs from utxo that are already in unBalancedTx - let inputsOutRefs = map Tx.txInRef txInputs - filteredUtxo = flip Map.filterWithKey utxo $ \txOutRef _ -> - txOutRef `notElem` inputsOutRefs - addInputs filteredUtxo ownPaymentPubKey ownStakePubKey neg tx' + pure $ tx' & over Tx.inputs (Set.union $ Set.fromList newTxIns) if remainingCollFees `Value.leq` PlutusTx.zero then do @@ -477,36 +475,45 @@ handleBalanceTx utxo utx = do logDebug $ AddingCollateralInputsFor remainingCollFees addCollateral utxo remainingCollFees tx'' --- | Adjust the left and right balance of an unbalanced 'Tx' with the missing --- lovelace considering the minimum lovelace per transaction output constraint --- from the Cardano blockchain. -adjustBalanceWithMissingLovelace - :: (Value, Value) -- ^ The unbalanced tx's left and right balance. - -> (Value, Value) -- ^ New left and right balance. -adjustBalanceWithMissingLovelace (neg, pos) = do - - -- We find the missing lovelace from the new positive balance. If - -- the positive balance is > 0 and < 'Ledger.minAdaTxOut', - -- then we adjust it to the minimum Ada. - let missingLovelaceFromPosValue = - if valueIsZeroOrHasMinAda pos - then 0 - else max 0 (Ledger.minAdaTxOut - Ada.fromValue pos) - -- We calculate the final negative and positive balances - newPos = pos <> Ada.toValue missingLovelaceFromPosValue - newNeg = neg <> Ada.toValue missingLovelaceFromPosValue - - (newNeg, newPos) - --- | Split value into an ada-only and an non-ada-only value, making sure each has at least minAdaTxOut. -splitOffAdaOnlyValue :: Value -> [Value] -splitOffAdaOnlyValue vl = if Value.isAdaOnlyValue vl || ada < Ledger.minAdaTxOut then [vl] else [Ada.toValue ada, vl <> Ada.toValue (-ada)] - where - ada = Ada.fromValue vl - Ledger.minAdaTxOut - -addOutput :: PaymentPubKey -> Maybe StakePubKey -> Value -> Tx -> Tx -addOutput pk sk vl tx = tx & over Tx.outputs (++ pkos) where - pkos = (\v -> Tx.pubKeyTxOut v pk sk) <$> splitOffAdaOnlyValue vl +calculateTxChanges + :: ( Member (Error WAPI.WalletAPIError) effs + ) + => Params + -> Address -- ^ The address for the change output + -> [(TxOutRef, Value)] -- ^ The current wallet's unspent transaction outputs. + -> (Value, Value) -- ^ The unbalanced tx's negative and positive balance. + -> Eff effs ((Value, [TxIn]), (Value, [TxOut])) +calculateTxChanges params addr utxos (neg, pos) = do + + -- Calculate the change output with minimal ada + (newNeg, newPos, extraTxOuts) <- if Value.isZero pos + then pure (neg, pos, []) + else do + (missing, extraTxOut) <- + either (throwError . WAPI.ToCardanoError) pure + $ U.adjustTxOut params (TxOut addr pos Nothing) + let missingValue = Ada.toValue (fold missing) + -- Add the missing ada to both sides to keep the balance. + pure (neg <> missingValue, pos <> missingValue, [extraTxOut]) + + -- Calculate the extra inputs needed + (spend, change) <- if Value.isZero newNeg + then pure ([], mempty) + else selectCoin utxos newNeg + + if Value.isZero change + then do + -- No change, so the new inputs and outputs have balanced the transaction + pure ((newNeg, Tx.pubKeyTxIn . fst <$> spend), (newPos, extraTxOuts)) + else if null extraTxOuts + -- We have change so we need an extra output, if we didn't have that yet, + -- first make one with an estimated minimal amount of ada + -- which then will calculate a more exact set of inputs + then calculateTxChanges params addr utxos (neg <> Ada.toValue Ledger.minAdaTxOut, Ada.toValue Ledger.minAdaTxOut) + -- Else recalculate with the change added to both sides + -- Ideally this creates the same inputs and outputs and then the change will be zero + -- But possibly the minimal Ada increases and then we also want to compute a new set of inputs + else calculateTxChanges params addr utxos (newNeg <> change, newPos <> change) addCollateral :: ( Member (Error WAPI.WalletAPIError) effs @@ -522,41 +529,15 @@ addCollateral mp vl tx = do in over Tx.collateralInputs (Set.union ins) pure $ tx & addTxCollateral --- | @addInputs mp pk vl tx@ selects transaction outputs worth at least --- @vl@ from the UTXO map @mp@ and adds them as inputs to @tx@. A public --- key output for @pk@ is added containing any leftover change. -addInputs - :: ( Member (Error WAPI.WalletAPIError) effs - ) - => Map.Map TxOutRef ChainIndexTxOut -- ^ The current wallet's unspent transaction outputs. - -> PaymentPubKey - -> Maybe StakePubKey - -> Value - -> Tx - -> Eff effs Tx -addInputs mp pk sk vl tx = do - (spend, change) <- selectCoin (second (view Ledger.ciTxOutValue) <$> Map.toList mp) vl - let - - addTxIns = - let ins = Set.fromList (Tx.pubKeyTxIn . fst <$> spend) - in over Tx.inputs (Set.union ins) - - addTxOut = - if Value.isZero change - then id - else addOutput pk sk change - - pure $ tx & addTxOut & addTxIns - -- | Given a set of @a@s with coin values, and a target value, select a number -- of @a@ such that their total value is greater than or equal to the target. selectCoin :: ( Member (Error WAPI.WalletAPIError) effs + , Eq a ) - => [(a, Value)] - -> Value - -> Eff effs ([(a, Value)], Value) + => [(a, Value)] -- ^ Possible inputs to choose from + -> Value -- ^ The target value + -> Eff effs ([(a, Value)], Value) -- ^ The chosen inputs and the change selectCoin fnds vl = let total = foldMap snd fnds @@ -572,25 +553,35 @@ selectCoin fnds vl = in if not (total `Value.geq` vl) then err else - let - -- Given the funds of a wallet, we take enough just enough such - -- that it's geq the target value, and if the resulting change - -- is not between 0 and the minimum Ada per tx output. - isTotalValueEnough totalVal = - vl `Value.leq` totalVal && valueIsZeroOrHasMinAda (totalVal PlutusTx.- vl) - fundsWithTotal = zip fnds (drop 1 $ scanl (<>) mempty $ fmap snd fnds) - fundsToSpend = takeUntil (isTotalValueEnough . snd) fundsWithTotal - totalSpent = maybe PlutusTx.zero snd $ listToMaybe $ reverse fundsToSpend - change = totalSpent PlutusTx.- vl - -- Make sure that the change is not less than the minimum amount - -- of lovelace per tx output. - in if valueIsZeroOrHasMinAda change - then pure (fst <$> fundsToSpend, change) - else throwError $ WAPI.ChangeHasLessThanNAda change Ledger.minAdaTxOut - --- | Check that a value is a proper TxOut value or is zero (i.e. the absence of a TxOut) -valueIsZeroOrHasMinAda :: Value -> Bool -valueIsZeroOrHasMinAda v = Value.isZero v || Ada.fromValue v >= Ledger.minAdaTxOut + -- Select inputs per asset class, sorting so we do Ada last. + -- We want to do the non-Ada asset classes first, because utxo's often contain + -- extra Ada because of fees or minAda constraints. So when we are done with the + -- non-Ada asset classes we probably already have picked some Ada too. + let (usedFinal, remainderFinal) = foldl' step ([], vl) (sortOn Down $ Value.flattenValue vl) + step (used, remainder) (cur, tok, _) = + let (used', remainder') = selectCoinSingle cur tok (fnds \\ used) remainder + in (used <> used', remainder') + in pure (usedFinal, PlutusTx.negate remainderFinal) + +selectCoinSingle + :: Value.CurrencySymbol + -> Value.TokenName + -> [(a, Value)] -- ^ Possible inputs to choose from + -> Value -- ^ The target value + -> ([(a, Value)], Value) -- ^ The chosen inputs and the remainder +selectCoinSingle cur tok fnds' vl = + let + -- We only want the values that contain the given asset class, + -- and want the single currency values first, + -- so that we're picking inputs that contain *only* the given asset class when possible. + fnds = sortOn (length . Value.symbols . snd) $ filter (\(_, v) -> Value.valueOf v cur tok > 0) fnds' + -- Given the funds of a wallet, we take enough just enough from + -- the target value such that the asset class value of the remainder is <= 0. + fundsWithRemainder = zip fnds (drop 1 $ scanl (PlutusTx.-) vl $ fmap snd fnds) + fundsToSpend = takeUntil (\(_, v) -> Value.valueOf v cur tok <= 0) fundsWithRemainder + remainder = maybe vl snd $ listToMaybe $ reverse fundsToSpend + in (fst <$> fundsToSpend, remainder) + -- | Removes transaction outputs with empty datum and empty value. removeEmptyOutputs :: Tx -> Tx diff --git a/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs b/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs index e2fb49c04c..d5d8a3d519 100644 --- a/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs +++ b/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs @@ -38,6 +38,7 @@ module Ledger.Constraints.OffChain( , validityTimeRange , emptyUnbalancedTx , adjustUnbalancedTx + , adjustTxOut , MkTxError(..) , mkTx , mkSomeTx @@ -420,13 +421,17 @@ mkTx lookups txc = mkSomeTx [SomeLookupsAndConstraints lookups txc] -- | Each transaction output should contain a minimum amount of Ada (this is a -- restriction on the real Cardano network). adjustUnbalancedTx :: Params -> UnbalancedTx -> Either Tx.ToCardanoError ([Ada.Ada], UnbalancedTx) -adjustUnbalancedTx params = alaf Compose (tx . Tx.outputs . traverse) adjustTxOut - where - adjustTxOut :: TxOut -> Either Tx.ToCardanoError ([Ada.Ada], TxOut) - adjustTxOut txOut = fromPlutusTxOutUnsafe params txOut <&> \txOut' -> - let minAdaTxOut' = evaluateMinLovelaceOutput params txOut' - missingLovelace = max 0 (minAdaTxOut' - Ada.fromValue (txOutValue txOut)) - in ([missingLovelace], txOut { txOutValue = txOutValue txOut <> Ada.toValue missingLovelace }) +adjustUnbalancedTx params = alaf Compose (tx . Tx.outputs . traverse) (adjustTxOut params) + +-- | Adjust a single transaction output so it contains at least the minimum amount of Ada +-- and return the adjustment (if any) and the updated TxOut. +adjustTxOut :: Params -> TxOut -> Either Tx.ToCardanoError ([Ada.Ada], TxOut) +adjustTxOut params txOut = fromPlutusTxOutUnsafe params txOut <&> \txOut' -> + let minAdaTxOut' = evaluateMinLovelaceOutput params txOut' + missingLovelace = minAdaTxOut' - Ada.fromValue (txOutValue txOut) + in if missingLovelace > 0 + then ([missingLovelace], txOut { txOutValue = txOutValue txOut <> Ada.toValue missingLovelace }) + else ([], txOut) -- | Add the remaining balance of the total value that the tx must spend. -- See note [Balance of value spent] diff --git a/plutus-ledger-constraints/src/Ledger/Constraints/OnChain/V1.hs b/plutus-ledger-constraints/src/Ledger/Constraints/OnChain/V1.hs index 47fe833344..4fdce7c40b 100644 --- a/plutus-ledger-constraints/src/Ledger/Constraints/OnChain/V1.hs +++ b/plutus-ledger-constraints/src/Ledger/Constraints/OnChain/V1.hs @@ -68,7 +68,7 @@ checkOwnOutputConstraint ctx@ScriptContext{scriptContextTxInfo} ScriptOutputCons let hsh = V.findDatumHash (Ledger.Datum $ toBuiltinData ocDatum) scriptContextTxInfo checkOutput TxOut{txOutValue, txOutDatumHash=Just svh} = Ada.fromValue txOutValue >= Ada.fromValue ocValue - && Ada.fromValue txOutValue <= Ada.fromValue ocValue + Ledger.minAdaTxOut + && Ada.fromValue txOutValue <= Ada.fromValue ocValue + Ledger.maxMinAdaTxOut && Value.noAdaValue txOutValue == Value.noAdaValue ocValue && hsh == Just svh checkOutput _ = False @@ -120,7 +120,7 @@ checkTxConstraint ctx@ScriptContext{scriptContextTxInfo} = \case addr = Address.scriptHashAddress vlh checkOutput TxOut{txOutAddress, txOutValue, txOutDatumHash=Just svh} = Ada.fromValue txOutValue >= Ada.fromValue vl - && Ada.fromValue txOutValue <= Ada.fromValue vl + Ledger.minAdaTxOut + && Ada.fromValue txOutValue <= Ada.fromValue vl + Ledger.maxMinAdaTxOut && Value.noAdaValue txOutValue == Value.noAdaValue vl && hsh == Just svh && txOutAddress == addr diff --git a/plutus-ledger/src/Ledger/Index.hs b/plutus-ledger/src/Ledger/Index.hs index 469faff258..d2f6cad223 100644 --- a/plutus-ledger/src/Ledger/Index.hs +++ b/plutus-ledger/src/Ledger/Index.hs @@ -34,6 +34,7 @@ module Ledger.Index( maxFee, minAdaTxOut, minLovelaceTxOut, + maxMinAdaTxOut, mkTxInfo, -- * Actual validation validateTransaction, @@ -324,7 +325,7 @@ checkPositiveValues t = else throwError $ NegativeValue t {-# INLINABLE minAdaTxOut #-} --- Minimum required Ada for each tx output. +-- An estimate of the minimum required Ada for each tx output. -- -- TODO: Should be removed. minAdaTxOut :: Ada @@ -334,6 +335,21 @@ minAdaTxOut = Ada.lovelaceOf minTxOut minTxOut :: Integer minTxOut = 2_000_000 +{-# INLINABLE maxMinAdaTxOut #-} +{- +maxMinAdaTxOut = maxTxOutSize * coinsPerUTxOWord +coinsPerUTxOWord = 34_482 +maxTxOutSize = utxoEntrySizeWithoutVal + maxValSizeInWords + dataHashSize +utxoEntrySizeWithoutVal = 27 +maxValSizeInWords = 500 +dataHashSize = 10 + +These values are partly protocol parameters-based, but since this is used in on-chain code +we want a constant to reduce code size. +-} +maxMinAdaTxOut :: Ada +maxMinAdaTxOut = Ada.lovelaceOf 18_516_834 + -- Minimum required Lovelace for each tx output. -- minLovelaceTxOut :: Lovelace diff --git a/plutus-use-cases/test/Spec/renderGuess.txt b/plutus-use-cases/test/Spec/renderGuess.txt index e8a8a9f5e9..aecd36fd3c 100644 --- a/plutus-use-cases/test/Spec/renderGuess.txt +++ b/plutus-use-cases/test/Spec/renderGuess.txt @@ -551,11 +551,11 @@ Balances Carried Forward: Ada: Lovelace: 100000000 ==== Slot #1, Tx #0 ==== -TxId: c24c24fa7914c2ca2ce5a1a44a9d24a677e6f816c938ae05d37e5f85d2ddf920 +TxId: 4c73ff6825fa5bbd6e05245d859ebc096eba9909eba5d3294a41284152c6b236 Fee: Ada: Lovelace: 184113 Mint: - Signatures PubKey: 8d9de88fbf445b7f6c3875a14daba94caee2ffcb... - Signature: 5840c9cacc039e6f96c16cceeaa26fdef77a4b5d... + Signature: 5840be792f4a550f69e2438dbb51f2607ecb7fce... Inputs: ---- Input 0 ---- Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) @@ -578,7 +578,7 @@ Inputs: Outputs: ---- Output 0 ---- - Destination: Script: e0cb974cfeddc5c4b5687862163a5fddbd47db908b4cedc5ca38dd98 + Destination: Script: dc5028161e8213a480e88184c842558c88071f359f8a4aa37b9e96dd Value: Ada: Lovelace: 8000000 @@ -629,6 +629,6 @@ Balances Carried Forward: Value: Ada: Lovelace: 100000000 - Script: e0cb974cfeddc5c4b5687862163a5fddbd47db908b4cedc5ca38dd98 + Script: dc5028161e8213a480e88184c842558c88071f359f8a4aa37b9e96dd Value: Ada: Lovelace: 8000000 \ No newline at end of file From 77ac3c7e148c74ecf65a79a2440fee842a4cff49 Mon Sep 17 00:00:00 2001 From: Wong Heung Sang <35202375+whs-dot-hk@users.noreply.github.com> Date: Fri, 5 Aug 2022 09:45:15 +0000 Subject: [PATCH 05/10] Fix static-site.nix formatting (#646) --- bitte/static-site.nix | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/bitte/static-site.nix b/bitte/static-site.nix index 78e6da4ba2..275c92c4cb 100644 --- a/bitte/static-site.nix +++ b/bitte/static-site.nix @@ -15,11 +15,11 @@ let ".jpg" => "image/jpeg", ".jpeg" => "image/jpeg", ".html" => "text/html", - ".js" => "text/javascript", - ".svg" => "image/svg+xml", + ".js" => "text/javascript", + ".svg" => "image/svg+xml", ) - deflate.cache-dir = "/tmp" - deflate.mimetypes = ("text/plain", "text/html", "text/css") + deflate.cache-dir = "/tmp" + deflate.mimetypes = ("text/plain", "text/html", "text/css") server.upload-dirs = ("/tmp") ''; in From 5d0da72d7d18e9cfa5235e8dc3801f73f0c24733 Mon Sep 17 00:00:00 2001 From: Sjoerd Visscher Date: Fri, 5 Aug 2022 13:10:52 +0200 Subject: [PATCH 06/10] Fix onchain MustPayToPubKeyAddress check (#648) --- .../src/Ledger/Constraints/OnChain/V1.hs | 7 +++---- plutus-use-cases/test/Spec/renderGuess.txt | 8 ++++---- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/plutus-ledger-constraints/src/Ledger/Constraints/OnChain/V1.hs b/plutus-ledger-constraints/src/Ledger/Constraints/OnChain/V1.hs index 4fdce7c40b..e53727c8b1 100644 --- a/plutus-ledger-constraints/src/Ledger/Constraints/OnChain/V1.hs +++ b/plutus-ledger-constraints/src/Ledger/Constraints/OnChain/V1.hs @@ -108,12 +108,11 @@ checkTxConstraint ctx@ScriptContext{scriptContextTxInfo} = \case MustPayToPubKeyAddress (PaymentPubKeyHash pk) _ mdv vl -> let outs = V.txInfoOutputs scriptContextTxInfo hsh dv = V.findDatumHash dv scriptContextTxInfo - checkOutput (Just dv) TxOut{txOutDatumHash=Just svh} = hsh dv == Just svh - -- return 'True' by default meaning we fail only when the provided datum is not found - checkOutput _ _ = True + checkOutput dv TxOut{txOutDatumHash=Just svh} = hsh dv == Just svh + checkOutput _ _ = False in traceIfFalse "La" -- "MustPayToPubKey" - $ vl `leq` V.valuePaidTo scriptContextTxInfo pk && any (checkOutput mdv) outs + $ vl `leq` V.valuePaidTo scriptContextTxInfo pk && maybe True (\dv -> any (checkOutput dv) outs) mdv MustPayToOtherScript vlh _ dv vl -> let outs = V.txInfoOutputs scriptContextTxInfo hsh = V.findDatumHash dv scriptContextTxInfo diff --git a/plutus-use-cases/test/Spec/renderGuess.txt b/plutus-use-cases/test/Spec/renderGuess.txt index aecd36fd3c..a908763f9e 100644 --- a/plutus-use-cases/test/Spec/renderGuess.txt +++ b/plutus-use-cases/test/Spec/renderGuess.txt @@ -551,11 +551,11 @@ Balances Carried Forward: Ada: Lovelace: 100000000 ==== Slot #1, Tx #0 ==== -TxId: 4c73ff6825fa5bbd6e05245d859ebc096eba9909eba5d3294a41284152c6b236 +TxId: 867a4615d971ee0adfe496a7a653f40ad6dfa5d5a952b66755dfd8b92d9273fc Fee: Ada: Lovelace: 184113 Mint: - Signatures PubKey: 8d9de88fbf445b7f6c3875a14daba94caee2ffcb... - Signature: 5840be792f4a550f69e2438dbb51f2607ecb7fce... + Signature: 584071c1d43465f291ea5f6b2d7283598288b2bf... Inputs: ---- Input 0 ---- Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) @@ -578,7 +578,7 @@ Inputs: Outputs: ---- Output 0 ---- - Destination: Script: dc5028161e8213a480e88184c842558c88071f359f8a4aa37b9e96dd + Destination: Script: 3c0db925789f9d6f4e84b8686cf444a4f76912e28a8524b3d61afa25 Value: Ada: Lovelace: 8000000 @@ -629,6 +629,6 @@ Balances Carried Forward: Value: Ada: Lovelace: 100000000 - Script: dc5028161e8213a480e88184c842558c88071f359f8a4aa37b9e96dd + Script: 3c0db925789f9d6f4e84b8686cf444a4f76912e28a8524b3d61afa25 Value: Ada: Lovelace: 8000000 \ No newline at end of file From 96c4508429b6142c3f06389a82b9c609d69a46a1 Mon Sep 17 00:00:00 2001 From: koslambrou Date: Fri, 5 Aug 2022 08:51:36 -0400 Subject: [PATCH 07/10] Made the functions `Ledger.Constraints.TxConstraints.collectFromPlutusV1ScriptFilter` and `Ledger.Constraints.TxConstraints.collectFromTheScript` as unrelated functions. (#644) The rationale is that if someone uses `collectFromPlutusV1ScriptFilter`, the constraints will fail with a `TypedValidatorMissing` error for lookups, even though we're not using typed validators. --- .../src/Ledger/Constraints/TxConstraints.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/plutus-ledger-constraints/src/Ledger/Constraints/TxConstraints.hs b/plutus-ledger-constraints/src/Ledger/Constraints/TxConstraints.hs index e870610935..c03d6c05c5 100644 --- a/plutus-ledger-constraints/src/Ledger/Constraints/TxConstraints.hs +++ b/plutus-ledger-constraints/src/Ledger/Constraints/TxConstraints.hs @@ -9,11 +9,12 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-} + {-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-} {-# OPTIONS_GHC -fno-specialise #-} {-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -{-# LANGUAGE TypeApplications #-} + -- | Constraints for transactions module Ledger.Constraints.TxConstraints where @@ -34,7 +35,7 @@ import PlutusTx.Prelude (Bool (False, True), Foldable (foldMap), Functor (fmap), import Ledger.Address (PaymentPubKeyHash, StakePubKeyHash) import Ledger.Address qualified as Address import Ledger.Tx (ChainIndexTxOut) -import Plutus.V1.Ledger.Api (Address, Datum (Datum), DatumHash, MintingPolicyHash, POSIXTimeRange, Redeemer (Redeemer), +import Plutus.V1.Ledger.Api (Address, Datum (Datum), DatumHash, MintingPolicyHash, POSIXTimeRange, Redeemer, StakeValidatorHash, TxOutRef, Validator, ValidatorHash) import Plutus.V1.Ledger.Interval qualified as I import Plutus.V1.Ledger.Scripts (unitRedeemer) @@ -600,9 +601,10 @@ collectFromPlutusV1ScriptFilter -> Validator -> Redeemer -> UntypedConstraints -collectFromPlutusV1ScriptFilter flt am vls (Redeemer red) = +collectFromPlutusV1ScriptFilter flt am vls red = let mp' = fromMaybe Haskell.mempty $ am ^. at (Address.scriptAddress vls) - in collectFromTheScriptFilter @PlutusTx.BuiltinData @PlutusTx.BuiltinData flt mp' red + ourUtxo = Map.filterWithKey flt mp' + in foldMap (flip mustSpendScriptOutput red) $ Map.keys ourUtxo -- | Given the pay to script address of the 'Validator', collect from it -- all the outputs that match a predicate, using the 'RedeemerValue'. From 0a35ed593b3c2e58ac362a5d3ece66924a2f082d Mon Sep 17 00:00:00 2001 From: James <74595920+james-iohk@users.noreply.github.com> Date: Mon, 8 Aug 2022 16:09:20 +0100 Subject: [PATCH 08/10] Add mustSpendAtLeast Constraint tests (#641) * Add mustSpendAtLeast Constraint tests * Change MustSpendAtLeast to use Datum and included phase-2 failure test * Spilt 'higherThanScriptBalance' test into two and introduced ownPaymentPubKeyHash script lookup (2 tests failing) * Comment out failing tests due to bug PLT-665 --- plutus-contract/plutus-contract.cabal | 1 + plutus-contract/test/Spec.hs | 4 +- plutus-contract/test/Spec/MustSpendAtLeast.hs | 149 ++++++++++++++++++ 3 files changed, 153 insertions(+), 1 deletion(-) create mode 100644 plutus-contract/test/Spec/MustSpendAtLeast.hs diff --git a/plutus-contract/plutus-contract.cabal b/plutus-contract/plutus-contract.cabal index 79894b05e2..4a0234747d 100644 --- a/plutus-contract/plutus-contract.cabal +++ b/plutus-contract/plutus-contract.cabal @@ -236,6 +236,7 @@ test-suite plutus-contract-test Spec.Contract Spec.Emulator Spec.ErrorChecking + Spec.MustSpendAtLeast Spec.Plutus.Contract.Oracle Spec.Plutus.Contract.Wallet Spec.Rows diff --git a/plutus-contract/test/Spec.hs b/plutus-contract/test/Spec.hs index 5982248f74..4d73a0e004 100644 --- a/plutus-contract/test/Spec.hs +++ b/plutus-contract/test/Spec.hs @@ -5,6 +5,7 @@ import Spec.Balancing qualified import Spec.Contract qualified import Spec.Emulator qualified import Spec.ErrorChecking qualified +import Spec.MustSpendAtLeast qualified import Spec.Plutus.Contract.Oracle qualified import Spec.Plutus.Contract.Wallet qualified import Spec.Rows qualified @@ -29,5 +30,6 @@ tests = testGroup "plutus-contract" [ Spec.ErrorChecking.tests, Spec.Plutus.Contract.Wallet.tests, Spec.Plutus.Contract.Oracle.tests, - Spec.Balancing.tests + Spec.Balancing.tests, + Spec.MustSpendAtLeast.tests ] diff --git a/plutus-contract/test/Spec/MustSpendAtLeast.hs b/plutus-contract/test/Spec/MustSpendAtLeast.hs new file mode 100644 index 0000000000..c6cd009fce --- /dev/null +++ b/plutus-contract/test/Spec/MustSpendAtLeast.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +module Spec.MustSpendAtLeast(tests) where + +import Control.Monad (void) +import Test.Tasty (TestTree, testGroup) + +import Ledger qualified +import Ledger.Ada qualified as Ada +import Ledger.Constraints.OffChain qualified as Constraints (ownPaymentPubKeyHash, plutusV1TypedValidatorLookups, + unspentOutputs) +import Ledger.Constraints.OnChain.V1 qualified as Constraints (checkScriptContext) +import Ledger.Constraints.TxConstraints qualified as Constraints (collectFromTheScript, mustIncludeDatum, + mustPayToTheScript, mustSpendAtLeast) +import Ledger.Tx qualified as Tx +import Ledger.Typed.Scripts qualified as Scripts +import Plutus.Contract as Con +import Plutus.Contract.Test (assertFailedTransaction, assertValidatedTransactionCount, checkPredicateOptions, + defaultCheckOptions, w1) +import Plutus.Trace qualified as Trace +import Plutus.V1.Ledger.Api (BuiltinByteString, Datum (Datum), ScriptContext, Validator, ValidatorHash) +import Plutus.V1.Ledger.Scripts (ScriptError (EvaluationError)) +import PlutusTx qualified +import PlutusTx.Prelude qualified as P +import Prelude hiding (not) + +tests :: TestTree +tests = + testGroup "MustSpendAtLeast" + [ entireScriptBalance + , lessThanScriptBalance + --, higherThanScriptBalanceWithoutWalletPubkeyLookup -- Failing due to PLT-665 + --, higherThanScriptBalanceWithWalletPubkeyLookup -- Failing due to PLT-665 + , phase2Failure + ] + +scriptBalance :: Integer +scriptBalance = 25_000_000 + +mustSpendAtLeastContract :: Integer -> Integer -> Ledger.PaymentPubKeyHash-> Contract () Empty ContractError () +mustSpendAtLeastContract offAmt onAmt pkh = do + let lookups1 = Constraints.plutusV1TypedValidatorLookups typedValidator + tx1 = Constraints.mustPayToTheScript onAmt (Ada.lovelaceValueOf scriptBalance) + ledgerTx1 <- submitTxConstraintsWith lookups1 tx1 + awaitTxConfirmed $ Tx.getCardanoTxId ledgerTx1 + + utxos <- utxosAt scrAddress + let lookups2 = Constraints.plutusV1TypedValidatorLookups typedValidator + <> Constraints.unspentOutputs utxos + <> Constraints.ownPaymentPubKeyHash pkh + tx2 = + Constraints.collectFromTheScript utxos () + <> Constraints.mustIncludeDatum (Datum $ PlutusTx.toBuiltinData onAmt) + <> Constraints.mustSpendAtLeast (Ada.lovelaceValueOf offAmt) + ledgerTx2 <- submitTxConstraintsWith @UnitTest lookups2 tx2 + awaitTxConfirmed $ Tx.getCardanoTxId ledgerTx2 + +trace :: Contract () Empty ContractError () -> Trace.EmulatorTrace () +trace contract = do + void $ Trace.activateContractWallet w1 contract + void $ Trace.waitNSlots 1 + +emptyPubKey :: Ledger.PaymentPubKeyHash +emptyPubKey = PlutusTx.unsafeFromBuiltinData $ PlutusTx.toBuiltinData ("" :: BuiltinByteString) + +entireScriptBalance :: TestTree +entireScriptBalance = + let contract = mustSpendAtLeastContract scriptBalance scriptBalance emptyPubKey + in checkPredicateOptions + defaultCheckOptions + "Successful use of mustSpendAtLeast at script's exact balance" + (assertValidatedTransactionCount 2) + (void $ trace contract) + +lessThanScriptBalance :: TestTree +lessThanScriptBalance = + let amt = scriptBalance - 1 + contract = mustSpendAtLeastContract amt amt emptyPubKey + in checkPredicateOptions + defaultCheckOptions + "Successful use of mustSpendAtLeast below script's balance" + (assertValidatedTransactionCount 2) + (void $ trace contract ) + +-- TODO: These two tests are failing due to PLT-665 +{- +higherThanScriptBalanceWithWalletPubkeyLookup :: TestTree +higherThanScriptBalanceWithWalletPubkeyLookup = + let amt = scriptBalance + 5_000_000 + contract = mustSpendAtLeastContract amt amt $ mockWalletPaymentPubKeyHash w1 + in checkPredicateOptions + defaultCheckOptions + "Validation pass when mustSpendAtLeast is greater than script's balance and wallet's pubkey is included in the lookup" + (assertValidatedTransactionCount 2) + (void $ trace contract) + +higherThanScriptBalanceWithoutWalletPubkeyLookup :: TestTree +higherThanScriptBalanceWithoutWalletPubkeyLookup = + let amt = scriptBalance + 5_000_000 + contract = mustSpendAtLeastContract amt amt $ mockWalletPaymentPubKeyHash w6 + in checkPredicateOptions + defaultCheckOptions + "Fail validation when mustSpendAtLeast is greater than script's balance and wallet's pubkey is not in the lookup" + (assertContractError contract (Trace.walletInstanceTag w1) (\case { ConstraintResolutionContractError Constraints.OwnPubKeyMissing -> True; _ -> False }) "failed to throw error" + .&&. assertValidatedTransactionCount 1) + (void $ trace contract) +-} + +phase2Failure :: TestTree +phase2Failure = + let offAmt = scriptBalance + onAmt = scriptBalance + 1 + contract = mustSpendAtLeastContract offAmt onAmt emptyPubKey + in checkPredicateOptions + defaultCheckOptions + "Fail phase-2 validation when on-chain mustSpendAtLeast is greater than script's balance" + (assertFailedTransaction (\_ err _ -> case err of {Ledger.ScriptFailure (EvaluationError ("L5":_) _) -> True; _ -> False })) + (void $ trace contract) + +{-# INLINEABLE mkValidator #-} +mkValidator :: Integer -> () -> ScriptContext -> Bool +mkValidator amt _ ctx = P.traceIfFalse "mustSpendAtLeast not satisfied" (Constraints.checkScriptContext @() @() (Constraints.mustSpendAtLeast P.$ Ada.lovelaceValueOf amt) ctx) + +data UnitTest +instance Scripts.ValidatorTypes UnitTest where + type instance DatumType UnitTest = Integer + type instance RedeemerType UnitTest = () + +typedValidator :: Scripts.TypedValidator UnitTest +typedValidator = Scripts.mkTypedValidator @UnitTest + $$(PlutusTx.compile [||mkValidator||]) + $$(PlutusTx.compile [|| wrap ||]) + where + wrap = Scripts.mkUntypedValidator + +validatorScript :: Validator +validatorScript = Scripts.validatorScript typedValidator + +valHash :: ValidatorHash +valHash = Scripts.validatorHash typedValidator + +scrAddress :: Ledger.Address +scrAddress = Ledger.scriptHashAddress valHash From 52b0a47ff5bd5b8aaedc09a8670d2e6773f808cd Mon Sep 17 00:00:00 2001 From: James <74595920+james-iohk@users.noreply.github.com> Date: Wed, 10 Aug 2022 11:25:40 +0100 Subject: [PATCH 09/10] Add plutus-contract tests for required signer and... (#624) ...moved some test specs into "TxConstraints directory. --- plutus-contract/plutus-contract.cabal | 7 +- plutus-contract/test/Spec.hs | 12 +- .../{ => TxConstraints}/MustSpendAtLeast.hs | 2 +- .../test/Spec/TxConstraints/RequiredSigner.hs | 157 ++++++++++++++++++ .../Spec/{ => TxConstraints}/TimeValidity.hs | 2 +- 5 files changed, 170 insertions(+), 10 deletions(-) rename plutus-contract/test/Spec/{ => TxConstraints}/MustSpendAtLeast.hs (99%) create mode 100644 plutus-contract/test/Spec/TxConstraints/RequiredSigner.hs rename plutus-contract/test/Spec/{ => TxConstraints}/TimeValidity.hs (98%) diff --git a/plutus-contract/plutus-contract.cabal b/plutus-contract/plutus-contract.cabal index 4a0234747d..4f14c09c19 100644 --- a/plutus-contract/plutus-contract.cabal +++ b/plutus-contract/plutus-contract.cabal @@ -236,14 +236,15 @@ test-suite plutus-contract-test Spec.Contract Spec.Emulator Spec.ErrorChecking - Spec.MustSpendAtLeast Spec.Plutus.Contract.Oracle Spec.Plutus.Contract.Wallet Spec.Rows Spec.Secrets Spec.State Spec.ThreadToken - Spec.TimeValidity + Spec.TxConstraints.MustSpendAtLeast + Spec.TxConstraints.RequiredSigner + Spec.TxConstraints.TimeValidity -------------------- -- Local components @@ -253,6 +254,7 @@ test-suite plutus-contract-test , plutus-chain-index-core , plutus-contract , plutus-ledger + , plutus-ledger-api , plutus-ledger-constraints , plutus-script-utils , plutus-tx-constraints @@ -263,7 +265,6 @@ test-suite plutus-contract-test build-depends: , cardano-api:{cardano-api, gen} , plutus-core - , plutus-ledger-api , plutus-tx if !(impl(ghcjs) || os(ghcjs)) diff --git a/plutus-contract/test/Spec.hs b/plutus-contract/test/Spec.hs index 4d73a0e004..ca73db2527 100644 --- a/plutus-contract/test/Spec.hs +++ b/plutus-contract/test/Spec.hs @@ -5,14 +5,15 @@ import Spec.Balancing qualified import Spec.Contract qualified import Spec.Emulator qualified import Spec.ErrorChecking qualified -import Spec.MustSpendAtLeast qualified import Spec.Plutus.Contract.Oracle qualified import Spec.Plutus.Contract.Wallet qualified import Spec.Rows qualified import Spec.Secrets qualified import Spec.State qualified import Spec.ThreadToken qualified -import Spec.TimeValidity qualified +import Spec.TxConstraints.MustSpendAtLeast qualified +import Spec.TxConstraints.RequiredSigner qualified +import Spec.TxConstraints.TimeValidity qualified import Test.Tasty (TestTree, defaultMain, testGroup) main :: IO () @@ -25,11 +26,12 @@ tests = testGroup "plutus-contract" [ Spec.State.tests, Spec.Rows.tests, Spec.ThreadToken.tests, - Spec.TimeValidity.tests, + Spec.TxConstraints.MustSpendAtLeast.tests, + Spec.TxConstraints.RequiredSigner.tests, + Spec.TxConstraints.TimeValidity.tests, Spec.Secrets.tests, Spec.ErrorChecking.tests, Spec.Plutus.Contract.Wallet.tests, Spec.Plutus.Contract.Oracle.tests, - Spec.Balancing.tests, - Spec.MustSpendAtLeast.tests + Spec.Balancing.tests ] diff --git a/plutus-contract/test/Spec/MustSpendAtLeast.hs b/plutus-contract/test/Spec/TxConstraints/MustSpendAtLeast.hs similarity index 99% rename from plutus-contract/test/Spec/MustSpendAtLeast.hs rename to plutus-contract/test/Spec/TxConstraints/MustSpendAtLeast.hs index c6cd009fce..61f946872e 100644 --- a/plutus-contract/test/Spec/MustSpendAtLeast.hs +++ b/plutus-contract/test/Spec/TxConstraints/MustSpendAtLeast.hs @@ -6,7 +6,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -module Spec.MustSpendAtLeast(tests) where +module Spec.TxConstraints.MustSpendAtLeast(tests) where import Control.Monad (void) import Test.Tasty (TestTree, testGroup) diff --git a/plutus-contract/test/Spec/TxConstraints/RequiredSigner.hs b/plutus-contract/test/Spec/TxConstraints/RequiredSigner.hs new file mode 100644 index 0000000000..40fd390628 --- /dev/null +++ b/plutus-contract/test/Spec/TxConstraints/RequiredSigner.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +module Spec.TxConstraints.RequiredSigner(tests) where + +import Control.Monad (void) +import Data.Void (Void) +import Test.Tasty (TestTree, testGroup) + +import Data.List (isInfixOf) +import Data.Maybe (fromJust) +import Data.String (fromString) +import Ledger qualified +import Ledger.Ada qualified as Ada +import Ledger.CardanoWallet as CW +import Ledger.Constraints.OffChain qualified as Constraints (paymentPubKey, plutusV1TypedValidatorLookups, + unspentOutputs) +import Ledger.Constraints.OnChain.V1 qualified as Constraints +import Ledger.Constraints.TxConstraints qualified as Constraints (collectFromTheScript, mustBeSignedBy, + mustIncludeDatum, mustPayToTheScript, + requiredSignatories) +import Ledger.Tx qualified as Tx +import Ledger.Typed.Scripts qualified as Scripts +import Plutus.Contract as Con +import Plutus.Contract.Test (assertFailedTransaction, assertValidatedTransactionCount, checkPredicateOptions, + defaultCheckOptions, mockWalletPaymentPubKey, mockWalletPaymentPubKeyHash, w1, w2) +import Plutus.Trace qualified as Trace +import Plutus.V1.Ledger.Scripts (ScriptError (EvaluationError), unitDatum) +import PlutusTx qualified +import Prelude +import Wallet.Emulator.Wallet (signPrivateKeys, walletToMockWallet) + +tests :: TestTree +tests = + testGroup "required signer" + [ + ownWallet + , otherWallet + , otherWalletNoSigningProcess + , withoutOffChainMustBeSignedBy + , phase2FailureMustBeSignedBy + ] + +mustBeSignedByContract :: Ledger.PaymentPubKey -> Ledger.PaymentPubKeyHash -> Contract () Empty ContractError () +mustBeSignedByContract pk pkh = do + let lookups1 = Constraints.plutusV1TypedValidatorLookups mustBeSignedByTypedValidator + tx1 = Constraints.mustPayToTheScript () (Ada.lovelaceValueOf 25_000_000) + ledgerTx1 <- submitTxConstraintsWith lookups1 tx1 + awaitTxConfirmed $ Tx.getCardanoTxId ledgerTx1 + + utxos <- utxosAt (Ledger.scriptHashAddress $ Scripts.validatorHash mustBeSignedByTypedValidator) + let lookups2 = + Constraints.plutusV1TypedValidatorLookups mustBeSignedByTypedValidator + <> Constraints.unspentOutputs utxos + <> Constraints.paymentPubKey pk + tx2 = + Constraints.collectFromTheScript utxos pkh + <> Constraints.mustIncludeDatum unitDatum + <> Constraints.mustBeSignedBy pkh + logInfo @String $ "Required Signatories: " ++ show (Constraints.requiredSignatories tx2) + ledgerTx2 <- submitTxConstraintsWith @UnitTest lookups2 tx2 + awaitTxConfirmed $ Tx.getCardanoTxId ledgerTx2 + +withoutOffChainMustBeSignedByContract :: Ledger.PaymentPubKey -> Ledger.PaymentPubKeyHash -> Contract () Empty ContractError () +withoutOffChainMustBeSignedByContract pk pkh = do + let lookups1 = Constraints.plutusV1TypedValidatorLookups mustBeSignedByTypedValidator + tx1 = Constraints.mustPayToTheScript () (Ada.lovelaceValueOf 25_000_000) + ledgerTx1 <- submitTxConstraintsWith lookups1 tx1 + awaitTxConfirmed $ Tx.getCardanoTxId ledgerTx1 + + utxos <- utxosAt (Ledger.scriptHashAddress $ Scripts.validatorHash mustBeSignedByTypedValidator) + let lookups2 = + Constraints.plutusV1TypedValidatorLookups mustBeSignedByTypedValidator + <> Constraints.unspentOutputs utxos + <> Constraints.paymentPubKey pk + tx2 = + Constraints.collectFromTheScript utxos pkh + <> Constraints.mustIncludeDatum unitDatum + logInfo @String $ "Required Signatories: " ++ show (Constraints.requiredSignatories tx2) + ledgerTx2 <- submitTxConstraintsWith @UnitTest lookups2 tx2 + awaitTxConfirmed $ Tx.getCardanoTxId ledgerTx2 + +ownWallet :: TestTree +ownWallet = + let pk = mockWalletPaymentPubKey w1 + pkh = mockWalletPaymentPubKeyHash w1 + trace = do + void $ Trace.activateContractWallet w1 $ mustBeSignedByContract pk pkh + void $ Trace.waitNSlots 1 + in checkPredicateOptions defaultCheckOptions "own wallet's signature passes on-chain mustBeSignedBy validation" (assertValidatedTransactionCount 2) (void trace) + +otherWallet :: TestTree -- must use Trace.setSigningProcess for w2 +otherWallet = + let pk = mockWalletPaymentPubKey w2 + pkh = mockWalletPaymentPubKeyHash w2 + trace = do + Trace.setSigningProcess w1 (Just $ signPrivateKeys [paymentPrivateKey $ fromJust $ walletToMockWallet w1, paymentPrivateKey $ fromJust $ walletToMockWallet w2]) + void $ Trace.activateContractWallet w1 $ mustBeSignedByContract pk pkh + void $ Trace.waitNSlots 1 + in checkPredicateOptions defaultCheckOptions "other wallet's signature passes on-chain mustBeSignedBy validation" (assertValidatedTransactionCount 2) (void trace) + +otherWalletNoSigningProcess :: TestTree +otherWalletNoSigningProcess = + let pk = mockWalletPaymentPubKey w2 + pkh = mockWalletPaymentPubKeyHash w2 + trace = do + void $ Trace.activateContractWallet w1 $ mustBeSignedByContract pk pkh + void $ Trace.waitNSlots 1 + in checkPredicateOptions defaultCheckOptions "without Trace.setSigningProcess fails phase-1 validation" + (assertFailedTransaction (\_ err _ -> case err of {Ledger.CardanoLedgerValidationError str -> isInfixOf "MissingRequiredSigners" str; _ -> False })) + (void trace) + +withoutOffChainMustBeSignedBy :: TestTree -- there's no "required signer" in the txbody logs but still passes phase-2 so it must be there. Raised https://github.com/input-output-hk/plutus-apps/issues/645. It'd be good to check log output for expected required signer pubkey in these tests. +withoutOffChainMustBeSignedBy = + let pk = mockWalletPaymentPubKey w1 + pkh = mockWalletPaymentPubKeyHash w1 + trace = do + void $ Trace.activateContractWallet w1 $ withoutOffChainMustBeSignedByContract pk pkh + void $ Trace.waitNSlots 1 + in checkPredicateOptions defaultCheckOptions "without mustBeSignedBy off-chain constraint passes mustBeSignedBy on-chain validation because required signer is still included in txbody" + (assertValidatedTransactionCount 2) + (void trace) + +phase2FailureMustBeSignedBy :: TestTree +phase2FailureMustBeSignedBy = + let pk = mockWalletPaymentPubKey w1 + pkh = Ledger.PaymentPubKeyHash $ fromString "76aaef06f38cc98ed08ceb168ddb55bab2ea5df43a6847a99f086fc9" :: Ledger.PaymentPubKeyHash + trace = do + void $ Trace.activateContractWallet w1 $ withoutOffChainMustBeSignedByContract pk pkh + void $ Trace.waitNSlots 1 + in checkPredicateOptions defaultCheckOptions "with wrong pubkey fails on-chain mustBeSignedBy constraint validation" + (assertFailedTransaction (\_ err _ -> case err of {Ledger.ScriptFailure (EvaluationError ("L4":_) _) -> True; _ -> False })) + (void trace) + +{- + validator using mustBeSignedBy constraint +-} + +data UnitTest +instance Scripts.ValidatorTypes UnitTest where + type instance DatumType UnitTest = () + type instance RedeemerType UnitTest = Ledger.PaymentPubKeyHash + +{-# INLINEABLE mustBeSignedByValidator #-} +mustBeSignedByValidator :: () -> Ledger.PaymentPubKeyHash -> Ledger.ScriptContext -> Bool +mustBeSignedByValidator _ pkh ctx = Constraints.checkScriptContext @Void @Void (Constraints.mustBeSignedBy pkh) ctx + +mustBeSignedByTypedValidator :: Scripts.TypedValidator UnitTest +mustBeSignedByTypedValidator = Scripts.mkTypedValidator @UnitTest + $$(PlutusTx.compile [||mustBeSignedByValidator||]) + $$(PlutusTx.compile [|| wrap ||]) + where + wrap = Scripts.mkUntypedValidator diff --git a/plutus-contract/test/Spec/TimeValidity.hs b/plutus-contract/test/Spec/TxConstraints/TimeValidity.hs similarity index 98% rename from plutus-contract/test/Spec/TimeValidity.hs rename to plutus-contract/test/Spec/TxConstraints/TimeValidity.hs index d68bf3e545..629e3fbf42 100644 --- a/plutus-contract/test/Spec/TimeValidity.hs +++ b/plutus-contract/test/Spec/TxConstraints/TimeValidity.hs @@ -4,7 +4,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -module Spec.TimeValidity(tests) where +module Spec.TxConstraints.TimeValidity(tests) where import Cardano.Api.Shelley (protocolParamProtocolVersion) import Control.Lens hiding (contains, from, (.>)) From dc37b7d0df35c29bffcdf8bc77bb342ee67ef0fd Mon Sep 17 00:00:00 2001 From: koslambrou Date: Thu, 11 Aug 2022 10:09:13 -0400 Subject: [PATCH 10/10] PLT-682 ADR for the constraint interface change in order to support reference inputs (#654) --- ...reference-inputs-in-constraint-library.rst | 47 +++++++++++++++++++ doc/adr/index.rst | 1 + 2 files changed, 48 insertions(+) create mode 100644 doc/adr/0007-support-reference-inputs-in-constraint-library.rst diff --git a/doc/adr/0007-support-reference-inputs-in-constraint-library.rst b/doc/adr/0007-support-reference-inputs-in-constraint-library.rst new file mode 100644 index 0000000000..d066dfa47f --- /dev/null +++ b/doc/adr/0007-support-reference-inputs-in-constraint-library.rst @@ -0,0 +1,47 @@ +.. _support_reference_inputs_in_constraint_library: + +ADR 7: Support reference inputs in constraint library +===================================================== + +Date: 2022-08-09 + +Authors +------- + +koslambrou + +Status +------ + +Proposed + +Context +------- + +After the Vasil HF, the Cardano blockchain will support `reference` inputs by adding a new field in the transaction data type. +With reference inputs, transactions can take a look at UTXOs without actually spending them. + +Thus, we need to adapt our transaction constraint data type (`TxConstraints`) to support referencing UTXOs. + +Decision +-------- + +* We will add the data constuctor `MustReferenceOutput TxOutRef` to the `TxConstraints` data type. + +* The PlutusV1 on-chain implementation of this new constraint will simply return `False`. + However, `cardano-ledger` throws a phase-1 validation error if transactions that use the some of the new features (reference inputs, inline datums and reference scripts) try to execute PlutusV1 scripts. + See the `Babbage era ledger specification `_. + Therefore, the only way to get a phase-2 validation error would be to use this constraint on-chain in a PlutusV1 script, without using any of the new Babbage era features off-chain. + +* The PlutusV2 on-chain implementation of this new constraint will check that the provided `TxOutRef` is part of the `ScriptContext`'s reference inputs. + +Argument +-------- + +At first glance, we might think that we need two data constructors for reference inputs such as `MustReferencePubKeyOutput` and `MustReferenceScriptOutput` in contrast to the existing `MustSpendPubKeyOutput` and `MustSpendScriptOutput` constraints. +However, we do not need to make the distinction between public key outputs and script outputs because we're not spending the output, therefore, we don't need to provide a redeemer nor the actual script as a witness to the transaction input. + +Notes +----- + +This ADR has been partially addressed on PR `#640 `_. diff --git a/doc/adr/index.rst b/doc/adr/index.rst index c51bdc8fdd..5b7a3a138a 100644 --- a/doc/adr/index.rst +++ b/doc/adr/index.rst @@ -36,3 +36,4 @@ The general process for creating an ADR is: 0004-marconi-initiative 0005-pab-indexing-solution-integration 0006-common-contract-api + 0007-support-reference-inputs-in-constraint-library