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

module CoinbasePro.Types
    ( OrderId (..)
    , ClientOrderId (..)
    , Price (..)
    , ProductId (..)
    , Sequence
    , UserId
    , ProfileId
    , Side (..)
    , Size (..)
    , Volume (..)
    , TradeId (..)
    , Funds (..)
    , OrderType (..)
    , CreatedAt (..)
    , Candle (..)
    , CandleGranularity (..)
    , TwentyFourHourStats (..)
    , CurrencyType (..)
    , Currency (..)
    , CryptoAddress (..)

    , filterOrderFieldName
    ) where

import           Data.Aeson            (FromJSON, FromJSONKey, ToJSON,
                                        ToJSONKey, parseJSON, toJSON, withArray,
                                        withObject, withText, (.:), (.:?))
import qualified Data.Aeson            as A
import           Data.Aeson.Casing     (camelCase, snakeCase)
import           Data.Aeson.TH         (constructorTagModifier, defaultOptions,
                                        deriveJSON, fieldLabelModifier,
                                        unwrapUnaryRecords)
import           Data.Text             (Text, pack, toLower, unpack)
import           Data.Time.Clock       (UTCTime)
import           Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import           Data.UUID             (UUID, toString, toText)
import qualified Data.Vector           as V
import           Servant.API
import           Text.Printf           (printf)


type UserId    = Text
type ProfileId = Text
type Sequence  = Int


data Side = Buy | Sell
    deriving (Side -> Side -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Side -> Side -> Bool
$c/= :: Side -> Side -> Bool
== :: Side -> Side -> Bool
$c== :: Side -> Side -> Bool
Eq, Eq Side
Side -> Side -> Bool
Side -> Side -> Ordering
Side -> Side -> Side
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 :: Side -> Side -> Side
$cmin :: Side -> Side -> Side
max :: Side -> Side -> Side
$cmax :: Side -> Side -> Side
>= :: Side -> Side -> Bool
$c>= :: Side -> Side -> Bool
> :: Side -> Side -> Bool
$c> :: Side -> Side -> Bool
<= :: Side -> Side -> Bool
$c<= :: Side -> Side -> Bool
< :: Side -> Side -> Bool
$c< :: Side -> Side -> Bool
compare :: Side -> Side -> Ordering
$ccompare :: Side -> Side -> Ordering
Ord, Int -> Side -> ShowS
[Side] -> ShowS
Side -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Side] -> ShowS
$cshowList :: [Side] -> ShowS
show :: Side -> String
$cshow :: Side -> String
showsPrec :: Int -> Side -> ShowS
$cshowsPrec :: Int -> Side -> ShowS
Show)


instance ToHttpApiData Side where
    toUrlPiece :: Side -> Text
toUrlPiece   = Text -> Text
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
    toQueryParam :: Side -> Text
toQueryParam = Text -> Text
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


deriveJSON defaultOptions
    { constructorTagModifier = camelCase
    , fieldLabelModifier     = snakeCase
    } ''Side


newtype OrderId = OrderId { OrderId -> Text
unOrderId :: Text }
    deriving (OrderId -> OrderId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderId -> OrderId -> Bool
$c/= :: OrderId -> OrderId -> Bool
== :: OrderId -> OrderId -> Bool
$c== :: OrderId -> OrderId -> Bool
Eq, Eq OrderId
OrderId -> OrderId -> Bool
OrderId -> OrderId -> Ordering
OrderId -> OrderId -> OrderId
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 :: OrderId -> OrderId -> OrderId
$cmin :: OrderId -> OrderId -> OrderId
max :: OrderId -> OrderId -> OrderId
$cmax :: OrderId -> OrderId -> OrderId
>= :: OrderId -> OrderId -> Bool
$c>= :: OrderId -> OrderId -> Bool
> :: OrderId -> OrderId -> Bool
$c> :: OrderId -> OrderId -> Bool
<= :: OrderId -> OrderId -> Bool
$c<= :: OrderId -> OrderId -> Bool
< :: OrderId -> OrderId -> Bool
$c< :: OrderId -> OrderId -> Bool
compare :: OrderId -> OrderId -> Ordering
$ccompare :: OrderId -> OrderId -> Ordering
Ord, OrderId -> ByteString
OrderId -> Builder
OrderId -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: OrderId -> Text
$ctoQueryParam :: OrderId -> Text
toHeader :: OrderId -> ByteString
$ctoHeader :: OrderId -> ByteString
toEncodedUrlPiece :: OrderId -> Builder
$ctoEncodedUrlPiece :: OrderId -> Builder
toUrlPiece :: OrderId -> Text
$ctoUrlPiece :: OrderId -> Text
ToHttpApiData)


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


deriveJSON defaultOptions
    { fieldLabelModifier = snakeCase
    , unwrapUnaryRecords = True
    } ''OrderId


newtype ClientOrderId = ClientOrderId { ClientOrderId -> UUID
unClientOrderId :: UUID }
    deriving (ClientOrderId -> ClientOrderId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientOrderId -> ClientOrderId -> Bool
$c/= :: ClientOrderId -> ClientOrderId -> Bool
== :: ClientOrderId -> ClientOrderId -> Bool
$c== :: ClientOrderId -> ClientOrderId -> Bool
Eq, Eq ClientOrderId
ClientOrderId -> ClientOrderId -> Bool
ClientOrderId -> ClientOrderId -> Ordering
ClientOrderId -> ClientOrderId -> ClientOrderId
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 :: ClientOrderId -> ClientOrderId -> ClientOrderId
$cmin :: ClientOrderId -> ClientOrderId -> ClientOrderId
max :: ClientOrderId -> ClientOrderId -> ClientOrderId
$cmax :: ClientOrderId -> ClientOrderId -> ClientOrderId
>= :: ClientOrderId -> ClientOrderId -> Bool
$c>= :: ClientOrderId -> ClientOrderId -> Bool
> :: ClientOrderId -> ClientOrderId -> Bool
$c> :: ClientOrderId -> ClientOrderId -> Bool
<= :: ClientOrderId -> ClientOrderId -> Bool
$c<= :: ClientOrderId -> ClientOrderId -> Bool
< :: ClientOrderId -> ClientOrderId -> Bool
$c< :: ClientOrderId -> ClientOrderId -> Bool
compare :: ClientOrderId -> ClientOrderId -> Ordering
$ccompare :: ClientOrderId -> ClientOrderId -> Ordering
Ord)


instance Show ClientOrderId where
  show :: ClientOrderId -> String
show (ClientOrderId UUID
t) = UUID -> String
toString UUID
t


instance ToHttpApiData ClientOrderId where
    toUrlPiece :: ClientOrderId -> Text
toUrlPiece = (Text
"client:" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientOrderId -> UUID
unClientOrderId


deriveJSON defaultOptions
    { unwrapUnaryRecords = True
    } ''ClientOrderId


newtype ProductId = ProductId { ProductId -> Text
unProductId :: Text }
    deriving (ProductId -> ProductId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProductId -> ProductId -> Bool
$c/= :: ProductId -> ProductId -> Bool
== :: ProductId -> ProductId -> Bool
$c== :: ProductId -> ProductId -> Bool
Eq, Eq ProductId
ProductId -> ProductId -> Bool
ProductId -> ProductId -> Ordering
ProductId -> ProductId -> ProductId
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 :: ProductId -> ProductId -> ProductId
$cmin :: ProductId -> ProductId -> ProductId
max :: ProductId -> ProductId -> ProductId
$cmax :: ProductId -> ProductId -> ProductId
>= :: ProductId -> ProductId -> Bool
$c>= :: ProductId -> ProductId -> Bool
> :: ProductId -> ProductId -> Bool
$c> :: ProductId -> ProductId -> Bool
<= :: ProductId -> ProductId -> Bool
$c<= :: ProductId -> ProductId -> Bool
< :: ProductId -> ProductId -> Bool
$c< :: ProductId -> ProductId -> Bool
compare :: ProductId -> ProductId -> Ordering
$ccompare :: ProductId -> ProductId -> Ordering
Ord, ProductId -> ByteString
ProductId -> Builder
ProductId -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: ProductId -> Text
$ctoQueryParam :: ProductId -> Text
toHeader :: ProductId -> ByteString
$ctoHeader :: ProductId -> ByteString
toEncodedUrlPiece :: ProductId -> Builder
$ctoEncodedUrlPiece :: ProductId -> Builder
toUrlPiece :: ProductId -> Text
$ctoUrlPiece :: ProductId -> Text
ToHttpApiData, ToJSONKeyFunction [ProductId]
ToJSONKeyFunction ProductId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [ProductId]
$ctoJSONKeyList :: ToJSONKeyFunction [ProductId]
toJSONKey :: ToJSONKeyFunction ProductId
$ctoJSONKey :: ToJSONKeyFunction ProductId
ToJSONKey, FromJSONKeyFunction [ProductId]
FromJSONKeyFunction ProductId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [ProductId]
$cfromJSONKeyList :: FromJSONKeyFunction [ProductId]
fromJSONKey :: FromJSONKeyFunction ProductId
$cfromJSONKey :: FromJSONKeyFunction ProductId
FromJSONKey)


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


deriveJSON defaultOptions
    { fieldLabelModifier = snakeCase
    , unwrapUnaryRecords = True
    } ''ProductId


newtype Price = Price { Price -> Double
unPrice :: Double }
    deriving (Price -> Price -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Price -> Price -> Bool
$c/= :: Price -> Price -> Bool
== :: Price -> Price -> Bool
$c== :: Price -> Price -> Bool
Eq, Eq Price
Price -> Price -> Bool
Price -> Price -> Ordering
Price -> Price -> Price
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 :: Price -> Price -> Price
$cmin :: Price -> Price -> Price
max :: Price -> Price -> Price
$cmax :: Price -> Price -> Price
>= :: Price -> Price -> Bool
$c>= :: Price -> Price -> Bool
> :: Price -> Price -> Bool
$c> :: Price -> Price -> Bool
<= :: Price -> Price -> Bool
$c<= :: Price -> Price -> Bool
< :: Price -> Price -> Bool
$c< :: Price -> Price -> Bool
compare :: Price -> Price -> Ordering
$ccompare :: Price -> Price -> Ordering
Ord, Integer -> Price
Price -> Price
Price -> Price -> Price
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Price
$cfromInteger :: Integer -> Price
signum :: Price -> Price
$csignum :: Price -> Price
abs :: Price -> Price
$cabs :: Price -> Price
negate :: Price -> Price
$cnegate :: Price -> Price
* :: Price -> Price -> Price
$c* :: Price -> Price -> Price
- :: Price -> Price -> Price
$c- :: Price -> Price -> Price
+ :: Price -> Price -> Price
$c+ :: Price -> Price -> Price
Num, Price -> ByteString
Price -> Builder
Price -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: Price -> Text
$ctoQueryParam :: Price -> Text
toHeader :: Price -> ByteString
$ctoHeader :: Price -> ByteString
toEncodedUrlPiece :: Price -> Builder
$ctoEncodedUrlPiece :: Price -> Builder
toUrlPiece :: Price -> Text
$ctoUrlPiece :: Price -> Text
ToHttpApiData)


instance Show Price where
  show :: Price -> String
show (Price Double
d) = forall r. PrintfType r => String -> r
printf String
"%.8f" Double
d


instance FromJSON Price where
    parseJSON :: Value -> Parser Price
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"price" 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 -> Price
Price 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


instance ToJSON Price where
    toJSON :: Price -> Value
toJSON = Text -> Value
A.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


newtype Size = Size { Size -> Double
unSize :: Double }
    deriving (Size -> Size -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c== :: Size -> Size -> Bool
Eq, Eq Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
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 :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmax :: Size -> Size -> Size
>= :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c< :: Size -> Size -> Bool
compare :: Size -> Size -> Ordering
$ccompare :: Size -> Size -> Ordering
Ord, Integer -> Size
Size -> Size
Size -> Size -> Size
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Size
$cfromInteger :: Integer -> Size
signum :: Size -> Size
$csignum :: Size -> Size
abs :: Size -> Size
$cabs :: Size -> Size
negate :: Size -> Size
$cnegate :: Size -> Size
* :: Size -> Size -> Size
$c* :: Size -> Size -> Size
- :: Size -> Size -> Size
$c- :: Size -> Size -> Size
+ :: Size -> Size -> Size
$c+ :: Size -> Size -> Size
Num, Size -> ByteString
Size -> Builder
Size -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: Size -> Text
$ctoQueryParam :: Size -> Text
toHeader :: Size -> ByteString
$ctoHeader :: Size -> ByteString
toEncodedUrlPiece :: Size -> Builder
$ctoEncodedUrlPiece :: Size -> Builder
toUrlPiece :: Size -> Text
$ctoUrlPiece :: Size -> Text
ToHttpApiData)


instance Show Size where
  show :: Size -> String
show (Size Double
d) = forall r. PrintfType r => String -> r
printf String
"%.8f" Double
d


instance ToJSON Size where
    toJSON :: Size -> Value
toJSON = Text -> Value
A.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


instance FromJSON Size where
    parseJSON :: Value -> Parser Size
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"size" 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 -> Size
Size 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 Volume = Volume { Volume -> Double
unVolume :: Double }
    deriving (Volume -> Volume -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Volume -> Volume -> Bool
$c/= :: Volume -> Volume -> Bool
== :: Volume -> Volume -> Bool
$c== :: Volume -> Volume -> Bool
Eq, Eq Volume
Volume -> Volume -> Bool
Volume -> Volume -> Ordering
Volume -> Volume -> Volume
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 :: Volume -> Volume -> Volume
$cmin :: Volume -> Volume -> Volume
max :: Volume -> Volume -> Volume
$cmax :: Volume -> Volume -> Volume
>= :: Volume -> Volume -> Bool
$c>= :: Volume -> Volume -> Bool
> :: Volume -> Volume -> Bool
$c> :: Volume -> Volume -> Bool
<= :: Volume -> Volume -> Bool
$c<= :: Volume -> Volume -> Bool
< :: Volume -> Volume -> Bool
$c< :: Volume -> Volume -> Bool
compare :: Volume -> Volume -> Ordering
$ccompare :: Volume -> Volume -> Ordering
Ord)


instance Show Volume where
  show :: Volume -> String
show (Volume Double
d) = forall r. PrintfType r => String -> r
printf String
"%.8f" Double
d


instance FromJSON Volume where
    parseJSON :: Value -> Parser Volume
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"volume" 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 -> Volume
Volume 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


instance ToJSON Volume where
    toJSON :: Volume -> Value
toJSON = Text -> Value
A.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


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


deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''TradeId


newtype Funds = Funds Double
    deriving (Funds -> Funds -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Funds -> Funds -> Bool
$c/= :: Funds -> Funds -> Bool
== :: Funds -> Funds -> Bool
$c== :: Funds -> Funds -> Bool
Eq, Eq Funds
Funds -> Funds -> Bool
Funds -> Funds -> Ordering
Funds -> Funds -> Funds
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 :: Funds -> Funds -> Funds
$cmin :: Funds -> Funds -> Funds
max :: Funds -> Funds -> Funds
$cmax :: Funds -> Funds -> Funds
>= :: Funds -> Funds -> Bool
$c>= :: Funds -> Funds -> Bool
> :: Funds -> Funds -> Bool
$c> :: Funds -> Funds -> Bool
<= :: Funds -> Funds -> Bool
$c<= :: Funds -> Funds -> Bool
< :: Funds -> Funds -> Bool
$c< :: Funds -> Funds -> Bool
compare :: Funds -> Funds -> Ordering
$ccompare :: Funds -> Funds -> Ordering
Ord, Funds -> ByteString
Funds -> Builder
Funds -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: Funds -> Text
$ctoQueryParam :: Funds -> Text
toHeader :: Funds -> ByteString
$ctoHeader :: Funds -> ByteString
toEncodedUrlPiece :: Funds -> Builder
$ctoEncodedUrlPiece :: Funds -> Builder
toUrlPiece :: Funds -> Text
$ctoUrlPiece :: Funds -> Text
ToHttpApiData)


instance Show Funds where
  show :: Funds -> String
show (Funds Double
d) = forall r. PrintfType r => String -> r
printf String
"%.16f" Double
d


instance ToJSON Funds where
    toJSON :: Funds -> Value
toJSON = Text -> Value
A.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


instance FromJSON Funds where
    parseJSON :: Value -> Parser Funds
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"funds" 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 -> Funds
Funds 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


data OrderType = Limit | Market
    deriving (OrderType -> OrderType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderType -> OrderType -> Bool
$c/= :: OrderType -> OrderType -> Bool
== :: OrderType -> OrderType -> Bool
$c== :: OrderType -> OrderType -> Bool
Eq, Eq OrderType
OrderType -> OrderType -> Bool
OrderType -> OrderType -> Ordering
OrderType -> OrderType -> OrderType
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 :: OrderType -> OrderType -> OrderType
$cmin :: OrderType -> OrderType -> OrderType
max :: OrderType -> OrderType -> OrderType
$cmax :: OrderType -> OrderType -> OrderType
>= :: OrderType -> OrderType -> Bool
$c>= :: OrderType -> OrderType -> Bool
> :: OrderType -> OrderType -> Bool
$c> :: OrderType -> OrderType -> Bool
<= :: OrderType -> OrderType -> Bool
$c<= :: OrderType -> OrderType -> Bool
< :: OrderType -> OrderType -> Bool
$c< :: OrderType -> OrderType -> Bool
compare :: OrderType -> OrderType -> Ordering
$ccompare :: OrderType -> OrderType -> Ordering
Ord, Int -> OrderType -> ShowS
[OrderType] -> ShowS
OrderType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrderType] -> ShowS
$cshowList :: [OrderType] -> ShowS
show :: OrderType -> String
$cshow :: OrderType -> String
showsPrec :: Int -> OrderType -> ShowS
$cshowsPrec :: Int -> OrderType -> ShowS
Show)


instance ToHttpApiData OrderType where
    toUrlPiece :: OrderType -> Text
toUrlPiece   = Text -> Text
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
    toQueryParam :: OrderType -> Text
toQueryParam = Text -> Text
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


deriveJSON defaultOptions {constructorTagModifier = camelCase} ''OrderType


newtype CreatedAt = CreatedAt UTCTime
    deriving (CreatedAt -> CreatedAt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatedAt -> CreatedAt -> Bool
$c/= :: CreatedAt -> CreatedAt -> Bool
== :: CreatedAt -> CreatedAt -> Bool
$c== :: CreatedAt -> CreatedAt -> Bool
Eq, Int -> CreatedAt -> ShowS
[CreatedAt] -> ShowS
CreatedAt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatedAt] -> ShowS
$cshowList :: [CreatedAt] -> ShowS
show :: CreatedAt -> String
$cshow :: CreatedAt -> String
showsPrec :: Int -> CreatedAt -> ShowS
$cshowsPrec :: Int -> CreatedAt -> ShowS
Show, Eq CreatedAt
CreatedAt -> CreatedAt -> Bool
CreatedAt -> CreatedAt -> Ordering
CreatedAt -> CreatedAt -> CreatedAt
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 :: CreatedAt -> CreatedAt -> CreatedAt
$cmin :: CreatedAt -> CreatedAt -> CreatedAt
max :: CreatedAt -> CreatedAt -> CreatedAt
$cmax :: CreatedAt -> CreatedAt -> CreatedAt
>= :: CreatedAt -> CreatedAt -> Bool
$c>= :: CreatedAt -> CreatedAt -> Bool
> :: CreatedAt -> CreatedAt -> Bool
$c> :: CreatedAt -> CreatedAt -> Bool
<= :: CreatedAt -> CreatedAt -> Bool
$c<= :: CreatedAt -> CreatedAt -> Bool
< :: CreatedAt -> CreatedAt -> Bool
$c< :: CreatedAt -> CreatedAt -> Bool
compare :: CreatedAt -> CreatedAt -> Ordering
$ccompare :: CreatedAt -> CreatedAt -> Ordering
Ord)


deriveJSON defaultOptions ''CreatedAt


filterOrderFieldName :: String -> String
filterOrderFieldName :: ShowS
filterOrderFieldName String
"order_type" = String
"type"
filterOrderFieldName String
s            = String
s


data Candle = Candle
    { Candle -> UTCTime
time   :: UTCTime
    , Candle -> Price
low    :: Price
    , Candle -> Price
high   :: Price
    , Candle -> Price
open   :: Price
    , Candle -> Price
close  :: Price
    , Candle -> Double
volume :: Double
    } deriving (Candle -> Candle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Candle -> Candle -> Bool
$c/= :: Candle -> Candle -> Bool
== :: Candle -> Candle -> Bool
$c== :: Candle -> Candle -> Bool
Eq, Int -> Candle -> ShowS
[Candle] -> ShowS
Candle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Candle] -> ShowS
$cshowList :: [Candle] -> ShowS
show :: Candle -> String
$cshow :: Candle -> String
showsPrec :: Int -> Candle -> ShowS
$cshowsPrec :: Int -> Candle -> ShowS
Show)


instance FromJSON Candle where
    parseJSON :: Value -> Parser Candle
parseJSON = forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"candle" forall a b. (a -> b) -> a -> b
$ \Array
a -> do
      let l :: [Value]
l = forall a. Vector a -> [a]
V.toList Array
a
      UTCTime
t  <- POSIXTime -> UTCTime
posixSecondsToUTCTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (forall a. [a] -> a
head [Value]
l)
      Price
lw <- Double -> Price
Price forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON ([Value]
l forall a. [a] -> Int -> a
!! Int
1)
      Price
h  <- Double -> Price
Price forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON ([Value]
l forall a. [a] -> Int -> a
!! Int
2)
      Price
o  <- Double -> Price
Price forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON ([Value]
l forall a. [a] -> Int -> a
!! Int
3)
      Price
c  <- Double -> Price
Price forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON ([Value]
l forall a. [a] -> Int -> a
!! Int
4)
      Double
v  <- forall a. FromJSON a => Value -> Parser a
parseJSON forall a b. (a -> b) -> a -> b
$ [Value]
l forall a. [a] -> Int -> a
!! Int
5
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UTCTime -> Price -> Price -> Price -> Price -> Double -> Candle
Candle UTCTime
t Price
lw Price
h Price
o Price
c Double
v


data CandleGranularity = Minute | FiveMinutes | FifteenMinutes | Hour | SixHours | Day
    deriving (CandleGranularity -> CandleGranularity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CandleGranularity -> CandleGranularity -> Bool
$c/= :: CandleGranularity -> CandleGranularity -> Bool
== :: CandleGranularity -> CandleGranularity -> Bool
$c== :: CandleGranularity -> CandleGranularity -> Bool
Eq, Eq CandleGranularity
CandleGranularity -> CandleGranularity -> Bool
CandleGranularity -> CandleGranularity -> Ordering
CandleGranularity -> CandleGranularity -> CandleGranularity
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 :: CandleGranularity -> CandleGranularity -> CandleGranularity
$cmin :: CandleGranularity -> CandleGranularity -> CandleGranularity
max :: CandleGranularity -> CandleGranularity -> CandleGranularity
$cmax :: CandleGranularity -> CandleGranularity -> CandleGranularity
>= :: CandleGranularity -> CandleGranularity -> Bool
$c>= :: CandleGranularity -> CandleGranularity -> Bool
> :: CandleGranularity -> CandleGranularity -> Bool
$c> :: CandleGranularity -> CandleGranularity -> Bool
<= :: CandleGranularity -> CandleGranularity -> Bool
$c<= :: CandleGranularity -> CandleGranularity -> Bool
< :: CandleGranularity -> CandleGranularity -> Bool
$c< :: CandleGranularity -> CandleGranularity -> Bool
compare :: CandleGranularity -> CandleGranularity -> Ordering
$ccompare :: CandleGranularity -> CandleGranularity -> Ordering
Ord, Int -> CandleGranularity -> ShowS
[CandleGranularity] -> ShowS
CandleGranularity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CandleGranularity] -> ShowS
$cshowList :: [CandleGranularity] -> ShowS
show :: CandleGranularity -> String
$cshow :: CandleGranularity -> String
showsPrec :: Int -> CandleGranularity -> ShowS
$cshowsPrec :: Int -> CandleGranularity -> ShowS
Show)


instance ToHttpApiData CandleGranularity where
    toUrlPiece :: CandleGranularity -> Text
toUrlPiece CandleGranularity
Minute         = Text
"60"
    toUrlPiece CandleGranularity
FiveMinutes    = Text
"300"
    toUrlPiece CandleGranularity
FifteenMinutes = Text
"900"
    toUrlPiece CandleGranularity
Hour           = Text
"3600"
    toUrlPiece CandleGranularity
SixHours       = Text
"21600"
    toUrlPiece CandleGranularity
Day            = Text
"86400"

    toQueryParam :: CandleGranularity -> Text
toQueryParam CandleGranularity
Minute         = Text
"60"
    toQueryParam CandleGranularity
FiveMinutes    = Text
"300"
    toQueryParam CandleGranularity
FifteenMinutes = Text
"900"
    toQueryParam CandleGranularity
Hour           = Text
"3600"
    toQueryParam CandleGranularity
SixHours       = Text
"21600"
    toQueryParam CandleGranularity
Day            = Text
"86400"


data TwentyFourHourStats = TwentyFourHourStats
    { TwentyFourHourStats -> Price
open24   :: Price
    , TwentyFourHourStats -> Price
high24   :: Price
    , TwentyFourHourStats -> Price
low24    :: Price
    , TwentyFourHourStats -> Volume
volume24 :: Volume
    , TwentyFourHourStats -> Price
last24   :: Price
    , TwentyFourHourStats -> Volume
volume30 :: Volume
    } deriving (TwentyFourHourStats -> TwentyFourHourStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TwentyFourHourStats -> TwentyFourHourStats -> Bool
$c/= :: TwentyFourHourStats -> TwentyFourHourStats -> Bool
== :: TwentyFourHourStats -> TwentyFourHourStats -> Bool
$c== :: TwentyFourHourStats -> TwentyFourHourStats -> Bool
Eq, Int -> TwentyFourHourStats -> ShowS
[TwentyFourHourStats] -> ShowS
TwentyFourHourStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TwentyFourHourStats] -> ShowS
$cshowList :: [TwentyFourHourStats] -> ShowS
show :: TwentyFourHourStats -> String
$cshow :: TwentyFourHourStats -> String
showsPrec :: Int -> TwentyFourHourStats -> ShowS
$cshowsPrec :: Int -> TwentyFourHourStats -> ShowS
Show)


deriveJSON defaultOptions { fieldLabelModifier = init . init } ''TwentyFourHourStats


data CurrencyDetails = CurrencyDetails
    { CurrencyDetails -> Text
cdType               :: Text
    , CurrencyDetails -> Maybe Text
symbol               :: Maybe Text
    , CurrencyDetails -> Maybe Int
networkConfirmations :: Maybe Int
    , CurrencyDetails -> Maybe Int
sortOrder            :: Maybe Int
    , CurrencyDetails -> Maybe Text
cryptoAddressLink    :: Maybe Text
    , CurrencyDetails -> [Text]
pushPaymentMethods   :: [Text]
    , CurrencyDetails -> Maybe [Text]
groupTypes           :: Maybe [Text]
    , CurrencyDetails -> Maybe Double
maxPrecision         :: Maybe Double
    , CurrencyDetails -> Maybe Double
maxWithdrawalAmount  :: Maybe Double
    } deriving (CurrencyDetails -> CurrencyDetails -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CurrencyDetails -> CurrencyDetails -> Bool
$c/= :: CurrencyDetails -> CurrencyDetails -> Bool
== :: CurrencyDetails -> CurrencyDetails -> Bool
$c== :: CurrencyDetails -> CurrencyDetails -> Bool
Eq, Int -> CurrencyDetails -> ShowS
[CurrencyDetails] -> ShowS
CurrencyDetails -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CurrencyDetails] -> ShowS
$cshowList :: [CurrencyDetails] -> ShowS
show :: CurrencyDetails -> String
$cshow :: CurrencyDetails -> String
showsPrec :: Int -> CurrencyDetails -> ShowS
$cshowsPrec :: Int -> CurrencyDetails -> ShowS
Show)


instance FromJSON CurrencyDetails where
    parseJSON :: Value -> Parser CurrencyDetails
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"currency details" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> [Text]
-> Maybe [Text]
-> Maybe Double
-> Maybe Double
-> CurrencyDetails
CurrencyDetails
        forall (f :: * -> *) a b. Functor 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 (Maybe a)
.:? Key
"symbol"
        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
"network_confirmations"
        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
"set_order"
        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
"crypto_address_link"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"push_payment_methods"
        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
"group_types"
        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
"max_precision"
        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
"max_withdrawal_amount"


newtype CurrencyType = CurrencyType Text
    deriving (CurrencyType -> CurrencyType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CurrencyType -> CurrencyType -> Bool
$c/= :: CurrencyType -> CurrencyType -> Bool
== :: CurrencyType -> CurrencyType -> Bool
$c== :: CurrencyType -> CurrencyType -> Bool
Eq, Eq CurrencyType
CurrencyType -> CurrencyType -> Bool
CurrencyType -> CurrencyType -> Ordering
CurrencyType -> CurrencyType -> CurrencyType
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 :: CurrencyType -> CurrencyType -> CurrencyType
$cmin :: CurrencyType -> CurrencyType -> CurrencyType
max :: CurrencyType -> CurrencyType -> CurrencyType
$cmax :: CurrencyType -> CurrencyType -> CurrencyType
>= :: CurrencyType -> CurrencyType -> Bool
$c>= :: CurrencyType -> CurrencyType -> Bool
> :: CurrencyType -> CurrencyType -> Bool
$c> :: CurrencyType -> CurrencyType -> Bool
<= :: CurrencyType -> CurrencyType -> Bool
$c<= :: CurrencyType -> CurrencyType -> Bool
< :: CurrencyType -> CurrencyType -> Bool
$c< :: CurrencyType -> CurrencyType -> Bool
compare :: CurrencyType -> CurrencyType -> Ordering
$ccompare :: CurrencyType -> CurrencyType -> Ordering
Ord, CurrencyType -> ByteString
CurrencyType -> Builder
CurrencyType -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: CurrencyType -> Text
$ctoQueryParam :: CurrencyType -> Text
toHeader :: CurrencyType -> ByteString
$ctoHeader :: CurrencyType -> ByteString
toEncodedUrlPiece :: CurrencyType -> Builder
$ctoEncodedUrlPiece :: CurrencyType -> Builder
toUrlPiece :: CurrencyType -> Text
$ctoUrlPiece :: CurrencyType -> Text
ToHttpApiData, FromJSONKeyFunction [CurrencyType]
FromJSONKeyFunction CurrencyType
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [CurrencyType]
$cfromJSONKeyList :: FromJSONKeyFunction [CurrencyType]
fromJSONKey :: FromJSONKeyFunction CurrencyType
$cfromJSONKey :: FromJSONKeyFunction CurrencyType
FromJSONKey)


instance Show CurrencyType where
    show :: CurrencyType -> String
show (CurrencyType Text
c) = Text -> String
unpack Text
c


deriveJSON defaultOptions
    { fieldLabelModifier = snakeCase
    , unwrapUnaryRecords = True
    } ''CurrencyType


data Currency = Currency
    { Currency -> Text
id      :: Text
    , Currency -> Text
name    :: Text
    , Currency -> Double
minSize :: Double
    , Currency -> Text
status  :: Text
    , Currency -> Maybe Text
message :: Maybe Text
    , Currency -> CurrencyDetails
details :: CurrencyDetails
    } 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)


instance FromJSON Currency where
    parseJSON :: Value -> Parser Currency
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"currency" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text
-> Double
-> Text
-> Maybe Text
-> CurrencyDetails
-> 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
"id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
        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
"min_size")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
        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
"message"
        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 CryptoAddress = CryptoAddress Text
    deriving CryptoAddress -> ByteString
CryptoAddress -> Builder
CryptoAddress -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: CryptoAddress -> Text
$ctoQueryParam :: CryptoAddress -> Text
toHeader :: CryptoAddress -> ByteString
$ctoHeader :: CryptoAddress -> ByteString
toEncodedUrlPiece :: CryptoAddress -> Builder
$ctoEncodedUrlPiece :: CryptoAddress -> Builder
toUrlPiece :: CryptoAddress -> Text
$ctoUrlPiece :: CryptoAddress -> Text
ToHttpApiData


instance Show CryptoAddress where
    show :: CryptoAddress -> String
show (CryptoAddress Text
ca) = Text -> String
unpack Text
ca


deriveJSON defaultOptions
    { fieldLabelModifier = snakeCase
    , unwrapUnaryRecords = True
    } ''CryptoAddress