@@ -171,22 +171,22 @@ dontAddChangeToDatum = do
171
171
let scrTxOut' =
172
172
ScriptChainIndexTxOut
173
173
valAddr
174
- (Right validator) -- (valHash, Just validator)
175
- (Right scrDatum) -- (scrDatumHash, Just scrDatum)
174
+ (Right validator)
175
+ (Right scrDatum)
176
176
scrValue
177
177
scrTxOut = Ledger. toTxOut scrTxOut'
178
178
usrTxOut' =
179
179
PublicKeyChainIndexTxOut
180
180
pkhAddr3
181
181
(Ada. lovelaceValueOf 1_001_000 )
182
182
usrTxOut = Ledger. toTxOut usrTxOut'
183
- -- initState :: MockContractState ()
183
+ initState :: MockContractState ()
184
184
initState =
185
185
def & utxos .~ [(txOutRef6, scrTxOut), (txOutRef7, usrTxOut)]
186
186
& contractEnv .~ contractEnv'
187
187
pabConf :: PABConfig
188
188
pabConf = def {pcOwnPubKeyHash = pkh3}
189
- -- contractEnv' :: ContractEnvironment ()
189
+ contractEnv' :: ContractEnvironment ()
190
190
contractEnv' = def {cePABConfig = pabConf}
191
191
192
192
-- Input UTxOs:
@@ -203,7 +203,7 @@ dontAddChangeToDatum = do
203
203
-- - Amt: 1 ADA
204
204
-- UTxO 2:
205
205
-- - To : Script
206
- -- - Amt: 1.0005 Ada + 200 Token
206
+ -- - Amt: 0.5005 Ada + 200 Token
207
207
--
208
208
-- Fees : 400 Lovelace
209
209
-- Change : 100 Lovelace
@@ -214,7 +214,6 @@ dontAddChangeToDatum = do
214
214
txConsts =
215
215
-- Pay the same datum to the script, but with more ada.
216
216
Constraints. mustPayToOtherScript valHash scrDatum (scrValue <> Ada. lovelaceValueOf 500 )
217
- -- <> Constraints.mustPayToOtherScript valHash scrDatum (Ada.lovelaceValueOf 1_000_000)
218
217
<> Constraints. mustPayToPubKey paymentPkh3 (Ada. lovelaceValueOf 1_000_000 )
219
218
<> Constraints. mustSpendScriptOutput txOutRef6 Ledger. unitRedeemer
220
219
<> Constraints. mustSpendPubKeyOutput txOutRef7
@@ -226,20 +225,20 @@ dontAddChangeToDatum = do
226
225
let (eRslt, _finalState) = runPABEffectPure initState (balanceTxIO @ () @ '[PABEffect () ] pabConf pkh3 unbalancedTx)
227
226
case eRslt of
228
227
(Left txt) -> assertFailure (" PAB effect error: " <> Text. unpack txt)
229
- (Right (Left txt)) -> assertFailure $ " Balancing error: " <> Text. unpack txt -- <> "\n(Tx: " <> show unbalancedTx <> ")"
228
+ (Right (Left txt)) -> assertFailure $ " Balancing error: " <> Text. unpack txt
230
229
(Right (Right trx)) -> do
231
230
let scrTxOut'' = scrTxOut' & Ledger. ciTxOutValue <>~ Ada. lovelaceValueOf 500
232
- scrTxOutNew = Ledger. toTxOut scrTxOut''
231
+ scrTxOutExpected = Ledger. toTxOut scrTxOut''
233
232
assertBool
234
233
( " Expected UTxO not in output Tx."
235
234
<> " \n Expected UTxO: "
236
- <> show scrTxOutNew
235
+ <> show scrTxOutExpected
237
236
<> " \n New UTxOs: "
238
237
<> show (txOutputs trx)
239
238
<> " \n Unbalanced UTxOs: "
240
239
<> show (txOutputs (unbalancedTx ^. OffChain. tx))
241
240
)
242
- (scrTxOutNew `elem` txOutputs trx)
241
+ (scrTxOutExpected `elem` txOutputs trx)
243
242
244
243
-- Like the first one, but
245
244
-- only has inputs from the script.
@@ -248,26 +247,37 @@ dontAddChangeToDatum2 = do
248
247
let scrTxOut' =
249
248
ScriptChainIndexTxOut
250
249
valAddr
251
- (Right validator) -- (valHash, Just validator)
252
- (Right scrDatum) -- (scrDatumHash, Just scrDatum)
250
+ (Right validator)
251
+ (Right scrDatum)
253
252
(scrValue <> Ada. lovelaceValueOf 1_500_000 )
254
253
scrTxOut = Ledger. toTxOut scrTxOut'
255
- -- initState :: MockContractState ()
254
+ initState :: MockContractState ()
256
255
initState =
257
256
def & utxos .~ [(txOutRef6, scrTxOut)]
258
257
& contractEnv .~ contractEnv'
259
258
pabConf :: PABConfig
260
259
pabConf = def {pcOwnPubKeyHash = pkh3}
261
- -- contractEnv' :: ContractEnvironment ()
260
+ contractEnv' :: ContractEnvironment ()
262
261
contractEnv' = def {cePABConfig = pabConf}
263
262
263
+ -- Input UTxO :
264
+ -- - 2.0 ADA
265
+ -- - 200 tokens
266
+ -- Output UTxO :
267
+ -- - 0.5 ADA
268
+ -- - 100 tokens
269
+ -- Change:
270
+ -- - 1.5 ADA (400 Lovelace to fees)
271
+ -- - 100 tokens
272
+
264
273
scrLkups =
265
274
Constraints. unspentOutputs (Map. fromList [(txOutRef6, scrTxOut')])
266
275
<> Constraints. ownPaymentPubKeyHash paymentPkh3
267
276
txConsts =
268
277
-- Pay the same datum to the script, but with LESS ada
269
278
-- and fewer tokens. This is to ensure that the excess
270
279
-- ADA and tokens are moved into their own UTxO(s),
280
+ -- rather than just being left in the original UTxO.
271
281
-- (The extra ada is used to cover fees etc...)
272
282
Constraints. mustPayToOtherScript valHash scrDatum scrValue'
273
283
<> Constraints. mustSpendScriptOutput txOutRef6 Ledger. unitRedeemer
@@ -279,17 +289,17 @@ dontAddChangeToDatum2 = do
279
289
let (eRslt, _finalState) = runPABEffectPure initState (balanceTxIO @ () @ '[PABEffect () ] pabConf pkh3 unbalancedTx)
280
290
case eRslt of
281
291
(Left txt) -> assertFailure (" PAB effect error: " <> Text. unpack txt)
282
- (Right (Left txt)) -> assertFailure $ " Balancing error: " <> Text. unpack txt -- <> "\n(Tx: " <> show unbalancedTx <> ")"
292
+ (Right (Left txt)) -> assertFailure $ " Balancing error: " <> Text. unpack txt
283
293
(Right (Right trx)) -> do
284
294
let scrTxOut'' = scrTxOut' & Ledger. ciTxOutValue .~ scrValue'
285
- scrTxOutNew = Ledger. toTxOut scrTxOut''
295
+ scrTxOutExpected = Ledger. toTxOut scrTxOut''
286
296
assertBool
287
297
( " Expected UTxO not in output Tx."
288
298
<> " \n Expected UTxO: "
289
- <> show scrTxOutNew
299
+ <> show scrTxOutExpected
290
300
<> " \n New UTxOs: "
291
301
<> show (txOutputs trx)
292
302
<> " \n Unbalanced UTxOs: "
293
303
<> show (txOutputs (unbalancedTx ^. OffChain. tx))
294
304
)
295
- (scrTxOutNew `elem` txOutputs trx)
305
+ (scrTxOutExpected `elem` txOutputs trx)
0 commit comments