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