{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Ledger.Shelley.Genesis
  ( ShelleyGenesisStaking (..),
    ShelleyGenesis (..),
    ValidationErr (..),
    emptyGenesisStaking,
    sgActiveSlotCoeff,
    genesisUTxO,
    initialFundsPseudoTxIn,
    validateGenesis,
    describeValidationErr,
    mkShelleyGlobals,
  )
where

import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen)
import qualified Cardano.Crypto.Hash.Class as Crypto
import Cardano.Crypto.KES.Class (totalPeriodsKES)
import Cardano.Ledger.Address
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Coin
import Cardano.Ledger.Crypto (HASH, KES)
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Era
import Cardano.Ledger.Hashes (EraIndependentTxBody)
import Cardano.Ledger.Keys
import Cardano.Ledger.SafeHash (unsafeMakeSafeHash)
import Cardano.Ledger.Serialization
  ( decodeRecordNamed,
    mapFromCBOR,
    mapToCBOR,
    utcTimeFromCBOR,
    utcTimeToCBOR,
  )
import Cardano.Ledger.Shelley.Constraints (UsesTxOut (..))
import Cardano.Ledger.Shelley.PParams
import Cardano.Ledger.Shelley.StabilityWindow
import Cardano.Ledger.Shelley.TxBody (PoolParams (..))
import Cardano.Ledger.Shelley.UTxO
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import qualified Cardano.Ledger.Val as Val
import Cardano.Slotting.EpochInfo
import Cardano.Slotting.Slot (EpochSize (..))
import Cardano.Slotting.Time (SystemStart (SystemStart))
import Data.Aeson (FromJSON (..), ToJSON (..), (.!=), (.:), (.:?), (.=))
import qualified Data.Aeson as Aeson
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 (NominalDiffTime, UTCTime (..))
import Data.Unit.Strict (forceElemsToWHNF)
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)
import GHC.Natural (Natural)
import NoThunks.Class (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 crypto = ShelleyGenesisStaking
  { -- | 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 crypto
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
sgsPools :: !(Map (KeyHash 'StakePool crypto) (PoolParams crypto)),
    -- | 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.
    ShelleyGenesisStaking crypto
-> Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
sgsStake :: !(Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto))
  }
  deriving stock (ShelleyGenesisStaking crypto
-> ShelleyGenesisStaking crypto -> Bool
(ShelleyGenesisStaking crypto
 -> ShelleyGenesisStaking crypto -> Bool)
-> (ShelleyGenesisStaking crypto
    -> ShelleyGenesisStaking crypto -> Bool)
-> Eq (ShelleyGenesisStaking crypto)
forall crypto.
ShelleyGenesisStaking crypto
-> ShelleyGenesisStaking crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShelleyGenesisStaking crypto
-> ShelleyGenesisStaking crypto -> Bool
$c/= :: forall crypto.
ShelleyGenesisStaking crypto
-> ShelleyGenesisStaking crypto -> Bool
== :: ShelleyGenesisStaking crypto
-> ShelleyGenesisStaking crypto -> Bool
$c== :: forall crypto.
ShelleyGenesisStaking crypto
-> ShelleyGenesisStaking crypto -> Bool
Eq, Int -> ShelleyGenesisStaking crypto -> ShowS
[ShelleyGenesisStaking crypto] -> ShowS
ShelleyGenesisStaking crypto -> String
(Int -> ShelleyGenesisStaking crypto -> ShowS)
-> (ShelleyGenesisStaking crypto -> String)
-> ([ShelleyGenesisStaking crypto] -> ShowS)
-> Show (ShelleyGenesisStaking crypto)
forall crypto. Int -> ShelleyGenesisStaking crypto -> ShowS
forall crypto. [ShelleyGenesisStaking crypto] -> ShowS
forall crypto. ShelleyGenesisStaking crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyGenesisStaking crypto] -> ShowS
$cshowList :: forall crypto. [ShelleyGenesisStaking crypto] -> ShowS
show :: ShelleyGenesisStaking crypto -> String
$cshow :: forall crypto. ShelleyGenesisStaking crypto -> String
showsPrec :: Int -> ShelleyGenesisStaking crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> ShelleyGenesisStaking crypto -> ShowS
Show, (forall x.
 ShelleyGenesisStaking crypto
 -> Rep (ShelleyGenesisStaking crypto) x)
-> (forall x.
    Rep (ShelleyGenesisStaking crypto) x
    -> ShelleyGenesisStaking crypto)
-> Generic (ShelleyGenesisStaking crypto)
forall x.
Rep (ShelleyGenesisStaking crypto) x
-> ShelleyGenesisStaking crypto
forall x.
ShelleyGenesisStaking crypto
-> Rep (ShelleyGenesisStaking crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (ShelleyGenesisStaking crypto) x
-> ShelleyGenesisStaking crypto
forall crypto x.
ShelleyGenesisStaking crypto
-> Rep (ShelleyGenesisStaking crypto) x
$cto :: forall crypto x.
Rep (ShelleyGenesisStaking crypto) x
-> ShelleyGenesisStaking crypto
$cfrom :: forall crypto x.
ShelleyGenesisStaking crypto
-> Rep (ShelleyGenesisStaking crypto) x
Generic)

instance NoThunks (ShelleyGenesisStaking crypto)

instance CC.Crypto crypto => ToCBOR (ShelleyGenesisStaking crypto) where
  toCBOR :: ShelleyGenesisStaking crypto -> Encoding
toCBOR (ShelleyGenesisStaking Map (KeyHash 'StakePool crypto) (PoolParams crypto)
pools Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
stake) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'StakePool crypto) (PoolParams crypto) -> Encoding
forall a b. (ToCBOR a, ToCBOR b) => Map a b -> Encoding
mapToCBOR Map (KeyHash 'StakePool crypto) (PoolParams crypto)
pools Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
-> Encoding
forall a b. (ToCBOR a, ToCBOR b) => Map a b -> Encoding
mapToCBOR Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
stake

instance CC.Crypto crypto => FromCBOR (ShelleyGenesisStaking crypto) where
  fromCBOR :: Decoder s (ShelleyGenesisStaking crypto)
fromCBOR = do
    Text
-> (ShelleyGenesisStaking crypto -> Int)
-> Decoder s (ShelleyGenesisStaking crypto)
-> Decoder s (ShelleyGenesisStaking crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"ShelleyGenesisStaking" (Int -> ShelleyGenesisStaking crypto -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (ShelleyGenesisStaking crypto)
 -> Decoder s (ShelleyGenesisStaking crypto))
-> Decoder s (ShelleyGenesisStaking crypto)
-> Decoder s (ShelleyGenesisStaking crypto)
forall a b. (a -> b) -> a -> b
$ do
      Map (KeyHash 'StakePool crypto) (PoolParams crypto)
pools <- Decoder s (Map (KeyHash 'StakePool crypto) (PoolParams crypto))
forall a b s.
(Ord a, FromCBOR a, FromCBOR b) =>
Decoder s (Map a b)
mapFromCBOR
      Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
stake <- Decoder
  s (Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto))
forall a b s.
(Ord a, FromCBOR a, FromCBOR b) =>
Decoder s (Map a b)
mapFromCBOR
      ShelleyGenesisStaking crypto
-> Decoder s (ShelleyGenesisStaking crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyGenesisStaking crypto
 -> Decoder s (ShelleyGenesisStaking crypto))
-> ShelleyGenesisStaking crypto
-> Decoder s (ShelleyGenesisStaking crypto)
forall a b. (a -> b) -> a -> b
$ Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
-> ShelleyGenesisStaking crypto
forall crypto.
Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
-> ShelleyGenesisStaking crypto
ShelleyGenesisStaking Map (KeyHash 'StakePool crypto) (PoolParams crypto)
pools Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
stake

-- | Empty genesis staking
emptyGenesisStaking :: ShelleyGenesisStaking crypto
emptyGenesisStaking :: ShelleyGenesisStaking crypto
emptyGenesisStaking =
  ShelleyGenesisStaking :: forall crypto.
Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
-> ShelleyGenesisStaking crypto
ShelleyGenesisStaking
    { sgsPools :: Map (KeyHash 'StakePool crypto) (PoolParams crypto)
sgsPools = Map (KeyHash 'StakePool crypto) (PoolParams crypto)
forall k a. Map k a
Map.empty,
      sgsStake :: Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
sgsStake = Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
forall k a. Map k a
Map.empty
    }

-- | 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 era = ShelleyGenesis
  { ShelleyGenesis era -> UTCTime
sgSystemStart :: !UTCTime,
    ShelleyGenesis era -> Word32
sgNetworkMagic :: !Word32,
    ShelleyGenesis era -> Network
sgNetworkId :: !Network,
    ShelleyGenesis era -> PositiveUnitInterval
sgActiveSlotsCoeff :: !PositiveUnitInterval,
    ShelleyGenesis era -> Word64
sgSecurityParam :: !Word64,
    ShelleyGenesis era -> EpochSize
sgEpochLength :: !EpochSize,
    ShelleyGenesis era -> Word64
sgSlotsPerKESPeriod :: !Word64,
    ShelleyGenesis era -> Word64
sgMaxKESEvolutions :: !Word64,
    ShelleyGenesis era -> NominalDiffTime
sgSlotLength :: !NominalDiffTime,
    ShelleyGenesis era -> Word64
sgUpdateQuorum :: !Word64,
    ShelleyGenesis era -> Word64
sgMaxLovelaceSupply :: !Word64,
    ShelleyGenesis era -> PParams era
sgProtocolParams :: !(PParams era),
    ShelleyGenesis era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
sgGenDelegs :: !(Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))),
    ShelleyGenesis era -> Map (Addr (Crypto era)) Coin
sgInitialFunds :: !(Map (Addr (Crypto era)) Coin),
    ShelleyGenesis era -> ShelleyGenesisStaking (Crypto era)
sgStaking :: !(ShelleyGenesisStaking (Crypto era))
  }
  deriving stock (ShelleyGenesis era -> ShelleyGenesis era -> Bool
(ShelleyGenesis era -> ShelleyGenesis era -> Bool)
-> (ShelleyGenesis era -> ShelleyGenesis era -> Bool)
-> Eq (ShelleyGenesis era)
forall era. ShelleyGenesis era -> ShelleyGenesis era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShelleyGenesis era -> ShelleyGenesis era -> Bool
$c/= :: forall era. ShelleyGenesis era -> ShelleyGenesis era -> Bool
== :: ShelleyGenesis era -> ShelleyGenesis era -> Bool
$c== :: forall era. ShelleyGenesis era -> ShelleyGenesis era -> Bool
Eq, Int -> ShelleyGenesis era -> ShowS
[ShelleyGenesis era] -> ShowS
ShelleyGenesis era -> String
(Int -> ShelleyGenesis era -> ShowS)
-> (ShelleyGenesis era -> String)
-> ([ShelleyGenesis era] -> ShowS)
-> Show (ShelleyGenesis era)
forall era. Int -> ShelleyGenesis era -> ShowS
forall era. [ShelleyGenesis era] -> ShowS
forall era. ShelleyGenesis era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyGenesis era] -> ShowS
$cshowList :: forall era. [ShelleyGenesis era] -> ShowS
show :: ShelleyGenesis era -> String
$cshow :: forall era. ShelleyGenesis era -> String
showsPrec :: Int -> ShelleyGenesis era -> ShowS
$cshowsPrec :: forall era. Int -> ShelleyGenesis era -> ShowS
Show, (forall x. ShelleyGenesis era -> Rep (ShelleyGenesis era) x)
-> (forall x. Rep (ShelleyGenesis era) x -> ShelleyGenesis era)
-> Generic (ShelleyGenesis era)
forall x. Rep (ShelleyGenesis era) x -> ShelleyGenesis era
forall x. ShelleyGenesis era -> Rep (ShelleyGenesis era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ShelleyGenesis era) x -> ShelleyGenesis era
forall era x. ShelleyGenesis era -> Rep (ShelleyGenesis era) x
$cto :: forall era x. Rep (ShelleyGenesis era) x -> ShelleyGenesis era
$cfrom :: forall era x. ShelleyGenesis era -> Rep (ShelleyGenesis era) x
Generic)

deriving instance Era era => NoThunks (ShelleyGenesis era)

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

instance Era era => ToJSON (ShelleyGenesis era) where
  toJSON :: ShelleyGenesis era -> Value
toJSON ShelleyGenesis era
sg =
    [Pair] -> Value
Aeson.object
      [ Key
"systemStart" Key -> UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesis era -> UTCTime
forall era. ShelleyGenesis era -> UTCTime
sgSystemStart ShelleyGenesis era
sg,
        Key
"networkMagic" Key -> Word32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesis era -> Word32
forall era. ShelleyGenesis era -> Word32
sgNetworkMagic ShelleyGenesis era
sg,
        Key
"networkId" Key -> Network -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesis era -> Network
forall era. ShelleyGenesis era -> Network
sgNetworkId ShelleyGenesis era
sg,
        Key
"activeSlotsCoeff" Key -> PositiveUnitInterval -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesis era -> PositiveUnitInterval
forall era. ShelleyGenesis era -> PositiveUnitInterval
sgActiveSlotsCoeff ShelleyGenesis era
sg,
        Key
"securityParam" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
sgSecurityParam ShelleyGenesis era
sg,
        Key
"epochLength" Key -> EpochSize -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesis era -> EpochSize
forall era. ShelleyGenesis era -> EpochSize
sgEpochLength ShelleyGenesis era
sg,
        Key
"slotsPerKESPeriod" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
sgSlotsPerKESPeriod ShelleyGenesis era
sg,
        Key
"maxKESEvolutions" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
sgMaxKESEvolutions ShelleyGenesis era
sg,
        Key
"slotLength" Key -> NominalDiffTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesis era -> NominalDiffTime
forall era. ShelleyGenesis era -> NominalDiffTime
sgSlotLength ShelleyGenesis era
sg,
        Key
"updateQuorum" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
sgUpdateQuorum ShelleyGenesis era
sg,
        Key
"maxLovelaceSupply" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
sgMaxLovelaceSupply ShelleyGenesis era
sg,
        Key
"protocolParams" Key -> PParams era -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesis era -> PParams era
forall era. ShelleyGenesis era -> PParams era
sgProtocolParams ShelleyGenesis era
sg,
        Key
"genDelegs" Key
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesis era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
forall era.
ShelleyGenesis era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
sgGenDelegs ShelleyGenesis era
sg,
        Key
"initialFunds" Key -> Map (Addr (Crypto era)) Coin -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesis era -> Map (Addr (Crypto era)) Coin
forall era. ShelleyGenesis era -> Map (Addr (Crypto era)) Coin
sgInitialFunds ShelleyGenesis era
sg,
        Key
"staking" Key -> ShelleyGenesisStaking (Crypto era) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesis era -> ShelleyGenesisStaking (Crypto era)
forall era.
ShelleyGenesis era -> ShelleyGenesisStaking (Crypto era)
sgStaking ShelleyGenesis era
sg
      ]

instance Era era => FromJSON (ShelleyGenesis era) where
  parseJSON :: Value -> Parser (ShelleyGenesis era)
parseJSON =
    String
-> (Object -> Parser (ShelleyGenesis era))
-> Value
-> Parser (ShelleyGenesis era)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ShelleyGenesis" ((Object -> Parser (ShelleyGenesis era))
 -> Value -> Parser (ShelleyGenesis era))
-> (Object -> Parser (ShelleyGenesis era))
-> Value
-> Parser (ShelleyGenesis era)
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      UTCTime
-> Word32
-> Network
-> PositiveUnitInterval
-> Word64
-> EpochSize
-> Word64
-> Word64
-> NominalDiffTime
-> Word64
-> Word64
-> PParams era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> Map (Addr (Crypto era)) Coin
-> ShelleyGenesisStaking (Crypto era)
-> ShelleyGenesis era
forall era.
UTCTime
-> Word32
-> Network
-> PositiveUnitInterval
-> Word64
-> EpochSize
-> Word64
-> Word64
-> NominalDiffTime
-> Word64
-> Word64
-> PParams era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> Map (Addr (Crypto era)) Coin
-> ShelleyGenesisStaking (Crypto era)
-> ShelleyGenesis era
ShelleyGenesis
        (UTCTime
 -> Word32
 -> Network
 -> PositiveUnitInterval
 -> Word64
 -> EpochSize
 -> Word64
 -> Word64
 -> NominalDiffTime
 -> Word64
 -> Word64
 -> PParams era
 -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
 -> Map (Addr (Crypto era)) Coin
 -> ShelleyGenesisStaking (Crypto era)
 -> ShelleyGenesis era)
-> Parser UTCTime
-> Parser
     (Word32
      -> Network
      -> PositiveUnitInterval
      -> Word64
      -> EpochSize
      -> Word64
      -> Word64
      -> NominalDiffTime
      -> Word64
      -> Word64
      -> PParams era
      -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
      -> Map (Addr (Crypto era)) Coin
      -> ShelleyGenesisStaking (Crypto era)
      -> ShelleyGenesis era)
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
   -> Word64
   -> EpochSize
   -> Word64
   -> Word64
   -> NominalDiffTime
   -> Word64
   -> Word64
   -> PParams era
   -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
   -> Map (Addr (Crypto era)) Coin
   -> ShelleyGenesisStaking (Crypto era)
   -> ShelleyGenesis era)
-> Parser Word32
-> Parser
     (Network
      -> PositiveUnitInterval
      -> Word64
      -> EpochSize
      -> Word64
      -> Word64
      -> NominalDiffTime
      -> Word64
      -> Word64
      -> PParams era
      -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
      -> Map (Addr (Crypto era)) Coin
      -> ShelleyGenesisStaking (Crypto era)
      -> ShelleyGenesis era)
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
   -> Word64
   -> EpochSize
   -> Word64
   -> Word64
   -> NominalDiffTime
   -> Word64
   -> Word64
   -> PParams era
   -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
   -> Map (Addr (Crypto era)) Coin
   -> ShelleyGenesisStaking (Crypto era)
   -> ShelleyGenesis era)
-> Parser Network
-> Parser
     (PositiveUnitInterval
      -> Word64
      -> EpochSize
      -> Word64
      -> Word64
      -> NominalDiffTime
      -> Word64
      -> Word64
      -> PParams era
      -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
      -> Map (Addr (Crypto era)) Coin
      -> ShelleyGenesisStaking (Crypto era)
      -> ShelleyGenesis era)
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
   -> Word64
   -> EpochSize
   -> Word64
   -> Word64
   -> NominalDiffTime
   -> Word64
   -> Word64
   -> PParams era
   -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
   -> Map (Addr (Crypto era)) Coin
   -> ShelleyGenesisStaking (Crypto era)
   -> ShelleyGenesis era)
-> Parser PositiveUnitInterval
-> Parser
     (Word64
      -> EpochSize
      -> Word64
      -> Word64
      -> NominalDiffTime
      -> Word64
      -> Word64
      -> PParams era
      -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
      -> Map (Addr (Crypto era)) Coin
      -> ShelleyGenesisStaking (Crypto era)
      -> ShelleyGenesis era)
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
  (Word64
   -> EpochSize
   -> Word64
   -> Word64
   -> NominalDiffTime
   -> Word64
   -> Word64
   -> PParams era
   -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
   -> Map (Addr (Crypto era)) Coin
   -> ShelleyGenesisStaking (Crypto era)
   -> ShelleyGenesis era)
-> Parser Word64
-> Parser
     (EpochSize
      -> Word64
      -> Word64
      -> NominalDiffTime
      -> Word64
      -> Word64
      -> PParams era
      -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
      -> Map (Addr (Crypto era)) Coin
      -> ShelleyGenesisStaking (Crypto era)
      -> ShelleyGenesis era)
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
"securityParam"
        Parser
  (EpochSize
   -> Word64
   -> Word64
   -> NominalDiffTime
   -> Word64
   -> Word64
   -> PParams era
   -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
   -> Map (Addr (Crypto era)) Coin
   -> ShelleyGenesisStaking (Crypto era)
   -> ShelleyGenesis era)
-> Parser EpochSize
-> Parser
     (Word64
      -> Word64
      -> NominalDiffTime
      -> Word64
      -> Word64
      -> PParams era
      -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
      -> Map (Addr (Crypto era)) Coin
      -> ShelleyGenesisStaking (Crypto era)
      -> ShelleyGenesis era)
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
   -> NominalDiffTime
   -> Word64
   -> Word64
   -> PParams era
   -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
   -> Map (Addr (Crypto era)) Coin
   -> ShelleyGenesisStaking (Crypto era)
   -> ShelleyGenesis era)
-> Parser Word64
-> Parser
     (Word64
      -> NominalDiffTime
      -> Word64
      -> Word64
      -> PParams era
      -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
      -> Map (Addr (Crypto era)) Coin
      -> ShelleyGenesisStaking (Crypto era)
      -> ShelleyGenesis era)
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
   -> NominalDiffTime
   -> Word64
   -> Word64
   -> PParams era
   -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
   -> Map (Addr (Crypto era)) Coin
   -> ShelleyGenesisStaking (Crypto era)
   -> ShelleyGenesis era)
-> Parser Word64
-> Parser
     (NominalDiffTime
      -> Word64
      -> Word64
      -> PParams era
      -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
      -> Map (Addr (Crypto era)) Coin
      -> ShelleyGenesisStaking (Crypto era)
      -> ShelleyGenesis era)
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
  (NominalDiffTime
   -> Word64
   -> Word64
   -> PParams era
   -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
   -> Map (Addr (Crypto era)) Coin
   -> ShelleyGenesisStaking (Crypto era)
   -> ShelleyGenesis era)
-> Parser NominalDiffTime
-> Parser
     (Word64
      -> Word64
      -> PParams era
      -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
      -> Map (Addr (Crypto era)) Coin
      -> ShelleyGenesisStaking (Crypto era)
      -> ShelleyGenesis era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser NominalDiffTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slotLength"
        Parser
  (Word64
   -> Word64
   -> PParams era
   -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
   -> Map (Addr (Crypto era)) Coin
   -> ShelleyGenesisStaking (Crypto era)
   -> ShelleyGenesis era)
-> Parser Word64
-> Parser
     (Word64
      -> PParams era
      -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
      -> Map (Addr (Crypto era)) Coin
      -> ShelleyGenesisStaking (Crypto era)
      -> ShelleyGenesis era)
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 era
   -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
   -> Map (Addr (Crypto era)) Coin
   -> ShelleyGenesisStaking (Crypto era)
   -> ShelleyGenesis era)
-> Parser Word64
-> Parser
     (PParams era
      -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
      -> Map (Addr (Crypto era)) Coin
      -> ShelleyGenesisStaking (Crypto era)
      -> ShelleyGenesis era)
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 era
   -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
   -> Map (Addr (Crypto era)) Coin
   -> ShelleyGenesisStaking (Crypto era)
   -> ShelleyGenesis era)
-> Parser (PParams era)
-> Parser
     (Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
      -> Map (Addr (Crypto era)) Coin
      -> ShelleyGenesisStaking (Crypto era)
      -> ShelleyGenesis era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (PParams era)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"protocolParams"
        Parser
  (Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
   -> Map (Addr (Crypto era)) Coin
   -> ShelleyGenesisStaking (Crypto era)
   -> ShelleyGenesis era)
-> Parser
     (Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era)))
-> Parser
     (Map (Addr (Crypto era)) Coin
      -> ShelleyGenesisStaking (Crypto era) -> ShelleyGenesis era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
forall (t :: * -> *) a. Foldable t => t a -> t a
forceElemsToWHNF (Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
 -> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era)))
-> Parser
     (Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era)))
-> Parser
     (Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object
-> Key
-> Parser
     (Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era)))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"genDelegs")
        Parser
  (Map (Addr (Crypto era)) Coin
   -> ShelleyGenesisStaking (Crypto era) -> ShelleyGenesis era)
-> Parser (Map (Addr (Crypto era)) Coin)
-> Parser
     (ShelleyGenesisStaking (Crypto era) -> ShelleyGenesis era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Map (Addr (Crypto era)) Coin -> Map (Addr (Crypto era)) Coin
forall (t :: * -> *) a. Foldable t => t a -> t a
forceElemsToWHNF (Map (Addr (Crypto era)) Coin -> Map (Addr (Crypto era)) Coin)
-> Parser (Map (Addr (Crypto era)) Coin)
-> Parser (Map (Addr (Crypto era)) Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Map (Addr (Crypto era)) Coin)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"initialFunds")
        Parser (ShelleyGenesisStaking (Crypto era) -> ShelleyGenesis era)
-> Parser (ShelleyGenesisStaking (Crypto era))
-> Parser (ShelleyGenesis era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object
-> Key -> Parser (Maybe (ShelleyGenesisStaking (Crypto era)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"staking" Parser (Maybe (ShelleyGenesisStaking (Crypto era)))
-> ShelleyGenesisStaking (Crypto era)
-> Parser (ShelleyGenesisStaking (Crypto era))
forall a. Parser (Maybe a) -> a -> Parser a
.!= ShelleyGenesisStaking (Crypto era)
forall crypto. ShelleyGenesisStaking crypto
emptyGenesisStaking
    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 CC.Crypto crypto => ToJSON (ShelleyGenesisStaking crypto) where
  toJSON :: ShelleyGenesisStaking crypto -> Value
toJSON ShelleyGenesisStaking crypto
sgs =
    [Pair] -> Value
Aeson.object
      [ Key
"pools" Key -> Map (KeyHash 'StakePool crypto) (PoolParams crypto) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesisStaking crypto
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
forall crypto.
ShelleyGenesisStaking crypto
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
sgsPools ShelleyGenesisStaking crypto
sgs,
        Key
"stake" Key
-> Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ShelleyGenesisStaking crypto
-> Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
forall crypto.
ShelleyGenesisStaking crypto
-> Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
sgsStake ShelleyGenesisStaking crypto
sgs
      ]

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

instance Era era => ToCBOR (ShelleyGenesis era) where
  toCBOR :: ShelleyGenesis era -> Encoding
toCBOR
    ShelleyGenesis
      { UTCTime
sgSystemStart :: UTCTime
sgSystemStart :: forall era. ShelleyGenesis era -> UTCTime
sgSystemStart,
        Word32
sgNetworkMagic :: Word32
sgNetworkMagic :: forall era. ShelleyGenesis era -> Word32
sgNetworkMagic,
        Network
sgNetworkId :: Network
sgNetworkId :: forall era. ShelleyGenesis era -> Network
sgNetworkId,
        PositiveUnitInterval
sgActiveSlotsCoeff :: PositiveUnitInterval
sgActiveSlotsCoeff :: forall era. ShelleyGenesis era -> PositiveUnitInterval
sgActiveSlotsCoeff,
        Word64
sgSecurityParam :: Word64
sgSecurityParam :: forall era. ShelleyGenesis era -> Word64
sgSecurityParam,
        EpochSize
sgEpochLength :: EpochSize
sgEpochLength :: forall era. ShelleyGenesis era -> EpochSize
sgEpochLength,
        Word64
sgSlotsPerKESPeriod :: Word64
sgSlotsPerKESPeriod :: forall era. ShelleyGenesis era -> Word64
sgSlotsPerKESPeriod,
        Word64
sgMaxKESEvolutions :: Word64
sgMaxKESEvolutions :: forall era. ShelleyGenesis era -> Word64
sgMaxKESEvolutions,
        NominalDiffTime
sgSlotLength :: NominalDiffTime
sgSlotLength :: forall era. ShelleyGenesis era -> NominalDiffTime
sgSlotLength,
        Word64
sgUpdateQuorum :: Word64
sgUpdateQuorum :: forall era. ShelleyGenesis era -> Word64
sgUpdateQuorum,
        Word64
sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply :: forall era. ShelleyGenesis era -> Word64
sgMaxLovelaceSupply,
        PParams era
sgProtocolParams :: PParams era
sgProtocolParams :: forall era. ShelleyGenesis era -> PParams era
sgProtocolParams,
        Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
sgGenDelegs :: Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
sgGenDelegs :: forall era.
ShelleyGenesis era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
sgGenDelegs,
        Map (Addr (Crypto era)) Coin
sgInitialFunds :: Map (Addr (Crypto era)) Coin
sgInitialFunds :: forall era. ShelleyGenesis era -> Map (Addr (Crypto era)) Coin
sgInitialFunds,
        ShelleyGenesisStaking (Crypto era)
sgStaking :: ShelleyGenesisStaking (Crypto era)
sgStaking :: forall era.
ShelleyGenesis era -> ShelleyGenesisStaking (Crypto era)
sgStaking
      } =
      Word -> Encoding
encodeListLen Word
15
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> UTCTime -> Encoding
utcTimeToCBOR UTCTime
sgSystemStart
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Word32
sgNetworkMagic
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Network -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Network
sgNetworkId
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PositiveUnitInterval -> Encoding
forall r. BoundedRational r => r -> Encoding
boundedRationalToCBOR PositiveUnitInterval
sgActiveSlotsCoeff
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Word64
sgSecurityParam
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (EpochSize -> Word64
unEpochSize EpochSize
sgEpochLength)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Word64
sgSlotsPerKESPeriod
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Word64
sgMaxKESEvolutions
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR NominalDiffTime
sgSlotLength
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Word64
sgUpdateQuorum
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Word64
sgMaxLovelaceSupply
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PParams era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PParams era
sgProtocolParams
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> Encoding
forall a b. (ToCBOR a, ToCBOR b) => Map a b -> Encoding
mapToCBOR Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
sgGenDelegs
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (Addr (Crypto era)) Coin -> Encoding
forall a b. (ToCBOR a, ToCBOR b) => Map a b -> Encoding
mapToCBOR Map (Addr (Crypto era)) Coin
sgInitialFunds
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ShelleyGenesisStaking (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ShelleyGenesisStaking (Crypto era)
sgStaking

instance Era era => FromCBOR (ShelleyGenesis era) where
  fromCBOR :: Decoder s (ShelleyGenesis era)
fromCBOR = do
    Text
-> (ShelleyGenesis era -> Int)
-> Decoder s (ShelleyGenesis era)
-> Decoder s (ShelleyGenesis era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"ShelleyGenesis" (Int -> ShelleyGenesis era -> Int
forall a b. a -> b -> a
const Int
15) (Decoder s (ShelleyGenesis era) -> Decoder s (ShelleyGenesis era))
-> Decoder s (ShelleyGenesis era) -> Decoder s (ShelleyGenesis era)
forall a b. (a -> b) -> a -> b
$ do
      UTCTime
sgSystemStart <- Decoder s UTCTime
forall s. Decoder s UTCTime
utcTimeFromCBOR
      Word32
sgNetworkMagic <- Decoder s Word32
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Network
sgNetworkId <- Decoder s Network
forall a s. FromCBOR a => Decoder s a
fromCBOR
      PositiveUnitInterval
sgActiveSlotsCoeff <- Decoder s PositiveUnitInterval
forall r s. BoundedRational r => Decoder s r
boundedRationalFromCBOR
      Word64
sgSecurityParam <- Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word64
sgEpochLength <- Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word64
sgSlotsPerKESPeriod <- Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word64
sgMaxKESEvolutions <- Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR
      NominalDiffTime
sgSlotLength <- Decoder s NominalDiffTime
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word64
sgUpdateQuorum <- Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word64
sgMaxLovelaceSupply <- Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR
      PParams era
sgProtocolParams <- Decoder s (PParams era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
sgGenDelegs <- Decoder
  s (Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era)))
forall a b s.
(Ord a, FromCBOR a, FromCBOR b) =>
Decoder s (Map a b)
mapFromCBOR
      Map (Addr (Crypto era)) Coin
sgInitialFunds <- Decoder s (Map (Addr (Crypto era)) Coin)
forall a b s.
(Ord a, FromCBOR a, FromCBOR b) =>
Decoder s (Map a b)
mapFromCBOR
      ShelleyGenesisStaking (Crypto era)
sgStaking <- Decoder s (ShelleyGenesisStaking (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      ShelleyGenesis era -> Decoder s (ShelleyGenesis era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyGenesis era -> Decoder s (ShelleyGenesis era))
-> ShelleyGenesis era -> Decoder s (ShelleyGenesis era)
forall a b. (a -> b) -> a -> b
$
        UTCTime
-> Word32
-> Network
-> PositiveUnitInterval
-> Word64
-> EpochSize
-> Word64
-> Word64
-> NominalDiffTime
-> Word64
-> Word64
-> PParams era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> Map (Addr (Crypto era)) Coin
-> ShelleyGenesisStaking (Crypto era)
-> ShelleyGenesis era
forall era.
UTCTime
-> Word32
-> Network
-> PositiveUnitInterval
-> Word64
-> EpochSize
-> Word64
-> Word64
-> NominalDiffTime
-> Word64
-> Word64
-> PParams era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> Map (Addr (Crypto era)) Coin
-> ShelleyGenesisStaking (Crypto era)
-> ShelleyGenesis era
ShelleyGenesis
          UTCTime
sgSystemStart
          Word32
sgNetworkMagic
          Network
sgNetworkId
          PositiveUnitInterval
sgActiveSlotsCoeff
          Word64
sgSecurityParam
          (Word64 -> EpochSize
EpochSize Word64
sgEpochLength)
          Word64
sgSlotsPerKESPeriod
          Word64
sgMaxKESEvolutions
          NominalDiffTime
sgSlotLength
          Word64
sgUpdateQuorum
          Word64
sgMaxLovelaceSupply
          PParams era
sgProtocolParams
          Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
sgGenDelegs
          Map (Addr (Crypto era)) Coin
sgInitialFunds
          ShelleyGenesisStaking (Crypto era)
sgStaking

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

genesisUTxO ::
  forall era.
  (Era era, UsesTxOut era) =>
  ShelleyGenesis era ->
  UTxO era
genesisUTxO :: ShelleyGenesis era -> UTxO era
genesisUTxO ShelleyGenesis era
genesis =
  Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
forall era. Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
UTxO (Map (TxIn (Crypto era)) (TxOut era) -> UTxO era)
-> Map (TxIn (Crypto era)) (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$
    [(TxIn (Crypto era), TxOut era)]
-> Map (TxIn (Crypto era)) (TxOut era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (TxIn (Crypto era)
txIn, TxOut era
txOut)
        | (Addr (Crypto era)
addr, Coin
amount) <- Map (Addr (Crypto era)) Coin -> [(Addr (Crypto era), Coin)]
forall k a. Map k a -> [(k, a)]
Map.toList (ShelleyGenesis era -> Map (Addr (Crypto era)) Coin
forall era. ShelleyGenesis era -> Map (Addr (Crypto era)) Coin
sgInitialFunds ShelleyGenesis era
genesis),
          let txIn :: TxIn (Crypto era)
txIn = Addr (Crypto era) -> TxIn (Crypto era)
forall crypto. Crypto crypto => Addr crypto -> TxIn crypto
initialFundsPseudoTxIn Addr (Crypto era)
addr
              txOut :: TxOut era
txOut = Proxy era -> Addr (Crypto era) -> Value era -> TxOut era
forall era.
UsesTxOut era =>
Proxy era -> Addr (Crypto era) -> Value era -> TxOut era
makeTxOut (Proxy era
forall k (t :: k). Proxy t
Proxy @era) Addr (Crypto era)
addr (Coin -> Value era
forall t. Val t => Coin -> t
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 :: forall crypto. CC.Crypto crypto => Addr crypto -> TxIn crypto
initialFundsPseudoTxIn :: Addr crypto -> TxIn crypto
initialFundsPseudoTxIn Addr crypto
addr =
  TxId crypto -> TxIx -> TxIn crypto
forall crypto. TxId crypto -> TxIx -> TxIn crypto
TxIn (Addr crypto -> TxId crypto
pseudoTxId Addr crypto
addr) TxIx
forall a. Bounded a => a
minBound
  where
    pseudoTxId :: Addr crypto -> TxId crypto
pseudoTxId =
      SafeHash crypto EraIndependentTxBody -> TxId crypto
forall crypto. SafeHash crypto EraIndependentTxBody -> TxId crypto
TxId
        (SafeHash crypto EraIndependentTxBody -> TxId crypto)
-> (Addr crypto -> SafeHash crypto EraIndependentTxBody)
-> Addr crypto
-> TxId crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (HASH crypto) EraIndependentTxBody
-> SafeHash crypto EraIndependentTxBody
forall crypto index.
Hash (HASH crypto) index -> SafeHash crypto index
unsafeMakeSafeHash
        (Hash (HASH crypto) EraIndependentTxBody
 -> SafeHash crypto EraIndependentTxBody)
-> (Addr crypto -> Hash (HASH crypto) EraIndependentTxBody)
-> Addr crypto
-> SafeHash crypto EraIndependentTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( Hash (HASH crypto) (Addr crypto)
-> Hash (HASH crypto) EraIndependentTxBody
forall h a b. Hash h a -> Hash h b
Crypto.castHash ::
              Crypto.Hash (HASH crypto) (Addr crypto) ->
              Crypto.Hash (HASH crypto) EraIndependentTxBody
          )
        (Hash (HASH crypto) (Addr crypto)
 -> Hash (HASH crypto) EraIndependentTxBody)
-> (Addr crypto -> Hash (HASH crypto) (Addr crypto))
-> Addr crypto
-> Hash (HASH crypto) EraIndependentTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Addr crypto -> ByteString)
-> Addr crypto -> Hash (HASH crypto) (Addr crypto)
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith Addr crypto -> ByteString
forall crypto. Addr crypto -> 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
/= :: ValidationErr -> ValidationErr -> Bool
$c/= :: ValidationErr -> ValidationErr -> Bool
== :: ValidationErr -> ValidationErr -> Bool
$c== :: 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
showList :: [ValidationErr] -> ShowS
$cshowList :: [ValidationErr] -> ShowS
show :: ValidationErr -> String
$cshow :: ValidationErr -> String
showsPrec :: Int -> ValidationErr -> ShowS
$cshowsPrec :: Int -> 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 ::
  forall era.
  Era era =>
  ShelleyGenesis era ->
  Either [ValidationErr] ()
validateGenesis :: ShelleyGenesis era -> Either [ValidationErr] ()
validateGenesis
  ShelleyGenesis
    { EpochSize
sgEpochLength :: EpochSize
sgEpochLength :: forall era. ShelleyGenesis era -> EpochSize
sgEpochLength,
      PositiveUnitInterval
sgActiveSlotsCoeff :: PositiveUnitInterval
sgActiveSlotsCoeff :: forall era. ShelleyGenesis era -> PositiveUnitInterval
sgActiveSlotsCoeff,
      Word64
sgMaxKESEvolutions :: Word64
sgMaxKESEvolutions :: forall era. ShelleyGenesis era -> Word64
sgMaxKESEvolutions,
      Word64
sgSecurityParam :: Word64
sgSecurityParam :: forall era. ShelleyGenesis era -> Word64
sgSecurityParam,
      Word64
sgUpdateQuorum :: Word64
sgUpdateQuorum :: forall era. ShelleyGenesis era -> Word64
sgUpdateQuorum,
      Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
sgGenDelegs :: Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
sgGenDelegs :: forall era.
ShelleyGenesis era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
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 a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> EpochSize) -> Double -> EpochSize
forall a b. (a -> b) -> a -> b
$
                Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Double (Word64
3 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* 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
                    Word64
sgSecurityParam
                    Rational
activeSlotsCoeff
                    EpochSize
minLength
              else Maybe ValidationErr
forall a. Maybe a
Nothing
      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 (Proxy (KES (Crypto era)) -> Word
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
totalPeriodsKES (Proxy (KES (Crypto era))
forall k (t :: k). Proxy t
Proxy @(KES (Crypto era))))
          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
                (Proxy (KES (Crypto era)) -> Word
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
totalPeriodsKES (Proxy (KES (Crypto era))
forall k (t :: k). Proxy t
Proxy @(KES (Crypto era))))
      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 (Crypto era)) (GenDelegPair (Crypto era))
-> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
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 era ->
  EpochInfo (Either Text) ->
  Natural ->
  Globals
mkShelleyGlobals :: ShelleyGenesis era -> EpochInfo (Either Text) -> Natural -> Globals
mkShelleyGlobals ShelleyGenesis era
genesis EpochInfo (Either Text)
epochInfoAc Natural
maxMajorPV =
  Globals :: EpochInfo (Either Text)
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Natural
-> Word64
-> ActiveSlotCoeff
-> Network
-> SystemStart
-> Globals
Globals
    { activeSlotCoeff :: ActiveSlotCoeff
activeSlotCoeff = ShelleyGenesis era -> ActiveSlotCoeff
forall era. ShelleyGenesis era -> ActiveSlotCoeff
sgActiveSlotCoeff ShelleyGenesis era
genesis,
      epochInfo :: EpochInfo (Either Text)
epochInfo = EpochInfo (Either Text)
epochInfoAc,
      maxKESEvo :: Word64
maxKESEvo = ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
sgMaxKESEvolutions ShelleyGenesis era
genesis,
      maxLovelaceSupply :: Word64
maxLovelaceSupply = ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
sgMaxLovelaceSupply ShelleyGenesis era
genesis,
      maxMajorPV :: Natural
maxMajorPV = Natural
maxMajorPV,
      networkId :: Network
networkId = ShelleyGenesis era -> Network
forall era. ShelleyGenesis era -> Network
sgNetworkId ShelleyGenesis era
genesis,
      quorum :: Word64
quorum = ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
sgUpdateQuorum ShelleyGenesis era
genesis,
      Word64
randomnessStabilisationWindow :: Word64
randomnessStabilisationWindow :: Word64
randomnessStabilisationWindow,
      securityParameter :: Word64
securityParameter = Word64
k,
      slotsPerKESPeriod :: Word64
slotsPerKESPeriod = ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
sgSlotsPerKESPeriod ShelleyGenesis era
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 era -> UTCTime
forall era. ShelleyGenesis era -> UTCTime
sgSystemStart ShelleyGenesis era
genesis
    k :: Word64
k = ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
sgSecurityParam ShelleyGenesis era
genesis
    stabilityWindow :: Word64
stabilityWindow =
      Word64 -> ActiveSlotCoeff -> Word64
computeStabilityWindow Word64
k (ShelleyGenesis era -> ActiveSlotCoeff
forall era. ShelleyGenesis era -> ActiveSlotCoeff
sgActiveSlotCoeff ShelleyGenesis era
genesis)
    randomnessStabilisationWindow :: Word64
randomnessStabilisationWindow =
      Word64 -> ActiveSlotCoeff -> Word64
computeRandomnessStabilisationWindow Word64
k (ShelleyGenesis era -> ActiveSlotCoeff
forall era. ShelleyGenesis era -> ActiveSlotCoeff
sgActiveSlotCoeff ShelleyGenesis era
genesis)