diff --git a/.gitignore b/.gitignore index eaac8b6..6362b1d 100644 --- a/.gitignore +++ b/.gitignore @@ -24,3 +24,4 @@ cabal.project.local~ .DS_Store *.skey var/ +.envrc diff --git a/README.md b/README.md index d188d6a..4e81a4d 100644 --- a/README.md +++ b/README.md @@ -10,11 +10,11 @@ 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_. +> In the following, we call any non-ADA token _commodity_, and we call ADA _currency_. An order offering currency in exchange for commodity is called a _buy order_, whereas an order offering commodity in exchange for currency is called a _sell order_. > > _Price_ is described in display unit[^1] of currency token per display unit of commodity token. -Given a market price `M` and a variable `δ` defined as _spread_, bot would place following orders where exact number and volume is determined by configuration: +Given a market price `M` and a variable `δ` defined as _spread_, the bot would place the following orders, where exact numbers and volumes are determined by the configuration: * Buy orders at price: * `M * (1 - δ)` @@ -25,9 +25,9 @@ Given a market price `M` and a variable `δ` defined as _spread_, bot would plac * `M * (1 + δ)` * `M * (1 + δ + δ / 2)` * `M * (1 + δ + δ / 2 + δ / 2)` - * And so on, where `n`th sell order's price is given by `M * (1 + δ + (n - 1) * δ / 2)`. + * And so on, where the `n`th sell order's price is given by `M * (1 + δ + (n - 1) * δ / 2)`. -If market price has drifted way higher (_"way higher"_ as directed by configuration) than the price at which buy orders were placed, buy orders would be canceled. Likewise, if the price has drifted way lower than the price at which sell orders were placed, they would be canceled. +If the market price has drifted way higher (_"way higher"_ as directed by the configuration) than the price at which buy orders were placed, buy orders would be canceled. Likewise, if the price has drifted way lower than the price at which sell orders were placed, those sell orders would be canceled. ## Running the market maker bot: Using docker compose (simple) @@ -56,7 +56,13 @@ As in the example above; the following environment variables must be specified b The configuration values used for these environment variables in the example above are just placeholders. These must be replaced by your own configuration values. A MAINNET Maestro API key is needed, a payment signing key must be generated and a collateral UTxO must be provided after -sending funds to the address controlled by the payment signing key. +sending funds to the address given by the payment signing key and the (optional) stake address. + +In order to determine this address, you could use `cardano-cli address build`, but you can also just run the market maker - the address will be printed to the console in the first line of output: + +``` +Genius Yield Market Maker: +``` Maestro API keys are available after registration via the following link: - https://docs.gomaestro.org/Getting-started/Sign-up-login diff --git a/geniusyield-market-maker/Main.hs b/geniusyield-market-maker/Main.hs index 113f5c1..d4e224a 100644 --- a/geniusyield-market-maker/Main.hs +++ b/geniusyield-market-maker/Main.hs @@ -1,13 +1,15 @@ module Main (main) where -import Control.Exception (throwIO) -import GeniusYield.GYConfig -import GeniusYield.MarketMaker.MakerBot -import GeniusYield.MarketMaker.MakerBotConfig -import GeniusYield.MarketMaker.Prices -import GeniusYield.MarketMaker.Strategies -import GeniusYield.OrderBot.DataSource.Providers (connectDB) -import System.Environment +import Control.Exception (throwIO) +import GeniusYield.GYConfig +import GeniusYield.MarketMaker.MakerBot +import GeniusYield.MarketMaker.MakerBotConfig +import GeniusYield.MarketMaker.Prices +import GeniusYield.MarketMaker.Strategies +import GeniusYield.MarketMaker.Utils (addrUser) +import GeniusYield.OrderBot.DataSource.Providers (connectDB) +import GeniusYield.Types (addressToText) +import System.Environment ----------------------------------------------------------------------- ----------------------------- MAIN ------------------------------------ @@ -16,9 +18,9 @@ parseArgs ∷ IO (String, FilePath, Maybe FilePath) parseArgs = do args ← getArgs case args of - [action, frameworkCfgPath, mBotConfigFile] → return (action, frameworkCfgPath, Just mBotConfigFile) - [action, frameworkCfgPath] → return (action, frameworkCfgPath, Nothing) - _ → + [action, frameworkCfgPath, mBotConfigFile] -> return (action, frameworkCfgPath, Just mBotConfigFile) + [action, frameworkCfgPath] -> return (action, frameworkCfgPath, Nothing) + _ -> throwIO . userError $ unlines @@ -28,21 +30,24 @@ parseArgs = do " 3. Path to the maker bot config file (optional). If not provided, required information is fetched from environment variables." ] -main ∷ IO () +main :: IO () main = do - (action, frameworkCfgPath, mBotConfigFile) ← parseArgs + (action, frameworkCfgPath, mBotConfigFile) <- parseArgs - coreCfg ← coreConfigIO frameworkCfgPath - mbc ← readMBotConfig mBotConfigFile - mb ← buildMakerBot mbc - di ← getDexInfo mbc + coreCfg <- coreConfigIO frameworkCfgPath + mbc <- readMBotConfig mBotConfigFile + mb <- buildMakerBot mbc + di <- getDexInfo mbc + + putStrLn $ "Genius Yield Market Maker: " + ++ show (addressToText $ addrUser (cfgNetworkId coreCfg) $ mbUser mb) let netId = cfgNetworkId coreCfg - withCfgProviders coreCfg "" $ \providers → + withCfgProviders coreCfg "" $ \providers -> case action of - "Run" → do - c ← connectDB netId providers - pp ← buildPP c di (mbcPriceConfig mbc) + "Run" -> do + c <- connectDB netId providers + pp <- buildPP c di (mbcPriceConfig mbc) executeStrategy (fixedSpreadVsMarketPriceStrategy (mbcStrategyConfig mbc)) mb netId providers pp di - "Cancel" → cancelAllOrders mb netId providers di - _ → throwIO . userError $ "Action '" ++ action ++ "' not supported. Check cli arguments." + "Cancel" -> cancelAllOrders mb netId providers di + _ -> throwIO . userError $ "Action '" ++ action ++ "' not supported. Check cli arguments." diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs index 46ec3f1..fb8a96b 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/MakerBot.hs @@ -1,56 +1,52 @@ module GeniusYield.MarketMaker.MakerBot where -import Control.Concurrent (threadDelay) -import Control.Exception (Exception (displayException), Handler (Handler), catches) -import Control.Monad (forM_, forever, when) -import Control.Monad.Reader (runReaderT) -import Data.List.Split (chunksOf) -import qualified Data.Map.Strict as M -import GeniusYield.Api.Dex.PartialOrder ( - PartialOrderInfo (poiOwnerKey), - cancelMultiplePartialOrders, - partialOrders, - placePartialOrder, - ) -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, - pkhFromSkey, - ) -import GeniusYield.Providers.Common (SubmitTxException) -import GeniusYield.Transaction (BuildTxException) -import GeniusYield.TxBuilder -import GeniusYield.Types -import System.Exit +import Control.Concurrent (threadDelay) +import Control.Exception (Exception (displayException), + Handler (Handler), catches) +import Control.Monad (forM_, forever, when) +import Control.Monad.Reader (runReaderT) +import Data.List.Split (chunksOf) +import qualified Data.Map.Strict as M +import GeniusYield.Api.Dex.PartialOrder (PartialOrderInfo (poiOwnerKey), + cancelMultiplePartialOrders, + partialOrders, + placePartialOrder) +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), + addrUser, pkhUser) +import GeniusYield.Providers.Common (SubmitTxException) +import GeniusYield.Transaction (BuildTxException) +import GeniusYield.TxBuilder +import GeniusYield.Types +import System.Exit data MakerBot = MakerBot { -- | User. - mbUser ∷ User, + mbUser :: User, -- | Delay in microseconds between each iteration of execution strategy loop. - mbDelay ∷ Int, + mbDelay :: Int, -- | Non-ADA token as other pair of the token is assumed to be ADA. - mbToken ∷ MMToken + mbToken :: MMToken } ----------------------------------------------------------------------- ---------------------------- ACTIONS ---------------------------------- -- | Scan the chain for existing orders and cancel all of them in batches of 6. -cancelAllOrders ∷ MakerBot → GYNetworkId → GYProviders → DEXInfo → IO () +cancelAllOrders :: MakerBot -> GYNetworkId -> GYProviders -> DEXInfo -> IO () cancelAllOrders MakerBot {mbUser} netId providers di = do - let go ∷ [PartialOrderInfo] → IO () + let go :: [PartialOrderInfo] -> IO () go partialOrderInfos = do gyLogInfo providers logNS $ "---------- " ++ show (length partialOrderInfos) ++ " orders to cancel! -----------" when (null partialOrderInfos) $ do gyLogInfo providers logNS "---------- No more orders to cancel! -----------" exitSuccess let (batch, rest) = splitAt 6 partialOrderInfos - userAddr = addrFromSkey netId $ uSKey mbUser + userAddr = addrUser netId mbUser txBody ← runGYTxMonadNode netId providers [userAddr] userAddr (uColl mbUser) $ runReaderT (cancelMultiplePartialOrders (dexPORefs di) batch) di @@ -61,23 +57,23 @@ cancelAllOrders MakerBot {mbUser} netId providers di = do 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 - userPOIs = filter (\o → poiOwnerKey o == userPkh) $ M.elems partialOrderInfos + partialOrderInfos <- runGYTxQueryMonadNode netId providers $ runReaderT (partialOrders (dexPORefs di)) di + let userPkh = pkhUser mbUser + userPOIs = filter (\o -> poiOwnerKey o == userPkh) $ M.elems partialOrderInfos go userPOIs -buildAndSubmitActions ∷ User → GYProviders → GYNetworkId → UserActions → DEXInfo → IO () -buildAndSubmitActions User {uSKey, uColl, uStakeAddress} providers netId ua di = flip catches handlers $ do - let userAddr = addrFromSkey netId uSKey +buildAndSubmitActions :: User -> GYProviders -> GYNetworkId -> UserActions -> DEXInfo -> IO () +buildAndSubmitActions user@User {uSKey, uColl, uStakeAddress} providers netId ua di = flip catches handlers $ do + let userAddr = addrUser netId user placeActions = uaPlaces ua cancelActions = uaCancels ua - forM_ (chunksOf 6 cancelActions) $ \cancelChunk → do + 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 + forM_ placeActions $ \pa@PlaceOrderAction {..} -> do logInfo $ "Building for place action: " <> show pa txBody ← runGYTxMonadNode netId providers [userAddr] userAddr uColl @@ -97,16 +93,16 @@ buildAndSubmitActions User {uSKey, uColl, uStakeAddress} providers netId ua di = logInfo = gyLogInfo providers logNS handlers = - let handlerCommon ∷ Exception e ⇒ e → IO () + let handlerCommon :: Exception e => e -> IO () handlerCommon = logWarn . displayException - be ∷ BuildTxException → IO () + be :: BuildTxException -> IO () be = handlerCommon - se ∷ SubmitTxException → IO () + se :: SubmitTxException -> IO () se = handlerCommon - me ∷ GYTxMonadException → IO () + me :: GYTxMonadException -> IO () me = handlerCommon in [Handler be, Handler se, Handler me] @@ -120,13 +116,13 @@ buildAndSubmitActions User {uSKey, uColl, uStakeAddress} providers netId ua di = logInfo $ printf "Tx successfully seen on chain with %d confirmation(s)" numConfirms executeStrategy - ∷ Strategy - → MakerBot - → GYNetworkId - → GYProviders - → PricesProviders - → DEXInfo - → IO () + :: Strategy + -> MakerBot + -> GYNetworkId + -> GYProviders + -> PricesProviders + -> DEXInfo + -> IO () executeStrategy runStrategy MakerBot {mbUser, mbDelay, mbToken} netId providers pp di = forever $ do newActions ← runStrategy pp mbUser mbToken diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs index 874ec20..3a05074 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Strategies.hs @@ -1,50 +1,40 @@ module GeniusYield.MarketMaker.Strategies where -import Control.Applicative ((<|>)) -import Control.Monad (unless) -import Data.Foldable -import Data.Function ((&)) -import Data.Functor ((<&>)) -import qualified Data.Map.Strict as M -import Data.Maybe (fromJust, mapMaybe) -import Data.Ratio ( - denominator, - numerator, - (%), - ) -import Data.Semigroup (Semigroup (stimes)) -import Deriving.Aeson -import GHC.Natural (naturalFromInteger) -import GeniusYield.AnnSet.Internal ( - orderInfo, - toAscList, - ) -import GeniusYield.Api.Dex.PartialOrder ( - PartialOrderInfo (..), - poiGetContainedFeeValue, - ) -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 ( - MultiAssetOrderBook, - OrderBook (..), - Orders (unOrders), - withEachAsset, - ) -import GeniusYield.OrderBot.Types -import GeniusYield.TxBuilder ( - GYTxQueryMonad (utxosAtAddress), - runGYTxQueryMonadNode, - ) -import GeniusYield.Types +import Control.Applicative ((<|>)) +import Control.Monad (unless) +import Data.Foldable +import Data.Function ((&)) +import Data.Functor ((<&>)) +import qualified Data.Map.Strict as M +import Data.Maybe (fromJust, mapMaybe) +import Data.Ratio (denominator, + numerator, (%)) +import Data.Semigroup (Semigroup (stimes)) +import Deriving.Aeson +import GeniusYield.AnnSet.Internal (orderInfo, + toAscList) +import GeniusYield.Api.Dex.PartialOrder (PartialOrderInfo (..), + poiGetContainedFeeValue) +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 (MultiAssetOrderBook, + OrderBook (..), + Orders (unOrders), + withEachAsset) +import GeniusYield.OrderBot.Types +import GeniusYield.TxBuilder (GYTxQueryMonad (utxosAtAddress), + runGYTxQueryMonadNode) +import GeniusYield.Types +import GHC.Natural (naturalFromInteger) data UserActions = UserActions - { uaPlaces ∷ [PlaceOrderAction], - uaCancels ∷ [CancelOrderAction] + { uaPlaces :: [PlaceOrderAction], + uaCancels :: [CancelOrderAction] } deriving stock (Show) @@ -62,54 +52,54 @@ instance Monoid UserActions where uaCancels = [] } -uaFromOnlyPlaces ∷ [PlaceOrderAction] → UserActions +uaFromOnlyPlaces :: [PlaceOrderAction]-> UserActions uaFromOnlyPlaces poas = mempty {uaPlaces = poas} -uaFromOnlyCancels ∷ [CancelOrderAction] → UserActions +uaFromOnlyCancels :: [CancelOrderAction] -> UserActions uaFromOnlyCancels coas = mempty {uaCancels = coas} data PlaceOrderAction = PlaceOrderAction - { poaOfferedAsset ∷ !GYAssetClass, - poaOfferedAmount ∷ !Natural, - poaAskedAsset ∷ !GYAssetClass, - poaPrice ∷ !GYRational + { poaOfferedAsset :: !GYAssetClass, + poaOfferedAmount :: !Natural, + poaAskedAsset :: !GYAssetClass, + poaPrice :: !GYRational } deriving stock (Show) -newtype CancelOrderAction = CancelOrderAction {coaPoi ∷ PartialOrderInfo} +newtype CancelOrderAction = CancelOrderAction {coaPoi :: PartialOrderInfo} deriving stock (Show) -type Strategy = PricesProviders → User → MMToken → IO UserActions +type Strategy = PricesProviders -> User -> MMToken -> IO UserActions data StrategyConfig = StrategyConfig - { scSpread ∷ !Rational, - scPriceCheckProduct ∷ !Integer, - scCancelThresholdProduct ∷ !Integer, - scTokenVolume ∷ !TokenVol + { scSpread :: !Rational, + scPriceCheckProduct :: !Integer, + scCancelThresholdProduct :: !Integer, + scTokenVolume :: !TokenVol } deriving stock (Show, Generic) deriving (FromJSON, ToJSON) via CustomJSON '[FieldLabelModifier '[CamelToSnake]] StrategyConfig data TokenVol = TokenVol - { tvSellMinVol ∷ !Integer, - tvBuyMinVol ∷ !Integer, - tvSellBudget ∷ !Integer, - tvBuyBudget ∷ !Integer, - tvSellVolThreshold ∷ !Integer, - tvBuyVolThreshold ∷ !Integer + { tvSellMinVol :: !Integer, + tvBuyMinVol :: !Integer, + tvSellBudget :: !Integer, + tvBuyBudget :: !Integer, + tvSellVolThreshold :: !Integer, + tvBuyVolThreshold :: !Integer } deriving stock (Show, Generic) deriving (FromJSON, ToJSON) via CustomJSON '[FieldLabelModifier '[CamelToSnake]] TokenVol -- | Uses a `MultiAssetOrderBook` to call `filterOwnOrders`. getOwnOrders - ∷ [MMTokenPair] - → [User] - → MultiAssetOrderBook - → M.Map User [(MMTokenPair, PartialOrderInfo)] + :: [MMTokenPair] + -> [User] + -> MultiAssetOrderBook + -> 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 + 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 `MMTokenPair`'s, a list of users and a list of @@ -117,33 +107,33 @@ getOwnOrders stps users maob = that belong to that user and trade in one of the relevant pairs. -} filterOwnOrders - ∷ [MMTokenPair] - → [User] - → [PartialOrderInfo] - → M.Map User [(MMTokenPair, PartialOrderInfo)] + :: [MMTokenPair] + -> [User] + -> [PartialOrderInfo] + -> M.Map User [(MMTokenPair, PartialOrderInfo)] filterOwnOrders stps users allOrders = - let usersPkh = map (pkhFromSkey . uSKey) users + let usersPkh = pkhUser <$> users ourPOIs = filter (flip elem usersPkh . poiOwnerKey) allOrders relevantTokensPOIs = mapMaybe (filterTokenPair stps) ourPOIs - finalMap = foldl' (\acc (stp, poi) → M.unionWith (++) acc (M.singleton (lookupUser poi) [(stp, poi)])) mempty relevantTokensPOIs + finalMap = foldl' (\acc (stp, poi) -> M.unionWith (++) acc (M.singleton (lookupUser poi) [(stp, poi)])) mempty relevantTokensPOIs in finalMap where - filterTokenPair ∷ [MMTokenPair] → PartialOrderInfo → Maybe (MMTokenPair, 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 MMTokenPair - findStp ap = find (\stp → ap == toOAPair stp) sTokenPairs + findStp :: OrderAssetPair -> Maybe MMTokenPair + findStp ap = find (\stp -> ap == toOAPair stp) sTokenPairs - lookupUser ∷ PartialOrderInfo → User + lookupUser :: PartialOrderInfo -> User lookupUser PartialOrderInfo {poiOwnerKey} = fromJust - $ find ((==) poiOwnerKey . pkhFromSkey . uSKey) users + $ find ((==) poiOwnerKey . pkhUser) users -fixedSpreadVsMarketPriceStrategy ∷ StrategyConfig → Strategy +fixedSpreadVsMarketPriceStrategy :: StrategyConfig -> Strategy fixedSpreadVsMarketPriceStrategy StrategyConfig { scSpread, @@ -156,7 +146,7 @@ fixedSpreadVsMarketPriceStrategy sToken = do let (Connection nid providers, _) = orderBookPP pp sTokenPair = mkMMTokenPair lovelaceSt sToken - userAddr = (addrFromSkey nid . uSKey) user + userAddr = addrUser nid user cancelThreshold = fromInteger scCancelThresholdProduct * scSpread priceCheckThreshold = fromInteger scPriceCheckProduct * scSpread @@ -170,11 +160,11 @@ fixedSpreadVsMarketPriceStrategy let ownOrdersPerUser = getOwnOrders [sTokenPair] [user] maob 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 mp) totalValueOnUtxos + totalValueOnUtxos = foldlUTxOs' (\acc utxo -> acc <> utxoValue utxo) mempty ownUtxos + equityOnUtxos = foldl' (\acc (_, n) -> acc + n) 0 $ valueToList $ valueMap (getEquityFromValue mp) totalValueOnUtxos cancelOrderActions = - map (\(_, poi) → CancelOrderAction poi) + map (\(_, poi) -> CancelOrderAction poi) $ ordersToBeRemoved mp cancelThreshold allOwnOrders relevantSTP = mkMMTokenPair lovelaceSt sToken @@ -194,15 +184,15 @@ fixedSpreadVsMarketPriceStrategy } = scTokenVolume (sellVol, buyVol) = case mtInfo of - Nothing → (0, 0) - Just OBMarketTokenInfo {mtSellVol, mtBuyVol} → (mtSellVol, mtBuyVol) + 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 - subtractTillZero ∷ GYValue → GYValue → Natural → Natural + subtractTillZero :: GYValue -> GYValue -> Natural -> Natural subtractTillZero val sub acc = if val `valueGreaterOrEqual` sub then subtractTillZero (val `valueMinus` sub) sub (acc + 1) else acc (newBuyOrders, totalValueOnUtxosAfterBuyOrds) ← @@ -269,13 +259,13 @@ fixedSpreadVsMarketPriceStrategy return $ placeUserActions <> cancelUserActions where buildNewUserOrders - ∷ Rational - → (MMToken, MMToken) - → Price - → Natural - → Natural - → Bool - → [PlaceOrderAction] + :: Rational + -> (MMToken, MMToken) + -> Price + -> Natural + -> Natural + -> Bool + -> [PlaceOrderAction] buildNewUserOrders delta' (ask, off) p tokenQ nOrders toInverse = let p' = getPrice p poi n = @@ -287,7 +277,7 @@ fixedSpreadVsMarketPriceStrategy poaPrice = rationalFromGHC $ if toInverse then denominator newMPrice % numerator newMPrice else newMPrice } 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 -> (MMTokenPair, PartialOrderInfo) -> Natural getEquityFromOrder price (_stp, poi) = let ownFunds = getOrderOwnFunds poi priceOfNonAdaToken nonAdaAC = floor $ fromIntegral (valueAssetClass ownFunds nonAdaAC) * getPrice price @@ -304,30 +294,30 @@ fixedSpreadVsMarketPriceStrategy -- * Initial deposit. -- * Collected fees. -- - getOrderOwnFunds ∷ PartialOrderInfo → GYValue + getOrderOwnFunds :: PartialOrderInfo -> GYValue getOrderOwnFunds PartialOrderInfo {..} = let toSubtract = valueSingleton (GYToken poiNFTCS poiNFT) 1 <> poiGetContainedFeeValue poi in poiUTxOValue `valueMinus` toSubtract - getEquityFromValue ∷ Price → GYAssetClass → Integer → Integer + getEquityFromValue :: Price -> GYAssetClass -> Integer -> Integer getEquityFromValue _ GYLovelace n = n - getEquityFromValue (getPrice → price) _ac n = + getEquityFromValue (getPrice -> price) _ac n = floor $ price * fromInteger n - getOrdersLockedValue ∷ MMTokenPair → MMToken → [(MMTokenPair, PartialOrderInfo)] → Natural + getOrdersLockedValue :: MMTokenPair -> MMToken -> [(MMTokenPair, PartialOrderInfo)] -> Natural getOrdersLockedValue stp st orders = let relevantOfferedAc = mmtAc st - relevantOrders = filter (\(oStp, oPoi) → oStp == stp && relevantOfferedAc == poiOfferedAsset oPoi) orders + relevantOrders = filter (\(oStp, oPoi) -> oStp == stp && relevantOfferedAc == poiOfferedAsset oPoi) orders in sum $ map (poiOfferedAmount . snd) relevantOrders - logInfo, logDebug, logWarn ∷ GYProviders → String → IO () + logInfo, logDebug, logWarn :: GYProviders -> String -> IO () logInfo providers = gyLogInfo providers logNS logDebug providers = gyLogDebug providers logNS logWarn providers = gyLogWarning providers logNS - logPlaceAction ∷ PlaceOrderAction → String + logPlaceAction :: PlaceOrderAction -> String logPlaceAction PlaceOrderAction {..} = - let price = (fromRational (rationalToGHC poaPrice) ∷ Double) + let price = (fromRational (rationalToGHC poaPrice) :: Double) adjustedPrice = 1 / price in unwords [ "Selling", @@ -341,26 +331,26 @@ fixedSpreadVsMarketPriceStrategy show adjustedPrice, ")" ] - logMaestroMarketInfo ∷ Price → String + logMaestroMarketInfo :: Price -> String logMaestroMarketInfo price = unwords [ "Price for:", prettyAc $ mmtAc sToken, "is", - show (fromRational (getPrice price) ∷ Double) + show (fromRational (getPrice price) :: Double) ] - prettyAc ∷ GYAssetClass → String - prettyAc GYLovelace = "lovelaces" + prettyAc :: GYAssetClass -> String + prettyAc GYLovelace = "lovelaces" prettyAc (GYToken _ tn) = "indivisible of " ++ show tn -ordersToBeRemoved ∷ Price → Rational → [(MMTokenPair, PartialOrderInfo)] → [(MMTokenPair, PartialOrderInfo)] +ordersToBeRemoved :: Price -> Rational -> [(MMTokenPair, PartialOrderInfo)] -> [(MMTokenPair, PartialOrderInfo)] ordersToBeRemoved price cancelLimitSpread = filter (orderIsToBeRemoved price cancelLimitSpread) -orderIsToBeRemoved ∷ Price → Rational → (MMTokenPair, PartialOrderInfo) → Bool +orderIsToBeRemoved :: Price -> Rational -> (MMTokenPair, 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) + SomeOrderInfo OrderInfo {orderType = SBuyOrder, price} -> getPrice price < marketPrice - (cancelLimitSpread * marketPrice) + SomeOrderInfo OrderInfo {orderType = SSellOrder, price} -> getPrice price > marketPrice + (cancelLimitSpread * marketPrice) diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/User.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/User.hs index fc9bd33..4829562 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/User.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/User.hs @@ -1,46 +1,46 @@ module GeniusYield.MarketMaker.User where -import Data.Aeson (withText) -import Deriving.Aeson -import GeniusYield.Imports -import GeniusYield.Types +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 :: GYStakeAddress -> GYStakeAddressBech32 stakeAddressToBech32 = coerce -stakeAddressFromBech32 ∷ GYStakeAddressBech32 → GYStakeAddress +stakeAddressFromBech32 :: GYStakeAddressBech32 -> GYStakeAddress stakeAddressFromBech32 = coerce instance ToJSON GYStakeAddressBech32 where toJSON (GYStakeAddressBech32 addr) = toJSON $ stakeAddressToText addr instance FromJSON GYStakeAddressBech32 where - parseJSON = withText "GYStakeAddressBech32" $ \t → + parseJSON = withText "GYStakeAddressBech32" $ \t -> case stakeAddressFromTextMaybe t of - Just addr → pure $ GYStakeAddressBech32 addr - Nothing → fail "cannot deserialise stake address" + Just addr -> pure $ GYStakeAddressBech32 addr + Nothing -> fail "cannot deserialise stake address" data UserRaw = UserRaw - { urSKeyPath ∷ !FilePath, - urColl ∷ !(Maybe GYTxOutRef), - urStakeAddress ∷ !(Maybe GYStakeAddressBech32) + { 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 -> 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) + { uSKey :: !GYPaymentSigningKey, + uColl :: !(Maybe (GYTxOutRef, Bool)), + uStakeAddress :: !(Maybe GYStakeAddressBech32) } deriving stock (Generic, Show, Eq, Ord) diff --git a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Utils.hs b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Utils.hs index da8e4fb..1f54b39 100644 --- a/geniusyield-market-maker/src/GeniusYield/MarketMaker/Utils.hs +++ b/geniusyield-market-maker/src/GeniusYield/MarketMaker/Utils.hs @@ -1,34 +1,40 @@ module GeniusYield.MarketMaker.Utils where -import qualified Data.Text as Text -import GeniusYield.Api.Dex.PartialOrder (PORefs) -import GeniusYield.Imports (coerce, first) -import GeniusYield.Providers.Common (SomeDeserializeError (DeserializeErrorAssetClass)) -import GeniusYield.Scripts (HasPartialOrderConfigAddr (..), HasPartialOrderNftScript (..), HasPartialOrderScript (..)) -import GeniusYield.Types -import qualified Maestro.Types.V1 as Maestro -import PlutusLedgerApi.V1.Scripts (ScriptHash) -import PlutusLedgerApi.V1.Value (AssetClass) -import PlutusLedgerApi.V2 (Address) -import Ply (ScriptRole (..), TypedScript) - -pkhFromSkey ∷ GYPaymentSigningKey → GYPubKeyHash -pkhFromSkey = pubKeyHash . paymentVerificationKey - -addrFromSkey ∷ GYNetworkId → GYPaymentSigningKey → GYAddress -addrFromSkey netId = addressFromPubKeyHash netId . pkhFromSkey +import qualified Data.Text as Text +import GeniusYield.Api.Dex.PartialOrder (PORefs) +import GeniusYield.Imports (coerce, first) +import GeniusYield.MarketMaker.User (User (..), + stakeAddressFromBech32) +import GeniusYield.Providers.Common (SomeDeserializeError (DeserializeErrorAssetClass)) +import GeniusYield.Scripts (HasPartialOrderConfigAddr (..), + HasPartialOrderNftScript (..), + HasPartialOrderScript (..)) +import GeniusYield.Types +import qualified Maestro.Types.V1 as Maestro +import PlutusLedgerApi.V1.Scripts (ScriptHash) +import PlutusLedgerApi.V1.Value (AssetClass) +import PlutusLedgerApi.V2 (Address) +import Ply (ScriptRole (..), TypedScript) + +pkhUser :: User -> GYPubKeyHash +pkhUser = pubKeyHash . paymentVerificationKey . uSKey + +addrUser :: GYNetworkId -> User -> GYAddress +addrUser netId user = addressFromCredential netId + (GYPaymentCredentialByKey $ pkhUser user) + (stakeAddressCredential . stakeAddressFromBech32 <$> uStakeAddress user) -- | Convert Maestro's asset class to our GY type. -assetClassFromMaestro ∷ (Maestro.TokenName, Maestro.PolicyId) → Either SomeDeserializeError GYAssetClass +assetClassFromMaestro :: (Maestro.TokenName, Maestro.PolicyId) → Either SomeDeserializeError GYAssetClass assetClassFromMaestro ("", "") = pure GYLovelace assetClassFromMaestro (tokenName, policyId) = first (DeserializeErrorAssetClass . Text.pack) $ parseAssetClassWithSep '#' (coerce policyId <> "#" <> coerce tokenName) -- | Type that encapsulates the scripts needed for the dex api. data DEXInfo = DEXInfo - { dexPartialOrderValidator ∷ !(TypedScript 'ValidatorRole '[Address, AssetClass]), - dexNftPolicy ∷ !(TypedScript 'MintingPolicyRole '[ScriptHash, Address, AssetClass]), - dexPartialOrderConfigAddr ∷ !GYAddress, - dexPORefs ∷ !PORefs + { dexPartialOrderValidator :: !(TypedScript 'ValidatorRole '[Address, AssetClass]), + dexNftPolicy :: !(TypedScript 'MintingPolicyRole '[ScriptHash, Address, AssetClass]), + dexPartialOrderConfigAddr :: !GYAddress, + dexPORefs :: !PORefs } instance HasPartialOrderScript DEXInfo where