-- | Responses for Cardano epoch quries

module Blockfrost.Types.Cardano.Epochs
  ( EpochInfo (..)
  , PoolStakeDistribution (..)
  , ProtocolParams (..)
  , StakeDistribution (..)
  ) where

import Blockfrost.Types.Shared
import Data.Aeson (Value)
import Data.Text (Text)
import Deriving.Aeson
import Servant.Docs (ToSample (..), singleSample)

-- | Information about an epoch
data EpochInfo = EpochInfo
  { EpochInfo -> Epoch
_epochInfoEpoch          :: Epoch -- ^ Epoch number
  , EpochInfo -> POSIXTime
_epochInfoStartTime      :: POSIXTime -- ^ Unix time of the start of the epoch
  , EpochInfo -> POSIXTime
_epochInfoEndTime        :: POSIXTime -- ^ Unix time of the end of the epoch
  , EpochInfo -> POSIXTime
_epochInfoFirstBlockTime :: POSIXTime -- ^ Unix time of the first block of the epoch
  , EpochInfo -> POSIXTime
_epochInfoLastBlockTime  :: POSIXTime -- ^ Unix time of the last block of the epoch
  , EpochInfo -> Integer
_epochInfoBlockCount     :: Integer -- ^ Number of blocks within the epoch
  , EpochInfo -> Integer
_epochInfoTxCount        :: Integer -- ^ Number of transactions within the epoch
  , EpochInfo -> Lovelaces
_epochInfoOutput         :: Lovelaces -- ^ Sum of all the transactions within the epoch in Lovelaces
  , EpochInfo -> Lovelaces
_epochInfoFees           :: Lovelaces -- ^ Sum of all the fees within the epoch in Lovelaces
  , EpochInfo -> Maybe Lovelaces
_epochInfoActiveStake    :: Maybe Lovelaces -- ^ Sum of all the active stakes within the epoch in Lovelaces
  }
  deriving stock (Int -> EpochInfo -> ShowS
[EpochInfo] -> ShowS
EpochInfo -> String
(Int -> EpochInfo -> ShowS)
-> (EpochInfo -> String)
-> ([EpochInfo] -> ShowS)
-> Show EpochInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EpochInfo] -> ShowS
$cshowList :: [EpochInfo] -> ShowS
show :: EpochInfo -> String
$cshow :: EpochInfo -> String
showsPrec :: Int -> EpochInfo -> ShowS
$cshowsPrec :: Int -> EpochInfo -> ShowS
Show, EpochInfo -> EpochInfo -> Bool
(EpochInfo -> EpochInfo -> Bool)
-> (EpochInfo -> EpochInfo -> Bool) -> Eq EpochInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EpochInfo -> EpochInfo -> Bool
$c/= :: EpochInfo -> EpochInfo -> Bool
== :: EpochInfo -> EpochInfo -> Bool
$c== :: EpochInfo -> EpochInfo -> Bool
Eq, (forall x. EpochInfo -> Rep EpochInfo x)
-> (forall x. Rep EpochInfo x -> EpochInfo) -> Generic EpochInfo
forall x. Rep EpochInfo x -> EpochInfo
forall x. EpochInfo -> Rep EpochInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EpochInfo x -> EpochInfo
$cfrom :: forall x. EpochInfo -> Rep EpochInfo x
Generic)
  deriving (Value -> Parser [EpochInfo]
Value -> Parser EpochInfo
(Value -> Parser EpochInfo)
-> (Value -> Parser [EpochInfo]) -> FromJSON EpochInfo
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EpochInfo]
$cparseJSONList :: Value -> Parser [EpochInfo]
parseJSON :: Value -> Parser EpochInfo
$cparseJSON :: Value -> Parser EpochInfo
FromJSON, [EpochInfo] -> Encoding
[EpochInfo] -> Value
EpochInfo -> Encoding
EpochInfo -> Value
(EpochInfo -> Value)
-> (EpochInfo -> Encoding)
-> ([EpochInfo] -> Value)
-> ([EpochInfo] -> Encoding)
-> ToJSON EpochInfo
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EpochInfo] -> Encoding
$ctoEncodingList :: [EpochInfo] -> Encoding
toJSONList :: [EpochInfo] -> Value
$ctoJSONList :: [EpochInfo] -> Value
toEncoding :: EpochInfo -> Encoding
$ctoEncoding :: EpochInfo -> Encoding
toJSON :: EpochInfo -> Value
$ctoJSON :: EpochInfo -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_epochInfo", CamelToSnake]] EpochInfo

instance ToSample EpochInfo where
  toSamples :: Proxy EpochInfo -> [(Text, EpochInfo)]
toSamples = [(Text, EpochInfo)] -> Proxy EpochInfo -> [(Text, EpochInfo)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, EpochInfo)] -> Proxy EpochInfo -> [(Text, EpochInfo)])
-> [(Text, EpochInfo)] -> Proxy EpochInfo -> [(Text, EpochInfo)]
forall a b. (a -> b) -> a -> b
$ EpochInfo -> [(Text, EpochInfo)]
forall a. a -> [(Text, a)]
singleSample
    EpochInfo :: Epoch
-> POSIXTime
-> POSIXTime
-> POSIXTime
-> POSIXTime
-> Integer
-> Integer
-> Lovelaces
-> Lovelaces
-> Maybe Lovelaces
-> EpochInfo
EpochInfo
      { _epochInfoEpoch :: Epoch
_epochInfoEpoch = Epoch
225
      , _epochInfoStartTime :: POSIXTime
_epochInfoStartTime = POSIXTime
1603403091
      , _epochInfoEndTime :: POSIXTime
_epochInfoEndTime = POSIXTime
1603835086
      , _epochInfoFirstBlockTime :: POSIXTime
_epochInfoFirstBlockTime = POSIXTime
1603403092
      , _epochInfoLastBlockTime :: POSIXTime
_epochInfoLastBlockTime = POSIXTime
1603835084
      , _epochInfoBlockCount :: Integer
_epochInfoBlockCount = Integer
21298
      , _epochInfoTxCount :: Integer
_epochInfoTxCount = Integer
17856
      , _epochInfoOutput :: Lovelaces
_epochInfoOutput = Lovelaces
7849943934049314
      , _epochInfoFees :: Lovelaces
_epochInfoFees = Lovelaces
4203312194
      , _epochInfoActiveStake :: Maybe Lovelaces
_epochInfoActiveStake = Discrete' "ADA" '(1000000, 1)
-> Maybe (Discrete' "ADA" '(1000000, 1))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Discrete' "ADA" '(1000000, 1)
784953934049314
      }


-- | Protocol parameters
data ProtocolParams = ProtocolParams
  { ProtocolParams -> Epoch
_protocolParamsEpoch                 :: Epoch -- ^ Epoch number
  , ProtocolParams -> Integer
_protocolParamsMinFeeA               :: Integer -- ^ The linear factor for the minimum fee calculation for given epoch
  , ProtocolParams -> Integer
_protocolParamsMinFeeB               :: Integer -- ^ The constant factor for the minimum fee calculation
  , ProtocolParams -> Integer
_protocolParamsMaxBlockSize          :: Integer -- ^ Maximum block body size in Bytes
  , ProtocolParams -> Integer
_protocolParamsMaxTxSize             :: Integer -- ^ Maximum transaction size
  , ProtocolParams -> Integer
_protocolParamsMaxBlockHeaderSize    :: Integer -- ^ Maximum block header size
  , ProtocolParams -> Lovelaces
_protocolParamsKeyDeposit            :: Lovelaces -- ^ The amount of a key registration deposit in Lovelaces
  , ProtocolParams -> Lovelaces
_protocolParamsPoolDeposit           :: Lovelaces -- ^ The amount of a pool registration deposit in Lovelaces
  , ProtocolParams -> Integer
_protocolParamsEMax                  :: Integer -- ^ Epoch bound on pool retirement
  , ProtocolParams -> Integer
_protocolParamsNOpt                  :: Integer -- ^ Desired number of pools
  , ProtocolParams -> Double
_protocolParamsA0                    :: Double -- ^ Pool pledge influence
  , ProtocolParams -> Double
_protocolParamsRho                   :: Double -- ^ Monetary expansion
  , ProtocolParams -> Double
_protocolParamsTau                   :: Double -- ^ Treasury expansion
  , ProtocolParams -> Double
_protocolParamsDecentralisationParam :: Double -- ^ Percentage of blocks produced by federated nodes
  , ProtocolParams -> Maybe Value
_protocolParamsExtraEntropy          :: Maybe Value -- ^ Seed for extra entropy
  , ProtocolParams -> Integer
_protocolParamsProtocolMajorVer      :: Integer -- ^ Accepted protocol major version
  , ProtocolParams -> Integer
_protocolParamsProtocolMinorVer      :: Integer -- ^ Accepted protocol minor version
  , ProtocolParams -> Lovelaces
_protocolParamsMinUtxo               :: Lovelaces -- ^ Minimum UTXO value
  , ProtocolParams -> Lovelaces
_protocolParamsMinPoolCost           :: Lovelaces  -- ^ Minimum stake cost forced on the pool
  , ProtocolParams -> Text
_protocolParamsNonce                 :: Text -- ^ Epoch number only used once
  -- cost models
  -- https://github.com/input-output-hk/cardano-db-sync/pull/758
  , ProtocolParams -> Double
_protocolParamsPriceMem               :: Double -- ^ The per word cost of script memory usage
  , ProtocolParams -> Double
_protocolParamsPriceStep              :: Double -- ^ The cost of script execution step usage
  , ProtocolParams -> Quantity
_protocolParamsMaxTxExMem             :: Quantity -- ^ The maximum number of execution memory allowed to be used in a single transaction
  , ProtocolParams -> Quantity
_protocolParamsMaxTxExSteps           :: Quantity -- ^ The maximum number of execution steps allowed to be used in a single transaction
  , ProtocolParams -> Quantity
_protocolParamsMaxBlockExMem          :: Quantity -- ^ The maximum number of execution memory allowed to be used in a single block
  , ProtocolParams -> Quantity
_protocolParamsMaxBlockExSteps        :: Quantity -- ^ The maximum number of execution steps allowed to be used in a single block
  , ProtocolParams -> Quantity
_protocolParamsMaxValSize             :: Quantity -- ^ The maximum Val size
  , ProtocolParams -> Integer
_protocolParamsCollateralPercent      :: Integer -- ^ The percentage of the transactions fee which must be provided as collateral when including non-native scripts
  , ProtocolParams -> Integer
_protocolParamsMaxCollateralInputs    :: Integer -- ^ The maximum number of collateral inputs allowed in a transaction
  , ProtocolParams -> Lovelaces
_protocolParamsCoinsPerUtxoWord       :: Lovelaces -- ^ The cost per UTxO word
  }
  deriving stock (Int -> ProtocolParams -> ShowS
[ProtocolParams] -> ShowS
ProtocolParams -> String
(Int -> ProtocolParams -> ShowS)
-> (ProtocolParams -> String)
-> ([ProtocolParams] -> ShowS)
-> Show ProtocolParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolParams] -> ShowS
$cshowList :: [ProtocolParams] -> ShowS
show :: ProtocolParams -> String
$cshow :: ProtocolParams -> String
showsPrec :: Int -> ProtocolParams -> ShowS
$cshowsPrec :: Int -> ProtocolParams -> ShowS
Show, ProtocolParams -> ProtocolParams -> Bool
(ProtocolParams -> ProtocolParams -> Bool)
-> (ProtocolParams -> ProtocolParams -> Bool) -> Eq ProtocolParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolParams -> ProtocolParams -> Bool
$c/= :: ProtocolParams -> ProtocolParams -> Bool
== :: ProtocolParams -> ProtocolParams -> Bool
$c== :: ProtocolParams -> ProtocolParams -> Bool
Eq, (forall x. ProtocolParams -> Rep ProtocolParams x)
-> (forall x. Rep ProtocolParams x -> ProtocolParams)
-> Generic ProtocolParams
forall x. Rep ProtocolParams x -> ProtocolParams
forall x. ProtocolParams -> Rep ProtocolParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProtocolParams x -> ProtocolParams
$cfrom :: forall x. ProtocolParams -> Rep ProtocolParams x
Generic)
  deriving (Value -> Parser [ProtocolParams]
Value -> Parser ProtocolParams
(Value -> Parser ProtocolParams)
-> (Value -> Parser [ProtocolParams]) -> FromJSON ProtocolParams
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ProtocolParams]
$cparseJSONList :: Value -> Parser [ProtocolParams]
parseJSON :: Value -> Parser ProtocolParams
$cparseJSON :: Value -> Parser ProtocolParams
FromJSON, [ProtocolParams] -> Encoding
[ProtocolParams] -> Value
ProtocolParams -> Encoding
ProtocolParams -> Value
(ProtocolParams -> Value)
-> (ProtocolParams -> Encoding)
-> ([ProtocolParams] -> Value)
-> ([ProtocolParams] -> Encoding)
-> ToJSON ProtocolParams
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ProtocolParams] -> Encoding
$ctoEncodingList :: [ProtocolParams] -> Encoding
toJSONList :: [ProtocolParams] -> Value
$ctoJSONList :: [ProtocolParams] -> Value
toEncoding :: ProtocolParams -> Encoding
$ctoEncoding :: ProtocolParams -> Encoding
toJSON :: ProtocolParams -> Value
$ctoJSON :: ProtocolParams -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_protocolParams", CamelToSnake]] ProtocolParams

instance ToSample ProtocolParams where
  toSamples :: Proxy ProtocolParams -> [(Text, ProtocolParams)]
toSamples = [(Text, ProtocolParams)]
-> Proxy ProtocolParams -> [(Text, ProtocolParams)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, ProtocolParams)]
 -> Proxy ProtocolParams -> [(Text, ProtocolParams)])
-> [(Text, ProtocolParams)]
-> Proxy ProtocolParams
-> [(Text, ProtocolParams)]
forall a b. (a -> b) -> a -> b
$ ProtocolParams -> [(Text, ProtocolParams)]
forall a. a -> [(Text, a)]
singleSample
    ProtocolParams :: Epoch
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Lovelaces
-> Lovelaces
-> Integer
-> Integer
-> Double
-> Double
-> Double
-> Double
-> Maybe Value
-> Integer
-> Integer
-> Lovelaces
-> Lovelaces
-> Text
-> Double
-> Double
-> Quantity
-> Quantity
-> Quantity
-> Quantity
-> Quantity
-> Integer
-> Integer
-> Lovelaces
-> ProtocolParams
ProtocolParams
      { _protocolParamsEpoch :: Epoch
_protocolParamsEpoch = Epoch
225
      , _protocolParamsMinFeeA :: Integer
_protocolParamsMinFeeA = Integer
44
      , _protocolParamsMinFeeB :: Integer
_protocolParamsMinFeeB = Integer
155381
      , _protocolParamsMaxBlockSize :: Integer
_protocolParamsMaxBlockSize = Integer
65536
      , _protocolParamsMaxTxSize :: Integer
_protocolParamsMaxTxSize = Integer
16384
      , _protocolParamsMaxBlockHeaderSize :: Integer
_protocolParamsMaxBlockHeaderSize = Integer
1100
      , _protocolParamsKeyDeposit :: Lovelaces
_protocolParamsKeyDeposit = Lovelaces
2000000
      , _protocolParamsPoolDeposit :: Lovelaces
_protocolParamsPoolDeposit = Lovelaces
500000000
      , _protocolParamsEMax :: Integer
_protocolParamsEMax = Integer
18
      , _protocolParamsNOpt :: Integer
_protocolParamsNOpt = Integer
150
      , _protocolParamsA0 :: Double
_protocolParamsA0 = Double
0.3
      , _protocolParamsRho :: Double
_protocolParamsRho = Double
0.003
      , _protocolParamsTau :: Double
_protocolParamsTau = Double
0.2
      , _protocolParamsDecentralisationParam :: Double
_protocolParamsDecentralisationParam = Double
0.5
      , _protocolParamsExtraEntropy :: Maybe Value
_protocolParamsExtraEntropy = Maybe Value
forall a. Maybe a
Nothing
      , _protocolParamsProtocolMajorVer :: Integer
_protocolParamsProtocolMajorVer = Integer
2
      , _protocolParamsProtocolMinorVer :: Integer
_protocolParamsProtocolMinorVer = Integer
0
      , _protocolParamsMinUtxo :: Lovelaces
_protocolParamsMinUtxo = Lovelaces
1000000
      , _protocolParamsMinPoolCost :: Lovelaces
_protocolParamsMinPoolCost = Lovelaces
340000000
      , _protocolParamsNonce :: Text
_protocolParamsNonce = Text
"1a3be38bcbb7911969283716ad7aa550250226b76a61fc51cc9a9a35d9276d81"
      , _protocolParamsPriceMem :: Double
_protocolParamsPriceMem = Double
0.0577
      , _protocolParamsPriceStep :: Double
_protocolParamsPriceStep = Double
0.0000721
      , _protocolParamsMaxTxExMem :: Quantity
_protocolParamsMaxTxExMem = Quantity
10000000
      , _protocolParamsMaxTxExSteps :: Quantity
_protocolParamsMaxTxExSteps = Quantity
10000000000
      , _protocolParamsMaxBlockExMem :: Quantity
_protocolParamsMaxBlockExMem = Quantity
50000000
      , _protocolParamsMaxBlockExSteps :: Quantity
_protocolParamsMaxBlockExSteps = Quantity
40000000000
      , _protocolParamsMaxValSize :: Quantity
_protocolParamsMaxValSize = Quantity
5000
      , _protocolParamsCollateralPercent :: Integer
_protocolParamsCollateralPercent = Integer
150
      , _protocolParamsMaxCollateralInputs :: Integer
_protocolParamsMaxCollateralInputs = Integer
3
      , _protocolParamsCoinsPerUtxoWord :: Lovelaces
_protocolParamsCoinsPerUtxoWord = Lovelaces
34482
      }

-- | Active stake distribution for an epoch
data StakeDistribution = StakeDistribution
  { StakeDistribution -> Address
_stakeDistributionStakeAddress :: Address -- ^ Stake address
  , StakeDistribution -> PoolId
_stakeDistributionPoolId       :: PoolId -- ^ Bech32 prefix of the pool delegated to
  , StakeDistribution -> Lovelaces
_stakeDistributionAmount       :: Lovelaces -- ^ Amount of active delegated stake in Lovelaces
  }
  deriving stock (Int -> StakeDistribution -> ShowS
[StakeDistribution] -> ShowS
StakeDistribution -> String
(Int -> StakeDistribution -> ShowS)
-> (StakeDistribution -> String)
-> ([StakeDistribution] -> ShowS)
-> Show StakeDistribution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakeDistribution] -> ShowS
$cshowList :: [StakeDistribution] -> ShowS
show :: StakeDistribution -> String
$cshow :: StakeDistribution -> String
showsPrec :: Int -> StakeDistribution -> ShowS
$cshowsPrec :: Int -> StakeDistribution -> ShowS
Show, StakeDistribution -> StakeDistribution -> Bool
(StakeDistribution -> StakeDistribution -> Bool)
-> (StakeDistribution -> StakeDistribution -> Bool)
-> Eq StakeDistribution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StakeDistribution -> StakeDistribution -> Bool
$c/= :: StakeDistribution -> StakeDistribution -> Bool
== :: StakeDistribution -> StakeDistribution -> Bool
$c== :: StakeDistribution -> StakeDistribution -> Bool
Eq, (forall x. StakeDistribution -> Rep StakeDistribution x)
-> (forall x. Rep StakeDistribution x -> StakeDistribution)
-> Generic StakeDistribution
forall x. Rep StakeDistribution x -> StakeDistribution
forall x. StakeDistribution -> Rep StakeDistribution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StakeDistribution x -> StakeDistribution
$cfrom :: forall x. StakeDistribution -> Rep StakeDistribution x
Generic)
  deriving (Value -> Parser [StakeDistribution]
Value -> Parser StakeDistribution
(Value -> Parser StakeDistribution)
-> (Value -> Parser [StakeDistribution])
-> FromJSON StakeDistribution
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [StakeDistribution]
$cparseJSONList :: Value -> Parser [StakeDistribution]
parseJSON :: Value -> Parser StakeDistribution
$cparseJSON :: Value -> Parser StakeDistribution
FromJSON, [StakeDistribution] -> Encoding
[StakeDistribution] -> Value
StakeDistribution -> Encoding
StakeDistribution -> Value
(StakeDistribution -> Value)
-> (StakeDistribution -> Encoding)
-> ([StakeDistribution] -> Value)
-> ([StakeDistribution] -> Encoding)
-> ToJSON StakeDistribution
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [StakeDistribution] -> Encoding
$ctoEncodingList :: [StakeDistribution] -> Encoding
toJSONList :: [StakeDistribution] -> Value
$ctoJSONList :: [StakeDistribution] -> Value
toEncoding :: StakeDistribution -> Encoding
$ctoEncoding :: StakeDistribution -> Encoding
toJSON :: StakeDistribution -> Value
$ctoJSON :: StakeDistribution -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_stakeDistribution", CamelToSnake]] StakeDistribution

instance ToSample StakeDistribution where
  toSamples :: Proxy StakeDistribution -> [(Text, StakeDistribution)]
toSamples = [(Text, StakeDistribution)]
-> Proxy StakeDistribution -> [(Text, StakeDistribution)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, StakeDistribution)]
 -> Proxy StakeDistribution -> [(Text, StakeDistribution)])
-> [(Text, StakeDistribution)]
-> Proxy StakeDistribution
-> [(Text, StakeDistribution)]
forall a b. (a -> b) -> a -> b
$ StakeDistribution -> [(Text, StakeDistribution)]
forall a. a -> [(Text, a)]
singleSample
    StakeDistribution :: Address -> PoolId -> Lovelaces -> StakeDistribution
StakeDistribution
      { _stakeDistributionStakeAddress :: Address
_stakeDistributionStakeAddress = Address
"stake1u9l5q5jwgelgagzyt6nuaasefgmn8pd25c8e9qpeprq0tdcp0e3uk"
      , _stakeDistributionPoolId :: PoolId
_stakeDistributionPoolId = PoolId
"pool1pu5jlj4q9w9jlxeu370a3c9myx47md5j5m2str0naunn2q3lkdy"
      , _stakeDistributionAmount :: Lovelaces
_stakeDistributionAmount = Lovelaces
4440295078
      }

-- | Stake distribution for an epoch for specific pool
data PoolStakeDistribution = PoolStakeDistribution
  { PoolStakeDistribution -> Address
_poolStakeDistributionStakeAddress :: Address -- ^ Stake address
  , PoolStakeDistribution -> Lovelaces
_poolStakeDistributionAmount       :: Lovelaces -- ^ Amount of active delegated stake in Lovelaces
  }
  deriving stock (Int -> PoolStakeDistribution -> ShowS
[PoolStakeDistribution] -> ShowS
PoolStakeDistribution -> String
(Int -> PoolStakeDistribution -> ShowS)
-> (PoolStakeDistribution -> String)
-> ([PoolStakeDistribution] -> ShowS)
-> Show PoolStakeDistribution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolStakeDistribution] -> ShowS
$cshowList :: [PoolStakeDistribution] -> ShowS
show :: PoolStakeDistribution -> String
$cshow :: PoolStakeDistribution -> String
showsPrec :: Int -> PoolStakeDistribution -> ShowS
$cshowsPrec :: Int -> PoolStakeDistribution -> ShowS
Show, PoolStakeDistribution -> PoolStakeDistribution -> Bool
(PoolStakeDistribution -> PoolStakeDistribution -> Bool)
-> (PoolStakeDistribution -> PoolStakeDistribution -> Bool)
-> Eq PoolStakeDistribution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolStakeDistribution -> PoolStakeDistribution -> Bool
$c/= :: PoolStakeDistribution -> PoolStakeDistribution -> Bool
== :: PoolStakeDistribution -> PoolStakeDistribution -> Bool
$c== :: PoolStakeDistribution -> PoolStakeDistribution -> Bool
Eq, (forall x. PoolStakeDistribution -> Rep PoolStakeDistribution x)
-> (forall x. Rep PoolStakeDistribution x -> PoolStakeDistribution)
-> Generic PoolStakeDistribution
forall x. Rep PoolStakeDistribution x -> PoolStakeDistribution
forall x. PoolStakeDistribution -> Rep PoolStakeDistribution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PoolStakeDistribution x -> PoolStakeDistribution
$cfrom :: forall x. PoolStakeDistribution -> Rep PoolStakeDistribution x
Generic)
  deriving (Value -> Parser [PoolStakeDistribution]
Value -> Parser PoolStakeDistribution
(Value -> Parser PoolStakeDistribution)
-> (Value -> Parser [PoolStakeDistribution])
-> FromJSON PoolStakeDistribution
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PoolStakeDistribution]
$cparseJSONList :: Value -> Parser [PoolStakeDistribution]
parseJSON :: Value -> Parser PoolStakeDistribution
$cparseJSON :: Value -> Parser PoolStakeDistribution
FromJSON, [PoolStakeDistribution] -> Encoding
[PoolStakeDistribution] -> Value
PoolStakeDistribution -> Encoding
PoolStakeDistribution -> Value
(PoolStakeDistribution -> Value)
-> (PoolStakeDistribution -> Encoding)
-> ([PoolStakeDistribution] -> Value)
-> ([PoolStakeDistribution] -> Encoding)
-> ToJSON PoolStakeDistribution
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PoolStakeDistribution] -> Encoding
$ctoEncodingList :: [PoolStakeDistribution] -> Encoding
toJSONList :: [PoolStakeDistribution] -> Value
$ctoJSONList :: [PoolStakeDistribution] -> Value
toEncoding :: PoolStakeDistribution -> Encoding
$ctoEncoding :: PoolStakeDistribution -> Encoding
toJSON :: PoolStakeDistribution -> Value
$ctoJSON :: PoolStakeDistribution -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_poolStakeDistribution", CamelToSnake]] PoolStakeDistribution

instance ToSample PoolStakeDistribution where
  toSamples :: Proxy PoolStakeDistribution -> [(Text, PoolStakeDistribution)]
toSamples = [(Text, PoolStakeDistribution)]
-> Proxy PoolStakeDistribution -> [(Text, PoolStakeDistribution)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, PoolStakeDistribution)]
 -> Proxy PoolStakeDistribution -> [(Text, PoolStakeDistribution)])
-> [(Text, PoolStakeDistribution)]
-> Proxy PoolStakeDistribution
-> [(Text, PoolStakeDistribution)]
forall a b. (a -> b) -> a -> b
$ PoolStakeDistribution -> [(Text, PoolStakeDistribution)]
forall a. a -> [(Text, a)]
singleSample
    PoolStakeDistribution :: Address -> Lovelaces -> PoolStakeDistribution
PoolStakeDistribution
      { _poolStakeDistributionStakeAddress :: Address
_poolStakeDistributionStakeAddress = Address
"stake1u9l5q5jwgelgagzyt6nuaasefgmn8pd25c8e9qpeprq0tdcp0e3uk"
      , _poolStakeDistributionAmount :: Lovelaces
_poolStakeDistributionAmount = Lovelaces
4440295078
      }