bfx wip

Author: functora

cabal.project

@@ -73,6 +73,7 @@ else
       pub/universum/*.cabal
       pub/functora/*.cabal
       pub/xlsx/*.cabal
+      pub/bfx/*.cabal
       ghcjs/*/*.cabal
     optional-packages:
       prv/*/*.cabal

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

@@ -45,7 +45,6 @@ import Bfx.Orphan ()
 import Data.Aeson (withText)
 import qualified Data.Aeson as A
 import qualified Data.Text as T
-import Language.Haskell.TH.Syntax as TH (Lift)
 import qualified Network.HTTP.Client as Web
 import qualified Prelude
 
@@ -394,8 +393,7 @@ data CurrencyPair = CurrencyPair
     ( Eq,
       Ord,
       Show,
-      Generic,
-      TH.Lift
+      Generic
     )
 
 instance FromJSON CurrencyPair where

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

@@ -110,7 +110,7 @@ instance From RawResponse ByteString
 
 instance Show RawResponse where
   show x =
-    case decodeUtf8' bs of
+    case decodeUtf8Strict bs of
       Left {} -> "ByteString RawResponse" <> inspect (BS.unpack bs)
       Right res -> "Text RawResponse " <> T.unpack res
     where

pub/bfx/src/Bfx/Rpc/Generic.hs

@@ -50,7 +50,10 @@ pub qs req = do
         Web.setQueryString
           (unQueryParam <$> qs)
           $ webReq0
-            { Web.method = inspect $ toRequestMethod @method
+            { Web.method =
+                encodeUtf8
+                  . inspect @Text
+                  $ toRequestMethod @method
             }
   webRes <-
     liftIO $ Web.httpLbs webReq1 manager
@@ -94,7 +97,7 @@ prv env req = do
     let nonce = encodeUtf8 (inspect nonce' :: Text)
     let webReq1 =
           webReq0
-            { Web.method = inspect $ toRequestMethod @method,
+            { Web.method = encodeUtf8 . inspect @Text $ toRequestMethod @method,
               Web.requestBody = Web.RequestBodyLBS reqBody,
               Web.requestHeaders =
                 [ ( "Content-Type",

pub/functora/src/money/Functora/MoneySing.hs

@@ -133,3 +133,93 @@ instance TestEquality (Sing :: GainOrLose -> Type) where
   testEquality SGain SGain = Just Refl
   testEquality SLose SLose = Just Refl
   testEquality _ _ = Nothing
+
+--
+-- BaseOrQuote
+--
+
+data instance Sing (x :: BaseOrQuote) where
+  SBase :: Sing 'Base
+  SQuote :: Sing 'Quote
+
+instance SingKind BaseOrQuote where
+  type Demote BaseOrQuote = BaseOrQuote
+  fromSing SBase = Base
+  fromSing SQuote = Quote
+  toSing Base = SomeSing SBase
+  toSing Quote = SomeSing SQuote
+
+instance SingI 'Base where sing = SBase
+
+instance SingI 'Quote where sing = SQuote
+
+instance TestEquality (Sing :: BaseOrQuote -> Type) where
+  testEquality SBase SBase = Just Refl
+  testEquality SQuote SQuote = Just Refl
+  testEquality _ _ = Nothing
+
+--
+-- MoneyKind
+--
+
+data instance Sing (x :: MoneyKind) where
+  SMoneyAmount :: Sing 'MoneyAmount
+  SCurrency :: Sing 'Currency
+  SQuotePerBase :: Sing 'QuotePerBase
+  SFeeRate :: Sing 'FeeRate
+  SProfitRate :: Sing 'ProfitRate
+
+instance SingKind MoneyKind where
+  type Demote MoneyKind = MoneyKind
+  fromSing SMoneyAmount = MoneyAmount
+  fromSing SCurrency = Currency
+  fromSing SQuotePerBase = QuotePerBase
+  fromSing SFeeRate = FeeRate
+  fromSing SProfitRate = ProfitRate
+  toSing MoneyAmount = SomeSing SMoneyAmount
+  toSing Currency = SomeSing SCurrency
+  toSing QuotePerBase = SomeSing SQuotePerBase
+  toSing FeeRate = SomeSing SFeeRate
+  toSing ProfitRate = SomeSing SProfitRate
+
+instance SingI 'MoneyAmount where sing = SMoneyAmount
+
+instance SingI 'Currency where sing = SCurrency
+
+instance SingI 'QuotePerBase where sing = SQuotePerBase
+
+instance SingI 'FeeRate where sing = SFeeRate
+
+instance SingI 'ProfitRate where sing = SProfitRate
+
+instance TestEquality (Sing :: MoneyKind -> Type) where
+  testEquality SMoneyAmount SMoneyAmount = Just Refl
+  testEquality SCurrency SCurrency = Just Refl
+  testEquality SQuotePerBase SQuotePerBase = Just Refl
+  testEquality SFeeRate SFeeRate = Just Refl
+  testEquality SProfitRate SProfitRate = Just Refl
+  testEquality _ _ = Nothing
+
+--
+-- MakerOrTaker
+--
+
+data instance Sing (x :: MakerOrTaker) where
+  SMaker :: Sing 'Maker
+  STaker :: Sing 'Taker
+
+instance SingKind MakerOrTaker where
+  type Demote MakerOrTaker = MakerOrTaker
+  fromSing SMaker = Maker
+  fromSing STaker = Taker
+  toSing Maker = SomeSing SMaker
+  toSing Taker = SomeSing STaker
+
+instance SingI 'Maker where sing = SMaker
+
+instance SingI 'Taker where sing = STaker
+
+instance TestEquality (Sing :: MakerOrTaker -> Type) where
+  testEquality SMaker SMaker = Just Refl
+  testEquality STaker STaker = Just Refl
+  testEquality _ _ = Nothing