Dev fix swap orders parsing

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: c25c8ab7daf52871d29efd00d3dac236cc9d6a36
   subdir:
     cardano-dex-contracts-offchain
 

dex-core/dex-core.cabal

@@ -111,6 +111,7 @@ library
         either,
         extra,
         transformers,
+        submit-api,
         cardano-api,
         text,
         serialise,

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

@@ -25,6 +25,7 @@ import ErgoDex.Contracts.Types
 import ErgoDex.Contracts.Proxy.Swap
 import ErgoDex.Contracts.Proxy.Deposit
 import ErgoDex.Contracts.Proxy.Redeem
+import Debug.Trace
 
 data Swap = Swap
   { swapPoolId      :: PoolId
@@ -37,8 +38,10 @@ data Swap = Swap
   , swapRewardSPkh  :: Maybe StakePubKeyHash
   } deriving (Show, Eq, Generic, ToJSON, FromJSON)
 
+-- 10 000 000 000 000 000
+
 instance FromLedger Swap where
-  parseFromLedger fout@FullTxOut{fullTxOutDatum=(KnownDatum (Datum d)), ..} =
+  parseFromLedger fout@FullTxOut{fullTxOutDatum=(KnownDatum (Datum d)), fullTxOutRef, ..} =
     case fromBuiltinData d of
       (Just SwapConfig{..}) -> do
         let
@@ -48,6 +51,15 @@ instance FromLedger Swap where
             if isAda swapBase
               then baseAmount + divide (minQuoteAmount * exFeePerTokenNum) exFeePerTokenDen
               else baseAmount
+        traceM $ "Found swap config for " ++ show (PoolId $ Coin poolNft)
+        traceM $ "baseIn " ++ show baseIn
+        traceM $ "baseAmount" ++ show baseAmount
+        traceM $ "minQuoteAmount" ++ show minQuoteAmount
+        traceM $ "exFeePerTokenNum" ++ show exFeePerTokenNum
+        traceM $ "exFeePerTokenDen" ++ show exFeePerTokenDen
+        traceM $ "divide (minQuoteAmount * exFeePerTokenNum) exFeePerTokenDen" ++ show (divide (minQuoteAmount * exFeePerTokenNum) exFeePerTokenDen)
+        traceM $ "minBase " ++ show minBase
+        traceM $ "(unAmount baseIn < minBase) " ++ show (unAmount baseIn < minBase)
         when (unAmount baseIn < minBase) Nothing
         Just $ OnChain fout Swap
           { swapPoolId      = PoolId $ Coin poolNft
@@ -78,7 +90,7 @@ instance FromLedger Deposit where
       (Just DepositConfig{..}) -> do
         let adaIn       = Ada.getLovelace $ Ada.fromValue fullTxOutValue
             adaDeclared = exFee + collateralAda
-        when (adaIn < adaDeclared) Nothing
+        --  when (adaIn < adaDeclared) Nothing
         case extractPairValue fullTxOutValue of
           [assetX, assetY] ->
               Just $ OnChain fout Deposit

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

@@ -11,9 +11,11 @@ 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)
+import Debug.Trace
 
 import CardanoTx.Models
     ( FullTxOut(FullTxOut, fullTxOutDatum, fullTxOutValue,
@@ -29,8 +31,12 @@ import           ErgoDex.Validators
 import qualified ErgoDex.Contracts.Typed       as S
 import           ErgoDex.Contracts.Types
 import qualified ErgoDex.Contracts.Proxy.Order as W
-import           ErgoDex.Contracts.Pool
+import ErgoDex.Contracts.Pool
+    ( PoolConfig(PoolConfig, lqBound, stakeAdminPolicy, poolFeeNum,
+                 poolLq, poolY, poolX, poolNft),
+      maxLqCapAmount )
 import           ErgoDex.Amm.Constants         (minSafeOutputAmount)
+import Debug.Trace
 
 newtype PoolId = PoolId { unPoolId :: Coin Nft }
   deriving (Show, Eq, Generic)
@@ -42,55 +48,65 @@ data PoolFee = PoolFee
   } deriving (Show, Eq, Generic, FromJSON, ToJSON)
 
 data Pool = Pool
-  { poolId        :: PoolId
-  , poolReservesX :: Amount X
-  , poolReservesY :: Amount Y
-  , poolLiquidity :: Amount Liquidity
-  , poolCoinX     :: Coin X
-  , poolCoinY     :: Coin Y
-  , poolCoinLq    :: Coin Liquidity
-  , poolFee       :: PoolFee
-  , outCollateral :: Amount Lovelace
+  { poolId           :: PoolId
+  , poolReservesX    :: Amount X
+  , poolReservesY    :: Amount Y
+  , poolLiquidity    :: Amount Liquidity
+  , poolCoinX        :: Coin X
+  , poolCoinY        :: Coin Y
+  , poolCoinLq       :: Coin Liquidity
+  , poolFee          :: PoolFee
+  , outCollateral    :: Amount Lovelace
+  , stakeAdminPolicy :: [CurrencySymbol]
+  , 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
-          , poolReservesX = rx
-          , poolReservesY = ry
-          , poolLiquidity = lq
-          , poolCoinX     = Coin poolX
-          , poolCoinY     = Coin poolY
-          , poolCoinLq    = Coin poolLq
-          , poolFee       = PoolFee poolFeeNum feeDen
-          , outCollateral = collateral
+          { poolId           = PoolId $ Coin poolNft
+          , poolReservesX    = rx
+          , poolReservesY    = ry
+          , poolLiquidity    = lq
+          , poolCoinX        = Coin poolX
+          , poolCoinY        = Coin poolY
+          , poolCoinLq       = Coin poolLq
+          , poolFee          = PoolFee poolFeeNum feeDen
+          , outCollateral    = collateral
+          , stakeAdminPolicy = stakeAdminPolicy
+          , lqBound          = lqBoundAmount
+          , stakeCred        = addressStakingCredential
           }
       _ -> Nothing
   parseFromLedger _ = Nothing
 
-instance ToLedger PoolValidatorV1 Pool where
+instance ToLedger (PoolValidator ver) 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 +116,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
+        , stakeAdminPolicy = stakeAdminPolicy
+        , lqBound          = unAmount lqBound
         }
 
 data PoolInitError
   = InvalidLiquidity Integer
   | InsufficientInitialLiqudity (Amount Liquidity)
   deriving (Show, Eq)
 
+-- todo: remove me
 initPool
   :: PoolValidator V1
   -> S.PoolConfig
@@ -128,21 +147,24 @@ initPool poolValidator S.PoolConfig{..} burnLq (inX, inY) = do
         then zero
         else minSafeOutputAmount
     pool = Pool
-      { poolId        = PoolId poolNft
-      , poolReservesX = inX
-      , poolReservesY = inY
-      , poolLiquidity = releasedLq
-      , poolCoinX     = poolX
-      , poolCoinY     = poolY
-      , poolCoinLq    = poolLq
-      , poolFee       = PoolFee poolFeeNum feeDen
-      , outCollateral = outCollateral
+      { poolId           = PoolId poolNft
+      , poolReservesX    = inX
+      , poolReservesY    = inY
+      , poolLiquidity    = releasedLq
+      , poolCoinX        = poolX
+      , poolCoinY        = poolY
+      , poolCoinLq       = poolLq
+      , poolFee          = PoolFee poolFeeNum feeDen
+      , stakeAdminPolicy = []
+      , lqBound          = 10000
+      , outCollateral    = outCollateral
+      , stakeCred        = Nothing
       }
     poolOut = toLedger poolValidator pool
   pure (Predicted poolOut pool, releasedLq)
 
 
-applyDeposit :: PoolValidator V1 -> Pool -> (Amount X, Amount Y) -> Predicted Pool
+applyDeposit :: PoolValidator ver -> Pool -> (Amount X, Amount Y) -> Predicted Pool
 applyDeposit poolValidator p@Pool{..} (inX, inY) =
     Predicted nextPoolOut nextPool
   where
@@ -170,7 +192,7 @@ rewardLp p@Pool{poolLiquidity=(Amount lq), poolReservesX=(Amount poolX), poolRes
         else (Amount $ (minByX - minByY) * poolX `div` lq, Amount 0)
     unlockedLq = Amount (min minByX minByY)
 
-applyRedeem :: PoolValidator V1 -> Pool -> Amount Liquidity -> Predicted Pool
+applyRedeem :: PoolValidator ver -> Pool -> Amount Liquidity -> Predicted Pool
 applyRedeem poolValidator p@Pool{..} burnedLq =
     Predicted nextPoolOut nextPool
   where
@@ -183,8 +205,8 @@ applyRedeem poolValidator p@Pool{..} burnedLq =
       }
     nextPoolOut = toLedger poolValidator nextPool
 
-applySwap :: PoolValidator V1 -> Pool -> AssetAmount Base -> Predicted Pool
-applySwap poolValidator p@Pool{..} base =
+applySwap :: PoolValidator ver -> Pool -> AssetAmount Base -> Predicted Pool
+applySwap poolValidator p@Pool{..} base = do
     Predicted nextPoolOut nextPool
   where
     xy             = unCoin (getAsset base) == unCoin poolCoinX