{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Shelley.Genesis (
  ShelleyGenesisStaking (..),
  ShelleyGenesis (..),
  ValidationErr (..),
  NominalDiffTimeMicro (..),
  emptyGenesisStaking,
  sgActiveSlotCoeff,
  genesisUTxO,
  initialFundsPseudoTxIn,
  validateGenesis,
  describeValidationErr,
  mkShelleyGlobals,
  nominalDiffTimeMicroToMicroseconds,
  nominalDiffTimeMicroToSeconds,
  toNominalDiffTimeMicro,
  toNominalDiffTimeMicroWithRounding,
  fromNominalDiffTimeMicro,
  secondsToNominalDiffTimeMicro,
  sgInitialFundsL,
  sgStakingL,
) where

import Cardano.Crypto.DSIGN (Ed25519DSIGN)
import Cardano.Crypto.Hash (Blake2b_256)
import qualified Cardano.Crypto.Hash.Class as H
import Cardano.Crypto.KES (Sum6KES, totalPeriodsKES)
import Cardano.Ledger.Address (Addr, serialiseAddr)
import Cardano.Ledger.BaseTypes (
  ActiveSlotCoeff,
  BoundedRational (boundRational, unboundRational),
  EpochSize (..),
  Globals (..),
  KeyValuePairs (..),
  Network,
  NonZero (..),
  Nonce (..),
  PositiveUnitInterval,
  ToKeyValuePairs (..),
  mkActiveSlotCoeff,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  Decoder,
  DecoderError (..),
  EncCBOR (..),
  Encoding,
  FromCBOR (..),
  ToCBOR (..),
  cborError,
  decodeRational,
  decodeRecordNamed,
  encodeListLen,
  enforceDecoderVersion,
  enforceEncodingVersion,
  shelleyProtVer,
  toPlainDecoder,
  toPlainEncoding,
 )
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Core
import Cardano.Ledger.Genesis
import Cardano.Ledger.Hashes (unsafeMakeSafeHash)
import Cardano.Ledger.Keys (GenDelegPair (..))
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.PParams (ShelleyPParams (..))
import Cardano.Ledger.Shelley.StabilityWindow
import Cardano.Ledger.State (StakePoolParams (..), UTxO (UTxO))
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import qualified Cardano.Ledger.Val as Val
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart (SystemStart))
import Control.DeepSeq (NFData)
import Control.Monad.Identity (Identity)
import Data.Aeson (FromJSON (..), ToJSON (..), object, (.!=), (.:), (.:?), (.=))
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (Parser, Value (..), typeMismatch)
import Data.Fixed (Fixed (..), Micro, Pico)
import qualified Data.ListMap as LM
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time.Clock (
  NominalDiffTime,
  UTCTime (..),
  nominalDiffTimeToSeconds,
  secondsToNominalDiffTime,
 )
import Data.Unit.Strict (forceElemsToWHNF)
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)
import Lens.Micro (Lens', lens)
import NoThunks.Class (AllowThunksIn (..), NoThunks (..))

-- | Genesis Shelley staking configuration.
--
-- This allows us to configure some initial stake pools and delegation to them,
-- in order to test Praos in a static configuration, without requiring on-chain
-- registration and delegation.
--
-- For simplicity, pools defined in the genesis staking do not pay deposits for
-- their registration.
data ShelleyGenesisStaking = ShelleyGenesisStaking
  { ShelleyGenesisStaking
-> ListMap (KeyHash StakePool) StakePoolParams
sgsPools :: LM.ListMap (KeyHash StakePool) StakePoolParams
  -- ^ Pools to register
  --
  --   The key in this map is the hash of the public key of the _pool_. This
  --   need not correspond to any payment or staking key, but must correspond
  --   to the cold key held by 'TPraosIsCoreNode'.
  , ShelleyGenesisStaking
-> ListMap (KeyHash Staking) (KeyHash StakePool)
sgsStake :: LM.ListMap (KeyHash Staking) (KeyHash StakePool)
  -- ^ Stake-holding key hash credentials and the pools to delegate that stake
  -- to. We require the raw staking key hash in order to:
  --
  -- - Avoid pointer addresses, which would be tricky when there's no slot or
  --   transaction to point to.
  -- - Avoid script credentials.
  }
  deriving stock (ShelleyGenesisStaking -> ShelleyGenesisStaking -> Bool
(ShelleyGenesisStaking -> ShelleyGenesisStaking -> Bool)
-> (ShelleyGenesisStaking -> ShelleyGenesisStaking -> Bool)
-> Eq ShelleyGenesisStaking
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShelleyGenesisStaking -> ShelleyGenesisStaking -> Bool
== :: ShelleyGenesisStaking -> ShelleyGenesisStaking -> Bool
$c/= :: ShelleyGenesisStaking -> ShelleyGenesisStaking -> Bool
/= :: ShelleyGenesisStaking -> ShelleyGenesisStaking -> Bool
Eq, Int -> ShelleyGenesisStaking -> ShowS
[ShelleyGenesisStaking] -> ShowS
ShelleyGenesisStaking -> String
(Int -> ShelleyGenesisStaking -> ShowS)
-> (ShelleyGenesisStaking -> String)
-> ([ShelleyGenesisStaking] -> ShowS)
-> Show ShelleyGenesisStaking
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShelleyGenesisStaking -> ShowS
showsPrec :: Int -> ShelleyGenesisStaking -> ShowS
$cshow :: ShelleyGenesisStaking -> String
show :: ShelleyGenesisStaking -> String
$cshowList :: [ShelleyGenesisStaking] -> ShowS
showList :: [ShelleyGenesisStaking] -> ShowS
Show, (forall x. ShelleyGenesisStaking -> Rep ShelleyGenesisStaking x)
-> (forall x. Rep ShelleyGenesisStaking x -> ShelleyGenesisStaking)
-> Generic ShelleyGenesisStaking
forall x. Rep ShelleyGenesisStaking x -> ShelleyGenesisStaking
forall x. ShelleyGenesisStaking -> Rep ShelleyGenesisStaking x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ShelleyGenesisStaking -> Rep ShelleyGenesisStaking x
from :: forall x. ShelleyGenesisStaking -> Rep ShelleyGenesisStaking x
$cto :: forall x. Rep ShelleyGenesisStaking x -> ShelleyGenesisStaking
to :: forall x. Rep ShelleyGenesisStaking x -> ShelleyGenesisStaking
Generic)
  deriving ([ShelleyGenesisStaking] -> Value
[ShelleyGenesisStaking] -> Encoding
ShelleyGenesisStaking -> Bool
ShelleyGenesisStaking -> Value
ShelleyGenesisStaking -> Encoding
(ShelleyGenesisStaking -> Value)
-> (ShelleyGenesisStaking -> Encoding)
-> ([ShelleyGenesisStaking] -> Value)
-> ([ShelleyGenesisStaking] -> Encoding)
-> (ShelleyGenesisStaking -> Bool)
-> ToJSON ShelleyGenesisStaking
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ShelleyGenesisStaking -> Value
toJSON :: ShelleyGenesisStaking -> Value
$ctoEncoding :: ShelleyGenesisStaking -> Encoding
toEncoding :: ShelleyGenesisStaking -> Encoding
$ctoJSONList :: [ShelleyGenesisStaking] -> Value
toJSONList :: [ShelleyGenesisStaking] -> Value
$ctoEncodingList :: [ShelleyGenesisStaking] -> Encoding
toEncodingList :: [ShelleyGenesisStaking] -> Encoding
$comitField :: ShelleyGenesisStaking -> Bool
omitField :: ShelleyGenesisStaking -> Bool
ToJSON) via KeyValuePairs ShelleyGenesisStaking

instance NFData ShelleyGenesisStaking

instance NoThunks ShelleyGenesisStaking

instance Semigroup ShelleyGenesisStaking where
  <> :: ShelleyGenesisStaking
-> ShelleyGenesisStaking -> ShelleyGenesisStaking
(<>) (ShelleyGenesisStaking ListMap (KeyHash StakePool) StakePoolParams
p1 ListMap (KeyHash Staking) (KeyHash StakePool)
s1) (ShelleyGenesisStaking ListMap (KeyHash StakePool) StakePoolParams
p2 ListMap (KeyHash Staking) (KeyHash StakePool)
s2) =
    ListMap (KeyHash StakePool) StakePoolParams
-> ListMap (KeyHash Staking) (KeyHash StakePool)
-> ShelleyGenesisStaking
ShelleyGenesisStaking (ListMap (KeyHash StakePool) StakePoolParams
p1 ListMap (KeyHash StakePool) StakePoolParams
-> ListMap (KeyHash StakePool) StakePoolParams
-> ListMap (KeyHash StakePool) StakePoolParams
forall a. Semigroup a => a -> a -> a
<> ListMap (KeyHash StakePool) StakePoolParams
p2) (ListMap (KeyHash Staking) (KeyHash StakePool)
s1 ListMap (KeyHash Staking) (KeyHash StakePool)
-> ListMap (KeyHash Staking) (KeyHash StakePool)
-> ListMap (KeyHash Staking) (KeyHash StakePool)
forall a. Semigroup a => a -> a -> a
<> ListMap (KeyHash Staking) (KeyHash StakePool)
s2)

instance Monoid ShelleyGenesisStaking where
  mempty :: ShelleyGenesisStaking
mempty = ListMap (KeyHash StakePool) StakePoolParams
-> ListMap (KeyHash Staking) (KeyHash StakePool)
-> ShelleyGenesisStaking
ShelleyGenesisStaking ListMap (KeyHash StakePool) StakePoolParams
forall a. Monoid a => a
mempty ListMap (KeyHash Staking) (KeyHash StakePool)
forall a. Monoid a => a
mempty

instance EncCBOR ShelleyGenesisStaking where
  encCBOR :: ShelleyGenesisStaking -> Encoding
encCBOR (ShelleyGenesisStaking ListMap (KeyHash StakePool) StakePoolParams
pools ListMap (KeyHash Staking) (KeyHash StakePool)
stake) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ListMap (KeyHash StakePool) StakePoolParams -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ListMap (KeyHash StakePool) StakePoolParams
pools Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ListMap (KeyHash Staking) (KeyHash StakePool) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ListMap (KeyHash Staking) (KeyHash StakePool)
stake

instance DecCBOR ShelleyGenesisStaking where
  decCBOR :: forall s. Decoder s ShelleyGenesisStaking
decCBOR = do
    Text
-> (ShelleyGenesisStaking -> Int)
-> Decoder s ShelleyGenesisStaking
-> Decoder s ShelleyGenesisStaking
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"ShelleyGenesisStaking" (Int -> ShelleyGenesisStaking -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s ShelleyGenesisStaking
 -> Decoder s ShelleyGenesisStaking)
-> Decoder s ShelleyGenesisStaking
-> Decoder s ShelleyGenesisStaking
forall a b. (a -> b) -> a -> b
$ do
      pools <- Decoder s (ListMap (KeyHash StakePool) StakePoolParams)
forall s. Decoder s (ListMap (KeyHash StakePool) StakePoolParams)
forall a s. DecCBOR a => Decoder s a
decCBOR
      stake <- decCBOR
      pure $ ShelleyGenesisStaking pools stake

-- | Empty genesis staking
emptyGenesisStaking :: ShelleyGenesisStaking
emptyGenesisStaking :: ShelleyGenesisStaking
emptyGenesisStaking = ShelleyGenesisStaking
forall a. Monoid a => a
mempty

-- | Unlike @'NominalDiffTime'@ that supports @'Pico'@ precision, this type
-- only supports @'Micro'@ precision.
newtype NominalDiffTimeMicro = NominalDiffTimeMicro Micro
  deriving (Int -> NominalDiffTimeMicro -> ShowS
[NominalDiffTimeMicro] -> ShowS
NominalDiffTimeMicro -> String
(Int -> NominalDiffTimeMicro -> ShowS)
-> (NominalDiffTimeMicro -> String)
-> ([NominalDiffTimeMicro] -> ShowS)
-> Show NominalDiffTimeMicro
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NominalDiffTimeMicro -> ShowS
showsPrec :: Int -> NominalDiffTimeMicro -> ShowS
$cshow :: NominalDiffTimeMicro -> String
show :: NominalDiffTimeMicro -> String
$cshowList :: [NominalDiffTimeMicro] -> ShowS
showList :: [NominalDiffTimeMicro] -> ShowS
Show, NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool
(NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool)
-> (NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool)
-> Eq NominalDiffTimeMicro
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool
== :: NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool
$c/= :: NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool
/= :: NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool
Eq, (forall x. NominalDiffTimeMicro -> Rep NominalDiffTimeMicro x)
-> (forall x. Rep NominalDiffTimeMicro x -> NominalDiffTimeMicro)
-> Generic NominalDiffTimeMicro
forall x. Rep NominalDiffTimeMicro x -> NominalDiffTimeMicro
forall x. NominalDiffTimeMicro -> Rep NominalDiffTimeMicro x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NominalDiffTimeMicro -> Rep NominalDiffTimeMicro x
from :: forall x. NominalDiffTimeMicro -> Rep NominalDiffTimeMicro x
$cto :: forall x. Rep NominalDiffTimeMicro x -> NominalDiffTimeMicro
to :: forall x. Rep NominalDiffTimeMicro x -> NominalDiffTimeMicro
Generic)
  deriving anyclass (Context -> NominalDiffTimeMicro -> IO (Maybe ThunkInfo)
Proxy NominalDiffTimeMicro -> String
(Context -> NominalDiffTimeMicro -> IO (Maybe ThunkInfo))
-> (Context -> NominalDiffTimeMicro -> IO (Maybe ThunkInfo))
-> (Proxy NominalDiffTimeMicro -> String)
-> NoThunks NominalDiffTimeMicro
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> NominalDiffTimeMicro -> IO (Maybe ThunkInfo)
noThunks :: Context -> NominalDiffTimeMicro -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> NominalDiffTimeMicro -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> NominalDiffTimeMicro -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy NominalDiffTimeMicro -> String
showTypeOf :: Proxy NominalDiffTimeMicro -> String
NoThunks)
  deriving newtype (Eq NominalDiffTimeMicro
Eq NominalDiffTimeMicro =>
(NominalDiffTimeMicro -> NominalDiffTimeMicro -> Ordering)
-> (NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool)
-> (NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool)
-> (NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool)
-> (NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool)
-> (NominalDiffTimeMicro
    -> NominalDiffTimeMicro -> NominalDiffTimeMicro)
-> (NominalDiffTimeMicro
    -> NominalDiffTimeMicro -> NominalDiffTimeMicro)
-> Ord NominalDiffTimeMicro
NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool
NominalDiffTimeMicro -> NominalDiffTimeMicro -> Ordering
NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
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 :: NominalDiffTimeMicro -> NominalDiffTimeMicro -> Ordering
compare :: NominalDiffTimeMicro -> NominalDiffTimeMicro -> Ordering
$c< :: NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool
< :: NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool
$c<= :: NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool
<= :: NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool
$c> :: NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool
> :: NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool
$c>= :: NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool
>= :: NominalDiffTimeMicro -> NominalDiffTimeMicro -> Bool
$cmax :: NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
max :: NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
$cmin :: NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
min :: NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
Ord, Integer -> NominalDiffTimeMicro
NominalDiffTimeMicro -> NominalDiffTimeMicro
NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
(NominalDiffTimeMicro
 -> NominalDiffTimeMicro -> NominalDiffTimeMicro)
-> (NominalDiffTimeMicro
    -> NominalDiffTimeMicro -> NominalDiffTimeMicro)
-> (NominalDiffTimeMicro
    -> NominalDiffTimeMicro -> NominalDiffTimeMicro)
-> (NominalDiffTimeMicro -> NominalDiffTimeMicro)
-> (NominalDiffTimeMicro -> NominalDiffTimeMicro)
-> (NominalDiffTimeMicro -> NominalDiffTimeMicro)
-> (Integer -> NominalDiffTimeMicro)
-> Num NominalDiffTimeMicro
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
+ :: NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
$c- :: NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
- :: NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
$c* :: NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
* :: NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
$cnegate :: NominalDiffTimeMicro -> NominalDiffTimeMicro
negate :: NominalDiffTimeMicro -> NominalDiffTimeMicro
$cabs :: NominalDiffTimeMicro -> NominalDiffTimeMicro
abs :: NominalDiffTimeMicro -> NominalDiffTimeMicro
$csignum :: NominalDiffTimeMicro -> NominalDiffTimeMicro
signum :: NominalDiffTimeMicro -> NominalDiffTimeMicro
$cfromInteger :: Integer -> NominalDiffTimeMicro
fromInteger :: Integer -> NominalDiffTimeMicro
Num, Num NominalDiffTimeMicro
Num NominalDiffTimeMicro =>
(NominalDiffTimeMicro
 -> NominalDiffTimeMicro -> NominalDiffTimeMicro)
-> (NominalDiffTimeMicro -> NominalDiffTimeMicro)
-> (Rational -> NominalDiffTimeMicro)
-> Fractional NominalDiffTimeMicro
Rational -> NominalDiffTimeMicro
NominalDiffTimeMicro -> NominalDiffTimeMicro
NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
/ :: NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
$crecip :: NominalDiffTimeMicro -> NominalDiffTimeMicro
recip :: NominalDiffTimeMicro -> NominalDiffTimeMicro
$cfromRational :: Rational -> NominalDiffTimeMicro
fromRational :: Rational -> NominalDiffTimeMicro
Fractional, Num NominalDiffTimeMicro
Ord NominalDiffTimeMicro
(Num NominalDiffTimeMicro, Ord NominalDiffTimeMicro) =>
(NominalDiffTimeMicro -> Rational) -> Real NominalDiffTimeMicro
NominalDiffTimeMicro -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: NominalDiffTimeMicro -> Rational
toRational :: NominalDiffTimeMicro -> Rational
Real, [NominalDiffTimeMicro] -> Value
[NominalDiffTimeMicro] -> Encoding
NominalDiffTimeMicro -> Bool
NominalDiffTimeMicro -> Value
NominalDiffTimeMicro -> Encoding
(NominalDiffTimeMicro -> Value)
-> (NominalDiffTimeMicro -> Encoding)
-> ([NominalDiffTimeMicro] -> Value)
-> ([NominalDiffTimeMicro] -> Encoding)
-> (NominalDiffTimeMicro -> Bool)
-> ToJSON NominalDiffTimeMicro
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: NominalDiffTimeMicro -> Value
toJSON :: NominalDiffTimeMicro -> Value
$ctoEncoding :: NominalDiffTimeMicro -> Encoding
toEncoding :: NominalDiffTimeMicro -> Encoding
$ctoJSONList :: [NominalDiffTimeMicro] -> Value
toJSONList :: [NominalDiffTimeMicro] -> Value
$ctoEncodingList :: [NominalDiffTimeMicro] -> Encoding
toEncodingList :: [NominalDiffTimeMicro] -> Encoding
$comitField :: NominalDiffTimeMicro -> Bool
omitField :: NominalDiffTimeMicro -> Bool
ToJSON, Maybe NominalDiffTimeMicro
Value -> Parser [NominalDiffTimeMicro]
Value -> Parser NominalDiffTimeMicro
(Value -> Parser NominalDiffTimeMicro)
-> (Value -> Parser [NominalDiffTimeMicro])
-> Maybe NominalDiffTimeMicro
-> FromJSON NominalDiffTimeMicro
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser NominalDiffTimeMicro
parseJSON :: Value -> Parser NominalDiffTimeMicro
$cparseJSONList :: Value -> Parser [NominalDiffTimeMicro]
parseJSONList :: Value -> Parser [NominalDiffTimeMicro]
$comittedField :: Maybe NominalDiffTimeMicro
omittedField :: Maybe NominalDiffTimeMicro
FromJSON, NominalDiffTimeMicro -> Encoding
(NominalDiffTimeMicro -> Encoding) -> EncCBOR NominalDiffTimeMicro
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: NominalDiffTimeMicro -> Encoding
encCBOR :: NominalDiffTimeMicro -> Encoding
EncCBOR, Typeable NominalDiffTimeMicro
Typeable NominalDiffTimeMicro =>
(forall s. Decoder s NominalDiffTimeMicro)
-> (forall s. Proxy NominalDiffTimeMicro -> Decoder s ())
-> (Proxy NominalDiffTimeMicro -> Text)
-> DecCBOR NominalDiffTimeMicro
Proxy NominalDiffTimeMicro -> Text
forall s. Decoder s NominalDiffTimeMicro
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy NominalDiffTimeMicro -> Decoder s ()
$cdecCBOR :: forall s. Decoder s NominalDiffTimeMicro
decCBOR :: forall s. Decoder s NominalDiffTimeMicro
$cdropCBOR :: forall s. Proxy NominalDiffTimeMicro -> Decoder s ()
dropCBOR :: forall s. Proxy NominalDiffTimeMicro -> Decoder s ()
$clabel :: Proxy NominalDiffTimeMicro -> Text
label :: Proxy NominalDiffTimeMicro -> Text
DecCBOR, NominalDiffTimeMicro -> ()
(NominalDiffTimeMicro -> ()) -> NFData NominalDiffTimeMicro
forall a. (a -> ()) -> NFData a
$crnf :: NominalDiffTimeMicro -> ()
rnf :: NominalDiffTimeMicro -> ()
NFData)

-- | There is no loss of resolution in this conversion
microToPico :: Micro -> Pico
microToPico :: Micro -> Pico
microToPico Micro
micro = forall a. Fractional a => Rational -> a
fromRational @Pico (Rational -> Pico) -> Rational -> Pico
forall a b. (a -> b) -> a -> b
$ Micro -> Rational
forall a. Real a => a -> Rational
toRational Micro
micro

-- | Loss of resolution occurs in this conversion
picoToMicro :: Pico -> Micro
picoToMicro :: Pico -> Micro
picoToMicro Pico
pico = forall a. Fractional a => Rational -> a
fromRational @Micro (Rational -> Micro) -> Rational -> Micro
forall a b. (a -> b) -> a -> b
$ Pico -> Rational
forall a. Real a => a -> Rational
toRational Pico
pico

fromNominalDiffTimeMicro :: NominalDiffTimeMicro -> NominalDiffTime
fromNominalDiffTimeMicro :: NominalDiffTimeMicro -> NominalDiffTime
fromNominalDiffTimeMicro =
  Pico -> NominalDiffTime
secondsToNominalDiffTime (Pico -> NominalDiffTime)
-> (NominalDiffTimeMicro -> Pico)
-> NominalDiffTimeMicro
-> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Micro -> Pico
microToPico (Micro -> Pico)
-> (NominalDiffTimeMicro -> Micro) -> NominalDiffTimeMicro -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTimeMicro -> Micro
nominalDiffTimeMicroToMicroseconds

toNominalDiffTimeMicroWithRounding :: NominalDiffTime -> NominalDiffTimeMicro
toNominalDiffTimeMicroWithRounding :: NominalDiffTime -> NominalDiffTimeMicro
toNominalDiffTimeMicroWithRounding =
  Micro -> NominalDiffTimeMicro
secondsToNominalDiffTimeMicro (Micro -> NominalDiffTimeMicro)
-> (NominalDiffTime -> Micro)
-> NominalDiffTime
-> NominalDiffTimeMicro
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pico -> Micro
picoToMicro (Pico -> Micro)
-> (NominalDiffTime -> Pico) -> NominalDiffTime -> Micro
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Pico
nominalDiffTimeToSeconds

toNominalDiffTimeMicro :: NominalDiffTime -> Maybe NominalDiffTimeMicro
toNominalDiffTimeMicro :: NominalDiffTime -> Maybe NominalDiffTimeMicro
toNominalDiffTimeMicro NominalDiffTime
ndt
  | NominalDiffTimeMicro -> NominalDiffTime
fromNominalDiffTimeMicro NominalDiffTimeMicro
ndtm NominalDiffTime -> NominalDiffTime -> Bool
forall a. Eq a => a -> a -> Bool
== NominalDiffTime
ndt = NominalDiffTimeMicro -> Maybe NominalDiffTimeMicro
forall a. a -> Maybe a
Just NominalDiffTimeMicro
ndtm
  | Bool
otherwise = Maybe NominalDiffTimeMicro
forall a. Maybe a
Nothing
  where
    ndtm :: NominalDiffTimeMicro
ndtm = NominalDiffTime -> NominalDiffTimeMicro
toNominalDiffTimeMicroWithRounding NominalDiffTime
ndt

secondsToNominalDiffTimeMicro :: Micro -> NominalDiffTimeMicro
secondsToNominalDiffTimeMicro :: Micro -> NominalDiffTimeMicro
secondsToNominalDiffTimeMicro = Micro -> NominalDiffTimeMicro
NominalDiffTimeMicro

nominalDiffTimeMicroToMicroseconds :: NominalDiffTimeMicro -> Micro
nominalDiffTimeMicroToMicroseconds :: NominalDiffTimeMicro -> Micro
nominalDiffTimeMicroToMicroseconds (NominalDiffTimeMicro Micro
microseconds) = Micro
microseconds

nominalDiffTimeMicroToSeconds :: NominalDiffTimeMicro -> Pico
nominalDiffTimeMicroToSeconds :: NominalDiffTimeMicro -> Pico
nominalDiffTimeMicroToSeconds (NominalDiffTimeMicro Micro
microseconds) = Micro -> Pico
microToPico Micro
microseconds

-- | Shelley genesis information
--
-- Note that this is needed only for a pure Shelley network, hence it being
-- defined here rather than in its own module. In mainnet, Shelley will
-- transition naturally from Byron, and thus will never have its own genesis
-- information.
data ShelleyGenesis = ShelleyGenesis
  { ShelleyGenesis -> UTCTime
sgSystemStart :: !UTCTime
  , ShelleyGenesis -> Word32
sgNetworkMagic :: !Word32
  , ShelleyGenesis -> Network
sgNetworkId :: !Network
  , ShelleyGenesis -> PositiveUnitInterval
sgActiveSlotsCoeff :: !PositiveUnitInterval
  , ShelleyGenesis -> NonZero Word64
sgSecurityParam :: !(NonZero Word64)
  , ShelleyGenesis -> EpochSize
sgEpochLength :: !EpochSize
  , ShelleyGenesis -> Word64
sgSlotsPerKESPeriod :: !Word64
  , ShelleyGenesis -> Word64
sgMaxKESEvolutions :: !Word64
  , ShelleyGenesis -> NominalDiffTimeMicro
sgSlotLength :: !NominalDiffTimeMicro
  , ShelleyGenesis -> Word64
sgUpdateQuorum :: !Word64
  , ShelleyGenesis -> Word64
sgMaxLovelaceSupply :: !Word64
  , ShelleyGenesis -> PParams ShelleyEra
sgProtocolParams :: !(PParams ShelleyEra)
  , ShelleyGenesis -> Map (KeyHash GenesisRole) GenDelegPair
sgGenDelegs :: !(Map (KeyHash GenesisRole) GenDelegPair)
  , ShelleyGenesis -> ListMap Addr Coin
sgInitialFunds :: LM.ListMap Addr Coin
  -- ^ 'sgInitialFunds' is intentionally kept lazy, as it can otherwise cause
  --   out-of-memory problems in testing and benchmarking.
  , ShelleyGenesis -> ShelleyGenesisStaking
sgStaking :: ShelleyGenesisStaking
  -- ^ 'sgStaking' is intentionally kept lazy, as it can otherwise cause
  --   out-of-memory problems in testing and benchmarking.
  }
  deriving stock ((forall x. ShelleyGenesis -> Rep ShelleyGenesis x)
-> (forall x. Rep ShelleyGenesis x -> ShelleyGenesis)
-> Generic ShelleyGenesis
forall x. Rep ShelleyGenesis x -> ShelleyGenesis
forall x. ShelleyGenesis -> Rep ShelleyGenesis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ShelleyGenesis -> Rep ShelleyGenesis x
from :: forall x. ShelleyGenesis -> Rep ShelleyGenesis x
$cto :: forall x. Rep ShelleyGenesis x -> ShelleyGenesis
to :: forall x. Rep ShelleyGenesis x -> ShelleyGenesis
Generic, Int -> ShelleyGenesis -> ShowS
[ShelleyGenesis] -> ShowS
ShelleyGenesis -> String
(Int -> ShelleyGenesis -> ShowS)
-> (ShelleyGenesis -> String)
-> ([ShelleyGenesis] -> ShowS)
-> Show ShelleyGenesis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShelleyGenesis -> ShowS
showsPrec :: Int -> ShelleyGenesis -> ShowS
$cshow :: ShelleyGenesis -> String
show :: ShelleyGenesis -> String
$cshowList :: [ShelleyGenesis] -> ShowS
showList :: [ShelleyGenesis] -> ShowS
Show, ShelleyGenesis -> ShelleyGenesis -> Bool
(ShelleyGenesis -> ShelleyGenesis -> Bool)
-> (ShelleyGenesis -> ShelleyGenesis -> Bool) -> Eq ShelleyGenesis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShelleyGenesis -> ShelleyGenesis -> Bool
== :: ShelleyGenesis -> ShelleyGenesis -> Bool
$c/= :: ShelleyGenesis -> ShelleyGenesis -> Bool
/= :: ShelleyGenesis -> ShelleyGenesis -> Bool
Eq)
  deriving ([ShelleyGenesis] -> Value
[ShelleyGenesis] -> Encoding
ShelleyGenesis -> Bool
ShelleyGenesis -> Value
ShelleyGenesis -> Encoding
(ShelleyGenesis -> Value)
-> (ShelleyGenesis -> Encoding)
-> ([ShelleyGenesis] -> Value)
-> ([ShelleyGenesis] -> Encoding)
-> (ShelleyGenesis -> Bool)
-> ToJSON ShelleyGenesis
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ShelleyGenesis -> Value
toJSON :: ShelleyGenesis -> Value
$ctoEncoding :: ShelleyGenesis -> Encoding
toEncoding :: ShelleyGenesis -> Encoding
$ctoJSONList :: [ShelleyGenesis] -> Value
toJSONList :: [ShelleyGenesis] -> Value
$ctoEncodingList :: [ShelleyGenesis] -> Encoding
toEncodingList :: [ShelleyGenesis] -> Encoding
$comitField :: ShelleyGenesis -> Bool
omitField :: ShelleyGenesis -> Bool
ToJSON) via KeyValuePairs ShelleyGenesis

instance NFData ShelleyGenesis

sgInitialFundsL :: Lens' ShelleyGenesis (LM.ListMap Addr Coin)
sgInitialFundsL :: Lens' ShelleyGenesis (ListMap Addr Coin)
sgInitialFundsL = (ShelleyGenesis -> ListMap Addr Coin)
-> (ShelleyGenesis -> ListMap Addr Coin -> ShelleyGenesis)
-> Lens' ShelleyGenesis (ListMap Addr Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ShelleyGenesis -> ListMap Addr Coin
sgInitialFunds (\ShelleyGenesis
sg ListMap Addr Coin
x -> ShelleyGenesis
sg {sgInitialFunds = x})

sgStakingL :: Lens' ShelleyGenesis ShelleyGenesisStaking
sgStakingL :: Lens' ShelleyGenesis ShelleyGenesisStaking
sgStakingL = (ShelleyGenesis -> ShelleyGenesisStaking)
-> (ShelleyGenesis -> ShelleyGenesisStaking -> ShelleyGenesis)
-> Lens' ShelleyGenesis ShelleyGenesisStaking
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ShelleyGenesis -> ShelleyGenesisStaking
sgStaking (\ShelleyGenesis
sg ShelleyGenesisStaking
x -> ShelleyGenesis
sg {sgStaking = x})

deriving via
  AllowThunksIn '["sgInitialFunds", "sgStaking"] ShelleyGenesis
  instance
    NoThunks ShelleyGenesis

sgActiveSlotCoeff :: ShelleyGenesis -> ActiveSlotCoeff
sgActiveSlotCoeff :: ShelleyGenesis -> ActiveSlotCoeff
sgActiveSlotCoeff = PositiveUnitInterval -> ActiveSlotCoeff
mkActiveSlotCoeff (PositiveUnitInterval -> ActiveSlotCoeff)
-> (ShelleyGenesis -> PositiveUnitInterval)
-> ShelleyGenesis
-> ActiveSlotCoeff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyGenesis -> PositiveUnitInterval
sgActiveSlotsCoeff

instance ToKeyValuePairs ShelleyGenesis where
  toKeyValuePairs :: forall e kv. KeyValue e kv => ShelleyGenesis -> [kv]
toKeyValuePairs
    ShelleyGenesis
      { UTCTime
sgSystemStart :: ShelleyGenesis -> UTCTime
sgSystemStart :: UTCTime
sgSystemStart
      , Word32
sgNetworkMagic :: ShelleyGenesis -> Word32
sgNetworkMagic :: Word32
sgNetworkMagic
      , Network
sgNetworkId :: ShelleyGenesis -> Network
sgNetworkId :: Network
sgNetworkId
      , PositiveUnitInterval
sgActiveSlotsCoeff :: ShelleyGenesis -> PositiveUnitInterval
sgActiveSlotsCoeff :: PositiveUnitInterval
sgActiveSlotsCoeff
      , NonZero Word64
sgSecurityParam :: ShelleyGenesis -> NonZero Word64
sgSecurityParam :: NonZero Word64
sgSecurityParam
      , EpochSize
sgEpochLength :: ShelleyGenesis -> EpochSize
sgEpochLength :: EpochSize
sgEpochLength
      , Word64
sgSlotsPerKESPeriod :: ShelleyGenesis -> Word64
sgSlotsPerKESPeriod :: Word64
sgSlotsPerKESPeriod
      , Word64
sgMaxKESEvolutions :: ShelleyGenesis -> Word64
sgMaxKESEvolutions :: Word64
sgMaxKESEvolutions
      , NominalDiffTimeMicro
sgSlotLength :: ShelleyGenesis -> NominalDiffTimeMicro
sgSlotLength :: NominalDiffTimeMicro
sgSlotLength
      , Word64
sgUpdateQuorum :: ShelleyGenesis -> Word64
sgUpdateQuorum :: Word64
sgUpdateQuorum
      , Word64
sgMaxLovelaceSupply :: ShelleyGenesis -> Word64
sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply
      , PParams ShelleyEra
sgProtocolParams :: ShelleyGenesis -> PParams ShelleyEra
sgProtocolParams :: PParams ShelleyEra
sgProtocolParams
      , Map (KeyHash GenesisRole) GenDelegPair
sgGenDelegs :: ShelleyGenesis -> Map (KeyHash GenesisRole) GenDelegPair
sgGenDelegs :: Map (KeyHash GenesisRole) GenDelegPair
sgGenDelegs
      , ListMap Addr Coin
sgInitialFunds :: ShelleyGenesis -> ListMap Addr Coin
sgInitialFunds :: ListMap Addr Coin
sgInitialFunds
      , ShelleyGenesisStaking
sgStaking :: ShelleyGenesis -> ShelleyGenesisStaking
sgStaking :: ShelleyGenesisStaking
sgStaking
      } =
      let !strictSgInitialFunds :: ListMap Addr Coin
strictSgInitialFunds = ListMap Addr Coin
sgInitialFunds
          !strictSgStaking :: ShelleyGenesisStaking
strictSgStaking = ShelleyGenesisStaking
sgStaking
       in [ Key
"systemStart" Key -> UTCTime -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTCTime
sgSystemStart
          , Key
"networkMagic" Key -> Word32 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
sgNetworkMagic
          , Key
"networkId" Key -> Network -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Network
sgNetworkId
          , Key
"activeSlotsCoeff" Key -> PositiveUnitInterval -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PositiveUnitInterval
sgActiveSlotsCoeff
          , Key
"securityParam" Key -> NonZero Word64 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonZero Word64
sgSecurityParam
          , Key
"epochLength" Key -> EpochSize -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EpochSize
sgEpochLength
          , Key
"slotsPerKESPeriod" Key -> Word64 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
sgSlotsPerKESPeriod
          , Key
"maxKESEvolutions" Key -> Word64 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
sgMaxKESEvolutions
          , Key
"slotLength" Key -> NominalDiffTimeMicro -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NominalDiffTimeMicro
sgSlotLength
          , Key
"updateQuorum" Key -> Word64 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
sgUpdateQuorum
          , Key
"maxLovelaceSupply" Key -> Word64 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
sgMaxLovelaceSupply
          , Key
"protocolParams" Key -> LegacyJSONPParams -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PParams ShelleyEra -> LegacyJSONPParams
legacyToJSONPParams PParams ShelleyEra
sgProtocolParams
          , Key
"genDelegs" Key -> Map (KeyHash GenesisRole) GenDelegPair -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash GenesisRole) GenDelegPair
sgGenDelegs
          , Key
"initialFunds" Key -> ListMap Addr Coin -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ListMap Addr Coin
strictSgInitialFunds
          , Key
"staking" Key -> ShelleyGenesisStaking -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesisStaking
strictSgStaking
          ]

instance EraGenesis ShelleyEra where
  type Genesis ShelleyEra = ShelleyGenesis

--------------------------------------------------
-- Legacy JSON representation of ShelleyGenesis --
--------------------------------------------------
newtype LegacyJSONPParams = LegacyJSONPParams (PParamsHKD Identity ShelleyEra)

legacyFromJSONPParams :: LegacyJSONPParams -> PParams ShelleyEra
legacyFromJSONPParams :: LegacyJSONPParams -> PParams ShelleyEra
legacyFromJSONPParams (LegacyJSONPParams PParamsHKD Identity ShelleyEra
x) = PParamsHKD Identity ShelleyEra -> PParams ShelleyEra
forall era. PParamsHKD Identity era -> PParams era
PParams PParamsHKD Identity ShelleyEra
x

instance FromJSON LegacyJSONPParams where
  parseJSON :: Value -> Parser LegacyJSONPParams
parseJSON =
    String
-> (Object -> Parser LegacyJSONPParams)
-> Value
-> Parser LegacyJSONPParams
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ShelleyPParams" ((Object -> Parser LegacyJSONPParams)
 -> Value -> Parser LegacyJSONPParams)
-> (Object -> Parser LegacyJSONPParams)
-> Value
-> Parser LegacyJSONPParams
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      PParamsHKD Identity ShelleyEra -> LegacyJSONPParams
ShelleyPParams Identity ShelleyEra -> LegacyJSONPParams
LegacyJSONPParams
        (ShelleyPParams Identity ShelleyEra -> LegacyJSONPParams)
-> Parser (ShelleyPParams Identity ShelleyEra)
-> Parser LegacyJSONPParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( CompactForm Coin
-> CompactForm Coin
-> Word32
-> Word32
-> Word16
-> CompactForm Coin
-> CompactForm Coin
-> EpochInterval
-> Word16
-> NonNegativeInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> Nonce
-> ProtVer
-> CompactForm Coin
-> CompactForm Coin
-> ShelleyPParams Identity ShelleyEra
HKD Identity (CompactForm Coin)
-> HKD Identity (CompactForm Coin)
-> HKD Identity Word32
-> HKD Identity Word32
-> HKD Identity Word16
-> HKD Identity (CompactForm Coin)
-> HKD Identity (CompactForm Coin)
-> HKD Identity EpochInterval
-> HKD Identity Word16
-> HKD Identity NonNegativeInterval
-> HKD Identity UnitInterval
-> HKD Identity UnitInterval
-> HKD Identity UnitInterval
-> HKD Identity Nonce
-> HKD Identity ProtVer
-> HKD Identity (CompactForm Coin)
-> HKD Identity (CompactForm Coin)
-> ShelleyPParams Identity ShelleyEra
forall (f :: * -> *) era.
HKD f (CompactForm Coin)
-> HKD f (CompactForm Coin)
-> HKD f Word32
-> HKD f Word32
-> HKD f Word16
-> HKD f (CompactForm Coin)
-> HKD f (CompactForm Coin)
-> HKD f EpochInterval
-> HKD f Word16
-> HKD f NonNegativeInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f Nonce
-> HKD f ProtVer
-> HKD f (CompactForm Coin)
-> HKD f (CompactForm Coin)
-> ShelleyPParams f era
ShelleyPParams
                (CompactForm Coin
 -> CompactForm Coin
 -> Word32
 -> Word32
 -> Word16
 -> CompactForm Coin
 -> CompactForm Coin
 -> EpochInterval
 -> Word16
 -> NonNegativeInterval
 -> UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> Nonce
 -> ProtVer
 -> CompactForm Coin
 -> CompactForm Coin
 -> ShelleyPParams Identity ShelleyEra)
-> Parser (CompactForm Coin)
-> Parser
     (CompactForm Coin
      -> Word32
      -> Word32
      -> Word16
      -> CompactForm Coin
      -> CompactForm Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> CompactForm Coin
      -> CompactForm Coin
      -> ShelleyPParams Identity ShelleyEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (CompactForm Coin)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minFeeA"
                Parser
  (CompactForm Coin
   -> Word32
   -> Word32
   -> Word16
   -> CompactForm Coin
   -> CompactForm Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> CompactForm Coin
   -> CompactForm Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser (CompactForm Coin)
-> Parser
     (Word32
      -> Word32
      -> Word16
      -> CompactForm Coin
      -> CompactForm Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> CompactForm Coin
      -> CompactForm Coin
      -> ShelleyPParams Identity ShelleyEra)
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 (CompactForm Coin)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minFeeB"
                Parser
  (Word32
   -> Word32
   -> Word16
   -> CompactForm Coin
   -> CompactForm Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> CompactForm Coin
   -> CompactForm Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser Word32
-> Parser
     (Word32
      -> Word16
      -> CompactForm Coin
      -> CompactForm Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> CompactForm Coin
      -> CompactForm Coin
      -> ShelleyPParams Identity ShelleyEra)
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 Word32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxBlockBodySize"
                Parser
  (Word32
   -> Word16
   -> CompactForm Coin
   -> CompactForm Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> CompactForm Coin
   -> CompactForm Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser Word32
-> Parser
     (Word16
      -> CompactForm Coin
      -> CompactForm Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> CompactForm Coin
      -> CompactForm Coin
      -> ShelleyPParams Identity ShelleyEra)
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 Word32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxTxSize"
                Parser
  (Word16
   -> CompactForm Coin
   -> CompactForm Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> CompactForm Coin
   -> CompactForm Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser Word16
-> Parser
     (CompactForm Coin
      -> CompactForm Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> CompactForm Coin
      -> CompactForm Coin
      -> ShelleyPParams Identity ShelleyEra)
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 Word16
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxBlockHeaderSize"
                Parser
  (CompactForm Coin
   -> CompactForm Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> CompactForm Coin
   -> CompactForm Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser (CompactForm Coin)
-> Parser
     (CompactForm Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> CompactForm Coin
      -> CompactForm Coin
      -> ShelleyPParams Identity ShelleyEra)
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 (CompactForm Coin)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"keyDeposit"
                Parser
  (CompactForm Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> CompactForm Coin
   -> CompactForm Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser (CompactForm Coin)
-> Parser
     (EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> CompactForm Coin
      -> CompactForm Coin
      -> ShelleyPParams Identity ShelleyEra)
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 (CompactForm Coin)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"poolDeposit"
                Parser
  (EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> CompactForm Coin
   -> CompactForm Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser EpochInterval
-> Parser
     (Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> CompactForm Coin
      -> CompactForm Coin
      -> ShelleyPParams Identity ShelleyEra)
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 EpochInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"eMax"
                Parser
  (Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> CompactForm Coin
   -> CompactForm Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser Word16
-> Parser
     (NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> CompactForm Coin
      -> CompactForm Coin
      -> ShelleyPParams Identity ShelleyEra)
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 Word16
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nOpt"
                Parser
  (NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> CompactForm Coin
   -> CompactForm Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser NonNegativeInterval
-> Parser
     (UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> CompactForm Coin
      -> CompactForm Coin
      -> ShelleyPParams Identity ShelleyEra)
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 NonNegativeInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"a0"
                Parser
  (UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> CompactForm Coin
   -> CompactForm Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser UnitInterval
-> Parser
     (UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> CompactForm Coin
      -> CompactForm Coin
      -> ShelleyPParams Identity ShelleyEra)
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
"rho"
                Parser
  (UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> CompactForm Coin
   -> CompactForm Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser UnitInterval
-> Parser
     (UnitInterval
      -> Nonce
      -> ProtVer
      -> CompactForm Coin
      -> CompactForm Coin
      -> ShelleyPParams Identity ShelleyEra)
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
"tau"
                Parser
  (UnitInterval
   -> Nonce
   -> ProtVer
   -> CompactForm Coin
   -> CompactForm Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser UnitInterval
-> Parser
     (Nonce
      -> ProtVer
      -> CompactForm Coin
      -> CompactForm Coin
      -> ShelleyPParams Identity ShelleyEra)
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
"decentralisationParam"
                Parser
  (Nonce
   -> ProtVer
   -> CompactForm Coin
   -> CompactForm Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser Nonce
-> Parser
     (ProtVer
      -> CompactForm Coin
      -> CompactForm Coin
      -> ShelleyPParams Identity ShelleyEra)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser Nonce
parseNonce (Value -> Parser Nonce) -> Parser Value -> Parser Nonce
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"extraEntropy"))
                Parser
  (ProtVer
   -> CompactForm Coin
   -> CompactForm Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser ProtVer
-> Parser
     (CompactForm Coin
      -> CompactForm Coin -> ShelleyPParams Identity ShelleyEra)
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 ProtVer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"protocolVersion"
                Parser
  (CompactForm Coin
   -> CompactForm Coin -> ShelleyPParams Identity ShelleyEra)
-> Parser (CompactForm Coin)
-> Parser (CompactForm Coin -> ShelleyPParams Identity ShelleyEra)
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 (CompactForm Coin))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"minUTxOValue" Parser (Maybe (CompactForm Coin))
-> CompactForm Coin -> Parser (CompactForm Coin)
forall a. Parser (Maybe a) -> a -> Parser a
.!= CompactForm Coin
forall a. Monoid a => a
mempty
                Parser (CompactForm Coin -> ShelleyPParams Identity ShelleyEra)
-> Parser (CompactForm Coin)
-> Parser (ShelleyPParams Identity ShelleyEra)
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 (CompactForm Coin))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"minPoolCost" Parser (Maybe (CompactForm Coin))
-> CompactForm Coin -> Parser (CompactForm Coin)
forall a. Parser (Maybe a) -> a -> Parser a
.!= CompactForm Coin
forall a. Monoid a => a
mempty
            )
    where
      parseNonce :: Aeson.Value -> Parser Nonce
      parseNonce :: Value -> Parser Nonce
parseNonce =
        String -> (Object -> Parser Nonce) -> Value -> Parser Nonce
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject
          String
"Nonce"
          ( \Object
obj -> do
              tag <- (Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tag" :: Parser Text)
              case tag of
                Text
"Nonce" -> Hash Blake2b_256 Nonce -> Nonce
Nonce (Hash Blake2b_256 Nonce -> Nonce)
-> Parser (Hash Blake2b_256 Nonce) -> Parser Nonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Hash Blake2b_256 Nonce)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contents"
                Text
"NeutralNonce" -> Nonce -> Parser Nonce
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Nonce
NeutralNonce
                Text
_ -> String -> Value -> Parser Nonce
forall a. String -> Value -> Parser a
typeMismatch String
"Nonce" (Object -> Value
Object Object
obj)
          )

legacyToJSONPParams :: PParams ShelleyEra -> LegacyJSONPParams
legacyToJSONPParams :: PParams ShelleyEra -> LegacyJSONPParams
legacyToJSONPParams (PParams PParamsHKD Identity ShelleyEra
x) = PParamsHKD Identity ShelleyEra -> LegacyJSONPParams
LegacyJSONPParams PParamsHKD Identity ShelleyEra
x

instance ToJSON LegacyJSONPParams where
  toJSON :: LegacyJSONPParams -> Value
toJSON
    ( LegacyJSONPParams
        ( ShelleyPParams
            { HKD Identity (CompactForm Coin)
sppMinFeeA :: HKD Identity (CompactForm Coin)
sppMinFeeA :: forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f (CompactForm Coin)
sppMinFeeA
            , HKD Identity (CompactForm Coin)
sppMinFeeB :: HKD Identity (CompactForm Coin)
sppMinFeeB :: forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f (CompactForm Coin)
sppMinFeeB
            , HKD Identity Word32
sppMaxBBSize :: HKD Identity Word32
sppMaxBBSize :: forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Word32
sppMaxBBSize
            , HKD Identity Word32
sppMaxTxSize :: HKD Identity Word32
sppMaxTxSize :: forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Word32
sppMaxTxSize
            , HKD Identity Word16
sppMaxBHSize :: HKD Identity Word16
sppMaxBHSize :: forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Word16
sppMaxBHSize
            , HKD Identity (CompactForm Coin)
sppKeyDeposit :: HKD Identity (CompactForm Coin)
sppKeyDeposit :: forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f (CompactForm Coin)
sppKeyDeposit
            , HKD Identity (CompactForm Coin)
sppPoolDeposit :: HKD Identity (CompactForm Coin)
sppPoolDeposit :: forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f (CompactForm Coin)
sppPoolDeposit
            , HKD Identity EpochInterval
sppEMax :: HKD Identity EpochInterval
sppEMax :: forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f EpochInterval
sppEMax
            , HKD Identity Word16
sppNOpt :: HKD Identity Word16
sppNOpt :: forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Word16
sppNOpt
            , HKD Identity NonNegativeInterval
sppA0 :: HKD Identity NonNegativeInterval
sppA0 :: forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f NonNegativeInterval
sppA0
            , HKD Identity UnitInterval
sppRho :: HKD Identity UnitInterval
sppRho :: forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f UnitInterval
sppRho
            , HKD Identity UnitInterval
sppTau :: HKD Identity UnitInterval
sppTau :: forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f UnitInterval
sppTau
            , HKD Identity UnitInterval
sppD :: HKD Identity UnitInterval
sppD :: forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f UnitInterval
sppD
            , HKD Identity Nonce
sppExtraEntropy :: HKD Identity Nonce
sppExtraEntropy :: forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Nonce
sppExtraEntropy
            , HKD Identity ProtVer
sppProtocolVersion :: HKD Identity ProtVer
sppProtocolVersion :: forall (f :: * -> *) era. ShelleyPParams f era -> HKD f ProtVer
sppProtocolVersion
            , HKD Identity (CompactForm Coin)
sppMinUTxOValue :: HKD Identity (CompactForm Coin)
sppMinUTxOValue :: forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f (CompactForm Coin)
sppMinUTxOValue
            , HKD Identity (CompactForm Coin)
sppMinPoolCost :: HKD Identity (CompactForm Coin)
sppMinPoolCost :: forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f (CompactForm Coin)
sppMinPoolCost
            }
          )
      ) =
      [Pair] -> Value
Aeson.object
        [ Key
"minFeeA" Key -> CompactForm Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CompactForm Coin
HKD Identity (CompactForm Coin)
sppMinFeeA
        , Key
"minFeeB" Key -> CompactForm Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CompactForm Coin
HKD Identity (CompactForm Coin)
sppMinFeeB
        , Key
"maxBlockBodySize" Key -> Word32 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
HKD Identity Word32
sppMaxBBSize
        , Key
"maxTxSize" Key -> Word32 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
HKD Identity Word32
sppMaxTxSize
        , Key
"maxBlockHeaderSize" Key -> Word16 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word16
HKD Identity Word16
sppMaxBHSize
        , Key
"keyDeposit" Key -> CompactForm Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CompactForm Coin
HKD Identity (CompactForm Coin)
sppKeyDeposit
        , Key
"poolDeposit" Key -> CompactForm Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CompactForm Coin
HKD Identity (CompactForm Coin)
sppPoolDeposit
        , Key
"eMax" Key -> EpochInterval -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EpochInterval
HKD Identity EpochInterval
sppEMax
        , Key
"nOpt" Key -> Word16 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word16
HKD Identity Word16
sppNOpt
        , Key
"a0" Key -> NonNegativeInterval -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HKD Identity NonNegativeInterval
NonNegativeInterval
sppA0
        , Key
"rho" Key -> UnitInterval -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HKD Identity UnitInterval
UnitInterval
sppRho
        , Key
"tau" Key -> UnitInterval -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HKD Identity UnitInterval
UnitInterval
sppTau
        , Key
"decentralisationParam" Key -> UnitInterval -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HKD Identity UnitInterval
UnitInterval
sppD
        , Key
"extraEntropy"
            Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
              ( case HKD Identity Nonce
sppExtraEntropy of
                  Nonce Hash Blake2b_256 Nonce
hash ->
                    [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"Nonce" :: Text)
                    , Key
"contents" Key -> Hash Blake2b_256 Nonce -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Hash Blake2b_256 Nonce
hash
                    ]
                  HKD Identity Nonce
Nonce
NeutralNonce -> [Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"NeutralNonce" :: Text)]
              )
        , Key
"protocolVersion" Key -> ProtVer -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HKD Identity ProtVer
ProtVer
sppProtocolVersion
        , Key
"minUTxOValue" Key -> CompactForm Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CompactForm Coin
HKD Identity (CompactForm Coin)
sppMinUTxOValue
        , Key
"minPoolCost" Key -> CompactForm Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CompactForm Coin
HKD Identity (CompactForm Coin)
sppMinPoolCost
        ]

instance FromJSON ShelleyGenesis where
  parseJSON :: Value -> Parser ShelleyGenesis
parseJSON =
    String
-> (Object -> Parser ShelleyGenesis)
-> Value
-> Parser ShelleyGenesis
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ShelleyGenesis" ((Object -> Parser ShelleyGenesis)
 -> Value -> Parser ShelleyGenesis)
-> (Object -> Parser ShelleyGenesis)
-> Value
-> Parser ShelleyGenesis
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      UTCTime
-> Word32
-> Network
-> PositiveUnitInterval
-> NonZero Word64
-> EpochSize
-> Word64
-> Word64
-> NominalDiffTimeMicro
-> Word64
-> Word64
-> PParams ShelleyEra
-> Map (KeyHash GenesisRole) GenDelegPair
-> ListMap Addr Coin
-> ShelleyGenesisStaking
-> ShelleyGenesis
ShelleyGenesis
        (UTCTime
 -> Word32
 -> Network
 -> PositiveUnitInterval
 -> NonZero Word64
 -> EpochSize
 -> Word64
 -> Word64
 -> NominalDiffTimeMicro
 -> Word64
 -> Word64
 -> PParams ShelleyEra
 -> Map (KeyHash GenesisRole) GenDelegPair
 -> ListMap Addr Coin
 -> ShelleyGenesisStaking
 -> ShelleyGenesis)
-> Parser UTCTime
-> Parser
     (Word32
      -> Network
      -> PositiveUnitInterval
      -> NonZero Word64
      -> EpochSize
      -> Word64
      -> Word64
      -> NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash GenesisRole) GenDelegPair
      -> ListMap Addr Coin
      -> ShelleyGenesisStaking
      -> ShelleyGenesis)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UTCTime -> UTCTime
forceUTCTime (UTCTime -> UTCTime) -> Parser UTCTime -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"systemStart")
        Parser
  (Word32
   -> Network
   -> PositiveUnitInterval
   -> NonZero Word64
   -> EpochSize
   -> Word64
   -> Word64
   -> NominalDiffTimeMicro
   -> Word64
   -> Word64
   -> PParams ShelleyEra
   -> Map (KeyHash GenesisRole) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser Word32
-> Parser
     (Network
      -> PositiveUnitInterval
      -> NonZero Word64
      -> EpochSize
      -> Word64
      -> Word64
      -> NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash GenesisRole) GenDelegPair
      -> ListMap Addr Coin
      -> ShelleyGenesisStaking
      -> ShelleyGenesis)
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 Word32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"networkMagic"
        Parser
  (Network
   -> PositiveUnitInterval
   -> NonZero Word64
   -> EpochSize
   -> Word64
   -> Word64
   -> NominalDiffTimeMicro
   -> Word64
   -> Word64
   -> PParams ShelleyEra
   -> Map (KeyHash GenesisRole) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser Network
-> Parser
     (PositiveUnitInterval
      -> NonZero Word64
      -> EpochSize
      -> Word64
      -> Word64
      -> NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash GenesisRole) GenDelegPair
      -> ListMap Addr Coin
      -> ShelleyGenesisStaking
      -> ShelleyGenesis)
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 Network
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"networkId"
        Parser
  (PositiveUnitInterval
   -> NonZero Word64
   -> EpochSize
   -> Word64
   -> Word64
   -> NominalDiffTimeMicro
   -> Word64
   -> Word64
   -> PParams ShelleyEra
   -> Map (KeyHash GenesisRole) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser PositiveUnitInterval
-> Parser
     (NonZero Word64
      -> EpochSize
      -> Word64
      -> Word64
      -> NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash GenesisRole) GenDelegPair
      -> ListMap Addr Coin
      -> ShelleyGenesisStaking
      -> ShelleyGenesis)
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 PositiveUnitInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"activeSlotsCoeff"
        Parser
  (NonZero Word64
   -> EpochSize
   -> Word64
   -> Word64
   -> NominalDiffTimeMicro
   -> Word64
   -> Word64
   -> PParams ShelleyEra
   -> Map (KeyHash GenesisRole) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser (NonZero Word64)
-> Parser
     (EpochSize
      -> Word64
      -> Word64
      -> NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash GenesisRole) GenDelegPair
      -> ListMap Addr Coin
      -> ShelleyGenesisStaking
      -> ShelleyGenesis)
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 (NonZero Word64)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"securityParam"
        Parser
  (EpochSize
   -> Word64
   -> Word64
   -> NominalDiffTimeMicro
   -> Word64
   -> Word64
   -> PParams ShelleyEra
   -> Map (KeyHash GenesisRole) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser EpochSize
-> Parser
     (Word64
      -> Word64
      -> NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash GenesisRole) GenDelegPair
      -> ListMap Addr Coin
      -> ShelleyGenesisStaking
      -> ShelleyGenesis)
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 EpochSize
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"epochLength"
        Parser
  (Word64
   -> Word64
   -> NominalDiffTimeMicro
   -> Word64
   -> Word64
   -> PParams ShelleyEra
   -> Map (KeyHash GenesisRole) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser Word64
-> Parser
     (Word64
      -> NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash GenesisRole) GenDelegPair
      -> ListMap Addr Coin
      -> ShelleyGenesisStaking
      -> ShelleyGenesis)
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 Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slotsPerKESPeriod"
        Parser
  (Word64
   -> NominalDiffTimeMicro
   -> Word64
   -> Word64
   -> PParams ShelleyEra
   -> Map (KeyHash GenesisRole) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser Word64
-> Parser
     (NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash GenesisRole) GenDelegPair
      -> ListMap Addr Coin
      -> ShelleyGenesisStaking
      -> ShelleyGenesis)
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 Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxKESEvolutions"
        Parser
  (NominalDiffTimeMicro
   -> Word64
   -> Word64
   -> PParams ShelleyEra
   -> Map (KeyHash GenesisRole) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser NominalDiffTimeMicro
-> Parser
     (Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash GenesisRole) GenDelegPair
      -> ListMap Addr Coin
      -> ShelleyGenesisStaking
      -> ShelleyGenesis)
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 NominalDiffTimeMicro
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slotLength"
        Parser
  (Word64
   -> Word64
   -> PParams ShelleyEra
   -> Map (KeyHash GenesisRole) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser Word64
-> Parser
     (Word64
      -> PParams ShelleyEra
      -> Map (KeyHash GenesisRole) GenDelegPair
      -> ListMap Addr Coin
      -> ShelleyGenesisStaking
      -> ShelleyGenesis)
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 Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updateQuorum"
        Parser
  (Word64
   -> PParams ShelleyEra
   -> Map (KeyHash GenesisRole) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser Word64
-> Parser
     (PParams ShelleyEra
      -> Map (KeyHash GenesisRole) GenDelegPair
      -> ListMap Addr Coin
      -> ShelleyGenesisStaking
      -> ShelleyGenesis)
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 Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxLovelaceSupply"
        Parser
  (PParams ShelleyEra
   -> Map (KeyHash GenesisRole) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser (PParams ShelleyEra)
-> Parser
     (Map (KeyHash GenesisRole) GenDelegPair
      -> ListMap Addr Coin -> ShelleyGenesisStaking -> ShelleyGenesis)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (LegacyJSONPParams -> PParams ShelleyEra
legacyFromJSONPParams (LegacyJSONPParams -> PParams ShelleyEra)
-> Parser LegacyJSONPParams -> Parser (PParams ShelleyEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser LegacyJSONPParams
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"protocolParams")
        Parser
  (Map (KeyHash GenesisRole) GenDelegPair
   -> ListMap Addr Coin -> ShelleyGenesisStaking -> ShelleyGenesis)
-> Parser (Map (KeyHash GenesisRole) GenDelegPair)
-> Parser
     (ListMap Addr Coin -> ShelleyGenesisStaking -> ShelleyGenesis)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Map (KeyHash GenesisRole) GenDelegPair
-> Map (KeyHash GenesisRole) GenDelegPair
forall (t :: * -> *) a. Foldable t => t a -> t a
forceElemsToWHNF (Map (KeyHash GenesisRole) GenDelegPair
 -> Map (KeyHash GenesisRole) GenDelegPair)
-> Parser (Map (KeyHash GenesisRole) GenDelegPair)
-> Parser (Map (KeyHash GenesisRole) GenDelegPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Map (KeyHash GenesisRole) GenDelegPair)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"genDelegs")
        Parser
  (ListMap Addr Coin -> ShelleyGenesisStaking -> ShelleyGenesis)
-> Parser (ListMap Addr Coin)
-> Parser (ShelleyGenesisStaking -> ShelleyGenesis)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ListMap Addr Coin -> ListMap Addr Coin
forall (t :: * -> *) a. Foldable t => t a -> t a
forceElemsToWHNF (ListMap Addr Coin -> ListMap Addr Coin)
-> Parser (ListMap Addr Coin) -> Parser (ListMap Addr Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (ListMap Addr Coin)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"initialFunds") -- TODO: disable. Move to EraTransition
        Parser (ShelleyGenesisStaking -> ShelleyGenesis)
-> Parser ShelleyGenesisStaking -> Parser ShelleyGenesis
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 ShelleyGenesisStaking)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"staking" Parser (Maybe ShelleyGenesisStaking)
-> ShelleyGenesisStaking -> Parser ShelleyGenesisStaking
forall a. Parser (Maybe a) -> a -> Parser a
.!= ShelleyGenesisStaking
emptyGenesisStaking -- TODO: remove. Move to EraTransition
    where
      forceUTCTime :: UTCTime -> UTCTime
forceUTCTime UTCTime
date =
        let !day :: Day
day = UTCTime -> Day
utctDay UTCTime
date
            !time :: DiffTime
time = UTCTime -> DiffTime
utctDayTime UTCTime
date
         in Day -> DiffTime -> UTCTime
UTCTime Day
day DiffTime
time

instance ToKeyValuePairs ShelleyGenesisStaking where
  toKeyValuePairs :: forall e kv. KeyValue e kv => ShelleyGenesisStaking -> [kv]
toKeyValuePairs ShelleyGenesisStaking {ListMap (KeyHash StakePool) StakePoolParams
sgsPools :: ShelleyGenesisStaking
-> ListMap (KeyHash StakePool) StakePoolParams
sgsPools :: ListMap (KeyHash StakePool) StakePoolParams
sgsPools, ListMap (KeyHash Staking) (KeyHash StakePool)
sgsStake :: ShelleyGenesisStaking
-> ListMap (KeyHash Staking) (KeyHash StakePool)
sgsStake :: ListMap (KeyHash Staking) (KeyHash StakePool)
sgsStake} =
    [ Key
"pools" Key -> ListMap (KeyHash StakePool) StakePoolParams -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ListMap (KeyHash StakePool) StakePoolParams
sgsPools
    , Key
"stake" Key -> ListMap (KeyHash Staking) (KeyHash StakePool) -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ListMap (KeyHash Staking) (KeyHash StakePool)
sgsStake
    ]

instance FromJSON ShelleyGenesisStaking where
  parseJSON :: Value -> Parser ShelleyGenesisStaking
parseJSON =
    String
-> (Object -> Parser ShelleyGenesisStaking)
-> Value
-> Parser ShelleyGenesisStaking
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ShelleyGenesisStaking" ((Object -> Parser ShelleyGenesisStaking)
 -> Value -> Parser ShelleyGenesisStaking)
-> (Object -> Parser ShelleyGenesisStaking)
-> Value
-> Parser ShelleyGenesisStaking
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      ListMap (KeyHash StakePool) StakePoolParams
-> ListMap (KeyHash Staking) (KeyHash StakePool)
-> ShelleyGenesisStaking
ShelleyGenesisStaking
        (ListMap (KeyHash StakePool) StakePoolParams
 -> ListMap (KeyHash Staking) (KeyHash StakePool)
 -> ShelleyGenesisStaking)
-> Parser (ListMap (KeyHash StakePool) StakePoolParams)
-> Parser
     (ListMap (KeyHash Staking) (KeyHash StakePool)
      -> ShelleyGenesisStaking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ListMap (KeyHash StakePool) StakePoolParams
-> ListMap (KeyHash StakePool) StakePoolParams
forall (t :: * -> *) a. Foldable t => t a -> t a
forceElemsToWHNF (ListMap (KeyHash StakePool) StakePoolParams
 -> ListMap (KeyHash StakePool) StakePoolParams)
-> Parser (ListMap (KeyHash StakePool) StakePoolParams)
-> Parser (ListMap (KeyHash StakePool) StakePoolParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object
-> Key -> Parser (ListMap (KeyHash StakePool) StakePoolParams)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pools")
        Parser
  (ListMap (KeyHash Staking) (KeyHash StakePool)
   -> ShelleyGenesisStaking)
-> Parser (ListMap (KeyHash Staking) (KeyHash StakePool))
-> Parser ShelleyGenesisStaking
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ListMap (KeyHash Staking) (KeyHash StakePool)
-> ListMap (KeyHash Staking) (KeyHash StakePool)
forall (t :: * -> *) a. Foldable t => t a -> t a
forceElemsToWHNF (ListMap (KeyHash Staking) (KeyHash StakePool)
 -> ListMap (KeyHash Staking) (KeyHash StakePool))
-> Parser (ListMap (KeyHash Staking) (KeyHash StakePool))
-> Parser (ListMap (KeyHash Staking) (KeyHash StakePool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object
-> Key -> Parser (ListMap (KeyHash Staking) (KeyHash StakePool))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stake")

-- | Genesis are always encoded with the version of era they are defined in.
instance DecCBOR ShelleyGenesis

instance EncCBOR ShelleyGenesis

instance ToCBOR ShelleyGenesis where
  toCBOR :: ShelleyGenesis -> Encoding
toCBOR
    ShelleyGenesis
      { UTCTime
sgSystemStart :: ShelleyGenesis -> UTCTime
sgSystemStart :: UTCTime
sgSystemStart
      , Word32
sgNetworkMagic :: ShelleyGenesis -> Word32
sgNetworkMagic :: Word32
sgNetworkMagic
      , Network
sgNetworkId :: ShelleyGenesis -> Network
sgNetworkId :: Network
sgNetworkId
      , PositiveUnitInterval
sgActiveSlotsCoeff :: ShelleyGenesis -> PositiveUnitInterval
sgActiveSlotsCoeff :: PositiveUnitInterval
sgActiveSlotsCoeff
      , NonZero Word64
sgSecurityParam :: ShelleyGenesis -> NonZero Word64
sgSecurityParam :: NonZero Word64
sgSecurityParam
      , EpochSize
sgEpochLength :: ShelleyGenesis -> EpochSize
sgEpochLength :: EpochSize
sgEpochLength
      , Word64
sgSlotsPerKESPeriod :: ShelleyGenesis -> Word64
sgSlotsPerKESPeriod :: Word64
sgSlotsPerKESPeriod
      , Word64
sgMaxKESEvolutions :: ShelleyGenesis -> Word64
sgMaxKESEvolutions :: Word64
sgMaxKESEvolutions
      , NominalDiffTimeMicro
sgSlotLength :: ShelleyGenesis -> NominalDiffTimeMicro
sgSlotLength :: NominalDiffTimeMicro
sgSlotLength
      , Word64
sgUpdateQuorum :: ShelleyGenesis -> Word64
sgUpdateQuorum :: Word64
sgUpdateQuorum
      , Word64
sgMaxLovelaceSupply :: ShelleyGenesis -> Word64
sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply
      , PParams ShelleyEra
sgProtocolParams :: ShelleyGenesis -> PParams ShelleyEra
sgProtocolParams :: PParams ShelleyEra
sgProtocolParams
      , Map (KeyHash GenesisRole) GenDelegPair
sgGenDelegs :: ShelleyGenesis -> Map (KeyHash GenesisRole) GenDelegPair
sgGenDelegs :: Map (KeyHash GenesisRole) GenDelegPair
sgGenDelegs
      , ListMap Addr Coin
sgInitialFunds :: ShelleyGenesis -> ListMap Addr Coin
sgInitialFunds :: ListMap Addr Coin
sgInitialFunds
      , ShelleyGenesisStaking
sgStaking :: ShelleyGenesis -> ShelleyGenesisStaking
sgStaking :: ShelleyGenesisStaking
sgStaking
      } =
      Version -> Encoding -> Encoding
toPlainEncoding Version
shelleyProtVer (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$
        Word -> Encoding
encodeListLen Word
15
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> UTCTime -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR UTCTime
sgSystemStart
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Word32
sgNetworkMagic
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Network -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Network
sgNetworkId
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PositiveUnitInterval -> Encoding
activeSlotsCoeffEncCBOR PositiveUnitInterval
sgActiveSlotsCoeff
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NonZero Word64 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR NonZero Word64
sgSecurityParam
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (EpochSize -> Word64
unEpochSize EpochSize
sgEpochLength)
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Word64
sgSlotsPerKESPeriod
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Word64
sgMaxKESEvolutions
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NominalDiffTimeMicro -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR NominalDiffTimeMicro
sgSlotLength
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Word64
sgUpdateQuorum
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Word64
sgMaxLovelaceSupply
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PParams ShelleyEra -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR PParams ShelleyEra
sgProtocolParams
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash GenesisRole) GenDelegPair -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (KeyHash GenesisRole) GenDelegPair
sgGenDelegs
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ListMap Addr Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ListMap Addr Coin
sgInitialFunds
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ShelleyGenesisStaking -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ShelleyGenesisStaking
sgStaking

instance FromCBOR ShelleyGenesis where
  fromCBOR :: forall s. Decoder s ShelleyGenesis
fromCBOR = Maybe ByteString
-> Version -> Decoder s ShelleyGenesis -> Decoder s ShelleyGenesis
forall s a.
Maybe ByteString -> Version -> Decoder s a -> Decoder s a
toPlainDecoder Maybe ByteString
forall a. Maybe a
Nothing Version
shelleyProtVer (Decoder s ShelleyGenesis -> Decoder s ShelleyGenesis)
-> Decoder s ShelleyGenesis -> Decoder s ShelleyGenesis
forall a b. (a -> b) -> a -> b
$ do
    Text
-> (ShelleyGenesis -> Int)
-> Decoder s ShelleyGenesis
-> Decoder s ShelleyGenesis
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"ShelleyGenesis" (Int -> ShelleyGenesis -> Int
forall a b. a -> b -> a
const Int
15) (Decoder s ShelleyGenesis -> Decoder s ShelleyGenesis)
-> Decoder s ShelleyGenesis -> Decoder s ShelleyGenesis
forall a b. (a -> b) -> a -> b
$ do
      sgSystemStart <- Decoder s UTCTime
forall s. Decoder s UTCTime
forall a s. DecCBOR a => Decoder s a
decCBOR
      sgNetworkMagic <- decCBOR
      sgNetworkId <- decCBOR
      sgActiveSlotsCoeff <- activeSlotsCoeffDecCBOR
      sgSecurityParam <- decCBOR
      sgEpochLength <- decCBOR
      sgSlotsPerKESPeriod <- decCBOR
      sgMaxKESEvolutions <- decCBOR
      sgSlotLength <- decCBOR
      sgUpdateQuorum <- decCBOR
      sgMaxLovelaceSupply <- decCBOR
      sgProtocolParams <- decCBOR
      sgGenDelegs <- decCBOR
      sgInitialFunds <- decCBOR
      sgStaking <- decCBOR
      pure $
        ShelleyGenesis
          sgSystemStart
          sgNetworkMagic
          sgNetworkId
          sgActiveSlotsCoeff
          sgSecurityParam
          (EpochSize sgEpochLength)
          sgSlotsPerKESPeriod
          sgMaxKESEvolutions
          sgSlotLength
          sgUpdateQuorum
          sgMaxLovelaceSupply
          sgProtocolParams
          sgGenDelegs
          sgInitialFunds
          sgStaking

-- | Serialize `PositiveUnitInterval` type in the same way `Rational` is serialized,
-- however ensure there is no usage of tag 30 by enforcing Shelley protocol version.
activeSlotsCoeffEncCBOR :: PositiveUnitInterval -> Encoding
activeSlotsCoeffEncCBOR :: PositiveUnitInterval -> Encoding
activeSlotsCoeffEncCBOR = Version -> Encoding -> Encoding
enforceEncodingVersion Version
shelleyProtVer (Encoding -> Encoding)
-> (PositiveUnitInterval -> Encoding)
-> PositiveUnitInterval
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Rational -> Encoding)
-> (PositiveUnitInterval -> Rational)
-> PositiveUnitInterval
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositiveUnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational

-- | Deserialize `PositiveUnitInterval` type using `Rational` deserialization and fail
-- when bounds are violated. Also, ensure there is no usage of tag 30 by enforcing Shelley
-- protocol version.
activeSlotsCoeffDecCBOR :: Decoder s PositiveUnitInterval
activeSlotsCoeffDecCBOR :: forall s. Decoder s PositiveUnitInterval
activeSlotsCoeffDecCBOR = do
  r <- Version -> Decoder s Rational -> Decoder s Rational
forall s a. Version -> Decoder s a -> Decoder s a
enforceDecoderVersion Version
shelleyProtVer (Decoder s Rational -> Decoder s Rational)
-> Decoder s Rational -> Decoder s Rational
forall a b. (a -> b) -> a -> b
$ Decoder s Rational
forall s. Decoder s Rational
decodeRational
  case boundRational r of
    Maybe PositiveUnitInterval
Nothing ->
      DecoderError -> Decoder s PositiveUnitInterval
forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError (DecoderError -> Decoder s PositiveUnitInterval)
-> DecoderError -> Decoder s PositiveUnitInterval
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"ActiveSlotsCoeff (PositiveUnitInterval)" (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Rational -> String
forall a. Show a => a -> String
show Rational
r)
    Just PositiveUnitInterval
u -> PositiveUnitInterval -> Decoder s PositiveUnitInterval
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PositiveUnitInterval
u

{-------------------------------------------------------------------------------
  Genesis UTxO
-------------------------------------------------------------------------------}

genesisUTxO ::
  forall era.
  EraTxOut era =>
  ShelleyGenesis ->
  UTxO era
genesisUTxO :: forall era. EraTxOut era => ShelleyGenesis -> UTxO era
genesisUTxO ShelleyGenesis
genesis =
  Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut era) -> UTxO era)
-> Map TxIn (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$
    [(TxIn, TxOut era)] -> Map TxIn (TxOut era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (TxIn
txIn, TxOut era
txOut)
      | (Addr
addr, Coin
amount) <- ListMap Addr Coin -> [(Addr, Coin)]
forall k v. ListMap k v -> [(k, v)]
LM.unListMap (ShelleyGenesis -> ListMap Addr Coin
sgInitialFunds ShelleyGenesis
genesis)
      , let txIn :: TxIn
txIn = Addr -> TxIn
initialFundsPseudoTxIn Addr
addr
            txOut :: TxOut era
txOut = Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
addr (Coin -> Value era
forall t s. Inject t s => t -> s
Val.inject Coin
amount)
      ]

-- | Compute the 'TxIn' of the initial UTxO pseudo-transaction corresponding
-- to the given address in the genesis initial funds.
--
-- The Shelley initial UTxO is constructed from the 'sgInitialFunds' which
-- is not a full UTxO but just a map from addresses to coin values.
--
-- This gets turned into a UTxO by making a pseudo-transaction for each address,
-- with the 0th output being the coin value. So to spend from the initial UTxO
-- we need this same 'TxIn' to use as an input to the spending transaction.
initialFundsPseudoTxIn :: Addr -> TxIn
initialFundsPseudoTxIn :: Addr -> TxIn
initialFundsPseudoTxIn Addr
addr =
  TxId -> TxIx -> TxIn
TxIn (Addr -> TxId
pseudoTxId Addr
addr) TxIx
forall a. Bounded a => a
minBound
  where
    pseudoTxId :: Addr -> TxId
pseudoTxId =
      SafeHash EraIndependentTxBody -> TxId
TxId
        (SafeHash EraIndependentTxBody -> TxId)
-> (Addr -> SafeHash EraIndependentTxBody) -> Addr -> TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_256 EraIndependentTxBody
-> SafeHash EraIndependentTxBody
forall i. Hash Blake2b_256 i -> SafeHash i
unsafeMakeSafeHash
        (Hash Blake2b_256 EraIndependentTxBody
 -> SafeHash EraIndependentTxBody)
-> (Addr -> Hash Blake2b_256 EraIndependentTxBody)
-> Addr
-> SafeHash EraIndependentTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( Hash Blake2b_256 Addr -> Hash Blake2b_256 EraIndependentTxBody
forall h a b. Hash h a -> Hash h b
H.castHash ::
              H.Hash HASH Addr ->
              H.Hash HASH EraIndependentTxBody
          )
        (Hash Blake2b_256 Addr -> Hash Blake2b_256 EraIndependentTxBody)
-> (Addr -> Hash Blake2b_256 Addr)
-> Addr
-> Hash Blake2b_256 EraIndependentTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Addr -> ByteString) -> Addr -> Hash Blake2b_256 Addr
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
H.hashWith Addr -> ByteString
serialiseAddr

{-------------------------------------------------------------------------------
  Genesis validation
-------------------------------------------------------------------------------}

data ValidationErr
  = EpochNotLongEnough EpochSize Word64 Rational EpochSize
  | MaxKESEvolutionsUnsupported Word64 Word
  | QuorumTooSmall Word64 Word64 Word64
  deriving (ValidationErr -> ValidationErr -> Bool
(ValidationErr -> ValidationErr -> Bool)
-> (ValidationErr -> ValidationErr -> Bool) -> Eq ValidationErr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidationErr -> ValidationErr -> Bool
== :: ValidationErr -> ValidationErr -> Bool
$c/= :: ValidationErr -> ValidationErr -> Bool
/= :: ValidationErr -> ValidationErr -> Bool
Eq, Int -> ValidationErr -> ShowS
[ValidationErr] -> ShowS
ValidationErr -> String
(Int -> ValidationErr -> ShowS)
-> (ValidationErr -> String)
-> ([ValidationErr] -> ShowS)
-> Show ValidationErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidationErr -> ShowS
showsPrec :: Int -> ValidationErr -> ShowS
$cshow :: ValidationErr -> String
show :: ValidationErr -> String
$cshowList :: [ValidationErr] -> ShowS
showList :: [ValidationErr] -> ShowS
Show)

describeValidationErr :: ValidationErr -> Text
describeValidationErr :: ValidationErr -> Text
describeValidationErr (EpochNotLongEnough EpochSize
es Word64
secParam Rational
asc EpochSize
minEpochSize) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
"Epoch length is too low. Your epoch length of "
    , String -> Text
Text.pack (EpochSize -> String
forall a. Show a => a -> String
show EpochSize
es)
    , Text
" does not meet the minimum epoch length of "
    , String -> Text
Text.pack (EpochSize -> String
forall a. Show a => a -> String
show EpochSize
minEpochSize)
    , Text
" required by your choice of parameters for k and f: "
    , String -> Text
Text.pack (Word64 -> String
forall a. Show a => a -> String
show Word64
secParam)
    , Text
" and "
    , String -> Text
Text.pack (Rational -> String
forall a. Show a => a -> String
show Rational
asc)
    , Text
". Epochs should be at least 10k/f slots long."
    ]
describeValidationErr (MaxKESEvolutionsUnsupported Word64
reqKES Word
supportedKES) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
"You have specified a 'maxKESEvolutions' higher"
    , Text
" than that supported by the underlying algorithm."
    , Text
" You requested "
    , String -> Text
Text.pack (Word64 -> String
forall a. Show a => a -> String
show Word64
reqKES)
    , Text
" but the algorithm supports a maximum of "
    , String -> Text
Text.pack (Word -> String
forall a. Show a => a -> String
show Word
supportedKES)
    ]
describeValidationErr (QuorumTooSmall Word64
q Word64
maxTooSmal Word64
nodes) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
"You have specified an 'updateQuorum' which is"
    , Text
" too small compared to the number of genesis nodes."
    , Text
" You requested "
    , String -> Text
Text.pack (Word64 -> String
forall a. Show a => a -> String
show Word64
q)
    , Text
", but given "
    , String -> Text
Text.pack (Word64 -> String
forall a. Show a => a -> String
show Word64
nodes)
    , Text
" genesis nodes 'updateQuorum' must be greater than "
    , String -> Text
Text.pack (Word64 -> String
forall a. Show a => a -> String
show Word64
maxTooSmal)
    ]

-- | Do some basic sanity checking on the Shelley genesis file.
validateGenesis :: ShelleyGenesis -> Either [ValidationErr] ()
validateGenesis :: ShelleyGenesis -> Either [ValidationErr] ()
validateGenesis
  ShelleyGenesis
    { EpochSize
sgEpochLength :: ShelleyGenesis -> EpochSize
sgEpochLength :: EpochSize
sgEpochLength
    , PositiveUnitInterval
sgActiveSlotsCoeff :: ShelleyGenesis -> PositiveUnitInterval
sgActiveSlotsCoeff :: PositiveUnitInterval
sgActiveSlotsCoeff
    , Word64
sgMaxKESEvolutions :: ShelleyGenesis -> Word64
sgMaxKESEvolutions :: Word64
sgMaxKESEvolutions
    , NonZero Word64
sgSecurityParam :: ShelleyGenesis -> NonZero Word64
sgSecurityParam :: NonZero Word64
sgSecurityParam
    , Word64
sgUpdateQuorum :: ShelleyGenesis -> Word64
sgUpdateQuorum :: Word64
sgUpdateQuorum
    , Map (KeyHash GenesisRole) GenDelegPair
sgGenDelegs :: ShelleyGenesis -> Map (KeyHash GenesisRole) GenDelegPair
sgGenDelegs :: Map (KeyHash GenesisRole) GenDelegPair
sgGenDelegs
    } =
    case [Maybe ValidationErr] -> [ValidationErr]
forall a. [Maybe a] -> [a]
catMaybes [Maybe ValidationErr]
errors of
      [] -> () -> Either [ValidationErr] ()
forall a b. b -> Either a b
Right ()
      [ValidationErr]
xs -> [ValidationErr] -> Either [ValidationErr] ()
forall a b. a -> Either a b
Left [ValidationErr]
xs
    where
      errors :: [Maybe ValidationErr]
errors =
        [ Maybe ValidationErr
checkEpochLength
        , Maybe ValidationErr
checkKesEvolutions
        , Maybe ValidationErr
checkQuorumSize
        ]
      checkEpochLength :: Maybe ValidationErr
checkEpochLength =
        let activeSlotsCoeff :: Rational
activeSlotsCoeff = PositiveUnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational PositiveUnitInterval
sgActiveSlotsCoeff
            minLength :: EpochSize
minLength =
              Word64 -> EpochSize
EpochSize (Word64 -> EpochSize) -> (Double -> Word64) -> Double -> EpochSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> EpochSize) -> Double -> EpochSize
forall a b. (a -> b) -> a -> b
$
                forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Double (Word64
3 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero Word64
sgSecurityParam)
                  Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
activeSlotsCoeff
         in if EpochSize
minLength EpochSize -> EpochSize -> Bool
forall a. Ord a => a -> a -> Bool
> EpochSize
sgEpochLength
              then
                ValidationErr -> Maybe ValidationErr
forall a. a -> Maybe a
Just (ValidationErr -> Maybe ValidationErr)
-> ValidationErr -> Maybe ValidationErr
forall a b. (a -> b) -> a -> b
$
                  EpochSize -> Word64 -> Rational -> EpochSize -> ValidationErr
EpochNotLongEnough
                    EpochSize
sgEpochLength
                    (NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero Word64
sgSecurityParam)
                    Rational
activeSlotsCoeff
                    EpochSize
minLength
              else Maybe ValidationErr
forall a. Maybe a
Nothing
      kesPeriods :: Word
kesPeriods = Proxy (Sum6KES Ed25519DSIGN Blake2b_256) -> Word
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
forall (proxy :: * -> *).
proxy (Sum6KES Ed25519DSIGN Blake2b_256) -> Word
totalPeriodsKES (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Sum6KES Ed25519DSIGN Blake2b_256))
      checkKesEvolutions :: Maybe ValidationErr
checkKesEvolutions =
        if Word64
sgMaxKESEvolutions Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
kesPeriods
          then Maybe ValidationErr
forall a. Maybe a
Nothing
          else ValidationErr -> Maybe ValidationErr
forall a. a -> Maybe a
Just (ValidationErr -> Maybe ValidationErr)
-> ValidationErr -> Maybe ValidationErr
forall a b. (a -> b) -> a -> b
$ Word64 -> Word -> ValidationErr
MaxKESEvolutionsUnsupported Word64
sgMaxKESEvolutions Word
kesPeriods
      checkQuorumSize :: Maybe ValidationErr
checkQuorumSize =
        let numGenesisNodes :: Word64
numGenesisNodes = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Map (KeyHash GenesisRole) GenDelegPair -> Int
forall a. Map (KeyHash GenesisRole) a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map (KeyHash GenesisRole) GenDelegPair
sgGenDelegs
            maxTooSmal :: Word64
maxTooSmal = Word64
numGenesisNodes Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
2
         in if Word64
numGenesisNodes Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
|| Word64
sgUpdateQuorum Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
maxTooSmal
              then Maybe ValidationErr
forall a. Maybe a
Nothing
              else ValidationErr -> Maybe ValidationErr
forall a. a -> Maybe a
Just (ValidationErr -> Maybe ValidationErr)
-> ValidationErr -> Maybe ValidationErr
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> ValidationErr
QuorumTooSmall Word64
sgUpdateQuorum Word64
maxTooSmal Word64
numGenesisNodes

{-------------------------------------------------------------------------------
  Construct 'Globals' using 'ShelleyGenesis'
-------------------------------------------------------------------------------}

mkShelleyGlobals :: ShelleyGenesis -> EpochInfo (Either Text) -> Globals
mkShelleyGlobals :: ShelleyGenesis -> EpochInfo (Either Text) -> Globals
mkShelleyGlobals ShelleyGenesis
genesis EpochInfo (Either Text)
epochInfoAc =
  Globals
    { activeSlotCoeff :: ActiveSlotCoeff
activeSlotCoeff = ShelleyGenesis -> ActiveSlotCoeff
sgActiveSlotCoeff ShelleyGenesis
genesis
    , epochInfo :: EpochInfo (Either Text)
epochInfo = EpochInfo (Either Text)
epochInfoAc
    , maxKESEvo :: Word64
maxKESEvo = ShelleyGenesis -> Word64
sgMaxKESEvolutions ShelleyGenesis
genesis
    , maxLovelaceSupply :: Word64
maxLovelaceSupply = ShelleyGenesis -> Word64
sgMaxLovelaceSupply ShelleyGenesis
genesis
    , networkId :: Network
networkId = ShelleyGenesis -> Network
sgNetworkId ShelleyGenesis
genesis
    , quorum :: Word64
quorum = ShelleyGenesis -> Word64
sgUpdateQuorum ShelleyGenesis
genesis
    , Word64
randomnessStabilisationWindow :: Word64
randomnessStabilisationWindow :: Word64
randomnessStabilisationWindow
    , securityParameter :: NonZero Word64
securityParameter = NonZero Word64
k
    , slotsPerKESPeriod :: Word64
slotsPerKESPeriod = ShelleyGenesis -> Word64
sgSlotsPerKESPeriod ShelleyGenesis
genesis
    , Word64
stabilityWindow :: Word64
stabilityWindow :: Word64
stabilityWindow
    , SystemStart
systemStart :: SystemStart
systemStart :: SystemStart
systemStart
    }
  where
    systemStart :: SystemStart
systemStart = UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis -> UTCTime
sgSystemStart ShelleyGenesis
genesis
    k :: NonZero Word64
k = ShelleyGenesis -> NonZero Word64
sgSecurityParam ShelleyGenesis
genesis
    stabilityWindow :: Word64
stabilityWindow =
      Word64 -> ActiveSlotCoeff -> Word64
computeStabilityWindow (NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero Word64
k) (ShelleyGenesis -> ActiveSlotCoeff
sgActiveSlotCoeff ShelleyGenesis
genesis)
    randomnessStabilisationWindow :: Word64
randomnessStabilisationWindow =
      Word64 -> ActiveSlotCoeff -> Word64
computeRandomnessStabilisationWindow (NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero Word64
k) (ShelleyGenesis -> ActiveSlotCoeff
sgActiveSlotCoeff ShelleyGenesis
genesis)