bfx wip

Author: functora

pub/bfx/bfx.cabal

@@ -90,6 +90,7 @@ common pkg-lib
     , cryptonite
     , envparse
     , functora
+    , functora:cfg
     , functora:money
     , functora:sql
     , http-client
@@ -207,6 +208,7 @@ test-suite bfx-test
       , cryptonite
       , envparse
       , functora
+      , functora:cfg
       , functora:money
       , functora:sql
       , http-client

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

@@ -1,16 +1,14 @@
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Data.Env
-  ( RawEnv (..),
-    Env (..),
+  ( Env (..),
     newEnv,
     sysEnv,
   )
 where
 
 import Bfx.Data.Web
 import Bfx.Import.External
-import qualified Data.Aeson as A
 import Env
   ( Mod,
     Var,
@@ -22,26 +20,6 @@ import Env
     var,
   )
 
-data RawEnv = RawEnv
-  { rawEnvApiKey :: ApiKey,
-    rawEnvPrvKey :: PrvKey
-  }
-  deriving stock
-    ( Eq,
-      -- | It's safe to derive 'Show' instance,
-      -- because 'ApiKey' and 'PrvKey'
-      -- instances are safe.
-      Show,
-      Generic
-    )
-
-instance FromJSON RawEnv where
-  parseJSON =
-    A.genericParseJSON
-      A.defaultOptions
-        { A.fieldLabelModifier = A.camelTo2 '_' . drop 6
-        }
-
 data Env = Env
   { envNonceGen :: NonceGen,
     envApiKey :: ApiKey,
@@ -52,14 +30,14 @@ data Env = Env
       Show
     )
 
-newEnv :: (MonadIO m) => RawEnv -> m Env
-newEnv raw = do
+newEnv :: (MonadIO m) => ApiKey -> PrvKey -> m Env
+newEnv apiKey prvKey = do
   nonceGen <- newNonceGen
-  pure $
-    Env
+  pure
+    $ Env
       { envNonceGen = nonceGen,
-        envApiKey = rawEnvApiKey raw,
-        envPrvKey = rawEnvPrvKey raw
+        envApiKey = apiKey,
+        envPrvKey = prvKey
       }
 
 sysEnv ::
@@ -71,8 +49,8 @@ sysEnv = do
   liftIO
     . parse (header "Bfx")
     $ Env nonceGen
-      <$> var (str <=< nonempty) "BITFINEX_API_KEY" op
-      <*> var (str <=< nonempty) "BITFINEX_PRV_KEY" op
+    <$> var (str <=< nonempty) "BITFINEX_API_KEY" op
+    <*> var (str <=< nonempty) "BITFINEX_PRV_KEY" op
   where
     op :: Mod Var a
     op = help mempty

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

@@ -1,4 +1,3 @@
-{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Data.Type
@@ -59,12 +58,17 @@ newtype OrderId = OrderId
     ( Eq,
       Ord,
       Show,
-      Num,
+      Read,
       ToJSON,
-      FromJSON
+      ToJSONKey,
+      FromJSON,
+      FromJSONKey,
+      HasCodec,
+      HasItemCodec
     )
   deriving stock
-    ( Generic
+    ( Data,
+      Generic
     )
 
 newtype OrderClientId = OrderClientId
@@ -74,12 +78,17 @@ newtype OrderClientId = OrderClientId
     ( Eq,
       Ord,
       Show,
-      Num,
+      Read,
       ToJSON,
-      FromJSON
+      ToJSONKey,
+      FromJSON,
+      FromJSONKey,
+      HasCodec,
+      HasItemCodec
     )
   deriving stock
-    ( Generic
+    ( Data,
+      Generic
     )
 
 newtype OrderGroupId = OrderGroupId
@@ -89,12 +98,17 @@ newtype OrderGroupId = OrderGroupId
     ( Eq,
       Ord,
       Show,
-      Num,
+      Read,
       ToJSON,
-      FromJSON
+      ToJSONKey,
+      FromJSON,
+      FromJSONKey,
+      HasCodec,
+      HasItemCodec
     )
   deriving stock
-    ( Generic
+    ( Data,
+      Generic
     )
 
 data Order (act :: BuyOrSell) (loc :: LocalOrRemote) = Order
@@ -110,7 +124,10 @@ data Order (act :: BuyOrSell) (loc :: LocalOrRemote) = Order
   }
   deriving stock
     ( Eq,
+      Ord,
       Show,
+      Read,
+      Data,
       Generic
     )
 
@@ -143,6 +160,7 @@ data OrderFlag
     ( Eq,
       Ord,
       Show,
+      Data,
       Generic,
       Enum,
       Bounded
@@ -156,10 +174,13 @@ newtype OrderFlagAcc
       Show,
       Num,
       ToJSON,
-      FromJSON
+      ToJSONKey,
+      FromJSON,
+      FromJSONKey
     )
   deriving stock
-    ( Generic
+    ( Data,
+      Generic
     )
 
 unOrderFlag :: OrderFlag -> OrderFlagAcc
@@ -189,11 +210,24 @@ data OrderStatus
     ( Eq,
       Ord,
       Show,
+      Read,
       Data,
       Generic,
       Enum,
       Bounded
     )
+  deriving
+    ( ToJSON,
+      ToJSONKey,
+      FromJSON,
+      FromJSONKey
+    )
+    via GenericType OrderStatus
+  deriving
+    ( HasCodec,
+      HasItemCodec
+    )
+    via GenericEnum OrderStatus
 
 newOrderStatus ::
   Text ->
@@ -393,8 +427,15 @@ data CurrencyPair = CurrencyPair
     ( Eq,
       Ord,
       Show,
+      Read,
+      Data,
       Generic
     )
+  deriving
+    ( HasCodec,
+      HasItemCodec
+    )
+    via GenericType CurrencyPair
 
 instance FromJSON CurrencyPair where
   parseJSON =

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

@@ -20,58 +20,35 @@ import Bfx.Import.External
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Types as A
 import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Text as T
 import qualified Prelude
 
 newtype PrvKey = PrvKey
-  { unPrvKey :: BS.ByteString
+  { unPrvKey :: Text
   }
   deriving newtype
     ( Eq,
       Ord,
-      IsString
+      Read,
+      IsString,
+      HasCodec,
+      HasItemCodec
     )
+  deriving stock (Data, Generic)
+  deriving (Show) via Redacted PrvKey
 
-instance From BS.ByteString PrvKey
-
-instance From PrvKey BS.ByteString
-
-instance From (UTF_8 BS.ByteString) PrvKey where
-  from =
-    via @BS.ByteString
-
-instance Prelude.Show PrvKey where
-  show =
-    const "SECRET"
-
-instance FromJSON PrvKey where
-  parseJSON =
-    parseJsonBs
-
-newtype ApiKey
-  = ApiKey BS.ByteString
+newtype ApiKey = ApiKey
+  { unApiKey :: Text
+  }
   deriving newtype
     ( Eq,
       Ord,
-      IsString
+      Read,
+      IsString,
+      HasCodec,
+      HasItemCodec
     )
-
-instance From BS.ByteString ApiKey
-
-instance From ApiKey BS.ByteString
-
-instance From (UTF_8 BS.ByteString) ApiKey where
-  from =
-    via @BS.ByteString
-
-instance Prelude.Show ApiKey where
-  show =
-    const "SECRET"
-
-instance FromJSON ApiKey where
-  parseJSON =
-    parseJsonBs
+  deriving stock (Data, Generic)
+  deriving (Show) via Redacted ApiKey
 
 data RequestMethod
   = GET
@@ -80,42 +57,35 @@ data RequestMethod
     ( Eq,
       Ord,
       Show,
+      Read,
       Data,
       Generic
     )
 
-newtype BaseUrl
-  = BaseUrl Text
+newtype BaseUrl = BaseUrl
+  { unBaseUrl :: Text
+  }
   deriving newtype
     ( Eq,
       Ord,
       Show,
+      Read,
       IsString
     )
 
-newtype RawResponse
-  = RawResponse ByteString
+newtype RawResponse = RawResponse
+  { unRawResponse :: ByteString
+  }
   deriving newtype
     ( Eq,
-      Ord
+      Ord,
+      Show
     )
   deriving stock
     ( Data,
       Generic
     )
 
-instance From ByteString RawResponse
-
-instance From RawResponse ByteString
-
-instance Show RawResponse where
-  show x =
-    case decodeUtf8Strict bs of
-      Left {} -> "ByteString RawResponse" <> inspect (BS.unpack bs)
-      Right res -> "Text RawResponse " <> T.unpack res
-    where
-      bs = BL.toStrict $ from x
-
 newtype Nonce = Nonce
   { unNonce :: Natural
   }

pub/bfx/src/Bfx/Import/External.hs

@@ -7,7 +7,6 @@ where
 
 import Control.Concurrent as X (threadDelay)
 import Control.Monad.Trans.Except as X (catchE, except, throwE)
-import Data.Aeson as X (FromJSON (..), FromJSONKey (..), ToJSON (..))
 import Data.ByteString.Lazy as X (ByteString)
 import Data.Coerce as X (coerce)
 import Data.Fixed as X (Fixed, HasResolution (..), showFixed)
@@ -24,6 +23,7 @@ import Data.Metrology.Poly as X
     (|/|),
   )
 import Data.Ratio.Rounding as X (dpRound, sdRound)
+import Functora.Cfg as X
 import Functora.Money as X
 import Functora.Prelude as X hiding (ByteString, Exchange (..), at)
 import Functora.Sql as X

pub/bfx/src/Bfx/Orphan.hs

@@ -1,8 +1,13 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Bfx.Orphan () where
 
 import Bfx.Data.Kind
 import Bfx.Import.External
 
 mkFgpt @Method
+
+deriving newtype instance HasCodec CurrencyCode
+
+deriving newtype instance HasItemCodec CurrencyCode