Skip to content
This repository was archived by the owner on Dec 2, 2024. It is now read-only.

Commit eceb8c3

Browse files
Re-enable prop_Uniswap
1 parent 68dcf27 commit eceb8c3

File tree

5 files changed

+41
-24
lines changed

5 files changed

+41
-24
lines changed

plutus-ledger-constraints/src/Ledger/Constraints/OnChain.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,7 @@ checkOwnOutputConstraint ctx@ScriptContext{scriptContextTxInfo} ScriptOutputCons
6868
let hsh = V.findDatumHash (Ledger.Datum $ toBuiltinData ocDatum) scriptContextTxInfo
6969
checkOutput TxOut{txOutValue, txOutDatumHash=Just svh} =
7070
Ada.fromValue txOutValue >= Ada.fromValue ocValue
71-
&& Ada.fromValue txOutValue <= Ada.fromValue ocValue + Ledger.minAdaTxOut
71+
&& Ada.fromValue txOutValue <= Ada.fromValue ocValue + Ledger.maxMinAdaTxOut
7272
&& Value.noAdaValue txOutValue == Value.noAdaValue ocValue
7373
&& hsh == Just svh
7474
checkOutput _ = False
@@ -120,7 +120,7 @@ checkTxConstraint ctx@ScriptContext{scriptContextTxInfo} = \case
120120
addr = Address.scriptHashAddress vlh
121121
checkOutput TxOut{txOutAddress, txOutValue, txOutDatumHash=Just svh} =
122122
Ada.fromValue txOutValue >= Ada.fromValue vl
123-
&& Ada.fromValue txOutValue <= Ada.fromValue vl + Ledger.minAdaTxOut
123+
&& Ada.fromValue txOutValue <= Ada.fromValue vl + Ledger.maxMinAdaTxOut
124124
&& Value.noAdaValue txOutValue == Value.noAdaValue vl
125125
&& hsh == Just svh
126126
&& txOutAddress == addr

plutus-ledger/src/Ledger/Index.hs

+17-1
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,7 @@ module Ledger.Index(
3434
maxFee,
3535
minAdaTxOut,
3636
minLovelaceTxOut,
37+
maxMinAdaTxOut,
3738
mkTxInfo,
3839
-- * Actual validation
3940
validateTransaction,
@@ -322,7 +323,7 @@ checkPositiveValues t =
322323
else throwError $ NegativeValue t
323324

324325
{-# INLINABLE minAdaTxOut #-}
325-
-- Minimum required Ada for each tx output.
326+
-- An estimate of the minimum required Ada for each tx output.
326327
--
327328
-- TODO: Should be removed.
328329
minAdaTxOut :: Ada
@@ -332,6 +333,21 @@ minAdaTxOut = Ada.lovelaceOf minTxOut
332333
minTxOut :: Integer
333334
minTxOut = 2_000_000
334335

336+
{-# INLINABLE maxMinAdaTxOut #-}
337+
{-
338+
maxMinAdaTxOut = maxTxOutSize * coinsPerUTxOWord
339+
coinsPerUTxOWord = 34_482
340+
maxTxOutSize = utxoEntrySizeWithoutVal + maxValSizeInWords + dataHashSize
341+
utxoEntrySizeWithoutVal = 27
342+
maxValSizeInWords = 500
343+
dataHashSize = 10
344+
345+
These values are partly protocol parameters-based, but since this is used in on-chain code
346+
we want a constant to reduce code size.
347+
-}
348+
maxMinAdaTxOut :: Ada
349+
maxMinAdaTxOut = Ada.lovelaceOf 18_516_834
350+
335351
-- Minimum required Lovelace for each tx output.
336352
--
337353
minLovelaceTxOut :: Lovelace

plutus-use-cases/src/Plutus/Contracts/Uniswap/OffChain.hs

+8-7
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,7 @@ import Data.Proxy (Proxy (..))
4343
import Data.Text (Text, pack)
4444
import Data.Void (Void, absurd)
4545
import Ledger hiding (singleton)
46+
import Ledger.Ada qualified as Ada
4647
import Ledger.Constraints as Constraints hiding (adjustUnbalancedTx)
4748
import Ledger.Typed.Scripts qualified as Scripts
4849
import Playground.Contract
@@ -203,7 +204,7 @@ start = do
203204
let c = mkCoin cs uniswapTokenName
204205
us = uniswap cs
205206
inst = uniswapInstance us
206-
tx = mustPayToTheScript (Factory []) $ unitValue c
207+
tx = mustPayToTheScript (Factory []) $ unitValue c <> Ada.adaValueOf 2
207208

208209
mkTxConstraints (Constraints.typedValidatorLookups inst) tx
209210
>>= adjustUnbalancedTx >>= submitTxConfirmed
@@ -226,8 +227,8 @@ create us CreateParams{..} = do
226227
usDat2 = Pool lp liquidity
227228
psC = poolStateCoin us
228229
lC = mkCoin (liquidityCurrency us) $ lpTicker lp
229-
usVal = unitValue $ usCoin us
230-
lpVal = valueOf cpCoinA cpAmountA <> valueOf cpCoinB cpAmountB <> unitValue psC
230+
usVal = unitValue (usCoin us) <> Ada.adaValueOf 2
231+
lpVal = valueOf cpCoinA cpAmountA <> valueOf cpCoinB cpAmountB <> unitValue psC <> Ada.adaValueOf 2
231232

232233
lookups = Constraints.typedValidatorLookups usInst <>
233234
Constraints.otherScript usScript <>
@@ -254,7 +255,7 @@ close us CloseParams{..} = do
254255
usC = usCoin us
255256
psC = poolStateCoin us
256257
lC = mkCoin (liquidityCurrency us) $ lpTicker lp
257-
usVal = unitValue usC
258+
usVal = unitValue usC <> Ada.adaValueOf 2
258259
psVal = unitValue psC
259260
lVal = valueOf lC liquidity
260261
redeemer = Redeemer $ PlutusTx.toBuiltinData Close
@@ -292,7 +293,7 @@ remove us RemoveParams{..} = do
292293
inA = amountOf inVal rpCoinA
293294
inB = amountOf inVal rpCoinB
294295
(outA, outB) = calculateRemoval inA inB liquidity rpDiff
295-
val = psVal <> valueOf rpCoinA outA <> valueOf rpCoinB outB
296+
val = psVal <> valueOf rpCoinA outA <> valueOf rpCoinB outB <> Ada.adaValueOf 2
296297
redeemer = Redeemer $ PlutusTx.toBuiltinData Remove
297298

298299
lookups = Constraints.typedValidatorLookups usInst <>
@@ -332,7 +333,7 @@ add us AddParams{..} = do
332333
lC = mkCoin (liquidityCurrency us) $ lpTicker lp
333334
psVal = unitValue psC
334335
lVal = valueOf lC delL
335-
val = psVal <> valueOf apCoinA newA <> valueOf apCoinB newB
336+
val = psVal <> valueOf apCoinA newA <> valueOf apCoinB newB <> Ada.adaValueOf 2
336337
redeemer = Redeemer $ PlutusTx.toBuiltinData Add
337338

338339
lookups = Constraints.typedValidatorLookups usInst <>
@@ -374,7 +375,7 @@ swap us SwapParams{..} = do
374375
logInfo @String $ printf "oldA = %d, oldB = %d, old product = %d, newA = %d, newB = %d, new product = %d" oldA oldB (unAmount oldA * unAmount oldB) newA newB (unAmount newA * unAmount newB)
375376

376377
let inst = uniswapInstance us
377-
val = valueOf spCoinA newA <> valueOf spCoinB newB <> unitValue (poolStateCoin us)
378+
val = valueOf spCoinA newA <> valueOf spCoinB newB <> unitValue (poolStateCoin us) <> Ada.adaValueOf 2
378379

379380
lookups = Constraints.typedValidatorLookups inst <>
380381
Constraints.otherScript (Scripts.validatorScript inst) <>

plutus-use-cases/test/Spec/Uniswap.hs

+10-10
Original file line numberDiff line numberDiff line change
@@ -144,7 +144,7 @@ setupTokens = do
144144
ownPK <- Contract.ownFirstPaymentPubKeyHash
145145
cur <- Currency.mintContract ownPK [(fromString tn, fromIntegral (length wallets) * amount) | tn <- tokenNames]
146146
let cs = Currency.currencySymbol cur
147-
v = mconcat [Value.singleton cs (fromString tn) amount | tn <- tokenNames]
147+
v = Ada.adaValueOf 4 <> mconcat [Value.singleton cs (fromString tn) amount | tn <- tokenNames]
148148

149149
forM_ wallets $ \w -> do
150150
let pkh = mockWalletPaymentPubKeyHash w
@@ -288,7 +288,7 @@ instance ContractModel UniswapModel where
288288
, start <- [StartContract . WalletKey, StartContract . BadReqKey] ]
289289

290290
precondition s Start = not $ hasUniswapToken s
291-
precondition _ SetupTokens = True
291+
precondition s SetupTokens = null (s ^. contractState . exchangeableTokens)
292292
precondition s (CreatePool _ t1 a1 t2 a2) = hasUniswapToken s
293293
&& not (hasOpenPool s t1 t2)
294294
&& t1 /= t2
@@ -326,26 +326,26 @@ instance ContractModel UniswapModel where
326326
SetupTokens -> do
327327
-- Give 1000000 A, B, C, and D token to w1, w2, w3, w4
328328
-- The tokens will be given to each wallet in a UTxO that needs
329-
-- to have minAdaTxOut
330-
withdraw w1 $ Ada.toValue ((fromInteger . toInteger . length $ wallets) * Ledger.minAdaTxOut)
329+
-- to have 4 Ada each
330+
withdraw w1 $ Ada.adaValueOf ((fromInteger . toInteger . length $ wallets) * 4)
331331
-- Create the tokens
332332
ts <- forM tokenNames $ \t -> do
333333
tok <- createToken t
334334
mint (symAssetClassValue tok (toInteger $ length wallets * 1000000))
335335
return tok
336336
-- Give the tokens to the wallets
337337
forM_ wallets $ \ w -> do
338-
deposit w $ Ada.toValue Ledger.minAdaTxOut
338+
deposit w $ Ada.adaValueOf 4
339339
deposit w $ mconcat [ symAssetClassValue t 1000000 | t <- ts ]
340340
exchangeableTokens %= (Set.fromList ts <>)
341-
wait 21
341+
wait 41
342342

343343
Start -> do
344344
-- Create the uniswap token
345345
us <- createToken "Uniswap"
346346
uniswapToken .= Just us
347347
-- Pay to the UTxO for the uniswap factory
348-
withdraw w1 (Ada.toValue Ledger.minAdaTxOut)
348+
withdraw w1 $ Ada.adaValueOf 2
349349
wait 6
350350

351351
CreatePool w t1 a1 t2 a2 -> do
@@ -368,7 +368,7 @@ instance ContractModel UniswapModel where
368368
deposit w liqVal
369369
mint liqVal
370370
-- Pay to the pool
371-
withdraw w $ Ada.toValue Ledger.minAdaTxOut
371+
withdraw w $ Ada.adaValueOf 2
372372
withdraw w $ symAssetClassValue t1 a1
373373
<> symAssetClassValue t2 a2
374374
wait 5
@@ -470,7 +470,7 @@ instance ContractModel UniswapModel where
470470
withdraw w liqVal
471471
mint $ inv liqVal
472472
-- Return the 2 ada at the script to the wallet
473-
deposit w $ Ada.toValue Ledger.minAdaTxOut
473+
deposit w $ Ada.adaValueOf 2
474474
wait 5
475475

476476
Bad _ -> do
@@ -632,7 +632,7 @@ tests = testGroup "uniswap" [
632632
.&&. assertNoFailedTransactions)
633633
Uniswap.uniswapTrace
634634
-- TODO: turned off until there is an option to turn off cardano-ledger validation
635-
-- , testProperty "prop_Uniswap" $ withMaxSuccess 20 prop_Uniswap
635+
, testProperty "prop_Uniswap" $ withMaxSuccess 20 prop_Uniswap
636636
, testProperty "prop_UniswapAssertions" $ withMaxSuccess 1000 (propSanityCheckAssertions @UniswapModel)
637637
, testProperty "prop_NLFP" $ withMaxSuccess 250 prop_CheckNoLockedFundsProofFast
638638
]

plutus-use-cases/test/Spec/renderGuess.txt

+4-4
Original file line numberDiff line numberDiff line change
@@ -551,11 +551,11 @@ Balances Carried Forward:
551551
Ada: Lovelace: 100000000
552552

553553
==== Slot #1, Tx #0 ====
554-
TxId: c24c24fa7914c2ca2ce5a1a44a9d24a677e6f816c938ae05d37e5f85d2ddf920
554+
TxId: 4c73ff6825fa5bbd6e05245d859ebc096eba9909eba5d3294a41284152c6b236
555555
Fee: Ada: Lovelace: 184113
556556
Mint: -
557557
Signatures PubKey: 8d9de88fbf445b7f6c3875a14daba94caee2ffcb...
558-
Signature: 5840c9cacc039e6f96c16cceeaa26fdef77a4b5d...
558+
Signature: 5840be792f4a550f69e2438dbb51f2607ecb7fce...
559559
Inputs:
560560
---- Input 0 ----
561561
Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491)
@@ -578,7 +578,7 @@ Inputs:
578578

579579
Outputs:
580580
---- Output 0 ----
581-
Destination: Script: e0cb974cfeddc5c4b5687862163a5fddbd47db908b4cedc5ca38dd98
581+
Destination: Script: dc5028161e8213a480e88184c842558c88071f359f8a4aa37b9e96dd
582582
Value:
583583
Ada: Lovelace: 8000000
584584

@@ -629,6 +629,6 @@ Balances Carried Forward:
629629
Value:
630630
Ada: Lovelace: 100000000
631631

632-
Script: e0cb974cfeddc5c4b5687862163a5fddbd47db908b4cedc5ca38dd98
632+
Script: dc5028161e8213a480e88184c842558c88071f359f8a4aa37b9e96dd
633633
Value:
634634
Ada: Lovelace: 8000000

0 commit comments

Comments
 (0)