bfx wip

Author: functora

pub/bfx/src/Bfx.hs

@@ -26,6 +26,8 @@ module Bfx
     candlesLast,
     candlesHist,
     tickers,
+    MinOrderArgs (..),
+    mkMinOrder,
     module X,
   )
 where
@@ -577,3 +579,58 @@ tickers =
     [ SomeQueryParam "symbols" ("ALL" :: Text)
     ]
     emptyReq
+
+data MinOrderArgs = MinOrderArgs
+  { minOrderArgsFee :: FeeRate,
+    minOrderArgsBuyOrSell :: BuyOrSell,
+    minOrderArgsCurrencyPair :: CurrencyPair
+  }
+  deriving stock
+    ( Eq,
+      Ord,
+      Show,
+      Read,
+      Data,
+      Generic
+    )
+
+mkMinOrder ::
+  ( MonadThrow m,
+    MonadUnliftIO m
+  ) =>
+  MinOrderArgs ->
+  m SubmitOrder.Request
+mkMinOrder args = do
+  syms <- symbolsDetails
+  minBaseAmt <-
+    maybe
+      (throwString $ inspect @Text sym <> " is missing!")
+      (pure . currencyPairMinOrderBaseAmt)
+      $ Map.lookup sym syms
+  baseAmt <-
+    case bos of
+      Buy ->
+        tweakMoneyAmount Buy
+          . MoneyAmount
+          $ unMoneyAmount minBaseAmt
+          / (1 - unFeeRate (minOrderArgsFee args))
+      Sell ->
+        pure minBaseAmt
+  price <-
+    Bfx.marketAveragePrice
+      MarketAveragePrice.Request
+        { MarketAveragePrice.buyOrSell = bos,
+          MarketAveragePrice.baseAmount = baseAmt,
+          MarketAveragePrice.symbol = sym
+        }
+  pure
+    SubmitOrder.Request
+      { SubmitOrder.buyOrSell = bos,
+        SubmitOrder.baseAmount = baseAmt,
+        SubmitOrder.symbol = sym,
+        SubmitOrder.rate = price,
+        SubmitOrder.options = SubmitOrder.optsDef
+      }
+  where
+    bos = minOrderArgsBuyOrSell args
+    sym = minOrderArgsCurrencyPair args

pub/bfx/src/Bfx/Data/Type.hs

@@ -348,6 +348,8 @@ data CurrencyPairConf = CurrencyPairConf
     ( Eq,
       Ord,
       Show,
+      Read,
+      Data,
       Generic
     )
 

pub/bfx/src/Bfx/Math.hs

@@ -1,21 +1,49 @@
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Math
-  ( tweakMoneyAmount,
+  ( roundMoneyAmount,
+    roundQuotePerBase,
+    tweakMoneyAmount,
     tweakQuotePerBase,
-    mkCounterOrder,
     CounterArgs (..),
     CounterRates (..),
     CounterExit (..),
-    roundMoneyAmount,
-    roundQuotePerBase,
+    mkCounterOrder,
   )
 where
 
 import Data.Ratio.Rounding (dpRound, sdRound)
 import Functora.Money
 import Functora.Prelude
 
+roundMoneyAmount :: (MonadThrow m) => MoneyAmount -> m MoneyAmount
+roundMoneyAmount arg@(MoneyAmount raw) =
+  if raw >= 0 && rounded >= 0
+    then pure $ MoneyAmount rounded
+    else throwString $ "Rounding error for " <> inspect @String arg
+  where
+    rounded =
+      unsafeFrom @Rational @(Ratio Natural)
+        . roundMoneyAmountRat
+        $ from @(Ratio Natural) @Rational raw
+
+roundQuotePerBase :: (MonadThrow m) => QuotePerBase -> m QuotePerBase
+roundQuotePerBase arg@(QuotePerBase raw) =
+  if raw > 0 && rounded > 0
+    then pure $ QuotePerBase rounded
+    else throwString $ "Rounding error for " <> inspect @String arg
+  where
+    rounded =
+      unsafeFrom @Rational @(Ratio Natural)
+        . roundQuotePerBaseRat
+        $ from @(Ratio Natural) @Rational raw
+
+roundMoneyAmountRat :: Rational -> Rational
+roundMoneyAmountRat = dpRound 8
+
+roundQuotePerBaseRat :: Rational -> Rational
+roundQuotePerBaseRat = sdRound 5 . dpRound 8
+
 tweakMoneyAmount ::
   ( MonadThrow m
   ) =>
@@ -188,31 +216,3 @@ mkCounterOrder args = do
     feeRate = counterRatesFee $ counterArgsRates args
     profitRate :: ProfitRate
     profitRate = counterRatesProfit $ counterArgsRates args
-
-roundMoneyAmount :: (MonadThrow m) => MoneyAmount -> m MoneyAmount
-roundMoneyAmount arg@(MoneyAmount raw) =
-  if raw >= 0 && rounded >= 0
-    then pure $ MoneyAmount rounded
-    else throwString $ "Rounding error for " <> inspect @String arg
-  where
-    rounded =
-      unsafeFrom @Rational @(Ratio Natural)
-        . roundMoneyAmountRat
-        $ from @(Ratio Natural) @Rational raw
-
-roundQuotePerBase :: (MonadThrow m) => QuotePerBase -> m QuotePerBase
-roundQuotePerBase arg@(QuotePerBase raw) =
-  if raw > 0 && rounded > 0
-    then pure $ QuotePerBase rounded
-    else throwString $ "Rounding error for " <> inspect @String arg
-  where
-    rounded =
-      unsafeFrom @Rational @(Ratio Natural)
-        . roundQuotePerBaseRat
-        $ from @(Ratio Natural) @Rational raw
-
-roundMoneyAmountRat :: Rational -> Rational
-roundMoneyAmountRat = dpRound 8
-
-roundQuotePerBaseRat :: Rational -> Rational
-roundQuotePerBaseRat = sdRound 5 . dpRound 8

pub/bfx/test/BfxSpec.hs

@@ -125,6 +125,17 @@ spec = before sysEnv $ do
   it "candlesHist succeeds" . const $ do
     res <- tryAny $ Bfx.candlesHist Ctf1h adaBtc Candles.optsDef
     res `shouldSatisfy` isRight
+  it "mkMinOrder" . const $ do
+    let req =
+          Bfx.MinOrderArgs
+            { Bfx.minOrderArgsFee = FeeRate 0.001,
+              Bfx.minOrderArgsBuyOrSell = Buy,
+              Bfx.minOrderArgsCurrencyPair = adaBtc
+            }
+    buyRes <- Bfx.mkMinOrder req
+    SubmitOrder.baseAmount buyRes `shouldBe` MoneyAmount 4.00400401
+    sellRes <- Bfx.mkMinOrder req {Bfx.minOrderArgsBuyOrSell = Sell}
+    SubmitOrder.baseAmount sellRes `shouldBe` MoneyAmount 4
 
 --  describe "End2End" $ do
 --    itRight "submitOrderMaker" $ \env -> do

pub/functora/src/sql/Functora/SqlOrphan.hs

@@ -104,3 +104,11 @@ deriving newtype instance PersistFieldSql QuotePerBase
 deriving newtype instance PersistField CurrencyCode
 
 deriving newtype instance PersistFieldSql CurrencyCode
+
+deriving newtype instance PersistField FeeRate
+
+deriving newtype instance PersistFieldSql FeeRate
+
+deriving newtype instance PersistField ProfitRate
+
+deriving newtype instance PersistFieldSql ProfitRate