From 7524d8b47fbf98297cf87ff7ee295c39cd7ed653 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Tue, 15 Oct 2024 16:40:39 +0530 Subject: [PATCH 1/4] style(#79): configure fourmolu formatter --- .github/workflows/build.yml | 1 + fourmolu.yaml | 9 + .../lib-common/GeniusYield/OrderBot/Types.hs | 288 ++++---- .../GeniusYield/OrderBot/OrderBook/Extra.hs | 12 +- .../src/GeniusYield/OrderBot.hs | 662 ++++++++++-------- .../GeniusYield/OrderBot/MatchingStrategy.hs | 86 +-- .../GeniusYield/OrderBot/OrderBotConfig.hs | 262 +++---- .../src/GeniusYield/OrderBot/Run.hs | 77 +- geniusyield-orderbot/src/Main.hs | 8 +- geniusyield-orderbot/test/Main.hs | 54 +- .../test/Tests/Prop/Orderbook.hs | 63 +- .../test/Tests/Prop/Strategies.hs | 206 +++--- geniusyield-orderbot/test/Tests/Prop/Utils.hs | 75 +- .../OrderBot/DataSource/Providers.hs | 121 ++-- .../GeniusYield/OrderBot/OrderBook/List.hs | 64 +- .../GeniusYield/OrderBot/Strategies/Impl.hs | 180 ++--- 16 files changed, 1146 insertions(+), 1022 deletions(-) create mode 100644 fourmolu.yaml diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 088e53a..9a5e0b3 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -13,6 +13,7 @@ jobs: packages: write contents: read steps: + - uses: haskell-actions/run-fourmolu@v10 - name: Set up Docker Buildx uses: docker/setup-buildx-action@v3 - name: Login to GitHub Container Registry diff --git a/fourmolu.yaml b/fourmolu.yaml new file mode 100644 index 0000000..2bd0fdc --- /dev/null +++ b/fourmolu.yaml @@ -0,0 +1,9 @@ +indentation: 2 +comma-style: leading +record-brace-space: true +indent-wheres: false +respectful: true +haddock-style: multi-line +newlines-between-decls: 1 +single-constraint-parens: never +single-deriving-parens: never diff --git a/geniusyield-orderbot-framework/lib-common/GeniusYield/OrderBot/Types.hs b/geniusyield-orderbot-framework/lib-common/GeniusYield/OrderBot/Types.hs index 9639baa..c34a158 100644 --- a/geniusyield-orderbot-framework/lib-common/GeniusYield/OrderBot/Types.hs +++ b/geniusyield-orderbot-framework/lib-common/GeniusYield/OrderBot/Types.hs @@ -1,44 +1,43 @@ -{-| +{- | Module : GeniusYield.OrderBot.Types Copyright : (c) 2023 GYELD GMBH License : Apache 2.0 Maintainer : support@geniusyield.co Stability : develop - -} -module GeniusYield.OrderBot.Types - ( OrderInfo (OrderInfo, orderRef, orderType, assetInfo, volume, price, mPoi) - , SomeOrderInfo (SomeOrderInfo) - , OrderAssetPair (OAssetPair, currencyAsset, commodityAsset) - , OrderType (..) - , SOrderType (..) - , SOrderTypeI (..) - , Volume (..) - , Price (..) - , mkOrderInfo - , isSellOrder - , isBuyOrder - , mkOrderAssetPair - , equivalentAssetPair - , mkEquivalentAssetPair - , FillType (..) - , MatchExecutionInfo (..) - , completeFill - , partialFill - ) where - -import Data.Aeson (ToJSON, (.=)) -import qualified Data.Aeson as Aeson -import Data.Kind (Type) -import Data.Ratio (denominator, numerator, (%)) -import Data.Text (Text) -import Numeric.Natural (Natural) - -import GeniusYield.Types.TxOutRef (GYTxOutRef, showTxOutRef) -import GeniusYield.Types.Value (GYAssetClass (..)) - -import GeniusYield.Api.Dex.PartialOrder (PartialOrderInfo (..)) -import GeniusYield.Types (rationalToGHC) +module GeniusYield.OrderBot.Types ( + OrderInfo (OrderInfo, orderRef, orderType, assetInfo, volume, price, mPoi), + SomeOrderInfo (SomeOrderInfo), + OrderAssetPair (OAssetPair, currencyAsset, commodityAsset), + OrderType (..), + SOrderType (..), + SOrderTypeI (..), + Volume (..), + Price (..), + mkOrderInfo, + isSellOrder, + isBuyOrder, + mkOrderAssetPair, + equivalentAssetPair, + mkEquivalentAssetPair, + FillType (..), + MatchExecutionInfo (..), + completeFill, + partialFill, +) where + +import Data.Aeson (ToJSON, (.=)) +import qualified Data.Aeson as Aeson +import Data.Kind (Type) +import Data.Ratio (denominator, numerator, (%)) +import Data.Text (Text) +import Numeric.Natural (Natural) + +import GeniusYield.Types.TxOutRef (GYTxOutRef, showTxOutRef) +import GeniusYield.Types.Value (GYAssetClass (..)) + +import GeniusYield.Api.Dex.PartialOrder (PartialOrderInfo (..)) +import GeniusYield.Types (rationalToGHC) ------------------------------------------------------------------------------- -- Information on DEX orders relevant to a matching strategy @@ -59,17 +58,17 @@ See: 'mkOrderInfo'. -} type OrderInfo :: OrderType -> Type data OrderInfo t = OrderInfo - { orderRef :: !GYTxOutRef - , orderType :: !(SOrderType t) - , assetInfo :: !OrderAssetPair - , volume :: !Volume - -- ^ Volume of the 'commodityAsset', either being bought or sold. - , price :: !Price - -- ^ Price of each 'commodityAsset', in 'currencyAsset'. - , mPoi :: !(Maybe PartialOrderInfo) - -- ^ The complete PartialOrderInfo. To avoid quering it again when filling the order - } - deriving stock (Eq, Show) + { orderRef :: !GYTxOutRef + , orderType :: !(SOrderType t) + , assetInfo :: !OrderAssetPair + , volume :: !Volume + -- ^ Volume of the 'commodityAsset', either being bought or sold. + , price :: !Price + -- ^ Price of each 'commodityAsset', in 'currencyAsset'. + , mPoi :: !(Maybe PartialOrderInfo) + -- ^ The complete PartialOrderInfo. To avoid quering it again when filling the order + } + deriving stock (Eq, Show) -- | Existential that can encapsulate both buy and sell orders. data SomeOrderInfo = forall t. SomeOrderInfo (OrderInfo t) @@ -103,37 +102,39 @@ price multiplied by the DEX order's offered amount. If the result is not a whole number, it is ceiled - because more payment is always accepted, but less is not. The min volume is just the ceiling of the price, because that's the amount of commodity assets you would need to pay to access 1 of the offered currencyAssets. - -} -mkOrderInfo - :: OrderAssetPair - -- ^ The order token Pair with currency and commodity assets - -> PartialOrderInfo - -- ^ The partialOrderInfo to use when building this OrderInfo. - -> SomeOrderInfo -mkOrderInfo oap poi@PartialOrderInfo{..} = case orderType of - BuyOrder -> - let maxVolume = ceiling $ (toInteger poiOfferedAmount % 1) * askedPrice - minVolume = ceiling askedPrice - in builder SBuyOrder - (Volume minVolume maxVolume) $ - Price (denominator askedPrice % numerator askedPrice) - SellOrder -> builder SSellOrder - (Volume 1 poiOfferedAmount) $ - Price askedPrice - where - orderType = mkOrderType poiAskedAsset oap - askedPrice = rationalToGHC poiPrice - builder :: SOrderType t -> Volume -> Price -> SomeOrderInfo - builder t vol price = SomeOrderInfo $ OrderInfo poiRef t oap vol price (Just poi) +mkOrderInfo :: + -- | The order token Pair with currency and commodity assets + OrderAssetPair -> + -- | The partialOrderInfo to use when building this OrderInfo. + PartialOrderInfo -> + SomeOrderInfo +mkOrderInfo oap poi@PartialOrderInfo {..} = case orderType of + BuyOrder -> + let maxVolume = ceiling $ (toInteger poiOfferedAmount % 1) * askedPrice + minVolume = ceiling askedPrice + in builder + SBuyOrder + (Volume minVolume maxVolume) + $ Price (denominator askedPrice % numerator askedPrice) + SellOrder -> + builder + SSellOrder + (Volume 1 poiOfferedAmount) + $ Price askedPrice + where + orderType = mkOrderType poiAskedAsset oap + askedPrice = rationalToGHC poiPrice + builder :: SOrderType t -> Volume -> Price -> SomeOrderInfo + builder t vol price = SomeOrderInfo $ OrderInfo poiRef t oap vol price (Just poi) isSellOrder :: OrderInfo t -> Bool -isSellOrder OrderInfo { orderType = SSellOrder} = True -isSellOrder _ = False +isSellOrder OrderInfo {orderType = SSellOrder} = True +isSellOrder _ = False isBuyOrder :: OrderInfo t -> Bool -isBuyOrder OrderInfo { orderType = SBuyOrder} = True -isBuyOrder _ = False +isBuyOrder OrderInfo {orderType = SBuyOrder} = True +isBuyOrder _ = False ------------------------------------------------------------------------------- -- Order classification components. @@ -142,20 +143,20 @@ isBuyOrder _ = False data OrderType = BuyOrder | SellOrder deriving stock (Eq, Show) data SOrderType (t :: OrderType) where - SBuyOrder :: SOrderType 'BuyOrder - SSellOrder :: SOrderType 'SellOrder + SBuyOrder :: SOrderType 'BuyOrder + SSellOrder :: SOrderType 'SellOrder deriving stock instance Eq (SOrderType t) deriving stock instance Show (SOrderType t) class SOrderTypeI (t :: OrderType) where - sOrderType :: SOrderType t + sOrderType :: SOrderType t instance SOrderTypeI 'BuyOrder where - sOrderType = SBuyOrder + sOrderType = SBuyOrder instance SOrderTypeI 'SellOrder where - sOrderType = SSellOrder + sOrderType = SSellOrder ------------------------------------------------------------------------------- -- Order components @@ -172,31 +173,31 @@ can't always fill it for 1. The amount depends on the price of the order. this invariant. -} data Volume = Volume - { volumeMin :: !Natural - -- ^ Minimum bound of the Order volume interval. - , volumeMax :: !Natural - -- ^ Maximum bound of the Order volume interval. - } - deriving stock (Eq, Show, Ord) + { volumeMin :: !Natural + -- ^ Minimum bound of the Order volume interval. + , volumeMax :: !Natural + -- ^ Maximum bound of the Order volume interval. + } + deriving stock (Eq, Show, Ord) instance Semigroup Volume where - (Volume minV1 maxV1) <> (Volume minV2 maxV2) = Volume (minV1 + minV2) (maxV1 + maxV2) - {-# INLINEABLE (<>) #-} + (Volume minV1 maxV1) <> (Volume minV2 maxV2) = Volume (minV1 + minV2) (maxV1 + maxV2) + {-# INLINEABLE (<>) #-} instance Monoid Volume where - mempty = Volume 0 0 - {-# INLINEABLE mempty #-} + mempty = Volume 0 0 + {-# INLINEABLE mempty #-} -- | The amount of currency asset (per commodity asset) offered or asked for in an order. newtype Price = Price {getPrice :: Rational} deriving stock (Show, Eq, Ord) instance Semigroup Price where - p1 <> p2 = Price $ getPrice p1 + getPrice p2 - {-# INLINEABLE (<>) #-} + p1 <> p2 = Price $ getPrice p1 + getPrice p2 + {-# INLINEABLE (<>) #-} instance Monoid Price where - mempty = Price 0 - {-# INLINEABLE mempty #-} + mempty = Price 0 + {-# INLINEABLE mempty #-} {- | The asset pair in a DEX Order. @@ -208,17 +209,17 @@ For each unique asset pair (see: 'mkAssetPair'), one asset is chosen as the it simpler to perform order matching. -} data OrderAssetPair = OAssetPair - { currencyAsset :: !GYAssetClass - , commodityAsset :: !GYAssetClass - } - deriving stock (Eq, Ord, Show) + { currencyAsset :: !GYAssetClass + , commodityAsset :: !GYAssetClass + } + deriving stock (Eq, Ord, Show) instance ToJSON OrderAssetPair where - toJSON OAssetPair{currencyAsset, commodityAsset} = - Aeson.object - [ "currencyAsset" .= currencyAsset - , "commodityAsset" .= commodityAsset - ] + toJSON OAssetPair {currencyAsset, commodityAsset} = + Aeson.object + [ "currencyAsset" .= currencyAsset + , "commodityAsset" .= commodityAsset + ] {- | Two order asset pairs are considered "equivalent" (but not strictly equal, as in 'Eq'), if they contain the same 2 assets irrespective of order. @@ -229,29 +230,33 @@ equivalentAssetPair :: OrderAssetPair -> OrderAssetPair -> Bool equivalentAssetPair oap oap' = oap == oap' || oap == mkEquivalentAssetPair oap' mkEquivalentAssetPair :: OrderAssetPair -> OrderAssetPair -mkEquivalentAssetPair oap = OAssetPair { commodityAsset = currencyAsset oap - , currencyAsset = commodityAsset oap - } - -mkOrderAssetPair - :: GYAssetClass - -- ^ Asset class of the currency asset in the order. - -> GYAssetClass - -- ^ Asset class of the commodity asset in the order. - -> OrderAssetPair -mkOrderAssetPair curAsset comAsset = OAssetPair { commodityAsset = comAsset - , currencyAsset = curAsset - } - -mkOrderType - :: GYAssetClass - -- ^ Asset class of the asked asset in the order. - -> OrderAssetPair - -- ^ Order Asset Pair with commodity and currency assets - -> OrderType +mkEquivalentAssetPair oap = + OAssetPair + { commodityAsset = currencyAsset oap + , currencyAsset = commodityAsset oap + } + +mkOrderAssetPair :: + -- | Asset class of the currency asset in the order. + GYAssetClass -> + -- | Asset class of the commodity asset in the order. + GYAssetClass -> + OrderAssetPair +mkOrderAssetPair curAsset comAsset = + OAssetPair + { commodityAsset = comAsset + , currencyAsset = curAsset + } + +mkOrderType :: + -- | Asset class of the asked asset in the order. + GYAssetClass -> + -- | Order Asset Pair with commodity and currency assets + OrderAssetPair -> + OrderType mkOrderType asked oap - | commodityAsset oap == asked = BuyOrder - | otherwise = SellOrder + | commodityAsset oap == asked = BuyOrder + | otherwise = SellOrder {- | "Fill" refers to the _volume_ of the order filled. Therefore, its unit is always the 'commodityAsset'. @@ -272,26 +277,33 @@ must be paid by the order. data FillType = CompleteFill | PartialFill Natural deriving stock (Eq, Show) data MatchExecutionInfo - = forall t. OrderExecutionInfo !FillType {-# UNPACK #-} !(OrderInfo t) + = forall t. OrderExecutionInfo !FillType {-# UNPACK #-} !(OrderInfo t) instance ToJSON MatchExecutionInfo where - toJSON (OrderExecutionInfo fillT OrderInfo { orderRef, orderType, assetInfo - , volume - , price = Price {getPrice = x} - }) = + toJSON + ( OrderExecutionInfo + fillT + OrderInfo + { orderRef + , orderType + , assetInfo + , volume + , price = Price {getPrice = x} + } + ) = Aeson.object - [ "utxoRef" .= showTxOutRef orderRef - , "volumeMin" .= volumeMin volume - , "volumeMax" .= volumeMax volume - , "price" .= x - , "commodity" .= commodityAsset assetInfo - , "currency" .= currencyAsset assetInfo - , "type" .= prettySOrderType orderType - , "fillType" .= show fillT - ] - where + [ "utxoRef" .= showTxOutRef orderRef + , "volumeMin" .= volumeMin volume + , "volumeMax" .= volumeMax volume + , "price" .= x + , "commodity" .= commodityAsset assetInfo + , "currency" .= currencyAsset assetInfo + , "type" .= prettySOrderType orderType + , "fillType" .= show fillT + ] + where prettySOrderType :: SOrderType t -> Text - prettySOrderType SBuyOrder = "Buy" + prettySOrderType SBuyOrder = "Buy" prettySOrderType SSellOrder = "Sell" completeFill :: OrderInfo t -> MatchExecutionInfo diff --git a/geniusyield-orderbot-framework/lib-orderbook/GeniusYield/OrderBot/OrderBook/Extra.hs b/geniusyield-orderbot-framework/lib-orderbook/GeniusYield/OrderBot/OrderBook/Extra.hs index 9f70b75..863db45 100644 --- a/geniusyield-orderbot-framework/lib-orderbook/GeniusYield/OrderBot/OrderBook/Extra.hs +++ b/geniusyield-orderbot-framework/lib-orderbook/GeniusYield/OrderBot/OrderBook/Extra.hs @@ -1,4 +1,4 @@ -{-| +{- | Module : GeniusYield.OrderBot.OrderBook.Extra Synopsis : Extra utilities when working with order books. Copyright : (c) 2023 GYELD GMBH @@ -12,9 +12,9 @@ module GeniusYield.OrderBot.OrderBook.Extra ( lookupBest, ) where -import Prelude (Maybe, Monad, (*>), pure) -import GeniusYield.OrderBot.Types (OrderInfo, SOrderTypeI (..), SOrderType (..), OrderType) -import GeniusYield.OrderBot.OrderBook +import GeniusYield.OrderBot.OrderBook +import GeniusYield.OrderBot.Types (OrderInfo, OrderType, SOrderType (..), SOrderTypeI (..)) +import Prelude (Maybe, Monad, pure, (*>)) -- | @foldlM'@ variant for 'Orders' which is strict in accumulator. foldlMOrders' :: forall a t m. Monad m => (a -> OrderInfo t -> m a) -> a -> Orders t -> m a @@ -27,5 +27,5 @@ mapMOrders_ f os = foldlMOrders' (\_ oi -> f oi *> pure ()) () os -- | In case we have buy orders, return the best buy order (highest price). And in case we have sell orders, return the best sell order (lowest price). lookupBest :: forall (t :: OrderType). SOrderTypeI t => Orders t -> Maybe (OrderInfo t) lookupBest os = case (sOrderType @t) of - SBuyOrder -> highestBuyMaybe os - SSellOrder -> lowestSellMaybe os \ No newline at end of file + SBuyOrder -> highestBuyMaybe os + SSellOrder -> lowestSellMaybe os diff --git a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot.hs b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot.hs index cd62a87..002ec01 100644 --- a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot.hs +++ b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot.hs @@ -1,97 +1,111 @@ -{-| +{- | Module : GeniusYield.OrderBot Copyright : (c) 2023 GYELD GMBH License : Apache 2.0 Maintainer : support@geniusyield.co Stability : develop - -} -module GeniusYield.OrderBot ( OrderBot (..) - , ExecutionStrategy (..) - , runOrderBot - ) where - -import Control.Arrow (second, (&&&)) -import Control.Concurrent (threadDelay) -import Control.Exception (AsyncException (UserInterrupt), - SomeException, bracket, - fromException, handle) -import Control.Monad (filterM, forever, - unless) -import Control.Monad.Reader (runReaderT) -import Data.Aeson (ToJSON, encode) -import Data.Foldable (foldl', toList) -import Data.Functor ((<&>)) -import Data.List (find) -import Data.Maybe (mapMaybe) - -import System.Exit (exitSuccess) - -import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString.Lazy as BL -import qualified Data.List.NonEmpty as NE (toList) -import qualified Data.Map as M -import qualified Data.Text as Txt - -import GeniusYield.GYConfig (GYCoreConfig (cfgNetworkId), - withCfgProviders) -import GeniusYield.OrderBot.DataSource (closeDB, connectDB) -import GeniusYield.OrderBot.MatchingStrategy (IndependentStrategy, - MatchExecutionInfo (..), - MatchResult, - executionSkeleton, - matchExecutionInfoUtxoRef) -import GeniusYield.OrderBot.OrderBook (OrderBook, buyOrders, - foldrOrders, - maOrderBookToList, - populateOrderBook, - sellOrders, - withEachAsset) -import GeniusYield.OrderBot.Types (OrderAssetPair (..), - assetInfo) -import GeniusYield.Providers.Common (SubmitTxException) -import GeniusYield.TxBuilder (GYTxBuildResult (..), - GYTxBuilderMonadIO, - GYTxSkeleton, - buildTxBodyParallelWithStrategy, - runGYTxBuilderMonadIO, - runGYTxQueryMonadIO, - utxosAtTxOutRefs) -import GeniusYield.Types - -import GeniusYield.Api.Dex.Constants (DEXInfo (..)) -import GeniusYield.Transaction (GYCoinSelectionStrategy (GYLegacy)) -import GeniusYield.TxBuilder.Errors (GYTxMonadException) +module GeniusYield.OrderBot ( + OrderBot (..), + ExecutionStrategy (..), + runOrderBot, +) where + +import Control.Arrow (second, (&&&)) +import Control.Concurrent (threadDelay) +import Control.Exception ( + AsyncException (UserInterrupt), + SomeException, + bracket, + fromException, + handle, + ) +import Control.Monad ( + filterM, + forever, + unless, + ) +import Control.Monad.Reader (runReaderT) +import Data.Aeson (ToJSON, encode) +import Data.Foldable (foldl', toList) +import Data.Functor ((<&>)) +import Data.List (find) +import Data.Maybe (mapMaybe) + +import System.Exit (exitSuccess) + +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.List.NonEmpty as NE (toList) +import qualified Data.Map as M +import qualified Data.Text as Txt + +import GeniusYield.GYConfig ( + GYCoreConfig (cfgNetworkId), + withCfgProviders, + ) +import GeniusYield.OrderBot.DataSource (closeDB, connectDB) +import GeniusYield.OrderBot.MatchingStrategy ( + IndependentStrategy, + MatchExecutionInfo (..), + MatchResult, + executionSkeleton, + matchExecutionInfoUtxoRef, + ) +import GeniusYield.OrderBot.OrderBook ( + OrderBook, + buyOrders, + foldrOrders, + maOrderBookToList, + populateOrderBook, + sellOrders, + withEachAsset, + ) +import GeniusYield.OrderBot.Types ( + OrderAssetPair (..), + assetInfo, + ) +import GeniusYield.Providers.Common (SubmitTxException) +import GeniusYield.TxBuilder ( + GYTxBuildResult (..), + GYTxBuilderMonadIO, + GYTxSkeleton, + buildTxBodyParallelWithStrategy, + runGYTxBuilderMonadIO, + runGYTxQueryMonadIO, + utxosAtTxOutRefs, + ) +import GeniusYield.Types + +import GeniusYield.Api.Dex.Constants (DEXInfo (..)) +import GeniusYield.Transaction (GYCoinSelectionStrategy (GYLegacy)) +import GeniusYield.TxBuilder.Errors (GYTxMonadException) -- | The order bot is product type between bot info and "execution strategies". data OrderBot = OrderBot - { botSkey :: !GYPaymentSigningKey - -- ^ Signing key of the bot. - , botStakeAddress :: !(Maybe GYStakeAddressBech32) - -- ^ Optional bech32 encoded stake address. - , botCollateral :: !(Maybe (GYTxOutRef, Bool)) - {- ^ UTxO ref of the collateral UTxO in the bot's wallet. - - NOTE: If collateral is Nothing, then Atlas will choose some UTxO to - function as collateral. If a TxOutRef is given, the bool indicates whether - the collateral can be spent in the tx. - -} - , botExecutionStrat :: !ExecutionStrategy - -- ^ The execution strategy, which includes and governs the matching strategy. - , botAssetPairFilter :: [OrderAssetPair] - {- ^ List that can be used to filter out uninteresting orders/pools. - The multiasset order book is created only with the existing pairs on - the list. - -} - , botRescanDelay :: Int - {- ^ How many microseconds to wait after a tx submission before rescanning - the chain for orders. - -} - , botTakeMatches :: [MatchResult] -> IO [MatchResult] - {- ^ How and how many matching results do the bot takes to build, sign and - submit every iteration. - -} - } + { botSkey :: !GYPaymentSigningKey + -- ^ Signing key of the bot. + , botStakeAddress :: !(Maybe GYStakeAddressBech32) + -- ^ Optional bech32 encoded stake address. + , botCollateral :: !(Maybe (GYTxOutRef, Bool)) + -- ^ UTxO ref of the collateral UTxO in the bot's wallet. + -- + -- NOTE: If collateral is Nothing, then Atlas will choose some UTxO to + -- function as collateral. If a TxOutRef is given, the bool indicates whether + -- the collateral can be spent in the tx. + , botExecutionStrat :: !ExecutionStrategy + -- ^ The execution strategy, which includes and governs the matching strategy. + , botAssetPairFilter :: [OrderAssetPair] + -- ^ List that can be used to filter out uninteresting orders/pools. + -- The multiasset order book is created only with the existing pairs on + -- the list. + , botRescanDelay :: Int + -- ^ How many microseconds to wait after a tx submission before rescanning + -- the chain for orders. + , botTakeMatches :: [MatchResult] -> IO [MatchResult] + -- ^ How and how many matching results do the bot takes to build, sign and + -- submit every iteration. + } {- | Currently, we only have the parallel execution strategy: @MultiAssetTraverse@, where each order book for each unique asset pair (see: "GeniusYield.OrderBot.Types.equivalentAssetPair") @@ -99,18 +113,18 @@ data OrderBot = OrderBot -} newtype ExecutionStrategy = MultiAssetTraverse IndependentStrategy +runOrderBot :: + -- | Path to the config file for the GY framework. + GYCoreConfig -> + -- | Complete DEX information. + DEXInfo -> + -- | OrderBot configuration. + OrderBot -> + IO () runOrderBot - :: GYCoreConfig - -- ^ Path to the config file for the GY framework. - -> DEXInfo - -- ^ Complete DEX information. - -> OrderBot - -- ^ OrderBot configuration. - -> IO () -runOrderBot - cfg - di - OrderBot + cfg + di + OrderBot { botSkey , botStakeAddress , botCollateral @@ -120,151 +134,183 @@ runOrderBot , botTakeMatches } = do withCfgProviders cfg "" $ \providers -> do - let logInfo = gyLogInfo providers "SOR" - logDebug = gyLogDebug providers "SOR" - - netId = cfgNetworkId cfg - botPkh = paymentKeyHash $ paymentVerificationKey botSkey - botChangeAddr = addressFromCredential netId (GYPaymentCredentialByKey botPkh) (stakeAddressToCredential . stakeAddressFromBech32 <$> botStakeAddress) - botAddrs = [botChangeAddr] - - logInfo $ unlines - [ "" - , "Starting bot with given credentials" - , " Payment key hash: " ++ show (paymentKeyHashToPlutus botPkh) - , " Wallet Addresses: " ++ show (Txt.unpack . addressToText <$> botAddrs) - , " Change Address: " ++ (Txt.unpack . addressToText $ botChangeAddr) - , " Collateral: " ++ show botCollateral - , " Scan delay (µs): " ++ show botRescanDelay - , " Token Pairs to scan:" - , unlines (map (("\t - " ++) . show) botAssetPairFilter) - , "" - ] - - bracket (connectDB netId providers) closeDB $ \conn -> forever $ - handle (handleAnyException providers) $ do - logInfo "Rescanning for orders..." - - -- First we populate the multi asset orderbook, using the provided - -- @populateOrderBook@. - book <- populateOrderBook conn di botAssetPairFilter - - let bookList = maOrderBookToList book - logInfo $ unwords [ "MultiAsset Order Book Info:" - , unwords $ jsonBookInfo bookList - ] - logDebug $ unwords [ "MultiAsset Order Book:" - , jsonPrint bookList - ] - - -- Now we pass each asset pair's orderbook to the provided execution strategy. - let matchesFound = withEachAsset strat book - - logDebug $ unwords [ "Matches Found:" - , jsonPrint matchesFound - ] - logInfo $ unwords [ "Total matches found:" - , jsonPrint $ M.toList $ matchingsPerOrderAssetPair botAssetPairFilter matchesFound - ] - - {- This part builds and submits the transactions from the returned matches. - This part has the highest chances of throwing exceptions, as it's extremely - stateful. The user provided exception handler is used to wrap this flow. - -} - unless (all null matchesFound) $ do - - matchesToExecute <- botTakeMatches matchesFound - - logDebug $ unwords [ "Matches To Execute:" - , jsonPrint matchesToExecute - ] - - logInfo $ unwords [ "Number Of Matches To Execute:" - , jsonPrint $ M.toList $ matchingsPerOrderAssetPair botAssetPairFilter matchesToExecute - ] - - -- We first build all the tx Bodies from the matches - txs <- buildTransactions matchesToExecute di netId providers (botAddrs, botChangeAddr) botCollateral - - logInfo $ unwords [ "Number Of Matches Built:" - , show $ length txs - ] - - -- We filter the txs that are not losing tokens - profitableTxs <- filterM (notLosingTokensCheck netId providers botAddrs botAssetPairFilter) - txs - - logInfo $ unwords [ "Transactions are losing money:" - , show (length txs - length profitableTxs) - ] - - {- We submit the txs sequentially. It's important to do it this way - because a utxo used as collateral in tx 1 can be used as input in tx2. - If we submit those txs concurrently, it can fail -} - - mapM_ (\(tx,_) -> signAndSubmitTx tx providers botSkey) profitableTxs - - {- Block production on the chain takes time. One has to wait for some amount - of time before the blockchain state properly changes and another transaction - can be submitted. - -} - logInfo "Waiting to rescan for orders..." - threadDelay botRescanDelay - where - handleAnyException :: GYProviders -> SomeException -> IO () - handleAnyException _ (fromException -> Just UserInterrupt) = - putStrLn "Gracefully stopping..." >> exitSuccess - handleAnyException providers err = - let logErr = gyLogError providers "SOR" - in logErr (show err) >> threadDelay botRescanDelay + let logInfo = gyLogInfo providers "SOR" + logDebug = gyLogDebug providers "SOR" + + netId = cfgNetworkId cfg + botPkh = paymentKeyHash $ paymentVerificationKey botSkey + botChangeAddr = addressFromCredential netId (GYPaymentCredentialByKey botPkh) (stakeAddressToCredential . stakeAddressFromBech32 <$> botStakeAddress) + botAddrs = [botChangeAddr] + + logInfo $ + unlines + [ "" + , "Starting bot with given credentials" + , " Payment key hash: " ++ show (paymentKeyHashToPlutus botPkh) + , " Wallet Addresses: " ++ show (Txt.unpack . addressToText <$> botAddrs) + , " Change Address: " ++ (Txt.unpack . addressToText $ botChangeAddr) + , " Collateral: " ++ show botCollateral + , " Scan delay (µs): " ++ show botRescanDelay + , " Token Pairs to scan:" + , unlines (map (("\t - " ++) . show) botAssetPairFilter) + , "" + ] + + bracket (connectDB netId providers) closeDB $ \conn -> forever $ + handle (handleAnyException providers) $ do + logInfo "Rescanning for orders..." + + -- First we populate the multi asset orderbook, using the provided + -- @populateOrderBook@. + book <- populateOrderBook conn di botAssetPairFilter + + let bookList = maOrderBookToList book + logInfo $ + unwords + [ "MultiAsset Order Book Info:" + , unwords $ jsonBookInfo bookList + ] + logDebug $ + unwords + [ "MultiAsset Order Book:" + , jsonPrint bookList + ] + + -- Now we pass each asset pair's orderbook to the provided execution strategy. + let matchesFound = withEachAsset strat book + + logDebug $ + unwords + [ "Matches Found:" + , jsonPrint matchesFound + ] + logInfo $ + unwords + [ "Total matches found:" + , jsonPrint $ M.toList $ matchingsPerOrderAssetPair botAssetPairFilter matchesFound + ] + + {- This part builds and submits the transactions from the returned matches. + This part has the highest chances of throwing exceptions, as it's extremely + stateful. The user provided exception handler is used to wrap this flow. + -} + unless (all null matchesFound) $ do + matchesToExecute <- botTakeMatches matchesFound + + logDebug $ + unwords + [ "Matches To Execute:" + , jsonPrint matchesToExecute + ] + + logInfo $ + unwords + [ "Number Of Matches To Execute:" + , jsonPrint $ M.toList $ matchingsPerOrderAssetPair botAssetPairFilter matchesToExecute + ] + + -- We first build all the tx Bodies from the matches + txs <- buildTransactions matchesToExecute di netId providers (botAddrs, botChangeAddr) botCollateral + + logInfo $ + unwords + [ "Number Of Matches Built:" + , show $ length txs + ] + + -- We filter the txs that are not losing tokens + profitableTxs <- + filterM + (notLosingTokensCheck netId providers botAddrs botAssetPairFilter) + txs + + logInfo $ + unwords + [ "Transactions are losing money:" + , show (length txs - length profitableTxs) + ] + + {- We submit the txs sequentially. It's important to do it this way + because a utxo used as collateral in tx 1 can be used as input in tx2. + If we submit those txs concurrently, it can fail -} + + mapM_ (\(tx, _) -> signAndSubmitTx tx providers botSkey) profitableTxs + + {- Block production on the chain takes time. One has to wait for some amount + of time before the blockchain state properly changes and another transaction + can be submitted. + -} + logInfo "Waiting to rescan for orders..." + threadDelay botRescanDelay + where + handleAnyException :: GYProviders -> SomeException -> IO () + handleAnyException _ (fromException -> Just UserInterrupt) = + putStrLn "Gracefully stopping..." >> exitSuccess + handleAnyException providers err = + let logErr = gyLogError providers "SOR" + in logErr (show err) >> threadDelay botRescanDelay signAndSubmitTx :: GYTxBody -> GYProviders -> GYPaymentSigningKey -> IO () signAndSubmitTx txBody providers botSkey = handle handlerSubmit $ do - let tx = signGYTxBody txBody [botSkey] - logDebug $ unwords [ "Transaction to submit:", show txBody ] - tid <- gySubmitTx providers tx - 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" - - handlerSubmit :: SubmitTxException -> IO () - handlerSubmit ex = logWarn $ unwords ["SubmitTxException:", show ex] - + let tx = signGYTxBody txBody [botSkey] + logDebug $ unwords ["Transaction to submit:", show txBody] + tid <- gySubmitTx providers tx + 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" + + handlerSubmit :: SubmitTxException -> IO () + handlerSubmit ex = logWarn $ unwords ["SubmitTxException:", show ex] + +buildTransactions :: + [MatchResult] -> + DEXInfo -> + GYNetworkId -> + GYProviders -> + ([GYAddress], GYAddress) -> + Maybe (GYTxOutRef, Bool) -> + IO [(GYTxBody, MatchResult)] buildTransactions - :: [MatchResult] - -> DEXInfo - -> GYNetworkId - -> GYProviders - -> ([GYAddress], GYAddress) - -> Maybe (GYTxOutRef, Bool) - -> IO [(GYTxBody, MatchResult)] -buildTransactions matchesToExecute di netId - providers (botAddrs, botChangeAddr) botCollateral = handle handlerBuildTx $ do - - res <- runGYTxMonadNodeParallelWithStrategy - GYLegacy - netId providers botAddrs botChangeAddr - botCollateral $ traverse resultToSkeleton matchesToExecute + matchesToExecute + di + netId + providers + (botAddrs, botChangeAddr) + botCollateral = handle handlerBuildTx $ do + res <- + runGYTxMonadNodeParallelWithStrategy + GYLegacy + netId + providers + botAddrs + botChangeAddr + botCollateral + $ traverse resultToSkeleton matchesToExecute case res of - -- Successful cases - GYTxBuildSuccess txs -> return $ zip (getBodies txs) matchesToExecute - GYTxBuildPartialSuccess _ txs -> return $ mapMaybe (findBody (getBodies txs)) - matchesToExecute - -- Failure cases - GYTxBuildFailure v -> logWarn (unwords ["Insufficient funds:", show v]) - >> return [] - GYTxBuildNoInputs -> logWarn "No Inputs" >> return [] - where + -- Successful cases + GYTxBuildSuccess txs -> return $ zip (getBodies txs) matchesToExecute + GYTxBuildPartialSuccess _ txs -> + return $ + mapMaybe + (findBody (getBodies txs)) + matchesToExecute + -- Failure cases + GYTxBuildFailure v -> + logWarn (unwords ["Insufficient funds:", show v]) + >> return [] + GYTxBuildNoInputs -> logWarn "No Inputs" >> return [] + where logWarn :: String -> IO () - logWarn = gyLogWarning providers "SOR" + logWarn = gyLogWarning providers "SOR" findBody :: [GYTxBody] -> MatchResult -> Maybe (GYTxBody, MatchResult) - findBody bs mr = let ref = matchExecutionInfoUtxoRef $ head mr - in find (elem ref . txBodyTxIns) bs <&> (,mr) + findBody bs mr = + let ref = matchExecutionInfoUtxoRef $ head mr + in find (elem ref . txBodyTxIns) bs <&> (,mr) getBodies = NE.toList @@ -272,77 +318,91 @@ buildTransactions matchesToExecute di netId resultToSkeleton mResult = runReaderT (executionSkeleton (dexPORefs di) mResult) di handlerBuildTx :: GYTxMonadException -> IO [(GYTxBody, MatchResult)] - handlerBuildTx ex = logWarn (unwords ["GYTxMonadException:", show ex]) - >> return [] - -notLosingTokensCheck - :: GYNetworkId - -> GYProviders - -> [GYAddress] - -> [OrderAssetPair] - -> (GYTxBody, MatchResult) - -> IO Bool + handlerBuildTx ex = + logWarn (unwords ["GYTxMonadException:", show ex]) + >> return [] + +notLosingTokensCheck :: + GYNetworkId -> + GYProviders -> + [GYAddress] -> + [OrderAssetPair] -> + (GYTxBody, MatchResult) -> + IO Bool notLosingTokensCheck netId providers botAddrs oapFilter (txBody, matchesToExecute) = do - let logDebug = gyLogDebug providers "SOR" - logWarn = gyLogWarning providers "SOR" - matchesRefs = map matchExecutionInfoUtxoRef matchesToExecute - botInputs = filter (`notElem` matchesRefs) $ txBodyTxIns txBody - - inputs <- runGYTxQueryMonadIO netId providers $ utxosAtTxOutRefs botInputs - - let (inputLovelace, filteredACInput) = - utxosLovelaceAndFilteredValueAtAddr inputs - (outputLovelace, filteredACOutput) = - utxosLovelaceAndFilteredValueAtAddr $ txBodyUTxOs txBody - - 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 - - unless lovelaceCheck $ logWarn $ unwords + let logDebug = gyLogDebug providers "SOR" + logWarn = gyLogWarning providers "SOR" + matchesRefs = map matchExecutionInfoUtxoRef matchesToExecute + botInputs = filter (`notElem` matchesRefs) $ txBodyTxIns txBody + + inputs <- runGYTxQueryMonadIO netId providers $ utxosAtTxOutRefs botInputs + + let (inputLovelace, filteredACInput) = + utxosLovelaceAndFilteredValueAtAddr inputs + (outputLovelace, filteredACOutput) = + utxosLovelaceAndFilteredValueAtAddr $ txBodyUTxOs txBody + + 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 + + unless lovelaceCheck $ + logWarn $ + unwords [ "Transaction losing lovelaces: " , "Expected ADA total amount at least: " ++ show (inputLovelace - fees) , "Actual ADA total amount: " ++ show outputLovelace ] - unless filteredACCheck $ logWarn $ unwords + unless filteredACCheck $ + logWarn $ + unwords [ "Transaction losing tokens: " , "Expected Tokens total amount: " ++ show filteredACOutput , "Actual Tokens total amount: " ++ show filteredACInput ] - unless completeCheck $ do - logDebug $ unwords [ "CompleteChecks:" - , jsonPrint matchesToExecute - , "Tx: " ++ show txBody - ] - - return completeCheck - where - botAssetFilter :: GYAssetClass -> Bool - botAssetFilter ac = - any (\oap -> currencyAsset oap == ac || commodityAsset oap == ac) - oapFilter - - utxosValueAtAddr :: GYUTxOs -> GYValue - utxosValueAtAddr = mconcat . map utxoValue . - filter ((`elem` botAddrs) . utxoAddress) . utxosToList - - utxosLovelaceAndFilteredValueAtAddr - :: GYUTxOs - -> (Integer, GYValue) - utxosLovelaceAndFilteredValueAtAddr utxos = - second (valueFromList . filter (botAssetFilter . fst) . valueToList) $ - valueSplitAda $ utxosValueAtAddr utxos - - currencyIsLovelace :: OrderAssetPair -> Bool - currencyIsLovelace oap = currencyAsset oap == GYLovelace + unless completeCheck $ do + logDebug $ + unwords + [ "CompleteChecks:" + , jsonPrint matchesToExecute + , "Tx: " ++ show txBody + ] + + return completeCheck + where + botAssetFilter :: GYAssetClass -> Bool + botAssetFilter ac = + any + (\oap -> currencyAsset oap == ac || commodityAsset oap == ac) + oapFilter + + utxosValueAtAddr :: GYUTxOs -> GYValue + utxosValueAtAddr = + mconcat + . map utxoValue + . filter ((`elem` botAddrs) . utxoAddress) + . utxosToList + + utxosLovelaceAndFilteredValueAtAddr :: + GYUTxOs -> + (Integer, GYValue) + utxosLovelaceAndFilteredValueAtAddr utxos = + second (valueFromList . filter (botAssetFilter . fst) . valueToList) $ + valueSplitAda $ + utxosValueAtAddr utxos + + currencyIsLovelace :: OrderAssetPair -> Bool + currencyIsLovelace oap = currencyAsset oap == GYLovelace ------------------------------------------------------------------------------- -- Helpers @@ -355,17 +415,17 @@ jsonBookInfo :: [(OrderAssetPair, OrderBook)] -> [String] jsonBookInfo = map (jsonPrint . second (totalSellOrders &&& totalBuyOrders)) totalSellOrders :: OrderBook -> Int -totalSellOrders = foldrOrders (const (+1)) 0 . sellOrders +totalSellOrders = foldrOrders (const (+ 1)) 0 . sellOrders totalBuyOrders :: OrderBook -> Int -totalBuyOrders = foldrOrders (const (+1)) 0 . buyOrders +totalBuyOrders = foldrOrders (const (+ 1)) 0 . buyOrders matchingsPerOrderAssetPair :: [OrderAssetPair] -> [MatchResult] -> M.Map OrderAssetPair Int -matchingsPerOrderAssetPair oaps = foldl' succOAP (M.fromList $ map (, 0) oaps) - where - succOAP :: M.Map OrderAssetPair Int -> MatchResult -> M.Map OrderAssetPair Int - succOAP m (OrderExecutionInfo _ oi : _) = M.insertWith (+) (assetInfo oi) 1 m - succOAP m _ = m +matchingsPerOrderAssetPair oaps = foldl' succOAP (M.fromList $ map (,0) oaps) + where + succOAP :: M.Map OrderAssetPair Int -> MatchResult -> M.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 diff --git a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/MatchingStrategy.hs b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/MatchingStrategy.hs index 4e2c03a..14ec49a 100644 --- a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/MatchingStrategy.hs +++ b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/MatchingStrategy.hs @@ -1,54 +1,56 @@ -{-| +{- | Module : GeniusYield.OrderBot.MatchingStrategy Copyright : (c) 2023 GYELD GMBH License : Apache 2.0 Maintainer : support@geniusyield.co Stability : develop - -} -module GeniusYield.OrderBot.MatchingStrategy - ( IndependentStrategy - , FillType (..) - , MatchExecutionInfo (..) - , MatchResult - , completeFill - , partialFill - , executionSkeleton - , matchExecutionInfoUtxoRef - ) where - -import Data.Maybe (fromJust) -import GeniusYield.Api.Dex.PartialOrder (PORefs, - PartialOrderInfo (poiOfferedAmount), - fillMultiplePartialOrders') -import GeniusYield.Api.Dex.Types (GYDexApiMonad) -import GeniusYield.OrderBot.Strategies (IndependentStrategy, - MatchResult) -import GeniusYield.OrderBot.Types -import GeniusYield.TxBuilder (GYTxSkeleton) -import GeniusYield.Types.PlutusVersion (PlutusVersion (PlutusV2)) -import GeniusYield.Types.TxOutRef (GYTxOutRef) +module GeniusYield.OrderBot.MatchingStrategy ( + IndependentStrategy, + FillType (..), + MatchExecutionInfo (..), + MatchResult, + completeFill, + partialFill, + executionSkeleton, + matchExecutionInfoUtxoRef, +) where +import Data.Maybe (fromJust) +import GeniusYield.Api.Dex.PartialOrder ( + PORefs, + PartialOrderInfo (poiOfferedAmount), + fillMultiplePartialOrders', + ) +import GeniusYield.Api.Dex.Types (GYDexApiMonad) +import GeniusYield.OrderBot.Strategies ( + IndependentStrategy, + MatchResult, + ) +import GeniusYield.OrderBot.Types +import GeniusYield.TxBuilder (GYTxSkeleton) +import GeniusYield.Types.PlutusVersion (PlutusVersion (PlutusV2)) +import GeniusYield.Types.TxOutRef (GYTxOutRef) -executionSkeleton - :: GYDexApiMonad m a - => PORefs - -> MatchResult - -> m (GYTxSkeleton 'PlutusV2) +executionSkeleton :: + GYDexApiMonad m a => + PORefs -> + MatchResult -> + m (GYTxSkeleton 'PlutusV2) executionSkeleton pors mr = fillMultiplePartialOrders' pors (map f mr) Nothing mempty - where - f (OrderExecutionInfo ft o) = - let oi = fromJust $ mPoi o in -- It's always under `Just` constructor in our code, but we aren't able to get rid of `Maybe` type for now since that would require significant changes in the test-suite. - (oi - , case ft of - CompleteFill -> poiOfferedAmount oi - PartialFill n -> - if isBuyOrder o then - floor $ fromIntegral n * getPrice (price o) - else - n - ) - + where + f (OrderExecutionInfo ft o) = + let oi = fromJust $ mPoi o -- It's always under `Just` constructor in our code, but we aren't able to get rid of `Maybe` type for now since that would require significant changes in the test-suite. + in ( oi + , case ft of + CompleteFill -> poiOfferedAmount oi + PartialFill n -> + if isBuyOrder o + then + floor $ fromIntegral n * getPrice (price o) + else + n + ) matchExecutionInfoUtxoRef :: MatchExecutionInfo -> GYTxOutRef matchExecutionInfoUtxoRef (OrderExecutionInfo CompleteFill OrderInfo {orderRef}) = orderRef diff --git a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/OrderBotConfig.hs b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/OrderBotConfig.hs index fafc5c0..1569f7e 100644 --- a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/OrderBotConfig.hs +++ b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/OrderBotConfig.hs @@ -1,106 +1,113 @@ -{-| +{- | Module : GeniusYield.OrderBot.OrderBotConfig Copyright : (c) 2023 GYELD GMBH License : Apache 2.0 Maintainer : support@geniusyield.co Stability : develop - -} module GeniusYield.OrderBot.OrderBotConfig where -import Control.Exception ( throwIO ) -import Control.Monad ( (<=<) ) -import Control.Monad.Reader ( runReaderT ) -import Control.Monad.Error.Class ( throwError ) -import Data.Aeson ( eitherDecodeFileStrict - , (.:), (.:?) - , withArray, withObject - , FromJSON(parseJSON) - , Array - , Value(Object), eitherDecodeStrict - ) +import Control.Exception (throwIO) +import Control.Monad ((<=<)) +import Control.Monad.Error.Class (throwError) +import Control.Monad.Reader (runReaderT) +import Data.Aeson ( + Array, + FromJSON (parseJSON), + Value (Object), + eitherDecodeFileStrict, + eitherDecodeStrict, + withArray, + withObject, + (.:), + (.:?), + ) import qualified Data.Aeson.Types as Aeson -import Data.Bifunctor ( first ) -import Data.String ( IsString(..) ) -import Data.Random ( shuffle, sample ) +import Data.Bifunctor (first) +import Data.List (nub) +import Data.Random (sample, shuffle) +import Data.String (IsString (..)) import qualified Data.Vector as V -import Data.List ( nub ) -import GHC.Generics ( Generic ) -import System.Envy ( FromEnv (fromEnv), Var, Parser, envMaybe, env - , decodeEnv - ) -import System.Random.MWC (fromSeed, initialize, createSystemSeed) - -import GeniusYield.OrderBot -import GeniusYield.OrderBot.Types ( OrderAssetPair(..) - , equivalentAssetPair - ) -import GeniusYield.OrderBot.MatchingStrategy ( MatchResult ) -import GeniusYield.Types -import Cardano.Api ( AsType (AsSigningKey, AsPaymentKey) - , deserialiseFromTextEnvelope - ) - -import GeniusYield.OrderBot.Strategies ( BotStrategy, allStrategies, mkIndependentStrategy ) +import GHC.Generics (Generic) +import System.Envy ( + FromEnv (fromEnv), + Parser, + Var, + decodeEnv, + env, + envMaybe, + ) +import System.Random.MWC (createSystemSeed, fromSeed, initialize) + +import Cardano.Api ( + AsType (AsPaymentKey, AsSigningKey), + deserialiseFromTextEnvelope, + ) +import GeniusYield.OrderBot +import GeniusYield.OrderBot.MatchingStrategy (MatchResult) +import GeniusYield.OrderBot.Types ( + OrderAssetPair (..), + equivalentAssetPair, + ) +import GeniusYield.Types + +import GeniusYield.OrderBot.Strategies (BotStrategy, allStrategies, mkIndependentStrategy) -- | Order bot vanilla config. -data OrderBotConfig = - OrderBotConfig - { botCSkey :: Either FilePath GYPaymentSigningKey - -- ^ Signing key of the bot. - , botCStakeAddress :: Maybe GYStakeAddressBech32 - -- ^ Optional bech32 encoded stake address. - , botCCollateral :: Maybe GYTxOutRef - {- ^ UTxO ref of the collateral UTxO in the bot's wallet. - - NOTE: If collateral is Nothing, then Atlas will choose some UTxO to - function as collateral. If a TxOutRef is given, the bool indicates wheter - the collateral can be spent in the tx. - -} - , botCExecutionStrat :: BotStrategy - -- ^ Name of the running strategy. - , botCAssetFilter :: [OrderAssetPair] - -- ^ List of asset pairs to scan. - , botCRescanDelay :: Int - {- ^ The duration (microseconds) of time we wait before re-initiating a - complete iteration for the bot. - -} - , botCMaxOrderMatches :: Int - -- ^ The maximum amount of orders to be matched into a single transaction. - , botCMaxTxsPerIteration :: Int - {- ^ The maximum amount of transactions that the bot will build, sign and - submit in each iteration. - -} - , botCRandomizeMatchesFound :: Bool - {- ^ A boolean that dictates whether the bot chooses the tx to submit at - random (to decrease collisions), or not (to maximize profit) - -} - } - deriving stock (Show, Eq, Generic) +data OrderBotConfig + = OrderBotConfig + { botCSkey :: Either FilePath GYPaymentSigningKey + -- ^ Signing key of the bot. + , botCStakeAddress :: Maybe GYStakeAddressBech32 + -- ^ Optional bech32 encoded stake address. + , botCCollateral :: Maybe GYTxOutRef + -- ^ UTxO ref of the collateral UTxO in the bot's wallet. + -- + -- NOTE: If collateral is Nothing, then Atlas will choose some UTxO to + -- function as collateral. If a TxOutRef is given, the bool indicates wheter + -- the collateral can be spent in the tx. + , botCExecutionStrat :: BotStrategy + -- ^ Name of the running strategy. + , botCAssetFilter :: [OrderAssetPair] + -- ^ List of asset pairs to scan. + , botCRescanDelay :: Int + -- ^ The duration (microseconds) of time we wait before re-initiating a + -- complete iteration for the bot. + , botCMaxOrderMatches :: Int + -- ^ The maximum amount of orders to be matched into a single transaction. + , botCMaxTxsPerIteration :: Int + -- ^ The maximum amount of transactions that the bot will build, sign and + -- submit in each iteration. + , botCRandomizeMatchesFound :: Bool + -- ^ A boolean that dictates whether the bot chooses the tx to submit at + -- random (to decrease collisions), or not (to maximize profit) + } + deriving stock (Show, Eq, Generic) instance FromEnv OrderBotConfig where - fromEnv _ = - OrderBotConfig - <$> (Right . parseCBORSKey <$> env "BOTC_SKEY") - <*> (fmap fromString <$> envMaybe "BOTC_STAKE_ADDRESS") - <*> (fmap fromString <$> envMaybe "BOTC_COLLATERAL") - <*> envWithMsg ("Invalid Strategy. Must be one of: " ++ show allStrategies) "BOTC_EXECUTION_STRAT" - <*> (parseArray <$> env "BOTC_ASSET_FILTER") - <*> envIntWithMsg "BOTC_RESCAN_DELAY" - <*> envIntWithMsg "BOTC_MAX_ORDERS_MATCHES" - <*> envIntWithMsg "BOTC_MAX_TXS_PER_ITERATION" - <*> envWithMsg "Must be either 'True' or 'False'" "BOTC_RANDOMIZE_MATCHES_FOUND" - where - parseCBORSKey :: String -> GYPaymentSigningKey - parseCBORSKey s = - either (error . ("Error parsing 'BOTC_SKEY': " ++)) paymentSigningKeyFromApi $ - eitherDecodeStrict (fromString s) >>= - first show . deserialiseFromTextEnvelope (AsSigningKey AsPaymentKey) - - parseArray :: String -> [OrderAssetPair] - parseArray s = either (error . ("Error parsing 'BOTC_ASSET_FILTER': " ++) ) id $ - eitherDecodeStrict (fromString s) >>= - Aeson.parseEither parseScanTokenPairs + fromEnv _ = + OrderBotConfig + <$> (Right . parseCBORSKey <$> env "BOTC_SKEY") + <*> (fmap fromString <$> envMaybe "BOTC_STAKE_ADDRESS") + <*> (fmap fromString <$> envMaybe "BOTC_COLLATERAL") + <*> envWithMsg ("Invalid Strategy. Must be one of: " ++ show allStrategies) "BOTC_EXECUTION_STRAT" + <*> (parseArray <$> env "BOTC_ASSET_FILTER") + <*> envIntWithMsg "BOTC_RESCAN_DELAY" + <*> envIntWithMsg "BOTC_MAX_ORDERS_MATCHES" + <*> envIntWithMsg "BOTC_MAX_TXS_PER_ITERATION" + <*> envWithMsg "Must be either 'True' or 'False'" "BOTC_RANDOMIZE_MATCHES_FOUND" + where + parseCBORSKey :: String -> GYPaymentSigningKey + parseCBORSKey s = + either (error . ("Error parsing 'BOTC_SKEY': " ++)) paymentSigningKeyFromApi $ + eitherDecodeStrict (fromString s) + >>= first show . deserialiseFromTextEnvelope (AsSigningKey AsPaymentKey) + + parseArray :: String -> [OrderAssetPair] + parseArray s = + either (error . ("Error parsing 'BOTC_ASSET_FILTER': " ++)) id $ + eitherDecodeStrict (fromString s) + >>= Aeson.parseEither parseScanTokenPairs envIntWithMsg :: Var a => String -> Parser a envIntWithMsg = envWithMsg "Not a number" @@ -109,18 +116,18 @@ envWithMsg :: Var a => String -> String -> Parser a envWithMsg msg name = maybe (throwError $ unwords ["Error parsing enviroment variable", name ++ ":", msg]) return =<< envMaybe name instance FromJSON OrderBotConfig where - parseJSON (Object obj) = OrderBotConfig - <$> (Left <$> obj .: "signingKeyFP") - <*> obj .:? "stakeAddress" - <*> obj .:? "collateral" - <*> obj .: "strategy" - <*> (parseScanTokenPairs =<< obj .: "scanTokens") - <*> obj .: "scanDelay" - <*> obj .: "maxOrderMatches" - <*> obj .: "maxTxsPerIteration" - <*> obj .: "randomizeMatchesFound" - - parseJSON _ = fail "Expecting object value" + parseJSON (Object obj) = + OrderBotConfig + <$> (Left <$> obj .: "signingKeyFP") + <*> obj .:? "stakeAddress" + <*> obj .:? "collateral" + <*> obj .: "strategy" + <*> (parseScanTokenPairs =<< obj .: "scanTokens") + <*> obj .: "scanDelay" + <*> obj .: "maxOrderMatches" + <*> obj .: "maxTxsPerIteration" + <*> obj .: "randomizeMatchesFound" + parseJSON _ = fail "Expecting object value" parseScanTokenPairs :: Value -> Aeson.Parser [OrderAssetPair] parseScanTokenPairs = withArray "parseScanTokenPairs" parseArrayTokenPairs @@ -129,13 +136,15 @@ parseArrayTokenPairs :: Array -> Aeson.Parser [OrderAssetPair] parseArrayTokenPairs = mapM parseObjectTokenPair . V.toList parseObjectTokenPair :: Value -> Aeson.Parser OrderAssetPair -parseObjectTokenPair = withObject "OrderAssetPair" $ \v -> OAssetPair +parseObjectTokenPair = withObject "OrderAssetPair" $ \v -> + OAssetPair <$> v .: "currencyAsset" <*> v .: "commodityAsset" -- | Given a vanilla order bot configuration, builds a complete order bot setup. buildOrderBot :: OrderBotConfig -> IO OrderBot -buildOrderBot OrderBotConfig +buildOrderBot + OrderBotConfig { botCSkey , botCStakeAddress , botCCollateral @@ -150,32 +159,34 @@ buildOrderBot OrderBotConfig maxOrderMatch <- intToNatural "Max Order matches amount" botCMaxOrderMatches maxTxPerIter <- intToNatural "Max Tx per iteration" botCMaxTxsPerIteration oneEquivalentAssetPair <- - if hasNoneEquivalentAssetPair botCAssetFilter + if hasNoneEquivalentAssetPair botCAssetFilter then return $ nub botCAssetFilter else throwIO $ userError "Can't have equivalent order asset pairs scanTokens" - return $ OrderBot - { botSkey = skey - , botStakeAddress = botCStakeAddress - , botCollateral = buildCollateral - , botExecutionStrat = + return $ + OrderBot + { botSkey = skey + , botStakeAddress = botCStakeAddress + , botCollateral = buildCollateral + , botExecutionStrat = MultiAssetTraverse $ mkIndependentStrategy botCExecutionStrat maxOrderMatch , botAssetPairFilter = nub oneEquivalentAssetPair - , botRescanDelay = botCRescanDelay - , botTakeMatches = takeMatches botCRandomizeMatchesFound maxTxPerIter + , botRescanDelay = botCRescanDelay + , botTakeMatches = takeMatches botCRandomizeMatchesFound maxTxPerIter } - where - buildCollateral :: Maybe (GYTxOutRef, Bool) - buildCollateral = (,False) <$> botCCollateral + where + buildCollateral :: Maybe (GYTxOutRef, Bool) + buildCollateral = (,False) <$> botCCollateral - hasNoneEquivalentAssetPair :: [OrderAssetPair] -> Bool - hasNoneEquivalentAssetPair [] = True - hasNoneEquivalentAssetPair (oap:oaps) = - not (any (equivalentAssetPair oap) oaps) - && hasNoneEquivalentAssetPair oaps + hasNoneEquivalentAssetPair :: [OrderAssetPair] -> Bool + hasNoneEquivalentAssetPair [] = True + hasNoneEquivalentAssetPair (oap : oaps) = + not (any (equivalentAssetPair oap) oaps) + && hasNoneEquivalentAssetPair oaps readBotConfig :: Maybe FilePath -> IO OrderBotConfig -readBotConfig = either (throwIO . userError) return <=< - maybe decodeEnv eitherDecodeFileStrict +readBotConfig = + either (throwIO . userError) return + <=< maybe decodeEnv eitherDecodeFileStrict intToNatural :: String -> Int -> IO Natural intToNatural _ i | i > 0 = return $ fromInteger $ toInteger i @@ -183,9 +194,10 @@ intToNatural msg _ = throwIO $ userError $ msg ++ " is negative or zero" takeMatches :: Bool -> Natural -> [MatchResult] -> IO [MatchResult] takeMatches r (fromIntegral -> maxTxPerIter) matches = - take maxTxPerIter <$> if r then shuffleList matches else return matches + take maxTxPerIter <$> if r then shuffleList matches else return matches shuffleList :: [a] -> IO [a] -shuffleList xs = createSystemSeed - >>= initialize . fromSeed - >>= runReaderT (sample (shuffle xs)) \ No newline at end of file +shuffleList xs = + createSystemSeed + >>= initialize . fromSeed + >>= runReaderT (sample (shuffle xs)) diff --git a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/Run.hs b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/Run.hs index 61ff445..9703234 100644 --- a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/Run.hs +++ b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/Run.hs @@ -1,49 +1,54 @@ -{-| +{- | Module : GeniusYield.OrderBot.Run Copyright : (c) 2023 GYELD GMBH License : Apache 2.0 Maintainer : support@geniusyield.co Stability : develop - -} -module GeniusYield.OrderBot.Run ( run ) where +module GeniusYield.OrderBot.Run (run) where -import Control.Exception (throwIO) -import GeniusYield.Api.Dex.Constants (dexInfoDefaultMainnet, - dexInfoDefaultPreprod) -import GeniusYield.GYConfig -import GeniusYield.OrderBot (runOrderBot) -import GeniusYield.Types (GYNetworkId (..)) -import GeniusYield.OrderBot.OrderBotConfig (buildOrderBot, readBotConfig) -import System.Environment (getArgs) +import Control.Exception (throwIO) +import GeniusYield.Api.Dex.Constants ( + dexInfoDefaultMainnet, + dexInfoDefaultPreprod, + ) +import GeniusYield.GYConfig +import GeniusYield.OrderBot (runOrderBot) +import GeniusYield.OrderBot.OrderBotConfig (buildOrderBot, readBotConfig) +import GeniusYield.Types (GYNetworkId (..)) +import System.Environment (getArgs) parseArgs :: IO (String, FilePath, Maybe FilePath) parseArgs = do - args <- getArgs - case args of - [action, providerConfigFile, botConfigFile] -> return ( action - , providerConfigFile - , Just botConfigFile - ) - [action, providerConfigFile] -> return (action, providerConfigFile, Nothing) - _ -> throwIO . userError $ unlines - [ "Expected two or three command line arguments, in order:" - , "\t1. Action to execute: 'run'" - , "\t2. Path to the Atlas provider configuration file" - , "\t3. Path to the OrderBot config-file (only when reading config from file)" - ] + args <- getArgs + case args of + [action, providerConfigFile, botConfigFile] -> + return + ( action + , providerConfigFile + , Just botConfigFile + ) + [action, providerConfigFile] -> return (action, providerConfigFile, Nothing) + _ -> + throwIO . userError $ + unlines + [ "Expected two or three command line arguments, in order:" + , "\t1. Action to execute: 'run'" + , "\t2. Path to the Atlas provider configuration file" + , "\t3. Path to the OrderBot config-file (only when reading config from file)" + ] run :: IO () run = do - (action, pConfFile,obConfFile) <- parseArgs - obc <- readBotConfig obConfFile - cfg <- coreConfigIO pConfFile - di <- - case cfgNetworkId cfg of - GYTestnetPreprod -> pure dexInfoDefaultPreprod - GYMainnet -> pure dexInfoDefaultMainnet - _ -> throwIO $ userError "Only Preprod and Mainnet are supported." - ob <- buildOrderBot obc - case action of - "run" -> runOrderBot cfg di ob - _ -> throwIO . userError $ unwords ["Action: ", show action, " not supported."] + (action, pConfFile, obConfFile) <- parseArgs + obc <- readBotConfig obConfFile + cfg <- coreConfigIO pConfFile + di <- + case cfgNetworkId cfg of + GYTestnetPreprod -> pure dexInfoDefaultPreprod + GYMainnet -> pure dexInfoDefaultMainnet + _ -> throwIO $ userError "Only Preprod and Mainnet are supported." + ob <- buildOrderBot obc + case action of + "run" -> runOrderBot cfg di ob + _ -> throwIO . userError $ unwords ["Action: ", show action, " not supported."] diff --git a/geniusyield-orderbot/src/Main.hs b/geniusyield-orderbot/src/Main.hs index 92a178d..6d1ebc9 100644 --- a/geniusyield-orderbot/src/Main.hs +++ b/geniusyield-orderbot/src/Main.hs @@ -1,15 +1,13 @@ -{-| +{- | Module : Main Copyright : (c) 2023 GYELD GMBH License : Apache 2.0 Maintainer : support@geniusyield.co Stability : develop - -} -module Main ( main ) where - -import GeniusYield.OrderBot.Run (run) +module Main (main) where +import GeniusYield.OrderBot.Run (run) main :: IO () main = run diff --git a/geniusyield-orderbot/test/Main.hs b/geniusyield-orderbot/test/Main.hs index 1808fbe..83727f8 100644 --- a/geniusyield-orderbot/test/Main.hs +++ b/geniusyield-orderbot/test/Main.hs @@ -1,35 +1,41 @@ module Main where -import Test.Tasty (defaultMain, testGroup, TestTree) -import Test.Tasty.QuickCheck (testProperty) import GeniusYield.OrderBot.Strategies.Impl -import Tests.Prop.Strategies +import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.Tasty.QuickCheck (testProperty) import Tests.Prop.Orderbook +import Tests.Prop.Strategies {- | All strategies are exiting when a match is found. so the interesting logic in the ComplexOneToManyPartial is not being tested -} main :: IO () -main = defaultMain $ testGroup "QC" - [ testGroup "Orderbook Tests" - [ testProperty "lowestSell" propLowestSell - , testProperty "highestBuy" propHighestBuy - , testProperty "sellsAreInOrder" propSellsAreInOrder - , testProperty "buysAreInOrder" propBuysAreInOrder - ] - , testGroup "Strategies tests" $ map qcTestsForStrategy allStrategies - ] +main = + defaultMain $ + testGroup + "QC" + [ testGroup + "Orderbook Tests" + [ testProperty "lowestSell" propLowestSell + , testProperty "highestBuy" propHighestBuy + , testProperty "sellsAreInOrder" propSellsAreInOrder + , testProperty "buysAreInOrder" propBuysAreInOrder + ] + , testGroup "Strategies tests" $ map qcTestsForStrategy allStrategies + ] qcTestsForStrategy :: BotStrategy -> TestTree -qcTestsForStrategy strat = testGroup (show strat) - [ testProperty "Price" $ - mkStrategyTest iStrat propPrice - , testProperty "Offer" $ - mkStrategyTest iStrat propOffered - , testProperty "Can Fill" $ - mkStrategyTest iStrat propCanExecuteFill - , testProperty "Can find only Match - Price" $ - propCanFindOnlyMatching iStrat genOrderInfosWrongPrices - ] - where - iStrat = mkIndependentStrategy strat 10 +qcTestsForStrategy strat = + testGroup + (show strat) + [ testProperty "Price" $ + mkStrategyTest iStrat propPrice + , testProperty "Offer" $ + mkStrategyTest iStrat propOffered + , testProperty "Can Fill" $ + mkStrategyTest iStrat propCanExecuteFill + , testProperty "Can find only Match - Price" $ + propCanFindOnlyMatching iStrat genOrderInfosWrongPrices + ] + where + iStrat = mkIndependentStrategy strat 10 diff --git a/geniusyield-orderbot/test/Tests/Prop/Orderbook.hs b/geniusyield-orderbot/test/Tests/Prop/Orderbook.hs index 83f9ee7..bbb0f66 100644 --- a/geniusyield-orderbot/test/Tests/Prop/Orderbook.hs +++ b/geniusyield-orderbot/test/Tests/Prop/Orderbook.hs @@ -1,64 +1,61 @@ module Tests.Prop.Orderbook where -import Control.Monad.Identity (Identity(..)) +import Control.Monad.Identity (Identity (..)) import Test.QuickCheck import qualified Test.QuickCheck.Monadic as M -import GeniusYield.OrderBot.Types import GeniusYield.OrderBot.OrderBook.List +import GeniusYield.OrderBot.Types import Tests.Prop.Utils - {- | This property checks that the sell order with the lowest price (lowestSell) reported by the OrderBook is the same as the lowest sell generated. -} propLowestSell :: Property propLowestSell = forAllShrink genOrderInfos shrinkTuple $ - \(oap, bOrders, sOrders) -> M.monadic (\(Identity p) -> p) $ do - let book = buildOrderBookList [] (# oap, bOrders, sOrders #) - M.monitor (counterexample (unlines ["BOOK:", show book, "Selected Lowest: ", show $ map lowSell book])) >> - M.assert (all (\b -> price (lowSell b) == foldl minSellOrder (price $ head sOrders) sOrders) book) - where - lowSell b = lowestSell $ sellOrders (snd b) - minSellOrder acc x = min acc (price x) - + \(oap, bOrders, sOrders) -> M.monadic (\(Identity p) -> p) $ do + let book = buildOrderBookList [] (# oap, bOrders, sOrders #) + M.monitor (counterexample (unlines ["BOOK:", show book, "Selected Lowest: ", show $ map lowSell book])) + >> M.assert (all (\b -> price (lowSell b) == foldl minSellOrder (price $ head sOrders) sOrders) book) + where + lowSell b = lowestSell $ sellOrders (snd b) + minSellOrder acc x = min acc (price x) {- | This property checks that the buy order with the highest price (highestBuy) reported by the OrderBook is the same as the highest buy generated. -} propHighestBuy :: Property propHighestBuy = forAllShrink genOrderInfos shrinkTuple $ - \(oap, bOrders, sOrders) -> M.monadic (\(Identity p) -> p) $ do - let book = buildOrderBookList [] (# oap, bOrders, sOrders #) - M.monitor (counterexample (unlines ["BOOK:", show book, "Selected Highest: ", show $ map highBuy book])) >> - M.assert (all (\b -> price (highBuy b) == foldl maxBuyOrder (price $ head bOrders) bOrders) book) - where - highBuy b = highestBuy $ buyOrders (snd b) - maxBuyOrder acc x = max acc (price x) - + \(oap, bOrders, sOrders) -> M.monadic (\(Identity p) -> p) $ do + let book = buildOrderBookList [] (# oap, bOrders, sOrders #) + M.monitor (counterexample (unlines ["BOOK:", show book, "Selected Highest: ", show $ map highBuy book])) + >> M.assert (all (\b -> price (highBuy b) == foldl maxBuyOrder (price $ head bOrders) bOrders) book) + where + highBuy b = highestBuy $ buyOrders (snd b) + maxBuyOrder acc x = max acc (price x) {- | This property checks that the sell orders are reported in increasing order by foldlOrders -} propSellsAreInOrder :: Property propSellsAreInOrder = forAllShrink genOrderInfos shrinkTuple $ - \(oap, bOrders, sOrders) -> M.monadic (\(Identity p) -> p) $ do - let book = buildOrderBookList [] (# oap, bOrders, sOrders #) - M.monitor (counterexample (unlines ["BOOK:", show book])) >> - M.assert (all sellsAreOrdered book) - where - sellsAreOrdered b = snd $ foldlOrders (\(o', isOrdered) o -> (o, isOrdered && price o' <= price o)) (lowSell b, True) (sellOrders (snd b)) - lowSell b = lowestSell $ sellOrders (snd b) + \(oap, bOrders, sOrders) -> M.monadic (\(Identity p) -> p) $ do + let book = buildOrderBookList [] (# oap, bOrders, sOrders #) + M.monitor (counterexample (unlines ["BOOK:", show book])) + >> M.assert (all sellsAreOrdered book) + where + sellsAreOrdered b = snd $ foldlOrders (\(o', isOrdered) o -> (o, isOrdered && price o' <= price o)) (lowSell b, True) (sellOrders (snd b)) + lowSell b = lowestSell $ sellOrders (snd b) {- | This property checks that the buy orders are reported in decreasing order by foldlOrders -} propBuysAreInOrder :: Property propBuysAreInOrder = forAllShrink genOrderInfos shrinkTuple $ - \(oap, bOrders, sOrders) -> M.monadic (\(Identity p) -> p) $ do - let book = buildOrderBookList [] (# oap, bOrders, sOrders #) - M.monitor (counterexample (unlines ["BOOK:", show book])) >> - M.assert (all buysAreOrdered book) - where - buysAreOrdered b = snd $ foldlOrders (\(o', isOrdered) o -> (o, isOrdered && price o' >= price o)) (highBuy b, True) (buyOrders (snd b)) - highBuy b = highestBuy $ buyOrders (snd b) + \(oap, bOrders, sOrders) -> M.monadic (\(Identity p) -> p) $ do + let book = buildOrderBookList [] (# oap, bOrders, sOrders #) + M.monitor (counterexample (unlines ["BOOK:", show book])) + >> M.assert (all buysAreOrdered book) + where + buysAreOrdered b = snd $ foldlOrders (\(o', isOrdered) o -> (o, isOrdered && price o' >= price o)) (highBuy b, True) (buyOrders (snd b)) + highBuy b = highestBuy $ buyOrders (snd b) diff --git a/geniusyield-orderbot/test/Tests/Prop/Strategies.hs b/geniusyield-orderbot/test/Tests/Prop/Strategies.hs index 67f8e78..b036a78 100644 --- a/geniusyield-orderbot/test/Tests/Prop/Strategies.hs +++ b/geniusyield-orderbot/test/Tests/Prop/Strategies.hs @@ -1,20 +1,19 @@ module Tests.Prop.Strategies where -import Control.Monad.Identity (Identity(..)) +import Control.Monad.Identity (Identity (..)) import Test.QuickCheck import qualified Test.QuickCheck.Monadic as M -import Data.Ratio import qualified Data.ByteString.Lazy.Char8 as LBS +import Data.Ratio -import GeniusYield.OrderBot.Types +import Data.Aeson (encode) import GeniusYield.OrderBot.MatchingStrategy import GeniusYield.OrderBot.OrderBook.List +import GeniusYield.OrderBot.Types import GeniusYield.Types -import Data.Aeson (encode) import Tests.Prop.Utils - {- | Function that creates the boilerplate for the properties. Given the strategy and a property over the matches generated by the strategy: @@ -25,25 +24,25 @@ import Tests.Prop.Utils * Sets up the counterexample and label * Runs the property over the result of running the strategy -} -mkStrategyTest - :: IndependentStrategy - -> ([MatchExecutionInfo] -> Bool) - -> Property +mkStrategyTest :: + IndependentStrategy -> + ([MatchExecutionInfo] -> Bool) -> + Property mkStrategyTest strat prop = forAllShrink genOrderInfos shrinkTuple $ - \(oap, buyOrders, sellOrders) -> M.monadic (\(Identity p) -> p) $ do - let book = buildOrderBookList [] (# oap, buyOrders, sellOrders #) - M.pre $ length book == 1 - let meis = uncurry strat $ head book - M.monitor (counterexample (unlines ["MEIS:", LBS.unpack $ encode meis])) >> - M.monitor (label (getLabel meis)) >> - M.assert (all prop meis) - where - getLabel :: [MatchResult] -> String - getLabel meis - | null meis = "No matches found" - | length meis == 1 = "1 match found" - | length meis <= 10 = "2-10 matches found" - | otherwise = "11+ matches found" + \(oap, buyOrders, sellOrders) -> M.monadic (\(Identity p) -> p) $ do + let book = buildOrderBookList [] (# oap, buyOrders, sellOrders #) + M.pre $ length book == 1 + let meis = uncurry strat $ head book + M.monitor (counterexample (unlines ["MEIS:", LBS.unpack $ encode meis])) + >> M.monitor (label (getLabel meis)) + >> M.assert (all prop meis) + where + getLabel :: [MatchResult] -> String + getLabel meis + | null meis = "No matches found" + | length meis == 1 = "1 match found" + | length meis <= 10 = "2-10 matches found" + | otherwise = "11+ matches found" {- | Property that checks if the strategy can find a match if one exists. @@ -61,21 +60,21 @@ mkStrategyTest strat prop = forAllShrink genOrderInfos shrinkTuple $ * Sets up the counterexample and label * Runs the property over the result of running the strategy the second time -} -propCanFindOnlyMatching - :: IndependentStrategy - -> Gen (OrderAssetPair, [OrderInfo 'BuyOrder], [OrderInfo 'SellOrder], OrderInfo 'BuyOrder, OrderInfo 'SellOrder) - -> Property +propCanFindOnlyMatching :: + IndependentStrategy -> + Gen (OrderAssetPair, [OrderInfo 'BuyOrder], [OrderInfo 'SellOrder], OrderInfo 'BuyOrder, OrderInfo 'SellOrder) -> + Property propCanFindOnlyMatching strat gen = forAllShrink gen shrinkTuple' $ - \(oap, buyOrders, sellOrders, nBuyOrder, nSellOrder) -> M.monadic (\(Identity p) -> p) $ do - let book = buildOrderBookList [] (# oap, buyOrders, sellOrders #) - M.pre $ length book == 1 - let meis = uncurry strat $ head book - M.pre $ all null meis - let book' = buildOrderBookList [] (# oap, nBuyOrder : buyOrders, nSellOrder : sellOrders #) - meis' = uncurry strat $ head book' - M.monitor (counterexample (unlines ["","MEIS:", LBS.unpack $ encode meis', "BOOK:", show book'])) >> - M.monitor (label (if null meis then "No matches" else "Matches found")) >> - M.assert (any (\mr -> length mr >= 2) meis') + \(oap, buyOrders, sellOrders, nBuyOrder, nSellOrder) -> M.monadic (\(Identity p) -> p) $ do + let book = buildOrderBookList [] (# oap, buyOrders, sellOrders #) + M.pre $ length book == 1 + let meis = uncurry strat $ head book + M.pre $ all null meis + let book' = buildOrderBookList [] (# oap, nBuyOrder : buyOrders, nSellOrder : sellOrders #) + meis' = uncurry strat $ head book' + M.monitor (counterexample (unlines ["", "MEIS:", LBS.unpack $ encode meis', "BOOK:", show book'])) + >> M.monitor (label (if null meis then "No matches" else "Matches found")) + >> M.assert (any (\mr -> length mr >= 2) meis') {- | Generates a fixes OrderAssetPair, a list of buy and sell orders that don't generate any matches because they don't line up on price. @@ -83,43 +82,47 @@ propCanFindOnlyMatching strat gen = forAllShrink gen shrinkTuple' $ -} genOrderInfosWrongPrices :: Gen (OrderAssetPair, [OrderInfo 'BuyOrder], [OrderInfo 'SellOrder], OrderInfo 'BuyOrder, OrderInfo 'SellOrder) genOrderInfosWrongPrices = do - buyOrders <- listOf1 $ genBuyOrder' oap - sellOrders <- listOf1 $ genSellOrder' oap - newBuyOrder <- genBuyOrder oap - newSellOrder <- genSellOrder oap `suchThat` sellOrderIsProfitable newBuyOrder - return (oap, buyOrders, sellOrders, newBuyOrder, newSellOrder) - where - goldPolicyId = "ff80aaaf03a273b8f5c558168dc0e2377eea810badbae6eceefc14ef" - oap = mkOrderAssetPair GYLovelace (GYToken goldPolicyId "GOLD") - - sellOrderIsProfitable :: OrderInfo 'BuyOrder -> OrderInfo 'SellOrder -> Bool - sellOrderIsProfitable bOrder sOrder = price sOrder <= price bOrder - && volumeMin (volume sOrder) <= volumeMax (volume bOrder) - && volumeMin (volume bOrder) <= volumeMax (volume sOrder) - - genBuyOrder' :: OrderAssetPair -> Gen (OrderInfo 'BuyOrder) - genBuyOrder' oap = do - price <- genPrice `suchThat` ((< (50%1)) . getPrice) - volume <- genVolume (ceiling $ getPrice price) - utxoRef <- genGYTxOutRef - return $ OrderInfo utxoRef SBuyOrder oap volume price Nothing - - genSellOrder' :: OrderAssetPair -> Gen (OrderInfo 'SellOrder) - genSellOrder' oap = OrderInfo <$> genGYTxOutRef - <*> pure SSellOrder - <*> pure oap - <*> genVolume 1 - <*> genPrice `suchThat` ((> (50%1)) . getPrice) - <*> pure Nothing + buyOrders <- listOf1 $ genBuyOrder' oap + sellOrders <- listOf1 $ genSellOrder' oap + newBuyOrder <- genBuyOrder oap + newSellOrder <- genSellOrder oap `suchThat` sellOrderIsProfitable newBuyOrder + return (oap, buyOrders, sellOrders, newBuyOrder, newSellOrder) + where + goldPolicyId = "ff80aaaf03a273b8f5c558168dc0e2377eea810badbae6eceefc14ef" + oap = mkOrderAssetPair GYLovelace (GYToken goldPolicyId "GOLD") + + sellOrderIsProfitable :: OrderInfo 'BuyOrder -> OrderInfo 'SellOrder -> Bool + sellOrderIsProfitable bOrder sOrder = + price sOrder <= price bOrder + && volumeMin (volume sOrder) <= volumeMax (volume bOrder) + && volumeMin (volume bOrder) <= volumeMax (volume sOrder) + + genBuyOrder' :: OrderAssetPair -> Gen (OrderInfo 'BuyOrder) + genBuyOrder' oap = do + price <- genPrice `suchThat` ((< (50 % 1)) . getPrice) + volume <- genVolume (ceiling $ getPrice price) + utxoRef <- genGYTxOutRef + return $ OrderInfo utxoRef SBuyOrder oap volume price Nothing + + genSellOrder' :: OrderAssetPair -> Gen (OrderInfo 'SellOrder) + genSellOrder' oap = + OrderInfo + <$> genGYTxOutRef + <*> pure SSellOrder + <*> pure oap + <*> genVolume 1 + <*> genPrice `suchThat` ((> (50 % 1)) . getPrice) + <*> pure Nothing {- | Property that checks if the sum of the offered tokens in the buy orders is less than or equal to the sum of offered tokens in the sell orders. -} propOffered :: [MatchExecutionInfo] -> Bool propOffered [] = True -propOffered xs = let buys = filter isBuyOrderMEI xs - sells = filter isSellOrderMEI xs - in sumOfOffered buys <= sumOfOffered sells +propOffered xs = + let buys = filter isBuyOrderMEI xs + sells = filter isSellOrderMEI xs + in sumOfOffered buys <= sumOfOffered sells {- | Property that checks if the sum of the price tokens in the buy orders is greater than or equal to the sum of price tokens in the sell orders. @@ -129,9 +132,10 @@ propOffered xs = let buys = filter isBuyOrderMEI xs -} propPrice :: [MatchExecutionInfo] -> Bool propPrice [] = True -propPrice xs = let buys = filter isBuyOrderMEI xs - sells = filter isSellOrderMEI xs - in sumOfPrice buys >= sumOfPrice sells +propPrice xs = + let buys = filter isBuyOrderMEI xs + sells = filter isSellOrderMEI xs + in sumOfPrice buys >= sumOfPrice sells {- | Property that checks if the matches generated by the strategy can be done Complete fill can always be performed and partial fills need to be @@ -139,16 +143,17 @@ propPrice xs = let buys = filter isBuyOrderMEI xs -} propCanExecuteFill :: [MatchExecutionInfo] -> Bool propCanExecuteFill = all canFill - where - canFill :: MatchExecutionInfo -> Bool - canFill (OrderExecutionInfo CompleteFill _) = True - canFill (OrderExecutionInfo (PartialFill n) OrderInfo {volume}) = - n >= volumeMin volume - && - n < volumeMax volume + where + canFill :: MatchExecutionInfo -> Bool + canFill (OrderExecutionInfo CompleteFill _) = True + canFill (OrderExecutionInfo (PartialFill n) OrderInfo {volume}) = + n >= volumeMin volume + && n < volumeMax volume -------------------------------------------------- + -- | UTILS + -------------------------------------------------- -- | Checks if a MatchExecutionInfo is a sell order @@ -164,20 +169,20 @@ isBuyOrderMEI _ = False -- | Given a list of MatchExecutionInfo, sums the offered tokens filled sumOfOffered :: [MatchExecutionInfo] -> Natural sumOfOffered = foldl (\acc -> (+) acc . eiOffered) 0 - where - eiOffered :: MatchExecutionInfo -> Natural - eiOffered (OrderExecutionInfo CompleteFill OrderInfo {volume}) = volumeMax volume - eiOffered (OrderExecutionInfo (PartialFill n) _) = n + where + eiOffered :: MatchExecutionInfo -> Natural + eiOffered (OrderExecutionInfo CompleteFill OrderInfo {volume}) = volumeMax volume + eiOffered (OrderExecutionInfo (PartialFill n) _) = n -- | Given a list of MatchExecutionInfo, sums the price tokens neccesary for the fills sumOfPrice :: [MatchExecutionInfo] -> Natural sumOfPrice = foldl (\acc -> (+) acc . eiOfferedByPrice) 0 - where - eiOfferedByPrice :: MatchExecutionInfo -> Natural - eiOfferedByPrice (OrderExecutionInfo CompleteFill OrderInfo {volume,price}) = - ceiling $ (toInteger (volumeMax volume) % 1) * getPrice price - eiOfferedByPrice (OrderExecutionInfo (PartialFill n) OrderInfo {price}) = - ceiling $ (toInteger n % 1) * getPrice price + where + eiOfferedByPrice :: MatchExecutionInfo -> Natural + eiOfferedByPrice (OrderExecutionInfo CompleteFill OrderInfo {volume, price}) = + ceiling $ (toInteger (volumeMax volume) % 1) * getPrice price + eiOfferedByPrice (OrderExecutionInfo (PartialFill n) OrderInfo {price}) = + ceiling $ (toInteger n % 1) * getPrice price {- | Shrink function for the CanFindOnlyMatching property. @@ -187,15 +192,18 @@ sumOfPrice = foldl (\acc -> (+) acc . eiOfferedByPrice) 0 * The extra buy order * The extra sell order -} -shrinkTuple' - :: (OrderAssetPair, [OrderInfo 'BuyOrder], [OrderInfo 'SellOrder], OrderInfo 'BuyOrder, OrderInfo 'SellOrder) - -> [(OrderAssetPair, [OrderInfo 'BuyOrder], [OrderInfo 'SellOrder], OrderInfo 'BuyOrder, OrderInfo 'SellOrder)] +shrinkTuple' :: + (OrderAssetPair, [OrderInfo 'BuyOrder], [OrderInfo 'SellOrder], OrderInfo 'BuyOrder, OrderInfo 'SellOrder) -> + [(OrderAssetPair, [OrderInfo 'BuyOrder], [OrderInfo 'SellOrder], OrderInfo 'BuyOrder, OrderInfo 'SellOrder)] shrinkTuple' (oap, xs, ys, bo, so) = - [ (oap, xs', ys, bo, so) | xs' <- shrinkList shrinkOrderInfo xs ] ++ - [ (oap, xs, ys', bo, so) | ys' <- shrinkList shrinkOrderInfo ys ] ++ - [ (oap, xs, ys, bo', so) | bo' <- shrinkOrderInfo bo - , volumeMin (volume so) < volumeMax (volume bo') - , price so < price bo' ] ++ - [ (oap, xs, ys, bo, so') | so' <- shrinkOrderInfo so - , volumeMin (volume bo) < volumeMax (volume so')] - + [(oap, xs', ys, bo, so) | xs' <- shrinkList shrinkOrderInfo xs] + ++ [(oap, xs, ys', bo, so) | ys' <- shrinkList shrinkOrderInfo ys] + ++ [ (oap, xs, ys, bo', so) + | bo' <- shrinkOrderInfo bo + , volumeMin (volume so) < volumeMax (volume bo') + , price so < price bo' + ] + ++ [ (oap, xs, ys, bo, so') + | so' <- shrinkOrderInfo so + , volumeMin (volume bo) < volumeMax (volume so') + ] diff --git a/geniusyield-orderbot/test/Tests/Prop/Utils.hs b/geniusyield-orderbot/test/Tests/Prop/Utils.hs index 346f81c..e88cf7d 100644 --- a/geniusyield-orderbot/test/Tests/Prop/Utils.hs +++ b/geniusyield-orderbot/test/Tests/Prop/Utils.hs @@ -4,69 +4,70 @@ import Test.QuickCheck import Data.Ratio +import Data.String (IsString (fromString)) import GeniusYield.OrderBot.Types import GeniusYield.Types -import Data.String (IsString(fromString)) - -- | Generator for the strategy tests. Using a hardcoded assetPair of GOLD <> ADA genOrderInfos :: Gen (OrderAssetPair, [OrderInfo 'BuyOrder], [OrderInfo 'SellOrder]) genOrderInfos = do - buyOrders <- listOf1 $ genBuyOrder oap - sellOrders <- listOf1 $ genSellOrder oap - return (oap, buyOrders, sellOrders) - where - goldPolicyId = "ff80aaaf03a273b8f5c558168dc0e2377eea810badbae6eceefc14ef" - oap = mkOrderAssetPair GYLovelace (GYToken goldPolicyId "GOLD") + buyOrders <- listOf1 $ genBuyOrder oap + sellOrders <- listOf1 $ genSellOrder oap + return (oap, buyOrders, sellOrders) + where + goldPolicyId = "ff80aaaf03a273b8f5c558168dc0e2377eea810badbae6eceefc14ef" + oap = mkOrderAssetPair GYLovelace (GYToken goldPolicyId "GOLD") -- | Generator for a GYTxOutRef with a very optimistic n genGYTxOutRef :: Gen GYTxOutRef genGYTxOutRef = do - id <- vectorOf 64 genHexString - n <- chooseInteger (0,1000) - return $ fromString $ id ++ "#" ++ show n + id <- vectorOf 64 genHexString + n <- chooseInteger (0, 1000) + return $ fromString $ id ++ "#" ++ show n -- | Hex characters used in the GYTxOutRef generator genHexString :: Gen Char -genHexString = elements $ ['a'..'f'] ++ ['0'..'9'] +genHexString = elements $ ['a' .. 'f'] ++ ['0' .. '9'] -- | Given a min, generate the max Volume. genVolume :: Integer -> Gen Volume genVolume min = do - vh <- chooseInteger (min ,100000000) - pure $ Volume (fromIntegral min) (fromIntegral vh) + vh <- chooseInteger (min, 100000000) + pure $ Volume (fromIntegral min) (fromIntegral vh) {- | Generator for the Volume. With a fixed minVolume of 34%. with an specified minimum and maximum. -} genVolume' :: Integer -> Integer -> Gen Volume genVolume' min max = do - vh <- chooseInteger (ceiling $ (1 % min) * (34 % 100) , max) - pure $ Volume (ceiling $ (vh % 1) * (34 % 100)) (fromIntegral vh) + vh <- chooseInteger (ceiling $ (1 % min) * (34 % 100), max) + pure $ Volume (ceiling $ (vh % 1) * (34 % 100)) (fromIntegral vh) -- | Generates a random price between 1/100 and 100 genPrice :: Gen Price genPrice = do - n <- chooseInteger (1,100) - m <- chooseInteger (1,100) - return $ Price (n % m) + n <- chooseInteger (1, 100) + m <- chooseInteger (1, 100) + return $ Price (n % m) -- | Generator for a buy order, using all previous generators genBuyOrder :: OrderAssetPair -> Gen (OrderInfo 'BuyOrder) genBuyOrder oap = do - price <- genPrice - volume <- genVolume (ceiling $ getPrice price) - utxoRef <- genGYTxOutRef - return $ OrderInfo utxoRef SBuyOrder oap volume price Nothing + price <- genPrice + volume <- genVolume (ceiling $ getPrice price) + utxoRef <- genGYTxOutRef + return $ OrderInfo utxoRef SBuyOrder oap volume price Nothing -- | Generator for a sell order, using all previous generators genSellOrder :: OrderAssetPair -> Gen (OrderInfo 'SellOrder) -genSellOrder oap = OrderInfo <$> genGYTxOutRef - <*> pure SSellOrder - <*> pure oap - <*> genVolume 1 - <*> genPrice - <*> pure Nothing +genSellOrder oap = + OrderInfo + <$> genGYTxOutRef + <*> pure SSellOrder + <*> pure oap + <*> genVolume 1 + <*> genPrice + <*> pure Nothing {- | Shrink function for the tuples used in properties. @@ -74,21 +75,21 @@ genSellOrder oap = OrderInfo <$> genGYTxOutRef * Buy Orders * Sell Orders -} -shrinkTuple - :: (OrderAssetPair, [OrderInfo 'BuyOrder], [OrderInfo 'SellOrder]) - -> [(OrderAssetPair, [OrderInfo 'BuyOrder], [OrderInfo 'SellOrder])] +shrinkTuple :: + (OrderAssetPair, [OrderInfo 'BuyOrder], [OrderInfo 'SellOrder]) -> + [(OrderAssetPair, [OrderInfo 'BuyOrder], [OrderInfo 'SellOrder])] shrinkTuple (oap, xs, ys) = - [ (oap, xs', ys) | xs' <- shrinkList shrinkOrderInfo xs ] ++ - [ (oap, xs, ys') | ys' <- shrinkList shrinkOrderInfo ys ] + [(oap, xs', ys) | xs' <- shrinkList shrinkOrderInfo xs] + ++ [(oap, xs, ys') | ys' <- shrinkList shrinkOrderInfo ys] -- | Shrinks an OrderInfo by shrinking it's volume shrinkOrderInfo :: forall t. OrderInfo t -> [OrderInfo t] shrinkOrderInfo order = - [ order { volume = vol'} | vol' <- shrinkVolume (volume order) ] + [order {volume = vol'} | vol' <- shrinkVolume (volume order)] {- | Shrinks a Volume by making sure the max is over the min. The min is fixed, so no need to shrink it. -} shrinkVolume :: Volume -> [Volume] -shrinkVolume v@Volume{volumeMin, volumeMax} = - [ v { volumeMax = vh' } | vh' <- shrinkIntegral volumeMax, vh' >= volumeMin ] +shrinkVolume v@Volume {volumeMin, volumeMax} = + [v {volumeMax = vh'} | vh' <- shrinkIntegral volumeMax, vh' >= volumeMin] diff --git a/impl/datasource-providers/GeniusYield/OrderBot/DataSource/Providers.hs b/impl/datasource-providers/GeniusYield/OrderBot/DataSource/Providers.hs index c55b985..c72e07e 100644 --- a/impl/datasource-providers/GeniusYield/OrderBot/DataSource/Providers.hs +++ b/impl/datasource-providers/GeniusYield/OrderBot/DataSource/Providers.hs @@ -1,28 +1,27 @@ -{-| +{- | Module : GeniusYield.OrderBot.DataSource.Providers Copyright : (c) 2023 GYELD GMBH License : Apache 2.0 Maintainer : support@geniusyield.co Stability : develop - -} -module GeniusYield.OrderBot.DataSource.Providers - ( Connection - , connectDB - , closeDB - , withEachAssetOrders - ) where - -import Data.List (foldl') -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map - -import Control.Monad.Reader (ReaderT (runReaderT)) -import GeniusYield.Api.Dex.Constants (DEXInfo (..)) -import GeniusYield.Api.Dex.PartialOrder -import GeniusYield.OrderBot.Types -import GeniusYield.TxBuilder -import GeniusYield.Types +module GeniusYield.OrderBot.DataSource.Providers ( + Connection, + connectDB, + closeDB, + withEachAssetOrders, +) where + +import Data.List (foldl') +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map + +import Control.Monad.Reader (ReaderT (runReaderT)) +import GeniusYield.Api.Dex.Constants (DEXInfo (..)) +import GeniusYield.Api.Dex.PartialOrder +import GeniusYield.OrderBot.Types +import GeniusYield.TxBuilder +import GeniusYield.Types data Connection = Connection !GYNetworkId {-# UNPACK #-} !GYProviders @@ -34,13 +33,13 @@ connectDB netId providers = pure $ Connection netId providers closeDB :: Connection -> IO () closeDB = const $ return () -withEachAssetOrders - :: Connection - -> DEXInfo - -> [OrderAssetPair] - -> (a -> OrderData -> a) - -> a - -> IO a +withEachAssetOrders :: + Connection -> + DEXInfo -> + [OrderAssetPair] -> + (a -> OrderData -> a) -> + a -> + IO a withEachAssetOrders c dex assetFilter f acc = do infoMap <- allOrderInfos c dex assetFilter pure $ @@ -49,7 +48,7 @@ withEachAssetOrders c dex assetFilter f acc = do let (buys, sells) = foldl' ( \(!buys, !sells) (SomeOrderInfo oInf@OrderInfo {orderType}) -> case orderType of - SBuyOrder -> (oInf : buys, sells) + SBuyOrder -> (oInf : buys, sells) SSellOrder -> (buys, oInf : sells) ) ([], []) @@ -62,40 +61,42 @@ withEachAssetOrders c dex assetFilter f acc = do runQuery :: Connection -> GYTxQueryMonadIO a -> IO a runQuery (Connection nid providers) = runGYTxQueryMonadIO nid providers -allOrderInfos - :: Connection - -> DEXInfo - -> [OrderAssetPair] - -> IO (Map OrderAssetPair [SomeOrderInfo]) +allOrderInfos :: + Connection -> + DEXInfo -> + [OrderAssetPair] -> + IO (Map OrderAssetPair [SomeOrderInfo]) allOrderInfos c dex assetPairs = do - cTime <- getCurrentGYTime - - partialOrderInfos <- runQuery c $ - runReaderT (partialOrdersWithTransformerPredicate (dexPORefs dex) $ partialOrderFilter cTime) dex - - return $ foldl' f Map.empty partialOrderInfos - where - f m (partialOrderInfoToOrderInfo -> info@(SomeOrderInfo OrderInfo {assetInfo})) = - Map.insertWith (++) assetInfo [info] m - - partialOrderFilter :: GYTime -> PartialOrderInfo -> Maybe (OrderAssetPair, PartialOrderInfo) - partialOrderFilter cTime poi = if inTimeOrder cTime poi - then filterTokenPair poi - else Nothing - - filterTokenPair :: PartialOrderInfo -> Maybe (OrderAssetPair, PartialOrderInfo) - filterTokenPair poi@PartialOrderInfo { poiOfferedAsset, poiAskedAsset } - | assetPair1 `elem` assetPairs = Just (assetPair1, poi) - | assetPair2 `elem` assetPairs = Just (assetPair2, poi) - | otherwise = Nothing - where - assetPair1 = mkOrderAssetPair poiOfferedAsset poiAskedAsset - assetPair2 = mkOrderAssetPair poiAskedAsset poiOfferedAsset - - inTimeOrder :: GYTime -> PartialOrderInfo -> Bool - inTimeOrder time poi = isAfterStart time (poiStart poi) - && - isBeforeEnd time (poiEnd poi) + cTime <- getCurrentGYTime + + partialOrderInfos <- + runQuery c $ + runReaderT (partialOrdersWithTransformerPredicate (dexPORefs dex) $ partialOrderFilter cTime) dex + + return $ foldl' f Map.empty partialOrderInfos + where + f m (partialOrderInfoToOrderInfo -> info@(SomeOrderInfo OrderInfo {assetInfo})) = + Map.insertWith (++) assetInfo [info] m + + partialOrderFilter :: GYTime -> PartialOrderInfo -> Maybe (OrderAssetPair, PartialOrderInfo) + partialOrderFilter cTime poi = + if inTimeOrder cTime poi + then filterTokenPair poi + else Nothing + + filterTokenPair :: PartialOrderInfo -> Maybe (OrderAssetPair, PartialOrderInfo) + filterTokenPair poi@PartialOrderInfo {poiOfferedAsset, poiAskedAsset} + | assetPair1 `elem` assetPairs = Just (assetPair1, poi) + | assetPair2 `elem` assetPairs = Just (assetPair2, poi) + | otherwise = Nothing + where + assetPair1 = mkOrderAssetPair poiOfferedAsset poiAskedAsset + assetPair2 = mkOrderAssetPair poiAskedAsset poiOfferedAsset + + inTimeOrder :: GYTime -> PartialOrderInfo -> Bool + inTimeOrder time poi = + isAfterStart time (poiStart poi) + && isBeforeEnd time (poiEnd poi) partialOrderInfoToOrderInfo :: (OrderAssetPair, PartialOrderInfo) -> SomeOrderInfo partialOrderInfoToOrderInfo = uncurry mkOrderInfo diff --git a/impl/orderbook-list/GeniusYield/OrderBot/OrderBook/List.hs b/impl/orderbook-list/GeniusYield/OrderBot/OrderBook/List.hs index b08efd4..01baef1 100644 --- a/impl/orderbook-list/GeniusYield/OrderBot/OrderBook/List.hs +++ b/impl/orderbook-list/GeniusYield/OrderBot/OrderBook/List.hs @@ -1,10 +1,9 @@ -{-| +{- | Module : GeniusYield.OrderBot.OrderBook.List Copyright : (c) 2023 GYELD GMBH License : Apache 2.0 Maintainer : support@geniusyield.co Stability : develop - -} module GeniusYield.OrderBot.OrderBook.List ( -- * Core Order book types @@ -43,22 +42,25 @@ module GeniusYield.OrderBot.OrderBook.List ( volumeGTPrice, volumeGTEPrice, nullOrders, + -- * MultiAssetOrderBook reading utilities withEachAsset, ) where -import Data.Aeson (ToJSON, object, toJSON) -import Data.Foldable (foldl', foldlM) -import Data.List (delete, insertBy, sortOn) -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as M -import Data.Ord (Down (Down)) - -import Data.Maybe (listToMaybe) -import GeniusYield.Api.Dex.Constants (DEXInfo) -import GeniusYield.OrderBot.DataSource (Connection, - withEachAssetOrders) -import GeniusYield.OrderBot.Types +import Data.Aeson (ToJSON, object, toJSON) +import Data.Foldable (foldl', foldlM) +import Data.List (delete, insertBy, sortOn) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as M +import Data.Ord (Down (Down)) + +import Data.Maybe (listToMaybe) +import GeniusYield.Api.Dex.Constants (DEXInfo) +import GeniusYield.OrderBot.DataSource ( + Connection, + withEachAssetOrders, + ) +import GeniusYield.OrderBot.Types type MultiAssetOrderBook = Map OrderAssetPair OrderBook @@ -73,18 +75,18 @@ newtype Orders t = Orders {unOrders :: [OrderInfo t]} data OrderBook = OrderBook { sellOrders :: Orders 'SellOrder - , buyOrders :: Orders 'BuyOrder + , buyOrders :: Orders 'BuyOrder } deriving stock (Show, Eq) instance ToJSON OrderBook where - toJSON _ = object [] + toJSON _ = object [] -populateOrderBook - :: Connection - -> DEXInfo - -> [OrderAssetPair] - -> IO MultiAssetOrderBook +populateOrderBook :: + Connection -> + DEXInfo -> + [OrderAssetPair] -> + IO MultiAssetOrderBook populateOrderBook conn dex f = do multiAssetBookL <- withEachAssetOrders @@ -95,27 +97,31 @@ populateOrderBook conn dex f = do [] pure $ mkMultiAssetOrderBook multiAssetBookL -buildOrderBookList - :: [(OrderAssetPair, OrderBook)] - -> (# OrderAssetPair, [OrderInfo 'BuyOrder], [OrderInfo 'SellOrder] #) - -> [(OrderAssetPair, OrderBook)] +buildOrderBookList :: + [(OrderAssetPair, OrderBook)] -> + (# OrderAssetPair, [OrderInfo 'BuyOrder], [OrderInfo 'SellOrder] #) -> + [(OrderAssetPair, OrderBook)] buildOrderBookList acc (# _, _, [] #) = acc buildOrderBookList acc (# _, [], _ #) = acc buildOrderBookList acc (# oap, buyOrders, sellOrders #) = - (oap, OrderBook (Orders $ sortOn price sellOrders) - (Orders $ sortOn (Down . price) buyOrders)) : acc + ( oap + , OrderBook + (Orders $ sortOn price sellOrders) + (Orders $ sortOn (Down . price) buyOrders) + ) + : acc emptyOrders :: Orders t emptyOrders = Orders [] unconsOrders :: Orders t -> Maybe (OrderInfo t, Orders t) -unconsOrders (Orders []) = Nothing +unconsOrders (Orders []) = Nothing unconsOrders (Orders (x : xs)) = Just (x, Orders xs) insertOrder :: OrderInfo t -> Orders t -> Orders t insertOrder oi (Orders os) = Orders $ case orderType oi of - SBuyOrder -> insertBy (\oadd opresent -> compare (price opresent) (price oadd)) oi os + SBuyOrder -> insertBy (\oadd opresent -> compare (price opresent) (price oadd)) oi os SSellOrder -> insertBy (\oadd opresent -> compare (price oadd) (price opresent)) oi os deleteOrder :: OrderInfo t -> Orders t -> Orders t diff --git a/impl/strategies-impl/GeniusYield/OrderBot/Strategies/Impl.hs b/impl/strategies-impl/GeniusYield/OrderBot/Strategies/Impl.hs index add4880..052602a 100644 --- a/impl/strategies-impl/GeniusYield/OrderBot/Strategies/Impl.hs +++ b/impl/strategies-impl/GeniusYield/OrderBot/Strategies/Impl.hs @@ -1,11 +1,11 @@ {-# LANGUAGE MultiWayIf #-} -{-| + +{- | Module : GeniusYield.OrderBot.Strategies.Impl Copyright : (c) 2023 GYELD GMBH License : Apache 2.0 Maintainer : support@geniusyield.co Stability : develop - -} module GeniusYield.OrderBot.Strategies.Impl ( BotStrategy (..), @@ -16,33 +16,33 @@ module GeniusYield.OrderBot.Strategies.Impl ( ) where import Control.Monad.State.Strict (State, execState, modify') -import Data.Text (Text) -import Data.Aeson.Types (Parser) -import Data.Aeson -import GeniusYield.OrderBot.Types -import GeniusYield.OrderBot.OrderBook -import GeniusYield.OrderBot.OrderBook.Extra -import Data.Data (Typeable) -import GHC.Generics (Generic) -import GHC.Natural (Natural) -import System.Envy (Var (..)) +import Data.Aeson +import Data.Aeson.Types (Parser) +import Data.Data (Typeable) +import Data.Text (Text) +import GHC.Generics (Generic) +import GHC.Natural (Natural) +import GeniusYield.OrderBot.OrderBook +import GeniusYield.OrderBot.OrderBook.Extra +import GeniusYield.OrderBot.Types +import System.Envy (Var (..)) data BotStrategy = OneSellToManyBuy - deriving stock (Show, Eq, Generic) - deriving anyclass (ToJSON, Typeable) + deriving stock (Show, Eq, Generic) + deriving anyclass (ToJSON, Typeable) instance FromJSON BotStrategy where - parseJSON = withText "BotStrategy" parse - where - parse :: Text -> Parser BotStrategy - parse "OneSellToManyBuy" = return OneSellToManyBuy - parse _ = fail "Undefined strategy name" + parseJSON = withText "BotStrategy" parse + where + parse :: Text -> Parser BotStrategy + parse "OneSellToManyBuy" = return OneSellToManyBuy + parse _ = fail "Undefined strategy name" instance Var BotStrategy where - fromVar s = case s of - "OneSellToManyBuy" -> Just OneSellToManyBuy - _ -> Nothing - toVar = show + fromVar s = case s of + "OneSellToManyBuy" -> Just OneSellToManyBuy + _ -> Nothing + toVar = show allStrategies :: [BotStrategy] allStrategies = [OneSellToManyBuy] @@ -53,81 +53,87 @@ type IndependentStrategy = (OrderAssetPair -> OrderBook -> [MatchResult]) mkIndependentStrategy :: BotStrategy -> Natural -> IndependentStrategy mkIndependentStrategy bs maxOrders _ bk = - case bs of - OneSellToManyBuy -> oneSellToManyBuy maxOrders bk + case bs of + OneSellToManyBuy -> oneSellToManyBuy maxOrders bk -- | Strategy state containing the matchings found and the remaining buy orders. data StrategyState = StrategyState - { matchResults :: ![MatchResult] - , remainingOrders :: !(Orders 'BuyOrder) - } + { matchResults :: ![MatchResult] + , remainingOrders :: !(Orders 'BuyOrder) + } -- | Utility function for updating the state, after one run of the strategy. -updateStrategyState - :: MatchResult - -> Orders 'BuyOrder - -> StrategyState - -> StrategyState -updateStrategyState [] bos' ss = ss { remainingOrders = bos' } -updateStrategyState mr' bos' StrategyState { matchResults = mr } = - StrategyState { matchResults = mr ++ [mr'] - , remainingOrders = bos' - } +updateStrategyState :: + MatchResult -> + Orders 'BuyOrder -> + StrategyState -> + StrategyState +updateStrategyState [] bos' ss = ss {remainingOrders = bos'} +updateStrategyState mr' bos' StrategyState {matchResults = mr} = + StrategyState + { matchResults = mr ++ [mr'] + , remainingOrders = bos' + } {- | Strategy matching: Picking one sell order and matching it with many (up to `maxOrders`) buy orders. -} oneSellToManyBuy :: Natural -> OrderBook -> [MatchResult] oneSellToManyBuy maxOrders ob = - matchResults - $ execState (mapMOrders_ go $ sellOrders ob) - $ StrategyState {matchResults = [], remainingOrders = buyOrders ob} - where - go :: OrderInfo 'SellOrder - -> State StrategyState () - go order = modify' $ - \st -> uncurry updateStrategyState - (multiFill (maxOrders - 1) (<=) order (remainingOrders st)) st + matchResults $ + execState (mapMOrders_ go $ sellOrders ob) $ + StrategyState {matchResults = [], remainingOrders = buyOrders ob} + where + go :: + OrderInfo 'SellOrder -> + State StrategyState () + go order = modify' $ + \st -> + uncurry + updateStrategyState + (multiFill (maxOrders - 1) (<=) order (remainingOrders st)) + st -- | General matching orders function. -multiFill - :: forall b b' - . Natural - -> (Price -> Price -> Bool) - -> OrderInfo b - -> Orders b' - -> (MatchResult, Orders b') +multiFill :: + forall b b'. + Natural -> + (Price -> Price -> Bool) -> + OrderInfo b -> + Orders b' -> + (MatchResult, Orders b') multiFill maxOrders checkPrices order = go (maxOrders - 1) vh - where - (Volume vl vh) = volume order - checkPrice = checkPrices $ price order - - go :: Natural -> Natural -> Orders b' -> (MatchResult, Orders b') - go _ 0 os = ([completeFill order], os) - go 0 v os - | (vh - v) >= vl = ([partialFill order (vh - v)], os) - | otherwise = ([], os) - go limitO remVol os' = - case unconsOrders os' of - Nothing -> - if | (vh - remVol) > vl -> ([partialFill order (vh - remVol)], emptyOrders) - | otherwise -> ([], emptyOrders) - Just (o, os) -> - if | remVol == maxFillX && checkPrice xP -> - let !b = completeFill o - in ([completeFill order, b], os) - | remVol > maxFillX && remVol >= minFillX && checkPrice xP -> - case go (limitO - 1) (remVol - maxFillX) os of - ([], _) -> updateRemaining o $ go limitO remVol os - (bs, s) -> (completeFill o : bs, s) - | remVol < maxFillX - && remVol >= minFillX - && checkPrice xP -> - ([completeFill order, partialFill o remVol], os) - | otherwise -> updateRemaining o $ go limitO remVol os - where - xP = price o - (Volume minFillX maxFillX) = volume o - - updateRemaining x (a, b) = (a, insertOrder x b) - + where + (Volume vl vh) = volume order + checkPrice = checkPrices $ price order + + go :: Natural -> Natural -> Orders b' -> (MatchResult, Orders b') + go _ 0 os = ([completeFill order], os) + go 0 v os + | (vh - v) >= vl = ([partialFill order (vh - v)], os) + | otherwise = ([], os) + go limitO remVol os' = + case unconsOrders os' of + Nothing -> + if + | (vh - remVol) > vl -> ([partialFill order (vh - remVol)], emptyOrders) + | otherwise -> ([], emptyOrders) + Just (o, os) -> + if + | remVol == maxFillX && checkPrice xP -> + let !b = completeFill o + in ([completeFill order, b], os) + | remVol > maxFillX && remVol >= minFillX && checkPrice xP -> + case go (limitO - 1) (remVol - maxFillX) os of + ([], _) -> updateRemaining o $ go limitO remVol os + (bs, s) -> (completeFill o : bs, s) + | remVol < maxFillX + && remVol >= minFillX + && checkPrice xP -> + ([completeFill order, partialFill o remVol], os) + | otherwise -> updateRemaining o $ go limitO remVol os + where + xP = price o + (Volume minFillX maxFillX) = volume o + + updateRemaining x (a, b) = (a, insertOrder x b) From 0bcbadef95f2f4198af8deac3ddab37a25362d9b Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Tue, 15 Oct 2024 16:48:47 +0530 Subject: [PATCH 2/4] build(#79): checkout code before running fourmolu action --- .github/workflows/build.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 9a5e0b3..64e0baf 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -13,6 +13,7 @@ jobs: packages: write contents: read steps: + - uses: actions/checkout@v4 - uses: haskell-actions/run-fourmolu@v10 - name: Set up Docker Buildx uses: docker/setup-buildx-action@v3 From ea2709934c57b68a3ca8db38c3386dda86110e6c Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Tue, 15 Oct 2024 16:55:28 +0530 Subject: [PATCH 3/4] style(#79): format cabal files using `cabal-gild`, add check for it in CI --- .github/workflows/build.yml | 3 + .../geniusyield-orderbot-framework.cabal | 177 +++++++------ geniusyield-orderbot.cabal | 235 +++++++++--------- 3 files changed, 218 insertions(+), 197 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 64e0baf..c4d2fe1 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -15,6 +15,9 @@ jobs: steps: - uses: actions/checkout@v4 - uses: haskell-actions/run-fourmolu@v10 + - uses: tfausak/cabal-gild-setup-action@v2 + - run: cabal-gild --input geniusyield-orderbot.cabal --mode check + - run: cabal-gild --input geniusyield-orderbot-framework/geniusyield-orderbot-framework.cabal --mode check - name: Set up Docker Buildx uses: docker/setup-buildx-action@v3 - name: Login to GitHub Container Registry diff --git a/geniusyield-orderbot-framework/geniusyield-orderbot-framework.cabal b/geniusyield-orderbot-framework/geniusyield-orderbot-framework.cabal index 1850d00..c28bc5c 100644 --- a/geniusyield-orderbot-framework/geniusyield-orderbot-framework.cabal +++ b/geniusyield-orderbot-framework/geniusyield-orderbot-framework.cabal @@ -1,40 +1,46 @@ cabal-version: 3.4 -name: geniusyield-orderbot-framework -synopsis: Smart Order Router framework -version: 0.5.0 -build-type: Simple -license: Apache-2.0 -copyright: (c) 2023 GYELD GMBH -author: Lars Bruenjes -maintainer: support@geniusyield.co -category: Blockchain, Cardano, Framework +name: geniusyield-orderbot-framework +synopsis: Smart Order Router framework +version: 0.5.0 +build-type: Simple +license: Apache-2.0 +copyright: (c) 2023 GYELD GMBH +author: Lars Bruenjes +maintainer: support@geniusyield.co +category: Blockchain, Cardano, Framework extra-doc-files: CHANGELOG.md -- Common sections - common common-ghc-opts ghc-options: - -Wall -Wcompat -Wincomplete-uni-patterns -Wno-unused-do-bind - -Wno-partial-type-signatures -Wincomplete-record-updates - -Wmissing-deriving-strategies -Wno-name-shadowing -Wunused-foralls - -Wno-unticked-promoted-constructors -fprint-explicit-foralls + -Wall + -Wcompat + -Wincomplete-uni-patterns + -Wno-unused-do-bind + -Wno-partial-type-signatures + -Wincomplete-record-updates + -Wmissing-deriving-strategies + -Wno-name-shadowing + -Wunused-foralls + -Wno-unticked-promoted-constructors + -fprint-explicit-foralls -fprint-explicit-kinds common common-deps build-depends: - , aeson - , aeson-pretty - , atlas-cardano - , base - , bytestring - , containers - , mtl - , mwc-random - , random - , random-fu - , serialise - , text - , time + aeson, + aeson-pretty, + atlas-cardano, + base, + bytestring, + containers, + mtl, + mwc-random, + random, + random-fu, + serialise, + text, + time, common common-lang default-language: Haskell2010 @@ -71,8 +77,8 @@ common common-lang LambdaCase MonomorphismRestriction MultiParamTypeClasses - NamedFieldPuns MultiWayIf + NamedFieldPuns NoStarIsType NumericUnderscores OverloadedStrings @@ -96,84 +102,95 @@ common common-lang ViewPatterns -- Build targets - -library common - import: common-lang - import: common-deps - import: common-ghc-opts - visibility: public - hs-source-dirs: lib-common +library common + import: common-lang + import: common-deps + import: common-ghc-opts + visibility: public + hs-source-dirs: lib-common build-depends: - , cardano-api - , geniusyield-dex-api - , postgresql-simple - , postgresql-simple-url + cardano-api, + geniusyield-dex-api, + postgresql-simple, + postgresql-simple-url, + exposed-modules: GeniusYield.OrderBot.Types + ghc-options: -O2 -library datasource - import: common-lang - import: common-ghc-opts - visibility: public - hs-source-dirs: lib-datasource - build-depends: base, atlas-cardano, geniusyield-orderbot-framework:common, geniusyield-dex-api +library datasource + import: common-lang + import: common-ghc-opts + visibility: public + hs-source-dirs: lib-datasource + build-depends: + atlas-cardano, + base, + geniusyield-dex-api, + geniusyield-orderbot-framework:common, + signatures: GeniusYield.OrderBot.DataSource -library orderbook - import: common-lang - import: common-ghc-opts - visibility: public - hs-source-dirs: lib-orderbook +library orderbook + import: common-lang + import: common-ghc-opts + visibility: public + hs-source-dirs: lib-orderbook build-depends: - , aeson - , atlas-cardano - , base - , geniusyield-orderbot-framework:common - , geniusyield-orderbot-framework:datasource - , geniusyield-dex-api + aeson, + atlas-cardano, + base, + geniusyield-dex-api, + geniusyield-orderbot-framework:common, + geniusyield-orderbot-framework:datasource, + signatures: GeniusYield.OrderBot.OrderBook + exposed-modules: GeniusYield.OrderBot.OrderBook.Extra -library strategies - import: common-lang - import: common-ghc-opts - visibility: public - hs-source-dirs: lib-strategies +library strategies + import: common-lang + import: common-ghc-opts + visibility: public + hs-source-dirs: lib-strategies build-depends: - , aeson - , atlas-cardano - , base - , envy - , geniusyield-orderbot-framework:common - , geniusyield-orderbot-framework:orderbook - , geniusyield-dex-api + aeson, + atlas-cardano, + base, + envy, + geniusyield-dex-api, + geniusyield-orderbot-framework:common, + geniusyield-orderbot-framework:orderbook, + signatures: GeniusYield.OrderBot.Strategies -- Indefinite library exposing the OrderBot orchestration types and functions. library - import: common-lang - import: common-deps - import: common-ghc-opts - hs-source-dirs: src + import: common-lang + import: common-deps + import: common-ghc-opts + hs-source-dirs: src build-depends: - , cardano-api - , envy - , geniusyield-orderbot-framework:common - , geniusyield-orderbot-framework:datasource - , geniusyield-orderbot-framework:orderbook - , geniusyield-orderbot-framework:strategies - , geniusyield-dex-api - , vector + cardano-api, + envy, + geniusyield-dex-api, + geniusyield-orderbot-framework:common, + geniusyield-orderbot-framework:datasource, + geniusyield-orderbot-framework:orderbook, + geniusyield-orderbot-framework:strategies, + vector, + exposed-modules: GeniusYield.OrderBot GeniusYield.OrderBot.MatchingStrategy GeniusYield.OrderBot.OrderBotConfig GeniusYield.OrderBot.Run + ghc-options: -O2 diff --git a/geniusyield-orderbot.cabal b/geniusyield-orderbot.cabal index b0517bb..790c38f 100644 --- a/geniusyield-orderbot.cabal +++ b/geniusyield-orderbot.cabal @@ -1,48 +1,55 @@ cabal-version: 3.4 -name: geniusyield-orderbot -version: 0.2.0 -synopsis: Smart Order Router -description: Open-source Smart Order Router framework to connect liquidity from - the GeniusYield DEX to empowers users to deploy their own arbitrage - strategies and bring true decentralization to the Cardano Defi - ecosystem. - -license: Apache-2.0 -license-file: LICENSE -copyright: (c) 2023 GYELD GMBH -author: Lars Bruenjes -maintainer: support@geniusyield.co -category: Blockchain, Cardano, Framework -homepage: https://github.com/geniusyield/smart-order-router#readme -bug-reports: https://github.com/geniusyield/smart-order-router/issues +name: geniusyield-orderbot +version: 0.2.0 +synopsis: Smart Order Router +description: + Open-source Smart Order Router framework to connect liquidity from + the GeniusYield DEX to empowers users to deploy their own arbitrage + strategies and bring true decentralization to the Cardano Defi + ecosystem. + +license: Apache-2.0 +license-file: LICENSE +copyright: (c) 2023 GYELD GMBH +author: Lars Bruenjes +maintainer: support@geniusyield.co +category: Blockchain, Cardano, Framework +homepage: https://github.com/geniusyield/smart-order-router#readme +bug-reports: https://github.com/geniusyield/smart-order-router/issues extra-source-files: README.md extra-doc-files: CHANGELOG.md -- Common sections - common common-ghc-opts ghc-options: - -Wall -Wcompat -Wincomplete-uni-patterns -Wno-unused-do-bind - -Wno-partial-type-signatures -Wincomplete-record-updates - -Wmissing-deriving-strategies -Wno-name-shadowing -Wunused-foralls - -Wno-unticked-promoted-constructors -fprint-explicit-foralls + -Wall + -Wcompat + -Wincomplete-uni-patterns + -Wno-unused-do-bind + -Wno-partial-type-signatures + -Wincomplete-record-updates + -Wmissing-deriving-strategies + -Wno-name-shadowing + -Wunused-foralls + -Wno-unticked-promoted-constructors + -fprint-explicit-foralls -fprint-explicit-kinds common common-deps build-depends: - , aeson - , aeson-pretty - , atlas-cardano - , base - , bytestring - , containers - , mtl - , mwc-random - , random - , random-fu - , serialise - , text - , vector + aeson, + aeson-pretty, + atlas-cardano, + base, + bytestring, + containers, + mtl, + mwc-random, + random, + random-fu, + serialise, + text, + vector, common common-lang default-language: Haskell2010 @@ -79,8 +86,8 @@ common common-lang LambdaCase MonomorphismRestriction MultiParamTypeClasses - NoStarIsType NamedFieldPuns + NoStarIsType NumericUnderscores OverloadedStrings PatternGuards @@ -102,112 +109,106 @@ common common-lang ViewPatterns -- Build targets - -library datasource-providers - import: common-lang - import: common-deps - import: common-ghc-opts - hs-source-dirs: impl/datasource-providers +library datasource-providers + import: common-lang + import: common-deps + import: common-ghc-opts + hs-source-dirs: impl/datasource-providers build-depends: - , geniusyield-orderbot-framework:common - , geniusyield-dex-api + geniusyield-dex-api, + geniusyield-orderbot-framework:common, + exposed-modules: GeniusYield.OrderBot.DataSource.Providers visibility: public -library orderbook-list - import: common-lang - import: common-deps - import: common-ghc-opts - hs-source-dirs: impl/orderbook-list +library orderbook-list + import: common-lang + import: common-deps + import: common-ghc-opts + hs-source-dirs: impl/orderbook-list build-depends: - , geniusyield-orderbot-framework:common - , geniusyield-orderbot-framework:datasource - , geniusyield-dex-api + geniusyield-dex-api, + geniusyield-orderbot-framework:common, + geniusyield-orderbot-framework:datasource, + exposed-modules: GeniusYield.OrderBot.OrderBook.List + visibility: public -library strategies-impl - import: common-lang - import: common-deps - import: common-ghc-opts - hs-source-dirs: impl/strategies-impl +library strategies-impl + import: common-lang + import: common-deps + import: common-ghc-opts + hs-source-dirs: impl/strategies-impl build-depends: - , envy - , geniusyield-orderbot-framework:common - , geniusyield-orderbot-framework:orderbook - , geniusyield-dex-api + envy, + geniusyield-dex-api, + geniusyield-orderbot-framework:common, + geniusyield-orderbot-framework:orderbook, + exposed-modules: GeniusYield.OrderBot.Strategies.Impl + visibility: public -- The primary orderbot executable - this must be instantiated with the signature -- implementations. - -executable geniusyield-orderbot-exe - import: common-lang - import: common-deps - import: common-ghc-opts - hs-source-dirs: geniusyield-orderbot/src - main-is: Main.hs +executable geniusyield-orderbot-exe + import: common-lang + import: common-deps + import: common-ghc-opts + hs-source-dirs: geniusyield-orderbot/src + main-is: Main.hs build-depends: - , cardano-api - , envy - , geniusyield-orderbot-framework - , geniusyield-orderbot-framework:common - , geniusyield-orderbot:datasource-providers - , geniusyield-orderbot:orderbook-list - , geniusyield-orderbot:strategies-impl - , geniusyield-dex-api - , plutus-ledger-api - , ply-core + cardano-api, + envy, + geniusyield-dex-api, + geniusyield-orderbot:datasource-providers, + geniusyield-orderbot:orderbook-list, + geniusyield-orderbot:strategies-impl, + geniusyield-orderbot-framework, + geniusyield-orderbot-framework:common, + plutus-ledger-api, + ply-core, + mixins: - , geniusyield-orderbot:orderbook-list requires - ( GeniusYield.OrderBot.DataSource as GeniusYield.OrderBot.DataSource.Providers ) - , geniusyield-orderbot-framework requires - ( GeniusYield.OrderBot.DataSource as GeniusYield.OrderBot.DataSource.Providers - , GeniusYield.OrderBot.OrderBook as GeniusYield.OrderBot.OrderBook.List - , GeniusYield.OrderBot.Strategies as GeniusYield.OrderBot.Strategies.Impl - ) - , geniusyield-orderbot:strategies-impl requires - ( GeniusYield.OrderBot.OrderBook as GeniusYield.OrderBot.OrderBook.List - , GeniusYield.OrderBot.DataSource as GeniusYield.OrderBot.DataSource.Providers - ) + geniusyield-orderbot:orderbook-list requires (GeniusYield.OrderBot.DataSource as GeniusYield.OrderBot.DataSource.Providers), + geniusyield-orderbot:strategies-impl requires (GeniusYield.OrderBot.DataSource as GeniusYield.OrderBot.DataSource.Providers, GeniusYield.OrderBot.OrderBook as GeniusYield.OrderBot.OrderBook.List), + geniusyield-orderbot-framework requires (GeniusYield.OrderBot.DataSource as GeniusYield.OrderBot.DataSource.Providers, GeniusYield.OrderBot.OrderBook as GeniusYield.OrderBot.OrderBook.List, GeniusYield.OrderBot.Strategies as GeniusYield.OrderBot.Strategies.Impl), + ghc-options: - -O2 -threaded -rtsopts -with-rtsopts=-N + -O2 + -threaded + -rtsopts + -with-rtsopts=-N test-suite strategies-tests - import: common-lang - import: common-deps - import: common-ghc-opts - type: exitcode-stdio-1.0 - main-is: Main.hs + import: common-lang + import: common-deps + import: common-ghc-opts + type: exitcode-stdio-1.0 + main-is: Main.hs hs-source-dirs: geniusyield-orderbot/test/ other-modules: - Tests.Prop.Strategies Tests.Prop.Orderbook + Tests.Prop.Strategies Tests.Prop.Utils + build-depends: - , cardano-api - , envy - , geniusyield-orderbot-framework - , geniusyield-orderbot-framework:common - , geniusyield-orderbot:datasource-providers - , geniusyield-orderbot:orderbook-list - , geniusyield-orderbot:strategies-impl - , geniusyield-dex-api - , QuickCheck - , tasty - , tasty-quickcheck + QuickCheck, + cardano-api, + envy, + geniusyield-dex-api, + geniusyield-orderbot:datasource-providers, + geniusyield-orderbot:orderbook-list, + geniusyield-orderbot:strategies-impl, + geniusyield-orderbot-framework, + geniusyield-orderbot-framework:common, + tasty, + tasty-quickcheck, + mixins: - , geniusyield-orderbot:orderbook-list requires - (GeniusYield.OrderBot.DataSource as GeniusYield.OrderBot.DataSource.Providers) - , geniusyield-orderbot-framework requires - ( GeniusYield.OrderBot.DataSource as GeniusYield.OrderBot.DataSource.Providers - , GeniusYield.OrderBot.OrderBook as GeniusYield.OrderBot.OrderBook.List - , GeniusYield.OrderBot.Strategies as GeniusYield.OrderBot.Strategies.Impl - ) - , geniusyield-orderbot:strategies-impl requires - ( GeniusYield.OrderBot.OrderBook as GeniusYield.OrderBot.OrderBook.List - , GeniusYield.OrderBot.DataSource as GeniusYield.OrderBot.DataSource.Providers - ) + geniusyield-orderbot:orderbook-list requires (GeniusYield.OrderBot.DataSource as GeniusYield.OrderBot.DataSource.Providers), + geniusyield-orderbot:strategies-impl requires (GeniusYield.OrderBot.DataSource as GeniusYield.OrderBot.DataSource.Providers, GeniusYield.OrderBot.OrderBook as GeniusYield.OrderBot.OrderBook.List), + geniusyield-orderbot-framework requires (GeniusYield.OrderBot.DataSource as GeniusYield.OrderBot.DataSource.Providers, GeniusYield.OrderBot.OrderBook as GeniusYield.OrderBot.OrderBook.List, GeniusYield.OrderBot.Strategies as GeniusYield.OrderBot.Strategies.Impl), From fd886c251f1a03881508b24b947c048c206a0120 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Tue, 15 Oct 2024 18:13:46 +0530 Subject: [PATCH 4/4] style(#79): set `respectful` to `false` in fourmolu config --- fourmolu.yaml | 2 +- .../lib-common/GeniusYield/OrderBot/Types.hs | 9 +++---- .../src/GeniusYield/OrderBot.hs | 18 +++++-------- .../GeniusYield/OrderBot/OrderBotConfig.hs | 26 +++++++++---------- .../test/Tests/Prop/Orderbook.hs | 5 ++-- .../test/Tests/Prop/Strategies.hs | 8 +++--- geniusyield-orderbot/test/Tests/Prop/Utils.hs | 4 +-- .../OrderBot/DataSource/Providers.hs | 3 +-- .../GeniusYield/OrderBot/OrderBook/List.hs | 3 +-- 9 files changed, 32 insertions(+), 46 deletions(-) diff --git a/fourmolu.yaml b/fourmolu.yaml index 2bd0fdc..d3e49d9 100644 --- a/fourmolu.yaml +++ b/fourmolu.yaml @@ -2,7 +2,7 @@ indentation: 2 comma-style: leading record-brace-space: true indent-wheres: false -respectful: true +respectful: false haddock-style: multi-line newlines-between-decls: 1 single-constraint-parens: never diff --git a/geniusyield-orderbot-framework/lib-common/GeniusYield/OrderBot/Types.hs b/geniusyield-orderbot-framework/lib-common/GeniusYield/OrderBot/Types.hs index c34a158..36756f5 100644 --- a/geniusyield-orderbot-framework/lib-common/GeniusYield/OrderBot/Types.hs +++ b/geniusyield-orderbot-framework/lib-common/GeniusYield/OrderBot/Types.hs @@ -31,13 +31,11 @@ import qualified Data.Aeson as Aeson import Data.Kind (Type) import Data.Ratio (denominator, numerator, (%)) import Data.Text (Text) -import Numeric.Natural (Natural) - -import GeniusYield.Types.TxOutRef (GYTxOutRef, showTxOutRef) -import GeniusYield.Types.Value (GYAssetClass (..)) - import GeniusYield.Api.Dex.PartialOrder (PartialOrderInfo (..)) import GeniusYield.Types (rationalToGHC) +import GeniusYield.Types.TxOutRef (GYTxOutRef, showTxOutRef) +import GeniusYield.Types.Value (GYAssetClass (..)) +import Numeric.Natural (Natural) ------------------------------------------------------------------------------- -- Information on DEX orders relevant to a matching strategy @@ -147,6 +145,7 @@ data SOrderType (t :: OrderType) where SSellOrder :: SOrderType 'SellOrder deriving stock instance Eq (SOrderType t) + deriving stock instance Show (SOrderType t) class SOrderTypeI (t :: OrderType) where diff --git a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot.hs b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot.hs index 002ec01..3c3eaea 100644 --- a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot.hs +++ b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot.hs @@ -27,19 +27,16 @@ import Control.Monad ( ) import Control.Monad.Reader (runReaderT) import Data.Aeson (ToJSON, encode) +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy as BL import Data.Foldable (foldl', toList) import Data.Functor ((<&>)) import Data.List (find) -import Data.Maybe (mapMaybe) - -import System.Exit (exitSuccess) - -import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString.Lazy as BL import qualified Data.List.NonEmpty as NE (toList) import qualified Data.Map as M +import Data.Maybe (mapMaybe) import qualified Data.Text as Txt - +import GeniusYield.Api.Dex.Constants (DEXInfo (..)) import GeniusYield.GYConfig ( GYCoreConfig (cfgNetworkId), withCfgProviders, @@ -66,6 +63,7 @@ import GeniusYield.OrderBot.Types ( assetInfo, ) import GeniusYield.Providers.Common (SubmitTxException) +import GeniusYield.Transaction (GYCoinSelectionStrategy (GYLegacy)) import GeniusYield.TxBuilder ( GYTxBuildResult (..), GYTxBuilderMonadIO, @@ -75,11 +73,9 @@ import GeniusYield.TxBuilder ( runGYTxQueryMonadIO, utxosAtTxOutRefs, ) -import GeniusYield.Types - -import GeniusYield.Api.Dex.Constants (DEXInfo (..)) -import GeniusYield.Transaction (GYCoinSelectionStrategy (GYLegacy)) import GeniusYield.TxBuilder.Errors (GYTxMonadException) +import GeniusYield.Types +import System.Exit (exitSuccess) -- | The order bot is product type between bot info and "execution strategies". data OrderBot = OrderBot diff --git a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/OrderBotConfig.hs b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/OrderBotConfig.hs index 1569f7e..288d1d6 100644 --- a/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/OrderBotConfig.hs +++ b/geniusyield-orderbot-framework/src/GeniusYield/OrderBot/OrderBotConfig.hs @@ -7,6 +7,10 @@ Stability : develop -} module GeniusYield.OrderBot.OrderBotConfig where +import Cardano.Api ( + AsType (AsPaymentKey, AsSigningKey), + deserialiseFromTextEnvelope, + ) import Control.Exception (throwIO) import Control.Monad ((<=<)) import Control.Monad.Error.Class (throwError) @@ -29,6 +33,14 @@ import Data.Random (sample, shuffle) import Data.String (IsString (..)) import qualified Data.Vector as V import GHC.Generics (Generic) +import GeniusYield.OrderBot +import GeniusYield.OrderBot.MatchingStrategy (MatchResult) +import GeniusYield.OrderBot.Strategies (BotStrategy, allStrategies, mkIndependentStrategy) +import GeniusYield.OrderBot.Types ( + OrderAssetPair (..), + equivalentAssetPair, + ) +import GeniusYield.Types import System.Envy ( FromEnv (fromEnv), Parser, @@ -39,20 +51,6 @@ import System.Envy ( ) import System.Random.MWC (createSystemSeed, fromSeed, initialize) -import Cardano.Api ( - AsType (AsPaymentKey, AsSigningKey), - deserialiseFromTextEnvelope, - ) -import GeniusYield.OrderBot -import GeniusYield.OrderBot.MatchingStrategy (MatchResult) -import GeniusYield.OrderBot.Types ( - OrderAssetPair (..), - equivalentAssetPair, - ) -import GeniusYield.Types - -import GeniusYield.OrderBot.Strategies (BotStrategy, allStrategies, mkIndependentStrategy) - -- | Order bot vanilla config. data OrderBotConfig = OrderBotConfig diff --git a/geniusyield-orderbot/test/Tests/Prop/Orderbook.hs b/geniusyield-orderbot/test/Tests/Prop/Orderbook.hs index bbb0f66..519b79e 100644 --- a/geniusyield-orderbot/test/Tests/Prop/Orderbook.hs +++ b/geniusyield-orderbot/test/Tests/Prop/Orderbook.hs @@ -1,11 +1,10 @@ module Tests.Prop.Orderbook where import Control.Monad.Identity (Identity (..)) -import Test.QuickCheck -import qualified Test.QuickCheck.Monadic as M - import GeniusYield.OrderBot.OrderBook.List import GeniusYield.OrderBot.Types +import Test.QuickCheck +import qualified Test.QuickCheck.Monadic as M import Tests.Prop.Utils {- | This property checks that the sell order with the lowest price (lowestSell) diff --git a/geniusyield-orderbot/test/Tests/Prop/Strategies.hs b/geniusyield-orderbot/test/Tests/Prop/Strategies.hs index b036a78..fbf611e 100644 --- a/geniusyield-orderbot/test/Tests/Prop/Strategies.hs +++ b/geniusyield-orderbot/test/Tests/Prop/Strategies.hs @@ -1,17 +1,15 @@ module Tests.Prop.Strategies where import Control.Monad.Identity (Identity (..)) -import Test.QuickCheck -import qualified Test.QuickCheck.Monadic as M - +import Data.Aeson (encode) import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Ratio - -import Data.Aeson (encode) import GeniusYield.OrderBot.MatchingStrategy import GeniusYield.OrderBot.OrderBook.List import GeniusYield.OrderBot.Types import GeniusYield.Types +import Test.QuickCheck +import qualified Test.QuickCheck.Monadic as M import Tests.Prop.Utils {- | Function that creates the boilerplate for the properties. diff --git a/geniusyield-orderbot/test/Tests/Prop/Utils.hs b/geniusyield-orderbot/test/Tests/Prop/Utils.hs index e88cf7d..01773f4 100644 --- a/geniusyield-orderbot/test/Tests/Prop/Utils.hs +++ b/geniusyield-orderbot/test/Tests/Prop/Utils.hs @@ -1,12 +1,10 @@ module Tests.Prop.Utils where -import Test.QuickCheck - import Data.Ratio - import Data.String (IsString (fromString)) import GeniusYield.OrderBot.Types import GeniusYield.Types +import Test.QuickCheck -- | Generator for the strategy tests. Using a hardcoded assetPair of GOLD <> ADA genOrderInfos :: Gen (OrderAssetPair, [OrderInfo 'BuyOrder], [OrderInfo 'SellOrder]) diff --git a/impl/datasource-providers/GeniusYield/OrderBot/DataSource/Providers.hs b/impl/datasource-providers/GeniusYield/OrderBot/DataSource/Providers.hs index c72e07e..f207075 100644 --- a/impl/datasource-providers/GeniusYield/OrderBot/DataSource/Providers.hs +++ b/impl/datasource-providers/GeniusYield/OrderBot/DataSource/Providers.hs @@ -12,11 +12,10 @@ module GeniusYield.OrderBot.DataSource.Providers ( withEachAssetOrders, ) where +import Control.Monad.Reader (ReaderT (runReaderT)) import Data.List (foldl') import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map - -import Control.Monad.Reader (ReaderT (runReaderT)) import GeniusYield.Api.Dex.Constants (DEXInfo (..)) import GeniusYield.Api.Dex.PartialOrder import GeniusYield.OrderBot.Types diff --git a/impl/orderbook-list/GeniusYield/OrderBot/OrderBook/List.hs b/impl/orderbook-list/GeniusYield/OrderBot/OrderBook/List.hs index 01baef1..b75c05b 100644 --- a/impl/orderbook-list/GeniusYield/OrderBot/OrderBook/List.hs +++ b/impl/orderbook-list/GeniusYield/OrderBot/OrderBook/List.hs @@ -52,9 +52,8 @@ import Data.Foldable (foldl', foldlM) import Data.List (delete, insertBy, sortOn) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M -import Data.Ord (Down (Down)) - import Data.Maybe (listToMaybe) +import Data.Ord (Down (Down)) import GeniusYield.Api.Dex.Constants (DEXInfo) import GeniusYield.OrderBot.DataSource ( Connection,