Skip to content

Commit 78329d8

Browse files
j-muellerj-mueller
committed
Add override to submit failing tx to network
1 parent bbac375 commit 78329d8

File tree

7 files changed

+134
-27
lines changed

7 files changed

+134
-27
lines changed

‎src/lib/Wst/Offchain/BuildTx/Failing.hs‎

Lines changed: 97 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,97 @@
1+
{-# LANGUAGE ConstraintKinds #-}
2+
{-# LANGUAGE FlexibleInstances #-}
3+
{-# LANGUAGE NamedFieldPuns #-}
4+
{-# LANGUAGE UndecidableInstances #-}
5+
{-| Tools for deliberately building a transaction
6+
with "scriptValidity" flag set to "invalid".
7+
-}
8+
module Wst.Offchain.BuildTx.Failing(
9+
IsEra,
10+
BlacklistedTransferPolicy(..),
11+
balanceTxEnvFailing
12+
) where
13+
14+
import Cardano.Api.Experimental (IsEra, obtainCommonConstraints, useEra)
15+
import Cardano.Api.Experimental qualified as C
16+
import Cardano.Api.Shelley qualified as C
17+
import Cardano.Ledger.Api qualified as L
18+
import Control.Lens (Iso', _3, _Just, at, iso, set, (&), (.~))
19+
import Control.Monad.Except (MonadError, throwError)
20+
import Control.Monad.Reader (MonadReader, ReaderT, ask, asks, runReaderT)
21+
import Control.Monad.Trans.Class (MonadTrans (..))
22+
import Convex.BuildTx (BuildTxT)
23+
import Convex.BuildTx qualified as BuildTx
24+
import Convex.CardanoApi.Lenses qualified as L
25+
import Convex.Class (MonadBlockchain (utxoByTxIn), queryProtocolParameters)
26+
import Convex.CoinSelection qualified as CoinSelection
27+
import Convex.PlutusLedger.V1 (transCredential)
28+
import Convex.Scripts (toHashableScriptData)
29+
import Convex.Utils (mapError)
30+
import Convex.Utxos (BalanceChanges)
31+
import Convex.Utxos qualified as Utxos
32+
import Convex.Wallet.Operator (returnOutputFor)
33+
import Data.Bifunctor (Bifunctor (..))
34+
import Data.Map (Map)
35+
import Wst.AppError (AppError (..))
36+
import Wst.Offchain.BuildTx.TransferLogic (FindProofResult (..),
37+
blacklistInitialNode)
38+
import Wst.Offchain.Env (HasOperatorEnv (..), OperatorEnv (..))
39+
import Wst.Offchain.Query (UTxODat (..))
40+
41+
{-| What to do if a transfer cannot proceed because of blacklisting
42+
-}
43+
data BlacklistedTransferPolicy
44+
= SubmitFailingTx -- ^ Deliberately submit a transaction with "scriptValidity = False". This will result in the collateral input being spent!
45+
| DontSubmitFailingTx -- ^ Don't submit a transaction
46+
deriving stock (Eq, Show)
47+
48+
{-| Balance a transaction using the operator's funds and return output
49+
-}
50+
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)
51+
balanceTxEnvFailing policy btx = do
52+
OperatorEnv{bteOperatorUtxos, bteOperator} <- asks operatorEnv
53+
params <- queryProtocolParameters
54+
(r, txBuilder) <- BuildTx.runBuildTxT $ btx <* BuildTx.setMinAdaDepositAll params
55+
-- TODO: change returnOutputFor to consider the stake address reference
56+
-- (needs to be done in sc-tools)
57+
let credential = C.PaymentCredentialByKey $ fst bteOperator
58+
output <- returnOutputFor credential
59+
(balBody, balChanges) <- case r of
60+
CredentialNotBlacklisted{} ->
61+
mapError BalancingError (CoinSelection.balanceTx mempty output (Utxos.fromApiUtxo bteOperatorUtxos) txBuilder CoinSelection.TrailingChange)
62+
CredentialBlacklisted UTxODat{uIn}
63+
| policy == SubmitFailingTx ->
64+
fmap (first setScriptsInvalid)
65+
$ runBacklistResetT uIn
66+
$ mapError BalancingError (CoinSelection.balanceTx mempty output (Utxos.fromApiUtxo bteOperatorUtxos) txBuilder CoinSelection.TrailingChange)
67+
| otherwise ->
68+
throwError (TransferBlacklistedCredential (transCredential credential))
69+
NoBlacklistNodes -> throwError BlacklistNodeNotFound
70+
pure (balBody, balChanges)
71+
72+
newtype BlacklistResetT m a = BlacklistResetT (ReaderT C.TxIn m a)
73+
deriving newtype (Functor, Applicative, Monad, MonadError e, MonadTrans)
74+
75+
instance (C.IsBabbageBasedEra era, MonadBlockchain era m) => MonadBlockchain era (BlacklistResetT m) where
76+
utxoByTxIn txis = BlacklistResetT $ do
77+
txi <- ask
78+
let newDat = C.TxOutDatumInline C.babbageBasedEra (toHashableScriptData blacklistInitialNode)
79+
fmap (set (_UTxO . at txi . _Just . L._TxOut . _3) newDat) $ utxoByTxIn txis
80+
81+
runBacklistResetT :: C.TxIn -> BlacklistResetT m a -> m a
82+
runBacklistResetT txi (BlacklistResetT action) = runReaderT action txi
83+
84+
_UTxO :: Iso' (C.UTxO era) (Map C.TxIn (C.TxOut C.CtxUTxO era))
85+
_UTxO = iso t f where
86+
t (C.UTxO k) = k
87+
f = C.UTxO
88+
89+
setScriptsInvalid ::
90+
forall era.
91+
( IsEra era
92+
)
93+
=> C.BalancedTxBody era
94+
-> C.BalancedTxBody era
95+
setScriptsInvalid (C.BalancedTxBody a (C.UnsignedTx b) c d) = obtainCommonConstraints (useEra @era) $
96+
let b' = C.UnsignedTx (b & L.isValidTxL @(C.LedgerEra era) .~ L.IsValid False)
97+
in C.BalancedTxBody a b' c d

‎src/lib/Wst/Offchain/BuildTx/TransferLogic.hs‎

Lines changed: 10 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55

66
module Wst.Offchain.BuildTx.TransferLogic
77
( transferSmartTokens,
8+
FindProofResult(..),
89
issueSmartTokens,
910
SeizeReason(..),
1011
seizeSmartTokens,
@@ -14,6 +15,7 @@ module Wst.Offchain.BuildTx.TransferLogic
1415
removeBlacklistNode,
1516
paySmartTokensToDestination,
1617
registerTransferScripts,
18+
blacklistInitialNode
1719
)
1820
where
1921

@@ -54,7 +56,7 @@ import SmartTokens.Contracts.ExampleTransferLogic (BlacklistProof (..))
5456
import SmartTokens.Types.ProtocolParams
5557
import SmartTokens.Types.PTokenDirectory (BlacklistNode (..),
5658
DirectorySetNode (..))
57-
import Wst.AppError (AppError (BlacklistNodeNotFound, DuplicateBlacklistNode, TransferBlacklistedCredential))
59+
import Wst.AppError (AppError (BlacklistNodeNotFound, DuplicateBlacklistNode))
5860
import Wst.Offchain.BuildTx.ProgrammableLogic (issueProgrammableToken,
5961
seizeProgrammableToken,
6062
transferProgrammableToken)
@@ -222,7 +224,7 @@ issueSmartTokens paramsTxOut (an, q) directoryList destinationCred = Utils.inBab
222224
paySmartTokensToDestination (an, q) issuedPolicyId destinationCred
223225
pure $ C.AssetId issuedPolicyId an
224226

225-
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 ()
227+
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)
226228
transferSmartTokens paramsTxIn blacklistNodes directoryList spendingUserOutputs (assetId, q) destinationCred = Utils.inBabbage @era $ do
227229
nid <- queryNetworkId
228230
userCred <- Env.operatorPaymentCredential
@@ -238,7 +240,7 @@ transferSmartTokens paramsTxIn blacklistNodes directoryList spendingUserOutputs
238240
C.AdaAssetId -> error "Ada is not programmable"
239241

240242
transferProgrammableToken paramsTxIn txins (transPolicyId programmablePolicyId) directoryList -- Invoking the programmableBase and global scripts
241-
addTransferWitness blacklistNodes -- Proof of non-membership of the blacklist
243+
result <- addTransferWitness blacklistNodes -- Proof of non-membership of the blacklist
242244

243245
-- Send outputs to destinationCred
244246
destStakeCred <- either (error . ("Could not unTrans credential: " <>) . show) pure $ unTransStakeCredential $ transCredential destinationCred
@@ -255,6 +257,7 @@ transferSmartTokens paramsTxIn blacklistNodes directoryList spendingUserOutputs
255257
returnAddr = C.makeShelleyAddressInEra C.shelleyBasedEra nid progLogicBaseCred (C.StakeAddressByValue srcStakeCred)
256258
returnOutput = C.TxOut returnAddr returnVal C.TxOutDatumNone C.ReferenceScriptNone
257259
prependTxOut returnOutput -- Add the seized output to the transaction
260+
pure result
258261

259262
{-| Reason for adding an address to the blacklist
260263
-}
@@ -338,6 +341,7 @@ tryFindProof :: [UTxODat era BlacklistNode] -> Credential -> UTxODat era Blackli
338341
tryFindProof blacklistNodes cred =
339342
case findProof blacklistNodes cred of
340343
CredentialNotBlacklisted r -> r
344+
CredentialBlacklisted r -> r
341345
_ -> error $ "tryFindProof failed for " <> show cred
342346

343347
{-| Find the blacklist node that covers the credential.
@@ -352,18 +356,10 @@ findProof blacklistNodes cred =
352356
then CredentialBlacklisted node
353357
else CredentialNotBlacklisted node
354358

355-
{-| Check that the credential is not blacklisted. Throw an error if the
356-
credential is blacklisted.
357-
-}
358-
checkNotBlacklisted :: forall era m. MonadError (AppError era) m => [UTxODat era BlacklistNode] -> Credential -> m ()
359-
checkNotBlacklisted nodes cred = case findProof nodes cred of
360-
CredentialNotBlacklisted{} -> pure ()
361-
_ -> throwError (TransferBlacklistedCredential cred)
362-
363359
{-| Add a proof that the user is allowed to transfer programmable tokens.
364360
Uses the user from 'HasOperatorEnv env'. Fails if the user is blacklisted.
365361
-}
366-
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 ()
362+
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)
367363
addTransferWitness blacklistNodes = Utils.inBabbage @era $ do
368364
opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) -- In this case 'operator' is the user
369365
nid <- queryNetworkId
@@ -390,20 +386,20 @@ addTransferWitness blacklistNodes = Utils.inBabbage @era $ do
390386
-- This means we're traversing the list of blacklist nodes an additional time.
391387
-- But here is the only place where we can use MonadError. So we have to do it
392388
-- here to allow the client code to handle the error properly.
393-
checkNotBlacklisted blacklistNodes (transCredential $ C.PaymentCredentialByKey opPkh)
389+
let proofResult = findProof blacklistNodes (transCredential $ C.PaymentCredentialByKey opPkh)
394390

395391
addRequiredSignature opPkh
396392
addReferencesWithTxBody witnessReferences
397393
addWithdrawalWithTxBody -- Add the global script witness to the transaction
398394
(C.makeStakeAddress nid transferStakeCred)
399395
(C.Quantity 0)
400396
$ C.ScriptWitness C.ScriptWitnessForStakeAddr . transferStakeWitness
397+
pure proofResult
401398

402399
addReferencesWithTxBody :: (MonadBuildTx era m, C.IsBabbageBasedEra era) => (C.TxBodyContent C.BuildTx era -> [C.TxIn]) -> m ()
403400
addReferencesWithTxBody f =
404401
addTxBuilder (TxBuilder $ \body -> over (L.txInsReference . L._TxInsReferenceIso) (nub . (f body <>)))
405402

406-
407403
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 ()
408404
addSeizeWitness = Utils.inBabbage @era $ do
409405
opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv)

‎src/lib/Wst/Offchain/Endpoints/Deployment.hs‎

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,8 @@ import SmartTokens.Types.PTokenDirectory (DirectorySetNode (..))
3030
import Wst.AppError (AppError (NoTokensToSeize))
3131
import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (inaNewKey))
3232
import Wst.Offchain.BuildTx.DirectorySet qualified as BuildTx
33+
import Wst.Offchain.BuildTx.Failing (BlacklistedTransferPolicy, IsEra,
34+
balanceTxEnvFailing)
3335
import Wst.Offchain.BuildTx.ProgrammableLogic qualified as BuildTx
3436
import Wst.Offchain.BuildTx.ProtocolParams qualified as BuildTx
3537
import Wst.Offchain.BuildTx.TransferLogic (BlacklistReason)
@@ -39,7 +41,6 @@ import Wst.Offchain.Env qualified as Env
3941
import Wst.Offchain.Query (UTxODat (..))
4042
import Wst.Offchain.Query qualified as Query
4143

42-
4344
{-| Build a transaction that deploys the directory and global params. Returns the
4445
transaction and the 'TxIn' that was selected for the one-shot NFTs.
4546
-}
@@ -176,17 +177,20 @@ transferSmartTokensTx :: forall era env m.
176177
, C.IsBabbageBasedEra era
177178
, C.HasScriptLanguageInEra C.PlutusScriptV3 era
178179
, MonadUtxoQuery m
180+
, IsEra era
179181
)
180-
=> C.AssetId -- ^ AssetId to transfer
182+
=> BlacklistedTransferPolicy
183+
-> C.AssetId -- ^ AssetId to transfer
181184
-> Quantity -- ^ Amount of tokens to be minted
182185
-> C.PaymentCredential -- ^ Destination credential
183186
-> m (C.Tx era)
184-
transferSmartTokensTx assetId quantity destCred = do
187+
transferSmartTokensTx policy assetId quantity destCred = do
185188
directory <- Query.registryNodes @era
186189
blacklist <- Query.blacklistNodes @era
187190
userOutputsAtProgrammable <- Env.operatorPaymentCredential >>= Query.userProgrammableOutputs
188191
paramsTxIn <- Query.globalParamsNode @era
189-
(tx, _) <- Env.balanceTxEnv_ $ do
192+
(tx, _) <- balanceTxEnvFailing policy $ do
193+
-- TODO: use a different balancing mechanism if we expect the scripts to fail
190194
BuildTx.transferSmartTokens paramsTxIn blacklist directory userOutputsAtProgrammable (assetId, quantity) destCred
191195
pure (Convex.CoinSelection.signBalancedTxBody [] tx)
192196

‎src/lib/Wst/Server.hs‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,7 @@ import SmartTokens.Types.PTokenDirectory (blnKey)
3333
import System.Environment qualified
3434
import Wst.App (WstApp, runWstAppServant)
3535
import Wst.AppError (AppError (..))
36+
import Wst.Offchain.BuildTx.Failing (BlacklistedTransferPolicy (..), IsEra)
3637
import Wst.Offchain.Endpoints.Deployment qualified as Endpoints
3738
import Wst.Offchain.Env qualified as Env
3839
import Wst.Offchain.Query (UTxODat (uDatum))
@@ -215,15 +216,17 @@ transferProgrammableTokenEndpoint :: forall era env m.
215216
, C.IsBabbageBasedEra era
216217
, C.HasScriptLanguageInEra C.PlutusScriptV3 era
217218
, MonadUtxoQuery m
219+
, IsEra era
218220
)
219221
=> TransferProgrammableTokenArgs -> m (TextEnvelopeJSON (C.Tx era))
220-
transferProgrammableTokenEndpoint TransferProgrammableTokenArgs{ttaSender, ttaRecipient, ttaAssetName, ttaQuantity, ttaIssuer} = do
222+
transferProgrammableTokenEndpoint TransferProgrammableTokenArgs{ttaSender, ttaRecipient, ttaAssetName, ttaQuantity, ttaIssuer, ttaSubmitFailingTx} = do
221223
operatorEnv <- Env.loadOperatorEnvFromAddress ttaSender
222224
dirEnv <- asks Env.directoryEnv
223225
logic <- Env.transferLogicForDirectory (paymentKeyHashFromAddress ttaIssuer)
224226
assetId <- Env.programmableTokenAssetId dirEnv <$> Env.transferLogicForDirectory (paymentKeyHashFromAddress ttaIssuer) <*> pure ttaAssetName
227+
let policy = maybe DontSubmitFailingTx (\k -> if k then SubmitFailingTx else DontSubmitFailingTx) ttaSubmitFailingTx
225228
Env.withEnv $ Env.withOperator operatorEnv $ Env.withDirectory dirEnv $ Env.withTransfer logic $ do
226-
TextEnvelopeJSON <$> Endpoints.transferSmartTokensTx assetId ttaQuantity (paymentCredentialFromAddress ttaRecipient)
229+
TextEnvelopeJSON <$> Endpoints.transferSmartTokensTx policy assetId ttaQuantity (paymentCredentialFromAddress ttaRecipient)
227230

228231
addToBlacklistEndpoint :: forall era env m.
229232
( MonadReader env m

‎src/lib/Wst/Server/Types.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -136,6 +136,7 @@ data TransferProgrammableTokenArgs =
136136
, ttaIssuer :: C.Address C.ShelleyAddr
137137
, ttaAssetName :: AssetName
138138
, ttaQuantity :: Quantity
139+
, ttaSubmitFailingTx :: Maybe Bool
139140
}
140141
deriving stock (Eq, Show, Generic)
141142

‎src/test/unit/Wst/Test/UnitTest.hs‎

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ import SmartTokens.Core.Scripts (ScriptTarget (Debug, Production))
3131
import Test.Tasty (TestTree, testGroup)
3232
import Test.Tasty.HUnit (Assertion, testCase)
3333
import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (..))
34+
import Wst.Offchain.BuildTx.Failing (BlacklistedTransferPolicy (..))
3435
import Wst.Offchain.BuildTx.Utils (addConwayStakeCredentialCertificate)
3536
import Wst.Offchain.Endpoints.Deployment qualified as Endpoints
3637
import Wst.Offchain.Env (DirectoryScriptRoot)
@@ -56,7 +57,8 @@ scriptTargetTests target =
5657
, testCase "smart token transfer" (mockchainSucceedsWithTarget target $ deployDirectorySet >>= transferSmartTokens)
5758
, testCase "blacklist credential" (mockchainSucceedsWithTarget target $ void $ deployDirectorySet >>= blacklistCredential)
5859
, testCase "unblacklist credential" (mockchainSucceedsWithTarget target $ void $ deployDirectorySet >>= unblacklistCredential)
59-
, testCase "blacklisted transfer" (mockchainFails blacklistTransfer assertBlacklistedAddressException)
60+
, testCase "blacklisted transfer" (mockchainFails (blacklistTransfer DontSubmitFailingTx) assertBlacklistedAddressException)
61+
, testCase "blacklisted transfer (failing tx)" (mockchainSucceedsWithTarget target (blacklistTransfer SubmitFailingTx))
6062
, testCase "seize user output" (mockchainSucceedsWithTarget target $ deployDirectorySet >>= seizeUserOutput)
6163
, testCase "deploy all" (mockchainSucceedsWithTarget target deployAll)
6264
]
@@ -152,7 +154,7 @@ transferSmartTokens scriptRoot = failOnError $ Env.withEnv $ do
152154
asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do
153155
opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv)
154156

155-
Endpoints.transferSmartTokensTx aid 80 (C.PaymentCredentialByKey userPkh)
157+
Endpoints.transferSmartTokensTx DontSubmitFailingTx aid 80 (C.PaymentCredentialByKey userPkh)
156158
>>= void . sendTx . signTxOperator admin
157159

158160
Query.programmableLogicOutputs @C.ConwayEra
@@ -208,8 +210,8 @@ unblacklistCredential scriptRoot = failOnError $ Env.withEnv $ do
208210

209211
pure paymentCred
210212

211-
blacklistTransfer :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => m ()
212-
blacklistTransfer = failOnError $ Env.withEnv $ do
213+
blacklistTransfer :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => BlacklistedTransferPolicy -> m ()
214+
blacklistTransfer policy = failOnError $ Env.withEnv $ do
213215
scriptRoot <- runReaderT deployDirectorySet Production
214216
userPkh <- asWallet Wallet.w2 $ asks (fst . Env.bteOperator . Env.operatorEnv)
215217
let userPaymentCred = C.PaymentCredentialByKey userPkh
@@ -221,7 +223,7 @@ blacklistTransfer = failOnError $ Env.withEnv $ do
221223

222224
opPkh <- asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do
223225
opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv)
224-
Endpoints.transferSmartTokensTx aid 50 (C.PaymentCredentialByKey userPkh)
226+
Endpoints.transferSmartTokensTx policy aid 50 (C.PaymentCredentialByKey userPkh)
225227
>>= void . sendTx . signTxOperator admin
226228
pure opPkh
227229

@@ -230,7 +232,7 @@ blacklistTransfer = failOnError $ Env.withEnv $ do
230232
asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ Endpoints.insertBlacklistNodeTx "" userPaymentCred
231233
>>= void . sendTx . signTxOperator admin
232234

233-
asWallet Wallet.w2 $ Env.withDirectoryFor scriptRoot $ Env.withTransfer transferLogic $ Endpoints.transferSmartTokensTx aid 30 (C.PaymentCredentialByKey opPkh)
235+
asWallet Wallet.w2 $ Env.withDirectoryFor scriptRoot $ Env.withTransfer transferLogic $ Endpoints.transferSmartTokensTx policy aid 30 (C.PaymentCredentialByKey opPkh)
234236
>>= void . sendTx . signTxOperator (user Wallet.w2)
235237

236238
seizeUserOutput :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => DirectoryScriptRoot -> m ()
@@ -244,7 +246,7 @@ seizeUserOutput scriptRoot = failOnError $ Env.withEnv $ do
244246
>>= void . sendTx . signTxOperator admin
245247

246248
asAdmin @C.ConwayEra $ Env.withDirectoryFor scriptRoot $ Env.withTransferFromOperator $ do
247-
Endpoints.transferSmartTokensTx aid 50 (C.PaymentCredentialByKey userPkh)
249+
Endpoints.transferSmartTokensTx DontSubmitFailingTx aid 50 (C.PaymentCredentialByKey userPkh)
248250
>>= void . sendTx . signTxOperator admin
249251
Query.programmableLogicOutputs @C.ConwayEra
250252
>>= void . expectN 2 "programmable logic outputs"

0 commit comments

Comments
 (0)