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

module Cardano.Ledger.Shelley.Genesis (
  ShelleyGenesisStaking (..),
  ShelleyGenesis (..),
  toShelleyGenesisPairs,
  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 (..),
  Network,
  NonZero (..),
  Nonce (..),
  PositiveUnitInterval,
  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 (EraGenesis (..))
import Cardano.Ledger.Hashes (unsafeMakeSafeHash)
import Cardano.Ledger.Keys
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.PParams (ShelleyPParams (..))
import Cardano.Ledger.Shelley.StabilityWindow
import Cardano.Ledger.State (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.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) PoolParams
sgsPools :: LM.ListMap (KeyHash 'StakePool) PoolParams
  -- ^ 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)

instance NoThunks ShelleyGenesisStaking

instance Semigroup ShelleyGenesisStaking where
  <> :: ShelleyGenesisStaking
-> ShelleyGenesisStaking -> ShelleyGenesisStaking
(<>) (ShelleyGenesisStaking ListMap (KeyHash 'StakePool) PoolParams
p1 ListMap (KeyHash 'Staking) (KeyHash 'StakePool)
s1) (ShelleyGenesisStaking ListMap (KeyHash 'StakePool) PoolParams
p2 ListMap (KeyHash 'Staking) (KeyHash 'StakePool)
s2) =
    ListMap (KeyHash 'StakePool) PoolParams
-> ListMap (KeyHash 'Staking) (KeyHash 'StakePool)
-> ShelleyGenesisStaking
ShelleyGenesisStaking (ListMap (KeyHash 'StakePool) PoolParams
p1 ListMap (KeyHash 'StakePool) PoolParams
-> ListMap (KeyHash 'StakePool) PoolParams
-> ListMap (KeyHash 'StakePool) PoolParams
forall a. Semigroup a => a -> a -> a
<> ListMap (KeyHash 'StakePool) PoolParams
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) PoolParams
-> ListMap (KeyHash 'Staking) (KeyHash 'StakePool)
-> ShelleyGenesisStaking
ShelleyGenesisStaking ListMap (KeyHash 'StakePool) PoolParams
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) PoolParams
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) PoolParams -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ListMap (KeyHash 'StakePool) PoolParams
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
      ListMap (KeyHash 'StakePool) PoolParams
pools <- Decoder s (ListMap (KeyHash 'StakePool) PoolParams)
forall s. Decoder s (ListMap (KeyHash 'StakePool) PoolParams)
forall a s. DecCBOR a => Decoder s a
decCBOR
      ListMap (KeyHash 'Staking) (KeyHash 'StakePool)
stake <- Decoder s (ListMap (KeyHash 'Staking) (KeyHash 'StakePool))
forall s.
Decoder s (ListMap (KeyHash 'Staking) (KeyHash 'StakePool))
forall a s. DecCBOR a => Decoder s a
decCBOR
      ShelleyGenesisStaking -> Decoder s ShelleyGenesisStaking
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyGenesisStaking -> Decoder s ShelleyGenesisStaking)
-> ShelleyGenesisStaking -> Decoder s ShelleyGenesisStaking
forall a b. (a -> b) -> a -> b
$ ListMap (KeyHash 'StakePool) PoolParams
-> ListMap (KeyHash 'Staking) (KeyHash 'StakePool)
-> ShelleyGenesisStaking
ShelleyGenesisStaking ListMap (KeyHash 'StakePool) PoolParams
pools ListMap (KeyHash 'Staking) (KeyHash 'StakePool)
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, Typeable NominalDiffTimeMicro
Typeable NominalDiffTimeMicro =>
(NominalDiffTimeMicro -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy NominalDiffTimeMicro -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [NominalDiffTimeMicro] -> Size)
-> EncCBOR NominalDiffTimeMicro
NominalDiffTimeMicro -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [NominalDiffTimeMicro] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy NominalDiffTimeMicro -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
$cencCBOR :: NominalDiffTimeMicro -> Encoding
encCBOR :: NominalDiffTimeMicro -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy NominalDiffTimeMicro -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy NominalDiffTimeMicro -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [NominalDiffTimeMicro] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [NominalDiffTimeMicro] -> Size
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)

-- | 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 'Genesis) GenDelegPair
sgGenDelegs :: !(Map (KeyHash 'Genesis) 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)

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 ToJSON ShelleyGenesis where
  toJSON :: ShelleyGenesis -> Value
toJSON = [Pair] -> Value
Aeson.object ([Pair] -> Value)
-> (ShelleyGenesis -> [Pair]) -> ShelleyGenesis -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyGenesis -> [Pair]
forall e a. KeyValue e a => ShelleyGenesis -> [a]
toShelleyGenesisPairs
  toEncoding :: ShelleyGenesis -> Encoding
toEncoding = Series -> Encoding
Aeson.pairs (Series -> Encoding)
-> (ShelleyGenesis -> Series) -> ShelleyGenesis -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (ShelleyGenesis -> [Series]) -> ShelleyGenesis -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyGenesis -> [Series]
forall e a. KeyValue e a => ShelleyGenesis -> [a]
toShelleyGenesisPairs

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
<$> ( HKD Identity Coin
-> HKD Identity Coin
-> HKD Identity Word32
-> HKD Identity Word32
-> HKD Identity Word16
-> HKD Identity Coin
-> HKD Identity 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 Coin
-> HKD Identity Coin
-> ShelleyPParams Identity ShelleyEra
Coin
-> Coin
-> Word32
-> Word32
-> Word16
-> Coin
-> Coin
-> EpochInterval
-> Word16
-> NonNegativeInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> Nonce
-> ProtVer
-> Coin
-> Coin
-> ShelleyPParams Identity ShelleyEra
forall (f :: * -> *) era.
HKD f Coin
-> HKD f Coin
-> HKD f Word32
-> HKD f Word32
-> HKD f Word16
-> HKD f Coin
-> HKD f 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 Coin
-> HKD f Coin
-> ShelleyPParams f era
ShelleyPParams
                (Coin
 -> Coin
 -> Word32
 -> Word32
 -> Word16
 -> Coin
 -> Coin
 -> EpochInterval
 -> Word16
 -> NonNegativeInterval
 -> UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> Nonce
 -> ProtVer
 -> Coin
 -> Coin
 -> ShelleyPParams Identity ShelleyEra)
-> Parser Coin
-> Parser
     (Coin
      -> Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> Coin
      -> ShelleyPParams Identity ShelleyEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minFeeA"
                Parser
  (Coin
   -> Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser Coin
-> Parser
     (Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> 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 Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minFeeB"
                Parser
  (Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser Word32
-> Parser
     (Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> 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
   -> Coin
   -> Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser Word32
-> Parser
     (Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> 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
   -> Coin
   -> Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser Word16
-> Parser
     (Coin
      -> Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> 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
  (Coin
   -> Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser Coin
-> Parser
     (Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> 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 Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"keyDeposit"
                Parser
  (Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser Coin
-> Parser
     (EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> 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 Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"poolDeposit"
                Parser
  (EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser EpochInterval
-> Parser
     (Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> 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
   -> Coin
   -> Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser Word16
-> Parser
     (NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> 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
   -> Coin
   -> Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser NonNegativeInterval
-> Parser
     (UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> 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
   -> Coin
   -> Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser UnitInterval
-> Parser
     (UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> 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
   -> Coin
   -> Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser UnitInterval
-> Parser
     (UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> 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
   -> Coin
   -> Coin
   -> ShelleyPParams Identity ShelleyEra)
-> Parser UnitInterval
-> Parser
     (Nonce
      -> ProtVer -> Coin -> 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 -> Coin -> Coin -> ShelleyPParams Identity ShelleyEra)
-> Parser Nonce
-> Parser
     (ProtVer -> Coin -> 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 -> Coin -> Coin -> ShelleyPParams Identity ShelleyEra)
-> Parser ProtVer
-> Parser (Coin -> 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 (Coin -> Coin -> ShelleyPParams Identity ShelleyEra)
-> Parser Coin
-> Parser (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 Coin)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"minUTxOValue" Parser (Maybe Coin) -> Coin -> Parser Coin
forall a. Parser (Maybe a) -> a -> Parser a
.!= Coin
forall a. Monoid a => a
mempty
                Parser (Coin -> ShelleyPParams Identity ShelleyEra)
-> Parser 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 Coin)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"minPoolCost" Parser (Maybe Coin) -> Coin -> Parser Coin
forall a. Parser (Maybe a) -> a -> Parser a
.!= 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
              Text
tag <- (Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tag" :: Parser Text)
              case Text
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 Coin
sppMinFeeA :: HKD Identity Coin
sppMinFeeA :: forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppMinFeeA
            , HKD Identity Coin
sppMinFeeB :: HKD Identity Coin
sppMinFeeB :: forall (f :: * -> *) era. ShelleyPParams f era -> HKD f 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 Coin
sppKeyDeposit :: HKD Identity Coin
sppKeyDeposit :: forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppKeyDeposit
            , HKD Identity Coin
sppPoolDeposit :: HKD Identity Coin
sppPoolDeposit :: forall (f :: * -> *) era. ShelleyPParams f era -> HKD f 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 Coin
sppMinUTxOValue :: HKD Identity Coin
sppMinUTxOValue :: forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppMinUTxOValue
            , HKD Identity Coin
sppMinPoolCost :: HKD Identity Coin
sppMinPoolCost :: forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppMinPoolCost
            }
          )
      ) =
      [Pair] -> Value
Aeson.object
        [ Key
"minFeeA" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HKD Identity Coin
Coin
sppMinFeeA
        , Key
"minFeeB" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HKD Identity Coin
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 -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HKD Identity Coin
Coin
sppKeyDeposit
        , Key
"poolDeposit" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HKD Identity Coin
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 -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HKD Identity Coin
Coin
sppMinUTxOValue
        , Key
"minPoolCost" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HKD Identity Coin
Coin
sppMinPoolCost
        ]

toShelleyGenesisPairs :: Aeson.KeyValue e a => ShelleyGenesis -> [a]
toShelleyGenesisPairs :: forall e a. KeyValue e a => ShelleyGenesis -> [a]
toShelleyGenesisPairs
  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 'Genesis) GenDelegPair
sgGenDelegs :: ShelleyGenesis -> Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs :: Map (KeyHash 'Genesis) 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 -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTCTime
sgSystemStart
        , Key
"networkMagic" Key -> Word32 -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
sgNetworkMagic
        , Key
"networkId" Key -> Network -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Network
sgNetworkId
        , Key
"activeSlotsCoeff" Key -> PositiveUnitInterval -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PositiveUnitInterval
sgActiveSlotsCoeff
        , Key
"securityParam" Key -> NonZero Word64 -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonZero Word64
sgSecurityParam
        , Key
"epochLength" Key -> EpochSize -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EpochSize
sgEpochLength
        , Key
"slotsPerKESPeriod" Key -> Word64 -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
sgSlotsPerKESPeriod
        , Key
"maxKESEvolutions" Key -> Word64 -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
sgMaxKESEvolutions
        , Key
"slotLength" Key -> NominalDiffTimeMicro -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NominalDiffTimeMicro
sgSlotLength
        , Key
"updateQuorum" Key -> Word64 -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
sgUpdateQuorum
        , Key
"maxLovelaceSupply" Key -> Word64 -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
sgMaxLovelaceSupply
        , Key
"protocolParams" Key -> LegacyJSONPParams -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PParams ShelleyEra -> LegacyJSONPParams
legacyToJSONPParams PParams ShelleyEra
sgProtocolParams
        , Key
"genDelegs" Key -> Map (KeyHash 'Genesis) GenDelegPair -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs
        , Key
"initialFunds" Key -> ListMap Addr Coin -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ListMap Addr Coin
strictSgInitialFunds
        , Key
"staking" Key -> ShelleyGenesisStaking -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesisStaking
strictSgStaking
        ]

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 'Genesis) GenDelegPair
-> ListMap Addr Coin
-> ShelleyGenesisStaking
-> ShelleyGenesis
ShelleyGenesis
        (UTCTime
 -> Word32
 -> Network
 -> PositiveUnitInterval
 -> NonZero Word64
 -> EpochSize
 -> Word64
 -> Word64
 -> NominalDiffTimeMicro
 -> Word64
 -> Word64
 -> PParams ShelleyEra
 -> Map (KeyHash 'Genesis) GenDelegPair
 -> ListMap Addr Coin
 -> ShelleyGenesisStaking
 -> ShelleyGenesis)
-> Parser UTCTime
-> Parser
     (Word32
      -> Network
      -> PositiveUnitInterval
      -> NonZero Word64
      -> EpochSize
      -> Word64
      -> Word64
      -> NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser Word32
-> Parser
     (Network
      -> PositiveUnitInterval
      -> NonZero Word64
      -> EpochSize
      -> Word64
      -> Word64
      -> NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser Network
-> Parser
     (PositiveUnitInterval
      -> NonZero Word64
      -> EpochSize
      -> Word64
      -> Word64
      -> NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser PositiveUnitInterval
-> Parser
     (NonZero Word64
      -> EpochSize
      -> Word64
      -> Word64
      -> NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser (NonZero Word64)
-> Parser
     (EpochSize
      -> Word64
      -> Word64
      -> NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser EpochSize
-> Parser
     (Word64
      -> Word64
      -> NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser Word64
-> Parser
     (Word64
      -> NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser Word64
-> Parser
     (NominalDiffTimeMicro
      -> Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser NominalDiffTimeMicro
-> Parser
     (Word64
      -> Word64
      -> PParams ShelleyEra
      -> Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser Word64
-> Parser
     (Word64
      -> PParams ShelleyEra
      -> Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser Word64
-> Parser
     (PParams ShelleyEra
      -> Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair
   -> ListMap Addr Coin
   -> ShelleyGenesisStaking
   -> ShelleyGenesis)
-> Parser (PParams ShelleyEra)
-> Parser
     (Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair
   -> ListMap Addr Coin -> ShelleyGenesisStaking -> ShelleyGenesis)
-> Parser (Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair
-> Map (KeyHash 'Genesis) GenDelegPair
forall (t :: * -> *) a. Foldable t => t a -> t a
forceElemsToWHNF (Map (KeyHash 'Genesis) GenDelegPair
 -> Map (KeyHash 'Genesis) GenDelegPair)
-> Parser (Map (KeyHash 'Genesis) GenDelegPair)
-> Parser (Map (KeyHash 'Genesis) GenDelegPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Map (KeyHash 'Genesis) 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 ToJSON ShelleyGenesisStaking where
  toJSON :: ShelleyGenesisStaking -> Value
toJSON = [Pair] -> Value
Aeson.object ([Pair] -> Value)
-> (ShelleyGenesisStaking -> [Pair])
-> ShelleyGenesisStaking
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyGenesisStaking -> [Pair]
forall e a. KeyValue e a => ShelleyGenesisStaking -> [a]
toShelleyGenesisStakingPairs
  toEncoding :: ShelleyGenesisStaking -> Encoding
toEncoding = Series -> Encoding
Aeson.pairs (Series -> Encoding)
-> (ShelleyGenesisStaking -> Series)
-> ShelleyGenesisStaking
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (ShelleyGenesisStaking -> [Series])
-> ShelleyGenesisStaking
-> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyGenesisStaking -> [Series]
forall e a. KeyValue e a => ShelleyGenesisStaking -> [a]
toShelleyGenesisStakingPairs

toShelleyGenesisStakingPairs ::
  Aeson.KeyValue e a =>
  ShelleyGenesisStaking ->
  [a]
toShelleyGenesisStakingPairs :: forall e a. KeyValue e a => ShelleyGenesisStaking -> [a]
toShelleyGenesisStakingPairs ShelleyGenesisStaking {ListMap (KeyHash 'StakePool) PoolParams
sgsPools :: ShelleyGenesisStaking -> ListMap (KeyHash 'StakePool) PoolParams
sgsPools :: ListMap (KeyHash 'StakePool) PoolParams
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) PoolParams -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ListMap (KeyHash 'StakePool) PoolParams
sgsPools
  , Key
"stake" Key -> ListMap (KeyHash 'Staking) (KeyHash 'StakePool) -> a
forall v. ToJSON v => Key -> v -> a
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) PoolParams
-> ListMap (KeyHash 'Staking) (KeyHash 'StakePool)
-> ShelleyGenesisStaking
ShelleyGenesisStaking
        (ListMap (KeyHash 'StakePool) PoolParams
 -> ListMap (KeyHash 'Staking) (KeyHash 'StakePool)
 -> ShelleyGenesisStaking)
-> Parser (ListMap (KeyHash 'StakePool) PoolParams)
-> Parser
     (ListMap (KeyHash 'Staking) (KeyHash 'StakePool)
      -> ShelleyGenesisStaking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ListMap (KeyHash 'StakePool) PoolParams
-> ListMap (KeyHash 'StakePool) PoolParams
forall (t :: * -> *) a. Foldable t => t a -> t a
forceElemsToWHNF (ListMap (KeyHash 'StakePool) PoolParams
 -> ListMap (KeyHash 'StakePool) PoolParams)
-> Parser (ListMap (KeyHash 'StakePool) PoolParams)
-> Parser (ListMap (KeyHash 'StakePool) PoolParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (ListMap (KeyHash 'StakePool) PoolParams)
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 'Genesis) GenDelegPair
sgGenDelegs :: ShelleyGenesis -> Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs :: Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (KeyHash 'Genesis) 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
      UTCTime
sgSystemStart <- Decoder s UTCTime
forall s. Decoder s UTCTime
forall a s. DecCBOR a => Decoder s a
decCBOR
      Word32
sgNetworkMagic <- Decoder s Word32
forall s. Decoder s Word32
forall a s. DecCBOR a => Decoder s a
decCBOR
      Network
sgNetworkId <- Decoder s Network
forall s. Decoder s Network
forall a s. DecCBOR a => Decoder s a
decCBOR
      PositiveUnitInterval
sgActiveSlotsCoeff <- Decoder s PositiveUnitInterval
forall s. Decoder s PositiveUnitInterval
activeSlotsCoeffDecCBOR
      NonZero Word64
sgSecurityParam <- Decoder s (NonZero Word64)
forall s. Decoder s (NonZero Word64)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Word64
sgEpochLength <- Decoder s Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR
      Word64
sgSlotsPerKESPeriod <- Decoder s Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR
      Word64
sgMaxKESEvolutions <- Decoder s Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR
      NominalDiffTimeMicro
sgSlotLength <- Decoder s NominalDiffTimeMicro
forall s. Decoder s NominalDiffTimeMicro
forall a s. DecCBOR a => Decoder s a
decCBOR
      Word64
sgUpdateQuorum <- Decoder s Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR
      Word64
sgMaxLovelaceSupply <- Decoder s Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR
      PParams ShelleyEra
sgProtocolParams <- Decoder s (PParams ShelleyEra)
forall s. Decoder s (PParams ShelleyEra)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs <- Decoder s (Map (KeyHash 'Genesis) GenDelegPair)
forall s. Decoder s (Map (KeyHash 'Genesis) GenDelegPair)
forall a s. DecCBOR a => Decoder s a
decCBOR
      ListMap Addr Coin
sgInitialFunds <- Decoder s (ListMap Addr Coin)
forall s. Decoder s (ListMap Addr Coin)
forall a s. DecCBOR a => Decoder s a
decCBOR
      ShelleyGenesisStaking
sgStaking <- Decoder s ShelleyGenesisStaking
forall s. Decoder s ShelleyGenesisStaking
forall a s. DecCBOR a => Decoder s a
decCBOR
      ShelleyGenesis -> Decoder s ShelleyGenesis
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyGenesis -> Decoder s ShelleyGenesis)
-> ShelleyGenesis -> Decoder s ShelleyGenesis
forall a b. (a -> b) -> a -> b
$
        UTCTime
-> Word32
-> Network
-> PositiveUnitInterval
-> NonZero Word64
-> EpochSize
-> Word64
-> Word64
-> NominalDiffTimeMicro
-> Word64
-> Word64
-> PParams ShelleyEra
-> Map (KeyHash 'Genesis) GenDelegPair
-> ListMap Addr Coin
-> ShelleyGenesisStaking
-> ShelleyGenesis
ShelleyGenesis
          UTCTime
sgSystemStart
          Word32
sgNetworkMagic
          Network
sgNetworkId
          PositiveUnitInterval
sgActiveSlotsCoeff
          NonZero Word64
sgSecurityParam
          (Word64 -> EpochSize
EpochSize Word64
sgEpochLength)
          Word64
sgSlotsPerKESPeriod
          Word64
sgMaxKESEvolutions
          NominalDiffTimeMicro
sgSlotLength
          Word64
sgUpdateQuorum
          Word64
sgMaxLovelaceSupply
          PParams ShelleyEra
sgProtocolParams
          Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs
          ListMap Addr Coin
sgInitialFunds
          ShelleyGenesisStaking
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
  Rational
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 Rational -> Maybe PositiveUnitInterval
forall r. BoundedRational r => Rational -> Maybe r
boundRational Rational
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 'Genesis) GenDelegPair
sgGenDelegs :: ShelleyGenesis -> Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs :: Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair -> Int
forall a. Map (KeyHash 'Genesis) a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map (KeyHash 'Genesis) 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)