fix all bfx tests

functora · functora · commit e535623eeff9 · 2024-12-07T22:54:49.000-03:00
diff --git a/pub/bfx/bfx.cabal b/pub/bfx/bfx.cabal
@@ -139,7 +139,6 @@ library
     Bfx.Indicator.Ma
     Bfx.Indicator.Tr
     Bfx.Math
-    Bfx.Orphan
     Bfx.Parser
     Bfx.Rpc.Generic
     Bfx.Util
@@ -191,7 +190,6 @@ test-suite bfx-test
       Bfx.Indicator.Ma
       Bfx.Indicator.Tr
       Bfx.Math
-      Bfx.Orphan
       Bfx.Parser
       Bfx.Rpc.Generic
       Bfx.Util
diff --git a/pub/bfx/src/Bfx/Class/FromRpc.hs b/pub/bfx/src/Bfx/Class/FromRpc.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Class.FromRpc
diff --git a/pub/bfx/src/Bfx/Class/ToBaseUrl.hs b/pub/bfx/src/Bfx/Class/ToBaseUrl.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Class.ToBaseUrl
diff --git a/pub/bfx/src/Bfx/Class/ToPathPieces.hs b/pub/bfx/src/Bfx/Class/ToPathPieces.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Class.ToPathPieces
diff --git a/pub/bfx/src/Bfx/Class/ToRequestMethod.hs b/pub/bfx/src/Bfx/Class/ToRequestMethod.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Class.ToRequestMethod
diff --git a/pub/bfx/src/Bfx/Class/ToRequestParam.hs b/pub/bfx/src/Bfx/Class/ToRequestParam.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Class.ToRequestParam
diff --git a/pub/bfx/src/Bfx/Data/Type.hs b/pub/bfx/src/Bfx/Data/Type.hs
@@ -39,7 +39,6 @@ where
 
 import Bfx.Class.ToRequestParam
 import Bfx.Import.External
-import Bfx.Orphan ()
 import Data.Aeson (withText)
 import qualified Data.Aeson as A
 import qualified Data.Text as T
diff --git a/pub/bfx/src/Bfx/Data/Wallets.hs b/pub/bfx/src/Bfx/Data/Wallets.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Data.Wallets
diff --git a/pub/bfx/src/Bfx/Import/Internal.hs b/pub/bfx/src/Bfx/Import/Internal.hs
@@ -14,6 +14,5 @@ import Bfx.Data.Kind as X
 import Bfx.Data.Type as X
 import Bfx.Data.Web as X
 import Bfx.Math as X
-import Bfx.Orphan as X ()
 import Bfx.Parser as X
 import Bfx.Util as X
diff --git a/pub/bfx/src/Bfx/Math.hs b/pub/bfx/src/Bfx/Math.hs
@@ -113,7 +113,7 @@ data CounterExit = CounterExit
 
 newCounterOrder :: (MonadThrow m) => CounterArgs -> m CounterExit
 newCounterOrder args = do
-  exitBase <- tweakMoneyAmount Sell =<< roundMoneyAmount exitBaseLoss
+  exitBase <- tweakMoneyAmount Sell exitBaseLoss
   exitPrice <- roundQuotePerBase exitRate
   pure
     CounterExit
diff --git a/pub/bfx/src/Bfx/Orphan.hs b/pub/bfx/src/Bfx/Orphan.hs
diff --git a/pub/bfx/src/Bfx/Rpc/Generic.hs b/pub/bfx/src/Bfx/Rpc/Generic.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Rpc.Generic
diff --git a/pub/bfx/src/Bfx/Util.hs b/pub/bfx/src/Bfx/Util.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Util
diff --git a/pub/bfx/test/Bfx/Data/SubmitOrderSpec.hs b/pub/bfx/test/Bfx/Data/SubmitOrderSpec.hs
@@ -15,12 +15,11 @@ spec :: Spec
 spec =
   before sysEnv $ describe "ToJSON" $ do
     it "Request" . const $ do
-      adabtc <- newCurrencyPair "ADABTC"
       let req =
             SubmitOrder.Request
               Buy
               testAdaAmt
-              adabtc
+              adaBtc
               (QuotePerBase 0.00081037)
               SubmitOrder.optsPostOnly
       A.encode req
diff --git a/pub/bfx/test/Bfx/MathSpec.hs b/pub/bfx/test/Bfx/MathSpec.hs
@@ -10,7 +10,7 @@ import Test.Hspec
 
 spec :: Spec
 spec =
-  focus . it "newCounterOrder" $ do
+  it "newCounterOrder" $ do
     let rates =
           CounterRates
             { counterRatesEnterBaseFee = FeeRate 0.001,
@@ -24,11 +24,12 @@ spec =
               counterArgsRates = rates
             }
     exit <- newCounterOrder args
-    --
-    -- TODO : !!!
-    --
     exit
       `shouldBe` CounterExit
-        { counterExitNetBaseLoss = MoneyAmount 1,
-          counterExitQuotePerBase = QuotePerBase 1
+        { -- Deduct fee and pip:
+          -- 0.2 * 0.999 - 0.00000001
+          counterExitNetBaseLoss = MoneyAmount 0.19979999,
+          -- Add profit and fee:
+          -- ((0.2 * 5) * (1 + 0.01) / (1 - 0.001)) / 0.19979999
+          counterExitQuotePerBase = QuotePerBase 5.0601
         }
diff --git a/pub/bfx/test/Bfx/TestEnv.hs b/pub/bfx/test/Bfx/TestEnv.hs
@@ -1,41 +1,22 @@
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.TestEnv
-  ( eraseFirst,
+  ( adaBtc,
+    btcAda,
     testAdaAmt,
-    itRight,
-    itLeft,
   )
 where
 
 import Bfx.Import
-import qualified Test.Hspec as HS
 
-eraseFirst :: (Bifunctor f) => f a b -> f () b
-eraseFirst =
-  first $ const ()
+adaBtc :: CurrencyPair
+adaBtc =
+  either impureThrow id $ newCurrencyPair "ADABTC"
 
-testAdaAmt :: MoneyAmount
-testAdaAmt = MoneyAmount 4.004004
-
-itRight ::
-  ( Show a
-  ) =>
-  String ->
-  (Env -> ExceptT Error IO a) ->
-  HS.SpecWith (HS.Arg (Env -> IO ()))
-itRight label test =
-  HS.it label $ \env -> do
-    x <- runExceptT $ test env
-    x `HS.shouldSatisfy` isRight
+btcAda :: CurrencyPair
+btcAda =
+  either impureThrow id $ newCurrencyPair "BTCADA"
 
-itLeft ::
-  ( Show a
-  ) =>
-  String ->
-  (Env -> ExceptT Error IO a) ->
-  HS.SpecWith (HS.Arg (Env -> IO ()))
-itLeft label test =
-  HS.it label $ \env -> do
-    x <- runExceptT $ test env
-    x `HS.shouldSatisfy` isLeft
+testAdaAmt :: MoneyAmount
+testAdaAmt =
+  MoneyAmount 4.004004
diff --git a/pub/bfx/test/BfxSpec.hs b/pub/bfx/test/BfxSpec.hs
@@ -17,13 +17,12 @@ import Test.Hspec
 
 spec :: Spec
 spec = before sysEnv $ do
-  let adabtc = either impureThrow id $ newCurrencyPair "ADABTC"
   it "platformStatus succeeds" . const $ do
     ss <- Bfx.platformStatus
     ss `shouldBe` PltOperative
   it "symbolsDetails succeeds" . const $ do
     ss <- Bfx.symbolsDetails
-    Map.lookup adabtc ss
+    Map.lookup adaBtc ss
       `shouldBe` Just
         CurrencyPairConf
           { currencyPairPrecision = 5,
@@ -38,25 +37,24 @@ spec = before sysEnv $ do
         MarketAveragePrice.Request
           { MarketAveragePrice.buyOrSell = Buy,
             MarketAveragePrice.baseAmount = testAdaAmt,
-            MarketAveragePrice.symbol = adabtc
+            MarketAveragePrice.symbol = adaBtc
           }
     sellRate <-
       Bfx.marketAveragePrice
         MarketAveragePrice.Request
           { MarketAveragePrice.buyOrSell = Sell,
             MarketAveragePrice.baseAmount = testAdaAmt,
-            MarketAveragePrice.symbol = adabtc
+            MarketAveragePrice.symbol = adaBtc
           }
     buyRate `shouldSatisfy` (> sellRate)
   it "marketAveragePrice fails" . const $ do
-    sym <- newCurrencyPair "BTCADA"
     res <-
       tryAny
         $ Bfx.marketAveragePrice
           MarketAveragePrice.Request
             { MarketAveragePrice.buyOrSell = Sell,
               MarketAveragePrice.baseAmount = testAdaAmt,
-              MarketAveragePrice.symbol = sym
+              MarketAveragePrice.symbol = btcAda
             }
     res `shouldSatisfy` isLeft
   it "feeSummary succeeds" $ \env -> do
@@ -68,7 +66,7 @@ spec = before sysEnv $ do
         MarketAveragePrice.Request
           { MarketAveragePrice.buyOrSell = Buy,
             MarketAveragePrice.baseAmount = testAdaAmt,
-            MarketAveragePrice.symbol = adabtc
+            MarketAveragePrice.symbol = adaBtc
           }
     rate <-
       roundQuotePerBase
@@ -81,7 +79,7 @@ spec = before sysEnv $ do
         SubmitOrder.Request
           { SubmitOrder.buyOrSell = Buy,
             SubmitOrder.baseAmount = testAdaAmt,
-            SubmitOrder.symbol = adabtc,
+            SubmitOrder.symbol = adaBtc,
             SubmitOrder.rate = rate,
             SubmitOrder.options = SubmitOrder.optsPostOnly
           }
@@ -91,13 +89,13 @@ spec = before sysEnv $ do
         $ orderId order
     res `shouldSatisfy` isRight
   it "retrieveOrders succeeds" $ \env -> do
-    res <- tryAny . Bfx.retrieveOrders env $ GetOrders.optsSym adabtc
+    res <- tryAny . Bfx.retrieveOrders env $ GetOrders.optsSym adaBtc
     res `shouldSatisfy` isRight
   it "ordersHistory succeeds" $ \env -> do
-    res <- tryAny . Bfx.ordersHistory env $ GetOrders.optsSym adabtc
+    res <- tryAny . Bfx.ordersHistory env $ GetOrders.optsSym adaBtc
     res `shouldSatisfy` isRight
   it "getOrders succeeds" $ \env -> do
-    res <- tryAny . Bfx.getOrders env $ GetOrders.optsSym adabtc
+    res <- tryAny . Bfx.getOrders env $ GetOrders.optsSym adaBtc
     res `shouldSatisfy` isRight
   it "getOrder fails" $ \env -> do
     res <- tryAny . Bfx.getOrder env $ OrderId 0
@@ -122,10 +120,10 @@ spec = before sysEnv $ do
     res <- tryAny . Bfx.netWorth env $ CurrencyCode "BTC"
     res `shouldSatisfy` isRight
   it "candlesLast succeeds" . const $ do
-    res <- tryAny $ Bfx.candlesLast Ctf1h adabtc Candles.optsDef
+    res <- tryAny $ Bfx.candlesLast Ctf1h adaBtc Candles.optsDef
     res `shouldSatisfy` isRight
   it "candlesHist succeeds" . const $ do
-    res <- tryAny $ Bfx.candlesHist Ctf1h adabtc Candles.optsDef
+    res <- tryAny $ Bfx.candlesHist Ctf1h adaBtc Candles.optsDef
     res `shouldSatisfy` isRight
 
 --  describe "End2End" $ do

Original file line number	Diff line number	Diff line change
`@@ -1,5 +1,3 @@`
`1`		`-{-# LANGUAGE AllowAmbiguousTypes #-}`
`2`		`-{-# LANGUAGE UndecidableInstances #-}`
`3`	`1`	`{-# OPTIONS_HADDOCK show-extensions #-}`
`4`	`2`
`5`	`3`	`module Bfx.Class.FromRpc`
Original file line number	Diff line number	Diff line change
`@@ -1,4 +1,3 @@`
`1`		`-{-# LANGUAGE AllowAmbiguousTypes #-}`
`2`	`1`	`{-# OPTIONS_HADDOCK show-extensions #-}`
`3`	`2`
`4`	`3`	`module Bfx.Class.ToBaseUrl`