update pool contract. StakeAdmins and lqLock support

Author: Bromel777

cabal.project

@@ -313,7 +313,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/ergolabs/cardano-dex-contracts
-  tag: 2fb44f444897d84e313ceb4d3d467441385802dd
+  tag: 0f53e485b2310cb83a946bbd29a5c5454a757b22
   subdir:
     cardano-dex-contracts-offchain
 

dex-core/src/ErgoDex/Amm/Pool.hs

@@ -11,6 +11,7 @@ import Ledger
 import Ledger.Value                   (assetClassValue, assetClassValueOf)
 import PlutusTx.IsData.Class
 import PlutusTx.Sqrt
+import Plutus.V1.Ledger.Api           (StakingCredential(..))
 import PlutusTx.Numeric               (AdditiveMonoid(zero))
 import Ledger.Ada                     (lovelaceValueOf)
 import Plutus.Script.Utils.V2.Address (mkValidatorAddress)
@@ -51,25 +52,29 @@ data Pool = Pool
   , poolCoinLq    :: Coin Liquidity
   , poolFee       :: PoolFee
   , outCollateral :: Amount Lovelace
+  , stakeAdmins   :: [PubKeyHash]
+  , lqBound       :: Amount X
+  , stakeCred     :: Maybe StakingCredential
   } deriving (Show, Eq, Generic, FromJSON, ToJSON)
 
 feeDen :: Integer
 feeDen = 1000
 
 instance FromLedger Pool where
-  parseFromLedger fout@FullTxOut{fullTxOutDatum=(KnownDatum (Datum d)), ..} = --todo add also check for address
+  parseFromLedger fout@FullTxOut{fullTxOutDatum=(KnownDatum (Datum d)), fullTxOutAddress=Address{..}, ..} = --todo add also check for address
     case fromBuiltinData d of
       (Just PoolConfig{..}) -> do
         let
-          rx         = Amount $ assetClassValueOf fullTxOutValue poolX
-          ry         = Amount $ assetClassValueOf fullTxOutValue poolY
-          rlq        = Amount $ assetClassValueOf fullTxOutValue poolLq
-          nft        = Amount $ assetClassValueOf fullTxOutValue poolNft
-          lq         = maxLqCapAmount - rlq -- actual LQ emission
+          rx            = Amount $ assetClassValueOf fullTxOutValue poolX
+          ry            = Amount $ assetClassValueOf fullTxOutValue poolY
+          rlq           = Amount $ assetClassValueOf fullTxOutValue poolLq
+          nft           = Amount $ assetClassValueOf fullTxOutValue poolNft
+          lqBoundAmount = Amount lqBound
+          lq            = maxLqCapAmount - rlq -- actual LQ emission
           collateral = if W.isAda poolX || W.isAda poolY then zero else minSafeOutputAmount
         when (rx == 0 || ry == 0 || rlq == 0 || nft /= 1) Nothing
         Just $ OnChain fout Pool
-          { poolId        = PoolId $ Coin  poolNft
+          { poolId        = PoolId $ Coin poolNft
           , poolReservesX = rx
           , poolReservesY = ry
           , poolLiquidity = lq
@@ -78,19 +83,25 @@ instance FromLedger Pool where
           , poolCoinLq    = Coin poolLq
           , poolFee       = PoolFee poolFeeNum feeDen
           , outCollateral = collateral
+          , stakeAdmins   = stakeAdmins
+          , lqBound       = lqBoundAmount
+          , stakeCred     = addressStakingCredential
           }
       _ -> Nothing
   parseFromLedger _ = Nothing
 
 instance ToLedger PoolValidatorV1 Pool where
   toLedger (PoolValidator poolValidator) Pool{..} =
       TxOutCandidate
-        { txOutCandidateAddress   = mkValidatorAddress poolValidator
+        { txOutCandidateAddress   = poolAddress
         , txOutCandidateValue     = poolValue
         , txOutCandidateDatum     = KnownDatum $ Datum $ toBuiltinData poolConf
         , txOutCandidateRefScript = Nothing
         }
     where
+      poolAddress    = (mkValidatorAddress poolValidator) {
+           addressStakingCredential = stakeCred
+        }
       nft            = unPoolId poolId
       poolLqReserves = maxLqCapAmount - poolLiquidity
       poolValue      = assetClassValue (unCoin nft) 1 <>
@@ -100,18 +111,21 @@ instance ToLedger PoolValidatorV1 Pool where
                        lovelaceValueOf (unAmount outCollateral)
 
       poolConf = PoolConfig
-        { poolNft    = unCoin nft
-        , poolX      = unCoin poolCoinX
-        , poolY      = unCoin poolCoinY
-        , poolLq     = unCoin poolCoinLq
-        , poolFeeNum = poolFeeNum' poolFee
+        { poolNft     = unCoin nft
+        , poolX       = unCoin poolCoinX
+        , poolY       = unCoin poolCoinY
+        , poolLq      = unCoin poolCoinLq
+        , poolFeeNum  = poolFeeNum' poolFee
+        , stakeAdmins = stakeAdmins
+        , lqBound     = unAmount lqBound
         }
 
 data PoolInitError
   = InvalidLiquidity Integer
   | InsufficientInitialLiqudity (Amount Liquidity)
   deriving (Show, Eq)
 
+-- todo: remove me
 initPool
   :: PoolValidator V1
   -> S.PoolConfig
@@ -136,6 +150,8 @@ initPool poolValidator S.PoolConfig{..} burnLq (inX, inY) = do
       , poolCoinY     = poolY
       , poolCoinLq    = poolLq
       , poolFee       = PoolFee poolFeeNum feeDen
+      , stakeAdmins   = []
+      , lqBound       = 10000
       , outCollateral = outCollateral
       }
     poolOut = toLedger poolValidator pool

dex-core/src/ErgoDex/Amm/PoolActions.hs

@@ -34,6 +34,7 @@ data OrderExecErr
   | PoolMismatch PoolId PoolId
   | EmptyPool PoolId
   | PoolNotFoundInFinalTx PoolId
+  | InsufficientPoolLqForSwap PoolId
   deriving (Show)
 
 instance Exception OrderExecErr
@@ -102,6 +103,7 @@ runSwap' executorPkh pv sv refInputs (OnChain swapOut Swap{swapExFee=ExFeePerTok
 
   when (swapPoolId /= poolId pool)               (Left $ PoolMismatch swapPoolId (poolId pool))
   when (getAmount quoteOutput < swapMinQuoteOut) (Left PriceTooHigh)
+  when (lqBound pool <= poolReservesX pool * 2)  (Left $ InsufficientPoolLqForSwap (poolId pool))
 
   let
     exFee      = assetAmountRawValue quoteOutput * exFeePerTokenNum `div` exFeePerTokenDen
@@ -121,7 +123,7 @@ runSwap' executorPkh pv sv refInputs (OnChain swapOut Swap{swapExFee=ExFeePerTok
           <> Ada.lovelaceValueOf (negate exFee)                               -- Remove Batcher Fee
 
         rewardValue = assetAmountValue quoteOutput <> residualValue
-  
+
     txCandidate = TxCandidate
       { txCandidateInputs       = inputs
       , txCandidateRefIns       = refInputs
@@ -218,7 +220,7 @@ runRedeem' executorPkh pv rv refInputs (OnChain redeemOut Redeem{..}) (poolOut,
     pp@(Predicted nextPoolOut _) = applyRedeem pv pool redeemLqIn
 
     burnLqValue = assetClassValue (unCoin redeemLq) (negate $ unAmount redeemLqIn)
-    
+
     exFee = unAmount $ unExFee redeemExFee
 
     rewardAddr = pubKeyHashAddress (PaymentPubKeyHash redeemRewardPkh) redeemRewardSPkh
@@ -233,13 +235,13 @@ runRedeem' executorPkh pv rv refInputs (OnChain redeemOut Redeem{..}) (poolOut,
         (outX, outY)  = sharesAmount pool redeemLqIn
         initValue     = fullTxOutValue redeemOut
         negatedExFe   = Ada.lovelaceValueOf . negate $ exFee
-        residualValue = 
-             initValue 
-          <> burnLqValue 
+        residualValue =
+             initValue
+          <> burnLqValue
           <> negatedExFe                                     -- Remove LQ input and ExFee
 
         rewardValue = assetAmountValue outX <> assetAmountValue outY <> residualValue
-    
+
     txCandidate = TxCandidate
       { txCandidateInputs       = inputs
       , txCandidateRefIns       = refInputs

dex-core/src/ErgoDex/Amm/PoolSetup.hs

@@ -44,6 +44,7 @@ mkPoolSetup pv changeAddr = PoolSetup
   { poolDeploy = poolDeploy' pv burnLqInitial changeAddr
   }
 
+-- todo: remove me
 poolDeploy'
   :: PoolValidatorV1
   -> Amount Liquidity 

dex-core/test/Spec/Pool.hs

@@ -100,11 +100,16 @@ nativePool = Pool
   , poolCoinLq    = poolLq
   , poolFee       = PoolFee poolFeeNum feeDen
   , outCollateral = minSafeOutputAmount
+  , stakeAdmins   = []
+  , lqBound       = Amount 0
+  , stakeCred     = Nothing
   }
 
+-- todo: remove me
 initPoolTests = testGroup "NonNativePoolInit"
-  [ HH.testProperty "init_non_native_pool_sufficient_liquidity" initNonNativePoolSufficientLiquidity
-  , HH.testProperty "init_non_native_pool_insufficient_liquidity" initNonNativePoolInsufficientLiquidity
+  [ 
+  --   HH.testProperty "init_non_native_pool_sufficient_liquidity" initNonNativePoolSufficientLiquidity
+  -- , HH.testProperty "init_non_native_pool_insufficient_liquidity" initNonNativePoolInsufficientLiquidity
   ]
 
 initNonNativePoolInsufficientLiquidity :: Property

nix/pkgs/haskell/haskell.nix

@@ -43,7 +43,7 @@ let
       "https://github.com/input-output-hk/cardano-ledger"."c7c63dabdb215ebdaed8b63274965966f2bf408f" = "zTQbMOGPD1Oodv6VUsfF6NUiXkbN8SWI98W3Atv4wbI=";
       "https://github.com/input-output-hk/plutus-apps"."593ffafa59dd30ad28cfaf144c526c66328595d2" = "CIuI/Nz7O67ljOHDg7UBbXgWuIE7VPRdPX4VK0/DI3A=";
       "https://github.com/input-output-hk/hedgehog-extras"."714ee03a5a786a05fc57ac5d2f1c2edce4660d85" = "6KQFEzb9g2a0soVvwLKESEbA+a8ygpROcMr6bkatROE=";
-      "https://github.com/ergolabs/cardano-dex-contracts"."2fb44f444897d84e313ceb4d3d467441385802dd" = "Kih0IS6Ty3EnXlgqAyF04nWIWJAnHOEVfraebh5RsNI=";
+      "https://github.com/ergolabs/cardano-dex-contracts"."0f53e485b2310cb83a946bbd29a5c5454a757b22" = "ksJ0ni8bFUbmoVyG4USSPzNu4+oasa84ijeY/pRDYew=";
       "https://github.com/ergolabs/hlog"."19dfa3a6e696a3f63fc3539cd6b7a3fc4d999853" = "Lvmj1oLuXmktrboXh/BrXqLPf8FxSCXIf99GnBXu0Bk=";
       "https://github.com/daleiz/rocksdb-haskell"."109af08f95b40f458d4933e3725ecb3e59337c39" = "1i1ya491fapa0g96527krarv0w0iybizqcz518741iw06hhpikiy";
     };