{-# 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
(PoolMetadata -> PoolMetadata -> Bool)
-> (PoolMetadata -> PoolMetadata -> Bool) -> Eq PoolMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PoolMetadata -> PoolMetadata -> Bool
== :: PoolMetadata -> PoolMetadata -> Bool
$c/= :: PoolMetadata -> PoolMetadata -> Bool
/= :: PoolMetadata -> PoolMetadata -> Bool
Eq, Eq PoolMetadata
Eq PoolMetadata =>
(PoolMetadata -> PoolMetadata -> Ordering)
-> (PoolMetadata -> PoolMetadata -> Bool)
-> (PoolMetadata -> PoolMetadata -> Bool)
-> (PoolMetadata -> PoolMetadata -> Bool)
-> (PoolMetadata -> PoolMetadata -> Bool)
-> (PoolMetadata -> PoolMetadata -> PoolMetadata)
-> (PoolMetadata -> PoolMetadata -> PoolMetadata)
-> Ord 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
$ccompare :: PoolMetadata -> PoolMetadata -> Ordering
compare :: PoolMetadata -> PoolMetadata -> Ordering
$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
>= :: PoolMetadata -> PoolMetadata -> Bool
$cmax :: PoolMetadata -> PoolMetadata -> PoolMetadata
max :: PoolMetadata -> PoolMetadata -> PoolMetadata
$cmin :: PoolMetadata -> PoolMetadata -> PoolMetadata
min :: PoolMetadata -> PoolMetadata -> PoolMetadata
Ord, (forall x. PoolMetadata -> Rep PoolMetadata x)
-> (forall x. Rep PoolMetadata x -> PoolMetadata)
-> Generic PoolMetadata
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
$cfrom :: forall x. PoolMetadata -> Rep PoolMetadata x
from :: forall x. PoolMetadata -> Rep PoolMetadata x
$cto :: forall x. Rep PoolMetadata x -> PoolMetadata
to :: forall x. Rep PoolMetadata x -> PoolMetadata
Generic, Int -> PoolMetadata -> ShowS
[PoolMetadata] -> ShowS
PoolMetadata -> String
(Int -> PoolMetadata -> ShowS)
-> (PoolMetadata -> String)
-> ([PoolMetadata] -> ShowS)
-> Show PoolMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PoolMetadata -> ShowS
showsPrec :: Int -> PoolMetadata -> ShowS
$cshow :: PoolMetadata -> String
show :: PoolMetadata -> String
$cshowList :: [PoolMetadata] -> ShowS
showList :: [PoolMetadata] -> ShowS
Show)

deriving instance NFData PoolMetadata

instance ToJSON PoolMetadata where
  toJSON :: PoolMetadata -> Value
toJSON PoolMetadata
pmd =
    [Pair] -> Value
Aeson.object
      [ Key
"url" Key -> Url -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolMetadata -> Url
pmUrl PoolMetadata
pmd
      , Key
"hash" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
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 =
    String
-> (Object -> Parser PoolMetadata) -> Value -> Parser PoolMetadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"PoolMetadata" ((Object -> Parser PoolMetadata) -> Value -> Parser PoolMetadata)
-> (Object -> Parser PoolMetadata) -> Value -> Parser PoolMetadata
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      Url
url <- Object
obj Object -> Key -> Parser Url
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      ByteString
hash <- (Value -> Parser ByteString) -> Object -> Key -> Parser ByteString
forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser ByteString
parseJsonBase16 Object
obj Key
"hash"
      PoolMetadata -> Parser PoolMetadata
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (PoolMetadata -> Parser PoolMetadata)
-> PoolMetadata -> Parser PoolMetadata
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 <- Value -> Parser String
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 -> ByteString -> Parser ByteString
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
    Left String
msg -> String -> Parser ByteString
forall a. String -> Parser a
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
(StakePoolRelay -> StakePoolRelay -> Bool)
-> (StakePoolRelay -> StakePoolRelay -> Bool) -> Eq StakePoolRelay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakePoolRelay -> StakePoolRelay -> Bool
== :: StakePoolRelay -> StakePoolRelay -> Bool
$c/= :: StakePoolRelay -> StakePoolRelay -> Bool
/= :: StakePoolRelay -> StakePoolRelay -> Bool
Eq, Eq StakePoolRelay
Eq StakePoolRelay =>
(StakePoolRelay -> StakePoolRelay -> Ordering)
-> (StakePoolRelay -> StakePoolRelay -> Bool)
-> (StakePoolRelay -> StakePoolRelay -> Bool)
-> (StakePoolRelay -> StakePoolRelay -> Bool)
-> (StakePoolRelay -> StakePoolRelay -> Bool)
-> (StakePoolRelay -> StakePoolRelay -> StakePoolRelay)
-> (StakePoolRelay -> StakePoolRelay -> StakePoolRelay)
-> Ord 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
$ccompare :: StakePoolRelay -> StakePoolRelay -> Ordering
compare :: StakePoolRelay -> StakePoolRelay -> Ordering
$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
>= :: StakePoolRelay -> StakePoolRelay -> Bool
$cmax :: StakePoolRelay -> StakePoolRelay -> StakePoolRelay
max :: StakePoolRelay -> StakePoolRelay -> StakePoolRelay
$cmin :: StakePoolRelay -> StakePoolRelay -> StakePoolRelay
min :: StakePoolRelay -> StakePoolRelay -> StakePoolRelay
Ord, (forall x. StakePoolRelay -> Rep StakePoolRelay x)
-> (forall x. Rep StakePoolRelay x -> StakePoolRelay)
-> Generic StakePoolRelay
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
$cfrom :: forall x. StakePoolRelay -> Rep StakePoolRelay x
from :: forall x. StakePoolRelay -> Rep StakePoolRelay x
$cto :: forall x. Rep StakePoolRelay x -> StakePoolRelay
to :: forall x. Rep StakePoolRelay x -> StakePoolRelay
Generic, Int -> StakePoolRelay -> ShowS
[StakePoolRelay] -> ShowS
StakePoolRelay -> String
(Int -> StakePoolRelay -> ShowS)
-> (StakePoolRelay -> String)
-> ([StakePoolRelay] -> ShowS)
-> Show StakePoolRelay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakePoolRelay -> ShowS
showsPrec :: Int -> StakePoolRelay -> ShowS
$cshow :: StakePoolRelay -> String
show :: StakePoolRelay -> String
$cshowList :: [StakePoolRelay] -> ShowS
showList :: [StakePoolRelay] -> ShowS
Show)

instance FromJSON StakePoolRelay where
  parseJSON :: Value -> Parser StakePoolRelay
parseJSON =
    String
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"StakePoolRelay" ((Object -> Parser StakePoolRelay)
 -> Value -> Parser StakePoolRelay)
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      [Parser StakePoolRelay] -> Parser StakePoolRelay
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ (Value -> Parser StakePoolRelay)
-> Object -> Key -> Parser StakePoolRelay
forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser StakePoolRelay
parser1 Object
obj Key
"single host address"
        , (Value -> Parser StakePoolRelay)
-> Object -> Key -> Parser StakePoolRelay
forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser StakePoolRelay
parser2 Object
obj Key
"single host name"
        , (Value -> Parser StakePoolRelay)
-> Object -> Key -> Parser StakePoolRelay
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 = String
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"SingleHostAddr" ((Object -> Parser StakePoolRelay)
 -> Value -> Parser StakePoolRelay)
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        StrictMaybe Port
-> StrictMaybe IPv4 -> StrictMaybe IPv6 -> StakePoolRelay
SingleHostAddr
          (StrictMaybe Port
 -> StrictMaybe IPv4 -> StrictMaybe IPv6 -> StakePoolRelay)
-> Parser (StrictMaybe Port)
-> Parser (StrictMaybe IPv4 -> StrictMaybe IPv6 -> StakePoolRelay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe (StrictMaybe Port))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"port" Parser (Maybe (StrictMaybe Port))
-> StrictMaybe Port -> Parser (StrictMaybe Port)
forall a. Parser (Maybe a) -> a -> Parser a
.!= StrictMaybe Port
forall a. StrictMaybe a
SNothing
          Parser (StrictMaybe IPv4 -> StrictMaybe IPv6 -> StakePoolRelay)
-> Parser (StrictMaybe IPv4)
-> Parser (StrictMaybe IPv6 -> StakePoolRelay)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe (StrictMaybe IPv4))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"IPv4" Parser (Maybe (StrictMaybe IPv4))
-> StrictMaybe IPv4 -> Parser (StrictMaybe IPv4)
forall a. Parser (Maybe a) -> a -> Parser a
.!= StrictMaybe IPv4
forall a. StrictMaybe a
SNothing
          Parser (StrictMaybe IPv6 -> StakePoolRelay)
-> Parser (StrictMaybe IPv6) -> Parser StakePoolRelay
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe (StrictMaybe IPv6))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"IPv6" Parser (Maybe (StrictMaybe IPv6))
-> StrictMaybe IPv6 -> Parser (StrictMaybe IPv6)
forall a. Parser (Maybe a) -> a -> Parser a
.!= StrictMaybe IPv6
forall a. StrictMaybe a
SNothing
      parser2 :: Value -> Parser StakePoolRelay
parser2 = String
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"SingleHostName" ((Object -> Parser StakePoolRelay)
 -> Value -> Parser StakePoolRelay)
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        StrictMaybe Port -> DnsName -> StakePoolRelay
SingleHostName
          (StrictMaybe Port -> DnsName -> StakePoolRelay)
-> Parser (StrictMaybe Port) -> Parser (DnsName -> StakePoolRelay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe (StrictMaybe Port))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"port" Parser (Maybe (StrictMaybe Port))
-> StrictMaybe Port -> Parser (StrictMaybe Port)
forall a. Parser (Maybe a) -> a -> Parser a
.!= StrictMaybe Port
forall a. StrictMaybe a
SNothing
          Parser (DnsName -> StakePoolRelay)
-> Parser DnsName -> Parser StakePoolRelay
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser DnsName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"dnsName"
      parser3 :: Value -> Parser StakePoolRelay
parser3 = String
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"MultiHostName" ((Object -> Parser StakePoolRelay)
 -> Value -> Parser StakePoolRelay)
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        DnsName -> StakePoolRelay
MultiHostName
          (DnsName -> StakePoolRelay)
-> Parser DnsName -> Parser StakePoolRelay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser DnsName
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"
          Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
Aeson.object
            [ Key
"port" Key -> StrictMaybe Port -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe Port
port
            , Key
"IPv4" Key -> StrictMaybe IPv4 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe IPv4
ipv4
            , Key
"IPv6" Key -> StrictMaybe IPv6 -> Pair
forall v. ToJSON v => Key -> v -> Pair
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"
          Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
Aeson.object
            [ Key
"port" Key -> StrictMaybe Port -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe Port
port
            , Key
"dnsName" Key -> DnsName -> Pair
forall v. ToJSON v => Key -> v -> Pair
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"
          Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
Aeson.object
            [ Key
"dnsName" Key -> DnsName -> Pair
forall v. ToJSON v => Key -> v -> Pair
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
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Port -> Encoding) -> Maybe Port -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe Port -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (StrictMaybe Port -> Maybe Port
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Port
p)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (IPv4 -> Encoding) -> Maybe IPv4 -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe IPv4 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (StrictMaybe IPv4 -> Maybe IPv4
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe IPv4
ipv4)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (IPv6 -> Encoding) -> Maybe IPv6 -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe IPv6 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (StrictMaybe IPv6 -> Maybe IPv6
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe IPv6
ipv6)
  encCBOR (SingleHostName StrictMaybe Port
p DnsName
n) =
    Word -> Encoding
encodeListLen Word
3
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
1 :: Word8)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Port -> Encoding) -> Maybe Port -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe Port -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (StrictMaybe Port -> Maybe Port
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Port
p)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DnsName -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR DnsName
n
  encCBOR (MultiHostName DnsName
n) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
2 :: Word8)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DnsName -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR DnsName
n

instance DecCBOR StakePoolRelay where
  decCBOR :: forall s. Decoder s StakePoolRelay
decCBOR = Text
-> (Word -> Decoder s (Int, StakePoolRelay))
-> Decoder s StakePoolRelay
forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"StakePoolRelay" ((Word -> Decoder s (Int, StakePoolRelay))
 -> Decoder s StakePoolRelay)
-> (Word -> Decoder s (Int, StakePoolRelay))
-> Decoder s 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))
          (StrictMaybe Port
 -> StrictMaybe IPv4 -> StrictMaybe IPv6 -> (Int, StakePoolRelay))
-> Decoder s (StrictMaybe Port)
-> Decoder
     s (StrictMaybe IPv4 -> StrictMaybe IPv6 -> (Int, StakePoolRelay))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Port -> StrictMaybe Port
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe Port -> StrictMaybe Port)
-> Decoder s (Maybe Port) -> Decoder s (StrictMaybe Port)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Port -> Decoder s (Maybe Port)
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s Port
forall s. Decoder s Port
forall a s. DecCBOR a => Decoder s a
decCBOR)
          Decoder
  s (StrictMaybe IPv4 -> StrictMaybe IPv6 -> (Int, StakePoolRelay))
-> Decoder s (StrictMaybe IPv4)
-> Decoder s (StrictMaybe IPv6 -> (Int, StakePoolRelay))
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe IPv4 -> StrictMaybe IPv4
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe IPv4 -> StrictMaybe IPv4)
-> Decoder s (Maybe IPv4) -> Decoder s (StrictMaybe IPv4)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s IPv4 -> Decoder s (Maybe IPv4)
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s IPv4
forall s. Decoder s IPv4
forall a s. DecCBOR a => Decoder s a
decCBOR)
          Decoder s (StrictMaybe IPv6 -> (Int, StakePoolRelay))
-> Decoder s (StrictMaybe IPv6) -> Decoder s (Int, StakePoolRelay)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe IPv6 -> StrictMaybe IPv6
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe IPv6 -> StrictMaybe IPv6)
-> Decoder s (Maybe IPv6) -> Decoder s (StrictMaybe IPv6)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s IPv6 -> Decoder s (Maybe IPv6)
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s IPv6
forall s. Decoder s IPv6
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))
          (StrictMaybe Port -> DnsName -> (Int, StakePoolRelay))
-> Decoder s (StrictMaybe Port)
-> Decoder s (DnsName -> (Int, StakePoolRelay))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Port -> StrictMaybe Port
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe Port -> StrictMaybe Port)
-> Decoder s (Maybe Port) -> Decoder s (StrictMaybe Port)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Port -> Decoder s (Maybe Port)
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s Port
forall s. Decoder s Port
forall a s. DecCBOR a => Decoder s a
decCBOR)
          Decoder s (DnsName -> (Int, StakePoolRelay))
-> Decoder s DnsName -> Decoder s (Int, StakePoolRelay)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s DnsName
forall s. Decoder s DnsName
forall a s. DecCBOR a => Decoder s a
decCBOR
      Word
2 -> do
        DnsName
x <- Decoder s DnsName
forall s. Decoder s DnsName
forall a s. DecCBOR a => Decoder s a
decCBOR
        (Int, StakePoolRelay) -> Decoder s (Int, StakePoolRelay)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, DnsName -> StakePoolRelay
MultiHostName DnsName
x)
      Word
k -> Word -> Decoder s (Int, StakePoolRelay)
forall a (m :: * -> *). (Typeable 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
(Int -> PoolParams -> ShowS)
-> (PoolParams -> String)
-> ([PoolParams] -> ShowS)
-> Show PoolParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PoolParams -> ShowS
showsPrec :: Int -> PoolParams -> ShowS
$cshow :: PoolParams -> String
show :: PoolParams -> String
$cshowList :: [PoolParams] -> ShowS
showList :: [PoolParams] -> ShowS
Show, (forall x. PoolParams -> Rep PoolParams x)
-> (forall x. Rep PoolParams x -> PoolParams) -> Generic PoolParams
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
$cfrom :: forall x. PoolParams -> Rep PoolParams x
from :: forall x. PoolParams -> Rep PoolParams x
$cto :: forall x. Rep PoolParams x -> PoolParams
to :: forall x. Rep PoolParams x -> PoolParams
Generic, PoolParams -> PoolParams -> Bool
(PoolParams -> PoolParams -> Bool)
-> (PoolParams -> PoolParams -> Bool) -> Eq PoolParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PoolParams -> PoolParams -> Bool
== :: PoolParams -> PoolParams -> Bool
$c/= :: PoolParams -> PoolParams -> Bool
/= :: PoolParams -> PoolParams -> Bool
Eq, Eq PoolParams
Eq PoolParams =>
(PoolParams -> PoolParams -> Ordering)
-> (PoolParams -> PoolParams -> Bool)
-> (PoolParams -> PoolParams -> Bool)
-> (PoolParams -> PoolParams -> Bool)
-> (PoolParams -> PoolParams -> Bool)
-> (PoolParams -> PoolParams -> PoolParams)
-> (PoolParams -> PoolParams -> PoolParams)
-> Ord 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
$ccompare :: PoolParams -> PoolParams -> Ordering
compare :: PoolParams -> PoolParams -> Ordering
$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
>= :: PoolParams -> PoolParams -> Bool
$cmax :: PoolParams -> PoolParams -> PoolParams
max :: PoolParams -> PoolParams -> PoolParams
$cmin :: PoolParams -> PoolParams -> PoolParams
min :: PoolParams -> PoolParams -> PoolParams
Ord)
  deriving (Typeable PoolParams
Typeable PoolParams =>
(PoolParams -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy PoolParams -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [PoolParams] -> Size)
-> EncCBOR 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
$cencCBOR :: PoolParams -> Encoding
encCBOR :: PoolParams -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy PoolParams -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy PoolParams -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PoolParams] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PoolParams] -> Size
EncCBOR) via CBORGroup PoolParams
  deriving (Typeable PoolParams
Typeable PoolParams =>
(forall s. Decoder s PoolParams)
-> (forall s. Proxy PoolParams -> Decoder s ())
-> (Proxy PoolParams -> Text)
-> DecCBOR 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 ()
$cdecCBOR :: forall s. Decoder s PoolParams
decCBOR :: forall s. Decoder s PoolParams
$cdropCBOR :: forall s. Proxy PoolParams -> Decoder s ()
dropCBOR :: forall s. Proxy PoolParams -> Decoder s ()
$clabel :: Proxy PoolParams -> Text
label :: Proxy PoolParams -> Text
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 KeyHash 'StakePool
forall a. Default a => a
def VRFVerKeyHash 'StakePoolVRF
forall a. Default a => a
def (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0) UnitInterval
forall a. Default a => a
def RewardAccount
forall a. Default a => a
def Set (KeyHash 'Staking)
forall a. Default a => a
def StrictSeq StakePoolRelay
forall a. Default a => a
def StrictMaybe PoolMetadata
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" Key -> KeyHash 'StakePool -> Pair
forall v. ToJSON v => Key -> v -> Pair
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" Key -> VRFVerKeyHash 'StakePoolVRF -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> VRFVerKeyHash 'StakePoolVRF
ppVrf PoolParams
pp
      , Key
"pledge" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> Coin
ppPledge PoolParams
pp
      , Key
"cost" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> Coin
ppCost PoolParams
pp
      , Key
"margin" Key -> UnitInterval -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> UnitInterval
ppMargin PoolParams
pp
      , Key
"rewardAccount" Key -> RewardAccount -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> RewardAccount
ppRewardAccount PoolParams
pp
      , Key
"owners" Key -> Set (KeyHash 'Staking) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> Set (KeyHash 'Staking)
ppOwners PoolParams
pp
      , Key
"relays" Key -> StrictSeq StakePoolRelay -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolParams -> StrictSeq StakePoolRelay
ppRelays PoolParams
pp
      , Key
"metadata" Key -> StrictMaybe PoolMetadata -> Pair
forall v. ToJSON v => Key -> v -> Pair
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 =
    String
-> (Object -> Parser PoolParams) -> Value -> Parser PoolParams
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"PoolParams" ((Object -> Parser PoolParams) -> Value -> Parser PoolParams)
-> (Object -> Parser PoolParams) -> Value -> Parser 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
        (KeyHash 'StakePool
 -> VRFVerKeyHash 'StakePoolVRF
 -> Coin
 -> Coin
 -> UnitInterval
 -> RewardAccount
 -> Set (KeyHash 'Staking)
 -> StrictSeq StakePoolRelay
 -> StrictMaybe PoolMetadata
 -> PoolParams)
-> Parser (KeyHash 'StakePool)
-> Parser
     (VRFVerKeyHash 'StakePoolVRF
      -> Coin
      -> Coin
      -> UnitInterval
      -> RewardAccount
      -> Set (KeyHash 'Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (KeyHash 'StakePool)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"publicKey" -- TODO publicKey is an unfortunate name, should be poolId
        Parser
  (VRFVerKeyHash 'StakePoolVRF
   -> Coin
   -> Coin
   -> UnitInterval
   -> RewardAccount
   -> Set (KeyHash 'Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> PoolParams)
-> Parser (VRFVerKeyHash 'StakePoolVRF)
-> Parser
     (Coin
      -> Coin
      -> UnitInterval
      -> RewardAccount
      -> Set (KeyHash 'Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (VRFVerKeyHash 'StakePoolVRF)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vrf"
        Parser
  (Coin
   -> Coin
   -> UnitInterval
   -> RewardAccount
   -> Set (KeyHash 'Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> PoolParams)
-> Parser Coin
-> Parser
     (Coin
      -> UnitInterval
      -> RewardAccount
      -> Set (KeyHash 'Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pledge"
        Parser
  (Coin
   -> UnitInterval
   -> RewardAccount
   -> Set (KeyHash 'Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> PoolParams)
-> Parser Coin
-> Parser
     (UnitInterval
      -> RewardAccount
      -> Set (KeyHash 'Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cost"
        Parser
  (UnitInterval
   -> RewardAccount
   -> Set (KeyHash 'Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> PoolParams)
-> Parser UnitInterval
-> Parser
     (RewardAccount
      -> Set (KeyHash 'Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser UnitInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"margin"
        Parser
  (RewardAccount
   -> Set (KeyHash 'Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> PoolParams)
-> Parser RewardAccount
-> Parser
     (Set (KeyHash 'Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser RewardAccount
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rewardAccount"
        Parser
  (Set (KeyHash 'Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> PoolParams)
-> Parser (Set (KeyHash 'Staking))
-> Parser
     (StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata -> PoolParams)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Set (KeyHash 'Staking))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owners"
        Parser
  (StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata -> PoolParams)
-> Parser (StrictSeq StakePoolRelay)
-> Parser (StrictMaybe PoolMetadata -> PoolParams)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (StrictSeq StakePoolRelay)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"relays"
        Parser (StrictMaybe PoolMetadata -> PoolParams)
-> Parser (StrictMaybe PoolMetadata) -> Parser PoolParams
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (StrictMaybe PoolMetadata)
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
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Url -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Url
u
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ByteString
h

instance DecCBOR PoolMetadata where
  decCBOR :: forall s. Decoder s PoolMetadata
decCBOR = do
    Text
-> (PoolMetadata -> Int)
-> Decoder s PoolMetadata
-> Decoder s PoolMetadata
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"PoolMetadata" (Int -> PoolMetadata -> Int
forall a b. a -> b -> a
const Int
2) (Url -> ByteString -> PoolMetadata
PoolMetadata (Url -> ByteString -> PoolMetadata)
-> Decoder s Url -> Decoder s (ByteString -> PoolMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Url
forall s. Decoder s Url
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (ByteString -> PoolMetadata)
-> Decoder s ByteString -> Decoder s PoolMetadata
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ByteString
forall s. Decoder s ByteString
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 = String -> SizeOfPoolOwners -> Encoding
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 = String -> SizeOfPoolRelays -> Encoding
forall a. HasCallStack => String -> a
error String
"The `SizeOfPoolRelays` type cannot be encoded!"

instance EncCBORGroup PoolParams where
  encCBORGroup :: PoolParams -> Encoding
encCBORGroup PoolParams
poolParams =
    KeyHash 'StakePool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> KeyHash 'StakePool
ppId PoolParams
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VRFVerKeyHash 'StakePoolVRF -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> VRFVerKeyHash 'StakePoolVRF
ppVrf PoolParams
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> Coin
ppPledge PoolParams
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> Coin
ppCost PoolParams
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> UnitInterval -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> UnitInterval
ppMargin PoolParams
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RewardAccount -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> RewardAccount
ppRewardAccount PoolParams
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set (KeyHash 'Staking) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> Set (KeyHash 'Staking)
ppOwners PoolParams
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StrictSeq StakePoolRelay -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (PoolParams -> StrictSeq StakePoolRelay
ppRelays PoolParams
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (PoolMetadata -> Encoding) -> Maybe PoolMetadata -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe PoolMetadata -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (StrictMaybe PoolMetadata -> Maybe PoolMetadata
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 t. EncCBOR t => Proxy t -> Size)
-> Proxy (KeyHash 'StakePool) -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size' (PoolParams -> KeyHash 'StakePool
ppId (PoolParams -> KeyHash 'StakePool)
-> Proxy PoolParams -> Proxy (KeyHash 'StakePool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VRFVerKeyHash 'StakePoolVRF) -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size' (PoolParams -> VRFVerKeyHash 'StakePoolVRF
ppVrf (PoolParams -> VRFVerKeyHash 'StakePoolVRF)
-> Proxy PoolParams -> Proxy (VRFVerKeyHash 'StakePoolVRF)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Coin -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size' (PoolParams -> Coin
ppPledge (PoolParams -> Coin) -> Proxy PoolParams -> Proxy Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Coin -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size' (PoolParams -> Coin
ppCost (PoolParams -> Coin) -> Proxy PoolParams -> Proxy Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy UnitInterval -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size' (PoolParams -> UnitInterval
ppMargin (PoolParams -> UnitInterval)
-> Proxy PoolParams -> Proxy UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy RewardAccount -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size' (PoolParams -> RewardAccount
ppRewardAccount (PoolParams -> RewardAccount)
-> Proxy PoolParams -> Proxy RewardAccount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
2
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
poolSize Size -> Size -> Size
forall a. Num a => a -> a -> a
* (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (KeyHash 'Staking) -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size' (Proxy (Set (KeyHash 'Staking)) -> Proxy (KeyHash 'Staking)
forall (f :: * -> *) a. Proxy (f a) -> Proxy a
elementProxy (PoolParams -> Set (KeyHash 'Staking)
ppOwners (PoolParams -> Set (KeyHash 'Staking))
-> Proxy PoolParams -> Proxy (Set (KeyHash 'Staking))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy))
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
2
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
relaySize Size -> Size -> Size
forall a. Num a => a -> a -> a
* (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy StakePoolRelay -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size' (Proxy (StrictSeq StakePoolRelay) -> Proxy StakePoolRelay
forall (f :: * -> *) a. Proxy (f a) -> Proxy a
elementProxy (PoolParams -> StrictSeq StakePoolRelay
ppRelays (PoolParams -> StrictSeq StakePoolRelay)
-> Proxy PoolParams -> Proxy (StrictSeq StakePoolRelay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy))
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ [Case Size] -> Size
szCases
        [ Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"Nothing" Size
1
        , Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"Just" (Size -> Case Size) -> Size -> Case Size
forall a b. (a -> b) -> a -> b
$ (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy PoolMetadata -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size' (Proxy (StrictMaybe PoolMetadata) -> Proxy PoolMetadata
forall (f :: * -> *) a. Proxy (f a) -> Proxy a
elementProxy (PoolParams -> StrictMaybe PoolMetadata
ppMetadata (PoolParams -> StrictMaybe PoolMetadata)
-> Proxy PoolParams -> Proxy (StrictMaybe PoolMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy PoolParams
proxy))
        ]
    where
      poolSize, relaySize :: Size
      poolSize :: Size
poolSize = Proxy SizeOfPoolOwners -> Size
forall t. EncCBOR t => Proxy t -> Size
size' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SizeOfPoolOwners)
      relaySize :: Size
relaySize = Proxy SizeOfPoolRelays -> Size
forall t. EncCBOR t => Proxy t -> Size
size' (forall t. Proxy t
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)
_ = Proxy 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 <- Decoder s (KeyHash 'StakePool)
forall s. Decoder s (KeyHash 'StakePool)
forall a s. DecCBOR a => Decoder s a
decCBOR
    VRFVerKeyHash 'StakePoolVRF
vrf <- Decoder s (VRFVerKeyHash 'StakePoolVRF)
forall s. Decoder s (VRFVerKeyHash 'StakePoolVRF)
forall a s. DecCBOR a => Decoder s a
decCBOR
    Coin
pledge <- Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR
    Coin
cost <- Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR
    UnitInterval
margin <- Decoder s UnitInterval
forall s. Decoder s UnitInterval
forall a s. DecCBOR a => Decoder s a
decCBOR
    RewardAccount
ra <- Decoder s RewardAccount
forall s. Decoder s RewardAccount
forall a s. DecCBOR a => Decoder s a
decCBOR
    Set (KeyHash 'Staking)
owners <- Decoder s (Set (KeyHash 'Staking))
forall s. Decoder s (Set (KeyHash 'Staking))
forall a s. DecCBOR a => Decoder s a
decCBOR
    StrictSeq StakePoolRelay
relays <- Decoder s (StrictSeq StakePoolRelay)
forall s. Decoder s (StrictSeq StakePoolRelay)
forall a s. DecCBOR a => Decoder s a
decCBOR
    Maybe PoolMetadata
md <- Decoder s PoolMetadata -> Decoder s (Maybe PoolMetadata)
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s PoolMetadata
forall s. Decoder s PoolMetadata
forall a s. DecCBOR a => Decoder s a
decCBOR
    PoolParams -> Decoder s PoolParams
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PoolParams -> Decoder s PoolParams)
-> PoolParams -> Decoder s PoolParams
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 = Maybe PoolMetadata -> StrictMaybe PoolMetadata
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe PoolMetadata
md
        }