{-# 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 AccountId -> AccountId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountId -> AccountId -> Bool
$c/= :: AccountId -> AccountId -> Bool
== :: AccountId -> AccountId -> Bool
$c== :: AccountId -> AccountId -> Bool
Eq


instance Show AccountId where
  show :: AccountId -> String
show (AccountId Text
t) = Text -> String
unpack Text
t


deriveJSON defaultOptions
    { fieldLabelModifier = snakeCase
    } ''AccountId


instance ToHttpApiData AccountId where
    toUrlPiece :: AccountId -> Text
toUrlPiece (AccountId Text
aid)   = Text
aid
    toQueryParam :: AccountId -> Text
toQueryParam (AccountId Text
aid) = Text
aid


newtype Currency = Currency Text
    deriving (Currency -> Currency -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Currency -> Currency -> Bool
$c/= :: Currency -> Currency -> Bool
== :: Currency -> Currency -> Bool
$c== :: Currency -> Currency -> Bool
Eq, Int -> Currency -> ShowS
[Currency] -> ShowS
Currency -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Currency] -> ShowS
$cshowList :: [Currency] -> ShowS
show :: Currency -> String
$cshow :: Currency -> String
showsPrec :: Int -> Currency -> ShowS
$cshowsPrec :: Int -> Currency -> ShowS
Show)


newtype Balance = Balance Double
    deriving (Balance -> Balance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Balance -> Balance -> Bool
$c/= :: Balance -> Balance -> Bool
== :: Balance -> Balance -> Bool
$c== :: Balance -> Balance -> Bool
Eq, Int -> Balance -> ShowS
[Balance] -> ShowS
Balance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Balance] -> ShowS
$cshowList :: [Balance] -> ShowS
show :: Balance -> String
$cshow :: Balance -> String
showsPrec :: Int -> Balance -> ShowS
$cshowsPrec :: Int -> Balance -> ShowS
Show, Eq Balance
Balance -> Balance -> Bool
Balance -> Balance -> Ordering
Balance -> Balance -> Balance
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Balance -> Balance -> Balance
$cmin :: Balance -> Balance -> Balance
max :: Balance -> Balance -> Balance
$cmax :: Balance -> Balance -> Balance
>= :: Balance -> Balance -> Bool
$c>= :: Balance -> Balance -> Bool
> :: Balance -> Balance -> Bool
$c> :: Balance -> Balance -> Bool
<= :: Balance -> Balance -> Bool
$c<= :: Balance -> Balance -> Bool
< :: Balance -> Balance -> Bool
$c< :: Balance -> Balance -> Bool
compare :: Balance -> Balance -> Ordering
$ccompare :: Balance -> Balance -> Ordering
Ord, Integer -> Balance
Balance -> Balance
Balance -> Balance -> Balance
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Balance
$cfromInteger :: Integer -> Balance
signum :: Balance -> Balance
$csignum :: Balance -> Balance
abs :: Balance -> Balance
$cabs :: Balance -> Balance
negate :: Balance -> Balance
$cnegate :: Balance -> Balance
* :: Balance -> Balance -> Balance
$c* :: Balance -> Balance -> Balance
- :: Balance -> Balance -> Balance
$c- :: Balance -> Balance -> Balance
+ :: Balance -> Balance -> Balance
$c+ :: Balance -> Balance -> Balance
Num)


instance ToJSON Balance where
    toJSON :: Balance -> Value
toJSON (Balance Double
s) = Text -> Value
A.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%.16f" Double
s


instance FromJSON Balance where
    parseJSON :: Value -> Parser Balance
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"balance" forall a b. (a -> b) -> a -> b
$ \Text
t ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Balance
Balance forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
t


newtype ProfileId = ProfileId Text
    deriving (ProfileId -> ProfileId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfileId -> ProfileId -> Bool
$c/= :: ProfileId -> ProfileId -> Bool
== :: ProfileId -> ProfileId -> Bool
$c== :: ProfileId -> ProfileId -> Bool
Eq, Int -> ProfileId -> ShowS
[ProfileId] -> ShowS
ProfileId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfileId] -> ShowS
$cshowList :: [ProfileId] -> ShowS
show :: ProfileId -> String
$cshow :: ProfileId -> String
showsPrec :: Int -> ProfileId -> ShowS
$cshowsPrec :: Int -> ProfileId -> ShowS
Show)


data Account = Account
    { Account -> AccountId
accountId :: AccountId
    , Account -> Currency
currency  :: Currency
    , Account -> Balance
balance   :: Balance
    , Account -> Balance
available :: Balance
    , Account -> Balance
hold      :: Balance
    , Account -> ProfileId
profileId :: ProfileId
    } deriving (Account -> Account -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Account -> Account -> Bool
$c/= :: Account -> Account -> Bool
== :: Account -> Account -> Bool
$c== :: Account -> Account -> Bool
Eq, Int -> Account -> ShowS
[Account] -> ShowS
Account -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Account] -> ShowS
$cshowList :: [Account] -> ShowS
show :: Account -> String
$cshow :: Account -> String
showsPrec :: Int -> Account -> ShowS
$cshowsPrec :: Int -> Account -> ShowS
Show)


instance FromJSON Account where
    parseJSON :: Value -> Parser Account
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"account" forall a b. (a -> b) -> a -> b
$ \Object
o -> AccountId
-> Currency
-> Balance
-> Balance
-> Balance
-> ProfileId
-> Account
Account
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> AccountId
AccountId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Currency
Currency forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"currency")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Double -> Balance
Balance forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"balance")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Double -> Balance
Balance forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"available")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Double -> Balance
Balance forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hold")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> ProfileId
ProfileId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"profile_id")


newtype FeeRate = FeeRate { FeeRate -> Double
unFeeRate :: Double }
    deriving (FeeRate -> FeeRate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FeeRate -> FeeRate -> Bool
$c/= :: FeeRate -> FeeRate -> Bool
== :: FeeRate -> FeeRate -> Bool
$c== :: FeeRate -> FeeRate -> Bool
Eq, Int -> FeeRate -> ShowS
[FeeRate] -> ShowS
FeeRate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FeeRate] -> ShowS
$cshowList :: [FeeRate] -> ShowS
show :: FeeRate -> String
$cshow :: FeeRate -> String
showsPrec :: Int -> FeeRate -> ShowS
$cshowsPrec :: Int -> FeeRate -> ShowS
Show, Eq FeeRate
FeeRate -> FeeRate -> Bool
FeeRate -> FeeRate -> Ordering
FeeRate -> FeeRate -> FeeRate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FeeRate -> FeeRate -> FeeRate
$cmin :: FeeRate -> FeeRate -> FeeRate
max :: FeeRate -> FeeRate -> FeeRate
$cmax :: FeeRate -> FeeRate -> FeeRate
>= :: FeeRate -> FeeRate -> Bool
$c>= :: FeeRate -> FeeRate -> Bool
> :: FeeRate -> FeeRate -> Bool
$c> :: FeeRate -> FeeRate -> Bool
<= :: FeeRate -> FeeRate -> Bool
$c<= :: FeeRate -> FeeRate -> Bool
< :: FeeRate -> FeeRate -> Bool
$c< :: FeeRate -> FeeRate -> Bool
compare :: FeeRate -> FeeRate -> Ordering
$ccompare :: FeeRate -> FeeRate -> Ordering
Ord, Value -> Parser [FeeRate]
Value -> Parser FeeRate
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FeeRate]
$cparseJSONList :: Value -> Parser [FeeRate]
parseJSON :: Value -> Parser FeeRate
$cparseJSON :: Value -> Parser FeeRate
FromJSON, [FeeRate] -> Encoding
[FeeRate] -> Value
FeeRate -> Encoding
FeeRate -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FeeRate] -> Encoding
$ctoEncodingList :: [FeeRate] -> Encoding
toJSONList :: [FeeRate] -> Value
$ctoJSONList :: [FeeRate] -> Value
toEncoding :: FeeRate -> Encoding
$ctoEncoding :: FeeRate -> Encoding
toJSON :: FeeRate -> Value
$ctoJSON :: FeeRate -> Value
ToJSON)


data Fees = Fees
    { Fees -> FeeRate
makerFeeRate :: FeeRate
    , Fees -> FeeRate
takerFeeRate :: FeeRate
    , Fees -> Volume
usdVolume    :: Volume
    } deriving (Fees -> Fees -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fees -> Fees -> Bool
$c/= :: Fees -> Fees -> Bool
== :: Fees -> Fees -> Bool
$c== :: Fees -> Fees -> Bool
Eq, Int -> Fees -> ShowS
[Fees] -> ShowS
Fees -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fees] -> ShowS
$cshowList :: [Fees] -> ShowS
show :: Fees -> String
$cshow :: Fees -> String
showsPrec :: Int -> Fees -> ShowS
$cshowsPrec :: Int -> Fees -> ShowS
Show)


instance FromJSON Fees where
    parseJSON :: Value -> Parser Fees
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"fees" forall a b. (a -> b) -> a -> b
$ \Object
o -> FeeRate -> FeeRate -> Volume -> Fees
Fees
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double -> FeeRate
FeeRate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maker_fee_rate")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Double -> FeeRate
FeeRate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"taker_fee_rate")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Double -> Volume
Volume forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"usd_volume")


data TrailingVolume = TrailingVolume
    { TrailingVolume -> ProductId
productId      :: ProductId
    , TrailingVolume -> Volume
exchangeVolume :: Volume
    , TrailingVolume -> Volume
volume         :: Volume
    , TrailingVolume -> UTCTime
recordedAt     :: UTCTime
    } deriving (TrailingVolume -> TrailingVolume -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrailingVolume -> TrailingVolume -> Bool
$c/= :: TrailingVolume -> TrailingVolume -> Bool
== :: TrailingVolume -> TrailingVolume -> Bool
$c== :: TrailingVolume -> TrailingVolume -> Bool
Eq, Int -> TrailingVolume -> ShowS
[TrailingVolume] -> ShowS
TrailingVolume -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrailingVolume] -> ShowS
$cshowList :: [TrailingVolume] -> ShowS
show :: TrailingVolume -> String
$cshow :: TrailingVolume -> String
showsPrec :: Int -> TrailingVolume -> ShowS
$cshowsPrec :: Int -> TrailingVolume -> ShowS
Show)


deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''TrailingVolume


data AccountHistoryType = Transfer | Match | Fee | Rebate | Conversion
    deriving (AccountHistoryType -> AccountHistoryType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountHistoryType -> AccountHistoryType -> Bool
$c/= :: AccountHistoryType -> AccountHistoryType -> Bool
== :: AccountHistoryType -> AccountHistoryType -> Bool
$c== :: AccountHistoryType -> AccountHistoryType -> Bool
Eq, Int -> AccountHistoryType -> ShowS
[AccountHistoryType] -> ShowS
AccountHistoryType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountHistoryType] -> ShowS
$cshowList :: [AccountHistoryType] -> ShowS
show :: AccountHistoryType -> String
$cshow :: AccountHistoryType -> String
showsPrec :: Int -> AccountHistoryType -> ShowS
$cshowsPrec :: Int -> AccountHistoryType -> ShowS
Show)


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


data Details = Details
    { Details -> Maybe OrderId
dOrderId   :: Maybe OrderId
    , Details -> Maybe TradeId
dTradeId   :: Maybe TradeId
    , Details -> Maybe ProductId
dProductId :: Maybe ProductId
    } deriving (Details -> Details -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Details -> Details -> Bool
$c/= :: Details -> Details -> Bool
== :: Details -> Details -> Bool
$c== :: Details -> Details -> Bool
Eq, Int -> Details -> ShowS
[Details] -> ShowS
Details -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Details] -> ShowS
$cshowList :: [Details] -> ShowS
show :: Details -> String
$cshow :: Details -> String
showsPrec :: Int -> Details -> ShowS
$cshowsPrec :: Int -> Details -> ShowS
Show)


instance FromJSON Details where
    parseJSON :: Value -> Parser Details
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"details" forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe OrderId -> Maybe TradeId -> Maybe ProductId -> Details
Details
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"order_id")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> TradeId
TradeId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"trade_id")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"product_id")


data AccountHistory = AccountHistory
    { AccountHistory -> AccountId
hAccountId :: AccountId
    , AccountHistory -> CreatedAt
hCreatedAt :: CreatedAt
    , AccountHistory -> Double
hAmount    :: Double
    , AccountHistory -> Balance
hBalance   :: Balance
    , AccountHistory -> AccountHistoryType
hType      :: AccountHistoryType
    , AccountHistory -> Maybe Details
hDetails   :: Maybe Details
    } deriving (AccountHistory -> AccountHistory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountHistory -> AccountHistory -> Bool
$c/= :: AccountHistory -> AccountHistory -> Bool
== :: AccountHistory -> AccountHistory -> Bool
$c== :: AccountHistory -> AccountHistory -> Bool
Eq, Int -> AccountHistory -> ShowS
[AccountHistory] -> ShowS
AccountHistory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountHistory] -> ShowS
$cshowList :: [AccountHistory] -> ShowS
show :: AccountHistory -> String
$cshow :: AccountHistory -> String
showsPrec :: Int -> AccountHistory -> ShowS
$cshowsPrec :: Int -> AccountHistory -> ShowS
Show)


instance FromJSON AccountHistory where
    parseJSON :: Value -> Parser AccountHistory
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"account_history" forall a b. (a -> b) -> a -> b
$ \Object
o -> AccountId
-> CreatedAt
-> Double
-> Balance
-> AccountHistoryType
-> Maybe Details
-> AccountHistory
AccountHistory
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> AccountId
AccountId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (UTCTime -> CreatedAt
CreatedAt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"amount")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Double -> Balance
Balance forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"balance")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"details")


newtype HoldId = HoldId Text
  deriving (HoldId -> HoldId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HoldId -> HoldId -> Bool
$c/= :: HoldId -> HoldId -> Bool
== :: HoldId -> HoldId -> Bool
$c== :: HoldId -> HoldId -> Bool
Eq, Int -> HoldId -> ShowS
[HoldId] -> ShowS
HoldId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HoldId] -> ShowS
$cshowList :: [HoldId] -> ShowS
show :: HoldId -> String
$cshow :: HoldId -> String
showsPrec :: Int -> HoldId -> ShowS
$cshowsPrec :: Int -> HoldId -> ShowS
Show, [HoldId] -> Encoding
[HoldId] -> Value
HoldId -> Encoding
HoldId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [HoldId] -> Encoding
$ctoEncodingList :: [HoldId] -> Encoding
toJSONList :: [HoldId] -> Value
$ctoJSONList :: [HoldId] -> Value
toEncoding :: HoldId -> Encoding
$ctoEncoding :: HoldId -> Encoding
toJSON :: HoldId -> Value
$ctoJSON :: HoldId -> Value
ToJSON, Value -> Parser [HoldId]
Value -> Parser HoldId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [HoldId]
$cparseJSONList :: Value -> Parser [HoldId]
parseJSON :: Value -> Parser HoldId
$cparseJSON :: Value -> Parser HoldId
FromJSON)


data HoldType = Order | HoldTransfer
  deriving (HoldType -> HoldType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HoldType -> HoldType -> Bool
$c/= :: HoldType -> HoldType -> Bool
== :: HoldType -> HoldType -> Bool
$c== :: HoldType -> HoldType -> Bool
Eq, Int -> HoldType -> ShowS
[HoldType] -> ShowS
HoldType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HoldType] -> ShowS
$cshowList :: [HoldType] -> ShowS
show :: HoldType -> String
$cshow :: HoldType -> String
showsPrec :: Int -> HoldType -> ShowS
$cshowsPrec :: Int -> HoldType -> ShowS
Show)


newtype HoldRef = HoldRef Text
  deriving (HoldRef -> HoldRef -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HoldRef -> HoldRef -> Bool
$c/= :: HoldRef -> HoldRef -> Bool
== :: HoldRef -> HoldRef -> Bool
$c== :: HoldRef -> HoldRef -> Bool
Eq, Int -> HoldRef -> ShowS
[HoldRef] -> ShowS
HoldRef -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HoldRef] -> ShowS
$cshowList :: [HoldRef] -> ShowS
show :: HoldRef -> String
$cshow :: HoldRef -> String
showsPrec :: Int -> HoldRef -> ShowS
$cshowsPrec :: Int -> HoldRef -> ShowS
Show, [HoldRef] -> Encoding
[HoldRef] -> Value
HoldRef -> Encoding
HoldRef -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [HoldRef] -> Encoding
$ctoEncodingList :: [HoldRef] -> Encoding
toJSONList :: [HoldRef] -> Value
$ctoJSONList :: [HoldRef] -> Value
toEncoding :: HoldRef -> Encoding
$ctoEncoding :: HoldRef -> Encoding
toJSON :: HoldRef -> Value
$ctoJSON :: HoldRef -> Value
ToJSON, Value -> Parser [HoldRef]
Value -> Parser HoldRef
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [HoldRef]
$cparseJSONList :: Value -> Parser [HoldRef]
parseJSON :: Value -> Parser HoldRef
$cparseJSON :: Value -> Parser HoldRef
FromJSON)


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


data Hold = Hold
    { Hold -> HoldId
holdId        :: HoldId
    , Hold -> AccountId
holdAccountId :: AccountId
    , Hold -> CreatedAt
holdCreatedAt :: CreatedAt
    , Hold -> CreatedAt
holdUpdatedAt :: CreatedAt
    , Hold -> Double
holdAmount    :: Double
    , Hold -> HoldType
holdType      :: HoldType
    , Hold -> HoldRef
holdRef       :: HoldRef
    } deriving (Hold -> Hold -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hold -> Hold -> Bool
$c/= :: Hold -> Hold -> Bool
== :: Hold -> Hold -> Bool
$c== :: Hold -> Hold -> Bool
Eq, Int -> Hold -> ShowS
[Hold] -> ShowS
Hold -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hold] -> ShowS
$cshowList :: [Hold] -> ShowS
show :: Hold -> String
$cshow :: Hold -> String
showsPrec :: Int -> Hold -> ShowS
$cshowsPrec :: Int -> Hold -> ShowS
Show)


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