From 0865d31ee4fbc7b94041147d60b6cbd7f86914d9 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Thu, 4 Jan 2024 17:05:34 +0530 Subject: [PATCH 01/12] Feat #11 & #14: Placing transactions linearly and not catching all exceptions --- .../src/GeniusYield/MarketMaker/MakerBot.hs | 107 +++++++++--------- .../src/GeniusYield/MarketMaker/Strategies.hs | 12 +- 2 files changed, 58 insertions(+), 61 deletions(-) diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs index e427584..c33e6b2 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs @@ -1,11 +1,9 @@ module GeniusYield.MarketMaker.MakerBot where import Control.Concurrent (threadDelay) -import Control.Exception (SomeException, handle) -import Control.Monad (forever, liftM2, when) +import Control.Exception (Exception (displayException), Handler (Handler), catches) +import Control.Monad (forM_, forever, when) import Control.Monad.Reader (runReaderT) -import Data.Functor.Identity (runIdentity) -import qualified Data.List.NonEmpty as NE (toList) import Data.List.Split (chunksOf) import qualified Data.Map.Strict as M import GeniusYield.Api.Dex.PartialOrder ( @@ -14,6 +12,7 @@ import GeniusYield.Api.Dex.PartialOrder ( partialOrders, placePartialOrder, ) +import GeniusYield.Imports (printf) import GeniusYield.MarketMaker.Prices import GeniusYield.MarketMaker.Strategies import GeniusYield.MarketMaker.Utils ( @@ -21,6 +20,8 @@ import GeniusYield.MarketMaker.Utils ( addrFromSkey, pkhFromSkey, ) +import GeniusYield.Providers.Common (SubmitTxException) +import GeniusYield.Transaction (BuildTxException) import GeniusYield.TxBuilder import GeniusYield.Types import System.Exit @@ -37,32 +38,6 @@ data MakerBot = MakerBot ----------------------------------------------------------------------- ---------------------------- ACTIONS ---------------------------------- --- | For each `PlaceOrderAction`, get a skeleton that places that order. -placeOrders ∷ GYNetworkId → User → [PlaceOrderAction] → DEXInfo → GYTxMonadNode [GYTxSkeleton 'PlutusV2] -placeOrders _ _ [] _ = return [] -placeOrders netId User {uSKey} sts di = do - let userAddr = addrFromSkey netId uSKey - - let getOrderSkeleton ∷ PlaceOrderAction → GYTxMonadNode (GYTxSkeleton 'PlutusV2) - getOrderSkeleton PlaceOrderAction {..} = - flip runReaderT di - $ placePartialOrder - (dexPORefs di) - userAddr - (poaOfferedAmount, poaOfferedAsset) - poaAskedAsset - poaPrice - Nothing - Nothing - Nothing - - mapM getOrderSkeleton sts - --- | Returns a skeleton that cancels all orders from the given list. -cancelOrders ∷ [CancelOrderAction] → DEXInfo → GYTxMonadNode [GYTxSkeleton 'PlutusV2] -cancelOrders [] _ = return [] -cancelOrders coas di = mapM (flip runReaderT di . cancelMultiplePartialOrders (dexPORefs di) . map coaPoi) $ chunksOf 6 coas - -- | Scan the chain for existing orders and cancel all of them in batches of 6. cancelAllOrders ∷ MakerBot → GYNetworkId → GYProviders → DEXInfo → IO () cancelAllOrders MakerBot {mbUser} netId providers di = do @@ -89,32 +64,58 @@ cancelAllOrders MakerBot {mbUser} netId providers di = do userPOIs = filter (\o → poiOwnerKey o == userPkh) $ M.elems partialOrderInfos go userPOIs -signAndSubmit ∷ User → GYProviders → GYNetworkId → GYTxMonadNode [GYTxSkeleton 'PlutusV2] → IO () -signAndSubmit User {uSKey, uColl} providers netId skeletons = handle hanldeSignAndSubmit $ do +buildAndSubmitActions ∷ User → GYProviders → GYNetworkId → UserActions → DEXInfo → IO () +buildAndSubmitActions User {uSKey, uColl} providers netId ua di = flip catches handlers $ do let userAddr = addrFromSkey netId uSKey + placeActions = uaPlaces ua + cancelActions = uaCancels ua + + forM_ (chunksOf 6 cancelActions) $ \cancelChunk → do + logInfo $ "Building for cancel action(s): " <> show cancelChunk + txBody ← runGYTxMonadNode netId providers [userAddr] userAddr uColl $ flip runReaderT di $ cancelMultiplePartialOrders (dexPORefs di) (map coaPoi cancelChunk) + buildCommon txBody + + forM_ placeActions $ \pa@PlaceOrderAction {..} → do + logInfo $ "Building for place action: " <> show pa + txBody ← + runGYTxMonadNode netId providers [userAddr] userAddr uColl + $ flip runReaderT di + $ placePartialOrder + (dexPORefs di) + userAddr + (poaOfferedAmount, poaOfferedAsset) + poaAskedAsset + poaPrice + Nothing + Nothing + Nothing + buildCommon txBody + where + logWarn = gyLogWarning providers "MM" + logInfo = gyLogInfo providers "MM" - txBodyRes ← runGYTxMonadNodeParallel netId providers [userAddr] userAddr uColl skeletons + handlers = + let handlerCommon ∷ Exception e ⇒ e → IO () + handlerCommon = logWarn . displayException - bodies ← case txBodyRes of - GYTxBuildSuccess txs → return $ getBodies txs - GYTxBuildPartialSuccess v txs → - logWarn (unwords ["Partial Success:", show v]) - >> return (getBodies txs) - GYTxBuildFailure v → - logWarn (unwords ["Insufficient funds:", show v]) - >> return [] - GYTxBuildNoInputs → logWarn "No Inputs" >> return [] + be ∷ BuildTxException → IO () + be = handlerCommon - let txs = map (`signGYTxBody` [uSKey]) bodies - tids ← mapM (gySubmitTx providers) txs - mapM_ (gyLogInfo providers "MM" . ("Submitted Tx: " ++) . show) tids - where - logWarn = gyLogWarning providers "Market Maker" + se ∷ SubmitTxException → IO () + se = handlerCommon - hanldeSignAndSubmit ∷ SomeException → IO () - hanldeSignAndSubmit = logWarn . show + me ∷ GYTxMonadException → IO () + me = handlerCommon + in [Handler be, Handler se, Handler me] - getBodies = NE.toList . runIdentity . sequence + buildCommon txBody = do + logInfo $ "Successfully built body for above action, tx id: " <> show (txBodyTxId txBody) + let tx = signGYTxBody txBody [uSKey] + tid ← gySubmitTx providers tx + let numConfirms = 1 + logInfo $ printf "Successfully submitted above tx, now waiting for %d confirmation(s)" numConfirms + gyAwaitTxConfirmed providers (GYAwaitTxParameters {checkInterval = 10_000_000, confirmations = numConfirms, maxAttempts = 30}) tid + logInfo $ printf "Tx successfully seen on chain with %d confirmation(s)" numConfirms executeStrategy ∷ Strategy @@ -128,11 +129,7 @@ executeStrategy runStrategy MakerBot {mbUser, mbDelay, mbToken} netId providers forever $ do newActions ← runStrategy pp mbUser mbToken - let placeSkeletons = placeOrders netId mbUser (uaPlaces newActions) di - cancelSkeletons = cancelOrders (uaCancels newActions) di - allSkeletons = liftM2 (++) placeSkeletons cancelSkeletons - - signAndSubmit mbUser providers netId allSkeletons + buildAndSubmitActions mbUser providers netId newActions di gyLogInfo providers "MM" "---------- Done for the block! -----------" threadDelay mbDelay diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs index 4f2c12c..e185ab0 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs @@ -294,12 +294,12 @@ fixedSpreadVsMarketPriceStrategy Nothing → error "Absurd in getEquityFromOrder: Order SimTokenPair not in MarketInfo" Just price → let ownFunds = getOrderOwnFunds poi - in let priceOfNonAdaToken nonAdaAC = floor $ fromIntegral (valueAssetClass ownFunds nonAdaAC) * getPrice price - in (valueAssetClass ownFunds GYLovelace & fromIntegral) - + ( if poiOfferedAsset poi == GYLovelace - then priceOfNonAdaToken (poiAskedAsset poi) - else priceOfNonAdaToken (poiOfferedAsset poi) - ) + priceOfNonAdaToken nonAdaAC = floor $ fromIntegral (valueAssetClass ownFunds nonAdaAC) * getPrice price + in (valueAssetClass ownFunds GYLovelace & fromIntegral) + + ( if poiOfferedAsset poi == GYLovelace + then priceOfNonAdaToken (poiAskedAsset poi) + else priceOfNonAdaToken (poiOfferedAsset poi) + ) where -- \| Note that at any moment, an order UTxO contains:- -- * An NFT. From 71d2d3af638b0723476398f0c34ca402b8387725 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Thu, 4 Jan 2024 20:08:13 +0530 Subject: [PATCH 02/12] Feat #18 - Remove redundant `mpo_commodity_token` --- .../src/GeniusYield/MarketMaker/Prices.hs | 140 +++++++------ .../src/GeniusYield/MarketMaker/Strategies.hs | 195 ++++++++---------- 2 files changed, 163 insertions(+), 172 deletions(-) diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs index dfc24d5..6d3faa8 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs @@ -1,17 +1,16 @@ module GeniusYield.MarketMaker.Prices where import Control.Applicative ((<|>)) -import Control.Arrow ((&&&)) -import Control.Monad (foldM) -import Data.Bifunctor (first) +import Control.Arrow (Arrow (first), (&&&)) +import Control.Exception (Exception, throwIO, try) +import Control.Monad ((<=<)) import Data.Coerce (coerce) import Data.Either (fromRight) import Data.Function ((&)) -import Data.List (find, foldl') +import Data.List (find) import qualified Data.Map.Strict as M -import Data.Maybe (fromJust, mapMaybe) +import Data.Maybe (fromJust) import Data.Text (Text, pack) -import qualified Data.Text as T import Deriving.Aeson import GeniusYield.GYConfig import GeniusYield.MarketMaker.Orphans () @@ -32,11 +31,18 @@ import GeniusYield.OrderBot.Types ( Price (..), Volume (..), ) +import GeniusYield.Providers.Common (silenceHeadersClientError) import GeniusYield.Providers.Maestro import GeniusYield.Types import Maestro.Client.V1 import Maestro.Types.V1 +data MaestroPriceException + = MaestroPairNotFound + | MaestroApiError !Text !MaestroError + deriving stock (Show) + deriving anyclass (Exception) + data SimTokenPair = SimTokenPair { currencySt ∷ SimToken, commoditySt ∷ SimToken @@ -68,8 +74,7 @@ lovelaceSt ∷ SimToken lovelaceSt = SimToken {stAc = GYLovelace, stPrecision = 6} data MaestroPairOverride = MaestroPairOverride - { mpoCommodityToken ∷ !GYAssetClass, - mpoPair ∷ !String, + { mpoPair ∷ !String, mpoCommodityIsFirst ∷ !Bool } deriving stock (Show, Generic) @@ -128,8 +133,6 @@ data OBMarketTokenInfo = OBMarketTokenInfo type OBMarketInfo = M.Map SimTokenPair OBMarketTokenInfo -type MaestroMarketInfo = M.Map SimTokenPair Price - mkOBMarketTokenInfo ∷ Price → Rational @@ -148,20 +151,21 @@ mkOBMarketTokenInfo (Price marketPrice) spread sellOrders buyOrders = sumVolBuy ∷ Volume sumVolBuy = volumeGTPrice (Price (marketPrice - (marketPrice * spread))) buyOrders +type MaestroMarketInfo = M.Map SimTokenPair Price + getOrderBookPrices ∷ PricesProviders → [SimTokenPair] - → MaestroMarketInfo + → Price → Rational → IO (OBMarketInfo, MultiAssetOrderBook) -getOrderBookPrices PP {orderBookPP = (c, dex)} stps mp priceCheckSpread = do +getOrderBookPrices PP {orderBookPP = (c, dex)} stps price priceCheckSpread = do maOrderBook ← populateOrderBook c dex (dexPORefs dex) (map toOAPair stps) return (M.fromList $ map buildPrice $ maOrderBookToList maOrderBook, maOrderBook) where buildPrice ∷ (OrderAssetPair, OrderBook) → (SimTokenPair, OBMarketTokenInfo) buildPrice (oap, ob) = let stPair = toSTPair oap - price = M.lookup stPair mp & fromJust sndElement = uncurry (mkOBMarketTokenInfo price priceCheckSpread) . (sellOrders &&& buyOrders) $ ob in (stPair, sndElement) @@ -170,63 +174,69 @@ getOrderBookPrices PP {orderBookPP = (c, dex)} stps mp priceCheckSpread = do find (\SimTokenPair {..} → stAc currencySt == currencyAsset && stAc commoditySt == commodityAsset) stps & fromJust -getMaestroPrices +-- | Remove headers (if `MaestroError` contains `ClientError`). +silenceHeadersMaestroClientError ∷ MaestroError → MaestroError +silenceHeadersMaestroClientError (ServantClientError e) = ServantClientError $ silenceHeadersClientError e +silenceHeadersMaestroClientError other = other + +throwMspvApiError ∷ Text → MaestroError → IO a +throwMspvApiError locationInfo = + throwIO . MaestroApiError locationInfo . silenceHeadersMaestroClientError + +-- | Utility function to handle Maestro errors, which also removes header (if present) so as to conceal API key. +handleMaestroError ∷ Text → Either MaestroError a → IO a +handleMaestroError locationInfo = either (throwMspvApiError locationInfo) pure + +getMaestroPrice ∷ PricesProviders - → [SimTokenPair] - → IO MaestroMarketInfo -getMaestroPrices PP {maestroPP = MaestroPP {..}} stps = do - allDexPairs ← dexPairResponsePairs <$> pairsFromDex mppEnv mppDex - - let extendedInfo = mapMaybe isRelevantPairInfo allDexPairs - stpInfos = foldl' (\m (stp, dpi, commodityIsA) → M.insert stp (dpi, commodityIsA) m) M.empty extendedInfo - - foldM - ( \m stp → - case findMaestroPair stp stpInfos of - Nothing → do - putStrLn $ "Could not find maestro pair for stp: " ++ show stp - return m - Just (name, commodityIsA) → do - let pair = TaggedText $ pack name - ohlInfo ← pricesFromDex mppEnv mppDex pair (Just Res5m) (Just Descending) - - let info = head ohlInfo - curPrecision = stPrecision $ currencySt stp - comPrecision = stPrecision $ commoditySt stp - precisionDiff = 10 ** fromIntegral (curPrecision - comPrecision) - - price = - if commodityIsA - then ohlcCandleInfoCoinBClose info - else ohlcCandleInfoCoinAClose info - - adjustedPrice = price * precisionDiff - - return $ M.insert stp (Price $ toRational adjustedPrice) m - ) - M.empty - stps + → SimTokenPair + → IO Price +getMaestroPrice PP {maestroPP = MaestroPP {..}} stp = do + (pairName, commodityIsA) ← case mppOverride of + -- We have to override with given details. + Just (MaestroPairOverride {..}) → do + pure (pack mpoPair, mpoCommodityIsFirst) + -- We are given commodity token and need to find pair name. + Nothing → do + allDexPairs ← dexPairResponsePairs <$> (handleMaestroError "getMaestroPrice - fetching dex pairs" <=< try $ pairsFromDex mppEnv mppDex) + + let go [] = throwIO MaestroPairNotFound + go (dpi : dpis) = maybe (go dpis) pure $ isRelevantPairInfo dpi + first dexPairInfoPair <$> go allDexPairs + + let pair = TaggedText pairName + + ohlInfo ← handleMaestroError "getMaestroPrice - fetching price from pair" <=< try $ pricesFromDex mppEnv mppDex pair (Just Res5m) (Just Descending) + + let info = head ohlInfo + curPrecision = stPrecision $ currencySt stp + comPrecision = stPrecision $ commoditySt stp + precisionDiff = 10 ** fromIntegral (curPrecision - comPrecision) + + price = + if commodityIsA + then ohlcCandleInfoCoinBClose info + else ohlcCandleInfoCoinAClose info + + adjustedPrice = price * precisionDiff + + return $ Price (toRational adjustedPrice) where - isRelevantPairInfo ∷ DexPairInfo → Maybe (SimTokenPair, DexPairInfo, Bool) + isRelevantPairInfo ∷ DexPairInfo → Maybe (DexPairInfo, Bool) isRelevantPairInfo dpi@DexPairInfo {..} = - (,dpi,False) - <$> findMatchingSTP - (dexPairInfoCoinAAssetName, dexPairInfoCoinAPolicy) - (dexPairInfoCoinBAssetName, dexPairInfoCoinBPolicy) - <|> (,dpi,True) - <$> findMatchingSTP - (dexPairInfoCoinBAssetName, dexPairInfoCoinBPolicy) - (dexPairInfoCoinAAssetName, dexPairInfoCoinAPolicy) + ( (dpi, False) + <$ findMatchingSTP + (dexPairInfoCoinAAssetName, dexPairInfoCoinAPolicy) + (dexPairInfoCoinBAssetName, dexPairInfoCoinBPolicy) + ) + <|> ( (dpi, True) + <$ findMatchingSTP + (dexPairInfoCoinBAssetName, dexPairInfoCoinBPolicy) + (dexPairInfoCoinAAssetName, dexPairInfoCoinAPolicy) + ) findMatchingSTP ∷ (TokenName, PolicyId) → (TokenName, PolicyId) → Maybe SimTokenPair findMatchingSTP tokenA tokenB = fromRight Nothing $ do assetClassA ← assetClassFromMaestro tokenA assetClassB ← assetClassFromMaestro tokenB - Right $ find (\stp → assetClassA == stAc (currencySt stp) && assetClassB == stAc (commoditySt stp)) stps - - findMaestroPair ∷ SimTokenPair → M.Map SimTokenPair (DexPairInfo, Bool) → Maybe (String, Bool) - findMaestroPair stp stpInfo = - (mpoPair &&& mpoCommodityIsFirst) - <$> find ((==) (stAc (commoditySt stp)) . mpoCommodityToken) mppOverride - <|> first (T.unpack . dexPairInfoPair) - <$> M.lookup stp stpInfo + Right $ if assetClassA == stAc (currencySt stp) && assetClassB == stAc (commoditySt stp) then Just stp else Nothing diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs index e185ab0..ffab62f 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs @@ -162,7 +162,7 @@ fixedSpreadVsMarketPriceStrategy cancelThreshold = fromInteger scCancelThresholdProduct * scSpread priceCheckThreshold = fromInteger scPriceCheckProduct * scSpread - mp ← getMaestroPrices pp [sTokenPair] + mp ← getMaestroPrice pp sTokenPair logDebug providers $ "Maestro Prices: " ++ show mp logInfo providers $ logMaestroMarketInfo mp @@ -174,82 +174,76 @@ fixedSpreadVsMarketPriceStrategy allOwnOrders = M.foldr (++) [] ownOrdersPerUser equityOnOrders = sum $ map (getEquityFromOrder mp) allOwnOrders totalValueOnUtxos = foldlUTxOs' (\acc utxo → acc <> utxoValue utxo) mempty ownUtxos - equityOnUtxos = foldl' (\acc (_, n) → acc + n) 0 $ valueToList $ valueMap (getEquityFromValue $ M.mapKeys toOAPair mp) totalValueOnUtxos + equityOnUtxos = foldl' (\acc (_, n) → acc + n) 0 $ valueToList $ valueMap (getEquityFromValue mp) totalValueOnUtxos cancelOrderActions = map (\(_, poi) → CancelOrderAction poi) - $ ordersToBeRemoved (`M.lookup` mp) cancelThreshold allOwnOrders + $ ordersToBeRemoved mp cancelThreshold allOwnOrders relevantSTP = mkSimTokenPair lovelaceSt sToken mtInfo = M.lookup relevantSTP bp - mMaestroPrice = M.lookup relevantSTP mp lockedLovelaces = getOrdersLockedValue relevantSTP lovelaceSt allOwnOrders lockedTokens = getOrdersLockedValue relevantSTP sToken allOwnOrders placeOrderActions ← do - case mMaestroPrice of - Nothing → do - logWarn providers $ "Could not get price from Maestro for the required token " ++ show relevantSTP - pure [] - (Just maestroPrice) → do - let TokenVol - { tvSellVolThreshold, - tvBuyVolThreshold, - tvSellMinVol, - tvBuyMinVol, - tvSellBudget, - tvBuyBudget - } = scTokenVolume - - (sellVol, buyVol) = case mtInfo of - Nothing → (0, 0) - Just OBMarketTokenInfo {mtSellVol, mtBuyVol} → (mtSellVol, mtBuyVol) - - availableBuyBudget = max 0 (tvBuyBudget - fromIntegral lockedLovelaces) - availableSellBudget = max 0 (tvSellBudget - fromIntegral lockedTokens) - numNewBuyOrders = availableBuyBudget `quot` tvBuyMinVol - numNewSellOrders = availableSellBudget `quot` tvSellMinVol - adaOverhead = valueFromLovelace 5_000_000 - - newBuyOrders ← - if tvBuyVolThreshold <= fromIntegral buyVol || numNewBuyOrders == 0 - then pure [] + let TokenVol + { tvSellVolThreshold, + tvBuyVolThreshold, + tvSellMinVol, + tvBuyMinVol, + tvSellBudget, + tvBuyBudget + } = scTokenVolume + + (sellVol, buyVol) = case mtInfo of + Nothing → (0, 0) + Just OBMarketTokenInfo {mtSellVol, mtBuyVol} → (mtSellVol, mtBuyVol) + + availableBuyBudget = max 0 (tvBuyBudget - fromIntegral lockedLovelaces) + availableSellBudget = max 0 (tvSellBudget - fromIntegral lockedTokens) + numNewBuyOrders = availableBuyBudget `quot` tvBuyMinVol + numNewSellOrders = availableSellBudget `quot` tvSellMinVol + adaOverhead = valueFromLovelace 5_000_000 + + newBuyOrders ← + if tvBuyVolThreshold <= fromIntegral buyVol || numNewBuyOrders == 0 + then pure [] + else do + let tokensToOfferPerOrder = availableBuyBudget `quot` numNewBuyOrders + neededAtleast = valueFromLovelace tokensToOfferPerOrder <> adaOverhead + if totalValueOnUtxos `valueGreaterOrEqual` neededAtleast + then + pure + $ buildNewUserOrders + scSpread + (sToken, lovelaceSt) + mp + (fromIntegral tokensToOfferPerOrder) + (fromIntegral numNewBuyOrders) + True else do - let tokensToOfferPerOrder = availableBuyBudget `quot` numNewBuyOrders - neededAtleast = valueFromLovelace tokensToOfferPerOrder <> adaOverhead - if totalValueOnUtxos `valueGreaterOrEqual` neededAtleast - then - pure - $ buildNewUserOrders - scSpread - (sToken, lovelaceSt) - maestroPrice - (fromIntegral tokensToOfferPerOrder) - (fromIntegral numNewBuyOrders) - True - else do - logWarn providers $ "Bot has to place buy order(s), but lack funds, needed at least: " ++ show (stimes numNewBuyOrders neededAtleast) -- We check for funds to place one order but in log describe inability for all orders because even if we have funds to place one order, out transaction build logic would see that and at least get that single one built successfully. - pure [] - - if tvSellVolThreshold <= fromIntegral sellVol || numNewSellOrders == 0 - then pure newBuyOrders + logWarn providers $ "Bot has to place buy order(s), but lack funds, needed at least: " ++ show (stimes numNewBuyOrders neededAtleast) -- We check for funds to place one order but in log describe inability for all orders because even if we have funds to place one order, out transaction build logic would see that and at least get that single one built successfully. + pure [] + + if tvSellVolThreshold <= fromIntegral sellVol || numNewSellOrders == 0 + then pure newBuyOrders + else do + let tokensToOfferPerOrder = availableSellBudget `quot` numNewSellOrders + neededAtleast = valueSingleton (stAc sToken) tokensToOfferPerOrder <> adaOverhead + if totalValueOnUtxos `valueGreaterOrEqual` neededAtleast + then + pure + $ buildNewUserOrders + scSpread + (lovelaceSt, sToken) + mp + (fromIntegral $ availableSellBudget `quot` numNewSellOrders) + (fromIntegral numNewSellOrders) + False else do - let tokensToOfferPerOrder = availableSellBudget `quot` numNewSellOrders - neededAtleast = valueSingleton (stAc sToken) tokensToOfferPerOrder <> adaOverhead - if totalValueOnUtxos `valueGreaterOrEqual` neededAtleast - then - pure - $ buildNewUserOrders - scSpread - (lovelaceSt, sToken) - maestroPrice - (fromIntegral $ availableSellBudget `quot` numNewSellOrders) - (fromIntegral numNewSellOrders) - False - else do - logWarn providers $ "Bot has to place sell order(s), but lack funds, needed at least: " ++ show (stimes numNewSellOrders neededAtleast) -- We check for funds to place one order but in log describe inability for all orders. - pure [] + logWarn providers $ "Bot has to place sell order(s), but lack funds, needed at least: " ++ show (stimes numNewSellOrders neededAtleast) -- We check for funds to place one order but in log describe inability for all orders. + pure [] let placeUserActions = uaFromOnlyPlaces placeOrderActions cancelUserActions = uaFromOnlyCancels cancelOrderActions @@ -289,17 +283,15 @@ fixedSpreadVsMarketPriceStrategy } in map poi [0 .. (nOrders - 1)] - getEquityFromOrder ∷ MaestroMarketInfo → (SimTokenPair, PartialOrderInfo) → Natural - getEquityFromOrder mmi (stp, poi) = case M.lookup stp mmi of - Nothing → error "Absurd in getEquityFromOrder: Order SimTokenPair not in MarketInfo" - Just price → - let ownFunds = getOrderOwnFunds poi - priceOfNonAdaToken nonAdaAC = floor $ fromIntegral (valueAssetClass ownFunds nonAdaAC) * getPrice price - in (valueAssetClass ownFunds GYLovelace & fromIntegral) - + ( if poiOfferedAsset poi == GYLovelace - then priceOfNonAdaToken (poiAskedAsset poi) - else priceOfNonAdaToken (poiOfferedAsset poi) - ) + getEquityFromOrder ∷ Price → (SimTokenPair, PartialOrderInfo) → Natural + getEquityFromOrder price (_stp, poi) = + let ownFunds = getOrderOwnFunds poi + priceOfNonAdaToken nonAdaAC = floor $ fromIntegral (valueAssetClass ownFunds nonAdaAC) * getPrice price + in (valueAssetClass ownFunds GYLovelace & fromIntegral) + + ( if poiOfferedAsset poi == GYLovelace + then priceOfNonAdaToken (poiAskedAsset poi) + else priceOfNonAdaToken (poiOfferedAsset poi) + ) where -- \| Note that at any moment, an order UTxO contains:- -- * An NFT. @@ -313,12 +305,10 @@ fixedSpreadVsMarketPriceStrategy let toSubtract = valueSingleton (GYToken poiNFTCS poiNFT) 1 <> poiGetContainedFeeValue poi in poiUTxOValue `valueMinus` toSubtract - getEquityFromValue ∷ M.Map OrderAssetPair Price → GYAssetClass → Integer → Integer + getEquityFromValue ∷ Price → GYAssetClass → Integer → Integer getEquityFromValue _ GYLovelace n = n - getEquityFromValue mp' ac n = - let valueOAP = mkOrderAssetPair GYLovelace ac - price = maybe 0 getPrice (M.lookup valueOAP mp') - in floor $ price * fromInteger n + getEquityFromValue (getPrice → price) _ac n = + floor $ price * fromInteger n getOrdersLockedValue ∷ SimTokenPair → SimToken → [(SimTokenPair, PartialOrderInfo)] → Natural getOrdersLockedValue stp st orders = @@ -347,35 +337,26 @@ fixedSpreadVsMarketPriceStrategy show adjustedPrice, ")" ] - logMaestroMarketInfo ∷ MaestroMarketInfo → String - logMaestroMarketInfo mmi = - unlines - $ M.elems - $ M.mapWithKey - ( \stp p → - unwords - [ "Price for:", - prettyAc $ stAc $ commoditySt stp, - "is", - show (fromRational (getPrice p) ∷ Double) - ] - ) - mmi + logMaestroMarketInfo ∷ Price → String + logMaestroMarketInfo price = + unwords + [ "Price for:", + prettyAc $ stAc sToken, + "is", + show (fromRational (getPrice price) ∷ Double) + ] prettyAc ∷ GYAssetClass → String prettyAc GYLovelace = "lovelaces" prettyAc (GYToken _ tn) = "indivisible of " ++ show tn -ordersToBeRemoved ∷ (SimTokenPair → Maybe Price) → Rational → [(SimTokenPair, PartialOrderInfo)] → [(SimTokenPair, PartialOrderInfo)] -ordersToBeRemoved getSTPPrice cancelLimitSpread = filter (orderIsToBeRemoved getSTPPrice cancelLimitSpread) - -orderIsToBeRemoved ∷ (SimTokenPair → Maybe Price) → Rational → (SimTokenPair, PartialOrderInfo) → Bool -orderIsToBeRemoved getSTPPrice cancelLimitSpread (stp, poi) = - case getSTPPrice stp of - Nothing → False - Just mPrice → - let marketPrice = getPrice mPrice - oap = toOAPair stp - in case mkOrderInfo oap poi of - SomeOrderInfo OrderInfo {orderType = SBuyOrder, price} → getPrice price < marketPrice - (cancelLimitSpread * marketPrice) - SomeOrderInfo OrderInfo {orderType = SSellOrder, price} → getPrice price > marketPrice + (cancelLimitSpread * marketPrice) +ordersToBeRemoved ∷ Price → Rational → [(SimTokenPair, PartialOrderInfo)] → [(SimTokenPair, PartialOrderInfo)] +ordersToBeRemoved price cancelLimitSpread = filter (orderIsToBeRemoved price cancelLimitSpread) + +orderIsToBeRemoved ∷ Price → Rational → (SimTokenPair, PartialOrderInfo) → Bool +orderIsToBeRemoved mPrice cancelLimitSpread (stp, poi) = + let marketPrice = getPrice mPrice + oap = toOAPair stp + in case mkOrderInfo oap poi of + SomeOrderInfo OrderInfo {orderType = SBuyOrder, price} → getPrice price < marketPrice - (cancelLimitSpread * marketPrice) + SomeOrderInfo OrderInfo {orderType = SSellOrder, price} → getPrice price > marketPrice + (cancelLimitSpread * marketPrice) From d8603faa358361baf2e37374dc2397b48b8af68d Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Fri, 5 Jan 2024 14:22:31 +0530 Subject: [PATCH 03/12] Feat #11, #14, #18: Bug fix - to be able to place buy orders as well --- .../src/GeniusYield/MarketMaker/Strategies.hs | 38 ++++++++++--------- 1 file changed, 20 insertions(+), 18 deletions(-) diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs index ffab62f..b4e5950 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs @@ -226,24 +226,26 @@ fixedSpreadVsMarketPriceStrategy logWarn providers $ "Bot has to place buy order(s), but lack funds, needed at least: " ++ show (stimes numNewBuyOrders neededAtleast) -- We check for funds to place one order but in log describe inability for all orders because even if we have funds to place one order, out transaction build logic would see that and at least get that single one built successfully. pure [] - if tvSellVolThreshold <= fromIntegral sellVol || numNewSellOrders == 0 - then pure newBuyOrders - else do - let tokensToOfferPerOrder = availableSellBudget `quot` numNewSellOrders - neededAtleast = valueSingleton (stAc sToken) tokensToOfferPerOrder <> adaOverhead - if totalValueOnUtxos `valueGreaterOrEqual` neededAtleast - then - pure - $ buildNewUserOrders - scSpread - (lovelaceSt, sToken) - mp - (fromIntegral $ availableSellBudget `quot` numNewSellOrders) - (fromIntegral numNewSellOrders) - False - else do - logWarn providers $ "Bot has to place sell order(s), but lack funds, needed at least: " ++ show (stimes numNewSellOrders neededAtleast) -- We check for funds to place one order but in log describe inability for all orders. - pure [] + newSellOrders ← + if tvSellVolThreshold <= fromIntegral sellVol || numNewSellOrders == 0 + then pure [] + else do + let tokensToOfferPerOrder = availableSellBudget `quot` numNewSellOrders + neededAtleast = valueSingleton (stAc sToken) tokensToOfferPerOrder <> adaOverhead + if totalValueOnUtxos `valueGreaterOrEqual` neededAtleast + then + pure + $ buildNewUserOrders + scSpread + (lovelaceSt, sToken) + mp + (fromIntegral $ availableSellBudget `quot` numNewSellOrders) + (fromIntegral numNewSellOrders) + False + else do + logWarn providers $ "Bot has to place sell order(s), but lack funds, needed at least: " ++ show (stimes numNewSellOrders neededAtleast) -- We check for funds to place one order but in log describe inability for all orders. + pure [] + pure $ newBuyOrders <> newSellOrders let placeUserActions = uaFromOnlyPlaces placeOrderActions cancelUserActions = uaFromOnlyCancels cancelOrderActions From 8a389c840c1e479dcab95f8e16da4e4dc614ab88 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Fri, 5 Jan 2024 16:46:42 +0530 Subject: [PATCH 04/12] Feat #11, #14, #18: Code improvements --- docker-compose.yml | 4 +- .../geniusyield-market-maker.cabal | 3 +- .../src/GeniusYield/MarketMaker/Constants.hs | 18 +++ .../src/GeniusYield/MarketMaker/MakerBot.hs | 23 ++-- .../GeniusYield/MarketMaker/MakerBotConfig.hs | 2 +- .../src/GeniusYield/MarketMaker/Prices.hs | 72 +++++------ .../src/GeniusYield/MarketMaker/Strategies.hs | 119 +++++++++--------- sample-mainnet-maker-bot-config-gens.json | 4 +- sample-preprod-maker-bot-config-gens.json | 5 +- 9 files changed, 139 insertions(+), 111 deletions(-) create mode 100644 geniusyield-market-maker/src/GeniusYield/MarketMaker/Constants.hs diff --git a/docker-compose.yml b/docker-compose.yml index 4e83d84..21515fb 100644 --- a/docker-compose.yml +++ b/docker-compose.yml @@ -60,8 +60,8 @@ services: "sc_cancel_threshold_product": 4 }, "mbc_token": { - "stAc": "dda5fdb1002f7389b33e036b6afee82a8189becb6cba852e8b79b4fb.0014df1047454e53", - "stPrecision": 6 + "ac": "dda5fdb1002f7389b33e036b6afee82a8189becb6cba852e8b79b4fb.0014df1047454e53", + "precision": 6 } } restart: always diff --git a/geniusyield-market-maker/geniusyield-market-maker.cabal b/geniusyield-market-maker/geniusyield-market-maker.cabal index 9e9574a..0fb6328 100644 --- a/geniusyield-market-maker/geniusyield-market-maker.cabal +++ b/geniusyield-market-maker/geniusyield-market-maker.cabal @@ -118,7 +118,8 @@ executable geniusyield-market-maker-exe import: common-deps import: common-ghc-opts main-is: Main.hs - other-modules: GeniusYield.MarketMaker.MakerBotConfig + other-modules: GeniusYield.MarketMaker.Constants + , GeniusYield.MarketMaker.MakerBotConfig , GeniusYield.MarketMaker.MakerBot , GeniusYield.MarketMaker.Orphans , GeniusYield.MarketMaker.Prices diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Constants.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Constants.hs new file mode 100644 index 0000000..4d8e83c --- /dev/null +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Constants.hs @@ -0,0 +1,18 @@ +module GeniusYield.MarketMaker.Constants ( + awaitTxParams, + logNS, + makerFeeRatio, +) where + +import Data.Ratio ((%)) +import GeniusYield.Types + +awaitTxParams ∷ GYAwaitTxParameters +awaitTxParams = GYAwaitTxParameters {maxAttempts = 20, confirmations = 1, checkInterval = 10_000_000} + +logNS ∷ GYLogNamespace +logNS = "MM" + +-- TODO: Get it from blockchain instead. +makerFeeRatio ∷ Rational +makerFeeRatio = 3 % 100 diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs index c33e6b2..45274a1 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs @@ -13,6 +13,7 @@ import GeniusYield.Api.Dex.PartialOrder ( placePartialOrder, ) import GeniusYield.Imports (printf) +import GeniusYield.MarketMaker.Constants (awaitTxParams, logNS) import GeniusYield.MarketMaker.Prices import GeniusYield.MarketMaker.Strategies import GeniusYield.MarketMaker.Utils ( @@ -32,7 +33,7 @@ data MakerBot = MakerBot -- | Delay in microseconds between each iteration of execution strategy loop. mbDelay ∷ Int, -- | Non-ada token as other pair of the token is assumed to be ada. - mbToken ∷ SimToken + mbToken ∷ MMToken } ----------------------------------------------------------------------- @@ -43,9 +44,9 @@ cancelAllOrders ∷ MakerBot → GYNetworkId → GYProviders → DEXInfo → IO cancelAllOrders MakerBot {mbUser} netId providers di = do let go ∷ [PartialOrderInfo] → IO () go partialOrderInfos = do - gyLogInfo providers "MM" $ "---------- " ++ show (length partialOrderInfos) ++ " orders to cancel! -----------" + gyLogInfo providers logNS $ "---------- " ++ show (length partialOrderInfos) ++ " orders to cancel! -----------" when (null partialOrderInfos) $ do - gyLogInfo providers "MM" "---------- No more orders to cancel! -----------" + gyLogInfo providers logNS "---------- No more orders to cancel! -----------" exitSuccess let (batch, rest) = splitAt 6 partialOrderInfos userAddr = addrFromSkey netId $ uSKey mbUser @@ -55,9 +56,9 @@ cancelAllOrders MakerBot {mbUser} netId providers di = do let signedTx = signGYTxBody txBody [uSKey mbUser] tid ← gySubmitTx providers signedTx - gyLogInfo providers "MM" $ "Submitted a cancel order batch: " ++ show tid - gyLogInfo providers "MM" "---------- Done for the block! -----------" - gyAwaitTxConfirmed providers (GYAwaitTxParameters {maxAttempts = 20, confirmations = 1, checkInterval = 20_000_000}) tid + gyLogInfo providers logNS $ "Submitted a cancel order batch: " ++ show tid + gyLogInfo providers logNS "---------- Done for the block! -----------" + gyAwaitTxConfirmed providers awaitTxParams tid go rest partialOrderInfos ← runGYTxQueryMonadNode netId providers $ runReaderT (partialOrders (dexPORefs di)) di let userPkh = pkhFromSkey . uSKey $ mbUser @@ -91,8 +92,8 @@ buildAndSubmitActions User {uSKey, uColl} providers netId ua di = flip catches h Nothing buildCommon txBody where - logWarn = gyLogWarning providers "MM" - logInfo = gyLogInfo providers "MM" + logWarn = gyLogWarning providers logNS + logInfo = gyLogInfo providers logNS handlers = let handlerCommon ∷ Exception e ⇒ e → IO () @@ -112,9 +113,9 @@ buildAndSubmitActions User {uSKey, uColl} providers netId ua di = flip catches h logInfo $ "Successfully built body for above action, tx id: " <> show (txBodyTxId txBody) let tx = signGYTxBody txBody [uSKey] tid ← gySubmitTx providers tx - let numConfirms = 1 + let numConfirms = confirmations awaitTxParams logInfo $ printf "Successfully submitted above tx, now waiting for %d confirmation(s)" numConfirms - gyAwaitTxConfirmed providers (GYAwaitTxParameters {checkInterval = 10_000_000, confirmations = numConfirms, maxAttempts = 30}) tid + gyAwaitTxConfirmed providers awaitTxParams tid logInfo $ printf "Tx successfully seen on chain with %d confirmation(s)" numConfirms executeStrategy @@ -131,5 +132,5 @@ executeStrategy runStrategy MakerBot {mbUser, mbDelay, mbToken} netId providers buildAndSubmitActions mbUser providers netId newActions di - gyLogInfo providers "MM" "---------- Done for the block! -----------" + gyLogInfo providers logNS "---------- Done for the block! -----------" threadDelay mbDelay diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBotConfig.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBotConfig.hs index 992845c..1ccf7cd 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBotConfig.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBotConfig.hs @@ -41,7 +41,7 @@ data MakerBotConfig = MakerBotConfig mbcPOConfigAddr ∷ !GYAddressBech32, mbcPORefs ∷ !PORefs, mbcDelay ∷ !Int, - mbcToken ∷ !SimToken, + mbcToken ∷ !MMToken, mbcStrategyConfig ∷ !StrategyConfig, mbcPriceConfig ∷ !PriceConfig } diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs index 6d3faa8..9a89258 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs @@ -43,36 +43,36 @@ data MaestroPriceException deriving stock (Show) deriving anyclass (Exception) -data SimTokenPair = SimTokenPair - { currencySt ∷ SimToken, - commoditySt ∷ SimToken +data MMToken = MMToken + { mmtAc ∷ GYAssetClass, + mmtPrecision ∷ Int + } + deriving stock (Eq, Ord, Show, Generic) + deriving (FromJSON, ToJSON) via CustomJSON '[FieldLabelModifier '[StripPrefix "mmt", LowerFirst]] MMToken + +lovelaceSt ∷ MMToken +lovelaceSt = MMToken {mmtAc = GYLovelace, mmtPrecision = 6} + +data MMTokenPair = MMTokenPair + { mmtpCurrency ∷ MMToken, + mmtpCommodity ∷ MMToken } deriving stock (Eq, Ord, Show) -mkSimTokenPair ∷ SimToken → SimToken → SimTokenPair -mkSimTokenPair currSt commSt = - SimTokenPair - { currencySt = currSt, - commoditySt = commSt +mkMMTokenPair ∷ MMToken → MMToken → MMTokenPair +mkMMTokenPair currSt commSt = + MMTokenPair + { mmtpCurrency = currSt, + mmtpCommodity = commSt } -toOAPair ∷ SimTokenPair → OrderAssetPair -toOAPair SimTokenPair {currencySt, commoditySt} = +toOAPair ∷ MMTokenPair → OrderAssetPair +toOAPair MMTokenPair {mmtpCurrency, mmtpCommodity} = OAssetPair - { currencyAsset = stAc currencySt, - commodityAsset = stAc commoditySt + { currencyAsset = mmtAc mmtpCurrency, + commodityAsset = mmtAc mmtpCommodity } -data SimToken = SimToken - { stAc ∷ GYAssetClass, - stPrecision ∷ Int - } - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (FromJSON, ToJSON) - -lovelaceSt ∷ SimToken -lovelaceSt = SimToken {stAc = GYLovelace, stPrecision = 6} - data MaestroPairOverride = MaestroPairOverride { mpoPair ∷ !String, mpoCommodityIsFirst ∷ !Bool @@ -131,7 +131,7 @@ data OBMarketTokenInfo = OBMarketTokenInfo } deriving stock (Show) -type OBMarketInfo = M.Map SimTokenPair OBMarketTokenInfo +type OBMarketInfo = M.Map MMTokenPair OBMarketTokenInfo mkOBMarketTokenInfo ∷ Price @@ -151,11 +151,11 @@ mkOBMarketTokenInfo (Price marketPrice) spread sellOrders buyOrders = sumVolBuy ∷ Volume sumVolBuy = volumeGTPrice (Price (marketPrice - (marketPrice * spread))) buyOrders -type MaestroMarketInfo = M.Map SimTokenPair Price +type MaestroMarketInfo = M.Map MMTokenPair Price getOrderBookPrices ∷ PricesProviders - → [SimTokenPair] + → [MMTokenPair] → Price → Rational → IO (OBMarketInfo, MultiAssetOrderBook) @@ -163,15 +163,15 @@ getOrderBookPrices PP {orderBookPP = (c, dex)} stps price priceCheckSpread = do maOrderBook ← populateOrderBook c dex (dexPORefs dex) (map toOAPair stps) return (M.fromList $ map buildPrice $ maOrderBookToList maOrderBook, maOrderBook) where - buildPrice ∷ (OrderAssetPair, OrderBook) → (SimTokenPair, OBMarketTokenInfo) + buildPrice ∷ (OrderAssetPair, OrderBook) → (MMTokenPair, OBMarketTokenInfo) buildPrice (oap, ob) = let stPair = toSTPair oap sndElement = uncurry (mkOBMarketTokenInfo price priceCheckSpread) . (sellOrders &&& buyOrders) $ ob in (stPair, sndElement) - toSTPair ∷ OrderAssetPair → SimTokenPair + toSTPair ∷ OrderAssetPair → MMTokenPair toSTPair OAssetPair {currencyAsset, commodityAsset} = - find (\SimTokenPair {..} → stAc currencySt == currencyAsset && stAc commoditySt == commodityAsset) stps + find (\MMTokenPair {..} → mmtAc mmtpCurrency == currencyAsset && mmtAc mmtpCommodity == commodityAsset) stps & fromJust -- | Remove headers (if `MaestroError` contains `ClientError`). @@ -189,7 +189,7 @@ handleMaestroError locationInfo = either (throwMspvApiError locationInfo) pure getMaestroPrice ∷ PricesProviders - → SimTokenPair + → MMTokenPair → IO Price getMaestroPrice PP {maestroPP = MaestroPP {..}} stp = do (pairName, commodityIsA) ← case mppOverride of @@ -198,7 +198,7 @@ getMaestroPrice PP {maestroPP = MaestroPP {..}} stp = do pure (pack mpoPair, mpoCommodityIsFirst) -- We are given commodity token and need to find pair name. Nothing → do - allDexPairs ← dexPairResponsePairs <$> (handleMaestroError "getMaestroPrice - fetching dex pairs" <=< try $ pairsFromDex mppEnv mppDex) + allDexPairs ← dexPairResponsePairs <$> (handleMaestroError (functionLocationIdent <> " - fetching dex pairs") <=< try $ pairsFromDex mppEnv mppDex) let go [] = throwIO MaestroPairNotFound go (dpi : dpis) = maybe (go dpis) pure $ isRelevantPairInfo dpi @@ -206,11 +206,11 @@ getMaestroPrice PP {maestroPP = MaestroPP {..}} stp = do let pair = TaggedText pairName - ohlInfo ← handleMaestroError "getMaestroPrice - fetching price from pair" <=< try $ pricesFromDex mppEnv mppDex pair (Just Res5m) (Just Descending) + ohlInfo ← handleMaestroError (functionLocationIdent <> " - fetching price from pair") <=< try $ pricesFromDex mppEnv mppDex pair (Just Res5m) (Just Descending) let info = head ohlInfo - curPrecision = stPrecision $ currencySt stp - comPrecision = stPrecision $ commoditySt stp + curPrecision = mmtPrecision $ mmtpCurrency stp + comPrecision = mmtPrecision $ mmtpCommodity stp precisionDiff = 10 ** fromIntegral (curPrecision - comPrecision) price = @@ -235,8 +235,10 @@ getMaestroPrice PP {maestroPP = MaestroPP {..}} stp = do (dexPairInfoCoinAAssetName, dexPairInfoCoinAPolicy) ) - findMatchingSTP ∷ (TokenName, PolicyId) → (TokenName, PolicyId) → Maybe SimTokenPair + findMatchingSTP ∷ (TokenName, PolicyId) → (TokenName, PolicyId) → Maybe MMTokenPair findMatchingSTP tokenA tokenB = fromRight Nothing $ do assetClassA ← assetClassFromMaestro tokenA assetClassB ← assetClassFromMaestro tokenB - Right $ if assetClassA == stAc (currencySt stp) && assetClassB == stAc (commoditySt stp) then Just stp else Nothing + Right $ if assetClassA == mmtAc (mmtpCurrency stp) && assetClassB == mmtAc (mmtpCommodity stp) then Just stp else Nothing + + functionLocationIdent = "getMaestroPrice" diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs index b4e5950..d044d94 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs @@ -1,6 +1,7 @@ module GeniusYield.MarketMaker.Strategies where import Control.Applicative ((<|>)) +import Control.Monad (unless) import Data.Foldable import Data.Function ((&)) import Data.Functor ((<&>)) @@ -22,6 +23,8 @@ import GeniusYield.Api.Dex.PartialOrder ( PartialOrderInfo (..), poiGetContainedFeeValue, ) +import GeniusYield.Imports (printf) +import GeniusYield.MarketMaker.Constants (logNS, makerFeeRatio) import GeniusYield.MarketMaker.Prices import GeniusYield.MarketMaker.Utils import GeniusYield.OrderBot.DataSource.Providers (Connection (..)) @@ -81,7 +84,7 @@ data PlaceOrderAction = PlaceOrderAction newtype CancelOrderAction = CancelOrderAction {coaPoi ∷ PartialOrderInfo} deriving stock (Show) -type Strategy = PricesProviders → User → SimToken → IO UserActions +type Strategy = PricesProviders → User → MMToken → IO UserActions data StrategyConfig = StrategyConfig { scSpread ∷ !Rational, @@ -105,24 +108,24 @@ data TokenVol = TokenVol -- | Uses a `MultiAssetOrderBook` to call `filterOwnOrders`. getOwnOrders - ∷ [SimTokenPair] + ∷ [MMTokenPair] → [User] → MultiAssetOrderBook - → M.Map User [(SimTokenPair, PartialOrderInfo)] + → M.Map User [(MMTokenPair, PartialOrderInfo)] getOwnOrders stps users maob = let sOrders = withEachAsset (\_ ob → toAscList $ unOrders $ sellOrders ob) maob bOrders = withEachAsset (\_ ob → toAscList $ unOrders $ buyOrders ob) maob in filterOwnOrders stps users (map (poi . orderInfo) sOrders ++ map (poi . orderInfo) bOrders) -{- | Given a list of relevant `SimTokenPair`'s, a list of users and a list of +{- | Given a list of relevant `MMTokenPair`'s, a list of users and a list of @PartialOrderInfo@. Returns a @Map@ between the users and the @PartialOrderInfo@'s that belong to that user and trade in one of the relevant pairs. -} filterOwnOrders - ∷ [SimTokenPair] + ∷ [MMTokenPair] → [User] → [PartialOrderInfo] - → M.Map User [(SimTokenPair, PartialOrderInfo)] + → M.Map User [(MMTokenPair, PartialOrderInfo)] filterOwnOrders stps users allOrders = let usersPkh = map (pkhFromSkey . uSKey) users ourPOIs = filter (flip elem usersPkh . poiOwnerKey) allOrders @@ -130,14 +133,14 @@ filterOwnOrders stps users allOrders = finalMap = foldl' (\acc (stp, poi) → M.unionWith (++) acc (M.singleton (lookupUser poi) [(stp, poi)])) mempty relevantTokensPOIs in finalMap where - filterTokenPair ∷ [SimTokenPair] → PartialOrderInfo → Maybe (SimTokenPair, PartialOrderInfo) + filterTokenPair ∷ [MMTokenPair] → PartialOrderInfo → Maybe (MMTokenPair, PartialOrderInfo) filterTokenPair sTokenPairs poi@PartialOrderInfo {poiOfferedAsset, poiAskedAsset} = findStp assetPair1 <|> findStp assetPair2 <&> (,poi) where assetPair1 = mkOrderAssetPair poiOfferedAsset poiAskedAsset assetPair2 = mkOrderAssetPair poiAskedAsset poiOfferedAsset - findStp ∷ OrderAssetPair → Maybe SimTokenPair + findStp ∷ OrderAssetPair → Maybe MMTokenPair findStp ap = find (\stp → ap == toOAPair stp) sTokenPairs lookupUser ∷ PartialOrderInfo → User @@ -157,14 +160,13 @@ fixedSpreadVsMarketPriceStrategy user sToken = do let (Connection nid providers, _) = orderBookPP pp - sTokenPair = mkSimTokenPair lovelaceSt sToken -- TODO: Currency is always lovelace. There is an assumption that lovelace is not part of @sTokens@ which should be made explicit in documentation. + sTokenPair = mkMMTokenPair lovelaceSt sToken -- TODO: Currency is always lovelace. There is an assumption that lovelace is not part of @sTokens@ which should be made explicit in documentation. userAddr = (addrFromSkey nid . uSKey) user cancelThreshold = fromInteger scCancelThresholdProduct * scSpread priceCheckThreshold = fromInteger scPriceCheckProduct * scSpread mp ← getMaestroPrice pp sTokenPair - logDebug providers $ "Maestro Prices: " ++ show mp logInfo providers $ logMaestroMarketInfo mp (bp, maob) ← getOrderBookPrices pp [sTokenPair] mp priceCheckThreshold @@ -180,7 +182,7 @@ fixedSpreadVsMarketPriceStrategy map (\(_, poi) → CancelOrderAction poi) $ ordersToBeRemoved mp cancelThreshold allOwnOrders - relevantSTP = mkSimTokenPair lovelaceSt sToken + relevantSTP = mkMMTokenPair lovelaceSt sToken mtInfo = M.lookup relevantSTP bp lockedLovelaces = getOrdersLockedValue relevantSTP lovelaceSt allOwnOrders @@ -205,46 +207,52 @@ fixedSpreadVsMarketPriceStrategy numNewBuyOrders = availableBuyBudget `quot` tvBuyMinVol numNewSellOrders = availableSellBudget `quot` tvSellMinVol adaOverhead = valueFromLovelace 5_000_000 + subtractTillZero ∷ GYValue → GYValue → Natural → Natural + subtractTillZero val sub acc = if val `valueGreaterOrEqual` sub then subtractTillZero (val `valueMinus` sub) sub (acc + 1) else acc - newBuyOrders ← + (newBuyOrders, totalValueOnUtxosAfterBuyOrds) ← if tvBuyVolThreshold <= fromIntegral buyVol || numNewBuyOrders == 0 - then pure [] + then pure ([], totalValueOnUtxos) else do let tokensToOfferPerOrder = availableBuyBudget `quot` numNewBuyOrders - neededAtleast = valueFromLovelace tokensToOfferPerOrder <> adaOverhead - if totalValueOnUtxos `valueGreaterOrEqual` neededAtleast - then - pure - $ buildNewUserOrders - scSpread - (sToken, lovelaceSt) - mp - (fromIntegral tokensToOfferPerOrder) - (fromIntegral numNewBuyOrders) - True - else do - logWarn providers $ "Bot has to place buy order(s), but lack funds, needed at least: " ++ show (stimes numNewBuyOrders neededAtleast) -- We check for funds to place one order but in log describe inability for all orders because even if we have funds to place one order, out transaction build logic would see that and at least get that single one built successfully. - pure [] + neededAtleastPerOrder = valueFromLovelace (ceiling $ toRational tokensToOfferPerOrder * (1 + makerFeeRatio)) <> adaOverhead + neededAtleast = stimes numNewBuyOrders neededAtleastPerOrder + valueSufficient = totalValueOnUtxos `valueGreaterOrEqual` neededAtleast + actualNumNewBuyOrders = if valueSufficient then numNewBuyOrders else fromIntegral $ subtractTillZero totalValueOnUtxos neededAtleastPerOrder 0 + totalValueOnUtxosAfterBuyOrds = totalValueOnUtxos `valueMinus` stimes actualNumNewBuyOrders neededAtleastPerOrder + + unless valueSufficient $ logWarn providers $ printf "Bot has to place %d buy order(s), but lack funds, total balance (excluding collateral) should be at least: %s but available funds are: %s. Only placing %d buy order(s)." numNewBuyOrders (show neededAtleast) (show totalValueOnUtxos) actualNumNewBuyOrders + + pure + ( buildNewUserOrders + scSpread + (sToken, lovelaceSt) + mp + (fromIntegral tokensToOfferPerOrder) + (fromIntegral actualNumNewBuyOrders) + True, + totalValueOnUtxosAfterBuyOrds + ) newSellOrders ← if tvSellVolThreshold <= fromIntegral sellVol || numNewSellOrders == 0 then pure [] else do let tokensToOfferPerOrder = availableSellBudget `quot` numNewSellOrders - neededAtleast = valueSingleton (stAc sToken) tokensToOfferPerOrder <> adaOverhead - if totalValueOnUtxos `valueGreaterOrEqual` neededAtleast - then - pure - $ buildNewUserOrders - scSpread - (lovelaceSt, sToken) - mp - (fromIntegral $ availableSellBudget `quot` numNewSellOrders) - (fromIntegral numNewSellOrders) - False - else do - logWarn providers $ "Bot has to place sell order(s), but lack funds, needed at least: " ++ show (stimes numNewSellOrders neededAtleast) -- We check for funds to place one order but in log describe inability for all orders. - pure [] + neededAtleastPerOrder = valueSingleton (mmtAc sToken) (ceiling $ toRational tokensToOfferPerOrder * (1 + makerFeeRatio)) <> adaOverhead + neededAtleast = stimes numNewSellOrders neededAtleastPerOrder + valueSufficient = totalValueOnUtxosAfterBuyOrds `valueGreaterOrEqual` neededAtleast + actualNumNewSellOrders = if valueSufficient then numNewSellOrders else fromIntegral $ subtractTillZero totalValueOnUtxosAfterBuyOrds neededAtleastPerOrder 0 + + unless valueSufficient $ logWarn providers $ printf "Bot has to place %d sell order(s), but lack funds, total balance (excluding collateral & value reserved for buy order(s)) should be at least: %s but available funds are: %s. Only placing %d sell order(s)." numNewSellOrders (show neededAtleast) (show totalValueOnUtxosAfterBuyOrds) actualNumNewSellOrders + pure + $ buildNewUserOrders + scSpread + (lovelaceSt, sToken) + mp + (fromIntegral $ availableSellBudget `quot` numNewSellOrders) + (fromIntegral actualNumNewSellOrders) + False pure $ newBuyOrders <> newSellOrders let placeUserActions = uaFromOnlyPlaces placeOrderActions @@ -267,7 +275,7 @@ fixedSpreadVsMarketPriceStrategy where buildNewUserOrders ∷ Rational - → (SimToken, SimToken) + → (MMToken, MMToken) → Price → Natural → Natural @@ -278,14 +286,13 @@ fixedSpreadVsMarketPriceStrategy poi n = let newMPrice = (1 + (1 + 0.5 * toRational n) * (if toInverse then -1 else 1) * delta') * p' in PlaceOrderAction - { poaOfferedAsset = stAc off, + { poaOfferedAsset = mmtAc off, poaOfferedAmount = naturalFromInteger $ fromIntegral tokenQ, - poaAskedAsset = stAc ask, + poaAskedAsset = mmtAc ask, poaPrice = rationalFromGHC $ if toInverse then denominator newMPrice % numerator newMPrice else newMPrice } - in map poi [0 .. (nOrders - 1)] - - getEquityFromOrder ∷ Price → (SimTokenPair, PartialOrderInfo) → Natural + in if nOrders == 0 then [] else map poi [0 .. (nOrders - 1)] -- `nOrders` has type `Natural` thus subtracting from zero can give arithmetic exception. + getEquityFromOrder ∷ Price → (MMTokenPair, PartialOrderInfo) → Natural getEquityFromOrder price (_stp, poi) = let ownFunds = getOrderOwnFunds poi priceOfNonAdaToken nonAdaAC = floor $ fromIntegral (valueAssetClass ownFunds nonAdaAC) * getPrice price @@ -312,16 +319,16 @@ fixedSpreadVsMarketPriceStrategy getEquityFromValue (getPrice → price) _ac n = floor $ price * fromInteger n - getOrdersLockedValue ∷ SimTokenPair → SimToken → [(SimTokenPair, PartialOrderInfo)] → Natural + getOrdersLockedValue ∷ MMTokenPair → MMToken → [(MMTokenPair, PartialOrderInfo)] → Natural getOrdersLockedValue stp st orders = - let relevantOfferedAc = stAc st + let relevantOfferedAc = mmtAc st relevantOrders = filter (\(oStp, oPoi) → oStp == stp && relevantOfferedAc == poiOfferedAsset oPoi) orders in sum $ map (poiOfferedAmount . snd) relevantOrders logInfo, logDebug, logWarn ∷ GYProviders → String → IO () - logInfo providers = gyLogInfo providers "MM" - logDebug providers = gyLogDebug providers "MM" - logWarn providers = gyLogWarning providers "MM" + logInfo providers = gyLogInfo providers logNS + logDebug providers = gyLogDebug providers logNS + logWarn providers = gyLogWarning providers logNS logPlaceAction ∷ PlaceOrderAction → String logPlaceAction PlaceOrderAction {..} = @@ -335,7 +342,7 @@ fixedSpreadVsMarketPriceStrategy show price, prettyAc poaAskedAsset, "each", - "(", + "(inverted price:", show adjustedPrice, ")" ] @@ -343,7 +350,7 @@ fixedSpreadVsMarketPriceStrategy logMaestroMarketInfo price = unwords [ "Price for:", - prettyAc $ stAc sToken, + prettyAc $ mmtAc sToken, "is", show (fromRational (getPrice price) ∷ Double) ] @@ -352,10 +359,10 @@ fixedSpreadVsMarketPriceStrategy prettyAc GYLovelace = "lovelaces" prettyAc (GYToken _ tn) = "indivisible of " ++ show tn -ordersToBeRemoved ∷ Price → Rational → [(SimTokenPair, PartialOrderInfo)] → [(SimTokenPair, PartialOrderInfo)] +ordersToBeRemoved ∷ Price → Rational → [(MMTokenPair, PartialOrderInfo)] → [(MMTokenPair, PartialOrderInfo)] ordersToBeRemoved price cancelLimitSpread = filter (orderIsToBeRemoved price cancelLimitSpread) -orderIsToBeRemoved ∷ Price → Rational → (SimTokenPair, PartialOrderInfo) → Bool +orderIsToBeRemoved ∷ Price → Rational → (MMTokenPair, PartialOrderInfo) → Bool orderIsToBeRemoved mPrice cancelLimitSpread (stp, poi) = let marketPrice = getPrice mPrice oap = toOAPair stp diff --git a/sample-mainnet-maker-bot-config-gens.json b/sample-mainnet-maker-bot-config-gens.json index b1c3fda..677cbc8 100644 --- a/sample-mainnet-maker-bot-config-gens.json +++ b/sample-mainnet-maker-bot-config-gens.json @@ -34,7 +34,7 @@ "sc_cancel_threshold_product": 4 }, "mbc_token": { - "stAc": "dda5fdb1002f7389b33e036b6afee82a8189becb6cba852e8b79b4fb.0014df1047454e53", - "stPrecision": 6 + "ac": "dda5fdb1002f7389b33e036b6afee82a8189becb6cba852e8b79b4fb.0014df1047454e53", + "precision": 6 } } diff --git a/sample-preprod-maker-bot-config-gens.json b/sample-preprod-maker-bot-config-gens.json index 7c1e9db..f9f55f4 100644 --- a/sample-preprod-maker-bot-config-gens.json +++ b/sample-preprod-maker-bot-config-gens.json @@ -17,7 +17,6 @@ "pc_network_id": "mainnet", "pc_dex": "genius-yield", "pc_override": { - "mpo_commodity_token": "c6e65ba7878b2f8ea0ad39287d3e2fd256dc5c4160fc19bdf4c4d87e.7447454e53", "mpo_pair": "ADA-GENS", "mpo_commodity_is_first": false } @@ -39,7 +38,7 @@ "sc_cancel_threshold_product": 4 }, "mbc_token": { - "stAc": "c6e65ba7878b2f8ea0ad39287d3e2fd256dc5c4160fc19bdf4c4d87e.7447454e53", - "stPrecision": 6 + "ac": "c6e65ba7878b2f8ea0ad39287d3e2fd256dc5c4160fc19bdf4c4d87e.7447454e53", + "precision": 6 } } From cfd0017203628928101efb85b0455f0bd16647a3 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Fri, 5 Jan 2024 17:28:11 +0530 Subject: [PATCH 05/12] Feat #16: Support to place orders at mangled address --- .../geniusyield-market-maker.cabal | 1 + .../src/GeniusYield/MarketMaker/MakerBot.hs | 5 +- .../GeniusYield/MarketMaker/MakerBotConfig.hs | 16 +------ .../src/GeniusYield/MarketMaker/Strategies.hs | 7 +-- .../src/GeniusYield/MarketMaker/User.hs | 46 +++++++++++++++++++ sample-mainnet-maker-bot-config-gens.json | 3 +- sample-preprod-maker-bot-config-gens.json | 3 +- 7 files changed, 57 insertions(+), 24 deletions(-) create mode 100644 geniusyield-market-maker/src/GeniusYield/MarketMaker/User.hs diff --git a/geniusyield-market-maker/geniusyield-market-maker.cabal b/geniusyield-market-maker/geniusyield-market-maker.cabal index 0fb6328..c470817 100644 --- a/geniusyield-market-maker/geniusyield-market-maker.cabal +++ b/geniusyield-market-maker/geniusyield-market-maker.cabal @@ -124,6 +124,7 @@ executable geniusyield-market-maker-exe , GeniusYield.MarketMaker.Orphans , GeniusYield.MarketMaker.Prices , GeniusYield.MarketMaker.Strategies + , GeniusYield.MarketMaker.User , GeniusYield.MarketMaker.Utils build-depends: , geniusyield-orderbot-framework:common diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs index 45274a1..908b8b2 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs @@ -16,6 +16,7 @@ import GeniusYield.Imports (printf) import GeniusYield.MarketMaker.Constants (awaitTxParams, logNS) import GeniusYield.MarketMaker.Prices import GeniusYield.MarketMaker.Strategies +import GeniusYield.MarketMaker.User import GeniusYield.MarketMaker.Utils ( DEXInfo (dexPORefs), addrFromSkey, @@ -66,7 +67,7 @@ cancelAllOrders MakerBot {mbUser} netId providers di = do go userPOIs buildAndSubmitActions ∷ User → GYProviders → GYNetworkId → UserActions → DEXInfo → IO () -buildAndSubmitActions User {uSKey, uColl} providers netId ua di = flip catches handlers $ do +buildAndSubmitActions User {uSKey, uColl, uStakeAddress} providers netId ua di = flip catches handlers $ do let userAddr = addrFromSkey netId uSKey placeActions = uaPlaces ua cancelActions = uaCancels ua @@ -89,7 +90,7 @@ buildAndSubmitActions User {uSKey, uColl} providers netId ua di = flip catches h poaPrice Nothing Nothing - Nothing + (stakeAddressCredential . stakeAddressFromBech32 <$> uStakeAddress) buildCommon txBody where logWarn = gyLogWarning providers logNS diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBotConfig.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBotConfig.hs index 1ccf7cd..c14df7d 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBotConfig.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBotConfig.hs @@ -9,10 +9,11 @@ import Data.Aeson ( import Data.String (IsString (..)) import Deriving.Aeson import GeniusYield.Api.Dex.PartialOrder (PORefs (..)) -import GeniusYield.MarketMaker.MakerBot +import GeniusYield.MarketMaker.MakerBot (MakerBot (..)) import GeniusYield.MarketMaker.Orphans () import GeniusYield.MarketMaker.Prices import GeniusYield.MarketMaker.Strategies +import GeniusYield.MarketMaker.User import GeniusYield.MarketMaker.Utils import GeniusYield.Types import PlutusLedgerApi.V1 (Address) @@ -21,19 +22,6 @@ import PlutusLedgerApi.V1.Value (AssetClass) import Ply (ScriptRole (..), TypedScript, readTypedScript) import System.Envy (FromEnv (fromEnv), decodeEnv, env) -data UserRaw = UserRaw - { urSKeyPath ∷ FilePath, - urColl ∷ Maybe GYTxOutRef - } - deriving stock (Generic, Show, Eq) - deriving (FromJSON, ToJSON) via CustomJSON '[FieldLabelModifier '[CamelToSnake]] UserRaw - -getUser ∷ UserRaw → IO User -getUser UserRaw {urSKeyPath, urColl} = do - let collateral = (,False) <$> urColl - uSKey ← readPaymentSigningKey urSKeyPath - pure $ User {uSKey = uSKey, uColl = collateral} - data MakerBotConfig = MakerBotConfig { mbcUser ∷ !UserRaw, mbcFPNftPolicy ∷ !FilePath, diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs index d044d94..e19ee79 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs @@ -26,6 +26,7 @@ import GeniusYield.Api.Dex.PartialOrder ( import GeniusYield.Imports (printf) import GeniusYield.MarketMaker.Constants (logNS, makerFeeRatio) import GeniusYield.MarketMaker.Prices +import GeniusYield.MarketMaker.User (User (..)) import GeniusYield.MarketMaker.Utils import GeniusYield.OrderBot.DataSource.Providers (Connection (..)) import GeniusYield.OrderBot.OrderBook.AnnSet ( @@ -41,12 +42,6 @@ import GeniusYield.TxBuilder ( ) import GeniusYield.Types -data User = User - { uSKey ∷ !GYPaymentSigningKey, - uColl ∷ !(Maybe (GYTxOutRef, Bool)) - } - deriving stock (Generic, Show, Eq, Ord) - data UserActions = UserActions { uaPlaces ∷ [PlaceOrderAction], uaCancels ∷ [CancelOrderAction] diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/User.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/User.hs new file mode 100644 index 0000000..fc9bd33 --- /dev/null +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/User.hs @@ -0,0 +1,46 @@ +module GeniusYield.MarketMaker.User where + +import Data.Aeson (withText) +import Deriving.Aeson +import GeniusYield.Imports +import GeniusYield.Types + +-- TODO: Move to Atlas. +newtype GYStakeAddressBech32 = GYStakeAddressBech32 GYStakeAddress + deriving newtype (Show, Eq, Ord) + +stakeAddressToBech32 ∷ GYStakeAddress → GYStakeAddressBech32 +stakeAddressToBech32 = coerce + +stakeAddressFromBech32 ∷ GYStakeAddressBech32 → GYStakeAddress +stakeAddressFromBech32 = coerce + +instance ToJSON GYStakeAddressBech32 where + toJSON (GYStakeAddressBech32 addr) = toJSON $ stakeAddressToText addr + +instance FromJSON GYStakeAddressBech32 where + parseJSON = withText "GYStakeAddressBech32" $ \t → + case stakeAddressFromTextMaybe t of + Just addr → pure $ GYStakeAddressBech32 addr + Nothing → fail "cannot deserialise stake address" + +data UserRaw = UserRaw + { urSKeyPath ∷ !FilePath, + urColl ∷ !(Maybe GYTxOutRef), + urStakeAddress ∷ !(Maybe GYStakeAddressBech32) + } + deriving stock (Generic, Show, Eq) + deriving (FromJSON, ToJSON) via CustomJSON '[FieldLabelModifier '[CamelToSnake]] UserRaw + +getUser ∷ UserRaw → IO User +getUser UserRaw {urSKeyPath, urColl, urStakeAddress} = do + let collateral = (,False) <$> urColl + uSKey ← readPaymentSigningKey urSKeyPath + pure $ User {uSKey = uSKey, uColl = collateral, uStakeAddress = urStakeAddress} + +data User = User + { uSKey ∷ !GYPaymentSigningKey, + uColl ∷ !(Maybe (GYTxOutRef, Bool)), + uStakeAddress ∷ !(Maybe GYStakeAddressBech32) + } + deriving stock (Generic, Show, Eq, Ord) diff --git a/sample-mainnet-maker-bot-config-gens.json b/sample-mainnet-maker-bot-config-gens.json index 677cbc8..564b906 100644 --- a/sample-mainnet-maker-bot-config-gens.json +++ b/sample-mainnet-maker-bot-config-gens.json @@ -1,7 +1,8 @@ { "mbc_user": { "ur_s_key_path": "path-to-skey", - "ur_coll": "tx-id#tx-ix" + "ur_coll": "tx-id#tx-ix", + "ur_stake_address": "bech32-encoded-stake-address" }, "mbc_fp_nft_policy": "compiled-scripts/minting-policy", "mbc_fp_order_validator": "compiled-scripts/partial-order", diff --git a/sample-preprod-maker-bot-config-gens.json b/sample-preprod-maker-bot-config-gens.json index f9f55f4..6fd1df7 100644 --- a/sample-preprod-maker-bot-config-gens.json +++ b/sample-preprod-maker-bot-config-gens.json @@ -1,7 +1,8 @@ { "mbc_user": { "ur_s_key_path": "path-to-skey", - "ur_coll": "tx-id#tx-ix" + "ur_coll": "tx-id#tx-ix", + "ur_stake_address": "bech32-encoded-stake-address" }, "mbc_fp_nft_policy": "compiled-scripts/minting-policy", "mbc_fp_order_validator": "compiled-scripts/partial-order", From 63bbebc013161375c9095b3839eaa6e8cb21226e Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Fri, 5 Jan 2024 17:37:46 +0530 Subject: [PATCH 06/12] Feat #23: Get resolution for maestro price provider from configuration --- .../src/GeniusYield/MarketMaker/Prices.hs | 5 ++++- sample-mainnet-maker-bot-config-gens.json | 1 + sample-preprod-maker-bot-config-gens.json | 1 + 3 files changed, 6 insertions(+), 1 deletion(-) diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs index 9a89258..6fcdf7b 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs @@ -82,6 +82,7 @@ data MaestroPairOverride = MaestroPairOverride data PriceConfig = PriceConfig { pcApiKey ∷ !(Confidential Text), + pcResolution ∷ !Resolution, pcNetworkId ∷ !GYNetworkId, pcDex ∷ !Dex, pcOverride ∷ !(Maybe MaestroPairOverride) @@ -91,6 +92,7 @@ data PriceConfig = PriceConfig data MaestroPP = MaestroPP { mppEnv ∷ !(MaestroEnv 'V1), + mppResolution ∷ !Resolution, mppDex ∷ !Dex, mppOverride ∷ !(Maybe MaestroPairOverride) } @@ -116,6 +118,7 @@ buildPP c dex PriceConfig {..} = return MaestroPP { mppEnv = env, + mppResolution = pcResolution, mppDex = pcDex, mppOverride = pcOverride } @@ -206,7 +209,7 @@ getMaestroPrice PP {maestroPP = MaestroPP {..}} stp = do let pair = TaggedText pairName - ohlInfo ← handleMaestroError (functionLocationIdent <> " - fetching price from pair") <=< try $ pricesFromDex mppEnv mppDex pair (Just Res5m) (Just Descending) + ohlInfo ← handleMaestroError (functionLocationIdent <> " - fetching price from pair") <=< try $ pricesFromDex mppEnv mppDex pair (Just mppResolution) (Just Descending) let info = head ohlInfo curPrecision = mmtPrecision $ mmtpCurrency stp diff --git a/sample-mainnet-maker-bot-config-gens.json b/sample-mainnet-maker-bot-config-gens.json index 564b906..d4a463a 100644 --- a/sample-mainnet-maker-bot-config-gens.json +++ b/sample-mainnet-maker-bot-config-gens.json @@ -15,6 +15,7 @@ "mbc_delay": 120000000, "mbc_price_config": { "pc_api_key": "<>", + "pc_resolution": "15m", "pc_network_id": "mainnet", "pc_dex": "genius-yield" }, diff --git a/sample-preprod-maker-bot-config-gens.json b/sample-preprod-maker-bot-config-gens.json index 6fd1df7..9269bc7 100644 --- a/sample-preprod-maker-bot-config-gens.json +++ b/sample-preprod-maker-bot-config-gens.json @@ -15,6 +15,7 @@ "mbc_delay": 120000000, "mbc_price_config": { "pc_api_key": "<>", + "pc_resolution": "15m", "pc_network_id": "mainnet", "pc_dex": "genius-yield", "pc_override": { From 712462f168967f613e5d58b309a30167c7316281 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Fri, 5 Jan 2024 20:30:51 +0530 Subject: [PATCH 07/12] Feat #15: Explanation of costs that market maker may incur --- README.md | 44 +++++++++++++++---- docker-compose.yml | 1 + .../src/GeniusYield/MarketMaker/Strategies.hs | 2 +- 3 files changed, 37 insertions(+), 10 deletions(-) diff --git a/README.md b/README.md index a950d12..cce9b55 100644 --- a/README.md +++ b/README.md @@ -89,7 +89,8 @@ See [`atlas-config-maestro.json`](./atlas-config-maestro.json) & [`atlas-config- { "mbc_user": { "ur_s_key_path": "path-to-skey", - "ur_coll": "tx-id#tx-ix" + "ur_coll": "tx-id#tx-ix", + "ur_stake_address": "bech32-encoded-stake-address" }, "mbc_fp_nft_policy": "compiled-scripts/minting-policy", "mbc_fp_order_validator": "compiled-scripts/partial-order", @@ -102,10 +103,10 @@ See [`atlas-config-maestro.json`](./atlas-config-maestro.json) & [`atlas-config- "mbc_delay": 120000000, "mbc_price_config": { "pc_api_key": "<>", + "pc_resolution": "15m", "pc_network_id": "mainnet", "pc_dex": "genius-yield", "pc_override": { - "mpo_commodity_token": "c6e65ba7878b2f8ea0ad39287d3e2fd256dc5c4160fc19bdf4c4d87e.7447454e53", "mpo_pair": "ADA-GENS", "mpo_commodity_is_first": false } @@ -127,19 +128,23 @@ See [`atlas-config-maestro.json`](./atlas-config-maestro.json) & [`atlas-config- "sc_cancel_threshold_product": 4 }, "mbc_token": { - "stAc": "c6e65ba7878b2f8ea0ad39287d3e2fd256dc5c4160fc19bdf4c4d87e.7447454e53", - "stPrecision": 6 + "ac": "c6e65ba7878b2f8ea0ad39287d3e2fd256dc5c4160fc19bdf4c4d87e.7447454e53", + "precision": 6 } } ``` -* `mbc_user` describes individual bot, it specifies `ur_s_key_path` which is the path to signing key file and `ur_coll` which is the UTxO reserved as collateral. Specifying `ur_coll` is optional but it is advised to set it as then this UTxO would be reserved (i.e., would not be spent) and thus be always available to serve as collateral. It is preferred for `ur_coll` to be pure 5 ada only UTxO (i.e., no other tokens besides ada). -* Fields `mbc_fp_nft_policy`, `mbc_fp_order_validator`, `mbc_po_config_addr` and `mbc_po_refs` relate to DEX smart contracts and can be left as it is. +* `mbc_user` describes individual bot. + * `ur_s_key_path` is the path to signing key file. + * `ur_coll` (optional) is the UTxO to be reserved as collateral. Though specifying `ur_coll` is optional but it is advised to set it as then this UTxO would be reserved (i.e., would not be spent) and thus be always available to serve as collateral. It is preferred for `ur_coll` to be pure 5 ada only UTxO (i.e., no other tokens besides ada). + * `ur_stake_address` (optional) is the bech32 stake address (`stake_test1...` for testnet and `stake1...` for mainnet). If specified, bot would place orders at the mangled address so that ada in those orders (both as an offer or as received payment) would be staked. Note that if an order undergoes partial fill, received payment is in the generated order UTxO and is received by the author of order only when order is completely filled or is cancelled. +* Fields `mbc_fp_nft_policy`, `mbc_fp_order_validator`, `mbc_po_config_addr` and `mbc_po_refs` relate to DEX smart contracts and can be left as it is. See sample files corresponding to the network to know for these values. * `mbc_delay` - Bot in single iteration tries to determine which orders need to be placed and which are needed to be cancelled. Once determined, it tries building the transactions and proceeds with submitting them, completing this single iteration. `mbc_delay` determines time in microseconds that bot must wait before proceeding with next iteration. * `mbc_price_config` gives the configuration on how to get market price using https://docs.gomaestro.org/DefiMarketAPI/mkt-dex-ohlc Maestro endpoint, for a token. * `pc_api_key` is the Maestro API key. + * `pc_resolution` is the resolution for the mentioned Maestro endpoint. Please see documentation [here](https://docs.gomaestro.org/DefiMarketAPI/Introduction#prices) on how resolution helps determine price. Possible values of resolution can be seen [here](https://docs.gomaestro.org/DefiMarketAPI/mkt-dex-ohlc). * `pc_network_id` determines Cardano network which is mentioned for in API calls. It should always be kept `mainnet` as of now. * `pc_dex` determines DEX from which market price is queried for. Currently `minswap` & `genius-yield` are supported. - * `pc_override` is optional and is needed in case one is not running bot on Mainnet. Since tokens on test network aren't actively traded, their price is not returned for by Maestro endpoint. To still get mainnet price for them, one can override the token given by `mpo_commodity_token` to pair with commodity token as described by `mpo_pair` & `mpo_commodity_is_first` respectively. In the above configuration, we are overriding the testnet GENS asset class `c6e65ba7878b2f8ea0ad39287d3e2fd256dc5c4160fc19bdf4c4d87e.7447454e53`, for the mainnet token pair `ADA-GENS`, and GENS is the second token in the pair so `mpo_commodity_is_first` is set to **false**. If the pair instead was `GENS-ADA` then `mpo_commodity_is_first` should be set to **true**. + * `pc_override` is optional and is needed in case one is not running bot on Mainnet. Since tokens on test network aren't actively traded, their price is not returned for by Maestro endpoint. To still get mainnet price for a corresponding mainnet token, one can specify desired (overriding) pair in `mpo_pair` & mention whether commodity is first token of the given pair or not in `mpo_commodity_is_first` field. In the above configuration, we are overriding the testnet GENS asset class `c6e65ba7878b2f8ea0ad39287d3e2fd256dc5c4160fc19bdf4c4d87e.7447454e53`, for the mainnet token pair `ADA-GENS`, and GENS is the second token in the pair so `mpo_commodity_is_first` is set to **false**. If the pair instead was `GENS-ADA` then `mpo_commodity_is_first` should be set to **true**. * `mbc_strategy_config` determines parameters for strategy: * `sc_spread` - Ratio representing `δ` as described before. @@ -150,6 +155,7 @@ See [`atlas-config-maestro.json`](./atlas-config-maestro.json) & [`atlas-config- * `tv_sell_budget` - Total amount of commodity tokens that bot can cumulatively offer in the orders. In every iteration, bot determines the number of commodity tokens locked in the orders and subtracts it from `tv_sell_budget` field, let's call the obtained number `asb` (short for _available sell budget_) then it determines number of sell orders placed to be `⌊asb / tv_sell_min_vol⌋ = ns` where `ns` is short of number of sell orders. Now bot would place `ns` sell orders, each having offer amount as `⌊asb / ns⌋`. * `tv_buy_budget` - Total amount of currency tokens that bot can cumulatively offer in the orders. It governs bot symmetric to `tv_sell_budget`. * `tv_sell_vol_threshold` - this is related to `sc_price_check_product`. Bot would build an order book from all the orders for the given pair in GeniusYield DEX. It will sum the offered commodity tokens for sell orders which have price less than `M * (1 + sc_price_check_product * δ)` to get `SV` (short for sell volume) and sum the asked commodity tokens for buy orders which have price greater than `M * (1 + sc_price_check_product * δ)` to get `BV'` (short for buy volume in commodity token). We'll multiply `BV'` with `M` to get `BV` to represent buy volume in currency token. Now, bot would not place a new sell order, if `tv_sell_vol_threshold` is less than or equal to `SV`. Idea is that if there is enough liquidity than bot need not place orders. Symmetrically, bot would not place new buy orders only if `tv_buy_vol_threshold` is less than or equal to `BV`. +* `mbc_token` specifies the commodity token with it's precision. Note that this must not be ADA! ## Canceling all the orders using docker (simple) @@ -186,8 +192,28 @@ cabal run geniusyield-market-maker-exe -- Cancel my-atlas-config.json my-maker-b The output should be similar like in the previous chapter. -## Known Issues +## Operational Costs -* When bot tries to place multiple orders in a single iteration, it might happen that we pick same UTxO against different transaction skeletons (due to a [quirk](https://github.com/geniusyield/dex-contracts-api/blob/cf360d6c1db8185b646a34ed8f6bb330c23774bb/src/GeniusYield/Api/Dex/PartialOrder.hs#L489-L498) where place order operation specifies UTxO to be spent in skeleton itself), leading to successful building of only some of the transaction skeletons and thus only few of the orders might be successfully placed even though bot might very well have the required funds to place all. Now the bot can place the remaining ones in next the iteration but as of now, these next orders are placed starting with initial spread difference from market price leading to a situation where the bot might have multiple orders at the same price. +Here we try to list costs which market maker incurs when interacting with our DEX which would help in better decision for configuration values such as _spread_. + +### Order placement + +Order placement incurs following fees besides usual transaction fees. + +* Flat fees: Every order is charged 1 ada flat maker fee on creation but order author will get this back only if order underwent no partial filling. +* Percent fees: Every order is charged 0.3% of offered tokens on creation. If an order is cancelled afterwards, 0.3% percent would be charged only on the amount which actually got filled and remaining is refunded. As an example, support an order is created, offering 100 GENS. 0.3% of it is 0.3 GENS which is initially charged. Now if order is cancelled after only 60 GENS from it was consumed, then order author would get back 0.3% of 40 GENS namely, 0.12 GENS. + +### Order cancellation + +_tl;dr_ We group up to 6 order cancellations in a single transaction, fees incurred is usual transaction fee plus additional ada up to 0.5. + +Order cancellation is slightly complex. + +* Order underwent no fills: Only the usual network transaction fee is charged. +* Order underwent some filling: In this case, ada taker fee might be added to this order or not. If it is added, only the usual network transaction fee is charged. However, if it is not added then as cancelling this order would require a fee output to GeniusYield address be generated, minimum ada requirement of this fee output must be satisfied which currently stands in worst case at slightly less than 1.5 ada. Now since maker certainly added 1 ada due to flat ada maker fee, it in worst case, would need to put additional 0.5 ada. + +### Equity monitoring + +Bot repeatedly logs for "equity" in terms of ada where ada equivalent of commodity token is obtained by using price provider. As an example, if wallet has 500 ada and 500 GENS and if price of 1 GENS is 2 ada, then equity of wallet would be 1500 ada. [^1]: _Display unit_ is one to which decimals are added as directed under [`cardano-token-registry`](https://github.com/cardano-foundation/cardano-token-registry). diff --git a/docker-compose.yml b/docker-compose.yml index 21515fb..3761be5 100644 --- a/docker-compose.yml +++ b/docker-compose.yml @@ -40,6 +40,7 @@ services: "mbc_delay": 120000000, "mbc_price_config": { "pc_api_key": "${MAESTRO_API_KEY}", + "pc_resolution": "15m", "pc_network_id": "${NETWORK:-mainnet}", "pc_dex": "genius-yield" }, diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs index e19ee79..874ec20 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs @@ -155,7 +155,7 @@ fixedSpreadVsMarketPriceStrategy user sToken = do let (Connection nid providers, _) = orderBookPP pp - sTokenPair = mkMMTokenPair lovelaceSt sToken -- TODO: Currency is always lovelace. There is an assumption that lovelace is not part of @sTokens@ which should be made explicit in documentation. + sTokenPair = mkMMTokenPair lovelaceSt sToken userAddr = (addrFromSkey nid . uSKey) user cancelThreshold = fromInteger scCancelThresholdProduct * scSpread priceCheckThreshold = fromInteger scPriceCheckProduct * scSpread From f71044267d8d2116a86998391cb3704dda57243a Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Fri, 5 Jan 2024 20:40:57 +0530 Subject: [PATCH 08/12] Feat #11 and rest, doc improvements --- README.md | 16 ++++++++-------- .../src/GeniusYield/MarketMaker/MakerBot.hs | 2 +- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/README.md b/README.md index cce9b55..45b2a40 100644 --- a/README.md +++ b/README.md @@ -10,7 +10,7 @@ Market maker bot for [GeniusYield](https://www.geniusyield.co/) DEX which implem > [!NOTE] > **Order classification and price** > -> We call non-ada tokens as _commodity_ and ada as _currency_. Order offering currency in exchange of commodity is called as _buy order_ whereas order offering commodity in exchange of currency is called as _sell order_. +> We call non-ADA tokens as _commodity_ and ADA as _currency_. Order offering currency in exchange of commodity is called as _buy order_ whereas order offering commodity in exchange of currency is called as _sell order_. > > _Price_ is described in display unit[^1] of currency token per display unit of commodity token. @@ -133,10 +133,10 @@ See [`atlas-config-maestro.json`](./atlas-config-maestro.json) & [`atlas-config- } } ``` -* `mbc_user` describes individual bot. +* `mbc_user` describes bot's wallet. * `ur_s_key_path` is the path to signing key file. - * `ur_coll` (optional) is the UTxO to be reserved as collateral. Though specifying `ur_coll` is optional but it is advised to set it as then this UTxO would be reserved (i.e., would not be spent) and thus be always available to serve as collateral. It is preferred for `ur_coll` to be pure 5 ada only UTxO (i.e., no other tokens besides ada). - * `ur_stake_address` (optional) is the bech32 stake address (`stake_test1...` for testnet and `stake1...` for mainnet). If specified, bot would place orders at the mangled address so that ada in those orders (both as an offer or as received payment) would be staked. Note that if an order undergoes partial fill, received payment is in the generated order UTxO and is received by the author of order only when order is completely filled or is cancelled. + * `ur_coll` (optional) is the UTxO to be reserved as collateral. Though specifying `ur_coll` is optional but it is advised to set it as then this UTxO would be reserved (i.e., would not be spent) and thus be always available to serve as collateral. It is preferred for `ur_coll` to be pure 5 ADA only UTxO (i.e., no other tokens besides ADA). + * `ur_stake_address` (optional) is the bech32 stake address (`stake_test1...` for testnet and `stake1...` for mainnet). If specified, bot would place orders at the mangled address so that ADA in those orders (both as an offer or as received payment) would be staked. Note that if an order undergoes partial fill, received payment is in the generated order UTxO and is received by the author of order only when order is completely filled or is cancelled. * Fields `mbc_fp_nft_policy`, `mbc_fp_order_validator`, `mbc_po_config_addr` and `mbc_po_refs` relate to DEX smart contracts and can be left as it is. See sample files corresponding to the network to know for these values. * `mbc_delay` - Bot in single iteration tries to determine which orders need to be placed and which are needed to be cancelled. Once determined, it tries building the transactions and proceeds with submitting them, completing this single iteration. `mbc_delay` determines time in microseconds that bot must wait before proceeding with next iteration. * `mbc_price_config` gives the configuration on how to get market price using https://docs.gomaestro.org/DefiMarketAPI/mkt-dex-ohlc Maestro endpoint, for a token. @@ -200,20 +200,20 @@ Here we try to list costs which market maker incurs when interacting with our DE Order placement incurs following fees besides usual transaction fees. -* Flat fees: Every order is charged 1 ada flat maker fee on creation but order author will get this back only if order underwent no partial filling. +* Flat fees: Every order is charged 1 ADA flat maker fee on creation but order author will get this back only if order underwent no partial filling. * Percent fees: Every order is charged 0.3% of offered tokens on creation. If an order is cancelled afterwards, 0.3% percent would be charged only on the amount which actually got filled and remaining is refunded. As an example, support an order is created, offering 100 GENS. 0.3% of it is 0.3 GENS which is initially charged. Now if order is cancelled after only 60 GENS from it was consumed, then order author would get back 0.3% of 40 GENS namely, 0.12 GENS. ### Order cancellation -_tl;dr_ We group up to 6 order cancellations in a single transaction, fees incurred is usual transaction fee plus additional ada up to 0.5. +_tl;dr_ We group up to 6 order cancellations in a single transaction, fees incurred is usual transaction fee plus additional ADA up to 0.5. Order cancellation is slightly complex. * Order underwent no fills: Only the usual network transaction fee is charged. -* Order underwent some filling: In this case, ada taker fee might be added to this order or not. If it is added, only the usual network transaction fee is charged. However, if it is not added then as cancelling this order would require a fee output to GeniusYield address be generated, minimum ada requirement of this fee output must be satisfied which currently stands in worst case at slightly less than 1.5 ada. Now since maker certainly added 1 ada due to flat ada maker fee, it in worst case, would need to put additional 0.5 ada. +* Order underwent some filling: In this case, ADA taker fee might be added to this order or not. If it is added, only the usual network transaction fee is charged. However, if it is not added then as cancelling this order would require a fee output to GeniusYield address be generated, minimum ADA requirement of this fee output must be satisfied which currently stands in worst case at slightly less than 1.5 ADA. Now since maker certainly added 1 ADA due to flat ADA maker fee, it in worst case, would need to put additional 0.5 ADA. ### Equity monitoring -Bot repeatedly logs for "equity" in terms of ada where ada equivalent of commodity token is obtained by using price provider. As an example, if wallet has 500 ada and 500 GENS and if price of 1 GENS is 2 ada, then equity of wallet would be 1500 ada. +Bot repeatedly logs for "equity" in terms of ADA where ADA equivalent of commodity token is obtained by using price provider. As an example, if wallet has 500 ADA and 500 GENS and if price of 1 GENS is 2 ADA, then equity of wallet would be 1500 ADA. [^1]: _Display unit_ is one to which decimals are added as directed under [`cardano-token-registry`](https://github.com/cardano-foundation/cardano-token-registry). diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs index 908b8b2..46ec3f1 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs @@ -33,7 +33,7 @@ data MakerBot = MakerBot mbUser ∷ User, -- | Delay in microseconds between each iteration of execution strategy loop. mbDelay ∷ Int, - -- | Non-ada token as other pair of the token is assumed to be ada. + -- | Non-ADA token as other pair of the token is assumed to be ADA. mbToken ∷ MMToken } From a8cc750df756b54e8074ecd1cccb5422eb8c3462 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Fri, 5 Jan 2024 20:51:40 +0530 Subject: [PATCH 09/12] Feat #11 and rest, doc improvements --- README.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 45b2a40..d188d6a 100644 --- a/README.md +++ b/README.md @@ -201,16 +201,16 @@ Here we try to list costs which market maker incurs when interacting with our DE Order placement incurs following fees besides usual transaction fees. * Flat fees: Every order is charged 1 ADA flat maker fee on creation but order author will get this back only if order underwent no partial filling. -* Percent fees: Every order is charged 0.3% of offered tokens on creation. If an order is cancelled afterwards, 0.3% percent would be charged only on the amount which actually got filled and remaining is refunded. As an example, support an order is created, offering 100 GENS. 0.3% of it is 0.3 GENS which is initially charged. Now if order is cancelled after only 60 GENS from it was consumed, then order author would get back 0.3% of 40 GENS namely, 0.12 GENS. +* Percent fees: Every order is charged 0.3% of offered tokens on creation. If an order is cancelled afterwards, 0.3% percent would be charged only on the amount which actually got filled and remaining is refunded. As an example, suppose an order is created - offering 100 GENS. 0.3% of it is 0.3 GENS, which is initially charged. Now if this order is cancelled after only 60 GENS from it was consumed, then order author would get back 0.3% of 40 GENS namely, 0.12 GENS. ### Order cancellation -_tl;dr_ We group up to 6 order cancellations in a single transaction, fees incurred is usual transaction fee plus additional ADA up to 0.5. +_tl;dr_ We group up to 6 order cancellations in a single transaction, fees incurred is usual transaction fee plus additional ADA up to 0.5, in worst case. Order cancellation is slightly complex. * Order underwent no fills: Only the usual network transaction fee is charged. -* Order underwent some filling: In this case, ADA taker fee might be added to this order or not. If it is added, only the usual network transaction fee is charged. However, if it is not added then as cancelling this order would require a fee output to GeniusYield address be generated, minimum ADA requirement of this fee output must be satisfied which currently stands in worst case at slightly less than 1.5 ADA. Now since maker certainly added 1 ADA due to flat ADA maker fee, it in worst case, would need to put additional 0.5 ADA. +* Order underwent some filling: In this case, ADA taker fee might be added to this order or not. If it is added, only the usual network transaction fee is charged. However, if it is not added then as cancelling this order would require a fee output to GeniusYield address be generated, minimum ADA requirement of this fee output must be satisfied which currently stands in worst case at slightly less than 1.5 ADA. Now since maker certainly added 1 ADA due to flat ADA maker fee, it in worst case, would need to put additional 0.5 ADA. Note that we split orders to be cancelled in set of size 6 and then submit cancellation transaction for each of these sets. Thus if there are 6 orders to be cancelled for in a single set, then this additional 0.5 ADA, if needed, is shared across these 6 orders as fee output is to be generated once per transaction and not once per order. As a further illustration, if the bot had 13 orders to cancel, we will generate 3 sets of sizes 6, 6 & 1 and thus submit 3 cancellation transactions. ### Equity monitoring From 9a201258abab9150177d90852b6fffe25ee198c4 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Fri, 5 Jan 2024 20:54:36 +0530 Subject: [PATCH 10/12] Feat #11 and rest, fixing ratio's estimate --- .../src/GeniusYield/MarketMaker/Constants.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Constants.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Constants.hs index 4d8e83c..1092dc7 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Constants.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Constants.hs @@ -15,4 +15,4 @@ logNS = "MM" -- TODO: Get it from blockchain instead. makerFeeRatio ∷ Rational -makerFeeRatio = 3 % 100 +makerFeeRatio = 3 % 1000 -- Is 0.3%, so ratio should be 0.003 == 3 / 1000. From afd40c5ee70c00e90d9a317095fb97260970ef1f Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Fri, 5 Jan 2024 20:55:51 +0530 Subject: [PATCH 11/12] Feat #11 and rest, additional comment for percent fee constant --- .../src/GeniusYield/MarketMaker/Constants.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Constants.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Constants.hs index 1092dc7..81e7994 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Constants.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Constants.hs @@ -13,6 +13,6 @@ awaitTxParams = GYAwaitTxParameters {maxAttempts = 20, confirmations = 1, checkI logNS ∷ GYLogNamespace logNS = "MM" --- TODO: Get it from blockchain instead. +-- TODO: Get it from blockchain instead. Note that this is only used to determine funds needed by wallet and is not forwarded to dex-contracts-api library. makerFeeRatio ∷ Rational makerFeeRatio = 3 % 1000 -- Is 0.3%, so ratio should be 0.003 == 3 / 1000. From 770de21c4eef04c2589e12a0af91b4c4aa2496ab Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Fri, 5 Jan 2024 20:59:52 +0530 Subject: [PATCH 12/12] Feat #11 and rest, removed no longer needed type --- geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs index 6fcdf7b..03e9580 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Prices.hs @@ -154,8 +154,6 @@ mkOBMarketTokenInfo (Price marketPrice) spread sellOrders buyOrders = sumVolBuy ∷ Volume sumVolBuy = volumeGTPrice (Price (marketPrice - (marketPrice * spread))) buyOrders -type MaestroMarketInfo = M.Map MMTokenPair Price - getOrderBookPrices ∷ PricesProviders → [MMTokenPair]