-- | Responses for Cardano epoch quries

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

import Blockfrost.Types.Shared
import Data.Aeson (object, FromJSON (..), ToJSON (..), withObject)
import Data.Map (Map)
import Data.Text (Text)
import Deriving.Aeson
import Servant.Docs (ToSample (..), singleSample)

import qualified Data.Aeson.Key
import qualified Data.Aeson.KeyMap
import qualified Data.Char
import qualified Data.Map

import Blockfrost.Types.Cardano.Scripts (ScriptType (..))

-- | 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
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
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. 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
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
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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> [(Text, a)]
singleSample
    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 = Discrete' "ADA" '(1000000, 1)
7849943934049314
      , _epochInfoFees :: Lovelaces
_epochInfoFees = Discrete' "ADA" '(1000000, 1)
4203312194
      , _epochInfoActiveStake :: Maybe Lovelaces
_epochInfoActiveStake = 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 -> Rational
_protocolParamsA0                    :: Rational -- ^ Pool pledge influence
  , ProtocolParams -> Rational
_protocolParamsRho                   :: Rational -- ^ Monetary expansion
  , ProtocolParams -> Rational
_protocolParamsTau                   :: Rational -- ^ Treasury expansion
  , ProtocolParams -> Rational
_protocolParamsDecentralisationParam :: Rational -- ^ Percentage of blocks produced by federated nodes
  , ProtocolParams -> Maybe Text
_protocolParamsExtraEntropy          :: Maybe Text -- ^ 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
  , ProtocolParams -> CostModels
_protocolParamsCostModels            :: CostModels -- ^ Cost models parameters for Plutus Core scripts
  , ProtocolParams -> Rational
_protocolParamsPriceMem               :: Rational -- ^ The per word cost of script memory usage
  , ProtocolParams -> Rational
_protocolParamsPriceStep              :: Rational -- ^ 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
_protocolParamsCoinsPerUtxoSize       :: Lovelaces -- ^ The cost per UTxO size. Cost per UTxO *word* for Alozno. Cost per UTxO *byte* for Babbage and later
  , ProtocolParams -> Lovelaces
_protocolParamsCoinsPerUtxoWord       :: Lovelaces -- ^ The cost per UTxO word (DEPRECATED)
  }
  deriving stock (Int -> ProtocolParams -> ShowS
[ProtocolParams] -> ShowS
ProtocolParams -> String
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
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. 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
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
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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> [(Text, a)]
singleSample
    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 = Discrete' "ADA" '(1000000, 1)
2000000
      , _protocolParamsPoolDeposit :: Lovelaces
_protocolParamsPoolDeposit = Discrete' "ADA" '(1000000, 1)
500000000
      , _protocolParamsEMax :: Integer
_protocolParamsEMax = Integer
18
      , _protocolParamsNOpt :: Integer
_protocolParamsNOpt = Integer
150
      , _protocolParamsA0 :: Rational
_protocolParamsA0 = Rational
0.3
      , _protocolParamsRho :: Rational
_protocolParamsRho = Rational
0.003
      , _protocolParamsTau :: Rational
_protocolParamsTau = Rational
0.2
      , _protocolParamsDecentralisationParam :: Rational
_protocolParamsDecentralisationParam = Rational
0.5
      , _protocolParamsExtraEntropy :: Maybe Text
_protocolParamsExtraEntropy = forall a. Maybe a
Nothing
      , _protocolParamsProtocolMajorVer :: Integer
_protocolParamsProtocolMajorVer = Integer
2
      , _protocolParamsProtocolMinorVer :: Integer
_protocolParamsProtocolMinorVer = Integer
0
      , _protocolParamsMinUtxo :: Lovelaces
_protocolParamsMinUtxo = Discrete' "ADA" '(1000000, 1)
1000000
      , _protocolParamsMinPoolCost :: Lovelaces
_protocolParamsMinPoolCost = Discrete' "ADA" '(1000000, 1)
340000000
      , _protocolParamsNonce :: Text
_protocolParamsNonce = Text
"1a3be38bcbb7911969283716ad7aa550250226b76a61fc51cc9a9a35d9276d81"
      , _protocolParamsCostModels :: CostModels
_protocolParamsCostModels = CostModels
costModelsSample
      , _protocolParamsPriceMem :: Rational
_protocolParamsPriceMem = Rational
0.0577
      , _protocolParamsPriceStep :: Rational
_protocolParamsPriceStep = Rational
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
      , _protocolParamsCoinsPerUtxoSize :: Lovelaces
_protocolParamsCoinsPerUtxoSize = Discrete' "ADA" '(1000000, 1)
34482
      , _protocolParamsCoinsPerUtxoWord :: Lovelaces
_protocolParamsCoinsPerUtxoWord = Discrete' "ADA" '(1000000, 1)
34482
      }

newtype CostModels = CostModels { CostModels -> Map ScriptType (Map Text Integer)
unCostModels :: Map ScriptType (Map Text Integer) }
  deriving (CostModels -> CostModels -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CostModels -> CostModels -> Bool
$c/= :: CostModels -> CostModels -> Bool
== :: CostModels -> CostModels -> Bool
$c== :: CostModels -> CostModels -> Bool
Eq, Int -> CostModels -> ShowS
[CostModels] -> ShowS
CostModels -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CostModels] -> ShowS
$cshowList :: [CostModels] -> ShowS
show :: CostModels -> String
$cshow :: CostModels -> String
showsPrec :: Int -> CostModels -> ShowS
$cshowsPrec :: Int -> CostModels -> ShowS
Show, forall x. Rep CostModels x -> CostModels
forall x. CostModels -> Rep CostModels x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CostModels x -> CostModels
$cfrom :: forall x. CostModels -> Rep CostModels x
Generic)

instance ToJSON CostModels where
  toJSON :: CostModels -> Value
toJSON =
      [Pair] -> Value
object
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(ScriptType
lang, Map Text Integer
params) ->
        ( String -> Key
Data.Aeson.Key.fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ScriptType
lang
        , [Pair] -> Value
object
          forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Text
key, Integer
param) ->
              ( Text -> Key
Data.Aeson.Key.fromText Text
key
              , forall a. ToJSON a => a -> Value
toJSON Integer
param)
            )
            forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Data.Map.toList Map Text Integer
params
        ))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Data.Map.toList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostModels -> Map ScriptType (Map Text Integer)
unCostModels

instance FromJSON CostModels where
  parseJSON :: Value -> Parser CostModels
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CostModel" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    let parseParams :: Value -> Parser [(Text, Integer)]
parseParams = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CostModelParams" forall a b. (a -> b) -> a -> b
$ \Object
po -> do
          forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. FromJSON a => Value -> Parser a
parseJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON) forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [(Key, v)]
Data.Aeson.KeyMap.toList Object
po

    [(ScriptType, Map Text Integer)]
langs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
               (\(Key
kLang, Value
vParams) -> do
                 ScriptType
l <- forall a. FromJSON a => Value -> Parser a
parseJSON
                    forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON
                    forall a b. (a -> b) -> a -> b
$ (\String
lang -> case String
lang of
                        [] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Absurd empty language in CostModels"
                        (Char
x:String
xs) -> Char -> Char
Data.Char.toLower Char
xforall a. a -> [a] -> [a]
:String
xs
                      )
                    forall a b. (a -> b) -> a -> b
$ Key -> String
Data.Aeson.Key.toString Key
kLang
                 [(Text, Integer)]
ps <- Value -> Parser [(Text, Integer)]
parseParams Value
vParams
                 forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptType
l, forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Text, Integer)]
ps)
               )
               forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [(Key, v)]
Data.Aeson.KeyMap.toList Object
o

    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Map ScriptType (Map Text Integer) -> CostModels
CostModels forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(ScriptType, Map Text Integer)]
langs

costModelsSample :: CostModels
costModelsSample :: CostModels
costModelsSample = Map ScriptType (Map Text Integer) -> CostModels
CostModels
      forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
      [ ( ScriptType
PlutusV1
        , forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [ (Text
"addInteger-cpu-arguments-intercept", Integer
197209)
          , (Text
"addInteger-cpu-arguments-slope", Integer
0)
          ]
        )
      , (ScriptType
PlutusV2
        , forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
          [ (Text
"addInteger-cpu-arguments-intercept", Integer
197209)
          , (Text
"addInteger-cpu-arguments-slope", Integer
0)
          ]
        )
      ]

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

-- | 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
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
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. 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
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
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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> [(Text, a)]
singleSample
    StakeDistribution
      { _stakeDistributionStakeAddress :: Address
_stakeDistributionStakeAddress = Address
"stake1u9l5q5jwgelgagzyt6nuaasefgmn8pd25c8e9qpeprq0tdcp0e3uk"
      , _stakeDistributionPoolId :: PoolId
_stakeDistributionPoolId = PoolId
"pool1pu5jlj4q9w9jlxeu370a3c9myx47md5j5m2str0naunn2q3lkdy"
      , _stakeDistributionAmount :: Lovelaces
_stakeDistributionAmount = Discrete' "ADA" '(1000000, 1)
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
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
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. 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
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
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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> [(Text, a)]
singleSample
    PoolStakeDistribution
      { _poolStakeDistributionStakeAddress :: Address
_poolStakeDistributionStakeAddress = Address
"stake1u9l5q5jwgelgagzyt6nuaasefgmn8pd25c8e9qpeprq0tdcp0e3uk"
      , _poolStakeDistributionAmount :: Lovelaces
_poolStakeDistributionAmount = Discrete' "ADA" '(1000000, 1)
4440295078
      }