Dev-7. Weighted pools. For audit (#29)

* Balance Pool. Swap, Deposit, Redeem, DepositSingleAsset operations * cleanup * fix treasury validation * Redeem & Swap for random weights and fees fixes. * Fixes and looped test example fixed. * DEV-7. Balance pool. Optimizations (#36) * DEV-7. Balance pools. Deposit, Redeem balance orders contracts (#30) * add daoBalanceMintPolicyValidator * DEV-7. Balance pool: optimizations, redundant logic removed. ValidDelta bug fix (#39) * Balance pool. Optimizations, redundant logic removed, validDelta bug fix * update balanceFeeSwitch * remove redundant variable in ppow10 * Fix incorrect flow in deposit, redeem contracts * Balance pool. New approach (#43) * New approach for balance pools * remove invariant * fix balance contract --------- Co-authored-by: Ilya <[email protected]> --------- Co-authored-by: AOranov <[email protected]> Co-authored-by: Alex Oranov <[email protected]> Co-authored-by: Ilya <[email protected]>
splashprotocol · Jun 2, 2024 · 81e4288 · 81e4288
1 parent 223a06c
commit 81e4288
Show file tree

Hide file tree

Showing 27 changed files with 2,376 additions and 246 deletions.
diff --git a/plutarch-validators/PExtra/Integer.hs b/plutarch-validators/PExtra/Integer.hs
@@ -1,6 +1,8 @@
 module PExtra.Integer (
     podd,
     peven,
+    ppow,
+    ppow10
 ) where
 
 import Plutarch.Prelude
@@ -10,3 +12,78 @@ podd = phoistAcyclic $ plam $ \n -> (pmod # n # 2) #== 1
 
 peven :: Term s (PInteger :--> PBool)
 peven = phoistAcyclic $ plam $ \n -> (pmod # n # 2) #== 0
+
+ppow :: Term s (PInteger :--> PInteger :--> PInteger)
+ppow = phoistAcyclic $
+    plam $ \a n ->
+        pif
+            (n #< 0)
+            perror
+            (pexp' # a # n)
+
+-- pexp' doesn't check if n is negative
+-- the helper function is used so n is only
+-- checked as positive once and not on
+-- recursive calls
+pexp' :: Term s (PInteger :--> PInteger :--> PInteger)
+pexp' = phoistAcyclic $
+    pfix #$ plam $ \self a n ->
+        pif
+            (n #== 0)
+            1
+            $ pif (podd # n) a 1 * (psquare #$ self # a # (pdiv # n # 2))
+
+ppow10 :: Term s (PInteger :--> PInteger)
+ppow10 = phoistAcyclic $
+    plam $ \n ->
+        pif
+            (n #< 0)
+            perror
+            (pexp10' # n)
+
+pexp10' :: Term s (PInteger :--> PInteger)
+pexp10' = phoistAcyclic $
+    pfix #$ plam $ \self n ->
+        pif
+            (n #< 12)
+            (pexp10constant' # n)
+            $ pif (podd # n) (pconstant 10) 1 * (psquare #$ self # (pdiv # n # 2))
+
+-- max degree is 11
+pexp10constant' :: Term s (PInteger :--> PInteger)
+pexp10constant' = phoistAcyclic $
+    plam $ \n ->
+        pif
+            ( n #== 11 )
+            (pconstant 100000000000)
+            ( pif (n #== 10)
+              (pconstant 10000000000)
+              ( pif (n #== 9)
+                (pconstant 1000000000)
+                ( pif (n #== 8)
+                  (pconstant 100000000)
+                  ( pif (n #== 7)
+                    (pconstant 10000000)
+                    ( pif (n #== 6)
+                      (pconstant 1000000)
+                      ( pif (n #== 5)
+                        (pconstant 100000)
+                        ( pif (n #== 4)
+                          (pconstant 10000)
+                          ( pif (n #== 3)
+                            (pconstant 1000)
+                            ( pif (n #== 2)
+                              (pconstant 100)
+                              $ pif (n #== 1) (pconstant 10) (pconstant 1)
+                            )
+                          )
+                        )
+                      )
+                    )
+                  )
+                )
+              )
+            )
+
+psquare :: Term s (PInteger :--> PInteger)
+psquare = phoistAcyclic $ plam $ \x' -> plet x' $ \x -> x * x
diff --git a/plutarch-validators/PExtra/Num.hs b/plutarch-validators/PExtra/Num.hs
diff --git a/plutarch-validators/WhalePoolsDex/Contracts/BalancePool.hs b/plutarch-validators/WhalePoolsDex/Contracts/BalancePool.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module WhalePoolsDex.Contracts.BalancePool (
+    BalancePoolConfig (..),
+    BalancePoolAction (..),
+    BalancePoolRedeemer (..)
+) where
+
+import PlutusTx.Builtins
+import qualified PlutusTx
+import PlutusLedgerApi.V1.Value
+import PlutusLedgerApi.V1.Crypto  (PubKeyHash)
+import PlutusLedgerApi.V1.Scripts (ValidatorHash)
+import PlutusLedgerApi.V1.Credential
+
+data BalancePoolConfig = BalancePoolConfig
+    { poolNft     :: AssetClass
+    , poolX       :: AssetClass
+    , poolY       :: AssetClass
+    , poolLq      :: AssetClass
+    , poolFeeNum  :: Integer
+    , treasuryFee :: Integer
+    , treasuryX   :: Integer
+    , treasuryY   :: Integer
+    , daoPolicy   :: [StakingCredential]
+    , treasuryAddress :: ValidatorHash
+    }
+    deriving stock (Show)
+
+PlutusTx.makeIsDataIndexed ''BalancePoolConfig [('BalancePoolConfig, 0)]
+
+data BalancePoolAction = Deposit | Redeem | Swap | DAOAction
+    deriving (Show)
+
+instance PlutusTx.FromData BalancePoolAction where
+    {-# INLINE fromBuiltinData #-}
+    fromBuiltinData d = matchData' d (\_ _ -> Nothing) (const Nothing) (const Nothing) chooseAction (const Nothing)
+      where
+        chooseAction i
+            | i == 0 = Just Deposit
+            | i == 1 = Just Redeem
+            | i == 2 = Just Swap
+            | i == 3 = Just DAOAction
+            | otherwise = Nothing
+
+instance PlutusTx.UnsafeFromData BalancePoolAction where
+    {-# INLINE unsafeFromBuiltinData #-}
+    unsafeFromBuiltinData = maybe (Prelude.error "Couln't convert BalancePoolAction from builtin data") id . PlutusTx.fromBuiltinData
+
+instance PlutusTx.ToData BalancePoolAction where
+    {-# INLINE toBuiltinData #-}
+    toBuiltinData a = mkI $ case a of
+        Deposit -> 0
+        Redeem -> 1
+        Swap -> 2
+        DAOAction -> 3
+
+data BalancePoolRedeemer = BalancePoolRedeemer
+    { action :: BalancePoolAction
+    , selfIx :: Integer
+    }
+    deriving (Show)
+
+PlutusTx.makeIsDataIndexed ''BalancePoolRedeemer [('BalancePoolRedeemer, 0)]
diff --git a/plutarch-validators/WhalePoolsDex/Contracts/Proxy/DepositBalance.hs b/plutarch-validators/WhalePoolsDex/Contracts/Proxy/DepositBalance.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module WhalePoolsDex.Contracts.Proxy.DepositBalance where
+
+import PlutusLedgerApi.V1.Crypto (PubKeyHash)
+import PlutusLedgerApi.V1.Value
+import qualified PlutusTx
+import PlutusTx.Builtins
+
+data DepositBalanceConfig = DepositBalanceConfig
+    { poolNft :: AssetClass
+    , tokenA  :: AssetClass
+    , tokenB  :: AssetClass
+    , tokenLp :: AssetClass
+    , exFee   :: Integer
+    , rewardPkh :: PubKeyHash
+    , stakePkh  :: Maybe PubKeyHash
+    , collateralAda :: Integer
+    }
+    deriving stock (Show)
+
+PlutusTx.makeIsDataIndexed ''DepositBalanceConfig [('DepositBalanceConfig, 0)]
diff --git a/plutarch-validators/WhalePoolsDex/Contracts/Proxy/RedeemBalance.hs b/plutarch-validators/WhalePoolsDex/Contracts/Proxy/RedeemBalance.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module WhalePoolsDex.Contracts.Proxy.RedeemBalance where
+
+import PlutusLedgerApi.V1.Crypto (PubKeyHash)
+import PlutusLedgerApi.V1.Value
+import qualified PlutusTx
+import PlutusTx.Builtins
+
+data RedeemBalanceConfig = RedeemBalanceConfig
+    { poolNft :: AssetClass
+    , poolX   :: AssetClass
+    , poolY   :: AssetClass
+    , poolLp  :: AssetClass
+    , exFee   :: Integer
+    , rewardPkh :: PubKeyHash
+    , stakePkh  :: Maybe PubKeyHash
+    }
+     deriving stock (Show)
+
+PlutusTx.makeIsDataIndexed ''RedeemBalanceConfig [('RedeemBalanceConfig, 0)]