Skip to content

Commit

Permalink
update pool contract. StakeAdmins and lqLock support
Browse files Browse the repository at this point in the history
  • Loading branch information
@Bromel777
Bromel777 committed Jul 13, 2023
1 parent 45c7af9 commit ea5a810
Show file tree
Hide file tree
Showing 6 changed files with 47 additions and 23 deletions.
2 changes: 1 addition & 1 deletion cabal.project
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
42 changes: 29 additions & 13 deletions dex-core/src/ErgoDex/Amm/Pool.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand All @@ -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 <>
Expand All @@ -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
Expand All @@ -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
Expand Down
14 changes: 8 additions & 6 deletions dex-core/src/ErgoDex/Amm/PoolActions.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,7 @@ data OrderExecErr
| PoolMismatch PoolId PoolId
| EmptyPool PoolId
| PoolNotFoundInFinalTx PoolId
| InsufficientPoolLqForSwap PoolId
deriving (Show)

instance Exception OrderExecErr
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
1 change: 1 addition & 0 deletions dex-core/src/ErgoDex/Amm/PoolSetup.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,7 @@ mkPoolSetup pv changeAddr = PoolSetup
{ poolDeploy = poolDeploy' pv burnLqInitial changeAddr
}

-- todo: remove me
poolDeploy'
:: PoolValidatorV1
-> Amount Liquidity
Expand Down
9 changes: 7 additions & 2 deletions dex-core/test/Spec/Pool.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion nix/pkgs/haskell/haskell.nix
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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";
};
Expand Down

0 comments on commit ea5a810

Please sign in to comment.