-- | Cardano Network reponses

{-# LANGUAGE NumericUnderscores #-}

module Blockfrost.Types.Cardano.Network
  ( Network (..)
  , NetworkStake (..)
  , NetworkSupply (..)
  ) where

import Deriving.Aeson
import Servant.Docs (ToSample (..), singleSample)

import Blockfrost.Types.Shared

-- | Lovelace supply data
data NetworkSupply = NetworkSupply
  { NetworkSupply -> Lovelaces
_supplyMax         :: Lovelaces -- ^ Maximum supply in Lovelaces
  , NetworkSupply -> Lovelaces
_supplyTotal       :: Lovelaces -- ^ Current total (max supply - reserves) supply in Lovelaces
  , NetworkSupply -> Lovelaces
_supplyCirculating :: Lovelaces -- ^ Current circulating (UTXOs + withdrawables) supply in Lovelaces
  , NetworkSupply -> Lovelaces
_supplyLocked      :: Lovelaces -- ^ Current supply locked by scripts in Lovelaces
  , NetworkSupply -> Lovelaces
_supplyTreasury    :: Lovelaces -- ^ Current supply locked in treasury
  , NetworkSupply -> Lovelaces
_supplyReserves    :: Lovelaces -- ^ Current supply locked in reserves
  }
  deriving stock (Int -> NetworkSupply -> ShowS
[NetworkSupply] -> ShowS
NetworkSupply -> String
(Int -> NetworkSupply -> ShowS)
-> (NetworkSupply -> String)
-> ([NetworkSupply] -> ShowS)
-> Show NetworkSupply
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NetworkSupply] -> ShowS
$cshowList :: [NetworkSupply] -> ShowS
show :: NetworkSupply -> String
$cshow :: NetworkSupply -> String
showsPrec :: Int -> NetworkSupply -> ShowS
$cshowsPrec :: Int -> NetworkSupply -> ShowS
Show, NetworkSupply -> NetworkSupply -> Bool
(NetworkSupply -> NetworkSupply -> Bool)
-> (NetworkSupply -> NetworkSupply -> Bool) -> Eq NetworkSupply
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NetworkSupply -> NetworkSupply -> Bool
$c/= :: NetworkSupply -> NetworkSupply -> Bool
== :: NetworkSupply -> NetworkSupply -> Bool
$c== :: NetworkSupply -> NetworkSupply -> Bool
Eq, (forall x. NetworkSupply -> Rep NetworkSupply x)
-> (forall x. Rep NetworkSupply x -> NetworkSupply)
-> Generic NetworkSupply
forall x. Rep NetworkSupply x -> NetworkSupply
forall x. NetworkSupply -> Rep NetworkSupply x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NetworkSupply x -> NetworkSupply
$cfrom :: forall x. NetworkSupply -> Rep NetworkSupply x
Generic)
  deriving (Value -> Parser [NetworkSupply]
Value -> Parser NetworkSupply
(Value -> Parser NetworkSupply)
-> (Value -> Parser [NetworkSupply]) -> FromJSON NetworkSupply
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [NetworkSupply]
$cparseJSONList :: Value -> Parser [NetworkSupply]
parseJSON :: Value -> Parser NetworkSupply
$cparseJSON :: Value -> Parser NetworkSupply
FromJSON, [NetworkSupply] -> Encoding
[NetworkSupply] -> Value
NetworkSupply -> Encoding
NetworkSupply -> Value
(NetworkSupply -> Value)
-> (NetworkSupply -> Encoding)
-> ([NetworkSupply] -> Value)
-> ([NetworkSupply] -> Encoding)
-> ToJSON NetworkSupply
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [NetworkSupply] -> Encoding
$ctoEncodingList :: [NetworkSupply] -> Encoding
toJSONList :: [NetworkSupply] -> Value
$ctoJSONList :: [NetworkSupply] -> Value
toEncoding :: NetworkSupply -> Encoding
$ctoEncoding :: NetworkSupply -> Encoding
toJSON :: NetworkSupply -> Value
$ctoJSON :: NetworkSupply -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_supply", CamelToSnake]] NetworkSupply

netSupplySample :: NetworkSupply
netSupplySample :: NetworkSupply
netSupplySample =
  NetworkSupply :: Lovelaces
-> Lovelaces
-> Lovelaces
-> Lovelaces
-> Lovelaces
-> Lovelaces
-> NetworkSupply
NetworkSupply
    { _supplyMax :: Lovelaces
_supplyMax = Lovelaces
45_000_000_000_000_000
    , _supplyTotal :: Lovelaces
_supplyTotal = Lovelaces
32_890_715_183_299_160
    , _supplyCirculating :: Lovelaces
_supplyCirculating = Lovelaces
32_412_601_976_210_393
    , _supplyLocked :: Lovelaces
_supplyLocked = Lovelaces
125_006_953_355
    , _supplyTreasury :: Lovelaces
_supplyTreasury = Lovelaces
98_635_632_000_000
    , _supplyReserves :: Lovelaces
_supplyReserves = Lovelaces
46_635_632_000_000
    }

instance ToSample NetworkSupply where
  toSamples :: Proxy NetworkSupply -> [(Text, NetworkSupply)]
toSamples = [(Text, NetworkSupply)]
-> Proxy NetworkSupply -> [(Text, NetworkSupply)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, NetworkSupply)]
 -> Proxy NetworkSupply -> [(Text, NetworkSupply)])
-> [(Text, NetworkSupply)]
-> Proxy NetworkSupply
-> [(Text, NetworkSupply)]
forall a b. (a -> b) -> a -> b
$ NetworkSupply -> [(Text, NetworkSupply)]
forall a. a -> [(Text, a)]
singleSample NetworkSupply
netSupplySample

-- | Live and active stake of the whole network
data NetworkStake = NetworkStake
  { NetworkStake -> Lovelaces
_stakeLive   :: Lovelaces -- ^ Current live stake in Lovelaces
  , NetworkStake -> Lovelaces
_stakeActive :: Lovelaces -- ^ Current active stake in Lovelaces
  }
  deriving stock (Int -> NetworkStake -> ShowS
[NetworkStake] -> ShowS
NetworkStake -> String
(Int -> NetworkStake -> ShowS)
-> (NetworkStake -> String)
-> ([NetworkStake] -> ShowS)
-> Show NetworkStake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NetworkStake] -> ShowS
$cshowList :: [NetworkStake] -> ShowS
show :: NetworkStake -> String
$cshow :: NetworkStake -> String
showsPrec :: Int -> NetworkStake -> ShowS
$cshowsPrec :: Int -> NetworkStake -> ShowS
Show, NetworkStake -> NetworkStake -> Bool
(NetworkStake -> NetworkStake -> Bool)
-> (NetworkStake -> NetworkStake -> Bool) -> Eq NetworkStake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NetworkStake -> NetworkStake -> Bool
$c/= :: NetworkStake -> NetworkStake -> Bool
== :: NetworkStake -> NetworkStake -> Bool
$c== :: NetworkStake -> NetworkStake -> Bool
Eq, (forall x. NetworkStake -> Rep NetworkStake x)
-> (forall x. Rep NetworkStake x -> NetworkStake)
-> Generic NetworkStake
forall x. Rep NetworkStake x -> NetworkStake
forall x. NetworkStake -> Rep NetworkStake x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NetworkStake x -> NetworkStake
$cfrom :: forall x. NetworkStake -> Rep NetworkStake x
Generic)
  deriving (Value -> Parser [NetworkStake]
Value -> Parser NetworkStake
(Value -> Parser NetworkStake)
-> (Value -> Parser [NetworkStake]) -> FromJSON NetworkStake
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [NetworkStake]
$cparseJSONList :: Value -> Parser [NetworkStake]
parseJSON :: Value -> Parser NetworkStake
$cparseJSON :: Value -> Parser NetworkStake
FromJSON, [NetworkStake] -> Encoding
[NetworkStake] -> Value
NetworkStake -> Encoding
NetworkStake -> Value
(NetworkStake -> Value)
-> (NetworkStake -> Encoding)
-> ([NetworkStake] -> Value)
-> ([NetworkStake] -> Encoding)
-> ToJSON NetworkStake
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [NetworkStake] -> Encoding
$ctoEncodingList :: [NetworkStake] -> Encoding
toJSONList :: [NetworkStake] -> Value
$ctoJSONList :: [NetworkStake] -> Value
toEncoding :: NetworkStake -> Encoding
$ctoEncoding :: NetworkStake -> Encoding
toJSON :: NetworkStake -> Value
$ctoJSON :: NetworkStake -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_stake", CamelToSnake]] NetworkStake

netStakeSample :: NetworkStake
netStakeSample :: NetworkStake
netStakeSample =
  NetworkStake :: Lovelaces -> Lovelaces -> NetworkStake
NetworkStake
    { _stakeLive :: Lovelaces
_stakeLive = Lovelaces
23_204_950_463_991_654
    , _stakeActive :: Lovelaces
_stakeActive = Lovelaces
22_210_233_523_456_321
    }

instance ToSample NetworkStake where
  toSamples :: Proxy NetworkStake -> [(Text, NetworkStake)]
toSamples = [(Text, NetworkStake)]
-> Proxy NetworkStake -> [(Text, NetworkStake)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, NetworkStake)]
 -> Proxy NetworkStake -> [(Text, NetworkStake)])
-> [(Text, NetworkStake)]
-> Proxy NetworkStake
-> [(Text, NetworkStake)]
forall a b. (a -> b) -> a -> b
$ NetworkStake -> [(Text, NetworkStake)]
forall a. a -> [(Text, a)]
singleSample NetworkStake
netStakeSample

-- | Detailed network information
data Network = Network
  { Network -> NetworkSupply
_networkSupply :: NetworkSupply -- ^ Supply data
  , Network -> NetworkStake
_networkStake  :: NetworkStake -- ^ Stake data
  }
  deriving stock (Int -> Network -> ShowS
[Network] -> ShowS
Network -> String
(Int -> Network -> ShowS)
-> (Network -> String) -> ([Network] -> ShowS) -> Show Network
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Network] -> ShowS
$cshowList :: [Network] -> ShowS
show :: Network -> String
$cshow :: Network -> String
showsPrec :: Int -> Network -> ShowS
$cshowsPrec :: Int -> Network -> ShowS
Show, Network -> Network -> Bool
(Network -> Network -> Bool)
-> (Network -> Network -> Bool) -> Eq Network
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Network -> Network -> Bool
$c/= :: Network -> Network -> Bool
== :: Network -> Network -> Bool
$c== :: Network -> Network -> Bool
Eq, (forall x. Network -> Rep Network x)
-> (forall x. Rep Network x -> Network) -> Generic Network
forall x. Rep Network x -> Network
forall x. Network -> Rep Network x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Network x -> Network
$cfrom :: forall x. Network -> Rep Network x
Generic)
  deriving (Value -> Parser [Network]
Value -> Parser Network
(Value -> Parser Network)
-> (Value -> Parser [Network]) -> FromJSON Network
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Network]
$cparseJSONList :: Value -> Parser [Network]
parseJSON :: Value -> Parser Network
$cparseJSON :: Value -> Parser Network
FromJSON, [Network] -> Encoding
[Network] -> Value
Network -> Encoding
Network -> Value
(Network -> Value)
-> (Network -> Encoding)
-> ([Network] -> Value)
-> ([Network] -> Encoding)
-> ToJSON Network
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Network] -> Encoding
$ctoEncodingList :: [Network] -> Encoding
toJSONList :: [Network] -> Value
$ctoJSONList :: [Network] -> Value
toEncoding :: Network -> Encoding
$ctoEncoding :: Network -> Encoding
toJSON :: Network -> Value
$ctoJSON :: Network -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_network", CamelToSnake]] Network

instance ToSample Network where
  toSamples :: Proxy Network -> [(Text, Network)]
toSamples = [(Text, Network)] -> Proxy Network -> [(Text, Network)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, Network)] -> Proxy Network -> [(Text, Network)])
-> [(Text, Network)] -> Proxy Network -> [(Text, Network)]
forall a b. (a -> b) -> a -> b
$ Network -> [(Text, Network)]
forall a. a -> [(Text, a)]
singleSample (Network -> [(Text, Network)]) -> Network -> [(Text, Network)]
forall a b. (a -> b) -> a -> b
$
    NetworkSupply -> NetworkStake -> Network
Network NetworkSupply
netSupplySample NetworkStake
netStakeSample