Skip to content

Commit 6a78bb4

Browse files
Bromel777Bromel777
committed
fix change stake policy
1 parent 4e29128 commit 6a78bb4

File tree

4 files changed

+30
-70
lines changed

4 files changed

+30
-70
lines changed

‎cardano-dex-contracts-onchain/ErgoDex/PContracts/PPool.hs‎

Lines changed: 5 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -205,40 +205,14 @@ findPoolOutput =
205205
)
206206
(const $ ptraceError "Pool output not found")
207207

208-
poolCheckStakeChange :: ClosedTerm (PoolConfig :--> PTxInfo :--> PDatum :--> PBool)
209-
poolCheckStakeChange = plam $ \cfg txInfo nextPoolDatum -> unTermCont $ do
208+
poolCheckStakeChange :: ClosedTerm (PoolConfig :--> PTxInfo :--> PBool)
209+
poolCheckStakeChange = plam $ \cfg txInfo -> unTermCont $ do
210210
valueMint <- tletField @"mint" txInfo
211211
policies <- tletField @"stakeAdminPolicy" cfg
212-
213-
PDatum poolDatum <- pmatchC nextPoolDatum
214-
pcfg <- tletUnwrap $ ptryFromData @(PoolConfig) $ poolDatum
215-
216-
prevConf <- pletFieldsC @'["poolNft", "poolX", "poolY", "poolLq", "feeNum", "lqBound"] cfg
217-
newConf <- pletFieldsC @'["poolNft", "poolX", "poolY", "poolLq", "feeNum", "lqBound"] pcfg
218-
let
219-
prevPoolNft = getField @"poolNft" prevConf
220-
prevPoolX = getField @"poolX" prevConf
221-
prevPoolY = getField @"poolY" prevConf
222-
prevPoolLq = getField @"poolLq" prevConf
223-
prevPoolFeeNum = getField @"feeNum" prevConf
224-
225-
newPoolNft = pfromData $ getField @"poolNft" newConf
226-
newPoolX = pfromData $ getField @"poolX" newConf
227-
newPoolY = pfromData $ getField @"poolY" newConf
228-
newPoolLq = pfromData $ getField @"poolLq" newConf
229-
newPoolFeeNum = pfromData $ getField @"feeNum" newConf
230-
231-
validPoolParams =
232-
prevPoolNft #== newPoolNft #&&
233-
prevPoolX #== newPoolX #&&
234-
prevPoolY #== newPoolY #&&
235-
prevPoolLq #== newPoolLq #&&
236-
prevPoolFeeNum #== newPoolFeeNum
237-
212+
let
238213
policyCS = pfromData $ phead # policies
239214
mintedAc = assetClass # policyCS # poolStakeChangeMintTokenNameP
240-
241-
pure $ (assetClassValueOf # valueMint # mintedAc #== 1) #&& validPoolParams
215+
pure $ assetClassValueOf # valueMint # mintedAc #== 1
242216

243217
poolValidatorT :: ClosedTerm (PoolConfig :--> PoolRedeemer :--> PScriptContext :--> PBool)
244218
poolValidatorT = plam $ \conf redeemer' ctx' -> unTermCont $ do
@@ -306,6 +280,6 @@ poolValidatorT = plam $ \conf redeemer' ctx' -> unTermCont $ do
306280
scriptPreserved = succAddr #== selfAddr -- validator, staking cred preserved
307281
valid = pmatch action $ \case
308282
Swap -> swapAllowed #&& selfIdentity #&& confPreserved #&& scriptPreserved #&& dlq #== 0 #&& validSwap # conf # s0 # dx # dy -- liquidity left intact and swap is performed properly
309-
ChangeStakingPool -> poolCheckStakeChange # conf # txinfo' # succD
283+
ChangeStakingPool -> poolCheckStakeChange # conf # txinfo'
310284
_ -> selfIdentity #&& confPreserved #&& scriptPreserved #&& validDepositRedeem # s0 # dx # dy # dlq -- either deposit or redeem is performed properly
311285
pure valid

‎cardano-dex-contracts-onchain/ErgoDex/PContracts/PPoolStakeChangeMintPolicy.hs‎

Lines changed: 24 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ poolStakeChangeMintPolicyValidatorT poolNft adminsPkhs threshold = plam $ \_ ctx
4141
poolInputResolved = getField @"resolved" poolInput
4242

4343
poolInputValue <- tletField @"value" poolInputResolved
44+
poolInputConfig <- tlet $ extractPoolConfig # poolInputResolved
4445

4546
successor <- tlet $ findPoolOutput # poolNft # outputs
4647

@@ -53,8 +54,29 @@ poolStakeChangeMintPolicyValidatorT poolNft adminsPkhs threshold = plam $ \_ ctx
5354
prevCred <- tletField @"credential" selfAddr
5455
newCred <- tletField @"credential" succAddr
5556

56-
newAdminPolicy <- tletField @"stakeAdminPolicy" succPoolOutputDatum'
57+
prevConf <- pletFieldsC @'["poolNft", "poolX", "poolY", "poolLq", "feeNum", "lqBound"] poolInputConfig
58+
newConf <- pletFieldsC @'["poolNft", "poolX", "poolY", "poolLq", "feeNum", "lqBound", "stakeAdminPolicy"] succPoolOutputDatum'
5759
let
60+
prevPoolNft = getField @"poolNft" prevConf
61+
prevPoolX = getField @"poolX" prevConf
62+
prevPoolY = getField @"poolY" prevConf
63+
prevPoolLq = getField @"poolLq" prevConf
64+
prevPoolFeeNum = getField @"feeNum" prevConf
65+
66+
newPoolNft = pfromData $ getField @"poolNft" newConf
67+
newPoolX = pfromData $ getField @"poolX" newConf
68+
newPoolY = pfromData $ getField @"poolY" newConf
69+
newPoolLq = pfromData $ getField @"poolLq" newConf
70+
newPoolFeeNum = pfromData $ getField @"feeNum" newConf
71+
newAdminPolicy = pfromData $ getField @"stakeAdminPolicy" newConf
72+
73+
validPoolParams =
74+
prevPoolNft #== newPoolNft #&&
75+
prevPoolX #== newPoolX #&&
76+
prevPoolY #== newPoolY #&&
77+
prevPoolLq #== newPoolLq #&&
78+
prevPoolFeeNum #== newPoolFeeNum
79+
5880
correctFinalPolicy = pnull # newAdminPolicy
5981

6082
validDelta = poolInputValue #== poolOutputValue
@@ -67,4 +89,4 @@ poolStakeChangeMintPolicyValidatorT poolNft adminsPkhs threshold = plam $ \_ ctx
6789

6890
validThreshold = threshold #<= validSignaturesQty
6991

70-
pure $ validDelta #&& correctFinalPolicy #&& validCred #&& validThreshold #&& correctPoolInput
92+
pure $ validDelta #&& validPoolParams #&& correctFinalPolicy #&& validCred #&& validThreshold #&& correctPoolInput

‎cardano-dex-contracts-onchain/test/Tests/Pool.hs‎

Lines changed: 0 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,6 @@ checkPool = testGroup "CheckPoolContract"
3333
[ HH.testProperty "pool_validator_hash_is_correct" validPoolHash
3434
, HH.testProperty "pool_change_stake_part_is_correct (correct minting)" successPoolChangeStakePartCorrectMinting
3535
, HH.testProperty "pool_change_stake_part_is_incorrect (incorrect minting)" failedPoolChangeStakePartIncorrectMinting
36-
, HH.testProperty "pool_change_stake_part_is_incorrect (incorrect datum)" failedPoolChangeStakePartIncorrectDatum
3736
, HH.testProperty "pool_deposit_is_correct" successPoolDeposit
3837
, HH.testProperty "pool_swap_is_correct" successPoolSwap
3938
, HH.testProperty "pool_swap_insufficient_lq_for_bound" poolSwapInsufficientLiqudityForBound
@@ -385,41 +384,6 @@ failedPoolChangeStakePartIncorrectMinting = property $ do
385384

386385
result === Left ()
387386

388-
failedPoolChangeStakePartIncorrectDatum :: Property
389-
failedPoolChangeStakePartIncorrectDatum = property $ do
390-
let (x, y, nft, lq) = genAssetClasses
391-
392-
(incorretX, incorrectY, incorrectNft, incorrectlq) <- forAll genRandomAssetClasses
393-
394-
stakeAdminPkh <- forAll genPkh
395-
newPkhForSC <- forAll genPkh
396-
let
397-
previousSc = Just $ StakingHash (PubKeyCredential stakeAdminPkh)
398-
newSc = Just $ StakingHash (PubKeyCredential newPkhForSC)
399-
mintingCS = CurrencySymbol $ getScriptHash $ scriptHash (unMintingPolicyScript (poolStakeChangeMintPolicyValidator nft [stakeAdminPkh] 1))
400-
401-
poolTxRef <- forAll genTxOutRef
402-
let
403-
(pcfg, previousPdh) = genPConfig x y nft lq 1 [mintingCS] 0
404-
405-
scMintAssetClass = mkAssetClass mintingCS poolStakeChangeMintTokenName
406-
407-
mintValue = mkValue scMintAssetClass 1
408-
409-
(_, newPdh) = genPConfig x y incorrectNft lq 1 [] 0
410-
poolTxIn = genPTxInWithSC poolTxRef previousSc previousPdh x 10 y 10 lq 9223372036854775797 nft 1 10000
411-
poolTxOut = genPTxOutWithSC newPdh newSc x 10 y 10 lq 9223372036854775797 nft 1 10000
412-
413-
txInfo = mkTxInfoWithSignaturesAndMinting [poolTxIn] poolTxOut [stakeAdminPkh] mintValue
414-
purpose = mkPurpose poolTxRef
415-
416-
cxtToData = toData $ mkContext txInfo purpose
417-
poolRedeemToData = toData $ mkPoolRedeemer 0 Pool.ChangeStakingPool
418-
419-
result = eraseLeft $ evalWithArgs (wrapValidator PPool.poolValidatorT) [pcfg, poolRedeemToData, cxtToData]
420-
421-
result === Left ()
422-
423387
poolDepositRedeemerIncorrectIx :: Property
424388
poolDepositRedeemerIncorrectIx = property $ do
425389
let (x, y, nft, lq) = genAssetClasses

‎cardano-dex-contracts-onchain/test/Tests/StakeMinting.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@ correctCurrencySymbol :: Property
5151
correctCurrencySymbol = withTests 1 $ property $ do
5252
let
5353
stakeAdminPkh = (PubKeyHash $ BuiltinByteString . mkByteString $ T.pack "61616161616161616161616161616161616161616161616161616161")
54-
correctCSValue = Plutus.CurrencySymbol $ BuiltinByteString . mkByteString $ T.pack "d7acc15d3f8fd5fd9630d8525716be72730e7acb271faef89d6c7a3e"
54+
correctCSValue = Plutus.CurrencySymbol $ BuiltinByteString . mkByteString $ T.pack "c209badc9dc4f01c4930dcdfd8f8d902f8739ea0e21344d1d407fecf"
5555
(_, _, nft, _) = genAssetClasses
5656
origCurSymbol = Plutus.CurrencySymbol $ getScriptHash $ scriptHash (Plutus.unMintingPolicyScript (poolStakeChangeMintPolicyValidator nft [stakeAdminPkh] 1))
5757
origCurSymbol === correctCSValue

0 commit comments

Comments
 (0)