{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module CoinbasePro.Authenticated.Oracle ( OracleResponse (..) ) where import Data.Aeson (FromJSON, parseJSON, withObject, (.:)) import Data.Aeson.Casing (snakeCase) import Data.Aeson.TH (defaultOptions, deriveJSON, fieldLabelModifier, unwrapUnaryRecords) import Data.Map.Strict (Map) import Data.Text (Text) import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import CoinbasePro.Types (CurrencyType, Price) newtype Message = Message Text deriving Int -> Message -> ShowS [Message] -> ShowS Message -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Message] -> ShowS $cshowList :: [Message] -> ShowS show :: Message -> String $cshow :: Message -> String showsPrec :: Int -> Message -> ShowS $cshowsPrec :: Int -> Message -> ShowS Show deriveJSON defaultOptions { fieldLabelModifier = snakeCase , unwrapUnaryRecords = True } ''Message newtype Signature = Signature Text deriving Int -> Signature -> ShowS [Signature] -> ShowS Signature -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Signature] -> ShowS $cshowList :: [Signature] -> ShowS show :: Signature -> String $cshow :: Signature -> String showsPrec :: Int -> Signature -> ShowS $cshowsPrec :: Int -> Signature -> ShowS Show deriveJSON defaultOptions { fieldLabelModifier = snakeCase , unwrapUnaryRecords = True } ''Signature data OracleResponse = OracleResponse { OracleResponse -> UTCTime timestamp :: UTCTime , OracleResponse -> [Message] messages :: [Message] , OracleResponse -> [Signature] signatures :: [Signature] , OracleResponse -> Map CurrencyType Price prices :: Map CurrencyType Price } deriving Int -> OracleResponse -> ShowS [OracleResponse] -> ShowS OracleResponse -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [OracleResponse] -> ShowS $cshowList :: [OracleResponse] -> ShowS show :: OracleResponse -> String $cshow :: OracleResponse -> String showsPrec :: Int -> OracleResponse -> ShowS $cshowsPrec :: Int -> OracleResponse -> ShowS Show instance FromJSON OracleResponse where parseJSON :: Value -> Parser OracleResponse parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a withObject String "oracle response" forall a b. (a -> b) -> a -> b $ \Object o -> UTCTime -> [Message] -> [Signature] -> Map CurrencyType Price -> OracleResponse OracleResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (POSIXTime -> UTCTime posixSecondsToUTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Real a, Fractional b) => a -> b realToFrac 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 "timestamp") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object o forall a. FromJSON a => Object -> Key -> Parser a .: Key "messages" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object o forall a. FromJSON a => Object -> Key -> Parser a .: Key "signatures" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Object o forall a. FromJSON a => Object -> Key -> Parser a .: Key "prices"