{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Ledger.PoolParams (
  PoolParams (..),
  PoolMetadata (..),
  StakePoolRelay (..),
  SizeOfPoolRelays (..),
  SizeOfPoolOwners (..),
)
where

import Cardano.Ledger.Address (RewardAccount (..))
import Cardano.Ledger.BaseTypes (
  DnsName,
  Port,
  StrictMaybe (..),
  UnitInterval,
  Url,
  invalidKey,
  maybeToStrictMaybe,
  strictMaybeToMaybe,
 )
import Cardano.Ledger.Binary (
  CBORGroup (..),
  Case (..),
  DecCBOR (decCBOR),
  DecCBORGroup (..),
  EncCBOR (..),
  EncCBORGroup (..),
  Size,
  decodeNullMaybe,
  decodeRecordNamed,
  decodeRecordSum,
  encodeListLen,
  encodeNullMaybe,
  szCases,
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..), KeyRoleVRF (StakePoolVRF), VRFVerKeyHash)
import Cardano.Ledger.Orphans ()
import Control.DeepSeq (NFData ())
import Data.Aeson (FromJSON (..), ToJSON (..), Value, (.!=), (.:), (.:?), (.=))
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (Parser, explicitParseField)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as Char8
import Data.Default (Default (..))
import Data.Foldable (asum)
import Data.IP (IPv4, IPv6)
import Data.Proxy (Proxy (..))
import Data.Sequence.Strict (StrictSeq)
import Data.Set (Set)
import qualified Data.Text.Encoding as Text
import Data.Word (Word8)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))

-- ========================================================================

data PoolMetadata = PoolMetadata
  { PoolMetadata -> Url
pmUrl :: !Url
  , PoolMetadata -> ByteString
pmHash :: !ByteString
  }
  deriving (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, Eq PoolMetadata
PoolMetadata -> PoolMetadata -> Bool
PoolMetadata -> PoolMetadata -> Ordering
PoolMetadata -> PoolMetadata -> PoolMetadata
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PoolMetadata -> PoolMetadata -> PoolMetadata
$cmin :: PoolMetadata -> PoolMetadata -> PoolMetadata
max :: PoolMetadata -> PoolMetadata -> PoolMetadata
$cmax :: PoolMetadata -> PoolMetadata -> PoolMetadata
>= :: PoolMetadata -> PoolMetadata -> Bool
$c>= :: PoolMetadata -> PoolMetadata -> Bool
> :: PoolMetadata -> PoolMetadata -> Bool
$c> :: PoolMetadata -> PoolMetadata -> Bool
<= :: PoolMetadata -> PoolMetadata -> Bool
$c<= :: PoolMetadata -> PoolMetadata -> Bool
< :: PoolMetadata -> PoolMetadata -> Bool
$c< :: PoolMetadata -> PoolMetadata -> Bool
compare :: PoolMetadata -> PoolMetadata -> Ordering
$ccompare :: PoolMetadata -> PoolMetadata -> Ordering
Ord, 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, 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)

deriving instance NFData PoolMetadata

instance ToJSON PoolMetadata where
  toJSON :: PoolMetadata -> Value
toJSON PoolMetadata
pmd =
    [Pair] -> Value
Aeson.object
      [ Key
"url" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolMetadata -> Url
pmUrl PoolMetadata
pmd
      , Key
"hash" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
Text.decodeLatin1 (ByteString -> ByteString
B16.encode (PoolMetadata -> ByteString
pmHash PoolMetadata
pmd))
      ]

instance FromJSON PoolMetadata where
  parseJSON :: Value -> Parser PoolMetadata
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"PoolMetadata" forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      Url
url <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      ByteString
hash <- forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser ByteString
parseJsonBase16 Object
obj Key
"hash"
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Url -> ByteString -> PoolMetadata
PoolMetadata Url
url ByteString
hash

parseJsonBase16 :: Value -> Parser ByteString
parseJsonBase16 :: Value -> Parser ByteString
parseJsonBase16 Value
v = do
  String
s <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  case ByteString -> Either String ByteString
B16.decode (String -> ByteString
Char8.pack String
s) of
    Right ByteString
bs -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
    Left String
msg -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg

instance NoThunks PoolMetadata

data StakePoolRelay
  = -- | One or both of IPv4 & IPv6
    SingleHostAddr !(StrictMaybe Port) !(StrictMaybe IPv4) !(StrictMaybe IPv6)
  | -- | An @A@ or @AAAA@ DNS record
    SingleHostName !(StrictMaybe Port) !DnsName
  | -- | A @SRV@ DNS record
    MultiHostName !DnsName
  deriving (StakePoolRelay -> StakePoolRelay -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StakePoolRelay -> StakePoolRelay -> Bool
$c/= :: StakePoolRelay -> StakePoolRelay -> Bool
== :: StakePoolRelay -> StakePoolRelay -> Bool
$c== :: StakePoolRelay -> StakePoolRelay -> Bool
Eq, Eq StakePoolRelay
StakePoolRelay -> StakePoolRelay -> Bool
StakePoolRelay -> StakePoolRelay -> Ordering
StakePoolRelay -> StakePoolRelay -> StakePoolRelay
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StakePoolRelay -> StakePoolRelay -> StakePoolRelay
$cmin :: StakePoolRelay -> StakePoolRelay -> StakePoolRelay
max :: StakePoolRelay -> StakePoolRelay -> StakePoolRelay
$cmax :: StakePoolRelay -> StakePoolRelay -> StakePoolRelay
>= :: StakePoolRelay -> StakePoolRelay -> Bool
$c>= :: StakePoolRelay -> StakePoolRelay -> Bool
> :: StakePoolRelay -> StakePoolRelay -> Bool
$c> :: StakePoolRelay -> StakePoolRelay -> Bool
<= :: StakePoolRelay -> StakePoolRelay -> Bool
$c<= :: StakePoolRelay -> StakePoolRelay -> Bool
< :: StakePoolRelay -> StakePoolRelay -> Bool
$c< :: StakePoolRelay -> StakePoolRelay -> Bool
compare :: StakePoolRelay -> StakePoolRelay -> Ordering
$ccompare :: StakePoolRelay -> StakePoolRelay -> Ordering
Ord, forall x. Rep StakePoolRelay x -> StakePoolRelay
forall x. StakePoolRelay -> Rep StakePoolRelay x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StakePoolRelay x -> StakePoolRelay
$cfrom :: forall x. StakePoolRelay -> Rep StakePoolRelay x
Generic, Int -> StakePoolRelay -> ShowS
[StakePoolRelay] -> ShowS
StakePoolRelay -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakePoolRelay] -> ShowS
$cshowList :: [StakePoolRelay] -> ShowS
show :: StakePoolRelay -> String
$cshow :: StakePoolRelay -> String
showsPrec :: Int -> StakePoolRelay -> ShowS
$cshowsPrec :: Int -> StakePoolRelay -> ShowS
Show)

instance FromJSON StakePoolRelay where
  parseJSON :: Value -> Parser StakePoolRelay
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"StakePoolRelay" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser StakePoolRelay
parser1 Object
obj Key
"single host address"
        , forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser StakePoolRelay
parser2 Object
obj Key
"single host name"
        , forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser StakePoolRelay
parser3 Object
obj Key
"multi host name"
        ]
    where
      parser1 :: Value -> Parser StakePoolRelay
parser1 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"SingleHostAddr" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        StrictMaybe Port
-> StrictMaybe IPv4 -> StrictMaybe IPv6 -> StakePoolRelay
SingleHostAddr
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"port" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. StrictMaybe a
SNothing
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"IPv4" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. StrictMaybe a
SNothing
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"IPv6" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. StrictMaybe a
SNothing
      parser2 :: Value -> Parser StakePoolRelay
parser2 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"SingleHostName" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        StrictMaybe Port -> DnsName -> StakePoolRelay
SingleHostName
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"port" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. StrictMaybe a
SNothing
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"dnsName"
      parser3 :: Value -> Parser StakePoolRelay
parser3 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"MultiHostName" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        DnsName -> StakePoolRelay
MultiHostName
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"dnsName"

instance ToJSON StakePoolRelay where
  toJSON :: StakePoolRelay -> Value
toJSON (SingleHostAddr StrictMaybe Port
port StrictMaybe IPv4
ipv4 StrictMaybe IPv6
ipv6) =
    [Pair] -> Value
Aeson.object
      [ Key
"single host address"
          forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
Aeson.object
            [ Key
"port" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe Port
port
            , Key
"IPv4" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe IPv4
ipv4
            , Key
"IPv6" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe IPv6
ipv6
            ]
      ]
  toJSON (SingleHostName StrictMaybe Port
port DnsName
dnsName) =
    [Pair] -> Value
Aeson.object
      [ Key
"single host name"
          forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
Aeson.object
            [ Key
"port" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe Port
port
            , Key
"dnsName" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DnsName
dnsName
            ]
      ]
  toJSON (MultiHostName DnsName
dnsName) =
    [Pair] -> Value
Aeson.object
      [ Key
"multi host name"
          forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
Aeson.object
            [ Key
"dnsName" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DnsName
dnsName
            ]
      ]

instance NoThunks StakePoolRelay

instance NFData StakePoolRelay

instance EncCBOR StakePoolRelay where
  encCBOR :: StakePoolRelay -> Encoding
encCBOR (SingleHostAddr StrictMaybe Port
p StrictMaybe IPv4
ipv4 StrictMaybe IPv6
ipv6) =
    Word -> Encoding
encodeListLen Word
4
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8)
      forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Port
p)
      forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe IPv4
ipv4)
      forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe IPv6
ipv6)
  encCBOR (SingleHostName StrictMaybe Port
p DnsName
n) =
    Word -> Encoding
encodeListLen Word
3
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
1 :: Word8)
      forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Port
p)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR DnsName
n
  encCBOR (MultiHostName DnsName
n) =
    Word -> Encoding
encodeListLen Word
2
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
2 :: Word8)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR DnsName
n

instance DecCBOR StakePoolRelay where
  decCBOR :: forall s. Decoder s StakePoolRelay
decCBOR = forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"StakePoolRelay" forall a b. (a -> b) -> a -> b
$
    \case
      Word
0 ->
        (\StrictMaybe Port
x StrictMaybe IPv4
y StrictMaybe IPv6
z -> (Int
4, StrictMaybe Port
-> StrictMaybe IPv4 -> StrictMaybe IPv6 -> StakePoolRelay
SingleHostAddr StrictMaybe Port
x StrictMaybe IPv4
y StrictMaybe IPv6
z))
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe forall a s. DecCBOR a => Decoder s a
decCBOR)
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe forall a s. DecCBOR a => Decoder s a
decCBOR)
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe forall a s. DecCBOR a => Decoder s a
decCBOR)
      Word
1 ->
        (\StrictMaybe Port
x DnsName
y -> (Int
3, StrictMaybe Port -> DnsName -> StakePoolRelay
SingleHostName StrictMaybe Port
x DnsName
y))
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe forall a s. DecCBOR a => Decoder s a
decCBOR)
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word
2 -> do
        DnsName
x <- forall a s. DecCBOR a => Decoder s a
decCBOR
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, DnsName -> StakePoolRelay
MultiHostName DnsName
x)
      Word
k -> forall (m :: * -> *) a. MonadFail m => Word -> m a
invalidKey Word
k

-- | A stake pool.
data PoolParams = PoolParams
  { PoolParams -> KeyHash 'StakePool
ppId :: !(KeyHash 'StakePool)
  , PoolParams -> VRFVerKeyHash 'StakePoolVRF
ppVrf :: !(VRFVerKeyHash 'StakePoolVRF)
  , PoolParams -> Coin
ppPledge :: !Coin
  , PoolParams -> Coin
ppCost :: !Coin
  , PoolParams -> UnitInterval
ppMargin :: !UnitInterval
  , PoolParams -> RewardAccount
ppRewardAccount :: !RewardAccount
  , PoolParams -> Set (KeyHash 'Staking)
ppOwners :: !(Set (KeyHash 'Staking))
  , PoolParams -> StrictSeq StakePoolRelay
ppRelays :: !(StrictSeq StakePoolRelay)
  , PoolParams -> StrictMaybe PoolMetadata
ppMetadata :: !(StrictMaybe PoolMetadata)
  }
  deriving (Int -> PoolParams -> ShowS
[PoolParams] -> ShowS
PoolParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolParams] -> ShowS
$cshowList :: [PoolParams] -> ShowS
show :: PoolParams -> String
$cshow :: PoolParams -> String
showsPrec :: Int -> PoolParams -> ShowS
$cshowsPrec :: Int -> PoolParams -> ShowS
Show, forall x. Rep PoolParams x -> PoolParams
forall x. PoolParams -> Rep PoolParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PoolParams x -> PoolParams
$cfrom :: forall x. PoolParams -> Rep PoolParams x
Generic, PoolParams -> PoolParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolParams -> PoolParams -> Bool
$c/= :: PoolParams -> PoolParams -> Bool
== :: PoolParams -> PoolParams -> Bool
$c== :: PoolParams -> PoolParams -> Bool
Eq, Eq PoolParams
PoolParams -> PoolParams -> Bool
PoolParams -> PoolParams -> Ordering
PoolParams -> PoolParams -> PoolParams
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PoolParams -> PoolParams -> PoolParams
$cmin :: PoolParams -> PoolParams -> PoolParams
max :: PoolParams -> PoolParams -> PoolParams
$cmax :: PoolParams -> PoolParams -> PoolParams
>= :: PoolParams -> PoolParams -> Bool
$c>= :: PoolParams -> PoolParams -> Bool
> :: PoolParams -> PoolParams -> Bool
$c> :: PoolParams -> PoolParams -> Bool
<= :: PoolParams -> PoolParams -> Bool
$c<= :: PoolParams -> PoolParams -> Bool
< :: PoolParams -> PoolParams -> Bool
$c< :: PoolParams -> PoolParams -> Bool
compare :: PoolParams -> PoolParams -> Ordering
$ccompare :: PoolParams -> PoolParams -> Ordering
Ord)
  deriving (Typeable PoolParams
PoolParams -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PoolParams] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy PoolParams -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PoolParams] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PoolParams] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy PoolParams -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy PoolParams -> Size
encCBOR :: PoolParams -> Encoding
$cencCBOR :: PoolParams -> Encoding
EncCBOR) via CBORGroup PoolParams
  deriving (Typeable PoolParams
Proxy PoolParams -> Text
forall s. Decoder s PoolParams
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy PoolParams -> Decoder s ()
label :: Proxy PoolParams -> Text
$clabel :: Proxy PoolParams -> Text
dropCBOR :: forall s. Proxy PoolParams -> Decoder s ()
$cdropCBOR :: forall s. Proxy PoolParams -> Decoder s ()
decCBOR :: forall s. Decoder s PoolParams
$cdecCBOR :: forall s. Decoder s PoolParams
DecCBOR) via CBORGroup PoolParams

instance Default PoolParams where
  def :: PoolParams
def = KeyHash 'StakePool
-> VRFVerKeyHash 'StakePoolVRF
-> Coin
-> Coin
-> UnitInterval
-> RewardAccount
-> Set (KeyHash 'Staking)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> PoolParams
PoolParams forall a. Default a => a
def forall a. Default a => a
def (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0) forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def

instance NoThunks PoolParams

deriving instance NFData PoolParams

instance ToJSON PoolParams where
  toJSON :: PoolParams -> Value
toJSON PoolParams
pp =
    [Pair] -> Value
Aeson.object
      [ Key
"publicKey" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> KeyHash 'StakePool
ppId PoolParams
pp -- TODO publicKey is an unfortunate name, should be poolId
      , Key
"vrf" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> VRFVerKeyHash 'StakePoolVRF
ppVrf PoolParams
pp
      , Key
"pledge" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> Coin
ppPledge PoolParams
pp
      , Key
"cost" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> Coin
ppCost PoolParams
pp
      , Key
"margin" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> UnitInterval
ppMargin PoolParams
pp
      , Key
"rewardAccount" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> RewardAccount
ppRewardAccount PoolParams
pp
      , Key
"owners" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> Set (KeyHash 'Staking)
ppOwners PoolParams
pp
      , Key
"relays" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> StrictSeq StakePoolRelay
ppRelays PoolParams
pp
      , Key
"metadata" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> StrictMaybe PoolMetadata
ppMetadata PoolParams
pp
      ]

instance FromJSON PoolParams where
  parseJSON :: Value -> Parser PoolParams
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"PoolParams" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      KeyHash 'StakePool
-> VRFVerKeyHash 'StakePoolVRF
-> Coin
-> Coin
-> UnitInterval
-> RewardAccount
-> Set (KeyHash 'Staking)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> PoolParams
PoolParams
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"publicKey" -- TODO publicKey is an unfortunate name, should be poolId
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vrf"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pledge"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cost"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"margin"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rewardAccount"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owners"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"relays"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"metadata"

instance EncCBOR PoolMetadata where
  encCBOR :: PoolMetadata -> Encoding
encCBOR (PoolMetadata Url
u ByteString
h) =
    Word -> Encoding
encodeListLen Word
2
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Url
u
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR ByteString
h

instance DecCBOR PoolMetadata where
  decCBOR :: forall s. Decoder s PoolMetadata
decCBOR = do
    forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"PoolMetadata" (forall a b. a -> b -> a
const Int
2) (Url -> ByteString -> PoolMetadata
PoolMetadata forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR)

-- | The size of the 'ppOwners' 'Set'.  Only used to compute size of encoded
-- 'PoolParams'.
data SizeOfPoolOwners = SizeOfPoolOwners

instance EncCBOR SizeOfPoolOwners where
  encCBOR :: SizeOfPoolOwners -> Encoding
encCBOR = forall a. HasCallStack => String -> a
error String
"The `SizeOfPoolOwners` type cannot be encoded!"

-- | The size of the 'ppRelays' 'Set'.  Only used to compute size of encoded
-- 'PoolParams'.
data SizeOfPoolRelays = SizeOfPoolRelays

instance EncCBOR SizeOfPoolRelays where
  encCBOR :: SizeOfPoolRelays -> Encoding
encCBOR = forall a. HasCallStack => String -> a
error String
"The `SizeOfPoolRelays` type cannot be encoded!"

instance EncCBORGroup PoolParams where
  encCBORGroup :: PoolParams -> Encoding
encCBORGroup PoolParams
poolParams =
    forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> KeyHash 'StakePool
ppId PoolParams
poolParams)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> VRFVerKeyHash 'StakePoolVRF
ppVrf PoolParams
poolParams)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> Coin
ppPledge PoolParams
poolParams)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> Coin
ppCost PoolParams
poolParams)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> UnitInterval
ppMargin PoolParams
poolParams)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> RewardAccount
ppRewardAccount PoolParams
poolParams)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> Set (KeyHash 'Staking)
ppOwners PoolParams
poolParams)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> StrictSeq StakePoolRelay
ppRelays PoolParams
poolParams)
      forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (PoolParams -> StrictMaybe PoolMetadata
ppMetadata PoolParams
poolParams))

  encodedGroupSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy PoolParams -> Size
encodedGroupSizeExpr forall t. EncCBOR t => Proxy t -> Size
size' Proxy PoolParams
proxy =
    forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size' (PoolParams -> KeyHash 'StakePool
ppId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy)
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size' (PoolParams -> VRFVerKeyHash 'StakePoolVRF
ppVrf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy)
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size' (PoolParams -> Coin
ppPledge forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy)
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size' (PoolParams -> Coin
ppCost forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy)
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size' (PoolParams -> UnitInterval
ppMargin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy)
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size' (PoolParams -> RewardAccount
ppRewardAccount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy)
      forall a. Num a => a -> a -> a
+ Size
2
      forall a. Num a => a -> a -> a
+ Size
poolSize forall a. Num a => a -> a -> a
* forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size' (forall (f :: * -> *) a. Proxy (f a) -> Proxy a
elementProxy (PoolParams -> Set (KeyHash 'Staking)
ppOwners forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy))
      forall a. Num a => a -> a -> a
+ Size
2
      forall a. Num a => a -> a -> a
+ Size
relaySize forall a. Num a => a -> a -> a
* forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size' (forall (f :: * -> *) a. Proxy (f a) -> Proxy a
elementProxy (PoolParams -> StrictSeq StakePoolRelay
ppRelays forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy))
      forall a. Num a => a -> a -> a
+ [Case Size] -> Size
szCases
        [ forall t. Text -> t -> Case t
Case Text
"Nothing" Size
1
        , forall t. Text -> t -> Case t
Case Text
"Just" forall a b. (a -> b) -> a -> b
$ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size' (forall (f :: * -> *) a. Proxy (f a) -> Proxy a
elementProxy (PoolParams -> StrictMaybe PoolMetadata
ppMetadata forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy))
        ]
    where
      poolSize, relaySize :: Size
      poolSize :: Size
poolSize = forall t. EncCBOR t => Proxy t -> Size
size' (forall {k} (t :: k). Proxy t
Proxy @SizeOfPoolOwners)
      relaySize :: Size
relaySize = forall t. EncCBOR t => Proxy t -> Size
size' (forall {k} (t :: k). Proxy t
Proxy @SizeOfPoolRelays)
      elementProxy :: Proxy (f a) -> Proxy a
      elementProxy :: forall (f :: * -> *) a. Proxy (f a) -> Proxy a
elementProxy Proxy (f a)
_ = forall {k} (t :: k). Proxy t
Proxy

  listLen :: PoolParams -> Word
listLen PoolParams
_ = Word
9
  listLenBound :: Proxy PoolParams -> Word
listLenBound Proxy PoolParams
_ = Word
9

instance DecCBORGroup PoolParams where
  decCBORGroup :: forall s. Decoder s PoolParams
decCBORGroup = do
    KeyHash 'StakePool
hk <- forall a s. DecCBOR a => Decoder s a
decCBOR
    VRFVerKeyHash 'StakePoolVRF
vrf <- forall a s. DecCBOR a => Decoder s a
decCBOR
    Coin
pledge <- forall a s. DecCBOR a => Decoder s a
decCBOR
    Coin
cost <- forall a s. DecCBOR a => Decoder s a
decCBOR
    UnitInterval
margin <- forall a s. DecCBOR a => Decoder s a
decCBOR
    RewardAccount
ra <- forall a s. DecCBOR a => Decoder s a
decCBOR
    Set (KeyHash 'Staking)
owners <- forall a s. DecCBOR a => Decoder s a
decCBOR
    StrictSeq StakePoolRelay
relays <- forall a s. DecCBOR a => Decoder s a
decCBOR
    Maybe PoolMetadata
md <- forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe forall a s. DecCBOR a => Decoder s a
decCBOR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      PoolParams
        { ppId :: KeyHash 'StakePool
ppId = KeyHash 'StakePool
hk
        , ppVrf :: VRFVerKeyHash 'StakePoolVRF
ppVrf = VRFVerKeyHash 'StakePoolVRF
vrf
        , ppPledge :: Coin
ppPledge = Coin
pledge
        , ppCost :: Coin
ppCost = Coin
cost
        , ppMargin :: UnitInterval
ppMargin = UnitInterval
margin
        , ppRewardAccount :: RewardAccount
ppRewardAccount = RewardAccount
ra
        , ppOwners :: Set (KeyHash 'Staking)
ppOwners = Set (KeyHash 'Staking)
owners
        , ppRelays :: StrictSeq StakePoolRelay
ppRelays = StrictSeq StakePoolRelay
relays
        , ppMetadata :: StrictMaybe PoolMetadata
ppMetadata = forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe PoolMetadata
md
        }