Accounts.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}

module CoinbasePro.Authenticated.Accounts
    ( Account (..)
    , AccountId (..)
    , Currency (..)
    , Balance (..)
    , ProfileId (..)
    , Fees (..)
    , TrailingVolume (..)
    , AccountHistory (..)
    , Hold (..)
    ) where

import           Data.Aeson        (FromJSON (..), ToJSON, withObject, withText,
                                    (.:), (.:?))
import qualified Data.Aeson        as A
import           Data.Aeson.Casing (snakeCase)
import           Data.Aeson.TH     (constructorTagModifier, defaultOptions,
                                    deriveJSON, fieldLabelModifier)
import qualified Data.Char         as Char
import           Data.Text         (Text, pack, unpack)
import           Data.Time.Clock   (UTCTime)
import           Text.Printf       (printf)
import           Web.HttpApiData   (ToHttpApiData (..))

import           CoinbasePro.Types (CreatedAt (..), OrderId, ProductId,
                                    TradeId (..), Volume (..))


newtype AccountId = AccountId Text
    deriving Eq


instance Show AccountId where
  show (AccountId t) = unpack t


deriveJSON defaultOptions
    { fieldLabelModifier = snakeCase
    } ''AccountId


instance ToHttpApiData AccountId where
    toUrlPiece (AccountId aid)   = aid
    toQueryParam (AccountId aid) = aid


newtype Currency = Currency Text
    deriving (Eq, Show)


newtype Balance = Balance Double
    deriving (Eq, Show)


instance ToJSON Balance where
    toJSON (Balance s) = A.String . pack $ printf "%.16f" s


instance FromJSON Balance where
    parseJSON = withText "balance" $ \t ->
      return . Balance . read $ unpack t


newtype ProfileId = ProfileId Text
    deriving (Eq, Show)


data Account = Account
    { accountId :: AccountId
    , currency  :: Currency
    , balance   :: Balance
    , available :: Balance
    , hold      :: Balance
    , profileId :: ProfileId
    } deriving (Eq, Show)


instance FromJSON Account where
    parseJSON = withObject "account" $ \o -> Account
        <$> (AccountId <$> o .: "id")
        <*> (Currency <$> o .: "currency")
        <*> (Balance . read <$> o .: "balance")
        <*> (Balance . read <$> o .: "available")
        <*> (Balance . read <$> o .: "hold")
        <*> (ProfileId <$> o .: "profile_id")


newtype FeeRate = FeeRate { unFeeRate :: Double }
    deriving (Eq, Show, FromJSON, ToJSON)


data Fees = Fees
    { makerFeeRate :: FeeRate
    , takerFeeRate :: FeeRate
    , usdVolume    :: Volume
    } deriving (Eq, Show)


instance FromJSON Fees where
    parseJSON = withObject "fees" $ \o -> Fees
        <$> (FeeRate . read <$> o .: "maker_fee_rate")
        <*> (FeeRate . read <$> o .: "taker_fee_rate")
        <*> (Volume . read <$> o .: "usd_volume")


data TrailingVolume = TrailingVolume
    { productId      :: ProductId
    , exchangeVolume :: Volume
    , volume         :: Volume
    , recordedAt     :: UTCTime
    } deriving (Eq, Show)


deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''TrailingVolume


data AccountHistoryType = Transfer | Match | Fee | Rebate | Conversion
    deriving (Eq, Show)


deriveJSON defaultOptions { constructorTagModifier = fmap Char.toLower } ''AccountHistoryType


data Details = Details
    { dOrderId   :: Maybe OrderId
    , dTradeId   :: Maybe TradeId
    , dProductId :: Maybe ProductId
    } deriving (Eq, Show)


instance FromJSON Details where
    parseJSON = withObject "details" $ \o -> Details
        <$> (o .:? "order_id")
        <*> (fmap (TradeId . read) <$> o .:? "trade_id")
        <*> (o .:? "product_id")


data AccountHistory = AccountHistory
    { hAccountId :: AccountId
    , hCreatedAt :: CreatedAt
    , hAmount    :: Double
    , hBalance   :: Balance
    , hType      :: AccountHistoryType
    , hDetails   :: Maybe Details
    } deriving (Eq, Show)


instance FromJSON AccountHistory where
    parseJSON = withObject "account_history" $ \o -> AccountHistory
        <$> (AccountId <$> o .: "id")
        <*> (CreatedAt <$> o .: "created_at")
        <*> (read <$> o .: "amount")
        <*> (Balance . read <$> o .: "balance")
        <*> (o .: "type")
        <*> (o .: "details")


newtype HoldId = HoldId Text
  deriving (Eq, Show, ToJSON, FromJSON)


data HoldType = Order | HoldTransfer
  deriving (Eq, Show)


newtype HoldRef = HoldRef Text
  deriving (Eq, Show, ToJSON, FromJSON)


deriveJSON defaultOptions { constructorTagModifier = fmap Char.toLower } ''HoldType


data Hold = Hold
    { holdId        :: HoldId
    , holdAccountId :: AccountId
    , holdCreatedAt :: CreatedAt
    , holdUpdatedAt :: CreatedAt
    , holdAmount    :: Double
    , holdType      :: HoldType
    , holdRef       :: HoldRef
    } deriving (Eq, Show)


deriveJSON defaultOptions { constructorTagModifier = fmap Char.toLower . drop 4, fieldLabelModifier = snakeCase } ''Hold