diff --git a/plutarch-validators/WhalePoolsDex/PContracts/PBalancePool.hs b/plutarch-validators/WhalePoolsDex/PContracts/PBalancePool.hs index d8389dd..566273f 100644 --- a/plutarch-validators/WhalePoolsDex/PContracts/PBalancePool.hs +++ b/plutarch-validators/WhalePoolsDex/PContracts/PBalancePool.hs @@ -188,7 +188,7 @@ verifyGEquality :: ) verifyGEquality = plam $ \leftSideMultiplicator rightSideRaw prevTokenBalance tokenG tokenWeight -> let - tokenBalanceIntLength = pIntLength # prevTokenBalance + tokenBalanceIntLength = pIntLength # rightSideRaw degree = pdiv # pDen # tokenWeight @@ -310,9 +310,12 @@ validSwap = plam $ \prevState' newState' prevPoolConfig newPoolConfig newGX newT prevInvariantLength = pIntLength # prevInvariant newInvarianRounded = roundTo # (newGX #* newGY) # prevInvariantLength - + invariantRoundingDiff = newInvarianRounded - prevInvariant -- Verify that new value of invariant equals to previous - newInvariantIsCorrect = prevInvariant #== newInvarianRounded + newInvariantIsCorrect = pif + ( invariantRoundingDiff #<= 0 ) + ( (-1) #<= invariantRoundingDiff ) + ( invariantRoundingDiff #<= (1) ) correctTokensUpdate = pif @@ -371,26 +374,30 @@ correctLpTokenDelta :: :--> PInteger :--> PBool ) -correctLpTokenDelta = plam $ \lpIssued lpDelta tokenDelta tokenBalance tokenWeight tokenG tokenT -> +correctLpTokenDelta = plam $ \lpIssued lpDelta tokenDelta tokenBalance tokenWeight tokenG tokenT -> unTermCont $ do let tokenBalanceIntLength = pIntLength # tokenBalance leftPart = roundTo # ((pabs #tokenDelta) * lpIssued) # tokenBalanceIntLength rightPart = roundTo # (tokenBalance * (pabs # lpDelta)) # tokenBalanceIntLength - leftRightPartDiff = leftPart - rightPart + calcTokenDelta = (pdiv # (lpDelta #* tokenBalance) # lpIssued) + + tokensDiff = calcTokenDelta - tokenDelta + + correctTokenError = pif + ( tokensDiff #<= 0 ) + ( (-1) #<= tokensDiff ) + ( tokensDiff #<= (1) ) + + correctTokenIn = correctTokenError #&& (calcTokenDelta #<= tokenDelta) - correctTokenIn = pif - ( leftRightPartDiff #<= 0 ) - ( (-1) #<= leftRightPartDiff ) - ( leftRightPartDiff #<= (1) ) - correctTokenValue = pif ( (pmod # pDen # tokenWeight) #== 0 ) ( verifyGEquality # 1 # (tokenBalance + tokenDelta) # tokenBalance # tokenG # tokenWeight ) ( verifyTExpEquality # tokenT # (tokenBalance + tokenDelta) ) - - in correctTokenIn #&& correctTokenValue + + pure $ correctTokenIn #&& correctTokenValue validDepositRedeemAllTokens :: ClosedTerm diff --git a/plutarch-validators/WhalePoolsDex/PMintingValidators.hs b/plutarch-validators/WhalePoolsDex/PMintingValidators.hs index 4824509..277961f 100644 --- a/plutarch-validators/WhalePoolsDex/PMintingValidators.hs +++ b/plutarch-validators/WhalePoolsDex/PMintingValidators.hs @@ -21,7 +21,7 @@ import PlutusLedgerApi.V1.Crypto (PubKeyHash) import PlutusLedgerApi.V1.Contexts cfgForMintingValidator :: Config -cfgForMintingValidator = Config DoTracing +cfgForMintingValidator = Config NoTracing wrapMintingValidator :: PIsData rdmr => diff --git a/plutarch-validators/WhalePoolsDex/PValidators.hs b/plutarch-validators/WhalePoolsDex/PValidators.hs index 2f3253a..2e6d1d8 100644 --- a/plutarch-validators/WhalePoolsDex/PValidators.hs +++ b/plutarch-validators/WhalePoolsDex/PValidators.hs @@ -26,7 +26,7 @@ import Plutarch.Unsafe (punsafeCoerce) import Plutarch.Internal cfgForValidator :: Config -cfgForValidator = Config DoTracing +cfgForValidator = Config NoTracing wrapValidator :: (PIsData dt, PIsData rdmr) => diff --git a/plutarch-validators/test/Eval.hs b/plutarch-validators/test/Eval.hs index d04ed8f..a044b93 100644 --- a/plutarch-validators/test/Eval.hs +++ b/plutarch-validators/test/Eval.hs @@ -19,7 +19,6 @@ evalConfig = Config NoTracing evalWithArgs :: ClosedTerm a -> [Data] -> Either Text (ExBudget, [Text], Program DeBruijn DefaultUni DefaultFun ()) evalWithArgs x args = do cmp <- compile evalConfig x - --traceM $ "Compiled:" let (escr, budg, trc) = evalScriptHuge $ applyArguments cmp args scr <- left (pack . show) escr pure (budg, trc, unScript scr) diff --git a/plutarch-validators/test/Gen/BalancePoolGen.hs b/plutarch-validators/test/Gen/BalancePoolGen.hs index ccec6bd..47fedf9 100644 --- a/plutarch-validators/test/Gen/BalancePoolGen.hs +++ b/plutarch-validators/test/Gen/BalancePoolGen.hs @@ -87,6 +87,7 @@ instance ToTxInfo BalancePool where } feeDen = 100000 +precisionAdditionalDec = 10 daoMintingPurpose :: BalancePool -> ScriptPurpose daoMintingPurpose BalancePool{..} = Rewarding $ List.head (daoPolicy config) @@ -136,20 +137,21 @@ genBalancePool adminsPkhs threshold lpFeeIsEditable = do stakeHash <- genPkh - -- todo: error on big values such as 10000000000000000 - (xQty :: Integer) <- integral (Range.constant 10000000000 10000000000000000) - -- (yQty :: Int) <- integral (Range.constant 10000000000 10000000000000000) - - -- todo: doesn't work for non 2/8 pools - -- (xWeight :: Integer) <- integral (Range.constant 1 5) + -- todo: error on big values such as 10 000 000 000 000 000 + (yQty :: Int) <- integral (Range.constant 10000000000 10000000000000000) + (xWeight :: Integer) <- integral (Range.constant 1 5) + (xQty :: Integer) <- integral (Range.constant 1000000000 1000000000000) poolFee <- integral (Range.constant 80000 feeDen) - trFee <- integral (Range.constant 0 1000) + trFee <- integral (Range.constant 1 1000) + -- let trFee = 683 + -- let poolFee = 86472 + -- let xWeight = 5 + -- let yWeight = 5 + -- let xQty = 303457031315 treasuryAddress <- genValidatorHash let - --xQty = 1325954420705621 - xWeight = 2 yWeight = 10 - xWeight yQty = xQty * yWeight @@ -161,7 +163,7 @@ genBalancePool adminsPkhs threshold lpFeeIsEditable = do yPartLength = toInteger $ RIO.length . show $ xQty xValueLength = toInteger $ RIO.length . show $ yQty - maxPrecision = (if (yPartLength > xValueLength) then yPartLength else xValueLength) + maxPrecision = (if (yPartLength > xValueLength) then yPartLength else xValueLength) + precisionAdditionalDec -- invariant = (xQtyFloat**(xWeightFloat / 10)) * (yQtyFloat**(yWeightFloat / 10)) invariantT = ((BigDecimal xQty 0) ** (fromRational $ (fromIntegral xWeight) / 10)) * ( (BigDecimal yQty 0) ** (fromRational $ (fromIntegral yWeight) / 10)) @@ -192,7 +194,6 @@ genBalancePool adminsPkhs threshold lpFeeIsEditable = do } poolValue = mkValues ((\(ac, qty) -> mkValue ac (fromIntegral qty)) `RIO.map` [(x, xQty), (y, yQty), (nft, nftQty), (lq, lqQty)]) mempty - pure $ BalancePool poolConfig stakeHash poolValue --- Test utils --- @@ -204,11 +205,7 @@ calculateGandTSwap baseAssetBalance baseAssetWeight quoteAssetBalance quoteAsset yPartLength = toInteger $ RIO.length . show $ quoteAssetBalance xValueLength = toInteger $ RIO.length . show $ (baseAssetBalance + baseIn) - maxPrecisionByToken = (if (yPartLength > xValueLength) then yPartLength else xValueLength) - - maxPrecision = (if (yPartLength > xValueLength) then yPartLength else xValueLength) + 15 - - xValuePrecise = 10 ^ xValueLength + maxPrecision = (if (yPartLength > xValueLength) then yPartLength else xValueLength) + precisionAdditionalDec invariantLength = toInteger $ RIO.length . show $ prevInvariant @@ -232,7 +229,7 @@ calculateGandTSwap baseAssetBalance baseAssetWeight quoteAssetBalance quoteAsset -- test invDivision = invariantFloat / xInInvariantWithDegree - invDivisionInReverseDegree = nthRoot (invDivision ** 10) (fromInteger quoteAssetWeghit) (DOWN, (Just . toInteger $ 10)) + invDivisionInReverseDegree = nthRoot (invDivision ** 10) (fromInteger quoteAssetWeghit) (DOWN, (Just . toInteger $ 0)) -- denum = 10 ^ (yPartLength - xValueLength) invDivisionInReverseDegreeBigDecimalRounded = takeNBigDecimal invDivisionInReverseDegree (yPartLength) @@ -245,14 +242,8 @@ calculateGandTSwap baseAssetBalance baseAssetWeight quoteAssetBalance quoteAsset gY = takeNBigDecimal gYDouble (maxPrecision) -- ((getValue gYDouble)) tY = takeNBigDecimal tGDouble (maxPrecision) -- ((getValue tGDouble)) - - - -------- Max test --------- - - - let - spotPriceWithoutFee = (((BigDecimal baseAssetBalance 0)) / ((BigDecimal baseAssetWeight 0))) / (((BigDecimal quoteAssetBalance 0)) / ((BigDecimal quoteAssetWeghit 0))) :: BigDecimal - spotPriceWithFee = spotPriceWithoutFee * (fromRational $ (fromIntegral (lpFee - treasuryFee) / fromIntegral (feeDen))) + spotPriceWithoutFee = (((BigDecimal baseAssetBalance 0)) / ((BigDecimal baseAssetWeight 0))) / (((BigDecimal quoteAssetBalance 0)) / ((BigDecimal quoteAssetWeghit 0))) :: BigDecimal + spotPriceWithFee = spotPriceWithoutFee * (fromRational $ (fromIntegral (lpFee - treasuryFee) / fromIntegral (feeDen))) pure (gX, tX, gY, tY, yToSwap) @@ -268,9 +259,7 @@ calculateGandTDeposit baseAssetBalance baseAssetWeight quoteAssetBalance quoteAs yPartLength = toInteger $ RIO.length . show $ quoteAssetBalance xValueLength = toInteger $ RIO.length . show $ (xValueFloat + xToDeposit) - maxPrecisionByToken = (if (yPartLength > xValueLength) then yPartLength else xValueLength) - - maxPrecision = (if (yPartLength > xValueLength) then yPartLength else xValueLength) + 5 + maxPrecision = (if (yPartLength > xValueLength) then yPartLength else xValueLength) xValueFloat = (fromIntegral baseAssetBalance) :: BigDecimal invariantFloat = fromIntegral prevInvariant :: BigDecimal @@ -302,15 +291,16 @@ calculateGandTDeposit baseAssetBalance baseAssetWeight quoteAssetBalance quoteAs pure (gX, tX, gY, tY, getDecimalNum xToDeposit, getDecimalNum yToDeposit, getDecimalNum lqIssuedDec) calculateGandTRedeem :: MonadGen m => Integer -> Integer -> Integer -> Integer -> Integer -> Integer -> Integer -> Integer -> Integer -> m (Integer, Integer, Integer, Integer, Integer, Integer) -calculateGandTRedeem baseAssetBalance baseAssetWeight quoteAssetBalance quoteAssetWeghit lqRedeemI lqSupply lpFee treasuryFee prevInvariant = do +calculateGandTRedeem baseAssetBalance baseAssetWeight quoteAssetBalance quoteAssetWeghit lqRedeem lqSupply lpFee treasuryFee prevInvariant = do let - lqLength = toInteger $ RIO.length . show $ lqSupply - yPartLength = toInteger $ RIO.length . show $ quoteAssetBalance - xValueLength = toInteger $ RIO.length . show $ baseAssetBalance + lqRedeemDec = (fromIntegral lqRedeem) :: BigDecimal + xToRedeem = roundBD ((lqRedeemDec * xValueFloat) / lqSupplyDouble) (DOWN, (Just . toInteger $ 0)) + yToRedeem = roundBD ((lqRedeemDec * yValueFloat) / lqSupplyDouble) (DOWN, (Just . toInteger $ 0)) - maxPrecisionByToken = (if (yPartLength > xValueLength) then yPartLength else xValueLength) + yPartLength = toInteger $ RIO.length . show $ quoteAssetBalance + xValueLength = toInteger $ RIO.length . show $ (xValueFloat - xToRedeem) - maxPrecision = (if (yPartLength > xValueLength) then yPartLength else xValueLength) + 10 + maxPrecision = (if (yPartLength > xValueLength) then yPartLength else xValueLength) xValueFloat = (fromIntegral baseAssetBalance) :: BigDecimal invariantFloat = fromIntegral prevInvariant :: BigDecimal @@ -320,12 +310,9 @@ calculateGandTRedeem baseAssetBalance baseAssetWeight quoteAssetBalance quoteAss treasuryFeeNum = (fromIntegral treasuryFee) :: BigDecimal lpFeeNum = (fromIntegral lpFee) :: BigDecimal lqSupplyDouble = (fromIntegral lqSupply) :: BigDecimal - lqRedeemDouble = (fromIntegral lqRedeemI) :: BigDecimal - - xToRedeem = roundBD ((lqRedeemDouble * xValueFloat) / lqSupplyDouble) (UP, (Just . toInteger $ 0)) - yToRedeem = roundBD ((lqRedeemDouble * yValueFloat) / lqSupplyDouble) (UP, (Just . toInteger $ 0)) - + -- no decimals after point xInInvariantBigDecimal = xValueFloat - xToRedeem + -- xInInvariantBigDecimal in degree `(xWieght / 10)` xInInvariantWithDegree = (xInInvariantBigDecimal ** (fromRational $ ((fromIntegral baseAssetWeight) / 10))) -- g xInInvariantWith1Degree = (xInInvariantBigDecimal) ** (fromRational $ (1 / 10)) -- t @@ -338,7 +325,7 @@ calculateGandTRedeem baseAssetBalance baseAssetWeight quoteAssetBalance quoteAss tGDoubleTest = nthRoot gBaseRounded 10 (DOWN, (Just . toInteger $ maxPrecision)) tGDouble = nthRoot gBaseRounded 10 (DOWN, (Just . toInteger $ maxPrecision)) - + gY = takeNBigDecimal gYDouble (maxPrecision) tY = takeNBigDecimal tGDouble (maxPrecision) @@ -364,9 +351,7 @@ correctSwap = (yCS, yTN) = unAssetClass (poolY config) xValue = valueOf value xCS xTN yValue = valueOf value yCS yTN - - xToSwap <- integral (Range.constant 10000 10000000) - + xToSwap <- integral (Range.constant 100 xValue) (gX, tX, gY, tY, yToSwap) <- calculateGandTSwap xValue (weightX config) yValue (weightY config) (xToSwap) (poolFeeNum config) (treasuryFee config) (invariant config) let -- going to withdraw all pool x and y value @@ -585,9 +570,8 @@ correctRedeem = yValue = valueOf value yCS yTN lqValue = valueOf value lqCS lqTN lqIssued = 0x7fffffffffffffff - lqValue - + -- let lqToRedeem = 85989149586251 lqToRedeem <- integral (Range.constant 1 ((lqIssued `div` 2) - 1)) - (gX, tX, gY, tY, xToRedeem, yToRedeem) <- calculateGandTRedeem xValue (weightX config) yValue (weightY config) (lqToRedeem) lqIssued (poolFeeNum config) (treasuryFee config) (invariant config) let diff --git a/plutarch-validators/test/Tests/BalancePool.hs b/plutarch-validators/test/Tests/BalancePool.hs index 922d8ee..086d4ad 100644 --- a/plutarch-validators/test/Tests/BalancePool.hs +++ b/plutarch-validators/test/Tests/BalancePool.hs @@ -37,7 +37,7 @@ import Debug.Trace import Data.Text as T (pack, unpack, splitOn) balancePool = testGroup "BalancePool" - ((genTests `map` [redeemAllTests])) + ((genTests `map` [swapTests, depositAllTests, redeemAllTests])) genTests BalancePoolTestGroup{..} = let @@ -92,7 +92,7 @@ cutFloatD toCut maxInt = let in read $ T.unpack . Prelude.head $ splitted actionWithValidSignersQty :: Int -> (BalancePool -> Gen BalancePoolActionResult) -> Pool.BalancePoolAction -> TestResult -> Property -actionWithValidSignersQty sigsQty poolUpdater action testResultShouldBe = withTests 10 $ property $ do +actionWithValidSignersQty sigsQty poolUpdater action testResultShouldBe = withShrinks 1 $ withTests 10 $ property $ do let threshold = 2