{-# 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