Pool contracts V2 support

cabal.project

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

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

@@ -37,6 +37,8 @@ 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)), ..} =
     case fromBuiltinData d of
@@ -46,8 +48,10 @@ instance FromLedger Swap where
           baseIn   = Amount $ assetClassValueOf fullTxOutValue base
           minBase  =
             if isAda swapBase
+              --   1000000 + (1199041 * 15011997087672564) / 10000000000000000
               then baseAmount + divide (minQuoteAmount * exFeePerTokenNum) exFeePerTokenDen
               else baseAmount
+        --                     2 799 999      
         when (unAmount baseIn < minBase) Nothing
         Just $ OnChain fout Swap
           { swapPoolId      = PoolId $ Coin poolNft

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

@@ -90,7 +90,7 @@ instance FromLedger Pool where
       _ -> Nothing
   parseFromLedger _ = Nothing
 
-instance ToLedger PoolValidatorV1 Pool where
+instance ToLedger (PoolValidator ver) Pool where
   toLedger (PoolValidator poolValidator) Pool{..} =
       TxOutCandidate
         { txOutCandidateAddress   = poolAddress
@@ -159,7 +159,7 @@ initPool poolValidator S.PoolConfig{..} burnLq (inX, inY) = do
   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
@@ -187,7 +187,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
@@ -200,7 +200,7 @@ applyRedeem poolValidator p@Pool{..} burnedLq =
       }
     nextPoolOut = toLedger poolValidator nextPool
 
-applySwap :: PoolValidator V1 -> Pool -> AssetAmount Base -> Predicted Pool
+applySwap :: PoolValidator ver -> Pool -> AssetAmount Base -> Predicted Pool
 applySwap poolValidator p@Pool{..} base =
     Predicted nextPoolOut nextPool
   where

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

@@ -81,7 +81,7 @@ fetchValidatorsV1 =
     <*> fetchDepositValidatorV1
     <*> fetchRedeemValidatorV1
 
-data PoolActions = PoolActions
+data PoolActions ver = PoolActions
   { runSwapWithDebug    :: [FullTxOut] -> OnChain Swap    -> (FullTxOut, Pool) -> Either (OrderExecErr, OrderInfo) (TxCandidate, Predicted Pool, OrderInfo)
   , runDepositWithDebug :: [FullTxOut] -> OnChain Deposit -> (FullTxOut, Pool) -> Either (OrderExecErr, OrderInfo) (TxCandidate, Predicted Pool, OrderInfo)
   , runRedeemWithDebug  :: [FullTxOut] -> OnChain Redeem  -> (FullTxOut, Pool) -> Either (OrderExecErr, OrderInfo) (TxCandidate, Predicted Pool, OrderInfo)
@@ -90,7 +90,7 @@ data PoolActions = PoolActions
   , runRedeem  :: [FullTxOut] -> OnChain Redeem  -> (FullTxOut, Pool) -> Either OrderExecErr (TxCandidate, Predicted Pool, Integer)
   }
 
-mkPoolActions :: UnsafeEvalConfig -> PaymentPubKeyHash -> AmmValidators V1 -> PoolActions
+mkPoolActions :: UnsafeEvalConfig -> PaymentPubKeyHash -> AmmValidators ver -> PoolActions ver
 mkPoolActions evalCfg executorPkh AmmValidators{..} = PoolActions
   { runSwapWithDebug    = runSwapWithDebug' executorPkh poolV swapV
   , runDepositWithDebug = runDepositWithDebug' executorPkh poolV depositV
@@ -104,9 +104,9 @@ newtype PoolIn  = PoolIn FullTxOut
 newtype OrderIn = OrderIn FullTxOut
 
 mkOrderInputs
-  :: forall kind. P.PoolAction
-  -> PoolValidator V1
-  -> OrderValidator kind V1
+  :: forall ver kind. P.PoolAction
+  -> PoolValidator ver
+  -> OrderValidator kind ver
   -> PoolIn
   -> OrderIn
   -> Set.Set FullTxIn
@@ -123,8 +123,8 @@ mkOrderInputs action (PoolValidator pv) ov' (PoolIn poolOut) (OrderIn orderOut)
 runSwapUnsafe'
   :: UnsafeEvalConfig
   -> PaymentPubKeyHash
-  -> PoolValidator V1
-  -> SwapValidator V1
+  -> PoolValidator ver
+  -> SwapValidator ver
   -> [FullTxOut]
   -> OnChain Swap
   -> (FullTxOut, Pool)
@@ -183,8 +183,8 @@ runSwapUnsafe' UnsafeEvalConfig{..} executorPkh pv sv refInputs (OnChain swapOut
 runDepositUnsafe'
   :: UnsafeEvalConfig
   -> PaymentPubKeyHash
-  -> PoolValidator V1
-  -> DepositValidator V1
+  -> PoolValidator ver
+  -> DepositValidator ver
   -> [FullTxOut]
   -> OnChain Deposit
   -> (FullTxOut, Pool)
@@ -260,8 +260,8 @@ runDepositUnsafe' UnsafeEvalConfig{..} executorPkh pv dv refInputs (OnChain depo
 runRedeemUnsafe'
   :: UnsafeEvalConfig
   -> PaymentPubKeyHash
-  -> PoolValidator V1
-  -> RedeemValidator V1
+  -> PoolValidator ver
+  -> RedeemValidator ver
   -> [FullTxOut]
   -> OnChain Redeem
   -> (FullTxOut, Pool)
@@ -321,8 +321,8 @@ runRedeemUnsafe' UnsafeEvalConfig{..} executorPkh pv rv refInputs (OnChain redee
 
 runSwapWithDebug'
   :: PaymentPubKeyHash
-  -> PoolValidator V1
-  -> SwapValidator V1
+  -> PoolValidator ver
+  -> SwapValidator ver
   -> [FullTxOut]
   -> OnChain Swap
   -> (FullTxOut, Pool)
@@ -385,8 +385,8 @@ runSwapWithDebug' executorPkh pv sv refInputs (OnChain swapOut s@Swap{swapExFee=
 
 runDepositWithDebug'
   :: PaymentPubKeyHash
-  -> PoolValidator V1
-  -> DepositValidator V1
+  -> PoolValidator ver
+  -> DepositValidator ver
   -> [FullTxOut]
   -> OnChain Deposit
   -> (FullTxOut, Pool)
@@ -473,8 +473,8 @@ runDepositWithDebug' executorPkh pv dv refInputs (OnChain depositOut d@Deposit{.
 
 runRedeemWithDebug'
   :: PaymentPubKeyHash
-  -> PoolValidator V1
-  -> RedeemValidator V1
+  -> PoolValidator ver
+  -> RedeemValidator ver
   -> [FullTxOut]
   -> OnChain Redeem
   -> (FullTxOut, Pool)

dex-core/src/ErgoDex/ScriptsValidators.hs

@@ -14,7 +14,7 @@ import qualified Plutus.V2.Ledger.Api as PV2
 import ErgoDex.Amm.PoolActions 
   ( AmmValidators (..) )
 import ErgoDex.Validators 
-  ( V1, PoolValidator (..), OrderValidator (..) )
+  ( Version(..), PoolValidator (..), OrderValidator (..) )
 import System.Logging.Hlog
 import CardanoTx.Models (FullTxOut(..))
 import ErgoDex.State (Confirmed(Confirmed), OnChain (OnChain))

dex-core/src/ErgoDex/Validators.hs

@@ -1,5 +1,5 @@
 module ErgoDex.Validators
-  ( V1
+  ( Version(..)
   , PoolValidator(..)
   , OrderValidator(..)
   , orderValidator
@@ -15,15 +15,18 @@ module ErgoDex.Validators
   ) where
 
 import Control.Monad.IO.Class (MonadIO)
-import RIO ((<&>))
+import RIO ((<&>), Generic)
 
 import qualified Plutus.V2.Ledger.Api as PV2
 
 import ErgoDex.PValidators
+    ( depositValidator, poolValidator, redeemValidator, swapValidator )
+import Data.Aeson
 
 newtype PoolValidator ver = PoolValidator PV2.Validator
 
-data V1
+data Version = V1 | V2
+  deriving (Generic, Eq, Show, FromJSON, ToJSON)
 
 data SwapK
 data DepositK
@@ -45,16 +48,16 @@ orderValidator (RedeemValidator rv)  = rv
 
 type AnyOrderValidator ver = forall kind. OrderValidator kind ver
 
-type PoolValidatorV1 = PoolValidator V1
+type PoolValidatorV1 = PoolValidator 'V1
 
-fetchPoolValidatorV1 :: MonadIO m => m (PoolValidator V1) 
+fetchPoolValidatorV1 :: MonadIO m => m (PoolValidator 'V1) 
 fetchPoolValidatorV1 = poolValidator <&> PoolValidator
 
-fetchSwapValidatorV1 :: MonadIO m => m (SwapValidator V1)
+fetchSwapValidatorV1 :: MonadIO m => m (SwapValidator 'V1)
 fetchSwapValidatorV1 = swapValidator <&> SwapValidator
 
-fetchDepositValidatorV1 :: MonadIO m => m (DepositValidator V1)
+fetchDepositValidatorV1 :: MonadIO m => m (DepositValidator 'V1)
 fetchDepositValidatorV1 = depositValidator <&> DepositValidator
 
-fetchRedeemValidatorV1 :: MonadIO m => m (RedeemValidator V1)
+fetchRedeemValidatorV1 :: MonadIO m => m (RedeemValidator 'V1)
 fetchRedeemValidatorV1 = redeemValidator <&> RedeemValidator

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"."b4330de32e2d8be821a8a4fd3fd2d24508c280d7" = "exJoEIagnfPYqW3Tj96/Q/A/dR9c2jW5KPSahXfazfg=";
+      "https://github.com/ergolabs/cardano-dex-contracts"."c25c8ab7daf52871d29efd00d3dac236cc9d6a36" = "/A2kO/ABqElTxeIcyA2SIqwX9StNLTe5GyE80h+Rf8w=";
       "https://github.com/ergolabs/hlog"."19dfa3a6e696a3f63fc3539cd6b7a3fc4d999853" = "Lvmj1oLuXmktrboXh/BrXqLPf8FxSCXIf99GnBXu0Bk=";
       "https://github.com/daleiz/rocksdb-haskell"."109af08f95b40f458d4933e3725ecb3e59337c39" = "1i1ya491fapa0g96527krarv0w0iybizqcz518741iw06hhpikiy";
     };

submit-api/submit-api.cabal

@@ -154,6 +154,7 @@ test-suite submit-api-tests
     , plutus-script-utils
     , plutus-ledger
     , containers
+    , either
     , random-strings
     , plutus-core
     , cardano-ledger-shelley

submit-api/test/Main.hs

@@ -54,6 +54,10 @@ import ErgoDex.Contracts.Proxy.Order (OrderRedeemer(OrderRedeemer), OrderAction
 import Control.Monad.IO.Class (MonadIO(liftIO))
 import RIO (lift, (&))
 import Control.Monad.Trans.Except (runExceptT)
+import ErgoDex.Contracts.Proxy.Swap (SwapConfig(SwapConfig, baseAmount, base))
+import ErgoDex.Contracts.Types (Amount(unAmount, Amount), Coin (Coin))
+import CardanoTx.Models (FullTxOut(fullTxOutValue))
+import PlutusTx.Prelude (divide)
 
 
 data TokenInfo = TokenInfo
@@ -248,21 +252,40 @@ test3 = do
   pure ()
 
 test123 = do
-  let
-    trustStore = mkTrustStore @_ @C.PaymentKey C.AsPaymentKey (SecretFile "/home/bromel/projects/cardano-dex-sdk-haskell/wallet1TS.json")
-    vault      = mkVault trustStore $ KeyPass $ T.pack "test1234" :: Vault IO
+  -- let
+  --   trustStore = mkTrustStore @_ @C.PaymentKey C.AsPaymentKey (SecretFile "/home/bromel/projects/cardano-dex-sdk-haskell/wallet1TS.json")
+  --   vault      = mkVault trustStore $ KeyPass $ T.pack "test1234" :: Vault IO
 
-    mkPCred = Explorer.PaymentCred . T.decodeUtf8 . convertToBase Base16 . serialiseToRawBytes
+  --   mkPCred = Explorer.PaymentCred . T.decodeUtf8 . convertToBase Base16 . serialiseToRawBytes
 
-  pkh <- getPaymentKeyHash vault
+  -- pkh <- getPaymentKeyHash vault
 
-  let
-    address = (mkPCred pkh)
+  -- let
+  --   address = (mkPCred pkh)
 
-  print address
+  -- print address
 
     -- defaultMain tests
   let
+
+    testData = BuiltinData $ deserialise $ LBS.fromStrict $ mkByteString $ T.pack "d8799fd8799f4040ffd8799f581c533bb94a8850ee3ccbe483106489399112b74c905342cb1792a797a044494e4459ffd8799f581cd0861c6a8e913001a9ceaca2c8f3d403c7ed541e27fab570c0d17a324c494e44495f4144415f4e4654ff1903e51b00355554f1c7a8f41b002386f26fc10000581cc06d3c6c1fd24aab874cfb35a7fe5d090a501e4df0d9a58d00fd5678d8799f581c63481073ae1ea98b21c55b4ea2ab133ad85288c67b51c06edea79459ff1a000f42401a00124bc1ff"
+
+  case fromBuiltinData testData of
+      (Just SwapConfig{..}) -> do
+        let
+          swapBase = Coin base
+          baseIn   = Amount 4800000
+          minBase  =
+            if True
+              --   1000000 + (1199041 * 15011997087672564) / 10000000000000000
+              then baseAmount + divide (1199041 * 15011997087672564) 10000000000000000
+              else baseAmount
+        --                     2 799 999      
+        print (unAmount baseIn < minBase)
+      _ -> print "test-"
+
+  let
+
     wallet1PubKeyHash = "9b697975d20d891cc1713a3c4d3f881490880a780019337037ef079c"
     wallet2PubKeyHash = "a6e1973e53af80c473cafb288235864f66240d305d9ce9df992125ea"