Redeem & Swap for random weights and fees fixes.

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 

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 =>

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) =>

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)

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

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