diff --git a/geniusyield-orderbot-framework/geniusyield-orderbot-framework.cabal b/geniusyield-orderbot-framework/geniusyield-orderbot-framework.cabal index b9c3c79..bf29784 100644 --- a/geniusyield-orderbot-framework/geniusyield-orderbot-framework.cabal +++ b/geniusyield-orderbot-framework/geniusyield-orderbot-framework.cabal @@ -186,6 +186,7 @@ library geniusyield-orderbot-framework:orderbook, geniusyield-orderbot-framework:strategies, geniusyield-server-lib, + http-api-data, maestro-sdk, vector, diff --git a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot.hs b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot.hs index 96646da..7f5afc3 100644 --- a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot.hs +++ b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot.hs @@ -6,6 +6,7 @@ Maintainer : support@geniusyield.co Stability : develop -} module GeniusYield.OrderBot ( + AssetInfo (..), PriceProviderConfig (..), OrderBot (..), ExecutionStrategy (..), @@ -16,29 +17,36 @@ import Control.Arrow (second, (&&&)) import Control.Concurrent (threadDelay) import Control.Exception ( AsyncException (UserInterrupt), + Exception, SomeException, bracket, + displayException, fromException, handle, + throwIO, + try, ) import Control.Monad ( filterM, forever, unless, when, + (<=<), ) import Control.Monad.Reader (runReaderT) import Data.Aeson (encode) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as BL -import Data.Foldable (foldl', toList) +import Data.Foldable (foldl', foldlM, toList) import Data.Functor ((<&>)) import Data.List (find) import qualified Data.List.NonEmpty as NE (toList) -import qualified Data.Map as M +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as M import Data.Maybe (mapMaybe) import Data.Text (Text) import qualified Data.Text as Txt +import Data.Word (Word64) import Deriving.Aeson import GeniusYield.Api.Dex.Constants (DEXInfo (..)) import GeniusYield.GYConfig ( @@ -71,7 +79,7 @@ import GeniusYield.OrderBot.Types ( import GeniusYield.Providers.Common (SubmitTxException) import GeniusYield.Providers.Maestro (networkIdToMaestroEnv) import GeniusYield.Server.Ctx (TapToolsEnv (..)) -import GeniusYield.Server.Dex.HistoricalPrices.TapTools.Client +import GeniusYield.Server.Dex.HistoricalPrices.TapTools.Client hiding (handleTapToolsError) import GeniusYield.Transaction (GYCoinSelectionStrategy (GYLegacy)) import GeniusYield.TxBuilder ( GYTxBuildResult (..), @@ -88,37 +96,29 @@ import GeniusYield.Types import qualified Maestro.Client.V1 as Maestro import qualified Maestro.Types.V1 as Maestro import System.Exit (exitSuccess) +import Web.HttpApiData (ToHttpApiData (..)) + +data AssetInfo = AssetInfo + { assetTicker :: Text + , assetDecimals :: Word64 + } + deriving stock (Show, Generic) + deriving (FromJSON, ToJSON) via CustomJSON '[FieldLabelModifier '[StripPrefix "asset", Maestro.LowerFirst]] AssetInfo data MaestroConfig = MaestroConfig { mcApiKey :: !(Confidential Text) , mcResolution :: !Maestro.Resolution , mcDex :: !Maestro.Dex - , mcPairOverride :: !(Maybe MaestroPairOverride) } deriving stock (Show, Generic) deriving (FromJSON, ToJSON) via CustomJSON '[FieldLabelModifier '[StripPrefix "mc", Maestro.LowerFirst]] MaestroConfig -data TapToolsConfig = TapToolsConfig - { ttcApiKey :: !(Confidential Text) - , ttcPairOverride :: !(Maybe TapToolsPairOverride) +newtype TapToolsConfig = TapToolsConfig + { ttcApiKey :: Confidential Text } deriving stock (Show, Generic) deriving (FromJSON, ToJSON) via CustomJSON '[FieldLabelModifier '[StripPrefix "ttc", Maestro.LowerFirst]] TapToolsConfig -data MaestroPairOverride = MaestroPairOverride - { mpoPair :: !String - , mpoCommodityIsFirst :: !Bool - } - deriving stock (Show, Generic) - deriving (FromJSON, ToJSON) via CustomJSON '[FieldLabelModifier '[StripPrefix "mpo", Maestro.LowerFirst]] MaestroPairOverride - -data TapToolsPairOverride = TapToolsPairOverride - { ttpoAsset :: !GYAssetClass - , ttpoPrecision :: !Natural - } - deriving stock (Show, Generic) - deriving (FromJSON, ToJSON) via CustomJSON '[FieldLabelModifier '[StripPrefix "ttpo", Maestro.LowerFirst]] TapToolsPairOverride - -- | Price provider to get ADA price of a token. data PriceProviderConfig = TapToolsPriceProviderConfig !TapToolsConfig @@ -130,12 +130,10 @@ data MaestroPP = MaestroPP { mppEnv :: !(Maestro.MaestroEnv 'Maestro.V1) , mppResolution :: !Maestro.Resolution , mppDex :: !Maestro.Dex - , mppPairOverride :: !(Maybe MaestroPairOverride) } -data TapToolsPP = TapToolsPP - { ttppEnv :: !TapToolsEnv - , ttppPairOverride :: !(Maybe TapToolsPairOverride) +newtype TapToolsPP = TapToolsPP + { ttppEnv :: TapToolsEnv } data PriceProvider @@ -149,7 +147,6 @@ buildTapToolsPP TapToolsConfig {..} = do pure TapToolsPP { ttppEnv = tenv - , ttppPairOverride = ttcPairOverride } buildMaestroPP :: MaestroConfig -> IO MaestroPP @@ -160,7 +157,6 @@ buildMaestroPP MaestroConfig {..} = do { mppEnv = env , mppResolution = mcResolution , mppDex = mcDex - , mppPairOverride = mcPairOverride } buildPP :: PriceProviderConfig -> IO PriceProvider @@ -195,6 +191,7 @@ data OrderBot = OrderBot -- ^ See 'botCLovelaceWarningThreshold'. , botPriceProvider :: Maybe PriceProviderConfig -- ^ The price provider for the bot, used in case arbitrage is in non-ada token & we need to decide if the arbitraged tokens compensate the ada lost due to transaction fees. + , botTokenInfos :: Map GYAssetClass AssetInfo } {- | Currently, we only have the parallel execution strategy: @MultiAssetTraverse@, @@ -203,6 +200,9 @@ data OrderBot = OrderBot -} newtype ExecutionStrategy = MultiAssetTraverse IndependentStrategy +sorNS :: GYLogNamespace +sorNS = "SOR" + runOrderBot :: -- | Path to the config file for the GY framework. GYCoreConfig -> @@ -224,12 +224,12 @@ runOrderBot , botTakeMatches , botLovelaceWarningThreshold , botPriceProvider + , botTokenInfos } = do withCfgProviders cfg "" $ \providers -> do let logInfo = gyLogInfo providers sorNS logDebug = gyLogDebug providers sorNS logWarn = gyLogWarning providers sorNS - sorNS = "SOR" netId = cfgNetworkId cfg botPkh = paymentKeyHash $ paymentVerificationKey botSkey @@ -246,11 +246,12 @@ runOrderBot , " Lovelace balance warning threshold: " ++ show botLovelaceWarningThreshold , " Scan delay (µs): " ++ show botRescanDelay , " Bot price configuration: " ++ show botPriceProvider + , " Bot token infos: " ++ show botTokenInfos , " Token Pairs to scan:" , unlines (map (("\t - " ++) . show) botAssetPairFilter) , "" ] - + mpp <- maybe (pure Nothing) (fmap Just . buildPP) botPriceProvider bracket (connectDB netId providers) closeDB $ \conn -> forever $ handle (handleAnyException providers) $ do logInfo "Rescanning for orders..." @@ -331,7 +332,7 @@ runOrderBot -- We filter the txs that are not losing tokens profitableTxs <- filterM - (notLosingTokensCheck netId providers botAddrs botAssetPairFilter) + (notLosingTokensCheck netId providers botAddrs botAssetPairFilter mpp botTokenInfos) txs logInfo $ @@ -357,7 +358,7 @@ runOrderBot handleAnyException _ (fromException -> Just UserInterrupt) = putStrLn "Gracefully stopping..." >> exitSuccess handleAnyException providers err = - let logErr = gyLogError providers "SOR" + let logErr = gyLogError providers sorNS in logErr (show err) >> threadDelay botRescanDelay signAndSubmitTx :: GYTxBody -> GYProviders -> GYPaymentSigningKey -> IO () @@ -368,9 +369,9 @@ signAndSubmitTx txBody providers botSkey = handle handlerSubmit $ do logInfo $ unwords ["Submitted order matching transaction with id:", show tid] where logInfo, logDebug, logWarn :: String -> IO () - logInfo = gyLogInfo providers "SOR" - logDebug = gyLogDebug providers "SOR" - logWarn = gyLogWarning providers "SOR" + logInfo = gyLogInfo providers sorNS + logDebug = gyLogDebug providers sorNS + logWarn = gyLogWarning providers sorNS handlerSubmit :: SubmitTxException -> IO () handlerSubmit ex = logWarn $ unwords ["SubmitTxException:", show ex] @@ -415,7 +416,7 @@ buildTransactions GYTxBuildNoInputs -> logWarn "No Inputs" >> return [] where logWarn :: String -> IO () - logWarn = gyLogWarning providers "SOR" + logWarn = gyLogWarning providers sorNS findBody :: [GYTxBody] -> MatchResult -> Maybe (GYTxBody, MatchResult) findBody bs mr = @@ -437,11 +438,14 @@ notLosingTokensCheck :: GYProviders -> [GYAddress] -> [OrderAssetPair] -> + Maybe PriceProvider -> + Map GYAssetClass AssetInfo -> (GYTxBody, MatchResult) -> IO Bool -notLosingTokensCheck netId providers botAddrs oapFilter (txBody, matchesToExecute) = do - let logDebug = gyLogDebug providers "SOR" - logWarn = gyLogWarning providers "SOR" +notLosingTokensCheck netId providers botAddrs oapFilter mpp assetInfos (txBody, matchesToExecute) = do + let logDebug = gyLogDebug providers sorNS + logWarn = gyLogWarning providers sorNS + logErr = gyLogError providers sorNS matchesRefs = map matchExecutionInfoUtxoRef matchesToExecute botInputs = filter (`notElem` matchesRefs) $ txBodyTxIns txBody @@ -451,21 +455,36 @@ notLosingTokensCheck netId providers botAddrs oapFilter (txBody, matchesToExecut utxosLovelaceAndFilteredValueAtAddr inputs (outputLovelace, filteredACOutput) = utxosLovelaceAndFilteredValueAtAddr $ txBodyUTxOs txBody - + botAssets = valueAssets filteredACInput fees = txBodyFee txBody - lovelaceCheck = if all currencyIsLovelace oapFilter then outputLovelace >= inputLovelace else inputLovelace - outputLovelace <= fees - - filteredACCheck = - all - ( \ac -> - valueAssetClass filteredACInput ac - <= valueAssetClass filteredACOutput ac - ) - $ toList - $ valueAssets filteredACInput - - completeCheck = lovelaceCheck && filteredACCheck - + nonAdaTokenArbitrage = map (\ac -> (ac, valueAssetClass filteredACOutput ac - valueAssetClass filteredACInput ac)) $ toList botAssets + filteredACCheck = all ((>= 0) . snd) nonAdaTokenArbitrage + lovelaceCheck <- + if all currencyIsLovelace oapFilter + then pure (outputLovelace >= inputLovelace) + else case mpp of + Nothing -> pure $ inputLovelace - outputLovelace <= fees -- Should include flat taker fee here as well. + Just pp -> do + accLovelace <- + foldlM' + ( \accLovelace (ac, amt) -> do + case M.lookup ac assetInfos of + Nothing -> do + logWarn $ "AssetInfo not found for: " ++ show ac + pure accLovelace + Just ai -> do + lovelacePriceOfAssetE <- getLovelacePriceOfAsset pp ac ai + case lovelacePriceOfAssetE of + Left e -> do + logErr $ "Failed to get lovelace price of asset: " ++ show ac ++ ", with error: " ++ show e + pure accLovelace + Right lovelacePriceOfAsset -> do + pure $ accLovelace + floor (lovelacePriceOfAsset * fromIntegral amt) -- TODO: Unit test this part! + ) + 0 + nonAdaTokenArbitrage + pure $ outputLovelace + accLovelace >= inputLovelace + let completeCheck = lovelaceCheck && filteredACCheck unless lovelaceCheck $ logWarn $ unwords @@ -530,12 +549,95 @@ totalSellOrders = foldrOrders (const (+ 1)) 0 . sellOrders totalBuyOrders :: OrderBook -> Int totalBuyOrders = foldrOrders (const (+ 1)) 0 . buyOrders -matchingsPerOrderAssetPair :: [OrderAssetPair] -> [MatchResult] -> M.Map OrderAssetPair Int +matchingsPerOrderAssetPair :: [OrderAssetPair] -> [MatchResult] -> Map OrderAssetPair Int matchingsPerOrderAssetPair oaps = foldl' succOAP (M.fromList $ map (,0) oaps) where - succOAP :: M.Map OrderAssetPair Int -> MatchResult -> M.Map OrderAssetPair Int + succOAP :: Map OrderAssetPair Int -> MatchResult -> Map OrderAssetPair Int succOAP m (OrderExecutionInfo _ oi : _) = M.insertWith (+) (assetInfo oi) 1 m succOAP m _ = m runGYTxMonadNodeParallelWithStrategy :: GYCoinSelectionStrategy -> GYNetworkId -> GYProviders -> [GYAddress] -> GYAddress -> Maybe (GYTxOutRef, Bool) -> GYTxBuilderMonadIO [GYTxSkeleton v] -> IO GYTxBuildResult runGYTxMonadNodeParallelWithStrategy strat nid providers addrs change collateral act = runGYTxBuilderMonadIO nid providers addrs change collateral $ act >>= buildTxBodyParallelWithStrategy strat + +getLovelacePriceOfAsset :: PriceProvider -> GYAssetClass -> AssetInfo -> IO (Either PricesProviderException Rational) +getLovelacePriceOfAsset _ GYLovelace _ = (pure . pure) 1 +getLovelacePriceOfAsset (MaestroPriceProvider MaestroPP {..}) _ac AssetInfo {..} = do + handle handleMaestroSourceFail $ do + let pairName = "ADA-" <> assetTicker + pair = Maestro.TaggedText pairName + + ohlInfo <- + handleMaestroError (functionLocationIdent <> " - fetching price from pair") <=< try $ + -- TODO: Should limit to 1? + Maestro.pricesFromDex mppEnv mppDex pair (Just mppResolution) Nothing Nothing Nothing (Just Maestro.Descending) + + let info = head ohlInfo + adaPrecision :: Int = 6 -- We cast to @Int@ so as to handle overflows when performing subtraction later. + tokenPrecision :: Int = fromIntegral assetDecimals + precisionDiff = 10 ** fromIntegral (adaPrecision - tokenPrecision) + + price = Maestro.ohlcCandleInfoCoinAClose info + + adjustedPrice = price * precisionDiff + + return . Right . toRational $ adjustedPrice + where + functionLocationIdent = "getLovelacePriceOfAsset:Maestro" +getLovelacePriceOfAsset (TapToolsPriceProvider TapToolsPP {..}) ac AssetInfo {..} = do + handle handleTapToolsSourceFail $ do + let unit = TapToolsUnit ac + adaPrecision :: Int = 6 -- We cast to @Int@ so as to handle overflows when performing subtraction later. + tokenPrecision :: Int = fromIntegral assetDecimals + precisionDiff = 10 ** fromIntegral (adaPrecision - tokenPrecision) + + priceInfo <- handleTapToolsError (functionLocationIdent <> " - fetching price from unit(s)") <=< try $ tapToolsPrices ttppEnv [unit] + + case M.lookup unit priceInfo of + Nothing -> throwIO $ TapToolsOtherError functionLocationIdent ("Price not found for given unit: " <> toUrlPiece unit) + Just price -> do + let adjustedPrice = price * precisionDiff + return . Right . toRational $ adjustedPrice + where + functionLocationIdent = "getLovelacePriceOfAsset:TapTools" + +foldlM' :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b +foldlM' f = foldlM (\ !acc -> f acc) + +data MaestroPriceException = MaestroApiError !Text !Maestro.MaestroError + deriving stock Show + deriving anyclass Exception + +data TapToolsPriceException + = TapToolsApiError !Text !TapToolsException + | TapToolsOtherError !Text !Text + deriving stock (Eq, Show) + deriving anyclass Exception + +data PricesProviderException + = PPMaestroErr MaestroPriceException + | PPTapToolsErr TapToolsPriceException + deriving stock Show + +instance Exception PricesProviderException where + displayException (PPMaestroErr err) = "Maestro fail: " ++ displayException err + displayException (PPTapToolsErr err) = "TapTools fail: " ++ displayException err + +throwMspvApiError :: Text -> Maestro.MaestroError -> IO a +throwMspvApiError locationInfo = + throwIO . MaestroApiError locationInfo + +handleMaestroError :: Text -> Either Maestro.MaestroError a -> IO a +handleMaestroError locationInfo = either (throwMspvApiError locationInfo) pure + +throwTtpvApiError :: Text -> TapToolsException -> IO a +throwTtpvApiError locationInfo = + throwIO . TapToolsApiError locationInfo + +handleTapToolsError :: Text -> Either TapToolsException a -> IO a +handleTapToolsError locationInfo = either (throwTtpvApiError locationInfo) pure + +handleMaestroSourceFail :: MaestroPriceException -> IO (Either PricesProviderException a) +handleMaestroSourceFail = pure . Left . PPMaestroErr + +handleTapToolsSourceFail :: TapToolsPriceException -> IO (Either PricesProviderException a) +handleTapToolsSourceFail = pure . Left . PPTapToolsErr \ No newline at end of file diff --git a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/OrderBotConfig.hs b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/OrderBotConfig.hs index 31aaace..ec49766 100644 --- a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/OrderBotConfig.hs +++ b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/OrderBotConfig.hs @@ -29,6 +29,8 @@ import Data.Aeson ( import qualified Data.Aeson.Types as Aeson import Data.Bifunctor (first) import Data.List (nub) +import Data.Map.Strict (Map) +import Data.Maybe (fromMaybe) import Data.Random (sample, shuffle) import Data.String (IsString (..)) import qualified Data.Vector as V @@ -83,6 +85,9 @@ data OrderBotConfig , botCLovelaceWarningThreshold :: Maybe Natural -- ^ If bot's lovelace balance falls below this value, bot would log warning logs. , botCPriceProvider :: Maybe PriceProviderConfig + -- ^ Price provider used to get ADA value of a token + , botCTokenInfos :: Maybe (Map GYAssetClass AssetInfo) + -- ^ Token registry information. Since prices given by provider are usually in display units, we need information such as registered decimal places to know lovelace value per indivisible token unit. } deriving stock (Show, Generic) @@ -100,6 +105,7 @@ instance FromEnv OrderBotConfig where -- Apparently, there is no `Var` instance for `Natural` in `System.Envy`. <*> (fmap (fromIntegral @Word64 @Natural) <$> envMaybe "BOTC_LOVELACE_WARNING_THRESHOLD") <*> (fmap forceFromJson <$> envMaybe "BOTC_PRICE_PROVIDER") + <*> (fmap forceFromJson <$> envMaybe "BOTC_TOKEN_INFOS") where parseCBORSKey :: String -> GYPaymentSigningKey parseCBORSKey s = @@ -135,6 +141,7 @@ instance FromJSON OrderBotConfig where <*> obj .: "randomizeMatchesFound" <*> obj .:? "lovelaceWarningThreshold" <*> obj .:? "priceProvider" + <*> obj .:? "tokenInfos" parseJSON _ = fail "Expecting object value" parseScanTokenPairs :: Value -> Aeson.Parser [OrderAssetPair] @@ -171,6 +178,7 @@ buildOrderBot OrderBotConfig {..} = do , botTakeMatches = takeMatches botCRandomizeMatchesFound maxTxPerIter , botLovelaceWarningThreshold = botCLovelaceWarningThreshold , botPriceProvider = botCPriceProvider + , botTokenInfos = fromMaybe mempty botCTokenInfos } where buildCollateral :: Maybe (GYTxOutRef, Bool)