From 78329d8bf49929cb1ff22bce523e7a5d35d1bb1f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Sat, 25 Jan 2025 09:34:22 +0100 Subject: [PATCH] Add override to submit failing tx to network --- src/lib/Wst/Offchain/BuildTx/Failing.hs | 97 +++++++++++++++++++ src/lib/Wst/Offchain/BuildTx/TransferLogic.hs | 24 ++--- src/lib/Wst/Offchain/Endpoints/Deployment.hs | 12 ++- src/lib/Wst/Server.hs | 7 +- src/lib/Wst/Server/Types.hs | 1 + src/test/unit/Wst/Test/UnitTest.hs | 16 +-- src/wst-poc.cabal | 4 + 7 files changed, 134 insertions(+), 27 deletions(-) create mode 100644 src/lib/Wst/Offchain/BuildTx/Failing.hs diff --git a/src/lib/Wst/Offchain/BuildTx/Failing.hs b/src/lib/Wst/Offchain/BuildTx/Failing.hs new file mode 100644 index 0000000..19680c7 --- /dev/null +++ b/src/lib/Wst/Offchain/BuildTx/Failing.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE UndecidableInstances #-} +{-| Tools for deliberately building a transaction +with "scriptValidity" flag set to "invalid". +-} +module Wst.Offchain.BuildTx.Failing( + IsEra, + BlacklistedTransferPolicy(..), + balanceTxEnvFailing +) where + +import Cardano.Api.Experimental (IsEra, obtainCommonConstraints, useEra) +import Cardano.Api.Experimental qualified as C +import Cardano.Api.Shelley qualified as C +import Cardano.Ledger.Api qualified as L +import Control.Lens (Iso', _3, _Just, at, iso, set, (&), (.~)) +import Control.Monad.Except (MonadError, throwError) +import Control.Monad.Reader (MonadReader, ReaderT, ask, asks, runReaderT) +import Control.Monad.Trans.Class (MonadTrans (..)) +import Convex.BuildTx (BuildTxT) +import Convex.BuildTx qualified as BuildTx +import Convex.CardanoApi.Lenses qualified as L +import Convex.Class (MonadBlockchain (utxoByTxIn), queryProtocolParameters) +import Convex.CoinSelection qualified as CoinSelection +import Convex.PlutusLedger.V1 (transCredential) +import Convex.Scripts (toHashableScriptData) +import Convex.Utils (mapError) +import Convex.Utxos (BalanceChanges) +import Convex.Utxos qualified as Utxos +import Convex.Wallet.Operator (returnOutputFor) +import Data.Bifunctor (Bifunctor (..)) +import Data.Map (Map) +import Wst.AppError (AppError (..)) +import Wst.Offchain.BuildTx.TransferLogic (FindProofResult (..), + blacklistInitialNode) +import Wst.Offchain.Env (HasOperatorEnv (..), OperatorEnv (..)) +import Wst.Offchain.Query (UTxODat (..)) + +{-| What to do if a transfer cannot proceed because of blacklisting +-} +data BlacklistedTransferPolicy + = SubmitFailingTx -- ^ Deliberately submit a transaction with "scriptValidity = False". This will result in the collateral input being spent! + | DontSubmitFailingTx -- ^ Don't submit a transaction + deriving stock (Eq, Show) + +{-| Balance a transaction using the operator's funds and return output +-} +balanceTxEnvFailing :: forall era env m. (IsEra era, MonadBlockchain era m, MonadReader env m, HasOperatorEnv era env, MonadError (AppError era) m, C.IsBabbageBasedEra era) => BlacklistedTransferPolicy -> BuildTxT era m (FindProofResult era) -> m (C.BalancedTxBody era, BalanceChanges) +balanceTxEnvFailing policy btx = do + OperatorEnv{bteOperatorUtxos, bteOperator} <- asks operatorEnv + params <- queryProtocolParameters + (r, txBuilder) <- BuildTx.runBuildTxT $ btx <* BuildTx.setMinAdaDepositAll params + -- TODO: change returnOutputFor to consider the stake address reference + -- (needs to be done in sc-tools) + let credential = C.PaymentCredentialByKey $ fst bteOperator + output <- returnOutputFor credential + (balBody, balChanges) <- case r of + CredentialNotBlacklisted{} -> + mapError BalancingError (CoinSelection.balanceTx mempty output (Utxos.fromApiUtxo bteOperatorUtxos) txBuilder CoinSelection.TrailingChange) + CredentialBlacklisted UTxODat{uIn} + | policy == SubmitFailingTx -> + fmap (first setScriptsInvalid) + $ runBacklistResetT uIn + $ mapError BalancingError (CoinSelection.balanceTx mempty output (Utxos.fromApiUtxo bteOperatorUtxos) txBuilder CoinSelection.TrailingChange) + | otherwise -> + throwError (TransferBlacklistedCredential (transCredential credential)) + NoBlacklistNodes -> throwError BlacklistNodeNotFound + pure (balBody, balChanges) + +newtype BlacklistResetT m a = BlacklistResetT (ReaderT C.TxIn m a) + deriving newtype (Functor, Applicative, Monad, MonadError e, MonadTrans) + +instance (C.IsBabbageBasedEra era, MonadBlockchain era m) => MonadBlockchain era (BlacklistResetT m) where + utxoByTxIn txis = BlacklistResetT $ do + txi <- ask + let newDat = C.TxOutDatumInline C.babbageBasedEra (toHashableScriptData blacklistInitialNode) + fmap (set (_UTxO . at txi . _Just . L._TxOut . _3) newDat) $ utxoByTxIn txis + +runBacklistResetT :: C.TxIn -> BlacklistResetT m a -> m a +runBacklistResetT txi (BlacklistResetT action) = runReaderT action txi + +_UTxO :: Iso' (C.UTxO era) (Map C.TxIn (C.TxOut C.CtxUTxO era)) +_UTxO = iso t f where + t (C.UTxO k) = k + f = C.UTxO + +setScriptsInvalid :: + forall era. + ( IsEra era + ) + => C.BalancedTxBody era + -> C.BalancedTxBody era +setScriptsInvalid (C.BalancedTxBody a (C.UnsignedTx b) c d) = obtainCommonConstraints (useEra @era) $ + let b' = C.UnsignedTx (b & L.isValidTxL @(C.LedgerEra era) .~ L.IsValid False) + in C.BalancedTxBody a b' c d diff --git a/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs b/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs index 6181a92..3aafe53 100644 --- a/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs +++ b/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs @@ -5,6 +5,7 @@ module Wst.Offchain.BuildTx.TransferLogic ( transferSmartTokens, + FindProofResult(..), issueSmartTokens, SeizeReason(..), seizeSmartTokens, @@ -14,6 +15,7 @@ module Wst.Offchain.BuildTx.TransferLogic removeBlacklistNode, paySmartTokensToDestination, registerTransferScripts, + blacklistInitialNode ) where @@ -54,7 +56,7 @@ import SmartTokens.Contracts.ExampleTransferLogic (BlacklistProof (..)) import SmartTokens.Types.ProtocolParams import SmartTokens.Types.PTokenDirectory (BlacklistNode (..), DirectorySetNode (..)) -import Wst.AppError (AppError (BlacklistNodeNotFound, DuplicateBlacklistNode, TransferBlacklistedCredential)) +import Wst.AppError (AppError (BlacklistNodeNotFound, DuplicateBlacklistNode)) import Wst.Offchain.BuildTx.ProgrammableLogic (issueProgrammableToken, seizeProgrammableToken, transferProgrammableToken) @@ -222,7 +224,7 @@ issueSmartTokens paramsTxOut (an, q) directoryList destinationCred = Utils.inBab paySmartTokensToDestination (an, q) issuedPolicyId destinationCred pure $ C.AssetId issuedPolicyId an -transferSmartTokens :: forall env era a m. (MonadReader env m, Env.HasTransferLogicEnv env, Env.HasDirectoryEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m, Env.HasOperatorEnv era env, MonadError (AppError era) m) => UTxODat era ProgrammableLogicGlobalParams -> [UTxODat era BlacklistNode] -> [UTxODat era DirectorySetNode] -> [UTxODat era a] -> (C.AssetId, C.Quantity) -> C.PaymentCredential -> m () +transferSmartTokens :: forall env era a m. (MonadReader env m, Env.HasTransferLogicEnv env, Env.HasDirectoryEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m, Env.HasOperatorEnv era env, MonadError (AppError era) m) => UTxODat era ProgrammableLogicGlobalParams -> [UTxODat era BlacklistNode] -> [UTxODat era DirectorySetNode] -> [UTxODat era a] -> (C.AssetId, C.Quantity) -> C.PaymentCredential -> m (FindProofResult era) transferSmartTokens paramsTxIn blacklistNodes directoryList spendingUserOutputs (assetId, q) destinationCred = Utils.inBabbage @era $ do nid <- queryNetworkId userCred <- Env.operatorPaymentCredential @@ -238,7 +240,7 @@ transferSmartTokens paramsTxIn blacklistNodes directoryList spendingUserOutputs C.AdaAssetId -> error "Ada is not programmable" transferProgrammableToken paramsTxIn txins (transPolicyId programmablePolicyId) directoryList -- Invoking the programmableBase and global scripts - addTransferWitness blacklistNodes -- Proof of non-membership of the blacklist + result <- addTransferWitness blacklistNodes -- Proof of non-membership of the blacklist -- Send outputs to destinationCred destStakeCred <- either (error . ("Could not unTrans credential: " <>) . show) pure $ unTransStakeCredential $ transCredential destinationCred @@ -255,6 +257,7 @@ transferSmartTokens paramsTxIn blacklistNodes directoryList spendingUserOutputs returnAddr = C.makeShelleyAddressInEra C.shelleyBasedEra nid progLogicBaseCred (C.StakeAddressByValue srcStakeCred) returnOutput = C.TxOut returnAddr returnVal C.TxOutDatumNone C.ReferenceScriptNone prependTxOut returnOutput -- Add the seized output to the transaction + pure result {-| Reason for adding an address to the blacklist -} @@ -338,6 +341,7 @@ tryFindProof :: [UTxODat era BlacklistNode] -> Credential -> UTxODat era Blackli tryFindProof blacklistNodes cred = case findProof blacklistNodes cred of CredentialNotBlacklisted r -> r + CredentialBlacklisted r -> r _ -> error $ "tryFindProof failed for " <> show cred {-| Find the blacklist node that covers the credential. @@ -352,18 +356,10 @@ findProof blacklistNodes cred = then CredentialBlacklisted node else CredentialNotBlacklisted node -{-| Check that the credential is not blacklisted. Throw an error if the - credential is blacklisted. --} -checkNotBlacklisted :: forall era m. MonadError (AppError era) m => [UTxODat era BlacklistNode] -> Credential -> m () -checkNotBlacklisted nodes cred = case findProof nodes cred of - CredentialNotBlacklisted{} -> pure () - _ -> throwError (TransferBlacklistedCredential cred) - {-| Add a proof that the user is allowed to transfer programmable tokens. Uses the user from 'HasOperatorEnv env'. Fails if the user is blacklisted. -} -addTransferWitness :: forall env era m. (MonadError (AppError era) m, MonadReader env m, Env.HasOperatorEnv era env, Env.HasTransferLogicEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => [UTxODat era BlacklistNode] -> m () +addTransferWitness :: forall env era m. (MonadError (AppError era) m, MonadReader env m, Env.HasOperatorEnv era env, Env.HasTransferLogicEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => [UTxODat era BlacklistNode] -> m (FindProofResult era) addTransferWitness blacklistNodes = Utils.inBabbage @era $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) -- In this case 'operator' is the user nid <- queryNetworkId @@ -390,7 +386,7 @@ addTransferWitness blacklistNodes = Utils.inBabbage @era $ do -- This means we're traversing the list of blacklist nodes an additional time. -- But here is the only place where we can use MonadError. So we have to do it -- here to allow the client code to handle the error properly. - checkNotBlacklisted blacklistNodes (transCredential $ C.PaymentCredentialByKey opPkh) + let proofResult = findProof blacklistNodes (transCredential $ C.PaymentCredentialByKey opPkh) addRequiredSignature opPkh addReferencesWithTxBody witnessReferences @@ -398,12 +394,12 @@ addTransferWitness blacklistNodes = Utils.inBabbage @era $ do (C.makeStakeAddress nid transferStakeCred) (C.Quantity 0) $ C.ScriptWitness C.ScriptWitnessForStakeAddr . transferStakeWitness + pure proofResult addReferencesWithTxBody :: (MonadBuildTx era m, C.IsBabbageBasedEra era) => (C.TxBodyContent C.BuildTx era -> [C.TxIn]) -> m () addReferencesWithTxBody f = addTxBuilder (TxBuilder $ \body -> over (L.txInsReference . L._TxInsReferenceIso) (nub . (f body <>))) - addSeizeWitness :: forall env era m. (MonadReader env m, Env.HasOperatorEnv era env, Env.HasTransferLogicEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => m () addSeizeWitness = Utils.inBabbage @era $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) diff --git a/src/lib/Wst/Offchain/Endpoints/Deployment.hs b/src/lib/Wst/Offchain/Endpoints/Deployment.hs index 4defc89..5ed13c4 100644 --- a/src/lib/Wst/Offchain/Endpoints/Deployment.hs +++ b/src/lib/Wst/Offchain/Endpoints/Deployment.hs @@ -30,6 +30,8 @@ import SmartTokens.Types.PTokenDirectory (DirectorySetNode (..)) import Wst.AppError (AppError (NoTokensToSeize)) import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (inaNewKey)) import Wst.Offchain.BuildTx.DirectorySet qualified as BuildTx +import Wst.Offchain.BuildTx.Failing (BlacklistedTransferPolicy, IsEra, + balanceTxEnvFailing) import Wst.Offchain.BuildTx.ProgrammableLogic qualified as BuildTx import Wst.Offchain.BuildTx.ProtocolParams qualified as BuildTx import Wst.Offchain.BuildTx.TransferLogic (BlacklistReason) @@ -39,7 +41,6 @@ import Wst.Offchain.Env qualified as Env import Wst.Offchain.Query (UTxODat (..)) import Wst.Offchain.Query qualified as Query - {-| Build a transaction that deploys the directory and global params. Returns the transaction and the 'TxIn' that was selected for the one-shot NFTs. -} @@ -176,17 +177,20 @@ transferSmartTokensTx :: forall era env m. , C.IsBabbageBasedEra era , C.HasScriptLanguageInEra C.PlutusScriptV3 era , MonadUtxoQuery m + , IsEra era ) - => C.AssetId -- ^ AssetId to transfer + => BlacklistedTransferPolicy + -> C.AssetId -- ^ AssetId to transfer -> Quantity -- ^ Amount of tokens to be minted -> C.PaymentCredential -- ^ Destination credential -> m (C.Tx era) -transferSmartTokensTx assetId quantity destCred = do +transferSmartTokensTx policy assetId quantity destCred = do directory <- Query.registryNodes @era blacklist <- Query.blacklistNodes @era userOutputsAtProgrammable <- Env.operatorPaymentCredential >>= Query.userProgrammableOutputs paramsTxIn <- Query.globalParamsNode @era - (tx, _) <- Env.balanceTxEnv_ $ do + (tx, _) <- balanceTxEnvFailing policy $ do + -- TODO: use a different balancing mechanism if we expect the scripts to fail BuildTx.transferSmartTokens paramsTxIn blacklist directory userOutputsAtProgrammable (assetId, quantity) destCred pure (Convex.CoinSelection.signBalancedTxBody [] tx) diff --git a/src/lib/Wst/Server.hs b/src/lib/Wst/Server.hs index f03b5a3..ebc78f0 100644 --- a/src/lib/Wst/Server.hs +++ b/src/lib/Wst/Server.hs @@ -33,6 +33,7 @@ import SmartTokens.Types.PTokenDirectory (blnKey) import System.Environment qualified import Wst.App (WstApp, runWstAppServant) import Wst.AppError (AppError (..)) +import Wst.Offchain.BuildTx.Failing (BlacklistedTransferPolicy (..), IsEra) import Wst.Offchain.Endpoints.Deployment qualified as Endpoints import Wst.Offchain.Env qualified as Env import Wst.Offchain.Query (UTxODat (uDatum)) @@ -215,15 +216,17 @@ transferProgrammableTokenEndpoint :: forall era env m. , C.IsBabbageBasedEra era , C.HasScriptLanguageInEra C.PlutusScriptV3 era , MonadUtxoQuery m + , IsEra era ) => TransferProgrammableTokenArgs -> m (TextEnvelopeJSON (C.Tx era)) -transferProgrammableTokenEndpoint TransferProgrammableTokenArgs{ttaSender, ttaRecipient, ttaAssetName, ttaQuantity, ttaIssuer} = do +transferProgrammableTokenEndpoint TransferProgrammableTokenArgs{ttaSender, ttaRecipient, ttaAssetName, ttaQuantity, ttaIssuer, ttaSubmitFailingTx} = do operatorEnv <- Env.loadOperatorEnvFromAddress ttaSender dirEnv <- asks Env.directoryEnv logic <- Env.transferLogicForDirectory (paymentKeyHashFromAddress ttaIssuer) assetId <- Env.programmableTokenAssetId dirEnv <$> Env.transferLogicForDirectory (paymentKeyHashFromAddress ttaIssuer) <*> pure ttaAssetName + let policy = maybe DontSubmitFailingTx (\k -> if k then SubmitFailingTx else DontSubmitFailingTx) ttaSubmitFailingTx Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer logic $ do - TextEnvelopeJSON <$> Endpoints.transferSmartTokensTx assetId ttaQuantity (paymentCredentialFromAddress ttaRecipient) + TextEnvelopeJSON <$> Endpoints.transferSmartTokensTx policy assetId ttaQuantity (paymentCredentialFromAddress ttaRecipient) addToBlacklistEndpoint :: forall era env m. ( MonadReader env m diff --git a/src/lib/Wst/Server/Types.hs b/src/lib/Wst/Server/Types.hs index 28fdaac..4291bb9 100644 --- a/src/lib/Wst/Server/Types.hs +++ b/src/lib/Wst/Server/Types.hs @@ -136,6 +136,7 @@ data TransferProgrammableTokenArgs = , ttaIssuer :: C.Address C.ShelleyAddr , ttaAssetName :: AssetName , ttaQuantity :: Quantity + , ttaSubmitFailingTx :: Maybe Bool } deriving stock (Eq, Show, Generic) diff --git a/src/test/unit/Wst/Test/UnitTest.hs b/src/test/unit/Wst/Test/UnitTest.hs index 391adeb..8de53e0 100644 --- a/src/test/unit/Wst/Test/UnitTest.hs +++ b/src/test/unit/Wst/Test/UnitTest.hs @@ -31,6 +31,7 @@ import SmartTokens.Core.Scripts (ScriptTarget (Debug, Production)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, testCase) import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (..)) +import Wst.Offchain.BuildTx.Failing (BlacklistedTransferPolicy (..)) import Wst.Offchain.BuildTx.Utils (addConwayStakeCredentialCertificate) import Wst.Offchain.Endpoints.Deployment qualified as Endpoints import Wst.Offchain.Env (DirectoryScriptRoot) @@ -56,7 +57,8 @@ scriptTargetTests target = , testCase "smart token transfer" (mockchainSucceedsWithTarget target $ deployDirectorySet >>= transferSmartTokens) , testCase "blacklist credential" (mockchainSucceedsWithTarget target $ void $ deployDirectorySet >>= blacklistCredential) , testCase "unblacklist credential" (mockchainSucceedsWithTarget target $ void $ deployDirectorySet >>= unblacklistCredential) - , testCase "blacklisted transfer" (mockchainFails blacklistTransfer assertBlacklistedAddressException) + , testCase "blacklisted transfer" (mockchainFails (blacklistTransfer DontSubmitFailingTx) assertBlacklistedAddressException) + , testCase "blacklisted transfer (failing tx)" (mockchainSucceedsWithTarget target (blacklistTransfer SubmitFailingTx)) , testCase "seize user output" (mockchainSucceedsWithTarget target $ deployDirectorySet >>= seizeUserOutput) , testCase "deploy all" (mockchainSucceedsWithTarget target deployAll) ] @@ -152,7 +154,7 @@ transferSmartTokens scriptRoot = failOnError $ Env.withEnv $ do asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) - Endpoints.transferSmartTokensTx aid 80 (C.PaymentCredentialByKey userPkh) + Endpoints.transferSmartTokensTx DontSubmitFailingTx aid 80 (C.PaymentCredentialByKey userPkh) >>= void . sendTx . signTxOperator admin Query.programmableLogicOutputs @C.ConwayEra @@ -208,8 +210,8 @@ unblacklistCredential scriptRoot = failOnError $ Env.withEnv $ do pure paymentCred -blacklistTransfer :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => m () -blacklistTransfer = failOnError $ Env.withEnv $ do +blacklistTransfer :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => BlacklistedTransferPolicy -> m () +blacklistTransfer policy = failOnError $ Env.withEnv $ do scriptRoot <- runReaderT deployDirectorySet Production userPkh <- asWallet Wallet.w2 $ asks (fst . Env.bteOperator . Env.operatorEnv) let userPaymentCred = C.PaymentCredentialByKey userPkh @@ -221,7 +223,7 @@ blacklistTransfer = failOnError $ Env.withEnv $ do opPkh <- asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) - Endpoints.transferSmartTokensTx aid 50 (C.PaymentCredentialByKey userPkh) + Endpoints.transferSmartTokensTx policy aid 50 (C.PaymentCredentialByKey userPkh) >>= void . sendTx . signTxOperator admin pure opPkh @@ -230,7 +232,7 @@ blacklistTransfer = failOnError $ Env.withEnv $ do asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ Endpoints.insertBlacklistNodeTx "" userPaymentCred >>= void . sendTx . signTxOperator admin - asWallet Wallet.w2 $ Env.withDirectoryFor scriptRoot $ Env.withTransfer transferLogic $ Endpoints.transferSmartTokensTx aid 30 (C.PaymentCredentialByKey opPkh) + asWallet Wallet.w2 $ Env.withDirectoryFor scriptRoot $ Env.withTransfer transferLogic $ Endpoints.transferSmartTokensTx policy aid 30 (C.PaymentCredentialByKey opPkh) >>= void . sendTx . signTxOperator (user Wallet.w2) seizeUserOutput :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => DirectoryScriptRoot -> m () @@ -244,7 +246,7 @@ seizeUserOutput scriptRoot = failOnError $ Env.withEnv $ do >>= void . sendTx . signTxOperator admin asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do - Endpoints.transferSmartTokensTx aid 50 (C.PaymentCredentialByKey userPkh) + Endpoints.transferSmartTokensTx DontSubmitFailingTx aid 50 (C.PaymentCredentialByKey userPkh) >>= void . sendTx . signTxOperator admin Query.programmableLogicOutputs @C.ConwayEra >>= void . expectN 2 "programmable logic outputs" diff --git a/src/wst-poc.cabal b/src/wst-poc.cabal index 2a0c8a8..6738528 100644 --- a/src/wst-poc.cabal +++ b/src/wst-poc.cabal @@ -76,6 +76,7 @@ library Wst.Client Wst.JSON.Utils Wst.Offchain.BuildTx.DirectorySet + Wst.Offchain.BuildTx.Failing Wst.Offchain.BuildTx.LinkedList Wst.Offchain.BuildTx.ProgrammableLogic Wst.Offchain.BuildTx.ProtocolParams @@ -100,6 +101,8 @@ library , blockfrost-client , blockfrost-client-core , cardano-api + , cardano-ledger-api + , cardano-ledger-binary , cardano-ledger-shelley , containers , convex-base @@ -123,6 +126,7 @@ library , servant-client-core , servant-server , text + , transformers , wai-cors , warp