-- | Cardano Pools reponses

module Blockfrost.Types.Cardano.Pools
  ( PoolEpoch (..)
  , PoolInfo (..)
  , PoolHistory (..)
  , PoolMetadata (..)
  , PoolRelay (..)
  , PoolDelegator (..)
  , PoolUpdate (..)
  , PoolRegistrationAction (..)
  , samplePoolRelay
  ) where

import Data.Aeson (FromJSON (..), ToJSON (..), object, pairs, withText)
import Data.Text (Text)
import Deriving.Aeson
import Servant.Docs (ToSample (..), samples, singleSample)

import Blockfrost.Types.Shared

-- | Retirement epoch for pool
data PoolEpoch = PoolEpoch
  { PoolEpoch -> PoolId
_poolEpochPoolId :: PoolId -- ^ Bech32 encoded pool ID
  , PoolEpoch -> Epoch
_poolEpochEpoch  :: Epoch -- ^ Retirement epoch number
  }
  deriving stock (Int -> PoolEpoch -> ShowS
[PoolEpoch] -> ShowS
PoolEpoch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolEpoch] -> ShowS
$cshowList :: [PoolEpoch] -> ShowS
show :: PoolEpoch -> String
$cshow :: PoolEpoch -> String
showsPrec :: Int -> PoolEpoch -> ShowS
$cshowsPrec :: Int -> PoolEpoch -> ShowS
Show, PoolEpoch -> PoolEpoch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolEpoch -> PoolEpoch -> Bool
$c/= :: PoolEpoch -> PoolEpoch -> Bool
== :: PoolEpoch -> PoolEpoch -> Bool
$c== :: PoolEpoch -> PoolEpoch -> Bool
Eq, forall x. Rep PoolEpoch x -> PoolEpoch
forall x. PoolEpoch -> Rep PoolEpoch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PoolEpoch x -> PoolEpoch
$cfrom :: forall x. PoolEpoch -> Rep PoolEpoch x
Generic)
  deriving (Value -> Parser [PoolEpoch]
Value -> Parser PoolEpoch
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PoolEpoch]
$cparseJSONList :: Value -> Parser [PoolEpoch]
parseJSON :: Value -> Parser PoolEpoch
$cparseJSON :: Value -> Parser PoolEpoch
FromJSON, [PoolEpoch] -> Encoding
[PoolEpoch] -> Value
PoolEpoch -> Encoding
PoolEpoch -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PoolEpoch] -> Encoding
$ctoEncodingList :: [PoolEpoch] -> Encoding
toJSONList :: [PoolEpoch] -> Value
$ctoJSONList :: [PoolEpoch] -> Value
toEncoding :: PoolEpoch -> Encoding
$ctoEncoding :: PoolEpoch -> Encoding
toJSON :: PoolEpoch -> Value
$ctoJSON :: PoolEpoch -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_poolEpoch", CamelToSnake]] PoolEpoch

instance ToSample PoolEpoch where
  toSamples :: Proxy PoolEpoch -> [(Text, PoolEpoch)]
toSamples = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(Text, a)]
samples
    [ PoolId -> Epoch -> PoolEpoch
PoolEpoch PoolId
"pool19u64770wqp6s95gkajc8udheske5e6ljmpq33awxk326zjaza0q" Epoch
225
    , PoolId -> Epoch -> PoolEpoch
PoolEpoch PoolId
"pool1dvla4zq98hpvacv20snndupjrqhuc79zl6gjap565nku6et5zdx" Epoch
215
    , PoolId -> Epoch -> PoolEpoch
PoolEpoch PoolId
"pool1wvccajt4eugjtf3k0ja3exjqdj7t8egsujwhcw4tzj4rzsxzw5w" Epoch
231
    ]

-- | Detailed pool information
data PoolInfo = PoolInfo
  { PoolInfo -> PoolId
_poolInfoPoolId         :: PoolId -- ^ Bech32 encoded pool ID
  , PoolInfo -> Text
_poolInfoHex            :: Text -- ^ Hexadecimal pool ID.
  , PoolInfo -> Text
_poolInfoVrfKey         :: Text -- ^ VRF key hash
  , PoolInfo -> Integer
_poolInfoBlocksMinted   :: Integer -- ^ Total minted blocks
  , PoolInfo -> Integer
_poolInfoBlocksEpoch    :: Integer -- ^ Number of blocks minted in the current epoch
  , PoolInfo -> Lovelaces
_poolInfoLiveStake      :: Lovelaces
  , PoolInfo -> Double
_poolInfoLiveSize       :: Double
  , PoolInfo -> Double
_poolInfoLiveSaturation :: Double
  , PoolInfo -> Double
_poolInfoLiveDelegators :: Double
  , PoolInfo -> Lovelaces
_poolInfoActiveStake    :: Lovelaces
  , PoolInfo -> Double
_poolInfoActiveSize     :: Double
  , PoolInfo -> Lovelaces
_poolInfoDeclaredPledge :: Lovelaces -- ^ Stake pool certificate pledge
  , PoolInfo -> Lovelaces
_poolInfoLivePledge     :: Lovelaces -- ^ Stake pool current pledge
  , PoolInfo -> Rational
_poolInfoMarginCost     :: Rational -- ^ Margin tax cost of the stake pool
  , PoolInfo -> Lovelaces
_poolInfoFixedCost      :: Lovelaces -- ^ Fixed tax cost of the stake pool
  , PoolInfo -> Address
_poolInfoRewardAccount  :: Address -- ^ Bech32 reward account of the stake pool
  , PoolInfo -> [Address]
_poolInfoOwners         :: [Address]
  , PoolInfo -> [Text]
_poolInfoRegistration   :: [Text]
  , PoolInfo -> [Text]
_poolInfoRetirement     :: [Text]
  }
  deriving stock (Int -> PoolInfo -> ShowS
[PoolInfo] -> ShowS
PoolInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolInfo] -> ShowS
$cshowList :: [PoolInfo] -> ShowS
show :: PoolInfo -> String
$cshow :: PoolInfo -> String
showsPrec :: Int -> PoolInfo -> ShowS
$cshowsPrec :: Int -> PoolInfo -> ShowS
Show, PoolInfo -> PoolInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolInfo -> PoolInfo -> Bool
$c/= :: PoolInfo -> PoolInfo -> Bool
== :: PoolInfo -> PoolInfo -> Bool
$c== :: PoolInfo -> PoolInfo -> Bool
Eq, forall x. Rep PoolInfo x -> PoolInfo
forall x. PoolInfo -> Rep PoolInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PoolInfo x -> PoolInfo
$cfrom :: forall x. PoolInfo -> Rep PoolInfo x
Generic)
  deriving (Value -> Parser [PoolInfo]
Value -> Parser PoolInfo
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PoolInfo]
$cparseJSONList :: Value -> Parser [PoolInfo]
parseJSON :: Value -> Parser PoolInfo
$cparseJSON :: Value -> Parser PoolInfo
FromJSON, [PoolInfo] -> Encoding
[PoolInfo] -> Value
PoolInfo -> Encoding
PoolInfo -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PoolInfo] -> Encoding
$ctoEncodingList :: [PoolInfo] -> Encoding
toJSONList :: [PoolInfo] -> Value
$ctoJSONList :: [PoolInfo] -> Value
toEncoding :: PoolInfo -> Encoding
$ctoEncoding :: PoolInfo -> Encoding
toJSON :: PoolInfo -> Value
$ctoJSON :: PoolInfo -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_poolInfo", CamelToSnake]] PoolInfo

instance ToSample PoolInfo where
  toSamples :: Proxy PoolInfo -> [(Text, PoolInfo)]
toSamples = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> [(Text, a)]
singleSample
    PoolInfo
      { _poolInfoPoolId :: PoolId
_poolInfoPoolId = PoolId
"pool1pu5jlj4q9w9jlxeu370a3c9myx47md5j5m2str0naunn2q3lkdy"
      , _poolInfoHex :: Text
_poolInfoHex = Text
"0f292fcaa02b8b2f9b3c8f9fd8e0bb21abedb692a6d5058df3ef2735"
      , _poolInfoVrfKey :: Text
_poolInfoVrfKey = Text
"0b5245f9934ec2151116fb8ec00f35fd00e0aa3b075c4ed12cce440f999d8233"
      , _poolInfoBlocksMinted :: Integer
_poolInfoBlocksMinted = Integer
69
      , _poolInfoBlocksEpoch :: Integer
_poolInfoBlocksEpoch = Integer
4
      , _poolInfoLiveStake :: Lovelaces
_poolInfoLiveStake = Discrete' "ADA" '(1000000, 1)
6900000000
      , _poolInfoLiveSize :: Double
_poolInfoLiveSize = Double
0.42
      , _poolInfoLiveSaturation :: Double
_poolInfoLiveSaturation = Double
0.93
      , _poolInfoLiveDelegators :: Double
_poolInfoLiveDelegators = Double
127
      , _poolInfoActiveStake :: Lovelaces
_poolInfoActiveStake = Discrete' "ADA" '(1000000, 1)
4200000000
      , _poolInfoActiveSize :: Double
_poolInfoActiveSize = Double
0.43
      , _poolInfoDeclaredPledge :: Lovelaces
_poolInfoDeclaredPledge = Discrete' "ADA" '(1000000, 1)
5000000000
      , _poolInfoLivePledge :: Lovelaces
_poolInfoLivePledge = Discrete' "ADA" '(1000000, 1)
5000000001
      , _poolInfoMarginCost :: Rational
_poolInfoMarginCost = Rational
0.05
      , _poolInfoFixedCost :: Lovelaces
_poolInfoFixedCost = Discrete' "ADA" '(1000000, 1)
340000000
      , _poolInfoRewardAccount :: Address
_poolInfoRewardAccount = Address
"stake1uxkptsa4lkr55jleztw43t37vgdn88l6ghclfwuxld2eykgpgvg3f"
      , _poolInfoOwners :: [Address]
_poolInfoOwners = [ Address
"stake1u98nnlkvkk23vtvf9273uq7cph5ww6u2yq2389psuqet90sv4xv9v" ]
      , _poolInfoRegistration :: [Text]
_poolInfoRegistration =
          [ Text
"9f83e5484f543e05b52e99988272a31da373f3aab4c064c76db96643a355d9dc"
          , Text
"7ce3b8c433bf401a190d58c8c483d8e3564dfd29ae8633c8b1b3e6c814403e95"
          , Text
"3e6e1200ce92977c3fe5996bd4d7d7e192bcb7e231bc762f9f240c76766535b9"
          ]
      , _poolInfoRetirement :: [Text]
_poolInfoRetirement = [ Text
"252f622976d39e646815db75a77289cf16df4ad2b287dd8e3a889ce14c13d1a8" ]
      }

-- | History of a stake pool parameters over epochs
data PoolHistory = PoolHistory
  { PoolHistory -> Epoch
_poolHistoryEpoch           :: Epoch -- ^ Epoch number
  , PoolHistory -> Integer
_poolHistoryBlocks          :: Integer -- ^ Number of blocks created by pool
  , PoolHistory -> Lovelaces
_poolHistoryActiveStake     :: Lovelaces -- ^ Active (Snapshot of live stake 2 epochs ago) stake in Lovelaces
  , PoolHistory -> Double
_poolHistoryActiveSize      :: Double -- ^ Pool size (percentage) of overall active stake at that epoch
  , PoolHistory -> Integer
_poolHistoryDelegatorsCount :: Integer -- ^ Number of delegators for epoch
  , PoolHistory -> Lovelaces
_poolHistoryRewards         :: Lovelaces -- ^ Total rewards received before distribution to delegators
  , PoolHistory -> Lovelaces
_poolHistoryFees            :: Lovelaces -- ^ Pool operator rewards
  }
  deriving stock (Int -> PoolHistory -> ShowS
[PoolHistory] -> ShowS
PoolHistory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolHistory] -> ShowS
$cshowList :: [PoolHistory] -> ShowS
show :: PoolHistory -> String
$cshow :: PoolHistory -> String
showsPrec :: Int -> PoolHistory -> ShowS
$cshowsPrec :: Int -> PoolHistory -> ShowS
Show, PoolHistory -> PoolHistory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolHistory -> PoolHistory -> Bool
$c/= :: PoolHistory -> PoolHistory -> Bool
== :: PoolHistory -> PoolHistory -> Bool
$c== :: PoolHistory -> PoolHistory -> Bool
Eq, forall x. Rep PoolHistory x -> PoolHistory
forall x. PoolHistory -> Rep PoolHistory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PoolHistory x -> PoolHistory
$cfrom :: forall x. PoolHistory -> Rep PoolHistory x
Generic)
  deriving (Value -> Parser [PoolHistory]
Value -> Parser PoolHistory
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PoolHistory]
$cparseJSONList :: Value -> Parser [PoolHistory]
parseJSON :: Value -> Parser PoolHistory
$cparseJSON :: Value -> Parser PoolHistory
FromJSON, [PoolHistory] -> Encoding
[PoolHistory] -> Value
PoolHistory -> Encoding
PoolHistory -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PoolHistory] -> Encoding
$ctoEncodingList :: [PoolHistory] -> Encoding
toJSONList :: [PoolHistory] -> Value
$ctoJSONList :: [PoolHistory] -> Value
toEncoding :: PoolHistory -> Encoding
$ctoEncoding :: PoolHistory -> Encoding
toJSON :: PoolHistory -> Value
$ctoJSON :: PoolHistory -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_poolHistory", CamelToSnake]] PoolHistory

instance ToSample PoolHistory where
  toSamples :: Proxy PoolHistory -> [(Text, PoolHistory)]
toSamples = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> [(Text, a)]
singleSample
    PoolHistory
      { _poolHistoryEpoch :: Epoch
_poolHistoryEpoch = Epoch
233
      , _poolHistoryBlocks :: Integer
_poolHistoryBlocks = Integer
22
      , _poolHistoryActiveStake :: Lovelaces
_poolHistoryActiveStake = Discrete' "ADA" '(1000000, 1)
20485965693569
      , _poolHistoryActiveSize :: Double
_poolHistoryActiveSize = Double
1.2345
      , _poolHistoryDelegatorsCount :: Integer
_poolHistoryDelegatorsCount = Integer
115
      , _poolHistoryRewards :: Lovelaces
_poolHistoryRewards = Discrete' "ADA" '(1000000, 1)
206936253674159
      , _poolHistoryFees :: Lovelaces
_poolHistoryFees = Discrete' "ADA" '(1000000, 1)
1290968354
      }

-- | Stake pool registration metadata
data PoolMetadata = PoolMetadata
  { PoolMetadata -> PoolId
_poolMetadataPoolId      :: PoolId -- ^ Bech32 pool ID
  , PoolMetadata -> Text
_poolMetadataHex         :: Text -- ^ Hexadecimal pool ID
  , PoolMetadata -> Maybe Text
_poolMetadataUrl         :: Maybe Text -- ^ URL to the stake pool metadata
  , PoolMetadata -> Maybe Text
_poolMetadataHash        :: Maybe Text -- ^ Hash of the metadata file
  , PoolMetadata -> Maybe Text
_poolMetadataTicker      :: Maybe Text -- ^ Ticker of the stake pool
  , PoolMetadata -> Maybe Text
_poolMetadataName        :: Maybe Text -- ^ Name of the stake pool
  , PoolMetadata -> Maybe Text
_poolMetadataDescription :: Maybe Text -- ^ Description of the stake pool
  , PoolMetadata -> Maybe Text
_poolMetadataHomepage    :: Maybe Text -- ^ Home page of the stake pool
  }
  deriving stock (Int -> PoolMetadata -> ShowS
[PoolMetadata] -> ShowS
PoolMetadata -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolMetadata] -> ShowS
$cshowList :: [PoolMetadata] -> ShowS
show :: PoolMetadata -> String
$cshow :: PoolMetadata -> String
showsPrec :: Int -> PoolMetadata -> ShowS
$cshowsPrec :: Int -> PoolMetadata -> ShowS
Show, PoolMetadata -> PoolMetadata -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolMetadata -> PoolMetadata -> Bool
$c/= :: PoolMetadata -> PoolMetadata -> Bool
== :: PoolMetadata -> PoolMetadata -> Bool
$c== :: PoolMetadata -> PoolMetadata -> Bool
Eq, forall x. Rep PoolMetadata x -> PoolMetadata
forall x. PoolMetadata -> Rep PoolMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PoolMetadata x -> PoolMetadata
$cfrom :: forall x. PoolMetadata -> Rep PoolMetadata x
Generic)
  deriving (Value -> Parser [PoolMetadata]
Value -> Parser PoolMetadata
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PoolMetadata]
$cparseJSONList :: Value -> Parser [PoolMetadata]
parseJSON :: Value -> Parser PoolMetadata
$cparseJSON :: Value -> Parser PoolMetadata
FromJSON, [PoolMetadata] -> Encoding
[PoolMetadata] -> Value
PoolMetadata -> Encoding
PoolMetadata -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PoolMetadata] -> Encoding
$ctoEncodingList :: [PoolMetadata] -> Encoding
toJSONList :: [PoolMetadata] -> Value
$ctoJSONList :: [PoolMetadata] -> Value
toEncoding :: PoolMetadata -> Encoding
$ctoEncoding :: PoolMetadata -> Encoding
toJSON :: PoolMetadata -> Value
$ctoJSON :: PoolMetadata -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_poolMetadata", CamelToSnake]] PoolMetadata

-- We need this more specific
-- instance since API returns
-- empty object if there's no metadata
instance {-# OVERLAPS #-} ToJSON (Maybe PoolMetadata) where
  toJSON :: Maybe PoolMetadata -> Value
toJSON Maybe PoolMetadata
Nothing   = [Pair] -> Value
object forall a. Monoid a => a
mempty
  toJSON (Just PoolMetadata
pm) = forall a. ToJSON a => a -> Value
toJSON PoolMetadata
pm
  toEncoding :: Maybe PoolMetadata -> Encoding
toEncoding Maybe PoolMetadata
Nothing   = Series -> Encoding
pairs forall a. Monoid a => a
mempty
  toEncoding (Just PoolMetadata
pm) = forall a. ToJSON a => a -> Encoding
toEncoding PoolMetadata
pm
instance {-# OVERLAPS #-} FromJSON (Maybe PoolMetadata) where
  parseJSON :: Value -> Parser (Maybe PoolMetadata)
parseJSON Value
x | Value
x forall a. Eq a => a -> a -> Bool
== [Pair] -> Value
object [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  parseJSON Value
x = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
x

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

samplePoolMetadata :: PoolMetadata
samplePoolMetadata :: PoolMetadata
samplePoolMetadata =
  PoolMetadata
    { _poolMetadataPoolId :: PoolId
_poolMetadataPoolId = PoolId
"pool1pu5jlj4q9w9jlxeu370a3c9myx47md5j5m2str0naunn2q3lkdy"
    , _poolMetadataHex :: Text
_poolMetadataHex = Text
"0f292fcaa02b8b2f9b3c8f9fd8e0bb21abedb692a6d5058df3ef2735"
    , _poolMetadataUrl :: Maybe Text
_poolMetadataUrl = forall a. a -> Maybe a
Just Text
"https://stakenuts.com/mainnet.json"
    , _poolMetadataHash :: Maybe Text
_poolMetadataHash = forall a. a -> Maybe a
Just Text
"47c0c68cb57f4a5b4a87bad896fc274678e7aea98e200fa14a1cb40c0cab1d8c"
    , _poolMetadataTicker :: Maybe Text
_poolMetadataTicker = forall a. a -> Maybe a
Just Text
"NUTS"
    , _poolMetadataName :: Maybe Text
_poolMetadataName = forall a. a -> Maybe a
Just Text
"Stake Nuts"
    , _poolMetadataDescription :: Maybe Text
_poolMetadataDescription = forall a. a -> Maybe a
Just Text
"The best pool ever"
    , _poolMetadataHomepage :: Maybe Text
_poolMetadataHomepage = forall a. a -> Maybe a
Just Text
"https://stakentus.com/"
    }

-- | Relays of a stake pool
data PoolRelay = PoolRelay
  { PoolRelay -> Maybe Text
_poolRelayIpv4   :: Maybe Text -- ^ IPv4 address of the relay
  , PoolRelay -> Maybe Text
_poolRelayIpv6   :: Maybe Text -- ^ IPv6 address of the relay
  , PoolRelay -> Maybe Text
_poolRelayDns    :: Maybe Text -- ^ DNS name of the relay
  , PoolRelay -> Maybe Text
_poolRelayDnsSrv :: Maybe Text -- ^ DNS SRV entry of the relay
  , PoolRelay -> Integer
_poolRelayPort   :: Integer -- ^ Network port of the relay
  }
  deriving stock (Int -> PoolRelay -> ShowS
[PoolRelay] -> ShowS
PoolRelay -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolRelay] -> ShowS
$cshowList :: [PoolRelay] -> ShowS
show :: PoolRelay -> String
$cshow :: PoolRelay -> String
showsPrec :: Int -> PoolRelay -> ShowS
$cshowsPrec :: Int -> PoolRelay -> ShowS
Show, PoolRelay -> PoolRelay -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolRelay -> PoolRelay -> Bool
$c/= :: PoolRelay -> PoolRelay -> Bool
== :: PoolRelay -> PoolRelay -> Bool
$c== :: PoolRelay -> PoolRelay -> Bool
Eq, forall x. Rep PoolRelay x -> PoolRelay
forall x. PoolRelay -> Rep PoolRelay x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PoolRelay x -> PoolRelay
$cfrom :: forall x. PoolRelay -> Rep PoolRelay x
Generic)
  deriving (Value -> Parser [PoolRelay]
Value -> Parser PoolRelay
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PoolRelay]
$cparseJSONList :: Value -> Parser [PoolRelay]
parseJSON :: Value -> Parser PoolRelay
$cparseJSON :: Value -> Parser PoolRelay
FromJSON, [PoolRelay] -> Encoding
[PoolRelay] -> Value
PoolRelay -> Encoding
PoolRelay -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PoolRelay] -> Encoding
$ctoEncodingList :: [PoolRelay] -> Encoding
toJSONList :: [PoolRelay] -> Value
$ctoJSONList :: [PoolRelay] -> Value
toEncoding :: PoolRelay -> Encoding
$ctoEncoding :: PoolRelay -> Encoding
toJSON :: PoolRelay -> Value
$ctoJSON :: PoolRelay -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_poolRelay", CamelToSnake]] PoolRelay

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

-- | Example of `PoolRelay`
samplePoolRelay :: PoolRelay
samplePoolRelay :: PoolRelay
samplePoolRelay =
  PoolRelay
    { _poolRelayIpv4 :: Maybe Text
_poolRelayIpv4 = forall a. a -> Maybe a
Just Text
"4.4.4.4"
    , _poolRelayIpv6 :: Maybe Text
_poolRelayIpv6 = forall a. a -> Maybe a
Just Text
"https://stakenuts.com/mainnet.json"
    , _poolRelayDns :: Maybe Text
_poolRelayDns = forall a. a -> Maybe a
Just Text
"relay1.stakenuts.com"
    , _poolRelayDnsSrv :: Maybe Text
_poolRelayDnsSrv = forall a. a -> Maybe a
Just Text
"_relays._tcp.relays.stakenuts.com"
    , _poolRelayPort :: Integer
_poolRelayPort = Integer
3001
    }

-- | Stake pool delegator
data PoolDelegator = PoolDelegator
  { PoolDelegator -> Text
_poolDelegatorAddress   :: Text -- ^ Bech32 encoded stake addresses
  , PoolDelegator -> Lovelaces
_poolDelegatorLiveStake :: Lovelaces -- ^ Currently delegated amount
  }
  deriving stock (Int -> PoolDelegator -> ShowS
[PoolDelegator] -> ShowS
PoolDelegator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolDelegator] -> ShowS
$cshowList :: [PoolDelegator] -> ShowS
show :: PoolDelegator -> String
$cshow :: PoolDelegator -> String
showsPrec :: Int -> PoolDelegator -> ShowS
$cshowsPrec :: Int -> PoolDelegator -> ShowS
Show, PoolDelegator -> PoolDelegator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolDelegator -> PoolDelegator -> Bool
$c/= :: PoolDelegator -> PoolDelegator -> Bool
== :: PoolDelegator -> PoolDelegator -> Bool
$c== :: PoolDelegator -> PoolDelegator -> Bool
Eq, forall x. Rep PoolDelegator x -> PoolDelegator
forall x. PoolDelegator -> Rep PoolDelegator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PoolDelegator x -> PoolDelegator
$cfrom :: forall x. PoolDelegator -> Rep PoolDelegator x
Generic)
  deriving (Value -> Parser [PoolDelegator]
Value -> Parser PoolDelegator
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PoolDelegator]
$cparseJSONList :: Value -> Parser [PoolDelegator]
parseJSON :: Value -> Parser PoolDelegator
$cparseJSON :: Value -> Parser PoolDelegator
FromJSON, [PoolDelegator] -> Encoding
[PoolDelegator] -> Value
PoolDelegator -> Encoding
PoolDelegator -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PoolDelegator] -> Encoding
$ctoEncodingList :: [PoolDelegator] -> Encoding
toJSONList :: [PoolDelegator] -> Value
$ctoJSONList :: [PoolDelegator] -> Value
toEncoding :: PoolDelegator -> Encoding
$ctoEncoding :: PoolDelegator -> Encoding
toJSON :: PoolDelegator -> Value
$ctoJSON :: PoolDelegator -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_poolDelegator", CamelToSnake]] PoolDelegator

instance ToSample PoolDelegator where
  toSamples :: Proxy PoolDelegator -> [(Text, PoolDelegator)]
toSamples = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(Text, a)]
samples
    [ PoolDelegator
        { _poolDelegatorAddress :: Text
_poolDelegatorAddress = Text
"stake1ux4vspfvwuus9uwyp5p3f0ky7a30jq5j80jxse0fr7pa56sgn8kha"
        , _poolDelegatorLiveStake :: Lovelaces
_poolDelegatorLiveStake = Discrete' "ADA" '(1000000, 1)
1137959159981411
        }
    , PoolDelegator
        { _poolDelegatorAddress :: Text
_poolDelegatorAddress = Text
"stake1uylayej7esmarzd4mk4aru37zh9yz0luj3g9fsvgpfaxulq564r5u"
        , _poolDelegatorLiveStake :: Lovelaces
_poolDelegatorLiveStake = Discrete' "ADA" '(1000000, 1)
16958865648
        }
    , PoolDelegator
        { _poolDelegatorAddress :: Text
_poolDelegatorAddress = Text
"stake1u8lr2pnrgf8f7vrs9lt79hc3sxm8s2w4rwvgpncks3axx6q93d4ck"
        , _poolDelegatorLiveStake :: Lovelaces
_poolDelegatorLiveStake = Discrete' "ADA" '(1000000, 1)
18605647
        }
    ]

-- | Registration action of a pool
data PoolRegistrationAction = PoolRegistered | PoolDeregistered
  deriving stock (Int -> PoolRegistrationAction -> ShowS
[PoolRegistrationAction] -> ShowS
PoolRegistrationAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolRegistrationAction] -> ShowS
$cshowList :: [PoolRegistrationAction] -> ShowS
show :: PoolRegistrationAction -> String
$cshow :: PoolRegistrationAction -> String
showsPrec :: Int -> PoolRegistrationAction -> ShowS
$cshowsPrec :: Int -> PoolRegistrationAction -> ShowS
Show, PoolRegistrationAction -> PoolRegistrationAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolRegistrationAction -> PoolRegistrationAction -> Bool
$c/= :: PoolRegistrationAction -> PoolRegistrationAction -> Bool
== :: PoolRegistrationAction -> PoolRegistrationAction -> Bool
$c== :: PoolRegistrationAction -> PoolRegistrationAction -> Bool
Eq, forall x. Rep PoolRegistrationAction x -> PoolRegistrationAction
forall x. PoolRegistrationAction -> Rep PoolRegistrationAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PoolRegistrationAction x -> PoolRegistrationAction
$cfrom :: forall x. PoolRegistrationAction -> Rep PoolRegistrationAction x
Generic)

instance ToJSON PoolRegistrationAction where
  toJSON :: PoolRegistrationAction -> Value
toJSON PoolRegistrationAction
PoolRegistered   = forall a. ToJSON a => a -> Value
toJSON (Text
"registered" :: Text)
  toJSON PoolRegistrationAction
PoolDeregistered = forall a. ToJSON a => a -> Value
toJSON (Text
"deregistered" :: Text)
  toEncoding :: PoolRegistrationAction -> Encoding
toEncoding PoolRegistrationAction
PoolRegistered   = forall a. ToJSON a => a -> Encoding
toEncoding (Text
"registered" :: Text)
  toEncoding PoolRegistrationAction
PoolDeregistered = forall a. ToJSON a => a -> Encoding
toEncoding (Text
"deregistered" :: Text)

instance FromJSON PoolRegistrationAction where
  parseJSON :: Value -> Parser PoolRegistrationAction
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"action" forall a b. (a -> b) -> a -> b
$ \case
    Text
"registered"   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PoolRegistrationAction
PoolRegistered
    Text
"deregistered" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PoolRegistrationAction
PoolDeregistered
    Text
x              -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Expected registration action got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
x)

instance ToSample PoolRegistrationAction where
  toSamples :: Proxy PoolRegistrationAction -> [(Text, PoolRegistrationAction)]
toSamples = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(Text, a)]
samples [ PoolRegistrationAction
PoolRegistered, PoolRegistrationAction
PoolDeregistered ]

-- | Certificate update to the stake pool
data PoolUpdate = PoolUpdate
  { PoolUpdate -> TxHash
_poolUpdateTxHash    :: TxHash -- ^ Transaction ID
  , PoolUpdate -> Integer
_poolUpdateCertIndex :: Integer -- ^ Certificate within the transaction
  , PoolUpdate -> PoolRegistrationAction
_poolUpdateAction    :: PoolRegistrationAction -- ^ Action in the certificate
  }
  deriving stock (Int -> PoolUpdate -> ShowS
[PoolUpdate] -> ShowS
PoolUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolUpdate] -> ShowS
$cshowList :: [PoolUpdate] -> ShowS
show :: PoolUpdate -> String
$cshow :: PoolUpdate -> String
showsPrec :: Int -> PoolUpdate -> ShowS
$cshowsPrec :: Int -> PoolUpdate -> ShowS
Show, PoolUpdate -> PoolUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolUpdate -> PoolUpdate -> Bool
$c/= :: PoolUpdate -> PoolUpdate -> Bool
== :: PoolUpdate -> PoolUpdate -> Bool
$c== :: PoolUpdate -> PoolUpdate -> Bool
Eq, forall x. Rep PoolUpdate x -> PoolUpdate
forall x. PoolUpdate -> Rep PoolUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PoolUpdate x -> PoolUpdate
$cfrom :: forall x. PoolUpdate -> Rep PoolUpdate x
Generic)
  deriving (Value -> Parser [PoolUpdate]
Value -> Parser PoolUpdate
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PoolUpdate]
$cparseJSONList :: Value -> Parser [PoolUpdate]
parseJSON :: Value -> Parser PoolUpdate
$cparseJSON :: Value -> Parser PoolUpdate
FromJSON, [PoolUpdate] -> Encoding
[PoolUpdate] -> Value
PoolUpdate -> Encoding
PoolUpdate -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PoolUpdate] -> Encoding
$ctoEncodingList :: [PoolUpdate] -> Encoding
toJSONList :: [PoolUpdate] -> Value
$ctoJSONList :: [PoolUpdate] -> Value
toEncoding :: PoolUpdate -> Encoding
$ctoEncoding :: PoolUpdate -> Encoding
toJSON :: PoolUpdate -> Value
$ctoJSON :: PoolUpdate -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_poolUpdate", CamelToSnake]] PoolUpdate

instance ToSample PoolUpdate where
  toSamples :: Proxy PoolUpdate -> [(Text, PoolUpdate)]
toSamples = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(Text, a)]
samples
    [ PoolUpdate
        { _poolUpdateTxHash :: TxHash
_poolUpdateTxHash = TxHash
"6804edf9712d2b619edb6ac86861fe93a730693183a262b165fcc1ba1bc99cad"
        , _poolUpdateCertIndex :: Integer
_poolUpdateCertIndex = Integer
0
        , _poolUpdateAction :: PoolRegistrationAction
_poolUpdateAction = PoolRegistrationAction
PoolRegistered
        }
    , PoolUpdate
        { _poolUpdateTxHash :: TxHash
_poolUpdateTxHash = TxHash
"9c190bc1ac88b2ab0c05a82d7de8b71b67a9316377e865748a89d4426c0d3005"
        , _poolUpdateCertIndex :: Integer
_poolUpdateCertIndex = Integer
0
        , _poolUpdateAction :: PoolRegistrationAction
_poolUpdateAction = PoolRegistrationAction
PoolDeregistered
        }
    , PoolUpdate
        { _poolUpdateTxHash :: TxHash
_poolUpdateTxHash = TxHash
"e14a75b0eb2625de7055f1f580d70426311b78e0d36dd695a6bdc96c7b3d80e0"
        , _poolUpdateCertIndex :: Integer
_poolUpdateCertIndex = Integer
1
        , _poolUpdateAction :: PoolRegistrationAction
_poolUpdateAction = PoolRegistrationAction
PoolRegistered
        }
    ]