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

instance Crypto c => Default (PoolParams c) where
  def :: PoolParams c
def = forall c.
KeyHash 'StakePool c
-> VRFVerKeyHash 'StakePoolVRF c
-> Coin
-> Coin
-> UnitInterval
-> RewardAccount c
-> Set (KeyHash 'Staking c)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> PoolParams c
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 c)

deriving instance NFData (PoolParams c)

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

instance Crypto c => FromJSON (PoolParams c) where
  parseJSON :: Value -> Parser (PoolParams c)
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"PoolParams" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      forall c.
KeyHash 'StakePool c
-> VRFVerKeyHash 'StakePoolVRF c
-> Coin
-> Coin
-> UnitInterval
-> RewardAccount c
-> Set (KeyHash 'Staking c)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> PoolParams c
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 Crypto c => EncCBORGroup (PoolParams c) where
  encCBORGroup :: PoolParams c -> Encoding
encCBORGroup PoolParams c
poolParams =
    forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. PoolParams c -> KeyHash 'StakePool c
ppId PoolParams c
poolParams)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. PoolParams c -> VRFVerKeyHash 'StakePoolVRF c
ppVrf PoolParams c
poolParams)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. PoolParams c -> Coin
ppPledge PoolParams c
poolParams)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. PoolParams c -> Coin
ppCost PoolParams c
poolParams)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. PoolParams c -> UnitInterval
ppMargin PoolParams c
poolParams)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. PoolParams c -> RewardAccount c
ppRewardAccount PoolParams c
poolParams)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. PoolParams c -> Set (KeyHash 'Staking c)
ppOwners PoolParams c
poolParams)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. PoolParams c -> StrictSeq StakePoolRelay
ppRelays PoolParams c
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 (forall c. PoolParams c -> StrictMaybe PoolMetadata
ppMetadata PoolParams c
poolParams))

  encodedGroupSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PoolParams c) -> Size
encodedGroupSizeExpr forall t. EncCBOR t => Proxy t -> Size
size' Proxy (PoolParams c)
proxy =
    forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size' (forall c. PoolParams c -> KeyHash 'StakePool c
ppId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams c)
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' (forall c. PoolParams c -> VRFVerKeyHash 'StakePoolVRF c
ppVrf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams c)
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' (forall c. PoolParams c -> Coin
ppPledge forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams c)
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' (forall c. PoolParams c -> Coin
ppCost forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams c)
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' (forall c. PoolParams c -> UnitInterval
ppMargin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams c)
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' (forall c. PoolParams c -> RewardAccount c
ppRewardAccount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams c)
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 (forall c. PoolParams c -> Set (KeyHash 'Staking c)
ppOwners forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams c)
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 (forall c. PoolParams c -> StrictSeq StakePoolRelay
ppRelays forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams c)
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 (forall c. PoolParams c -> StrictMaybe PoolMetadata
ppMetadata forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams c)
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 c -> Word
listLen PoolParams c
_ = Word
9
  listLenBound :: Proxy (PoolParams c) -> Word
listLenBound Proxy (PoolParams c)
_ = Word
9

instance Crypto c => DecCBORGroup (PoolParams c) where
  decCBORGroup :: forall s. Decoder s (PoolParams c)
decCBORGroup = do
    KeyHash 'StakePool c
hk <- forall a s. DecCBOR a => Decoder s a
decCBOR
    VRFVerKeyHash 'StakePoolVRF c
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 c
ra <- forall a s. DecCBOR a => Decoder s a
decCBOR
    Set (KeyHash 'Staking c)
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 c
ppId = KeyHash 'StakePool c
hk
        , ppVrf :: VRFVerKeyHash 'StakePoolVRF c
ppVrf = VRFVerKeyHash 'StakePoolVRF c
vrf
        , ppPledge :: Coin
ppPledge = Coin
pledge
        , ppCost :: Coin
ppCost = Coin
cost
        , ppMargin :: UnitInterval
ppMargin = UnitInterval
margin
        , ppRewardAccount :: RewardAccount c
ppRewardAccount = RewardAccount c
ra
        , ppOwners :: Set (KeyHash 'Staking c)
ppOwners = Set (KeyHash 'Staking c)
owners
        , ppRelays :: StrictSeq StakePoolRelay
ppRelays = StrictSeq StakePoolRelay
relays
        , ppMetadata :: StrictMaybe PoolMetadata
ppMetadata = forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe PoolMetadata
md
        }