{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Redundant ==" #-}

-- | The various Cardano protocol parameters, including:
--
-- * the current values of updatable protocol parameters: 'ProtocolParameters'
-- * updates to protocol parameters: 'ProtocolParametersUpdate'
-- * update proposals that can be embedded in transactions: 'UpdateProposal'
-- * parameters fixed in the genesis file: 'GenesisParameters'
module Cardano.Api.ProtocolParameters
  ( -- * The updatable protocol parameters
    ProtocolParameters (..)
  , checkProtocolParameters
  , EpochNo

    -- * The updatable protocol parameters
  , LedgerProtocolParameters (..)
  , EraBasedProtocolParametersUpdate (..)
  , AlonzoOnwardsPParams (..)
  , CommonProtocolParametersUpdate (..)
  , DeprecatedAfterBabbagePParams (..)
  , DeprecatedAfterMaryPParams (..)
  , ShelleyToAlonzoPParams (..)
  , IntroducedInBabbagePParams (..)
  , IntroducedInConwayPParams (..)
  , createEraBasedProtocolParamUpdate
  , convertToLedgerProtocolParameters
  , createPParams

    -- * Deprecated
  , ProtocolParametersUpdate (..)

    -- * Errors
  , ProtocolParametersError (..)
  , ProtocolParametersConversionError (..)

    -- * PraosNonce
  , PraosNonce
  , makePraosNonce

    -- * Execution units, prices and cost models,
  , ExecutionUnits (..)
  , ExecutionUnitPrices (..)
  , CostModels (..)
  , CostModel (..)
  , fromAlonzoCostModels

    -- * Update proposals to change the protocol parameters
  , UpdateProposal (..)
  , makeShelleyUpdateProposal

    -- * Internal conversion functions
  , toLedgerNonce
  , toLedgerUpdate
  , fromLedgerUpdate
  , toLedgerProposedPPUpdates
  , fromLedgerProposedPPUpdates
  , toLedgerPParams
  , toLedgerPParamsUpdate
  , fromLedgerPParams
  , fromLedgerPParamsUpdate
  , toAlonzoPrices
  , fromAlonzoPrices
  , toAlonzoScriptLanguage
  , fromAlonzoScriptLanguage
  , toAlonzoCostModel
  , fromAlonzoCostModel
  , toAlonzoCostModels

    -- * Data family instances
  , AsType (..)

    -- ** Era-dependent protocol features
  )
where

import           Cardano.Api.Address
import           Cardano.Api.Eon.AlonzoEraOnwards
import           Cardano.Api.Eon.BabbageEraOnwards
import           Cardano.Api.Eon.ShelleyBasedEra
import           Cardano.Api.Eras
import           Cardano.Api.Error
import           Cardano.Api.Hash
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Json (toRationalJSON)
import           Cardano.Api.Keys.Byron
import           Cardano.Api.Keys.Shelley
import           Cardano.Api.Orphans ()
import           Cardano.Api.Pretty
import           Cardano.Api.Script
import           Cardano.Api.SerialiseCBOR
import           Cardano.Api.SerialiseRaw
import           Cardano.Api.SerialiseTextEnvelope
import           Cardano.Api.SerialiseUsing
import           Cardano.Api.StakePoolMetadata
import           Cardano.Api.TxMetadata
import           Cardano.Api.Utils
import           Cardano.Api.Value

import qualified Cardano.Binary as CBOR
import qualified Cardano.Crypto.Hash.Class as Crypto
import qualified Cardano.Ledger.Alonzo.PParams as Ledger
import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
import qualified Cardano.Ledger.Api.Era as Ledger
import           Cardano.Ledger.Api.PParams
import qualified Cardano.Ledger.Babbage.Core as Ledger
import           Cardano.Ledger.BaseTypes (strictMaybeToMaybe)
import qualified Cardano.Ledger.BaseTypes as Ledger
import qualified Cardano.Ledger.Coin as L
import qualified Cardano.Ledger.Conway.PParams as Ledger
import           Cardano.Ledger.Crypto (StandardCrypto)
import qualified Cardano.Ledger.Keys as Ledger
import qualified Cardano.Ledger.Plutus.CostModels as Plutus
import qualified Cardano.Ledger.Plutus.Language as Plutus
import qualified Cardano.Ledger.Shelley.API as Ledger
import           Cardano.Slotting.Slot (EpochNo (..))
import           PlutusLedgerApi.Common (CostModelApplyError)

import           Control.Monad
import           Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.!=), (.:), (.:?),
                   (.=))
import           Data.Bifunctor (bimap, first)
import           Data.ByteString (ByteString)
import           Data.Data (Data)
import           Data.Either.Combinators (maybeToRight)
import           Data.Int (Int64)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (isJust)
import           Data.Maybe.Strict (StrictMaybe (..))
import           Data.String (IsString)
import           Data.Text (Text)
import           Data.Word
import           GHC.Exts (IsList (..))
import           GHC.Generics
import           Lens.Micro
import           Numeric.Natural
import           Text.PrettyBy.Default (display)

-- -----------------------------------------------------------------------------
-- Era based ledger protocol parameters
--
newtype LedgerProtocolParameters era = LedgerProtocolParameters
  { forall era.
LedgerProtocolParameters era -> PParams (ShelleyLedgerEra era)
unLedgerProtocolParameters :: Ledger.PParams (ShelleyLedgerEra era)
  }

instance IsShelleyBasedEra era => Show (LedgerProtocolParameters era) where
  show :: LedgerProtocolParameters era -> String
show (LedgerProtocolParameters PParams (ShelleyLedgerEra era)
pp) =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => String) -> String
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ((ShelleyBasedEraConstraints era => String) -> String)
-> (ShelleyBasedEraConstraints era => String) -> String
forall a b. (a -> b) -> a -> b
$
      PParams (ShelleyLedgerEra era) -> String
forall a. Show a => a -> String
show PParams (ShelleyLedgerEra era)
pp

instance IsShelleyBasedEra era => Eq (LedgerProtocolParameters era) where
  LedgerProtocolParameters PParams (ShelleyLedgerEra era)
a == :: LedgerProtocolParameters era
-> LedgerProtocolParameters era -> Bool
== LedgerProtocolParameters PParams (ShelleyLedgerEra era)
b =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Bool) -> Bool
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ((ShelleyBasedEraConstraints era => Bool) -> Bool)
-> (ShelleyBasedEraConstraints era => Bool) -> Bool
forall a b. (a -> b) -> a -> b
$
      PParams (ShelleyLedgerEra era)
a PParams (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era) -> Bool
forall a. Eq a => a -> a -> Bool
== PParams (ShelleyLedgerEra era)
b

{-# DEPRECATED
  convertToLedgerProtocolParameters
  "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork."
  #-}
convertToLedgerProtocolParameters
  :: ShelleyBasedEra era
  -> ProtocolParameters
  -> Either ProtocolParametersConversionError (LedgerProtocolParameters era)
convertToLedgerProtocolParameters :: forall era.
ShelleyBasedEra era
-> ProtocolParameters
-> Either
     ProtocolParametersConversionError (LedgerProtocolParameters era)
convertToLedgerProtocolParameters ShelleyBasedEra era
sbe ProtocolParameters
pp =
  PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
forall era.
PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
LedgerProtocolParameters (PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era)
-> Either
     ProtocolParametersConversionError (PParams (ShelleyLedgerEra era))
-> Either
     ProtocolParametersConversionError (LedgerProtocolParameters era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShelleyBasedEra era
-> ProtocolParameters
-> Either
     ProtocolParametersConversionError (PParams (ShelleyLedgerEra era))
forall era.
ShelleyBasedEra era
-> ProtocolParameters
-> Either
     ProtocolParametersConversionError (PParams (ShelleyLedgerEra era))
toLedgerPParams ShelleyBasedEra era
sbe ProtocolParameters
pp

createPParams
  :: ShelleyBasedEra era
  -> EraBasedProtocolParametersUpdate era
  -> Ledger.PParams (ShelleyLedgerEra era)
createPParams :: forall era.
ShelleyBasedEra era
-> EraBasedProtocolParametersUpdate era
-> PParams (ShelleyLedgerEra era)
createPParams ShelleyBasedEra era
sbe EraBasedProtocolParametersUpdate era
ebPParamsUpdate =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => PParams (ShelleyLedgerEra era))
 -> PParams (ShelleyLedgerEra era))
-> (ShelleyBasedEraConstraints era =>
    PParams (ShelleyLedgerEra era))
-> PParams (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
    let ppUp :: PParamsUpdate (ShelleyLedgerEra era)
ppUp = ShelleyBasedEra era
-> EraBasedProtocolParametersUpdate era
-> PParamsUpdate (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era
-> EraBasedProtocolParametersUpdate era
-> PParamsUpdate (ShelleyLedgerEra era)
createEraBasedProtocolParamUpdate ShelleyBasedEra era
sbe EraBasedProtocolParametersUpdate era
ebPParamsUpdate
     in PParams (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
-> PParams (ShelleyLedgerEra era)
forall era.
EraPParams era =>
PParams era -> PParamsUpdate era -> PParams era
Ledger.applyPPUpdates PParams (ShelleyLedgerEra era)
forall era. EraPParams era => PParams era
emptyPParams PParamsUpdate (ShelleyLedgerEra era)
ppUp

-- -----------------------------------------------------------------------------
-- Era based Ledger protocol parameters update
--

-- | Each constructor corresponds to the set of protocol parameters available
-- in a given era.
data EraBasedProtocolParametersUpdate era where
  ShelleyEraBasedProtocolParametersUpdate
    :: CommonProtocolParametersUpdate
    -> DeprecatedAfterMaryPParams ShelleyEra
    -> DeprecatedAfterBabbagePParams ShelleyEra
    -> ShelleyToAlonzoPParams ShelleyEra
    -> EraBasedProtocolParametersUpdate ShelleyEra
  AllegraEraBasedProtocolParametersUpdate
    :: CommonProtocolParametersUpdate
    -> DeprecatedAfterMaryPParams AllegraEra
    -> ShelleyToAlonzoPParams AllegraEra
    -> DeprecatedAfterBabbagePParams ShelleyEra
    -> EraBasedProtocolParametersUpdate AllegraEra
  MaryEraBasedProtocolParametersUpdate
    :: CommonProtocolParametersUpdate
    -> DeprecatedAfterMaryPParams MaryEra
    -> ShelleyToAlonzoPParams MaryEra
    -> DeprecatedAfterBabbagePParams ShelleyEra
    -> EraBasedProtocolParametersUpdate MaryEra
  AlonzoEraBasedProtocolParametersUpdate
    :: CommonProtocolParametersUpdate
    -> ShelleyToAlonzoPParams AlonzoEra
    -> AlonzoOnwardsPParams AlonzoEra
    -> DeprecatedAfterBabbagePParams ShelleyEra
    -> EraBasedProtocolParametersUpdate AlonzoEra
  BabbageEraBasedProtocolParametersUpdate
    :: CommonProtocolParametersUpdate
    -> AlonzoOnwardsPParams BabbageEra
    -> DeprecatedAfterBabbagePParams ShelleyEra
    -> IntroducedInBabbagePParams BabbageEra
    -> EraBasedProtocolParametersUpdate BabbageEra
  ConwayEraBasedProtocolParametersUpdate
    :: CommonProtocolParametersUpdate
    -> AlonzoOnwardsPParams ConwayEra
    -> IntroducedInBabbagePParams ConwayEra
    -> IntroducedInConwayPParams (ShelleyLedgerEra ConwayEra)
    -> EraBasedProtocolParametersUpdate ConwayEra

deriving instance Show (EraBasedProtocolParametersUpdate era)

data IntroducedInConwayPParams era
  = IntroducedInConwayPParams
  { forall era.
IntroducedInConwayPParams era -> StrictMaybe PoolVotingThresholds
icPoolVotingThresholds :: StrictMaybe Ledger.PoolVotingThresholds
  , forall era.
IntroducedInConwayPParams era -> StrictMaybe DRepVotingThresholds
icDRepVotingThresholds :: StrictMaybe Ledger.DRepVotingThresholds
  , forall era. IntroducedInConwayPParams era -> StrictMaybe Natural
icMinCommitteeSize :: StrictMaybe Natural
  , forall era.
IntroducedInConwayPParams era -> StrictMaybe EpochInterval
icCommitteeTermLength :: StrictMaybe Ledger.EpochInterval
  , forall era.
IntroducedInConwayPParams era -> StrictMaybe EpochInterval
icGovActionLifetime :: StrictMaybe Ledger.EpochInterval
  , forall era. IntroducedInConwayPParams era -> StrictMaybe Coin
icGovActionDeposit :: StrictMaybe Ledger.Coin
  , forall era. IntroducedInConwayPParams era -> StrictMaybe Coin
icDRepDeposit :: StrictMaybe Ledger.Coin
  , forall era.
IntroducedInConwayPParams era -> StrictMaybe EpochInterval
icDRepActivity :: StrictMaybe Ledger.EpochInterval
  , forall era.
IntroducedInConwayPParams era -> StrictMaybe NonNegativeInterval
icMinFeeRefScriptCostPerByte :: StrictMaybe Ledger.NonNegativeInterval
  }
  deriving Int -> IntroducedInConwayPParams era -> ShowS
[IntroducedInConwayPParams era] -> ShowS
IntroducedInConwayPParams era -> String
(Int -> IntroducedInConwayPParams era -> ShowS)
-> (IntroducedInConwayPParams era -> String)
-> ([IntroducedInConwayPParams era] -> ShowS)
-> Show (IntroducedInConwayPParams era)
forall era. Int -> IntroducedInConwayPParams era -> ShowS
forall era. [IntroducedInConwayPParams era] -> ShowS
forall era. IntroducedInConwayPParams era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> IntroducedInConwayPParams era -> ShowS
showsPrec :: Int -> IntroducedInConwayPParams era -> ShowS
$cshow :: forall era. IntroducedInConwayPParams era -> String
show :: IntroducedInConwayPParams era -> String
$cshowList :: forall era. [IntroducedInConwayPParams era] -> ShowS
showList :: [IntroducedInConwayPParams era] -> ShowS
Show

createIntroducedInConwayPParams
  :: Ledger.ConwayEraPParams ledgerera
  => IntroducedInConwayPParams ledgerera
  -> Ledger.PParamsUpdate ledgerera
createIntroducedInConwayPParams :: forall ledgerera.
ConwayEraPParams ledgerera =>
IntroducedInConwayPParams ledgerera -> PParamsUpdate ledgerera
createIntroducedInConwayPParams IntroducedInConwayPParams{StrictMaybe Natural
StrictMaybe Coin
StrictMaybe DRepVotingThresholds
StrictMaybe PoolVotingThresholds
StrictMaybe EpochInterval
StrictMaybe NonNegativeInterval
icPoolVotingThresholds :: forall era.
IntroducedInConwayPParams era -> StrictMaybe PoolVotingThresholds
icDRepVotingThresholds :: forall era.
IntroducedInConwayPParams era -> StrictMaybe DRepVotingThresholds
icMinCommitteeSize :: forall era. IntroducedInConwayPParams era -> StrictMaybe Natural
icCommitteeTermLength :: forall era.
IntroducedInConwayPParams era -> StrictMaybe EpochInterval
icGovActionLifetime :: forall era.
IntroducedInConwayPParams era -> StrictMaybe EpochInterval
icGovActionDeposit :: forall era. IntroducedInConwayPParams era -> StrictMaybe Coin
icDRepDeposit :: forall era. IntroducedInConwayPParams era -> StrictMaybe Coin
icDRepActivity :: forall era.
IntroducedInConwayPParams era -> StrictMaybe EpochInterval
icMinFeeRefScriptCostPerByte :: forall era.
IntroducedInConwayPParams era -> StrictMaybe NonNegativeInterval
icPoolVotingThresholds :: StrictMaybe PoolVotingThresholds
icDRepVotingThresholds :: StrictMaybe DRepVotingThresholds
icMinCommitteeSize :: StrictMaybe Natural
icCommitteeTermLength :: StrictMaybe EpochInterval
icGovActionLifetime :: StrictMaybe EpochInterval
icGovActionDeposit :: StrictMaybe Coin
icDRepDeposit :: StrictMaybe Coin
icDRepActivity :: StrictMaybe EpochInterval
icMinFeeRefScriptCostPerByte :: StrictMaybe NonNegativeInterval
..} =
  PParamsUpdate ledgerera
forall era. EraPParams era => PParamsUpdate era
Ledger.emptyPParamsUpdate
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe PoolVotingThresholds
 -> Identity (StrictMaybe PoolVotingThresholds))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe PoolVotingThresholds)
Lens' (PParamsUpdate ledgerera) (StrictMaybe PoolVotingThresholds)
Ledger.ppuPoolVotingThresholdsL ((StrictMaybe PoolVotingThresholds
  -> Identity (StrictMaybe PoolVotingThresholds))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe PoolVotingThresholds
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe PoolVotingThresholds
icPoolVotingThresholds
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe DRepVotingThresholds
 -> Identity (StrictMaybe DRepVotingThresholds))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe DRepVotingThresholds)
Lens' (PParamsUpdate ledgerera) (StrictMaybe DRepVotingThresholds)
Ledger.ppuDRepVotingThresholdsL ((StrictMaybe DRepVotingThresholds
  -> Identity (StrictMaybe DRepVotingThresholds))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe DRepVotingThresholds
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe DRepVotingThresholds
icDRepVotingThresholds
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Natural -> Identity (StrictMaybe Natural))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Natural)
Ledger.ppuCommitteeMinSizeL ((StrictMaybe Natural -> Identity (StrictMaybe Natural))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Natural
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Natural
icMinCommitteeSize
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe EpochInterval -> Identity (StrictMaybe EpochInterval))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe EpochInterval)
Ledger.ppuCommitteeMaxTermLengthL ((StrictMaybe EpochInterval
  -> Identity (StrictMaybe EpochInterval))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe EpochInterval
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe EpochInterval
icCommitteeTermLength
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe EpochInterval -> Identity (StrictMaybe EpochInterval))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe EpochInterval)
Ledger.ppuGovActionLifetimeL ((StrictMaybe EpochInterval
  -> Identity (StrictMaybe EpochInterval))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe EpochInterval
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe EpochInterval
icGovActionLifetime
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
Ledger.ppuGovActionDepositL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Coin
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
icGovActionDeposit
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
Ledger.ppuDRepDepositL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Coin
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
icDRepDeposit
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe EpochInterval -> Identity (StrictMaybe EpochInterval))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe EpochInterval)
Ledger.ppuDRepActivityL ((StrictMaybe EpochInterval
  -> Identity (StrictMaybe EpochInterval))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe EpochInterval
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe EpochInterval
icDRepActivity
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe NonNegativeInterval
 -> Identity (StrictMaybe NonNegativeInterval))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe NonNegativeInterval)
Ledger.ppuMinFeeRefScriptCostPerByteL ((StrictMaybe NonNegativeInterval
  -> Identity (StrictMaybe NonNegativeInterval))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe NonNegativeInterval
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe NonNegativeInterval
icMinFeeRefScriptCostPerByte

createEraBasedProtocolParamUpdate
  :: ShelleyBasedEra era
  -> EraBasedProtocolParametersUpdate era
  -> Ledger.PParamsUpdate (ShelleyLedgerEra era)
createEraBasedProtocolParamUpdate :: forall era.
ShelleyBasedEra era
-> EraBasedProtocolParametersUpdate era
-> PParamsUpdate (ShelleyLedgerEra era)
createEraBasedProtocolParamUpdate ShelleyBasedEra era
sbe EraBasedProtocolParametersUpdate era
eraPParamsUpdate =
  case EraBasedProtocolParametersUpdate era
eraPParamsUpdate of
    ShelleyEraBasedProtocolParametersUpdate CommonProtocolParametersUpdate
c DeprecatedAfterMaryPParams ShelleyEra
depAfterMary DeprecatedAfterBabbagePParams ShelleyEra
depAfterBabbage ShelleyToAlonzoPParams ShelleyEra
depAfterAlonzo ->
      let Ledger.PParamsUpdate PParamsHKD StrictMaybe (ShelleyEra StandardCrypto)
common = CommonProtocolParametersUpdate
-> PParamsUpdate (ShelleyEra StandardCrypto)
forall ledgerera.
EraPParams ledgerera =>
CommonProtocolParametersUpdate -> PParamsUpdate ledgerera
createCommonPParamsUpdate CommonProtocolParametersUpdate
c
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (ShelleyEra StandardCrypto)
withProtVer = DeprecatedAfterBabbagePParams ShelleyEra
-> PParamsUpdate (ShelleyEra StandardCrypto)
forall ledgerera cppProtocolVersion.
(EraPParams ledgerera, ProtVerAtMost ledgerera 8) =>
DeprecatedAfterBabbagePParams cppProtocolVersion
-> PParamsUpdate ledgerera
createPreConwayProtocolVersionUpdate DeprecatedAfterBabbagePParams ShelleyEra
depAfterBabbage
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (ShelleyLedgerEra era)
depAfterMary' = ShelleyBasedEra era
-> DeprecatedAfterMaryPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
forall era.
(EraPParams (ShelleyLedgerEra era),
 MaxMaryEra (ShelleyLedgerEra era)) =>
ShelleyBasedEra era
-> DeprecatedAfterMaryPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
createDeprecatedAfterMaryPParams ShelleyBasedEra era
sbe DeprecatedAfterMaryPParams era
DeprecatedAfterMaryPParams ShelleyEra
depAfterMary
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (ShelleyLedgerEra era)
depAfterAlonzo' = ShelleyBasedEra era
-> ShelleyToAlonzoPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
forall era.
(EraPParams (ShelleyLedgerEra era),
 MaxAlonzoEra (ShelleyLedgerEra era)) =>
ShelleyBasedEra era
-> ShelleyToAlonzoPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
createDeprecatedAfterAlonzoPParams ShelleyBasedEra era
sbe ShelleyToAlonzoPParams era
ShelleyToAlonzoPParams ShelleyEra
depAfterAlonzo
       in PParamsHKD StrictMaybe (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall era. PParamsHKD StrictMaybe era -> PParamsUpdate era
Ledger.PParamsUpdate (PParamsHKD StrictMaybe (ShelleyLedgerEra era)
 -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsHKD StrictMaybe (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ PParamsHKD StrictMaybe (ShelleyEra StandardCrypto)
ShelleyPParams StrictMaybe (ShelleyEra StandardCrypto)
common ShelleyPParams StrictMaybe (ShelleyEra StandardCrypto)
-> ShelleyPParams StrictMaybe (ShelleyEra StandardCrypto)
-> ShelleyPParams StrictMaybe (ShelleyEra StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (ShelleyEra StandardCrypto)
ShelleyPParams StrictMaybe (ShelleyEra StandardCrypto)
withProtVer ShelleyPParams StrictMaybe (ShelleyEra StandardCrypto)
-> ShelleyPParams StrictMaybe (ShelleyEra StandardCrypto)
-> ShelleyPParams StrictMaybe (ShelleyEra StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (ShelleyLedgerEra era)
ShelleyPParams StrictMaybe (ShelleyEra StandardCrypto)
depAfterMary' ShelleyPParams StrictMaybe (ShelleyEra StandardCrypto)
-> ShelleyPParams StrictMaybe (ShelleyEra StandardCrypto)
-> ShelleyPParams StrictMaybe (ShelleyEra StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (ShelleyLedgerEra era)
ShelleyPParams StrictMaybe (ShelleyEra StandardCrypto)
depAfterAlonzo'
    AllegraEraBasedProtocolParametersUpdate CommonProtocolParametersUpdate
c DeprecatedAfterMaryPParams AllegraEra
depAfterMary ShelleyToAlonzoPParams AllegraEra
depAfterAlonzo DeprecatedAfterBabbagePParams ShelleyEra
depAfterBabbage ->
      let Ledger.PParamsUpdate PParamsHKD StrictMaybe (AllegraEra StandardCrypto)
common = CommonProtocolParametersUpdate
-> PParamsUpdate (AllegraEra StandardCrypto)
forall ledgerera.
EraPParams ledgerera =>
CommonProtocolParametersUpdate -> PParamsUpdate ledgerera
createCommonPParamsUpdate CommonProtocolParametersUpdate
c
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (AllegraEra StandardCrypto)
withProtVer = DeprecatedAfterBabbagePParams ShelleyEra
-> PParamsUpdate (AllegraEra StandardCrypto)
forall ledgerera cppProtocolVersion.
(EraPParams ledgerera, ProtVerAtMost ledgerera 8) =>
DeprecatedAfterBabbagePParams cppProtocolVersion
-> PParamsUpdate ledgerera
createPreConwayProtocolVersionUpdate DeprecatedAfterBabbagePParams ShelleyEra
depAfterBabbage
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (ShelleyLedgerEra era)
depAfterMary' = ShelleyBasedEra era
-> DeprecatedAfterMaryPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
forall era.
(EraPParams (ShelleyLedgerEra era),
 MaxMaryEra (ShelleyLedgerEra era)) =>
ShelleyBasedEra era
-> DeprecatedAfterMaryPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
createDeprecatedAfterMaryPParams ShelleyBasedEra era
sbe DeprecatedAfterMaryPParams era
DeprecatedAfterMaryPParams AllegraEra
depAfterMary
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (ShelleyLedgerEra era)
depAfterAlonzo' = ShelleyBasedEra era
-> ShelleyToAlonzoPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
forall era.
(EraPParams (ShelleyLedgerEra era),
 MaxAlonzoEra (ShelleyLedgerEra era)) =>
ShelleyBasedEra era
-> ShelleyToAlonzoPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
createDeprecatedAfterAlonzoPParams ShelleyBasedEra era
sbe ShelleyToAlonzoPParams era
ShelleyToAlonzoPParams AllegraEra
depAfterAlonzo
       in PParamsHKD StrictMaybe (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall era. PParamsHKD StrictMaybe era -> PParamsUpdate era
Ledger.PParamsUpdate (PParamsHKD StrictMaybe (ShelleyLedgerEra era)
 -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsHKD StrictMaybe (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ PParamsHKD StrictMaybe (AllegraEra StandardCrypto)
ShelleyPParams StrictMaybe (AllegraEra StandardCrypto)
common ShelleyPParams StrictMaybe (AllegraEra StandardCrypto)
-> ShelleyPParams StrictMaybe (AllegraEra StandardCrypto)
-> ShelleyPParams StrictMaybe (AllegraEra StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (AllegraEra StandardCrypto)
ShelleyPParams StrictMaybe (AllegraEra StandardCrypto)
withProtVer ShelleyPParams StrictMaybe (AllegraEra StandardCrypto)
-> ShelleyPParams StrictMaybe (AllegraEra StandardCrypto)
-> ShelleyPParams StrictMaybe (AllegraEra StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (ShelleyLedgerEra era)
ShelleyPParams StrictMaybe (AllegraEra StandardCrypto)
depAfterMary' ShelleyPParams StrictMaybe (AllegraEra StandardCrypto)
-> ShelleyPParams StrictMaybe (AllegraEra StandardCrypto)
-> ShelleyPParams StrictMaybe (AllegraEra StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (ShelleyLedgerEra era)
ShelleyPParams StrictMaybe (AllegraEra StandardCrypto)
depAfterAlonzo'
    MaryEraBasedProtocolParametersUpdate CommonProtocolParametersUpdate
c DeprecatedAfterMaryPParams MaryEra
depAfterMary ShelleyToAlonzoPParams MaryEra
depAfterAlonzo DeprecatedAfterBabbagePParams ShelleyEra
depAfterBabbage ->
      let Ledger.PParamsUpdate PParamsHKD StrictMaybe (MaryEra StandardCrypto)
common = CommonProtocolParametersUpdate
-> PParamsUpdate (MaryEra StandardCrypto)
forall ledgerera.
EraPParams ledgerera =>
CommonProtocolParametersUpdate -> PParamsUpdate ledgerera
createCommonPParamsUpdate CommonProtocolParametersUpdate
c
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (MaryEra StandardCrypto)
withProtVer = DeprecatedAfterBabbagePParams ShelleyEra
-> PParamsUpdate (MaryEra StandardCrypto)
forall ledgerera cppProtocolVersion.
(EraPParams ledgerera, ProtVerAtMost ledgerera 8) =>
DeprecatedAfterBabbagePParams cppProtocolVersion
-> PParamsUpdate ledgerera
createPreConwayProtocolVersionUpdate DeprecatedAfterBabbagePParams ShelleyEra
depAfterBabbage
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (ShelleyLedgerEra era)
depAfterMary' = ShelleyBasedEra era
-> DeprecatedAfterMaryPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
forall era.
(EraPParams (ShelleyLedgerEra era),
 MaxMaryEra (ShelleyLedgerEra era)) =>
ShelleyBasedEra era
-> DeprecatedAfterMaryPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
createDeprecatedAfterMaryPParams ShelleyBasedEra era
sbe DeprecatedAfterMaryPParams era
DeprecatedAfterMaryPParams MaryEra
depAfterMary
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (ShelleyLedgerEra era)
depAfterAlonzo' = ShelleyBasedEra era
-> ShelleyToAlonzoPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
forall era.
(EraPParams (ShelleyLedgerEra era),
 MaxAlonzoEra (ShelleyLedgerEra era)) =>
ShelleyBasedEra era
-> ShelleyToAlonzoPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
createDeprecatedAfterAlonzoPParams ShelleyBasedEra era
sbe ShelleyToAlonzoPParams era
ShelleyToAlonzoPParams MaryEra
depAfterAlonzo
       in PParamsHKD StrictMaybe (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall era. PParamsHKD StrictMaybe era -> PParamsUpdate era
Ledger.PParamsUpdate (PParamsHKD StrictMaybe (ShelleyLedgerEra era)
 -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsHKD StrictMaybe (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ PParamsHKD StrictMaybe (MaryEra StandardCrypto)
ShelleyPParams StrictMaybe (MaryEra StandardCrypto)
common ShelleyPParams StrictMaybe (MaryEra StandardCrypto)
-> ShelleyPParams StrictMaybe (MaryEra StandardCrypto)
-> ShelleyPParams StrictMaybe (MaryEra StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (MaryEra StandardCrypto)
ShelleyPParams StrictMaybe (MaryEra StandardCrypto)
withProtVer ShelleyPParams StrictMaybe (MaryEra StandardCrypto)
-> ShelleyPParams StrictMaybe (MaryEra StandardCrypto)
-> ShelleyPParams StrictMaybe (MaryEra StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (ShelleyLedgerEra era)
ShelleyPParams StrictMaybe (MaryEra StandardCrypto)
depAfterMary' ShelleyPParams StrictMaybe (MaryEra StandardCrypto)
-> ShelleyPParams StrictMaybe (MaryEra StandardCrypto)
-> ShelleyPParams StrictMaybe (MaryEra StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (ShelleyLedgerEra era)
ShelleyPParams StrictMaybe (MaryEra StandardCrypto)
depAfterAlonzo'
    AlonzoEraBasedProtocolParametersUpdate CommonProtocolParametersUpdate
c ShelleyToAlonzoPParams AlonzoEra
depAfterAlonzoA AlonzoOnwardsPParams AlonzoEra
introInAlon DeprecatedAfterBabbagePParams ShelleyEra
depAfterBabbage ->
      let Ledger.PParamsUpdate PParamsHKD StrictMaybe (AlonzoEra StandardCrypto)
common = CommonProtocolParametersUpdate
-> PParamsUpdate (AlonzoEra StandardCrypto)
forall ledgerera.
EraPParams ledgerera =>
CommonProtocolParametersUpdate -> PParamsUpdate ledgerera
createCommonPParamsUpdate CommonProtocolParametersUpdate
c
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (AlonzoEra StandardCrypto)
withProtVer = DeprecatedAfterBabbagePParams ShelleyEra
-> PParamsUpdate (AlonzoEra StandardCrypto)
forall ledgerera cppProtocolVersion.
(EraPParams ledgerera, ProtVerAtMost ledgerera 8) =>
DeprecatedAfterBabbagePParams cppProtocolVersion
-> PParamsUpdate ledgerera
createPreConwayProtocolVersionUpdate DeprecatedAfterBabbagePParams ShelleyEra
depAfterBabbage
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (ShelleyLedgerEra AlonzoEra)
preAl' = AlonzoEraOnwards AlonzoEra
-> AlonzoOnwardsPParams AlonzoEra
-> PParamsUpdate (ShelleyLedgerEra AlonzoEra)
forall era.
AlonzoEraOnwards era
-> AlonzoOnwardsPParams era -> PParamsUpdate (ShelleyLedgerEra era)
createPParamsUpdateIntroducedInAlonzo AlonzoEraOnwards AlonzoEra
AlonzoEraOnwardsAlonzo AlonzoOnwardsPParams AlonzoEra
introInAlon
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (ShelleyLedgerEra era)
depAfterAlonzoA' = ShelleyBasedEra era
-> ShelleyToAlonzoPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
forall era.
(EraPParams (ShelleyLedgerEra era),
 MaxAlonzoEra (ShelleyLedgerEra era)) =>
ShelleyBasedEra era
-> ShelleyToAlonzoPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
createDeprecatedAfterAlonzoPParams ShelleyBasedEra era
sbe ShelleyToAlonzoPParams era
ShelleyToAlonzoPParams AlonzoEra
depAfterAlonzoA
       in PParamsHKD StrictMaybe (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall era. PParamsHKD StrictMaybe era -> PParamsUpdate era
Ledger.PParamsUpdate (PParamsHKD StrictMaybe (ShelleyLedgerEra era)
 -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsHKD StrictMaybe (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ PParamsHKD StrictMaybe (AlonzoEra StandardCrypto)
AlonzoPParams StrictMaybe (AlonzoEra StandardCrypto)
common AlonzoPParams StrictMaybe (AlonzoEra StandardCrypto)
-> AlonzoPParams StrictMaybe (AlonzoEra StandardCrypto)
-> AlonzoPParams StrictMaybe (AlonzoEra StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (AlonzoEra StandardCrypto)
AlonzoPParams StrictMaybe (AlonzoEra StandardCrypto)
withProtVer AlonzoPParams StrictMaybe (AlonzoEra StandardCrypto)
-> AlonzoPParams StrictMaybe (AlonzoEra StandardCrypto)
-> AlonzoPParams StrictMaybe (AlonzoEra StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (ShelleyLedgerEra AlonzoEra)
AlonzoPParams StrictMaybe (AlonzoEra StandardCrypto)
preAl' AlonzoPParams StrictMaybe (AlonzoEra StandardCrypto)
-> AlonzoPParams StrictMaybe (AlonzoEra StandardCrypto)
-> AlonzoPParams StrictMaybe (AlonzoEra StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (ShelleyLedgerEra era)
AlonzoPParams StrictMaybe (AlonzoEra StandardCrypto)
depAfterAlonzoA'
    BabbageEraBasedProtocolParametersUpdate CommonProtocolParametersUpdate
c AlonzoOnwardsPParams BabbageEra
introInAlonzo DeprecatedAfterBabbagePParams ShelleyEra
depAfterBabbage IntroducedInBabbagePParams BabbageEra
introInBabbage ->
      let Ledger.PParamsUpdate PParamsHKD StrictMaybe (BabbageEra StandardCrypto)
common = CommonProtocolParametersUpdate
-> PParamsUpdate (BabbageEra StandardCrypto)
forall ledgerera.
EraPParams ledgerera =>
CommonProtocolParametersUpdate -> PParamsUpdate ledgerera
createCommonPParamsUpdate CommonProtocolParametersUpdate
c
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (BabbageEra StandardCrypto)
withProtVer = DeprecatedAfterBabbagePParams ShelleyEra
-> PParamsUpdate (BabbageEra StandardCrypto)
forall ledgerera cppProtocolVersion.
(EraPParams ledgerera, ProtVerAtMost ledgerera 8) =>
DeprecatedAfterBabbagePParams cppProtocolVersion
-> PParamsUpdate ledgerera
createPreConwayProtocolVersionUpdate DeprecatedAfterBabbagePParams ShelleyEra
depAfterBabbage
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (ShelleyLedgerEra BabbageEra)
inAlonzoPParams = AlonzoEraOnwards BabbageEra
-> AlonzoOnwardsPParams BabbageEra
-> PParamsUpdate (ShelleyLedgerEra BabbageEra)
forall era.
AlonzoEraOnwards era
-> AlonzoOnwardsPParams era -> PParamsUpdate (ShelleyLedgerEra era)
createPParamsUpdateIntroducedInAlonzo AlonzoEraOnwards BabbageEra
AlonzoEraOnwardsBabbage AlonzoOnwardsPParams BabbageEra
introInAlonzo
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (ShelleyLedgerEra BabbageEra)
inBAb = BabbageEraOnwards BabbageEra
-> IntroducedInBabbagePParams BabbageEra
-> PParamsUpdate (ShelleyLedgerEra BabbageEra)
forall era.
BabbageEraOnwards era
-> IntroducedInBabbagePParams era
-> PParamsUpdate (ShelleyLedgerEra era)
createIntroducedInBabbagePParams BabbageEraOnwards BabbageEra
BabbageEraOnwardsBabbage IntroducedInBabbagePParams BabbageEra
introInBabbage
       in PParamsHKD StrictMaybe (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall era. PParamsHKD StrictMaybe era -> PParamsUpdate era
Ledger.PParamsUpdate (PParamsHKD StrictMaybe (ShelleyLedgerEra era)
 -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsHKD StrictMaybe (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ PParamsHKD StrictMaybe (BabbageEra StandardCrypto)
BabbagePParams StrictMaybe (BabbageEra StandardCrypto)
common BabbagePParams StrictMaybe (BabbageEra StandardCrypto)
-> BabbagePParams StrictMaybe (BabbageEra StandardCrypto)
-> BabbagePParams StrictMaybe (BabbageEra StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (BabbageEra StandardCrypto)
BabbagePParams StrictMaybe (BabbageEra StandardCrypto)
withProtVer BabbagePParams StrictMaybe (BabbageEra StandardCrypto)
-> BabbagePParams StrictMaybe (BabbageEra StandardCrypto)
-> BabbagePParams StrictMaybe (BabbageEra StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (ShelleyLedgerEra BabbageEra)
BabbagePParams StrictMaybe (BabbageEra StandardCrypto)
inAlonzoPParams BabbagePParams StrictMaybe (BabbageEra StandardCrypto)
-> BabbagePParams StrictMaybe (BabbageEra StandardCrypto)
-> BabbagePParams StrictMaybe (BabbageEra StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (ShelleyLedgerEra BabbageEra)
BabbagePParams StrictMaybe (BabbageEra StandardCrypto)
inBAb
    ConwayEraBasedProtocolParametersUpdate CommonProtocolParametersUpdate
c AlonzoOnwardsPParams ConwayEra
introInAlonzo IntroducedInBabbagePParams ConwayEra
introInBabbage IntroducedInConwayPParams (ShelleyLedgerEra ConwayEra)
introInConway ->
      let Ledger.PParamsUpdate PParamsHKD StrictMaybe StandardConway
common = CommonProtocolParametersUpdate -> PParamsUpdate StandardConway
forall ledgerera.
EraPParams ledgerera =>
CommonProtocolParametersUpdate -> PParamsUpdate ledgerera
createCommonPParamsUpdate CommonProtocolParametersUpdate
c
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (ShelleyLedgerEra ConwayEra)
inAlonzoPParams = AlonzoEraOnwards ConwayEra
-> AlonzoOnwardsPParams ConwayEra
-> PParamsUpdate (ShelleyLedgerEra ConwayEra)
forall era.
AlonzoEraOnwards era
-> AlonzoOnwardsPParams era -> PParamsUpdate (ShelleyLedgerEra era)
createPParamsUpdateIntroducedInAlonzo AlonzoEraOnwards ConwayEra
AlonzoEraOnwardsConway AlonzoOnwardsPParams ConwayEra
introInAlonzo
          Ledger.PParamsUpdate PParamsHKD StrictMaybe (ShelleyLedgerEra ConwayEra)
inBab = BabbageEraOnwards ConwayEra
-> IntroducedInBabbagePParams ConwayEra
-> PParamsUpdate (ShelleyLedgerEra ConwayEra)
forall era.
BabbageEraOnwards era
-> IntroducedInBabbagePParams era
-> PParamsUpdate (ShelleyLedgerEra era)
createIntroducedInBabbagePParams BabbageEraOnwards ConwayEra
BabbageEraOnwardsConway IntroducedInBabbagePParams ConwayEra
introInBabbage
          Ledger.PParamsUpdate PParamsHKD StrictMaybe StandardConway
inCon = IntroducedInConwayPParams StandardConway
-> PParamsUpdate StandardConway
forall ledgerera.
ConwayEraPParams ledgerera =>
IntroducedInConwayPParams ledgerera -> PParamsUpdate ledgerera
createIntroducedInConwayPParams IntroducedInConwayPParams StandardConway
IntroducedInConwayPParams (ShelleyLedgerEra ConwayEra)
introInConway
       in PParamsHKD StrictMaybe (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall era. PParamsHKD StrictMaybe era -> PParamsUpdate era
Ledger.PParamsUpdate (PParamsHKD StrictMaybe (ShelleyLedgerEra era)
 -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsHKD StrictMaybe (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ PParamsHKD StrictMaybe StandardConway
ConwayPParams StrictMaybe StandardConway
common ConwayPParams StrictMaybe StandardConway
-> ConwayPParams StrictMaybe StandardConway
-> ConwayPParams StrictMaybe StandardConway
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (ShelleyLedgerEra ConwayEra)
ConwayPParams StrictMaybe StandardConway
inAlonzoPParams ConwayPParams StrictMaybe StandardConway
-> ConwayPParams StrictMaybe StandardConway
-> ConwayPParams StrictMaybe StandardConway
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe (ShelleyLedgerEra ConwayEra)
ConwayPParams StrictMaybe StandardConway
inBab ConwayPParams StrictMaybe StandardConway
-> ConwayPParams StrictMaybe StandardConway
-> ConwayPParams StrictMaybe StandardConway
forall a. Semigroup a => a -> a -> a
<> PParamsHKD StrictMaybe StandardConway
ConwayPParams StrictMaybe StandardConway
inCon

-- | Protocol parameters common to each era. This can only ever be reduced
-- if parameters are deprecated.
data CommonProtocolParametersUpdate
  = CommonProtocolParametersUpdate
  { CommonProtocolParametersUpdate -> StrictMaybe Coin
cppMinFeeA :: StrictMaybe Ledger.Coin
  , CommonProtocolParametersUpdate -> StrictMaybe Coin
cppMinFeeB :: StrictMaybe Ledger.Coin
  , CommonProtocolParametersUpdate -> StrictMaybe Word32
cppMaxBlockBodySize :: StrictMaybe Word32
  , CommonProtocolParametersUpdate -> StrictMaybe Word32
cppMaxTxSize :: StrictMaybe Word32
  , CommonProtocolParametersUpdate -> StrictMaybe Word16
cppMaxBlockHeaderSize :: StrictMaybe Word16
  , CommonProtocolParametersUpdate -> StrictMaybe Coin
cppKeyDeposit :: StrictMaybe Ledger.Coin
  , CommonProtocolParametersUpdate -> StrictMaybe Coin
cppPoolDeposit :: StrictMaybe Ledger.Coin
  , CommonProtocolParametersUpdate -> StrictMaybe EpochInterval
cppPoolRetireMaxEpoch :: StrictMaybe Ledger.EpochInterval
  , CommonProtocolParametersUpdate -> StrictMaybe Natural
cppStakePoolTargetNum :: StrictMaybe Natural
  , CommonProtocolParametersUpdate -> StrictMaybe NonNegativeInterval
cppPoolPledgeInfluence :: StrictMaybe Ledger.NonNegativeInterval
  , CommonProtocolParametersUpdate -> StrictMaybe UnitInterval
cppTreasuryExpansion :: StrictMaybe Ledger.UnitInterval
  , CommonProtocolParametersUpdate -> StrictMaybe UnitInterval
cppMonetaryExpansion :: StrictMaybe Ledger.UnitInterval
  , CommonProtocolParametersUpdate -> StrictMaybe Coin
cppMinPoolCost :: StrictMaybe Ledger.Coin
  }
  deriving Int -> CommonProtocolParametersUpdate -> ShowS
[CommonProtocolParametersUpdate] -> ShowS
CommonProtocolParametersUpdate -> String
(Int -> CommonProtocolParametersUpdate -> ShowS)
-> (CommonProtocolParametersUpdate -> String)
-> ([CommonProtocolParametersUpdate] -> ShowS)
-> Show CommonProtocolParametersUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommonProtocolParametersUpdate -> ShowS
showsPrec :: Int -> CommonProtocolParametersUpdate -> ShowS
$cshow :: CommonProtocolParametersUpdate -> String
show :: CommonProtocolParametersUpdate -> String
$cshowList :: [CommonProtocolParametersUpdate] -> ShowS
showList :: [CommonProtocolParametersUpdate] -> ShowS
Show

-- | Create a protocol parameters update with parameters common to all eras
createCommonPParamsUpdate
  :: EraPParams ledgerera => CommonProtocolParametersUpdate -> Ledger.PParamsUpdate ledgerera
createCommonPParamsUpdate :: forall ledgerera.
EraPParams ledgerera =>
CommonProtocolParametersUpdate -> PParamsUpdate ledgerera
createCommonPParamsUpdate CommonProtocolParametersUpdate{StrictMaybe Natural
StrictMaybe Word16
StrictMaybe Word32
StrictMaybe Coin
StrictMaybe EpochInterval
StrictMaybe NonNegativeInterval
StrictMaybe UnitInterval
cppMinFeeA :: CommonProtocolParametersUpdate -> StrictMaybe Coin
cppMinFeeB :: CommonProtocolParametersUpdate -> StrictMaybe Coin
cppMaxBlockBodySize :: CommonProtocolParametersUpdate -> StrictMaybe Word32
cppMaxTxSize :: CommonProtocolParametersUpdate -> StrictMaybe Word32
cppMaxBlockHeaderSize :: CommonProtocolParametersUpdate -> StrictMaybe Word16
cppKeyDeposit :: CommonProtocolParametersUpdate -> StrictMaybe Coin
cppPoolDeposit :: CommonProtocolParametersUpdate -> StrictMaybe Coin
cppPoolRetireMaxEpoch :: CommonProtocolParametersUpdate -> StrictMaybe EpochInterval
cppStakePoolTargetNum :: CommonProtocolParametersUpdate -> StrictMaybe Natural
cppPoolPledgeInfluence :: CommonProtocolParametersUpdate -> StrictMaybe NonNegativeInterval
cppTreasuryExpansion :: CommonProtocolParametersUpdate -> StrictMaybe UnitInterval
cppMonetaryExpansion :: CommonProtocolParametersUpdate -> StrictMaybe UnitInterval
cppMinPoolCost :: CommonProtocolParametersUpdate -> StrictMaybe Coin
cppMinFeeA :: StrictMaybe Coin
cppMinFeeB :: StrictMaybe Coin
cppMaxBlockBodySize :: StrictMaybe Word32
cppMaxTxSize :: StrictMaybe Word32
cppMaxBlockHeaderSize :: StrictMaybe Word16
cppKeyDeposit :: StrictMaybe Coin
cppPoolDeposit :: StrictMaybe Coin
cppPoolRetireMaxEpoch :: StrictMaybe EpochInterval
cppStakePoolTargetNum :: StrictMaybe Natural
cppPoolPledgeInfluence :: StrictMaybe NonNegativeInterval
cppTreasuryExpansion :: StrictMaybe UnitInterval
cppMonetaryExpansion :: StrictMaybe UnitInterval
cppMinPoolCost :: StrictMaybe Coin
..} =
  PParamsUpdate ledgerera
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
Ledger.ppuMinFeeAL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Coin
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
cppMinFeeA
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
Ledger.ppuMinFeeBL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Coin
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
cppMinFeeB
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Word32 -> Identity (StrictMaybe Word32))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Word32)
Ledger.ppuMaxBBSizeL ((StrictMaybe Word32 -> Identity (StrictMaybe Word32))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Word32
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Word32
cppMaxBlockBodySize
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Word32 -> Identity (StrictMaybe Word32))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Word32)
Ledger.ppuMaxTxSizeL ((StrictMaybe Word32 -> Identity (StrictMaybe Word32))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Word32
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Word32
cppMaxTxSize
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Word16 -> Identity (StrictMaybe Word16))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Word16)
Ledger.ppuMaxBHSizeL ((StrictMaybe Word16 -> Identity (StrictMaybe Word16))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Word16
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Word16
cppMaxBlockHeaderSize
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
Ledger.ppuKeyDepositL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Coin
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
cppKeyDeposit
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
Ledger.ppuPoolDepositL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Coin
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
cppPoolDeposit
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe EpochInterval -> Identity (StrictMaybe EpochInterval))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe EpochInterval)
Ledger.ppuEMaxL ((StrictMaybe EpochInterval
  -> Identity (StrictMaybe EpochInterval))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe EpochInterval
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe EpochInterval
cppPoolRetireMaxEpoch
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Natural -> Identity (StrictMaybe Natural))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Natural)
Ledger.ppuNOptL ((StrictMaybe Natural -> Identity (StrictMaybe Natural))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Natural
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Natural
cppStakePoolTargetNum
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe NonNegativeInterval
 -> Identity (StrictMaybe NonNegativeInterval))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe NonNegativeInterval)
Ledger.ppuA0L ((StrictMaybe NonNegativeInterval
  -> Identity (StrictMaybe NonNegativeInterval))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe NonNegativeInterval
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe NonNegativeInterval
cppPoolPledgeInfluence
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe UnitInterval)
Ledger.ppuTauL ((StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe UnitInterval
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe UnitInterval
cppTreasuryExpansion
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe UnitInterval)
Ledger.ppuRhoL ((StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe UnitInterval
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe UnitInterval
cppMonetaryExpansion
    PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
Ledger.ppuMinPoolCostL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Coin
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
cppMinPoolCost

-- | Updating protocol version with PParamUpdate is being prevented in Conway
-- (via the `ProtVerAtMost era 8` constraint in `ppuProtocolVersionL`).
-- As a consequence, ppuProtocolVersionL cannot be used in `createCommonPParamsUpdate`,
-- as was the case pre-Conway.
-- Here we isolate the usage of the lens, so that it can be used in each pre-conway era
-- when creating `Ledger.PParamsUpdate` within `createEraBasedProtocolParamUpdate`.
createPreConwayProtocolVersionUpdate
  :: (EraPParams ledgerera, Ledger.ProtVerAtMost ledgerera 8)
  => DeprecatedAfterBabbagePParams cppProtocolVersion
  -> Ledger.PParamsUpdate ledgerera
createPreConwayProtocolVersionUpdate :: forall ledgerera cppProtocolVersion.
(EraPParams ledgerera, ProtVerAtMost ledgerera 8) =>
DeprecatedAfterBabbagePParams cppProtocolVersion
-> PParamsUpdate ledgerera
createPreConwayProtocolVersionUpdate (DeprecatedAfterBabbagePParams StrictMaybe ProtVer
cppProtocolVersion) =
  PParamsUpdate ledgerera
forall era. EraPParams era => PParamsUpdate era
Ledger.emptyPParamsUpdate PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe ProtVer -> Identity (StrictMaybe ProtVer))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
(EraPParams era, ProtVerAtMost era 8) =>
Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
Lens' (PParamsUpdate ledgerera) (StrictMaybe ProtVer)
Ledger.ppuProtocolVersionL ((StrictMaybe ProtVer -> Identity (StrictMaybe ProtVer))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe ProtVer
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe ProtVer
cppProtocolVersion

newtype DeprecatedAfterMaryPParams ledgerera
  = DeprecatedAfterMaryPParams (StrictMaybe Ledger.Coin) -- Minimum UTxO value
  deriving Int -> DeprecatedAfterMaryPParams ledgerera -> ShowS
[DeprecatedAfterMaryPParams ledgerera] -> ShowS
DeprecatedAfterMaryPParams ledgerera -> String
(Int -> DeprecatedAfterMaryPParams ledgerera -> ShowS)
-> (DeprecatedAfterMaryPParams ledgerera -> String)
-> ([DeprecatedAfterMaryPParams ledgerera] -> ShowS)
-> Show (DeprecatedAfterMaryPParams ledgerera)
forall ledgerera.
Int -> DeprecatedAfterMaryPParams ledgerera -> ShowS
forall ledgerera. [DeprecatedAfterMaryPParams ledgerera] -> ShowS
forall ledgerera. DeprecatedAfterMaryPParams ledgerera -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ledgerera.
Int -> DeprecatedAfterMaryPParams ledgerera -> ShowS
showsPrec :: Int -> DeprecatedAfterMaryPParams ledgerera -> ShowS
$cshow :: forall ledgerera. DeprecatedAfterMaryPParams ledgerera -> String
show :: DeprecatedAfterMaryPParams ledgerera -> String
$cshowList :: forall ledgerera. [DeprecatedAfterMaryPParams ledgerera] -> ShowS
showList :: [DeprecatedAfterMaryPParams ledgerera] -> ShowS
Show

newtype DeprecatedAfterBabbagePParams ledgerera
  = DeprecatedAfterBabbagePParams (StrictMaybe Ledger.ProtVer)
  deriving Int -> DeprecatedAfterBabbagePParams ledgerera -> ShowS
[DeprecatedAfterBabbagePParams ledgerera] -> ShowS
DeprecatedAfterBabbagePParams ledgerera -> String
(Int -> DeprecatedAfterBabbagePParams ledgerera -> ShowS)
-> (DeprecatedAfterBabbagePParams ledgerera -> String)
-> ([DeprecatedAfterBabbagePParams ledgerera] -> ShowS)
-> Show (DeprecatedAfterBabbagePParams ledgerera)
forall ledgerera.
Int -> DeprecatedAfterBabbagePParams ledgerera -> ShowS
forall ledgerera.
[DeprecatedAfterBabbagePParams ledgerera] -> ShowS
forall ledgerera. DeprecatedAfterBabbagePParams ledgerera -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ledgerera.
Int -> DeprecatedAfterBabbagePParams ledgerera -> ShowS
showsPrec :: Int -> DeprecatedAfterBabbagePParams ledgerera -> ShowS
$cshow :: forall ledgerera. DeprecatedAfterBabbagePParams ledgerera -> String
show :: DeprecatedAfterBabbagePParams ledgerera -> String
$cshowList :: forall ledgerera.
[DeprecatedAfterBabbagePParams ledgerera] -> ShowS
showList :: [DeprecatedAfterBabbagePParams ledgerera] -> ShowS
Show

type MaxMaryEra ledgerera = Ledger.ProtVerAtMost ledgerera 4

createDeprecatedAfterMaryPParams
  :: EraPParams (ShelleyLedgerEra era)
  => MaxMaryEra (ShelleyLedgerEra era)
  => ShelleyBasedEra era -> DeprecatedAfterMaryPParams era -> Ledger.PParamsUpdate (ShelleyLedgerEra era)
createDeprecatedAfterMaryPParams :: forall era.
(EraPParams (ShelleyLedgerEra era),
 MaxMaryEra (ShelleyLedgerEra era)) =>
ShelleyBasedEra era
-> DeprecatedAfterMaryPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
createDeprecatedAfterMaryPParams ShelleyBasedEra era
_ (DeprecatedAfterMaryPParams StrictMaybe Coin
minUtxoVal) =
  PParamsUpdate (ShelleyLedgerEra era)
forall era. EraPParams era => PParamsUpdate era
Ledger.emptyPParamsUpdate PParamsUpdate (ShelleyLedgerEra era)
-> (PParamsUpdate (ShelleyLedgerEra era)
    -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate (ShelleyLedgerEra era)
-> Identity (PParamsUpdate (ShelleyLedgerEra era))
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate (ShelleyLedgerEra era)) (StrictMaybe Coin)
Ledger.ppuMinUTxOValueL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate (ShelleyLedgerEra era)
 -> Identity (PParamsUpdate (ShelleyLedgerEra era)))
-> StrictMaybe Coin
-> PParamsUpdate (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
minUtxoVal

data ShelleyToAlonzoPParams ledgerera
  = ShelleyToAlonzoPParams
      (StrictMaybe Ledger.Nonce)
      -- ^ Extra entropy
      (StrictMaybe Ledger.UnitInterval)
      -- ^ Decentralization parameter
  deriving Int -> ShelleyToAlonzoPParams ledgerera -> ShowS
[ShelleyToAlonzoPParams ledgerera] -> ShowS
ShelleyToAlonzoPParams ledgerera -> String
(Int -> ShelleyToAlonzoPParams ledgerera -> ShowS)
-> (ShelleyToAlonzoPParams ledgerera -> String)
-> ([ShelleyToAlonzoPParams ledgerera] -> ShowS)
-> Show (ShelleyToAlonzoPParams ledgerera)
forall ledgerera. Int -> ShelleyToAlonzoPParams ledgerera -> ShowS
forall ledgerera. [ShelleyToAlonzoPParams ledgerera] -> ShowS
forall ledgerera. ShelleyToAlonzoPParams ledgerera -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ledgerera. Int -> ShelleyToAlonzoPParams ledgerera -> ShowS
showsPrec :: Int -> ShelleyToAlonzoPParams ledgerera -> ShowS
$cshow :: forall ledgerera. ShelleyToAlonzoPParams ledgerera -> String
show :: ShelleyToAlonzoPParams ledgerera -> String
$cshowList :: forall ledgerera. [ShelleyToAlonzoPParams ledgerera] -> ShowS
showList :: [ShelleyToAlonzoPParams ledgerera] -> ShowS
Show

type MaxAlonzoEra ledgerera = Ledger.ProtVerAtMost ledgerera 6

createDeprecatedAfterAlonzoPParams
  :: EraPParams (ShelleyLedgerEra era)
  => MaxAlonzoEra (ShelleyLedgerEra era)
  => ShelleyBasedEra era
  -> ShelleyToAlonzoPParams era
  -> Ledger.PParamsUpdate (ShelleyLedgerEra era)
createDeprecatedAfterAlonzoPParams :: forall era.
(EraPParams (ShelleyLedgerEra era),
 MaxAlonzoEra (ShelleyLedgerEra era)) =>
ShelleyBasedEra era
-> ShelleyToAlonzoPParams era
-> PParamsUpdate (ShelleyLedgerEra era)
createDeprecatedAfterAlonzoPParams ShelleyBasedEra era
_ (ShelleyToAlonzoPParams StrictMaybe Nonce
extraEntropy StrictMaybe UnitInterval
decentralization) =
  PParamsUpdate (ShelleyLedgerEra era)
forall era. EraPParams era => PParamsUpdate era
Ledger.emptyPParamsUpdate
    PParamsUpdate (ShelleyLedgerEra era)
-> (PParamsUpdate (ShelleyLedgerEra era)
    -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe Nonce -> Identity (StrictMaybe Nonce))
-> PParamsUpdate (ShelleyLedgerEra era)
-> Identity (PParamsUpdate (ShelleyLedgerEra era))
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParamsUpdate era) (StrictMaybe Nonce)
Lens' (PParamsUpdate (ShelleyLedgerEra era)) (StrictMaybe Nonce)
Ledger.ppuExtraEntropyL ((StrictMaybe Nonce -> Identity (StrictMaybe Nonce))
 -> PParamsUpdate (ShelleyLedgerEra era)
 -> Identity (PParamsUpdate (ShelleyLedgerEra era)))
-> StrictMaybe Nonce
-> PParamsUpdate (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Nonce
extraEntropy
    PParamsUpdate (ShelleyLedgerEra era)
-> (PParamsUpdate (ShelleyLedgerEra era)
    -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
-> PParamsUpdate (ShelleyLedgerEra era)
-> Identity (PParamsUpdate (ShelleyLedgerEra era))
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens'
  (PParamsUpdate (ShelleyLedgerEra era)) (StrictMaybe UnitInterval)
Ledger.ppuDL ((StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
 -> PParamsUpdate (ShelleyLedgerEra era)
 -> Identity (PParamsUpdate (ShelleyLedgerEra era)))
-> StrictMaybe UnitInterval
-> PParamsUpdate (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe UnitInterval
decentralization

data AlonzoOnwardsPParams ledgerera
  = AlonzoOnwardsPParams
  { forall ledgerera.
AlonzoOnwardsPParams ledgerera -> StrictMaybe CostModels
alCostModels :: StrictMaybe Alonzo.CostModels
  , forall ledgerera.
AlonzoOnwardsPParams ledgerera -> StrictMaybe Prices
alPrices :: StrictMaybe Alonzo.Prices
  , forall ledgerera.
AlonzoOnwardsPParams ledgerera -> StrictMaybe ExUnits
alMaxTxExUnits :: StrictMaybe Alonzo.ExUnits
  , forall ledgerera.
AlonzoOnwardsPParams ledgerera -> StrictMaybe ExUnits
alMaxBlockExUnits :: StrictMaybe Alonzo.ExUnits
  , forall ledgerera.
AlonzoOnwardsPParams ledgerera -> StrictMaybe Natural
alMaxValSize :: StrictMaybe Natural
  , forall ledgerera.
AlonzoOnwardsPParams ledgerera -> StrictMaybe Natural
alCollateralPercentage :: StrictMaybe Natural
  , forall ledgerera.
AlonzoOnwardsPParams ledgerera -> StrictMaybe Natural
alMaxCollateralInputs :: StrictMaybe Natural
  }
  deriving Int -> AlonzoOnwardsPParams ledgerera -> ShowS
[AlonzoOnwardsPParams ledgerera] -> ShowS
AlonzoOnwardsPParams ledgerera -> String
(Int -> AlonzoOnwardsPParams ledgerera -> ShowS)
-> (AlonzoOnwardsPParams ledgerera -> String)
-> ([AlonzoOnwardsPParams ledgerera] -> ShowS)
-> Show (AlonzoOnwardsPParams ledgerera)
forall ledgerera. Int -> AlonzoOnwardsPParams ledgerera -> ShowS
forall ledgerera. [AlonzoOnwardsPParams ledgerera] -> ShowS
forall ledgerera. AlonzoOnwardsPParams ledgerera -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ledgerera. Int -> AlonzoOnwardsPParams ledgerera -> ShowS
showsPrec :: Int -> AlonzoOnwardsPParams ledgerera -> ShowS
$cshow :: forall ledgerera. AlonzoOnwardsPParams ledgerera -> String
show :: AlonzoOnwardsPParams ledgerera -> String
$cshowList :: forall ledgerera. [AlonzoOnwardsPParams ledgerera] -> ShowS
showList :: [AlonzoOnwardsPParams ledgerera] -> ShowS
Show

createPParamsUpdateIntroducedInAlonzo
  :: ()
  => AlonzoEraOnwards era
  -> AlonzoOnwardsPParams era
  -> Ledger.PParamsUpdate (ShelleyLedgerEra era)
createPParamsUpdateIntroducedInAlonzo :: forall era.
AlonzoEraOnwards era
-> AlonzoOnwardsPParams era -> PParamsUpdate (ShelleyLedgerEra era)
createPParamsUpdateIntroducedInAlonzo AlonzoEraOnwards era
w (AlonzoOnwardsPParams{StrictMaybe Natural
StrictMaybe ExUnits
StrictMaybe CostModels
StrictMaybe Prices
alCostModels :: forall ledgerera.
AlonzoOnwardsPParams ledgerera -> StrictMaybe CostModels
alPrices :: forall ledgerera.
AlonzoOnwardsPParams ledgerera -> StrictMaybe Prices
alMaxTxExUnits :: forall ledgerera.
AlonzoOnwardsPParams ledgerera -> StrictMaybe ExUnits
alMaxBlockExUnits :: forall ledgerera.
AlonzoOnwardsPParams ledgerera -> StrictMaybe ExUnits
alMaxValSize :: forall ledgerera.
AlonzoOnwardsPParams ledgerera -> StrictMaybe Natural
alCollateralPercentage :: forall ledgerera.
AlonzoOnwardsPParams ledgerera -> StrictMaybe Natural
alMaxCollateralInputs :: forall ledgerera.
AlonzoOnwardsPParams ledgerera -> StrictMaybe Natural
alCostModels :: StrictMaybe CostModels
alPrices :: StrictMaybe Prices
alMaxTxExUnits :: StrictMaybe ExUnits
alMaxBlockExUnits :: StrictMaybe ExUnits
alMaxValSize :: StrictMaybe Natural
alCollateralPercentage :: StrictMaybe Natural
alMaxCollateralInputs :: StrictMaybe Natural
..}) =
  AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    PParamsUpdate (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
w ((AlonzoEraOnwardsConstraints era =>
  PParamsUpdate (ShelleyLedgerEra era))
 -> PParamsUpdate (ShelleyLedgerEra era))
-> (AlonzoEraOnwardsConstraints era =>
    PParamsUpdate (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
    PParamsUpdate (ShelleyLedgerEra era)
forall era. EraPParams era => PParamsUpdate era
Ledger.emptyPParamsUpdate
      PParamsUpdate (ShelleyLedgerEra era)
-> (PParamsUpdate (ShelleyLedgerEra era)
    -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe CostModels -> Identity (StrictMaybe CostModels))
-> PParamsUpdate (ShelleyLedgerEra era)
-> Identity (PParamsUpdate (ShelleyLedgerEra era))
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe CostModels)
Lens'
  (PParamsUpdate (ShelleyLedgerEra era)) (StrictMaybe CostModels)
Ledger.ppuCostModelsL ((StrictMaybe CostModels -> Identity (StrictMaybe CostModels))
 -> PParamsUpdate (ShelleyLedgerEra era)
 -> Identity (PParamsUpdate (ShelleyLedgerEra era)))
-> StrictMaybe CostModels
-> PParamsUpdate (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe CostModels
alCostModels
      PParamsUpdate (ShelleyLedgerEra era)
-> (PParamsUpdate (ShelleyLedgerEra era)
    -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe Prices -> Identity (StrictMaybe Prices))
-> PParamsUpdate (ShelleyLedgerEra era)
-> Identity (PParamsUpdate (ShelleyLedgerEra era))
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Prices)
Lens' (PParamsUpdate (ShelleyLedgerEra era)) (StrictMaybe Prices)
Ledger.ppuPricesL ((StrictMaybe Prices -> Identity (StrictMaybe Prices))
 -> PParamsUpdate (ShelleyLedgerEra era)
 -> Identity (PParamsUpdate (ShelleyLedgerEra era)))
-> StrictMaybe Prices
-> PParamsUpdate (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Prices
alPrices
      PParamsUpdate (ShelleyLedgerEra era)
-> (PParamsUpdate (ShelleyLedgerEra era)
    -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe ExUnits -> Identity (StrictMaybe ExUnits))
-> PParamsUpdate (ShelleyLedgerEra era)
-> Identity (PParamsUpdate (ShelleyLedgerEra era))
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe ExUnits)
Lens' (PParamsUpdate (ShelleyLedgerEra era)) (StrictMaybe ExUnits)
Ledger.ppuMaxTxExUnitsL ((StrictMaybe ExUnits -> Identity (StrictMaybe ExUnits))
 -> PParamsUpdate (ShelleyLedgerEra era)
 -> Identity (PParamsUpdate (ShelleyLedgerEra era)))
-> StrictMaybe ExUnits
-> PParamsUpdate (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe ExUnits
alMaxTxExUnits
      PParamsUpdate (ShelleyLedgerEra era)
-> (PParamsUpdate (ShelleyLedgerEra era)
    -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe ExUnits -> Identity (StrictMaybe ExUnits))
-> PParamsUpdate (ShelleyLedgerEra era)
-> Identity (PParamsUpdate (ShelleyLedgerEra era))
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe ExUnits)
Lens' (PParamsUpdate (ShelleyLedgerEra era)) (StrictMaybe ExUnits)
Ledger.ppuMaxBlockExUnitsL ((StrictMaybe ExUnits -> Identity (StrictMaybe ExUnits))
 -> PParamsUpdate (ShelleyLedgerEra era)
 -> Identity (PParamsUpdate (ShelleyLedgerEra era)))
-> StrictMaybe ExUnits
-> PParamsUpdate (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe ExUnits
alMaxBlockExUnits
      PParamsUpdate (ShelleyLedgerEra era)
-> (PParamsUpdate (ShelleyLedgerEra era)
    -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe Natural -> Identity (StrictMaybe Natural))
-> PParamsUpdate (ShelleyLedgerEra era)
-> Identity (PParamsUpdate (ShelleyLedgerEra era))
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate (ShelleyLedgerEra era)) (StrictMaybe Natural)
Ledger.ppuMaxValSizeL ((StrictMaybe Natural -> Identity (StrictMaybe Natural))
 -> PParamsUpdate (ShelleyLedgerEra era)
 -> Identity (PParamsUpdate (ShelleyLedgerEra era)))
-> StrictMaybe Natural
-> PParamsUpdate (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Natural
alMaxValSize
      PParamsUpdate (ShelleyLedgerEra era)
-> (PParamsUpdate (ShelleyLedgerEra era)
    -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe Natural -> Identity (StrictMaybe Natural))
-> PParamsUpdate (ShelleyLedgerEra era)
-> Identity (PParamsUpdate (ShelleyLedgerEra era))
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate (ShelleyLedgerEra era)) (StrictMaybe Natural)
Ledger.ppuCollateralPercentageL ((StrictMaybe Natural -> Identity (StrictMaybe Natural))
 -> PParamsUpdate (ShelleyLedgerEra era)
 -> Identity (PParamsUpdate (ShelleyLedgerEra era)))
-> StrictMaybe Natural
-> PParamsUpdate (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Natural
alCollateralPercentage
      PParamsUpdate (ShelleyLedgerEra era)
-> (PParamsUpdate (ShelleyLedgerEra era)
    -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe Natural -> Identity (StrictMaybe Natural))
-> PParamsUpdate (ShelleyLedgerEra era)
-> Identity (PParamsUpdate (ShelleyLedgerEra era))
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate (ShelleyLedgerEra era)) (StrictMaybe Natural)
Ledger.ppuMaxCollateralInputsL ((StrictMaybe Natural -> Identity (StrictMaybe Natural))
 -> PParamsUpdate (ShelleyLedgerEra era)
 -> Identity (PParamsUpdate (ShelleyLedgerEra era)))
-> StrictMaybe Natural
-> PParamsUpdate (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Natural
alMaxCollateralInputs

newtype IntroducedInBabbagePParams era
  = -- | Coins per UTxO byte
    IntroducedInBabbagePParams
      (StrictMaybe CoinPerByte)
  deriving Int -> IntroducedInBabbagePParams era -> ShowS
[IntroducedInBabbagePParams era] -> ShowS
IntroducedInBabbagePParams era -> String
(Int -> IntroducedInBabbagePParams era -> ShowS)
-> (IntroducedInBabbagePParams era -> String)
-> ([IntroducedInBabbagePParams era] -> ShowS)
-> Show (IntroducedInBabbagePParams era)
forall era. Int -> IntroducedInBabbagePParams era -> ShowS
forall era. [IntroducedInBabbagePParams era] -> ShowS
forall era. IntroducedInBabbagePParams era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> IntroducedInBabbagePParams era -> ShowS
showsPrec :: Int -> IntroducedInBabbagePParams era -> ShowS
$cshow :: forall era. IntroducedInBabbagePParams era -> String
show :: IntroducedInBabbagePParams era -> String
$cshowList :: forall era. [IntroducedInBabbagePParams era] -> ShowS
showList :: [IntroducedInBabbagePParams era] -> ShowS
Show

createIntroducedInBabbagePParams
  :: ()
  => BabbageEraOnwards era
  -> IntroducedInBabbagePParams era
  -> Ledger.PParamsUpdate (ShelleyLedgerEra era)
createIntroducedInBabbagePParams :: forall era.
BabbageEraOnwards era
-> IntroducedInBabbagePParams era
-> PParamsUpdate (ShelleyLedgerEra era)
createIntroducedInBabbagePParams BabbageEraOnwards era
w (IntroducedInBabbagePParams StrictMaybe CoinPerByte
coinsPerUTxOByte) =
  BabbageEraOnwards era
-> (BabbageEraOnwardsConstraints era =>
    PParamsUpdate (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
forall era a.
BabbageEraOnwards era
-> (BabbageEraOnwardsConstraints era => a) -> a
babbageEraOnwardsConstraints BabbageEraOnwards era
w ((BabbageEraOnwardsConstraints era =>
  PParamsUpdate (ShelleyLedgerEra era))
 -> PParamsUpdate (ShelleyLedgerEra era))
-> (BabbageEraOnwardsConstraints era =>
    PParamsUpdate (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
    PParamsUpdate (ShelleyLedgerEra era)
forall era. EraPParams era => PParamsUpdate era
Ledger.emptyPParamsUpdate PParamsUpdate (ShelleyLedgerEra era)
-> (PParamsUpdate (ShelleyLedgerEra era)
    -> PParamsUpdate (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe CoinPerByte -> Identity (StrictMaybe CoinPerByte))
-> PParamsUpdate (ShelleyLedgerEra era)
-> Identity (PParamsUpdate (ShelleyLedgerEra era))
forall era.
BabbageEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe CoinPerByte)
Lens'
  (PParamsUpdate (ShelleyLedgerEra era)) (StrictMaybe CoinPerByte)
Ledger.ppuCoinsPerUTxOByteL ((StrictMaybe CoinPerByte -> Identity (StrictMaybe CoinPerByte))
 -> PParamsUpdate (ShelleyLedgerEra era)
 -> Identity (PParamsUpdate (ShelleyLedgerEra era)))
-> StrictMaybe CoinPerByte
-> PParamsUpdate (ShelleyLedgerEra era)
-> PParamsUpdate (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe CoinPerByte
coinsPerUTxOByte

-- | The values of the set of /updatable/ protocol parameters. At any
-- particular point on the chain there is a current set of parameters in use.
--
-- These parameters can be updated (at epoch boundaries) via an
-- 'UpdateProposal', which contains a 'ProtocolParametersUpdate'.
--
-- The 'ProtocolParametersUpdate' is essentially a diff for the
-- 'ProtocolParameters'.
--
-- There are also parameters fixed in the Genesis file. See 'GenesisParameters'.
{-# DEPRECATED
  ProtocolParameters
  "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork."
  #-}

data ProtocolParameters
  = ProtocolParameters
  { ProtocolParameters -> (Natural, Natural)
protocolParamProtocolVersion :: (Natural, Natural)
  -- ^ Protocol version, major and minor. Updating the major version is
  -- used to trigger hard forks.
  --                              (Major  , Minor  )
  , ProtocolParameters -> Maybe Rational
protocolParamDecentralization :: Maybe Rational
  -- ^ The decentralization parameter. This is fraction of slots that
  -- belong to the BFT overlay schedule, rather than the Praos schedule.
  -- So 1 means fully centralised, while 0 means fully decentralised.
  --
  -- This is the \"d\" parameter from the design document.
  --
  -- /Deprecated in Babbage/
  , ProtocolParameters -> Maybe PraosNonce
protocolParamExtraPraosEntropy :: Maybe PraosNonce
  -- ^ Extra entropy for the Praos per-epoch nonce.
  --
  -- This can be used to add extra entropy during the decentralisation
  -- process. If the extra entropy can be demonstrated to be generated
  -- randomly then this method can be used to show that the initial
  -- federated operators did not subtly bias the initial schedule so that
  -- they retain undue influence after decentralisation.
  , ProtocolParameters -> Natural
protocolParamMaxBlockHeaderSize :: Natural
  -- ^ The maximum permitted size of a block header.
  --
  -- This must be at least as big as the largest legitimate block headers
  -- but should not be too much larger, to help prevent DoS attacks.
  --
  -- Caution: setting this to be smaller than legitimate block headers is
  -- a sure way to brick the system!
  , ProtocolParameters -> Natural
protocolParamMaxBlockBodySize :: Natural
  -- ^ The maximum permitted size of the block body (that is, the block
  -- payload, without the block header).
  --
  -- This should be picked with the Praos network delta security parameter
  -- in mind. Making this too large can severely weaken the Praos
  -- consensus properties.
  --
  -- Caution: setting this to be smaller than a transaction that can
  -- change the protocol parameters is a sure way to brick the system!
  , ProtocolParameters -> Natural
protocolParamMaxTxSize :: Natural
  -- ^ The maximum permitted size of a transaction.
  --
  -- Typically this should not be too high a fraction of the block size,
  -- otherwise wastage from block fragmentation becomes a problem, and
  -- the current implementation does not use any sophisticated box packing
  -- algorithm.
  , ProtocolParameters -> Coin
protocolParamTxFeeFixed :: L.Coin
  -- ^ The constant factor for the minimum fee calculation.
  , ProtocolParameters -> Coin
protocolParamTxFeePerByte :: L.Coin
  -- ^ Per byte linear factor for the minimum fee calculation.
  , ProtocolParameters -> Maybe Coin
protocolParamMinUTxOValue :: Maybe L.Coin
  -- ^ The minimum permitted value for new UTxO entries, ie for
  -- transaction outputs.
  , ProtocolParameters -> Coin
protocolParamStakeAddressDeposit :: L.Coin
  -- ^ The deposit required to register a stake address.
  , ProtocolParameters -> Coin
protocolParamStakePoolDeposit :: L.Coin
  -- ^ The deposit required to register a stake pool.
  , ProtocolParameters -> Coin
protocolParamMinPoolCost :: L.Coin
  -- ^ The minimum value that stake pools are permitted to declare for
  -- their cost parameter.
  , ProtocolParameters -> EpochInterval
protocolParamPoolRetireMaxEpoch :: Ledger.EpochInterval
  -- ^ The maximum number of epochs into the future that stake pools
  -- are permitted to schedule a retirement.
  , ProtocolParameters -> Natural
protocolParamStakePoolTargetNum :: Natural
  -- ^ The equilibrium target number of stake pools.
  --
  -- This is the \"k\" incentives parameter from the design document.
  , ProtocolParameters -> Rational
protocolParamPoolPledgeInfluence :: Rational
  -- ^ The influence of the pledge in stake pool rewards.
  --
  -- This is the \"a_0\" incentives parameter from the design document.
  , ProtocolParameters -> Rational
protocolParamMonetaryExpansion :: Rational
  -- ^ The monetary expansion rate. This determines the fraction of the
  -- reserves that are added to the fee pot each epoch.
  --
  -- This is the \"rho\" incentives parameter from the design document.
  , ProtocolParameters -> Rational
protocolParamTreasuryCut :: Rational
  -- ^ The fraction of the fee pot each epoch that goes to the treasury.
  --
  -- This is the \"tau\" incentives parameter from the design document.
  , ProtocolParameters -> Map AnyPlutusScriptVersion CostModel
protocolParamCostModels :: Map AnyPlutusScriptVersion CostModel
  -- ^ Cost models for script languages that use them.
  --
  -- /Introduced in Alonzo/
  , ProtocolParameters -> Maybe ExecutionUnitPrices
protocolParamPrices :: Maybe ExecutionUnitPrices
  -- ^ Price of execution units for script languages that use them.
  --
  -- /Introduced in Alonzo/
  , ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxTxExUnits :: Maybe ExecutionUnits
  -- ^ Max total script execution resources units allowed per tx
  --
  -- /Introduced in Alonzo/
  , ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxBlockExUnits :: Maybe ExecutionUnits
  -- ^ Max total script execution resources units allowed per block
  --
  -- /Introduced in Alonzo/
  , ProtocolParameters -> Maybe Natural
protocolParamMaxValueSize :: Maybe Natural
  -- ^ Max size of a Value in a tx output.
  --
  -- /Introduced in Alonzo/
  , ProtocolParameters -> Maybe Natural
protocolParamCollateralPercent :: Maybe Natural
  -- ^ The percentage of the script contribution to the txfee that must be
  -- provided as collateral inputs when including Plutus scripts.
  --
  -- /Introduced in Alonzo/
  , ProtocolParameters -> Maybe Natural
protocolParamMaxCollateralInputs :: Maybe Natural
  -- ^ The maximum number of collateral inputs allowed in a transaction.
  --
  -- /Introduced in Alonzo/
  , ProtocolParameters -> Maybe Coin
protocolParamUTxOCostPerByte :: Maybe L.Coin
  -- ^ Cost in ada per byte of UTxO storage.
  --
  -- /Introduced in Babbage/
  }
  deriving (ProtocolParameters -> ProtocolParameters -> Bool
(ProtocolParameters -> ProtocolParameters -> Bool)
-> (ProtocolParameters -> ProtocolParameters -> Bool)
-> Eq ProtocolParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtocolParameters -> ProtocolParameters -> Bool
== :: ProtocolParameters -> ProtocolParameters -> Bool
$c/= :: ProtocolParameters -> ProtocolParameters -> Bool
/= :: ProtocolParameters -> ProtocolParameters -> Bool
Eq, (forall x. ProtocolParameters -> Rep ProtocolParameters x)
-> (forall x. Rep ProtocolParameters x -> ProtocolParameters)
-> Generic ProtocolParameters
forall x. Rep ProtocolParameters x -> ProtocolParameters
forall x. ProtocolParameters -> Rep ProtocolParameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProtocolParameters -> Rep ProtocolParameters x
from :: forall x. ProtocolParameters -> Rep ProtocolParameters x
$cto :: forall x. Rep ProtocolParameters x -> ProtocolParameters
to :: forall x. Rep ProtocolParameters x -> ProtocolParameters
Generic, Int -> ProtocolParameters -> ShowS
[ProtocolParameters] -> ShowS
ProtocolParameters -> String
(Int -> ProtocolParameters -> ShowS)
-> (ProtocolParameters -> String)
-> ([ProtocolParameters] -> ShowS)
-> Show ProtocolParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtocolParameters -> ShowS
showsPrec :: Int -> ProtocolParameters -> ShowS
$cshow :: ProtocolParameters -> String
show :: ProtocolParameters -> String
$cshowList :: [ProtocolParameters] -> ShowS
showList :: [ProtocolParameters] -> ShowS
Show)

instance FromJSON ProtocolParameters where
  parseJSON :: Value -> Parser ProtocolParameters
parseJSON =
    String
-> (Object -> Parser ProtocolParameters)
-> Value
-> Parser ProtocolParameters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProtocolParameters" ((Object -> Parser ProtocolParameters)
 -> Value -> Parser ProtocolParameters)
-> (Object -> Parser ProtocolParameters)
-> Value
-> Parser ProtocolParameters
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Object
v <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"protocolVersion"
      (Natural, Natural)
-> Maybe Rational
-> Maybe PraosNonce
-> Natural
-> Natural
-> Natural
-> Coin
-> Coin
-> Maybe Coin
-> Coin
-> Coin
-> Coin
-> EpochInterval
-> Natural
-> Rational
-> Rational
-> Rational
-> Map AnyPlutusScriptVersion CostModel
-> Maybe ExecutionUnitPrices
-> Maybe ExecutionUnits
-> Maybe ExecutionUnits
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Coin
-> ProtocolParameters
ProtocolParameters
        ((Natural, Natural)
 -> Maybe Rational
 -> Maybe PraosNonce
 -> Natural
 -> Natural
 -> Natural
 -> Coin
 -> Coin
 -> Maybe Coin
 -> Coin
 -> Coin
 -> Coin
 -> EpochInterval
 -> Natural
 -> Rational
 -> Rational
 -> Rational
 -> Map AnyPlutusScriptVersion CostModel
 -> Maybe ExecutionUnitPrices
 -> Maybe ExecutionUnits
 -> Maybe ExecutionUnits
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Coin
 -> ProtocolParameters)
-> Parser (Natural, Natural)
-> Parser
     (Maybe Rational
      -> Maybe PraosNonce
      -> Natural
      -> Natural
      -> Natural
      -> Coin
      -> Coin
      -> Maybe Coin
      -> Coin
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (Natural -> Natural -> (Natural, Natural))
-> Parser Natural -> Parser (Natural -> (Natural, Natural))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"major" Parser (Natural -> (Natural, Natural))
-> Parser Natural -> Parser (Natural, Natural)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minor")
        Parser
  (Maybe Rational
   -> Maybe PraosNonce
   -> Natural
   -> Natural
   -> Natural
   -> Coin
   -> Coin
   -> Maybe Coin
   -> Coin
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser (Maybe Rational)
-> Parser
     (Maybe PraosNonce
      -> Natural
      -> Natural
      -> Natural
      -> Coin
      -> Coin
      -> Maybe Coin
      -> Coin
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Rational)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"decentralization"
        Parser
  (Maybe PraosNonce
   -> Natural
   -> Natural
   -> Natural
   -> Coin
   -> Coin
   -> Maybe Coin
   -> Coin
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser (Maybe PraosNonce)
-> Parser
     (Natural
      -> Natural
      -> Natural
      -> Coin
      -> Coin
      -> Maybe Coin
      -> Coin
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe PraosNonce)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"extraPraosEntropy"
        Parser
  (Natural
   -> Natural
   -> Natural
   -> Coin
   -> Coin
   -> Maybe Coin
   -> Coin
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser Natural
-> Parser
     (Natural
      -> Natural
      -> Coin
      -> Coin
      -> Maybe Coin
      -> Coin
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxBlockHeaderSize"
        Parser
  (Natural
   -> Natural
   -> Coin
   -> Coin
   -> Maybe Coin
   -> Coin
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser Natural
-> Parser
     (Natural
      -> Coin
      -> Coin
      -> Maybe Coin
      -> Coin
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxBlockBodySize"
        Parser
  (Natural
   -> Coin
   -> Coin
   -> Maybe Coin
   -> Coin
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser Natural
-> Parser
     (Coin
      -> Coin
      -> Maybe Coin
      -> Coin
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxTxSize"
        Parser
  (Coin
   -> Coin
   -> Maybe Coin
   -> Coin
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser Coin
-> Parser
     (Coin
      -> Maybe Coin
      -> Coin
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txFeeFixed"
        Parser
  (Coin
   -> Maybe Coin
   -> Coin
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser Coin
-> Parser
     (Maybe Coin
      -> Coin
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txFeePerByte"
        Parser
  (Maybe Coin
   -> Coin
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser (Maybe Coin)
-> Parser
     (Coin
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Coin)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minUTxOValue"
        Parser
  (Coin
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser Coin
-> Parser
     (Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stakeAddressDeposit"
        Parser
  (Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser Coin
-> Parser
     (Coin
      -> EpochInterval
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stakePoolDeposit"
        Parser
  (Coin
   -> EpochInterval
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser Coin
-> Parser
     (EpochInterval
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minPoolCost"
        Parser
  (EpochInterval
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser EpochInterval
-> Parser
     (Natural
      -> Rational
      -> Rational
      -> Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser EpochInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"poolRetireMaxEpoch"
        Parser
  (Natural
   -> Rational
   -> Rational
   -> Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser Natural
-> Parser
     (Rational
      -> Rational
      -> Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stakePoolTargetNum"
        Parser
  (Rational
   -> Rational
   -> Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser Rational
-> Parser
     (Rational
      -> Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Rational
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"poolPledgeInfluence"
        Parser
  (Rational
   -> Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser Rational
-> Parser
     (Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Rational
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"monetaryExpansion"
        Parser
  (Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser Rational
-> Parser
     (Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Rational
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"treasuryCut"
        Parser
  (Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser (Map AnyPlutusScriptVersion CostModel)
-> Parser
     (Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((CostModels -> Map AnyPlutusScriptVersion CostModel)
-> Maybe CostModels -> Maybe (Map AnyPlutusScriptVersion CostModel)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CostModels -> Map AnyPlutusScriptVersion CostModel
unCostModels (Maybe CostModels -> Maybe (Map AnyPlutusScriptVersion CostModel))
-> Parser (Maybe CostModels)
-> Parser (Maybe (Map AnyPlutusScriptVersion CostModel))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe CostModels)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"costModels") Parser (Maybe (Map AnyPlutusScriptVersion CostModel))
-> Map AnyPlutusScriptVersion CostModel
-> Parser (Map AnyPlutusScriptVersion CostModel)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map AnyPlutusScriptVersion CostModel
forall k a. Map k a
Map.empty
        Parser
  (Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser (Maybe ExecutionUnitPrices)
-> Parser
     (Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ExecutionUnitPrices)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"executionUnitPrices"
        Parser
  (Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser (Maybe ExecutionUnits)
-> Parser
     (Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ExecutionUnits)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"maxTxExecutionUnits"
        Parser
  (Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser (Maybe ExecutionUnits)
-> Parser
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ExecutionUnits)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"maxBlockExecutionUnits"
        Parser
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParameters)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Natural
      -> Maybe Natural -> Maybe Coin -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Natural)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"maxValueSize"
        Parser
  (Maybe Natural
   -> Maybe Natural -> Maybe Coin -> ProtocolParameters)
-> Parser (Maybe Natural)
-> Parser (Maybe Natural -> Maybe Coin -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Natural)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"collateralPercentage"
        Parser (Maybe Natural -> Maybe Coin -> ProtocolParameters)
-> Parser (Maybe Natural)
-> Parser (Maybe Coin -> ProtocolParameters)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Natural)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"maxCollateralInputs"
        Parser (Maybe Coin -> ProtocolParameters)
-> Parser (Maybe Coin) -> Parser ProtocolParameters
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Coin)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"utxoCostPerByte"

instance ToJSON ProtocolParameters where
  toJSON :: ProtocolParameters -> Value
toJSON ProtocolParameters{Natural
Maybe Natural
Maybe Rational
Maybe Coin
Maybe ExecutionUnits
Maybe ExecutionUnitPrices
Maybe PraosNonce
Rational
(Natural, Natural)
Map AnyPlutusScriptVersion CostModel
Coin
EpochInterval
protocolParamProtocolVersion :: ProtocolParameters -> (Natural, Natural)
protocolParamDecentralization :: ProtocolParameters -> Maybe Rational
protocolParamExtraPraosEntropy :: ProtocolParameters -> Maybe PraosNonce
protocolParamMaxBlockHeaderSize :: ProtocolParameters -> Natural
protocolParamMaxBlockBodySize :: ProtocolParameters -> Natural
protocolParamMaxTxSize :: ProtocolParameters -> Natural
protocolParamTxFeeFixed :: ProtocolParameters -> Coin
protocolParamTxFeePerByte :: ProtocolParameters -> Coin
protocolParamMinUTxOValue :: ProtocolParameters -> Maybe Coin
protocolParamStakeAddressDeposit :: ProtocolParameters -> Coin
protocolParamStakePoolDeposit :: ProtocolParameters -> Coin
protocolParamMinPoolCost :: ProtocolParameters -> Coin
protocolParamPoolRetireMaxEpoch :: ProtocolParameters -> EpochInterval
protocolParamStakePoolTargetNum :: ProtocolParameters -> Natural
protocolParamPoolPledgeInfluence :: ProtocolParameters -> Rational
protocolParamMonetaryExpansion :: ProtocolParameters -> Rational
protocolParamTreasuryCut :: ProtocolParameters -> Rational
protocolParamCostModels :: ProtocolParameters -> Map AnyPlutusScriptVersion CostModel
protocolParamPrices :: ProtocolParameters -> Maybe ExecutionUnitPrices
protocolParamMaxTxExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxBlockExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxValueSize :: ProtocolParameters -> Maybe Natural
protocolParamCollateralPercent :: ProtocolParameters -> Maybe Natural
protocolParamMaxCollateralInputs :: ProtocolParameters -> Maybe Natural
protocolParamUTxOCostPerByte :: ProtocolParameters -> Maybe Coin
protocolParamProtocolVersion :: (Natural, Natural)
protocolParamDecentralization :: Maybe Rational
protocolParamExtraPraosEntropy :: Maybe PraosNonce
protocolParamMaxBlockHeaderSize :: Natural
protocolParamMaxBlockBodySize :: Natural
protocolParamMaxTxSize :: Natural
protocolParamTxFeeFixed :: Coin
protocolParamTxFeePerByte :: Coin
protocolParamMinUTxOValue :: Maybe Coin
protocolParamStakeAddressDeposit :: Coin
protocolParamStakePoolDeposit :: Coin
protocolParamMinPoolCost :: Coin
protocolParamPoolRetireMaxEpoch :: EpochInterval
protocolParamStakePoolTargetNum :: Natural
protocolParamPoolPledgeInfluence :: Rational
protocolParamMonetaryExpansion :: Rational
protocolParamTreasuryCut :: Rational
protocolParamCostModels :: Map AnyPlutusScriptVersion CostModel
protocolParamPrices :: Maybe ExecutionUnitPrices
protocolParamMaxTxExUnits :: Maybe ExecutionUnits
protocolParamMaxBlockExUnits :: Maybe ExecutionUnits
protocolParamMaxValueSize :: Maybe Natural
protocolParamCollateralPercent :: Maybe Natural
protocolParamMaxCollateralInputs :: Maybe Natural
protocolParamUTxOCostPerByte :: Maybe Coin
..} =
    [Pair] -> Value
object
      [ Key
"extraPraosEntropy" Key -> Maybe PraosNonce -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe PraosNonce
protocolParamExtraPraosEntropy
      , Key
"stakePoolTargetNum" Key -> Natural -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Natural
protocolParamStakePoolTargetNum
      , Key
"minUTxOValue" Key -> Maybe Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Coin
protocolParamMinUTxOValue
      , Key
"poolRetireMaxEpoch" Key -> EpochInterval -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EpochInterval
protocolParamPoolRetireMaxEpoch
      , Key
"decentralization" Key -> Maybe Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Rational -> Value
toRationalJSON (Rational -> Value) -> Maybe Rational -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Rational
protocolParamDecentralization)
      , Key
"stakePoolDeposit" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
protocolParamStakePoolDeposit
      , Key
"maxBlockHeaderSize" Key -> Natural -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Natural
protocolParamMaxBlockHeaderSize
      , Key
"maxBlockBodySize" Key -> Natural -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Natural
protocolParamMaxBlockBodySize
      , Key
"maxTxSize" Key -> Natural -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Natural
protocolParamMaxTxSize
      , Key
"treasuryCut" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
toRationalJSON Rational
protocolParamTreasuryCut
      , Key
"minPoolCost" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
protocolParamMinPoolCost
      , Key
"monetaryExpansion" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
toRationalJSON Rational
protocolParamMonetaryExpansion
      , Key
"stakeAddressDeposit" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
protocolParamStakeAddressDeposit
      , Key
"poolPledgeInfluence" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
toRationalJSON Rational
protocolParamPoolPledgeInfluence
      , Key
"protocolVersion"
          Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= let (Natural
major, Natural
minor) = (Natural, Natural)
protocolParamProtocolVersion
              in [Pair] -> Value
object [Key
"major" Key -> Natural -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Natural
major, Key
"minor" Key -> Natural -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Natural
minor]
      , Key
"txFeeFixed" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
protocolParamTxFeeFixed
      , Key
"txFeePerByte" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
protocolParamTxFeePerByte
      , -- Alonzo era:
        Key
"costModels" Key -> CostModels -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map AnyPlutusScriptVersion CostModel -> CostModels
CostModels Map AnyPlutusScriptVersion CostModel
protocolParamCostModels
      , Key
"executionUnitPrices" Key -> Maybe ExecutionUnitPrices -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe ExecutionUnitPrices
protocolParamPrices
      , Key
"maxTxExecutionUnits" Key -> Maybe ExecutionUnits -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe ExecutionUnits
protocolParamMaxTxExUnits
      , Key
"maxBlockExecutionUnits" Key -> Maybe ExecutionUnits -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe ExecutionUnits
protocolParamMaxBlockExUnits
      , Key
"maxValueSize" Key -> Maybe Natural -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Natural
protocolParamMaxValueSize
      , Key
"collateralPercentage" Key -> Maybe Natural -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Natural
protocolParamCollateralPercent
      , Key
"maxCollateralInputs" Key -> Maybe Natural -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Natural
protocolParamMaxCollateralInputs
      , -- Babbage era:
        Key
"utxoCostPerByte" Key -> Maybe Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Coin
protocolParamUTxOCostPerByte
      ]

-- ----------------------------------------------------------------------------
-- Updates to the protocol parameters
--

-- | The representation of a change in the 'ProtocolParameters'.
data ProtocolParametersUpdate
  = ProtocolParametersUpdate
  { ProtocolParametersUpdate -> Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
  -- ^ Protocol version, major and minor. Updating the major version is
  -- used to trigger hard forks.
  , ProtocolParametersUpdate -> Maybe Rational
protocolUpdateDecentralization :: Maybe Rational
  -- ^ The decentralization parameter. This is fraction of slots that
  -- belong to the BFT overlay schedule, rather than the Praos schedule.
  -- So 1 means fully centralised, while 0 means fully decentralised.
  --
  -- This is the \"d\" parameter from the design document.
  , ProtocolParametersUpdate -> Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy :: Maybe (Maybe PraosNonce)
  -- ^ Extra entropy for the Praos per-epoch nonce.
  --
  -- This can be used to add extra entropy during the decentralisation
  -- process. If the extra entropy can be demonstrated to be generated
  -- randomly then this method can be used to show that the initial
  -- federated operators did not subtly bias the initial schedule so that
  -- they retain undue influence after decentralisation.
  , ProtocolParametersUpdate -> Maybe Word16
protocolUpdateMaxBlockHeaderSize :: Maybe Word16
  -- ^ The maximum permitted size of a block header.
  --
  -- This must be at least as big as the largest legitimate block headers
  -- but should not be too much larger, to help prevent DoS attacks.
  --
  -- Caution: setting this to be smaller than legitimate block headers is
  -- a sure way to brick the system!
  , ProtocolParametersUpdate -> Maybe Word32
protocolUpdateMaxBlockBodySize :: Maybe Word32
  -- ^ The maximum permitted size of the block body (that is, the block
  -- payload, without the block header).
  --
  -- This should be picked with the Praos network delta security parameter
  -- in mind. Making this too large can severely weaken the Praos
  -- consensus properties.
  --
  -- Caution: setting this to be smaller than a transaction that can
  -- change the protocol parameters is a sure way to brick the system!
  , ProtocolParametersUpdate -> Maybe Word32
protocolUpdateMaxTxSize :: Maybe Word32
  -- ^ The maximum permitted size of a transaction.
  --
  -- Typically this should not be too high a fraction of the block size,
  -- otherwise wastage from block fragmentation becomes a problem, and
  -- the current implementation does not use any sophisticated box packing
  -- algorithm.
  , ProtocolParametersUpdate -> Maybe Coin
protocolUpdateTxFeeFixed :: Maybe L.Coin
  -- ^ The constant factor for the minimum fee calculation.
  , ProtocolParametersUpdate -> Maybe Coin
protocolUpdateTxFeePerByte :: Maybe L.Coin
  -- ^ The linear factor for the minimum fee calculation.
  , ProtocolParametersUpdate -> Maybe Coin
protocolUpdateMinUTxOValue :: Maybe L.Coin
  -- ^ The minimum permitted value for new UTxO entries, ie for
  -- transaction outputs.
  , ProtocolParametersUpdate -> Maybe Coin
protocolUpdateStakeAddressDeposit :: Maybe L.Coin
  -- ^ The deposit required to register a stake address.
  , ProtocolParametersUpdate -> Maybe Coin
protocolUpdateStakePoolDeposit :: Maybe L.Coin
  -- ^ The deposit required to register a stake pool.
  , ProtocolParametersUpdate -> Maybe Coin
protocolUpdateMinPoolCost :: Maybe L.Coin
  -- ^ The minimum value that stake pools are permitted to declare for
  -- their cost parameter.
  , ProtocolParametersUpdate -> Maybe EpochInterval
protocolUpdatePoolRetireMaxEpoch :: Maybe Ledger.EpochInterval
  -- ^ The maximum number of epochs into the future that stake pools
  -- are permitted to schedule a retirement.
  , ProtocolParametersUpdate -> Maybe Natural
protocolUpdateStakePoolTargetNum :: Maybe Natural
  -- ^ The equilibrium target number of stake pools.
  --
  -- This is the \"k\" incentives parameter from the design document.
  , ProtocolParametersUpdate -> Maybe Rational
protocolUpdatePoolPledgeInfluence :: Maybe Rational
  -- ^ The influence of the pledge in stake pool rewards.
  --
  -- This is the \"a_0\" incentives parameter from the design document.
  , ProtocolParametersUpdate -> Maybe Rational
protocolUpdateMonetaryExpansion :: Maybe Rational
  -- ^ The monetary expansion rate. This determines the fraction of the
  -- reserves that are added to the fee pot each epoch.
  --
  -- This is the \"rho\" incentives parameter from the design document.
  , ProtocolParametersUpdate -> Maybe Rational
protocolUpdateTreasuryCut :: Maybe Rational
  -- ^ The fraction of the fee pot each epoch that goes to the treasury.
  --
  -- This is the \"tau\" incentives parameter from the design document.
  , -- Introduced in Alonzo,

    ProtocolParametersUpdate -> Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels :: Map AnyPlutusScriptVersion CostModel
  -- ^ Cost models for script languages that use them.
  --
  -- /Introduced in Alonzo/
  , ProtocolParametersUpdate -> Maybe ExecutionUnitPrices
protocolUpdatePrices :: Maybe ExecutionUnitPrices
  -- ^ Price of execution units for script languages that use them.
  --
  -- /Introduced in Alonzo/
  , ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxTxExUnits :: Maybe ExecutionUnits
  -- ^ Max total script execution resources units allowed per tx
  --
  -- /Introduced in Alonzo/
  , ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits :: Maybe ExecutionUnits
  -- ^ Max total script execution resources units allowed per block
  --
  -- /Introduced in Alonzo/
  , ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxValueSize :: Maybe Natural
  -- ^ Max size of a 'Value' in a tx output.
  --
  -- /Introduced in Alonzo/
  , ProtocolParametersUpdate -> Maybe Natural
protocolUpdateCollateralPercent :: Maybe Natural
  -- ^ The percentage of the script contribution to the txfee that must be
  -- provided as collateral inputs when including Plutus scripts.
  --
  -- /Introduced in Alonzo/
  , ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxCollateralInputs :: Maybe Natural
  -- ^ The maximum number of collateral inputs allowed in a transaction.
  --
  -- /Introduced in Alonzo/
  , ProtocolParametersUpdate -> Maybe Coin
protocolUpdateUTxOCostPerByte :: Maybe L.Coin
  -- ^ Cost in ada per byte of UTxO storage.
  --
  -- /Introduced in Babbage/
  }
  deriving (ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
(ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool)
-> (ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool)
-> Eq ProtocolParametersUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
== :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
$c/= :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
/= :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
Eq, Int -> ProtocolParametersUpdate -> ShowS
[ProtocolParametersUpdate] -> ShowS
ProtocolParametersUpdate -> String
(Int -> ProtocolParametersUpdate -> ShowS)
-> (ProtocolParametersUpdate -> String)
-> ([ProtocolParametersUpdate] -> ShowS)
-> Show ProtocolParametersUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtocolParametersUpdate -> ShowS
showsPrec :: Int -> ProtocolParametersUpdate -> ShowS
$cshow :: ProtocolParametersUpdate -> String
show :: ProtocolParametersUpdate -> String
$cshowList :: [ProtocolParametersUpdate] -> ShowS
showList :: [ProtocolParametersUpdate] -> ShowS
Show)

instance Semigroup ProtocolParametersUpdate where
  ProtocolParametersUpdate
ppu1 <> :: ProtocolParametersUpdate
-> ProtocolParametersUpdate -> ProtocolParametersUpdate
<> ProtocolParametersUpdate
ppu2 =
    ProtocolParametersUpdate
      { protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
protocolUpdateProtocolVersion = (ProtocolParametersUpdate -> Maybe (Natural, Natural))
-> Maybe (Natural, Natural)
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe (Natural, Natural)
protocolUpdateProtocolVersion
      , protocolUpdateDecentralization :: Maybe Rational
protocolUpdateDecentralization = (ProtocolParametersUpdate -> Maybe Rational) -> Maybe Rational
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Rational
protocolUpdateDecentralization
      , protocolUpdateExtraPraosEntropy :: Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy = (ProtocolParametersUpdate -> Maybe (Maybe PraosNonce))
-> Maybe (Maybe PraosNonce)
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy
      , protocolUpdateMaxBlockHeaderSize :: Maybe Word16
protocolUpdateMaxBlockHeaderSize = (ProtocolParametersUpdate -> Maybe Word16) -> Maybe Word16
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Word16
protocolUpdateMaxBlockHeaderSize
      , protocolUpdateMaxBlockBodySize :: Maybe Word32
protocolUpdateMaxBlockBodySize = (ProtocolParametersUpdate -> Maybe Word32) -> Maybe Word32
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Word32
protocolUpdateMaxBlockBodySize
      , protocolUpdateMaxTxSize :: Maybe Word32
protocolUpdateMaxTxSize = (ProtocolParametersUpdate -> Maybe Word32) -> Maybe Word32
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Word32
protocolUpdateMaxTxSize
      , protocolUpdateTxFeeFixed :: Maybe Coin
protocolUpdateTxFeeFixed = (ProtocolParametersUpdate -> Maybe Coin) -> Maybe Coin
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Coin
protocolUpdateTxFeeFixed
      , protocolUpdateTxFeePerByte :: Maybe Coin
protocolUpdateTxFeePerByte = (ProtocolParametersUpdate -> Maybe Coin) -> Maybe Coin
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Coin
protocolUpdateTxFeePerByte
      , protocolUpdateMinUTxOValue :: Maybe Coin
protocolUpdateMinUTxOValue = (ProtocolParametersUpdate -> Maybe Coin) -> Maybe Coin
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Coin
protocolUpdateMinUTxOValue
      , protocolUpdateStakeAddressDeposit :: Maybe Coin
protocolUpdateStakeAddressDeposit = (ProtocolParametersUpdate -> Maybe Coin) -> Maybe Coin
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Coin
protocolUpdateStakeAddressDeposit
      , protocolUpdateStakePoolDeposit :: Maybe Coin
protocolUpdateStakePoolDeposit = (ProtocolParametersUpdate -> Maybe Coin) -> Maybe Coin
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Coin
protocolUpdateStakePoolDeposit
      , protocolUpdateMinPoolCost :: Maybe Coin
protocolUpdateMinPoolCost = (ProtocolParametersUpdate -> Maybe Coin) -> Maybe Coin
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Coin
protocolUpdateMinPoolCost
      , protocolUpdatePoolRetireMaxEpoch :: Maybe EpochInterval
protocolUpdatePoolRetireMaxEpoch = (ProtocolParametersUpdate -> Maybe EpochInterval)
-> Maybe EpochInterval
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe EpochInterval
protocolUpdatePoolRetireMaxEpoch
      , protocolUpdateStakePoolTargetNum :: Maybe Natural
protocolUpdateStakePoolTargetNum = (ProtocolParametersUpdate -> Maybe Natural) -> Maybe Natural
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Natural
protocolUpdateStakePoolTargetNum
      , protocolUpdatePoolPledgeInfluence :: Maybe Rational
protocolUpdatePoolPledgeInfluence = (ProtocolParametersUpdate -> Maybe Rational) -> Maybe Rational
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Rational
protocolUpdatePoolPledgeInfluence
      , protocolUpdateMonetaryExpansion :: Maybe Rational
protocolUpdateMonetaryExpansion = (ProtocolParametersUpdate -> Maybe Rational) -> Maybe Rational
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Rational
protocolUpdateMonetaryExpansion
      , protocolUpdateTreasuryCut :: Maybe Rational
protocolUpdateTreasuryCut = (ProtocolParametersUpdate -> Maybe Rational) -> Maybe Rational
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Rational
protocolUpdateTreasuryCut
      , -- Introduced in Alonzo below.
        protocolUpdateCostModels :: Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels = (ProtocolParametersUpdate -> Map AnyPlutusScriptVersion CostModel)
-> Map AnyPlutusScriptVersion CostModel
forall k a.
Ord k =>
(ProtocolParametersUpdate -> Map k a) -> Map k a
mergeMap ProtocolParametersUpdate -> Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels
      , protocolUpdatePrices :: Maybe ExecutionUnitPrices
protocolUpdatePrices = (ProtocolParametersUpdate -> Maybe ExecutionUnitPrices)
-> Maybe ExecutionUnitPrices
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe ExecutionUnitPrices
protocolUpdatePrices
      , protocolUpdateMaxTxExUnits :: Maybe ExecutionUnits
protocolUpdateMaxTxExUnits = (ProtocolParametersUpdate -> Maybe ExecutionUnits)
-> Maybe ExecutionUnits
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxTxExUnits
      , protocolUpdateMaxBlockExUnits :: Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits = (ProtocolParametersUpdate -> Maybe ExecutionUnits)
-> Maybe ExecutionUnits
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits
      , protocolUpdateMaxValueSize :: Maybe Natural
protocolUpdateMaxValueSize = (ProtocolParametersUpdate -> Maybe Natural) -> Maybe Natural
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxValueSize
      , protocolUpdateCollateralPercent :: Maybe Natural
protocolUpdateCollateralPercent = (ProtocolParametersUpdate -> Maybe Natural) -> Maybe Natural
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Natural
protocolUpdateCollateralPercent
      , protocolUpdateMaxCollateralInputs :: Maybe Natural
protocolUpdateMaxCollateralInputs = (ProtocolParametersUpdate -> Maybe Natural) -> Maybe Natural
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxCollateralInputs
      , -- Introduced in Babbage below.
        protocolUpdateUTxOCostPerByte :: Maybe Coin
protocolUpdateUTxOCostPerByte = (ProtocolParametersUpdate -> Maybe Coin) -> Maybe Coin
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Coin
protocolUpdateUTxOCostPerByte
      }
   where
    -- prefer the right hand side:
    merge :: (ProtocolParametersUpdate -> Maybe a) -> Maybe a
    merge :: forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe a
f = ProtocolParametersUpdate -> Maybe a
f ProtocolParametersUpdate
ppu2 Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ProtocolParametersUpdate -> Maybe a
f ProtocolParametersUpdate
ppu1

    -- prefer the right hand side:
    mergeMap :: Ord k => (ProtocolParametersUpdate -> Map k a) -> Map k a
    mergeMap :: forall k a.
Ord k =>
(ProtocolParametersUpdate -> Map k a) -> Map k a
mergeMap ProtocolParametersUpdate -> Map k a
f = ProtocolParametersUpdate -> Map k a
f ProtocolParametersUpdate
ppu2 Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` ProtocolParametersUpdate -> Map k a
f ProtocolParametersUpdate
ppu1

instance Monoid ProtocolParametersUpdate where
  mempty :: ProtocolParametersUpdate
mempty =
    ProtocolParametersUpdate
      { protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
protocolUpdateProtocolVersion = Maybe (Natural, Natural)
forall a. Maybe a
Nothing
      , protocolUpdateDecentralization :: Maybe Rational
protocolUpdateDecentralization = Maybe Rational
forall a. Maybe a
Nothing
      , protocolUpdateExtraPraosEntropy :: Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy = Maybe (Maybe PraosNonce)
forall a. Maybe a
Nothing
      , protocolUpdateMaxBlockHeaderSize :: Maybe Word16
protocolUpdateMaxBlockHeaderSize = Maybe Word16
forall a. Maybe a
Nothing
      , protocolUpdateMaxBlockBodySize :: Maybe Word32
protocolUpdateMaxBlockBodySize = Maybe Word32
forall a. Maybe a
Nothing
      , protocolUpdateMaxTxSize :: Maybe Word32
protocolUpdateMaxTxSize = Maybe Word32
forall a. Maybe a
Nothing
      , protocolUpdateTxFeeFixed :: Maybe Coin
protocolUpdateTxFeeFixed = Maybe Coin
forall a. Maybe a
Nothing
      , protocolUpdateTxFeePerByte :: Maybe Coin
protocolUpdateTxFeePerByte = Maybe Coin
forall a. Maybe a
Nothing
      , protocolUpdateMinUTxOValue :: Maybe Coin
protocolUpdateMinUTxOValue = Maybe Coin
forall a. Maybe a
Nothing
      , protocolUpdateStakeAddressDeposit :: Maybe Coin
protocolUpdateStakeAddressDeposit = Maybe Coin
forall a. Maybe a
Nothing
      , protocolUpdateStakePoolDeposit :: Maybe Coin
protocolUpdateStakePoolDeposit = Maybe Coin
forall a. Maybe a
Nothing
      , protocolUpdateMinPoolCost :: Maybe Coin
protocolUpdateMinPoolCost = Maybe Coin
forall a. Maybe a
Nothing
      , protocolUpdatePoolRetireMaxEpoch :: Maybe EpochInterval
protocolUpdatePoolRetireMaxEpoch = Maybe EpochInterval
forall a. Maybe a
Nothing
      , protocolUpdateStakePoolTargetNum :: Maybe Natural
protocolUpdateStakePoolTargetNum = Maybe Natural
forall a. Maybe a
Nothing
      , protocolUpdatePoolPledgeInfluence :: Maybe Rational
protocolUpdatePoolPledgeInfluence = Maybe Rational
forall a. Maybe a
Nothing
      , protocolUpdateMonetaryExpansion :: Maybe Rational
protocolUpdateMonetaryExpansion = Maybe Rational
forall a. Maybe a
Nothing
      , protocolUpdateTreasuryCut :: Maybe Rational
protocolUpdateTreasuryCut = Maybe Rational
forall a. Maybe a
Nothing
      , protocolUpdateCostModels :: Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels = Map AnyPlutusScriptVersion CostModel
forall a. Monoid a => a
mempty
      , protocolUpdatePrices :: Maybe ExecutionUnitPrices
protocolUpdatePrices = Maybe ExecutionUnitPrices
forall a. Maybe a
Nothing
      , protocolUpdateMaxTxExUnits :: Maybe ExecutionUnits
protocolUpdateMaxTxExUnits = Maybe ExecutionUnits
forall a. Maybe a
Nothing
      , protocolUpdateMaxBlockExUnits :: Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits = Maybe ExecutionUnits
forall a. Maybe a
Nothing
      , protocolUpdateMaxValueSize :: Maybe Natural
protocolUpdateMaxValueSize = Maybe Natural
forall a. Maybe a
Nothing
      , protocolUpdateCollateralPercent :: Maybe Natural
protocolUpdateCollateralPercent = Maybe Natural
forall a. Maybe a
Nothing
      , protocolUpdateMaxCollateralInputs :: Maybe Natural
protocolUpdateMaxCollateralInputs = Maybe Natural
forall a. Maybe a
Nothing
      , protocolUpdateUTxOCostPerByte :: Maybe Coin
protocolUpdateUTxOCostPerByte = Maybe Coin
forall a. Maybe a
Nothing
      }

instance ToCBOR ProtocolParametersUpdate where
  toCBOR :: ProtocolParametersUpdate -> CBOR.Encoding
  toCBOR :: ProtocolParametersUpdate -> Encoding
toCBOR ProtocolParametersUpdate{Maybe Natural
Maybe (Maybe PraosNonce)
Maybe Rational
Maybe Word16
Maybe Word32
Maybe (Natural, Natural)
Maybe Coin
Maybe EpochInterval
Maybe ExecutionUnits
Maybe ExecutionUnitPrices
Map AnyPlutusScriptVersion CostModel
protocolUpdateProtocolVersion :: ProtocolParametersUpdate -> Maybe (Natural, Natural)
protocolUpdateDecentralization :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateExtraPraosEntropy :: ProtocolParametersUpdate -> Maybe (Maybe PraosNonce)
protocolUpdateMaxBlockHeaderSize :: ProtocolParametersUpdate -> Maybe Word16
protocolUpdateMaxBlockBodySize :: ProtocolParametersUpdate -> Maybe Word32
protocolUpdateMaxTxSize :: ProtocolParametersUpdate -> Maybe Word32
protocolUpdateTxFeeFixed :: ProtocolParametersUpdate -> Maybe Coin
protocolUpdateTxFeePerByte :: ProtocolParametersUpdate -> Maybe Coin
protocolUpdateMinUTxOValue :: ProtocolParametersUpdate -> Maybe Coin
protocolUpdateStakeAddressDeposit :: ProtocolParametersUpdate -> Maybe Coin
protocolUpdateStakePoolDeposit :: ProtocolParametersUpdate -> Maybe Coin
protocolUpdateMinPoolCost :: ProtocolParametersUpdate -> Maybe Coin
protocolUpdatePoolRetireMaxEpoch :: ProtocolParametersUpdate -> Maybe EpochInterval
protocolUpdateStakePoolTargetNum :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdatePoolPledgeInfluence :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateMonetaryExpansion :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateTreasuryCut :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateCostModels :: ProtocolParametersUpdate -> Map AnyPlutusScriptVersion CostModel
protocolUpdatePrices :: ProtocolParametersUpdate -> Maybe ExecutionUnitPrices
protocolUpdateMaxTxExUnits :: ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits :: ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxValueSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateCollateralPercent :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxCollateralInputs :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateUTxOCostPerByte :: ProtocolParametersUpdate -> Maybe Coin
protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
protocolUpdateDecentralization :: Maybe Rational
protocolUpdateExtraPraosEntropy :: Maybe (Maybe PraosNonce)
protocolUpdateMaxBlockHeaderSize :: Maybe Word16
protocolUpdateMaxBlockBodySize :: Maybe Word32
protocolUpdateMaxTxSize :: Maybe Word32
protocolUpdateTxFeeFixed :: Maybe Coin
protocolUpdateTxFeePerByte :: Maybe Coin
protocolUpdateMinUTxOValue :: Maybe Coin
protocolUpdateStakeAddressDeposit :: Maybe Coin
protocolUpdateStakePoolDeposit :: Maybe Coin
protocolUpdateMinPoolCost :: Maybe Coin
protocolUpdatePoolRetireMaxEpoch :: Maybe EpochInterval
protocolUpdateStakePoolTargetNum :: Maybe Natural
protocolUpdatePoolPledgeInfluence :: Maybe Rational
protocolUpdateMonetaryExpansion :: Maybe Rational
protocolUpdateTreasuryCut :: Maybe Rational
protocolUpdateCostModels :: Map AnyPlutusScriptVersion CostModel
protocolUpdatePrices :: Maybe ExecutionUnitPrices
protocolUpdateMaxTxExUnits :: Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits :: Maybe ExecutionUnits
protocolUpdateMaxValueSize :: Maybe Natural
protocolUpdateCollateralPercent :: Maybe Natural
protocolUpdateMaxCollateralInputs :: Maybe Natural
protocolUpdateUTxOCostPerByte :: Maybe Coin
..} =
    Word -> Encoding
CBOR.encodeListLen Word
26
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe (Natural, Natural) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe (Natural, Natural)
protocolUpdateProtocolVersion
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Rational -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Rational
protocolUpdateDecentralization
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe (Maybe PraosNonce) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Word16 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Word16
protocolUpdateMaxBlockHeaderSize
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Word32 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Word32
protocolUpdateMaxBlockBodySize
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Word32 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Word32
protocolUpdateMaxTxSize
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Coin
protocolUpdateTxFeeFixed
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Coin
protocolUpdateTxFeePerByte
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Coin
protocolUpdateMinUTxOValue
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Coin
protocolUpdateStakeAddressDeposit
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Coin
protocolUpdateStakePoolDeposit
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Coin
protocolUpdateMinPoolCost
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe EpochInterval -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe EpochInterval
protocolUpdatePoolRetireMaxEpoch
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Natural
protocolUpdateStakePoolTargetNum
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Rational -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Rational
protocolUpdatePoolPledgeInfluence
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Rational -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Rational
protocolUpdateMonetaryExpansion
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Rational -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Rational
protocolUpdateTreasuryCut
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map AnyPlutusScriptVersion CostModel -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe ExecutionUnitPrices -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe ExecutionUnitPrices
protocolUpdatePrices
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe ExecutionUnits -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe ExecutionUnits
protocolUpdateMaxTxExUnits
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe ExecutionUnits -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Natural
protocolUpdateMaxValueSize
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Natural
protocolUpdateCollateralPercent
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Natural
protocolUpdateMaxCollateralInputs
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Coin
protocolUpdateUTxOCostPerByte

instance FromCBOR ProtocolParametersUpdate where
  fromCBOR :: forall s. Decoder s ProtocolParametersUpdate
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
CBOR.enforceSize Text
"ProtocolParametersUpdate" Int
26
    Maybe (Natural, Natural)
-> Maybe Rational
-> Maybe (Maybe PraosNonce)
-> Maybe Word16
-> Maybe Word32
-> Maybe Word32
-> Maybe Coin
-> Maybe Coin
-> Maybe Coin
-> Maybe Coin
-> Maybe Coin
-> Maybe Coin
-> Maybe EpochInterval
-> Maybe Natural
-> Maybe Rational
-> Maybe Rational
-> Maybe Rational
-> Map AnyPlutusScriptVersion CostModel
-> Maybe ExecutionUnitPrices
-> Maybe ExecutionUnits
-> Maybe ExecutionUnits
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Coin
-> ProtocolParametersUpdate
ProtocolParametersUpdate
      (Maybe (Natural, Natural)
 -> Maybe Rational
 -> Maybe (Maybe PraosNonce)
 -> Maybe Word16
 -> Maybe Word32
 -> Maybe Word32
 -> Maybe Coin
 -> Maybe Coin
 -> Maybe Coin
 -> Maybe Coin
 -> Maybe Coin
 -> Maybe Coin
 -> Maybe EpochInterval
 -> Maybe Natural
 -> Maybe Rational
 -> Maybe Rational
 -> Maybe Rational
 -> Map AnyPlutusScriptVersion CostModel
 -> Maybe ExecutionUnitPrices
 -> Maybe ExecutionUnits
 -> Maybe ExecutionUnits
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Coin
 -> ProtocolParametersUpdate)
-> Decoder s (Maybe (Natural, Natural))
-> Decoder
     s
     (Maybe Rational
      -> Maybe (Maybe PraosNonce)
      -> Maybe Word16
      -> Maybe Word32
      -> Maybe Word32
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Maybe (Natural, Natural))
forall s. Decoder s (Maybe (Natural, Natural))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Rational
   -> Maybe (Maybe PraosNonce)
   -> Maybe Word16
   -> Maybe Word32
   -> Maybe Word32
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Rational)
-> Decoder
     s
     (Maybe (Maybe PraosNonce)
      -> Maybe Word16
      -> Maybe Word32
      -> Maybe Word32
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Rational)
forall s. Decoder s (Maybe Rational)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe (Maybe PraosNonce)
   -> Maybe Word16
   -> Maybe Word32
   -> Maybe Word32
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe (Maybe PraosNonce))
-> Decoder
     s
     (Maybe Word16
      -> Maybe Word32
      -> Maybe Word32
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe (Maybe PraosNonce))
forall s. Decoder s (Maybe (Maybe PraosNonce))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Word16
   -> Maybe Word32
   -> Maybe Word32
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Word16)
-> Decoder
     s
     (Maybe Word32
      -> Maybe Word32
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Word16)
forall s. Decoder s (Maybe Word16)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Word32
   -> Maybe Word32
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Word32)
-> Decoder
     s
     (Maybe Word32
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Word32)
forall s. Decoder s (Maybe Word32)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Word32
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Word32)
-> Decoder
     s
     (Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Word32)
forall s. Decoder s (Maybe Word32)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Coin)
-> Decoder
     s
     (Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Coin)
forall s. Decoder s (Maybe Coin)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Coin)
-> Decoder
     s
     (Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Coin)
forall s. Decoder s (Maybe Coin)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Coin)
-> Decoder
     s
     (Maybe Coin
      -> Maybe Coin
      -> Maybe Coin
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Coin)
forall s. Decoder s (Maybe Coin)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Coin
   -> Maybe Coin
   -> Maybe Coin
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Coin)
-> Decoder
     s
     (Maybe Coin
      -> Maybe Coin
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Coin)
forall s. Decoder s (Maybe Coin)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Coin
   -> Maybe Coin
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Coin)
-> Decoder
     s
     (Maybe Coin
      -> Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Coin)
forall s. Decoder s (Maybe Coin)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Coin
   -> Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Coin)
-> Decoder
     s
     (Maybe EpochInterval
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Coin)
forall s. Decoder s (Maybe Coin)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe EpochInterval
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe EpochInterval)
-> Decoder
     s
     (Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe EpochInterval)
forall s. Decoder s (Maybe EpochInterval)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s
     (Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall s. Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Rational)
-> Decoder
     s
     (Maybe Rational
      -> Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Rational)
forall s. Decoder s (Maybe Rational)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Rational
   -> Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Rational)
-> Decoder
     s
     (Maybe Rational
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Rational)
forall s. Decoder s (Maybe Rational)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Rational
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Rational)
-> Decoder
     s
     (Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Rational)
forall s. Decoder s (Maybe Rational)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Map AnyPlutusScriptVersion CostModel)
-> Decoder
     s
     (Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Map AnyPlutusScriptVersion CostModel)
forall s. Decoder s (Map AnyPlutusScriptVersion CostModel)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe ExecutionUnitPrices)
-> Decoder
     s
     (Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe ExecutionUnitPrices)
forall s. Decoder s (Maybe ExecutionUnitPrices)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe ExecutionUnits)
-> Decoder
     s
     (Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe ExecutionUnits)
forall s. Decoder s (Maybe ExecutionUnits)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe ExecutionUnits)
-> Decoder
     s
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Coin
      -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe ExecutionUnits)
forall s. Decoder s (Maybe ExecutionUnits)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Coin
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s
     (Maybe Natural
      -> Maybe Natural -> Maybe Coin -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall s. Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Natural
   -> Maybe Natural -> Maybe Coin -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s (Maybe Natural -> Maybe Coin -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall s. Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Maybe Natural -> Maybe Coin -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder s (Maybe Coin -> ProtocolParametersUpdate)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall s. Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Maybe Coin -> ProtocolParametersUpdate)
-> Decoder s (Maybe Coin) -> Decoder s ProtocolParametersUpdate
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Coin)
forall s. Decoder s (Maybe Coin)
forall a s. FromCBOR a => Decoder s a
fromCBOR

-- ----------------------------------------------------------------------------
-- Praos nonce
--

newtype PraosNonce = PraosNonce {PraosNonce -> Hash StandardCrypto ByteString
unPraosNonce :: Ledger.Hash StandardCrypto ByteString}
  deriving stock (PraosNonce -> PraosNonce -> Bool
(PraosNonce -> PraosNonce -> Bool)
-> (PraosNonce -> PraosNonce -> Bool) -> Eq PraosNonce
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PraosNonce -> PraosNonce -> Bool
== :: PraosNonce -> PraosNonce -> Bool
$c/= :: PraosNonce -> PraosNonce -> Bool
/= :: PraosNonce -> PraosNonce -> Bool
Eq, Eq PraosNonce
Eq PraosNonce =>
(PraosNonce -> PraosNonce -> Ordering)
-> (PraosNonce -> PraosNonce -> Bool)
-> (PraosNonce -> PraosNonce -> Bool)
-> (PraosNonce -> PraosNonce -> Bool)
-> (PraosNonce -> PraosNonce -> Bool)
-> (PraosNonce -> PraosNonce -> PraosNonce)
-> (PraosNonce -> PraosNonce -> PraosNonce)
-> Ord PraosNonce
PraosNonce -> PraosNonce -> Bool
PraosNonce -> PraosNonce -> Ordering
PraosNonce -> PraosNonce -> PraosNonce
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 :: PraosNonce -> PraosNonce -> Ordering
compare :: PraosNonce -> PraosNonce -> Ordering
$c< :: PraosNonce -> PraosNonce -> Bool
< :: PraosNonce -> PraosNonce -> Bool
$c<= :: PraosNonce -> PraosNonce -> Bool
<= :: PraosNonce -> PraosNonce -> Bool
$c> :: PraosNonce -> PraosNonce -> Bool
> :: PraosNonce -> PraosNonce -> Bool
$c>= :: PraosNonce -> PraosNonce -> Bool
>= :: PraosNonce -> PraosNonce -> Bool
$cmax :: PraosNonce -> PraosNonce -> PraosNonce
max :: PraosNonce -> PraosNonce -> PraosNonce
$cmin :: PraosNonce -> PraosNonce -> PraosNonce
min :: PraosNonce -> PraosNonce -> PraosNonce
Ord, (forall x. PraosNonce -> Rep PraosNonce x)
-> (forall x. Rep PraosNonce x -> PraosNonce) -> Generic PraosNonce
forall x. Rep PraosNonce x -> PraosNonce
forall x. PraosNonce -> Rep PraosNonce x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PraosNonce -> Rep PraosNonce x
from :: forall x. PraosNonce -> Rep PraosNonce x
$cto :: forall x. Rep PraosNonce x -> PraosNonce
to :: forall x. Rep PraosNonce x -> PraosNonce
Generic)
  deriving (Int -> PraosNonce -> ShowS
[PraosNonce] -> ShowS
PraosNonce -> String
(Int -> PraosNonce -> ShowS)
-> (PraosNonce -> String)
-> ([PraosNonce] -> ShowS)
-> Show PraosNonce
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PraosNonce -> ShowS
showsPrec :: Int -> PraosNonce -> ShowS
$cshow :: PraosNonce -> String
show :: PraosNonce -> String
$cshowList :: [PraosNonce] -> ShowS
showList :: [PraosNonce] -> ShowS
Show, String -> PraosNonce
(String -> PraosNonce) -> IsString PraosNonce
forall a. (String -> a) -> IsString a
$cfromString :: String -> PraosNonce
fromString :: String -> PraosNonce
IsString) via UsingRawBytesHex PraosNonce
  deriving ([PraosNonce] -> Value
[PraosNonce] -> Encoding
PraosNonce -> Bool
PraosNonce -> Value
PraosNonce -> Encoding
(PraosNonce -> Value)
-> (PraosNonce -> Encoding)
-> ([PraosNonce] -> Value)
-> ([PraosNonce] -> Encoding)
-> (PraosNonce -> Bool)
-> ToJSON PraosNonce
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PraosNonce -> Value
toJSON :: PraosNonce -> Value
$ctoEncoding :: PraosNonce -> Encoding
toEncoding :: PraosNonce -> Encoding
$ctoJSONList :: [PraosNonce] -> Value
toJSONList :: [PraosNonce] -> Value
$ctoEncodingList :: [PraosNonce] -> Encoding
toEncodingList :: [PraosNonce] -> Encoding
$comitField :: PraosNonce -> Bool
omitField :: PraosNonce -> Bool
ToJSON, Maybe PraosNonce
Value -> Parser [PraosNonce]
Value -> Parser PraosNonce
(Value -> Parser PraosNonce)
-> (Value -> Parser [PraosNonce])
-> Maybe PraosNonce
-> FromJSON PraosNonce
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser PraosNonce
parseJSON :: Value -> Parser PraosNonce
$cparseJSONList :: Value -> Parser [PraosNonce]
parseJSONList :: Value -> Parser [PraosNonce]
$comittedField :: Maybe PraosNonce
omittedField :: Maybe PraosNonce
FromJSON) via UsingRawBytesHex PraosNonce
  deriving (Typeable PraosNonce
Typeable PraosNonce =>
(PraosNonce -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy PraosNonce -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [PraosNonce] -> Size)
-> ToCBOR PraosNonce
PraosNonce -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PraosNonce] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy PraosNonce -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: PraosNonce -> Encoding
toCBOR :: PraosNonce -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy PraosNonce -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy PraosNonce -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PraosNonce] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PraosNonce] -> Size
ToCBOR, Typeable PraosNonce
Typeable PraosNonce =>
(forall s. Decoder s PraosNonce)
-> (Proxy PraosNonce -> Text) -> FromCBOR PraosNonce
Proxy PraosNonce -> Text
forall s. Decoder s PraosNonce
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s PraosNonce
fromCBOR :: forall s. Decoder s PraosNonce
$clabel :: Proxy PraosNonce -> Text
label :: Proxy PraosNonce -> Text
FromCBOR) via UsingRawBytes PraosNonce

instance HasTypeProxy PraosNonce where
  data AsType PraosNonce = AsPraosNonce
  proxyToAsType :: Proxy PraosNonce -> AsType PraosNonce
proxyToAsType Proxy PraosNonce
_ = AsType PraosNonce
AsPraosNonce

instance SerialiseAsRawBytes PraosNonce where
  serialiseToRawBytes :: PraosNonce -> ByteString
serialiseToRawBytes (PraosNonce Hash StandardCrypto ByteString
h) =
    Hash Blake2b_256 ByteString -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_256 ByteString
Hash StandardCrypto ByteString
h

  deserialiseFromRawBytes :: AsType PraosNonce
-> ByteString -> Either SerialiseAsRawBytesError PraosNonce
deserialiseFromRawBytes AsType PraosNonce
R:AsTypePraosNonce
AsPraosNonce ByteString
bs =
    SerialiseAsRawBytesError
-> Maybe PraosNonce -> Either SerialiseAsRawBytesError PraosNonce
forall b a. b -> Maybe a -> Either b a
maybeToRight (String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError String
"Unable to deserialise PraosNonce") (Maybe PraosNonce -> Either SerialiseAsRawBytesError PraosNonce)
-> Maybe PraosNonce -> Either SerialiseAsRawBytesError PraosNonce
forall a b. (a -> b) -> a -> b
$
      Hash Blake2b_256 ByteString -> PraosNonce
Hash StandardCrypto ByteString -> PraosNonce
PraosNonce (Hash Blake2b_256 ByteString -> PraosNonce)
-> Maybe (Hash Blake2b_256 ByteString) -> Maybe PraosNonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_256 ByteString)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

makePraosNonce :: ByteString -> PraosNonce
makePraosNonce :: ByteString -> PraosNonce
makePraosNonce = Hash Blake2b_256 ByteString -> PraosNonce
Hash StandardCrypto ByteString -> PraosNonce
PraosNonce (Hash Blake2b_256 ByteString -> PraosNonce)
-> (ByteString -> Hash Blake2b_256 ByteString)
-> ByteString
-> PraosNonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith ByteString -> ByteString
forall a. a -> a
id

toLedgerNonce :: Maybe PraosNonce -> Ledger.Nonce
toLedgerNonce :: Maybe PraosNonce -> Nonce
toLedgerNonce Maybe PraosNonce
Nothing = Nonce
Ledger.NeutralNonce
toLedgerNonce (Just (PraosNonce Hash StandardCrypto ByteString
h)) = Hash Blake2b_256 Nonce -> Nonce
Ledger.Nonce (Hash Blake2b_256 ByteString -> Hash Blake2b_256 Nonce
forall h a b. Hash h a -> Hash h b
Crypto.castHash Hash Blake2b_256 ByteString
Hash StandardCrypto ByteString
h)

fromLedgerNonce :: Ledger.Nonce -> Maybe PraosNonce
fromLedgerNonce :: Nonce -> Maybe PraosNonce
fromLedgerNonce Nonce
Ledger.NeutralNonce = Maybe PraosNonce
forall a. Maybe a
Nothing
fromLedgerNonce (Ledger.Nonce Hash Blake2b_256 Nonce
h) = PraosNonce -> Maybe PraosNonce
forall a. a -> Maybe a
Just (Hash StandardCrypto ByteString -> PraosNonce
PraosNonce (Hash Blake2b_256 Nonce -> Hash Blake2b_256 ByteString
forall h a b. Hash h a -> Hash h b
Crypto.castHash Hash Blake2b_256 Nonce
h))

-- ----------------------------------------------------------------------------
-- Script execution unit prices and cost models
--

-- | The prices for 'ExecutionUnits' as a fraction of a 'L.Coin'.
--
-- These are used to determine the fee for the use of a script within a
-- transaction, based on the 'ExecutionUnits' needed by the use of the script.
data ExecutionUnitPrices
  = ExecutionUnitPrices
  { ExecutionUnitPrices -> Rational
priceExecutionSteps :: Rational
  , ExecutionUnitPrices -> Rational
priceExecutionMemory :: Rational
  }
  deriving (ExecutionUnitPrices -> ExecutionUnitPrices -> Bool
(ExecutionUnitPrices -> ExecutionUnitPrices -> Bool)
-> (ExecutionUnitPrices -> ExecutionUnitPrices -> Bool)
-> Eq ExecutionUnitPrices
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExecutionUnitPrices -> ExecutionUnitPrices -> Bool
== :: ExecutionUnitPrices -> ExecutionUnitPrices -> Bool
$c/= :: ExecutionUnitPrices -> ExecutionUnitPrices -> Bool
/= :: ExecutionUnitPrices -> ExecutionUnitPrices -> Bool
Eq, Int -> ExecutionUnitPrices -> ShowS
[ExecutionUnitPrices] -> ShowS
ExecutionUnitPrices -> String
(Int -> ExecutionUnitPrices -> ShowS)
-> (ExecutionUnitPrices -> String)
-> ([ExecutionUnitPrices] -> ShowS)
-> Show ExecutionUnitPrices
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecutionUnitPrices -> ShowS
showsPrec :: Int -> ExecutionUnitPrices -> ShowS
$cshow :: ExecutionUnitPrices -> String
show :: ExecutionUnitPrices -> String
$cshowList :: [ExecutionUnitPrices] -> ShowS
showList :: [ExecutionUnitPrices] -> ShowS
Show)

instance ToCBOR ExecutionUnitPrices where
  toCBOR :: ExecutionUnitPrices -> Encoding
toCBOR ExecutionUnitPrices{Rational
priceExecutionSteps :: ExecutionUnitPrices -> Rational
priceExecutionSteps :: Rational
priceExecutionSteps, Rational
priceExecutionMemory :: ExecutionUnitPrices -> Rational
priceExecutionMemory :: Rational
priceExecutionMemory} =
    Word -> Encoding
CBOR.encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Rational -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Rational
priceExecutionSteps
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Rational -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Rational
priceExecutionMemory

instance FromCBOR ExecutionUnitPrices where
  fromCBOR :: forall s. Decoder s ExecutionUnitPrices
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
CBOR.enforceSize Text
"ExecutionUnitPrices" Int
2
    Rational -> Rational -> ExecutionUnitPrices
ExecutionUnitPrices
      (Rational -> Rational -> ExecutionUnitPrices)
-> Decoder s Rational
-> Decoder s (Rational -> ExecutionUnitPrices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Rational
forall s. Decoder s Rational
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Rational -> ExecutionUnitPrices)
-> Decoder s Rational -> Decoder s ExecutionUnitPrices
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Rational
forall s. Decoder s Rational
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ToJSON ExecutionUnitPrices where
  toJSON :: ExecutionUnitPrices -> Value
toJSON ExecutionUnitPrices{Rational
priceExecutionSteps :: ExecutionUnitPrices -> Rational
priceExecutionSteps :: Rational
priceExecutionSteps, Rational
priceExecutionMemory :: ExecutionUnitPrices -> Rational
priceExecutionMemory :: Rational
priceExecutionMemory} =
    [Pair] -> Value
object
      [ Key
"priceSteps" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
toRationalJSON Rational
priceExecutionSteps
      , Key
"priceMemory" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
toRationalJSON Rational
priceExecutionMemory
      ]

instance FromJSON ExecutionUnitPrices where
  parseJSON :: Value -> Parser ExecutionUnitPrices
parseJSON =
    String
-> (Object -> Parser ExecutionUnitPrices)
-> Value
-> Parser ExecutionUnitPrices
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExecutionUnitPrices" ((Object -> Parser ExecutionUnitPrices)
 -> Value -> Parser ExecutionUnitPrices)
-> (Object -> Parser ExecutionUnitPrices)
-> Value
-> Parser ExecutionUnitPrices
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      Rational -> Rational -> ExecutionUnitPrices
ExecutionUnitPrices
        (Rational -> Rational -> ExecutionUnitPrices)
-> Parser Rational -> Parser (Rational -> ExecutionUnitPrices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Rational
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"priceSteps"
        Parser (Rational -> ExecutionUnitPrices)
-> Parser Rational -> Parser ExecutionUnitPrices
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Rational
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"priceMemory"

toAlonzoPrices :: ExecutionUnitPrices -> Either ProtocolParametersConversionError Alonzo.Prices
toAlonzoPrices :: ExecutionUnitPrices
-> Either ProtocolParametersConversionError Prices
toAlonzoPrices
  ExecutionUnitPrices
    { Rational
priceExecutionSteps :: ExecutionUnitPrices -> Rational
priceExecutionSteps :: Rational
priceExecutionSteps
    , Rational
priceExecutionMemory :: ExecutionUnitPrices -> Rational
priceExecutionMemory :: Rational
priceExecutionMemory
    } = do
    NonNegativeInterval
prSteps <- String
-> Rational
-> Either ProtocolParametersConversionError NonNegativeInterval
forall b.
BoundedRational b =>
String -> Rational -> Either ProtocolParametersConversionError b
boundRationalEither String
"Steps" Rational
priceExecutionSteps
    NonNegativeInterval
prMem <- String
-> Rational
-> Either ProtocolParametersConversionError NonNegativeInterval
forall b.
BoundedRational b =>
String -> Rational -> Either ProtocolParametersConversionError b
boundRationalEither String
"Mem" Rational
priceExecutionMemory
    Prices -> Either ProtocolParametersConversionError Prices
forall a. a -> Either ProtocolParametersConversionError a
forall (m :: * -> *) a. Monad m => a -> m a
return
      Alonzo.Prices
        { NonNegativeInterval
prSteps :: NonNegativeInterval
prSteps :: NonNegativeInterval
Alonzo.prSteps
        , NonNegativeInterval
prMem :: NonNegativeInterval
prMem :: NonNegativeInterval
Alonzo.prMem
        }

fromAlonzoPrices :: Alonzo.Prices -> ExecutionUnitPrices
fromAlonzoPrices :: Prices -> ExecutionUnitPrices
fromAlonzoPrices Alonzo.Prices{NonNegativeInterval
prSteps :: Prices -> NonNegativeInterval
prSteps :: NonNegativeInterval
Alonzo.prSteps, NonNegativeInterval
prMem :: Prices -> NonNegativeInterval
prMem :: NonNegativeInterval
Alonzo.prMem} =
  ExecutionUnitPrices
    { priceExecutionSteps :: Rational
priceExecutionSteps = NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational NonNegativeInterval
prSteps
    , priceExecutionMemory :: Rational
priceExecutionMemory = NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational NonNegativeInterval
prMem
    }

-- ----------------------------------------------------------------------------
-- Script cost models
--

newtype CostModel = CostModel [Int64]
  deriving (CostModel -> CostModel -> Bool
(CostModel -> CostModel -> Bool)
-> (CostModel -> CostModel -> Bool) -> Eq CostModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CostModel -> CostModel -> Bool
== :: CostModel -> CostModel -> Bool
$c/= :: CostModel -> CostModel -> Bool
/= :: CostModel -> CostModel -> Bool
Eq, Int -> CostModel -> ShowS
[CostModel] -> ShowS
CostModel -> String
(Int -> CostModel -> ShowS)
-> (CostModel -> String)
-> ([CostModel] -> ShowS)
-> Show CostModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CostModel -> ShowS
showsPrec :: Int -> CostModel -> ShowS
$cshow :: CostModel -> String
show :: CostModel -> String
$cshowList :: [CostModel] -> ShowS
showList :: [CostModel] -> ShowS
Show, Typeable CostModel
Typeable CostModel =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CostModel -> c CostModel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CostModel)
-> (CostModel -> Constr)
-> (CostModel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CostModel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostModel))
-> ((forall b. Data b => b -> b) -> CostModel -> CostModel)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CostModel -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CostModel -> r)
-> (forall u. (forall d. Data d => d -> u) -> CostModel -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CostModel -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CostModel -> m CostModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CostModel -> m CostModel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CostModel -> m CostModel)
-> Data CostModel
CostModel -> Constr
CostModel -> DataType
(forall b. Data b => b -> b) -> CostModel -> CostModel
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CostModel -> u
forall u. (forall d. Data d => d -> u) -> CostModel -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostModel -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CostModel -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostModel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostModel -> c CostModel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CostModel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostModel)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostModel -> c CostModel
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostModel -> c CostModel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostModel
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostModel
$ctoConstr :: CostModel -> Constr
toConstr :: CostModel -> Constr
$cdataTypeOf :: CostModel -> DataType
dataTypeOf :: CostModel -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CostModel)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CostModel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostModel)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostModel)
$cgmapT :: (forall b. Data b => b -> b) -> CostModel -> CostModel
gmapT :: (forall b. Data b => b -> b) -> CostModel -> CostModel
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostModel -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostModel -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CostModel -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CostModel -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CostModel -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CostModel -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CostModel -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CostModel -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostModel -> m CostModel
Data)
  deriving newtype (Typeable CostModel
Typeable CostModel =>
(CostModel -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy CostModel -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [CostModel] -> Size)
-> ToCBOR CostModel
CostModel -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CostModel] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy CostModel -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: CostModel -> Encoding
toCBOR :: CostModel -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy CostModel -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy CostModel -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CostModel] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CostModel] -> Size
ToCBOR, Typeable CostModel
Typeable CostModel =>
(forall s. Decoder s CostModel)
-> (Proxy CostModel -> Text) -> FromCBOR CostModel
Proxy CostModel -> Text
forall s. Decoder s CostModel
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s CostModel
fromCBOR :: forall s. Decoder s CostModel
$clabel :: Proxy CostModel -> Text
label :: Proxy CostModel -> Text
FromCBOR)

newtype CostModels = CostModels {CostModels -> Map AnyPlutusScriptVersion CostModel
unCostModels :: Map AnyPlutusScriptVersion CostModel}
  deriving (CostModels -> CostModels -> Bool
(CostModels -> CostModels -> Bool)
-> (CostModels -> CostModels -> Bool) -> Eq CostModels
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CostModels -> CostModels -> Bool
== :: CostModels -> CostModels -> Bool
$c/= :: CostModels -> CostModels -> Bool
/= :: CostModels -> CostModels -> Bool
Eq, Int -> CostModels -> ShowS
[CostModels] -> ShowS
CostModels -> String
(Int -> CostModels -> ShowS)
-> (CostModels -> String)
-> ([CostModels] -> ShowS)
-> Show CostModels
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CostModels -> ShowS
showsPrec :: Int -> CostModels -> ShowS
$cshow :: CostModels -> String
show :: CostModels -> String
$cshowList :: [CostModels] -> ShowS
showList :: [CostModels] -> ShowS
Show)

instance FromJSON CostModels where
  parseJSON :: Value -> Parser CostModels
parseJSON Value
v = Map AnyPlutusScriptVersion CostModel -> CostModels
CostModels (Map AnyPlutusScriptVersion CostModel -> CostModels)
-> (CostModels -> Map AnyPlutusScriptVersion CostModel)
-> CostModels
-> CostModels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostModels -> Map AnyPlutusScriptVersion CostModel
fromAlonzoCostModels (CostModels -> CostModels)
-> Parser CostModels -> Parser CostModels
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser CostModels
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance ToJSON CostModels where
  toJSON :: CostModels -> Value
toJSON (CostModels Map AnyPlutusScriptVersion CostModel
costModels) =
    case Map AnyPlutusScriptVersion CostModel
-> Either ProtocolParametersConversionError CostModels
toAlonzoCostModels Map AnyPlutusScriptVersion CostModel
costModels of
      Left ProtocolParametersConversionError
err -> String -> Value
forall a. HasCallStack => String -> a
error (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ ProtocolParametersConversionError -> String
forall a. Error a => a -> String
displayError ProtocolParametersConversionError
err
      Right CostModels
ledgerCostModels -> CostModels -> Value
forall a. ToJSON a => a -> Value
toJSON CostModels
ledgerCostModels

toAlonzoCostModels
  :: Map AnyPlutusScriptVersion CostModel
  -> Either ProtocolParametersConversionError Alonzo.CostModels
toAlonzoCostModels :: Map AnyPlutusScriptVersion CostModel
-> Either ProtocolParametersConversionError CostModels
toAlonzoCostModels Map AnyPlutusScriptVersion CostModel
m = do
  [(Language, CostModel)]
f <- ((AnyPlutusScriptVersion, CostModel)
 -> Either ProtocolParametersConversionError (Language, CostModel))
-> [(AnyPlutusScriptVersion, CostModel)]
-> Either ProtocolParametersConversionError [(Language, CostModel)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (AnyPlutusScriptVersion, CostModel)
-> Either ProtocolParametersConversionError (Language, CostModel)
conv ([(AnyPlutusScriptVersion, CostModel)]
 -> Either
      ProtocolParametersConversionError [(Language, CostModel)])
-> [(AnyPlutusScriptVersion, CostModel)]
-> Either ProtocolParametersConversionError [(Language, CostModel)]
forall a b. (a -> b) -> a -> b
$ Map AnyPlutusScriptVersion CostModel
-> [Item (Map AnyPlutusScriptVersion CostModel)]
forall l. IsList l => l -> [Item l]
toList Map AnyPlutusScriptVersion CostModel
m
  CostModels -> Either ProtocolParametersConversionError CostModels
forall a b. b -> Either a b
Right (CostModels -> Either ProtocolParametersConversionError CostModels)
-> CostModels
-> Either ProtocolParametersConversionError CostModels
forall a b. (a -> b) -> a -> b
$ Map Language CostModel -> CostModels
Plutus.mkCostModels (Map Language CostModel -> CostModels)
-> Map Language CostModel -> CostModels
forall a b. (a -> b) -> a -> b
$ [Item (Map Language CostModel)] -> Map Language CostModel
forall l. IsList l => [Item l] -> l
fromList [(Language, CostModel)]
[Item (Map Language CostModel)]
f
 where
  conv
    :: (AnyPlutusScriptVersion, CostModel)
    -> Either ProtocolParametersConversionError (Plutus.Language, Alonzo.CostModel)
  conv :: (AnyPlutusScriptVersion, CostModel)
-> Either ProtocolParametersConversionError (Language, CostModel)
conv (AnyPlutusScriptVersion
anySVer, CostModel
cModel) = do
    CostModel
alonzoCostModel <- CostModel
-> Language -> Either ProtocolParametersConversionError CostModel
toAlonzoCostModel CostModel
cModel (AnyPlutusScriptVersion -> Language
toAlonzoScriptLanguage AnyPlutusScriptVersion
anySVer)
    (Language, CostModel)
-> Either ProtocolParametersConversionError (Language, CostModel)
forall a b. b -> Either a b
Right (AnyPlutusScriptVersion -> Language
toAlonzoScriptLanguage AnyPlutusScriptVersion
anySVer, CostModel
alonzoCostModel)

fromAlonzoCostModels
  :: Plutus.CostModels
  -> Map AnyPlutusScriptVersion CostModel
fromAlonzoCostModels :: CostModels -> Map AnyPlutusScriptVersion CostModel
fromAlonzoCostModels CostModels
cModels =
  [(AnyPlutusScriptVersion, CostModel)]
-> Map AnyPlutusScriptVersion CostModel
[Item (Map AnyPlutusScriptVersion CostModel)]
-> Map AnyPlutusScriptVersion CostModel
forall l. IsList l => [Item l] -> l
fromList
    ([(AnyPlutusScriptVersion, CostModel)]
 -> Map AnyPlutusScriptVersion CostModel)
-> ([(Language, CostModel)]
    -> [(AnyPlutusScriptVersion, CostModel)])
-> [(Language, CostModel)]
-> Map AnyPlutusScriptVersion CostModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Language, CostModel) -> (AnyPlutusScriptVersion, CostModel))
-> [(Language, CostModel)] -> [(AnyPlutusScriptVersion, CostModel)]
forall a b. (a -> b) -> [a] -> [b]
map ((Language -> AnyPlutusScriptVersion)
-> (CostModel -> CostModel)
-> (Language, CostModel)
-> (AnyPlutusScriptVersion, CostModel)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Language -> AnyPlutusScriptVersion
fromAlonzoScriptLanguage CostModel -> CostModel
fromAlonzoCostModel)
    ([(Language, CostModel)] -> Map AnyPlutusScriptVersion CostModel)
-> [(Language, CostModel)] -> Map AnyPlutusScriptVersion CostModel
forall a b. (a -> b) -> a -> b
$ Map Language CostModel -> [Item (Map Language CostModel)]
forall l. IsList l => l -> [Item l]
toList
    (Map Language CostModel -> [Item (Map Language CostModel)])
-> Map Language CostModel -> [Item (Map Language CostModel)]
forall a b. (a -> b) -> a -> b
$ CostModels -> Map Language CostModel
Plutus.costModelsValid CostModels
cModels

toAlonzoScriptLanguage :: AnyPlutusScriptVersion -> Plutus.Language
toAlonzoScriptLanguage :: AnyPlutusScriptVersion -> Language
toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV1) = Language
Plutus.PlutusV1
toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV2) = Language
Plutus.PlutusV2
toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV3) = Language
Plutus.PlutusV3

fromAlonzoScriptLanguage :: Plutus.Language -> AnyPlutusScriptVersion
fromAlonzoScriptLanguage :: Language -> AnyPlutusScriptVersion
fromAlonzoScriptLanguage Language
Plutus.PlutusV1 = PlutusScriptVersion PlutusScriptV1 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
fromAlonzoScriptLanguage Language
Plutus.PlutusV2 = PlutusScriptVersion PlutusScriptV2 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV2
PlutusScriptV2
fromAlonzoScriptLanguage Language
Plutus.PlutusV3 = PlutusScriptVersion PlutusScriptV3 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV3
PlutusScriptV3

toAlonzoCostModel
  :: CostModel -> Plutus.Language -> Either ProtocolParametersConversionError Alonzo.CostModel
toAlonzoCostModel :: CostModel
-> Language -> Either ProtocolParametersConversionError CostModel
toAlonzoCostModel (CostModel [Int64]
m) Language
l = (CostModelApplyError -> ProtocolParametersConversionError)
-> Either CostModelApplyError CostModel
-> Either ProtocolParametersConversionError CostModel
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (CostModel
-> CostModelApplyError -> ProtocolParametersConversionError
PpceInvalidCostModel ([Int64] -> CostModel
CostModel [Int64]
m)) (Either CostModelApplyError CostModel
 -> Either ProtocolParametersConversionError CostModel)
-> Either CostModelApplyError CostModel
-> Either ProtocolParametersConversionError CostModel
forall a b. (a -> b) -> a -> b
$ Language -> [Int64] -> Either CostModelApplyError CostModel
Alonzo.mkCostModel Language
l [Int64]
m

fromAlonzoCostModel :: Alonzo.CostModel -> CostModel
fromAlonzoCostModel :: CostModel -> CostModel
fromAlonzoCostModel CostModel
m = [Int64] -> CostModel
CostModel ([Int64] -> CostModel) -> [Int64] -> CostModel
forall a b. (a -> b) -> a -> b
$ CostModel -> [Int64]
Alonzo.getCostModelParams CostModel
m

-- ----------------------------------------------------------------------------
-- Proposals embedded in transactions to update protocol parameters
--

data UpdateProposal
  = UpdateProposal
      !(Map (Hash GenesisKey) ProtocolParametersUpdate)
      !EpochNo
  deriving stock (UpdateProposal -> UpdateProposal -> Bool
(UpdateProposal -> UpdateProposal -> Bool)
-> (UpdateProposal -> UpdateProposal -> Bool) -> Eq UpdateProposal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateProposal -> UpdateProposal -> Bool
== :: UpdateProposal -> UpdateProposal -> Bool
$c/= :: UpdateProposal -> UpdateProposal -> Bool
/= :: UpdateProposal -> UpdateProposal -> Bool
Eq, Int -> UpdateProposal -> ShowS
[UpdateProposal] -> ShowS
UpdateProposal -> String
(Int -> UpdateProposal -> ShowS)
-> (UpdateProposal -> String)
-> ([UpdateProposal] -> ShowS)
-> Show UpdateProposal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateProposal -> ShowS
showsPrec :: Int -> UpdateProposal -> ShowS
$cshow :: UpdateProposal -> String
show :: UpdateProposal -> String
$cshowList :: [UpdateProposal] -> ShowS
showList :: [UpdateProposal] -> ShowS
Show)
  deriving anyclass HasTypeProxy UpdateProposal
HasTypeProxy UpdateProposal =>
(UpdateProposal -> ByteString)
-> (AsType UpdateProposal
    -> ByteString -> Either DecoderError UpdateProposal)
-> SerialiseAsCBOR UpdateProposal
AsType UpdateProposal
-> ByteString -> Either DecoderError UpdateProposal
UpdateProposal -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: UpdateProposal -> ByteString
serialiseToCBOR :: UpdateProposal -> ByteString
$cdeserialiseFromCBOR :: AsType UpdateProposal
-> ByteString -> Either DecoderError UpdateProposal
deserialiseFromCBOR :: AsType UpdateProposal
-> ByteString -> Either DecoderError UpdateProposal
SerialiseAsCBOR

instance HasTypeProxy UpdateProposal where
  data AsType UpdateProposal = AsUpdateProposal
  proxyToAsType :: Proxy UpdateProposal -> AsType UpdateProposal
proxyToAsType Proxy UpdateProposal
_ = AsType UpdateProposal
AsUpdateProposal

instance HasTextEnvelope UpdateProposal where
  textEnvelopeType :: AsType UpdateProposal -> TextEnvelopeType
textEnvelopeType AsType UpdateProposal
_ = TextEnvelopeType
"UpdateProposalShelley"

instance ToCBOR UpdateProposal where
  toCBOR :: UpdateProposal -> Encoding
toCBOR (UpdateProposal Map (Hash GenesisKey) ProtocolParametersUpdate
ppup EpochNo
epochno) =
    Word -> Encoding
CBOR.encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (Hash GenesisKey) ProtocolParametersUpdate -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map (Hash GenesisKey) ProtocolParametersUpdate
ppup
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR EpochNo
epochno

instance FromCBOR UpdateProposal where
  fromCBOR :: forall s. Decoder s UpdateProposal
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
CBOR.enforceSize Text
"ProtocolParametersUpdate" Int
2
    Map (Hash GenesisKey) ProtocolParametersUpdate
-> EpochNo -> UpdateProposal
UpdateProposal
      (Map (Hash GenesisKey) ProtocolParametersUpdate
 -> EpochNo -> UpdateProposal)
-> Decoder s (Map (Hash GenesisKey) ProtocolParametersUpdate)
-> Decoder s (EpochNo -> UpdateProposal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map (Hash GenesisKey) ProtocolParametersUpdate)
forall s.
Decoder s (Map (Hash GenesisKey) ProtocolParametersUpdate)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (EpochNo -> UpdateProposal)
-> Decoder s EpochNo -> Decoder s UpdateProposal
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s EpochNo
forall s. Decoder s EpochNo
forall a s. FromCBOR a => Decoder s a
fromCBOR

makeShelleyUpdateProposal
  :: ProtocolParametersUpdate
  -> [Hash GenesisKey]
  -> EpochNo
  -> UpdateProposal
makeShelleyUpdateProposal :: ProtocolParametersUpdate
-> [Hash GenesisKey] -> EpochNo -> UpdateProposal
makeShelleyUpdateProposal ProtocolParametersUpdate
params [Hash GenesisKey]
genesisKeyHashes =
  -- TODO decide how to handle parameter validation
  --     for example we need to validate the Rational values can convert
  --     into the UnitInterval type ok.
  Map (Hash GenesisKey) ProtocolParametersUpdate
-> EpochNo -> UpdateProposal
UpdateProposal ([Item (Map (Hash GenesisKey) ProtocolParametersUpdate)]
-> Map (Hash GenesisKey) ProtocolParametersUpdate
forall l. IsList l => [Item l] -> l
fromList [(Hash GenesisKey
kh, ProtocolParametersUpdate
params) | Hash GenesisKey
kh <- [Hash GenesisKey]
genesisKeyHashes])

-- ----------------------------------------------------------------------------
-- Conversion functions: updates to ledger types
--

toLedgerUpdate
  :: ()
  => ShelleyBasedEra era
  -> UpdateProposal
  -> Either ProtocolParametersConversionError (Ledger.Update (ShelleyLedgerEra era))
toLedgerUpdate :: forall era.
ShelleyBasedEra era
-> UpdateProposal
-> Either
     ProtocolParametersConversionError (Update (ShelleyLedgerEra era))
toLedgerUpdate ShelleyBasedEra era
sbe (UpdateProposal Map (Hash GenesisKey) ProtocolParametersUpdate
ppup EpochNo
epochno) =
  (ProposedPPUpdates (ShelleyLedgerEra era)
-> EpochNo -> Update (ShelleyLedgerEra era)
forall era. ProposedPPUpdates era -> EpochNo -> Update era
`Ledger.Update` EpochNo
epochno) (ProposedPPUpdates (ShelleyLedgerEra era)
 -> Update (ShelleyLedgerEra era))
-> Either
     ProtocolParametersConversionError
     (ProposedPPUpdates (ShelleyLedgerEra era))
-> Either
     ProtocolParametersConversionError (Update (ShelleyLedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShelleyBasedEra era
-> Map (Hash GenesisKey) ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (ProposedPPUpdates (ShelleyLedgerEra era))
forall era.
ShelleyBasedEra era
-> Map (Hash GenesisKey) ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (ProposedPPUpdates (ShelleyLedgerEra era))
toLedgerProposedPPUpdates ShelleyBasedEra era
sbe Map (Hash GenesisKey) ProtocolParametersUpdate
ppup

toLedgerProposedPPUpdates
  :: ()
  => ShelleyBasedEra era
  -> Map (Hash GenesisKey) ProtocolParametersUpdate
  -> Either ProtocolParametersConversionError (Ledger.ProposedPPUpdates (ShelleyLedgerEra era))
toLedgerProposedPPUpdates :: forall era.
ShelleyBasedEra era
-> Map (Hash GenesisKey) ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (ProposedPPUpdates (ShelleyLedgerEra era))
toLedgerProposedPPUpdates ShelleyBasedEra era
sbe Map (Hash GenesisKey) ProtocolParametersUpdate
m =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Either
      ProtocolParametersConversionError
      (ProposedPPUpdates (ShelleyLedgerEra era)))
-> Either
     ProtocolParametersConversionError
     (ProposedPPUpdates (ShelleyLedgerEra era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  Either
    ProtocolParametersConversionError
    (ProposedPPUpdates (ShelleyLedgerEra era)))
 -> Either
      ProtocolParametersConversionError
      (ProposedPPUpdates (ShelleyLedgerEra era)))
-> (ShelleyBasedEraConstraints era =>
    Either
      ProtocolParametersConversionError
      (ProposedPPUpdates (ShelleyLedgerEra era)))
-> Either
     ProtocolParametersConversionError
     (ProposedPPUpdates (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
    Map
  (KeyHash 'Genesis (EraCrypto (ShelleyLedgerEra era)))
  (PParamsUpdate (ShelleyLedgerEra era))
-> ProposedPPUpdates (ShelleyLedgerEra era)
Map
  (KeyHash 'Genesis StandardCrypto)
  (PParamsUpdate (ShelleyLedgerEra era))
-> ProposedPPUpdates (ShelleyLedgerEra era)
forall era.
Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era)
-> ProposedPPUpdates era
Ledger.ProposedPPUpdates (Map
   (KeyHash 'Genesis StandardCrypto)
   (PParamsUpdate (ShelleyLedgerEra era))
 -> ProposedPPUpdates (ShelleyLedgerEra era))
-> (Map (Hash GenesisKey) (PParamsUpdate (ShelleyLedgerEra era))
    -> Map
         (KeyHash 'Genesis StandardCrypto)
         (PParamsUpdate (ShelleyLedgerEra era)))
-> Map (Hash GenesisKey) (PParamsUpdate (ShelleyLedgerEra era))
-> ProposedPPUpdates (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hash GenesisKey -> KeyHash 'Genesis StandardCrypto)
-> Map (Hash GenesisKey) (PParamsUpdate (ShelleyLedgerEra era))
-> Map
     (KeyHash 'Genesis StandardCrypto)
     (PParamsUpdate (ShelleyLedgerEra era))
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic (\(GenesisKeyHash KeyHash 'Genesis StandardCrypto
kh) -> KeyHash 'Genesis StandardCrypto
kh)
      (Map (Hash GenesisKey) (PParamsUpdate (ShelleyLedgerEra era))
 -> ProposedPPUpdates (ShelleyLedgerEra era))
-> Either
     ProtocolParametersConversionError
     (Map (Hash GenesisKey) (PParamsUpdate (ShelleyLedgerEra era)))
-> Either
     ProtocolParametersConversionError
     (ProposedPPUpdates (ShelleyLedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProtocolParametersUpdate
 -> Either
      ProtocolParametersConversionError
      (PParamsUpdate (ShelleyLedgerEra era)))
-> Map (Hash GenesisKey) ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (Map (Hash GenesisKey) (PParamsUpdate (ShelleyLedgerEra era)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Map (Hash GenesisKey) a -> f (Map (Hash GenesisKey) b)
traverse (ShelleyBasedEra era
-> ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (ShelleyLedgerEra era))
forall era.
ShelleyBasedEra era
-> ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (ShelleyLedgerEra era))
toLedgerPParamsUpdate ShelleyBasedEra era
sbe) Map (Hash GenesisKey) ProtocolParametersUpdate
m

toLedgerPParamsUpdate
  :: ShelleyBasedEra era
  -> ProtocolParametersUpdate
  -> Either ProtocolParametersConversionError (PParamsUpdate (ShelleyLedgerEra era))
toLedgerPParamsUpdate :: forall era.
ShelleyBasedEra era
-> ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (ShelleyLedgerEra era))
toLedgerPParamsUpdate ShelleyBasedEra era
ShelleyBasedEraShelley = ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (ShelleyEra StandardCrypto))
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (ShelleyLedgerEra era))
forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera, AtMostEra BabbageEra ledgerera) =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
toShelleyPParamsUpdate
toLedgerPParamsUpdate ShelleyBasedEra era
ShelleyBasedEraAllegra = ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (AllegraEra StandardCrypto))
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (ShelleyLedgerEra era))
forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera, AtMostEra BabbageEra ledgerera) =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
toShelleyPParamsUpdate
toLedgerPParamsUpdate ShelleyBasedEra era
ShelleyBasedEraMary = ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (MaryEra StandardCrypto))
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (ShelleyLedgerEra era))
forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera, AtMostEra BabbageEra ledgerera) =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
toShelleyPParamsUpdate
toLedgerPParamsUpdate ShelleyBasedEra era
ShelleyBasedEraAlonzo = ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (AlonzoEra StandardCrypto))
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (ShelleyLedgerEra era))
forall crypto.
Crypto crypto =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (AlonzoEra crypto))
toAlonzoPParamsUpdate
toLedgerPParamsUpdate ShelleyBasedEra era
ShelleyBasedEraBabbage = ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (BabbageEra StandardCrypto))
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (ShelleyLedgerEra era))
forall crypto.
Crypto crypto =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (BabbageEra crypto))
toBabbagePParamsUpdate
toLedgerPParamsUpdate ShelleyBasedEra era
ShelleyBasedEraConway = ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate StandardConway)
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (ShelleyLedgerEra era))
forall ledgerera.
BabbageEraPParams ledgerera =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
toConwayPParamsUpdate

toShelleyCommonPParamsUpdate
  :: EraPParams ledgerera
  => ProtocolParametersUpdate
  -> Either ProtocolParametersConversionError (PParamsUpdate ledgerera)
toShelleyCommonPParamsUpdate :: forall ledgerera.
EraPParams ledgerera =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
toShelleyCommonPParamsUpdate
  ProtocolParametersUpdate
    { Maybe Word16
protocolUpdateMaxBlockHeaderSize :: ProtocolParametersUpdate -> Maybe Word16
protocolUpdateMaxBlockHeaderSize :: Maybe Word16
protocolUpdateMaxBlockHeaderSize
    , Maybe Word32
protocolUpdateMaxBlockBodySize :: ProtocolParametersUpdate -> Maybe Word32
protocolUpdateMaxBlockBodySize :: Maybe Word32
protocolUpdateMaxBlockBodySize
    , Maybe Word32
protocolUpdateMaxTxSize :: ProtocolParametersUpdate -> Maybe Word32
protocolUpdateMaxTxSize :: Maybe Word32
protocolUpdateMaxTxSize
    , Maybe Coin
protocolUpdateTxFeeFixed :: ProtocolParametersUpdate -> Maybe Coin
protocolUpdateTxFeeFixed :: Maybe Coin
protocolUpdateTxFeeFixed
    , Maybe Coin
protocolUpdateTxFeePerByte :: ProtocolParametersUpdate -> Maybe Coin
protocolUpdateTxFeePerByte :: Maybe Coin
protocolUpdateTxFeePerByte
    , Maybe Coin
protocolUpdateStakeAddressDeposit :: ProtocolParametersUpdate -> Maybe Coin
protocolUpdateStakeAddressDeposit :: Maybe Coin
protocolUpdateStakeAddressDeposit
    , Maybe Coin
protocolUpdateStakePoolDeposit :: ProtocolParametersUpdate -> Maybe Coin
protocolUpdateStakePoolDeposit :: Maybe Coin
protocolUpdateStakePoolDeposit
    , Maybe Coin
protocolUpdateMinPoolCost :: ProtocolParametersUpdate -> Maybe Coin
protocolUpdateMinPoolCost :: Maybe Coin
protocolUpdateMinPoolCost
    , Maybe EpochInterval
protocolUpdatePoolRetireMaxEpoch :: ProtocolParametersUpdate -> Maybe EpochInterval
protocolUpdatePoolRetireMaxEpoch :: Maybe EpochInterval
protocolUpdatePoolRetireMaxEpoch
    , Maybe Natural
protocolUpdateStakePoolTargetNum :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateStakePoolTargetNum :: Maybe Natural
protocolUpdateStakePoolTargetNum
    , Maybe Rational
protocolUpdatePoolPledgeInfluence :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdatePoolPledgeInfluence :: Maybe Rational
protocolUpdatePoolPledgeInfluence
    , Maybe Rational
protocolUpdateMonetaryExpansion :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateMonetaryExpansion :: Maybe Rational
protocolUpdateMonetaryExpansion
    , Maybe Rational
protocolUpdateTreasuryCut :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateTreasuryCut :: Maybe Rational
protocolUpdateTreasuryCut
    } = do
    Maybe NonNegativeInterval
a0 <- (Rational
 -> Either ProtocolParametersConversionError NonNegativeInterval)
-> Maybe Rational
-> Either
     ProtocolParametersConversionError (Maybe NonNegativeInterval)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (String
-> Rational
-> Either ProtocolParametersConversionError NonNegativeInterval
forall b.
BoundedRational b =>
String -> Rational -> Either ProtocolParametersConversionError b
boundRationalEither String
"A0") Maybe Rational
protocolUpdatePoolPledgeInfluence
    Maybe UnitInterval
rho <- (Rational -> Either ProtocolParametersConversionError UnitInterval)
-> Maybe Rational
-> Either ProtocolParametersConversionError (Maybe UnitInterval)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (String
-> Rational
-> Either ProtocolParametersConversionError UnitInterval
forall b.
BoundedRational b =>
String -> Rational -> Either ProtocolParametersConversionError b
boundRationalEither String
"Rho") Maybe Rational
protocolUpdateMonetaryExpansion
    Maybe UnitInterval
tau <- (Rational -> Either ProtocolParametersConversionError UnitInterval)
-> Maybe Rational
-> Either ProtocolParametersConversionError (Maybe UnitInterval)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (String
-> Rational
-> Either ProtocolParametersConversionError UnitInterval
forall b.
BoundedRational b =>
String -> Rational -> Either ProtocolParametersConversionError b
boundRationalEither String
"Tau") Maybe Rational
protocolUpdateTreasuryCut
    let ppuCommon :: PParamsUpdate ledgerera
ppuCommon =
          PParamsUpdate ledgerera
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
ppuMinFeeAL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Coin
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Coin -> StrictMaybe Coin
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Coin
protocolUpdateTxFeePerByte
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
ppuMinFeeBL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Coin
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Coin -> StrictMaybe Coin
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Coin
protocolUpdateTxFeeFixed
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Word32 -> Identity (StrictMaybe Word32))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Word32)
ppuMaxBBSizeL ((StrictMaybe Word32 -> Identity (StrictMaybe Word32))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Word32
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Word32 -> StrictMaybe Word32
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Word32
protocolUpdateMaxBlockBodySize
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Word32 -> Identity (StrictMaybe Word32))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Word32)
ppuMaxTxSizeL ((StrictMaybe Word32 -> Identity (StrictMaybe Word32))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Word32
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Word32 -> StrictMaybe Word32
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Word32
protocolUpdateMaxTxSize
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Word16 -> Identity (StrictMaybe Word16))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Word16)
ppuMaxBHSizeL ((StrictMaybe Word16 -> Identity (StrictMaybe Word16))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Word16
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Word16 -> StrictMaybe Word16
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Word16
protocolUpdateMaxBlockHeaderSize
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
ppuKeyDepositL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Coin
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Coin -> StrictMaybe Coin
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Coin
protocolUpdateStakeAddressDeposit
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
ppuPoolDepositL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Coin
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Coin -> StrictMaybe Coin
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Coin
protocolUpdateStakePoolDeposit
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe EpochInterval -> Identity (StrictMaybe EpochInterval))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe EpochInterval)
ppuEMaxL ((StrictMaybe EpochInterval
  -> Identity (StrictMaybe EpochInterval))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe EpochInterval
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe EpochInterval -> StrictMaybe EpochInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe EpochInterval
protocolUpdatePoolRetireMaxEpoch
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Natural -> Identity (StrictMaybe Natural))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Natural)
ppuNOptL ((StrictMaybe Natural -> Identity (StrictMaybe Natural))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Natural
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateStakePoolTargetNum
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe NonNegativeInterval
 -> Identity (StrictMaybe NonNegativeInterval))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe NonNegativeInterval)
ppuA0L ((StrictMaybe NonNegativeInterval
  -> Identity (StrictMaybe NonNegativeInterval))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe NonNegativeInterval
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe NonNegativeInterval -> StrictMaybe NonNegativeInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe NonNegativeInterval
a0
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe UnitInterval)
ppuRhoL ((StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe UnitInterval
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe UnitInterval -> StrictMaybe UnitInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe UnitInterval
rho
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe UnitInterval)
ppuTauL ((StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe UnitInterval
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe UnitInterval -> StrictMaybe UnitInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe UnitInterval
tau
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
ppuMinPoolCostL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Coin
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Coin -> StrictMaybe Coin
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Coin
protocolUpdateMinPoolCost
    PParamsUpdate ledgerera
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParamsUpdate ledgerera
ppuCommon

toShelleyPParamsUpdate
  :: ( EraPParams ledgerera
     , Ledger.AtMostEra Ledger.MaryEra ledgerera
     , Ledger.AtMostEra Ledger.AlonzoEra ledgerera
     , Ledger.AtMostEra Ledger.BabbageEra ledgerera
     )
  => ProtocolParametersUpdate
  -> Either ProtocolParametersConversionError (PParamsUpdate ledgerera)
toShelleyPParamsUpdate :: forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera, AtMostEra BabbageEra ledgerera) =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
toShelleyPParamsUpdate
  protocolParametersUpdate :: ProtocolParametersUpdate
protocolParametersUpdate@ProtocolParametersUpdate
    { Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: ProtocolParametersUpdate -> Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
protocolUpdateProtocolVersion
    , Maybe Rational
protocolUpdateDecentralization :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateDecentralization :: Maybe Rational
protocolUpdateDecentralization
    , Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy :: ProtocolParametersUpdate -> Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy :: Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy
    , Maybe Coin
protocolUpdateMinUTxOValue :: ProtocolParametersUpdate -> Maybe Coin
protocolUpdateMinUTxOValue :: Maybe Coin
protocolUpdateMinUTxOValue
    } = do
    PParamsUpdate ledgerera
ppuCommon <- ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
forall ledgerera.
EraPParams ledgerera =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
toShelleyCommonPParamsUpdate ProtocolParametersUpdate
protocolParametersUpdate
    Maybe UnitInterval
d <- (Rational -> Either ProtocolParametersConversionError UnitInterval)
-> Maybe Rational
-> Either ProtocolParametersConversionError (Maybe UnitInterval)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (String
-> Rational
-> Either ProtocolParametersConversionError UnitInterval
forall b.
BoundedRational b =>
String -> Rational -> Either ProtocolParametersConversionError b
boundRationalEither String
"D") Maybe Rational
protocolUpdateDecentralization
    Maybe ProtVer
protVer <- ((Natural, Natural)
 -> Either ProtocolParametersConversionError ProtVer)
-> Maybe (Natural, Natural)
-> Either ProtocolParametersConversionError (Maybe ProtVer)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Natural, Natural)
-> Either ProtocolParametersConversionError ProtVer
mkProtVer Maybe (Natural, Natural)
protocolUpdateProtocolVersion
    let ppuShelley :: PParamsUpdate ledgerera
ppuShelley =
          PParamsUpdate ledgerera
ppuCommon
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe UnitInterval)
ppuDL ((StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe UnitInterval
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe UnitInterval -> StrictMaybe UnitInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe UnitInterval
d
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Nonce -> Identity (StrictMaybe Nonce))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParamsUpdate era) (StrictMaybe Nonce)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Nonce)
ppuExtraEntropyL
              ((StrictMaybe Nonce -> Identity (StrictMaybe Nonce))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Nonce
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Maybe PraosNonce -> Nonce
toLedgerNonce (Maybe PraosNonce -> Nonce)
-> StrictMaybe (Maybe PraosNonce) -> StrictMaybe Nonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Maybe PraosNonce) -> StrictMaybe (Maybe PraosNonce)
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy)
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
ppuMinUTxOValueL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Coin
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Coin -> StrictMaybe Coin
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Coin
protocolUpdateMinUTxOValue
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe ProtVer -> Identity (StrictMaybe ProtVer))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
(EraPParams era, ProtVerAtMost era 8) =>
Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
Lens' (PParamsUpdate ledgerera) (StrictMaybe ProtVer)
ppuProtocolVersionL ((StrictMaybe ProtVer -> Identity (StrictMaybe ProtVer))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe ProtVer
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ProtVer -> StrictMaybe ProtVer
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe ProtVer
protVer
    PParamsUpdate ledgerera
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParamsUpdate ledgerera
ppuShelley

toAlonzoCommonPParamsUpdate
  :: AlonzoEraPParams ledgerera
  => ProtocolParametersUpdate
  -> Either ProtocolParametersConversionError (PParamsUpdate ledgerera)
toAlonzoCommonPParamsUpdate :: forall ledgerera.
AlonzoEraPParams ledgerera =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
toAlonzoCommonPParamsUpdate
  protocolParametersUpdate :: ProtocolParametersUpdate
protocolParametersUpdate@ProtocolParametersUpdate
    { Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels :: ProtocolParametersUpdate -> Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels :: Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels
    , Maybe ExecutionUnitPrices
protocolUpdatePrices :: ProtocolParametersUpdate -> Maybe ExecutionUnitPrices
protocolUpdatePrices :: Maybe ExecutionUnitPrices
protocolUpdatePrices
    , Maybe ExecutionUnits
protocolUpdateMaxTxExUnits :: ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxTxExUnits :: Maybe ExecutionUnits
protocolUpdateMaxTxExUnits
    , Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits :: ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits :: Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits
    , Maybe Natural
protocolUpdateMaxValueSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxValueSize :: Maybe Natural
protocolUpdateMaxValueSize
    , Maybe Natural
protocolUpdateCollateralPercent :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateCollateralPercent :: Maybe Natural
protocolUpdateCollateralPercent
    , Maybe Natural
protocolUpdateMaxCollateralInputs :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxCollateralInputs :: Maybe Natural
protocolUpdateMaxCollateralInputs
    } = do
    PParamsUpdate ledgerera
ppuShelleyCommon <- ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
forall ledgerera.
EraPParams ledgerera =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
toShelleyCommonPParamsUpdate ProtocolParametersUpdate
protocolParametersUpdate
    StrictMaybe CostModels
costModels <-
      if Map AnyPlutusScriptVersion CostModel -> Bool
forall k a. Map k a -> Bool
Map.null Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels
        then StrictMaybe CostModels
-> Either
     ProtocolParametersConversionError (StrictMaybe CostModels)
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe CostModels
forall a. StrictMaybe a
SNothing
        else CostModels -> StrictMaybe CostModels
forall a. a -> StrictMaybe a
SJust (CostModels -> StrictMaybe CostModels)
-> Either ProtocolParametersConversionError CostModels
-> Either
     ProtocolParametersConversionError (StrictMaybe CostModels)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map AnyPlutusScriptVersion CostModel
-> Either ProtocolParametersConversionError CostModels
toAlonzoCostModels Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels
    Maybe Prices
prices <- (ExecutionUnitPrices
 -> Either ProtocolParametersConversionError Prices)
-> Maybe ExecutionUnitPrices
-> Either ProtocolParametersConversionError (Maybe Prices)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM ExecutionUnitPrices
-> Either ProtocolParametersConversionError Prices
toAlonzoPrices Maybe ExecutionUnitPrices
protocolUpdatePrices
    let ppuAlonzoCommon :: PParamsUpdate ledgerera
ppuAlonzoCommon =
          PParamsUpdate ledgerera
ppuShelleyCommon
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe CostModels -> Identity (StrictMaybe CostModels))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe CostModels)
Lens' (PParamsUpdate ledgerera) (StrictMaybe CostModels)
ppuCostModelsL ((StrictMaybe CostModels -> Identity (StrictMaybe CostModels))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe CostModels
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe CostModels
costModels
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Prices -> Identity (StrictMaybe Prices))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Prices)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Prices)
ppuPricesL ((StrictMaybe Prices -> Identity (StrictMaybe Prices))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Prices
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Prices -> StrictMaybe Prices
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Prices
prices
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe ExUnits -> Identity (StrictMaybe ExUnits))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe ExUnits)
Lens' (PParamsUpdate ledgerera) (StrictMaybe ExUnits)
ppuMaxTxExUnitsL
              ((StrictMaybe ExUnits -> Identity (StrictMaybe ExUnits))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe ExUnits
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (ExecutionUnits -> ExUnits
toAlonzoExUnits (ExecutionUnits -> ExUnits)
-> StrictMaybe ExecutionUnits -> StrictMaybe ExUnits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ExecutionUnits -> StrictMaybe ExecutionUnits
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe ExecutionUnits
protocolUpdateMaxTxExUnits)
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe ExUnits -> Identity (StrictMaybe ExUnits))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe ExUnits)
Lens' (PParamsUpdate ledgerera) (StrictMaybe ExUnits)
ppuMaxBlockExUnitsL
              ((StrictMaybe ExUnits -> Identity (StrictMaybe ExUnits))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe ExUnits
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (ExecutionUnits -> ExUnits
toAlonzoExUnits (ExecutionUnits -> ExUnits)
-> StrictMaybe ExecutionUnits -> StrictMaybe ExUnits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ExecutionUnits -> StrictMaybe ExecutionUnits
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits)
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Natural -> Identity (StrictMaybe Natural))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Natural)
ppuMaxValSizeL ((StrictMaybe Natural -> Identity (StrictMaybe Natural))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Natural
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateMaxValueSize
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Natural -> Identity (StrictMaybe Natural))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Natural)
ppuCollateralPercentageL ((StrictMaybe Natural -> Identity (StrictMaybe Natural))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Natural
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateCollateralPercent
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe Natural -> Identity (StrictMaybe Natural))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Natural)
ppuMaxCollateralInputsL ((StrictMaybe Natural -> Identity (StrictMaybe Natural))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe Natural
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateMaxCollateralInputs
    PParamsUpdate ledgerera
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParamsUpdate ledgerera
ppuAlonzoCommon

toAlonzoPParamsUpdate
  :: Ledger.Crypto crypto
  => ProtocolParametersUpdate
  -> Either ProtocolParametersConversionError (PParamsUpdate (Ledger.AlonzoEra crypto))
toAlonzoPParamsUpdate :: forall crypto.
Crypto crypto =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (AlonzoEra crypto))
toAlonzoPParamsUpdate
  protocolParametersUpdate :: ProtocolParametersUpdate
protocolParametersUpdate@ProtocolParametersUpdate
    { Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: ProtocolParametersUpdate -> Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
protocolUpdateProtocolVersion
    , Maybe Rational
protocolUpdateDecentralization :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateDecentralization :: Maybe Rational
protocolUpdateDecentralization
    } = do
    PParamsUpdate (AlonzoEra crypto)
ppuAlonzoCommon <- ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (AlonzoEra crypto))
forall ledgerera.
AlonzoEraPParams ledgerera =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
toAlonzoCommonPParamsUpdate ProtocolParametersUpdate
protocolParametersUpdate
    Maybe UnitInterval
d <- (Rational -> Either ProtocolParametersConversionError UnitInterval)
-> Maybe Rational
-> Either ProtocolParametersConversionError (Maybe UnitInterval)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (String
-> Rational
-> Either ProtocolParametersConversionError UnitInterval
forall b.
BoundedRational b =>
String -> Rational -> Either ProtocolParametersConversionError b
boundRationalEither String
"D") Maybe Rational
protocolUpdateDecentralization
    Maybe ProtVer
protVer <- ((Natural, Natural)
 -> Either ProtocolParametersConversionError ProtVer)
-> Maybe (Natural, Natural)
-> Either ProtocolParametersConversionError (Maybe ProtVer)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Natural, Natural)
-> Either ProtocolParametersConversionError ProtVer
mkProtVer Maybe (Natural, Natural)
protocolUpdateProtocolVersion
    let ppuAlonzo :: PParamsUpdate (AlonzoEra crypto)
ppuAlonzo =
          PParamsUpdate (AlonzoEra crypto)
ppuAlonzoCommon
            PParamsUpdate (AlonzoEra crypto)
-> (PParamsUpdate (AlonzoEra crypto)
    -> PParamsUpdate (AlonzoEra crypto))
-> PParamsUpdate (AlonzoEra crypto)
forall a b. a -> (a -> b) -> b
& (StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
-> PParamsUpdate (AlonzoEra crypto)
-> Identity (PParamsUpdate (AlonzoEra crypto))
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate (AlonzoEra crypto)) (StrictMaybe UnitInterval)
ppuDL ((StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
 -> PParamsUpdate (AlonzoEra crypto)
 -> Identity (PParamsUpdate (AlonzoEra crypto)))
-> StrictMaybe UnitInterval
-> PParamsUpdate (AlonzoEra crypto)
-> PParamsUpdate (AlonzoEra crypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe UnitInterval -> StrictMaybe UnitInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe UnitInterval
d
            PParamsUpdate (AlonzoEra crypto)
-> (PParamsUpdate (AlonzoEra crypto)
    -> PParamsUpdate (AlonzoEra crypto))
-> PParamsUpdate (AlonzoEra crypto)
forall a b. a -> (a -> b) -> b
& (StrictMaybe ProtVer -> Identity (StrictMaybe ProtVer))
-> PParamsUpdate (AlonzoEra crypto)
-> Identity (PParamsUpdate (AlonzoEra crypto))
forall era.
(EraPParams era, ProtVerAtMost era 8) =>
Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
Lens' (PParamsUpdate (AlonzoEra crypto)) (StrictMaybe ProtVer)
ppuProtocolVersionL ((StrictMaybe ProtVer -> Identity (StrictMaybe ProtVer))
 -> PParamsUpdate (AlonzoEra crypto)
 -> Identity (PParamsUpdate (AlonzoEra crypto)))
-> StrictMaybe ProtVer
-> PParamsUpdate (AlonzoEra crypto)
-> PParamsUpdate (AlonzoEra crypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ProtVer -> StrictMaybe ProtVer
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe ProtVer
protVer
    PParamsUpdate (AlonzoEra crypto)
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (AlonzoEra crypto))
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParamsUpdate (AlonzoEra crypto)
ppuAlonzo

toBabbageCommonPParamsUpdate
  :: BabbageEraPParams ledgerera
  => ProtocolParametersUpdate
  -> Either ProtocolParametersConversionError (Ledger.PParamsUpdate ledgerera)
toBabbageCommonPParamsUpdate :: forall ledgerera.
BabbageEraPParams ledgerera =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
toBabbageCommonPParamsUpdate
  protocolParametersUpdate :: ProtocolParametersUpdate
protocolParametersUpdate@ProtocolParametersUpdate
    { Maybe Coin
protocolUpdateUTxOCostPerByte :: ProtocolParametersUpdate -> Maybe Coin
protocolUpdateUTxOCostPerByte :: Maybe Coin
protocolUpdateUTxOCostPerByte
    } = do
    PParamsUpdate ledgerera
ppuAlonzoCommon <- ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
forall ledgerera.
AlonzoEraPParams ledgerera =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
toAlonzoCommonPParamsUpdate ProtocolParametersUpdate
protocolParametersUpdate
    let ppuBabbage :: PParamsUpdate ledgerera
ppuBabbage =
          PParamsUpdate ledgerera
ppuAlonzoCommon
            PParamsUpdate ledgerera
-> (PParamsUpdate ledgerera -> PParamsUpdate ledgerera)
-> PParamsUpdate ledgerera
forall a b. a -> (a -> b) -> b
& (StrictMaybe CoinPerByte -> Identity (StrictMaybe CoinPerByte))
-> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera)
forall era.
BabbageEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe CoinPerByte)
Lens' (PParamsUpdate ledgerera) (StrictMaybe CoinPerByte)
ppuCoinsPerUTxOByteL ((StrictMaybe CoinPerByte -> Identity (StrictMaybe CoinPerByte))
 -> PParamsUpdate ledgerera -> Identity (PParamsUpdate ledgerera))
-> StrictMaybe CoinPerByte
-> PParamsUpdate ledgerera
-> PParamsUpdate ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Coin -> CoinPerByte)
-> StrictMaybe Coin -> StrictMaybe CoinPerByte
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Coin -> CoinPerByte
CoinPerByte (Maybe Coin -> StrictMaybe Coin
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Coin
protocolUpdateUTxOCostPerByte)
    PParamsUpdate ledgerera
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParamsUpdate ledgerera
ppuBabbage

toBabbagePParamsUpdate
  :: Ledger.Crypto crypto
  => ProtocolParametersUpdate
  -> Either ProtocolParametersConversionError (Ledger.PParamsUpdate (Ledger.BabbageEra crypto))
toBabbagePParamsUpdate :: forall crypto.
Crypto crypto =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (BabbageEra crypto))
toBabbagePParamsUpdate
  protocolParametersUpdate :: ProtocolParametersUpdate
protocolParametersUpdate@ProtocolParametersUpdate
    { Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: ProtocolParametersUpdate -> Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
protocolUpdateProtocolVersion
    } = do
    PParamsUpdate (BabbageEra crypto)
ppuBabbageCommon <- ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (BabbageEra crypto))
forall ledgerera.
BabbageEraPParams ledgerera =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
toBabbageCommonPParamsUpdate ProtocolParametersUpdate
protocolParametersUpdate
    Maybe ProtVer
protVer <- ((Natural, Natural)
 -> Either ProtocolParametersConversionError ProtVer)
-> Maybe (Natural, Natural)
-> Either ProtocolParametersConversionError (Maybe ProtVer)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Natural, Natural)
-> Either ProtocolParametersConversionError ProtVer
mkProtVer Maybe (Natural, Natural)
protocolUpdateProtocolVersion
    let ppuBabbage :: PParamsUpdate (BabbageEra crypto)
ppuBabbage =
          PParamsUpdate (BabbageEra crypto)
ppuBabbageCommon
            PParamsUpdate (BabbageEra crypto)
-> (PParamsUpdate (BabbageEra crypto)
    -> PParamsUpdate (BabbageEra crypto))
-> PParamsUpdate (BabbageEra crypto)
forall a b. a -> (a -> b) -> b
& (StrictMaybe ProtVer -> Identity (StrictMaybe ProtVer))
-> PParamsUpdate (BabbageEra crypto)
-> Identity (PParamsUpdate (BabbageEra crypto))
forall era.
(EraPParams era, ProtVerAtMost era 8) =>
Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
Lens' (PParamsUpdate (BabbageEra crypto)) (StrictMaybe ProtVer)
ppuProtocolVersionL ((StrictMaybe ProtVer -> Identity (StrictMaybe ProtVer))
 -> PParamsUpdate (BabbageEra crypto)
 -> Identity (PParamsUpdate (BabbageEra crypto)))
-> StrictMaybe ProtVer
-> PParamsUpdate (BabbageEra crypto)
-> PParamsUpdate (BabbageEra crypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ProtVer -> StrictMaybe ProtVer
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe ProtVer
protVer
    PParamsUpdate (BabbageEra crypto)
-> Either
     ProtocolParametersConversionError
     (PParamsUpdate (BabbageEra crypto))
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParamsUpdate (BabbageEra crypto)
ppuBabbage

requireParam
  :: String
  -> (a -> Either ProtocolParametersConversionError b)
  -> Maybe a
  -> Either ProtocolParametersConversionError b
requireParam :: forall a b.
String
-> (a -> Either ProtocolParametersConversionError b)
-> Maybe a
-> Either ProtocolParametersConversionError b
requireParam String
paramName = Either ProtocolParametersConversionError b
-> (a -> Either ProtocolParametersConversionError b)
-> Maybe a
-> Either ProtocolParametersConversionError b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ProtocolParametersConversionError
-> Either ProtocolParametersConversionError b
forall a b. a -> Either a b
Left (ProtocolParametersConversionError
 -> Either ProtocolParametersConversionError b)
-> ProtocolParametersConversionError
-> Either ProtocolParametersConversionError b
forall a b. (a -> b) -> a -> b
$ String -> ProtocolParametersConversionError
PpceMissingParameter String
paramName)

mkProtVer :: (Natural, Natural) -> Either ProtocolParametersConversionError Ledger.ProtVer
mkProtVer :: (Natural, Natural)
-> Either ProtocolParametersConversionError ProtVer
mkProtVer (Natural
majorProtVer, Natural
minorProtVer) =
  ProtocolParametersConversionError
-> Maybe ProtVer
-> Either ProtocolParametersConversionError ProtVer
forall b a. b -> Maybe a -> Either b a
maybeToRight (Natural -> ProtocolParametersConversionError
PpceVersionInvalid Natural
majorProtVer) (Maybe ProtVer -> Either ProtocolParametersConversionError ProtVer)
-> Maybe ProtVer
-> Either ProtocolParametersConversionError ProtVer
forall a b. (a -> b) -> a -> b
$
    (Version -> Natural -> ProtVer
`Ledger.ProtVer` Natural
minorProtVer) (Version -> ProtVer) -> Maybe Version -> Maybe ProtVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> Maybe Version
forall i (m :: * -> *). (Integral i, MonadFail m) => i -> m Version
Ledger.mkVersion Natural
majorProtVer

boundRationalEither
  :: Ledger.BoundedRational b
  => String
  -> Rational
  -> Either ProtocolParametersConversionError b
boundRationalEither :: forall b.
BoundedRational b =>
String -> Rational -> Either ProtocolParametersConversionError b
boundRationalEither String
name Rational
r = ProtocolParametersConversionError
-> Maybe b -> Either ProtocolParametersConversionError b
forall b a. b -> Maybe a -> Either b a
maybeToRight (String -> Rational -> ProtocolParametersConversionError
PpceOutOfBounds String
name Rational
r) (Maybe b -> Either ProtocolParametersConversionError b)
-> Maybe b -> Either ProtocolParametersConversionError b
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe b
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
r

-- Conway uses the same PParams as Babbage for now.
toConwayPParamsUpdate
  :: BabbageEraPParams ledgerera
  => ProtocolParametersUpdate
  -> Either ProtocolParametersConversionError (PParamsUpdate ledgerera)
toConwayPParamsUpdate :: forall ledgerera.
BabbageEraPParams ledgerera =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
toConwayPParamsUpdate = ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
forall ledgerera.
BabbageEraPParams ledgerera =>
ProtocolParametersUpdate
-> Either
     ProtocolParametersConversionError (PParamsUpdate ledgerera)
toBabbageCommonPParamsUpdate

-- ----------------------------------------------------------------------------
-- Conversion functions: updates from ledger types
--

fromLedgerUpdate
  :: forall era ledgerera
   . ShelleyLedgerEra era ~ ledgerera
  => Ledger.EraCrypto ledgerera ~ StandardCrypto
  => ShelleyBasedEra era
  -> Ledger.Update ledgerera
  -> UpdateProposal
fromLedgerUpdate :: forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera,
 EraCrypto ledgerera ~ StandardCrypto) =>
ShelleyBasedEra era -> Update ledgerera -> UpdateProposal
fromLedgerUpdate ShelleyBasedEra era
sbe (Ledger.Update ProposedPPUpdates ledgerera
ppup EpochNo
epochno) =
  Map (Hash GenesisKey) ProtocolParametersUpdate
-> EpochNo -> UpdateProposal
UpdateProposal (ShelleyBasedEra era
-> ProposedPPUpdates ledgerera
-> Map (Hash GenesisKey) ProtocolParametersUpdate
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera,
 EraCrypto ledgerera ~ StandardCrypto) =>
ShelleyBasedEra era
-> ProposedPPUpdates ledgerera
-> Map (Hash GenesisKey) ProtocolParametersUpdate
fromLedgerProposedPPUpdates ShelleyBasedEra era
sbe ProposedPPUpdates ledgerera
ppup) EpochNo
epochno

fromLedgerProposedPPUpdates
  :: forall era ledgerera
   . ShelleyLedgerEra era ~ ledgerera
  => Ledger.EraCrypto ledgerera ~ StandardCrypto
  => ShelleyBasedEra era
  -> Ledger.ProposedPPUpdates ledgerera
  -> Map (Hash GenesisKey) ProtocolParametersUpdate
fromLedgerProposedPPUpdates :: forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera,
 EraCrypto ledgerera ~ StandardCrypto) =>
ShelleyBasedEra era
-> ProposedPPUpdates ledgerera
-> Map (Hash GenesisKey) ProtocolParametersUpdate
fromLedgerProposedPPUpdates ShelleyBasedEra era
sbe =
  (PParamsUpdate ledgerera -> ProtocolParametersUpdate)
-> Map (Hash GenesisKey) (PParamsUpdate ledgerera)
-> Map (Hash GenesisKey) ProtocolParametersUpdate
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (ShelleyBasedEra era
-> PParamsUpdate (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall era.
ShelleyBasedEra era
-> PParamsUpdate (ShelleyLedgerEra era) -> ProtocolParametersUpdate
fromLedgerPParamsUpdate ShelleyBasedEra era
sbe)
    (Map (Hash GenesisKey) (PParamsUpdate ledgerera)
 -> Map (Hash GenesisKey) ProtocolParametersUpdate)
-> (ProposedPPUpdates ledgerera
    -> Map (Hash GenesisKey) (PParamsUpdate ledgerera))
-> ProposedPPUpdates ledgerera
-> Map (Hash GenesisKey) ProtocolParametersUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyHash 'Genesis StandardCrypto -> Hash GenesisKey)
-> Map (KeyHash 'Genesis StandardCrypto) (PParamsUpdate ledgerera)
-> Map (Hash GenesisKey) (PParamsUpdate ledgerera)
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic KeyHash 'Genesis StandardCrypto -> Hash GenesisKey
GenesisKeyHash
    (Map (KeyHash 'Genesis StandardCrypto) (PParamsUpdate ledgerera)
 -> Map (Hash GenesisKey) (PParamsUpdate ledgerera))
-> (ProposedPPUpdates ledgerera
    -> Map (KeyHash 'Genesis StandardCrypto) (PParamsUpdate ledgerera))
-> ProposedPPUpdates ledgerera
-> Map (Hash GenesisKey) (PParamsUpdate ledgerera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Ledger.ProposedPPUpdates Map
  (KeyHash 'Genesis (EraCrypto ledgerera)) (PParamsUpdate ledgerera)
ppup) -> Map
  (KeyHash 'Genesis (EraCrypto ledgerera)) (PParamsUpdate ledgerera)
Map (KeyHash 'Genesis StandardCrypto) (PParamsUpdate ledgerera)
ppup)

fromLedgerPParamsUpdate
  :: ShelleyBasedEra era
  -> Ledger.PParamsUpdate (ShelleyLedgerEra era)
  -> ProtocolParametersUpdate
fromLedgerPParamsUpdate :: forall era.
ShelleyBasedEra era
-> PParamsUpdate (ShelleyLedgerEra era) -> ProtocolParametersUpdate
fromLedgerPParamsUpdate ShelleyBasedEra era
ShelleyBasedEraShelley = PParamsUpdate (ShelleyEra StandardCrypto)
-> ProtocolParametersUpdate
PParamsUpdate (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera, AtMostEra BabbageEra ledgerera) =>
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromShelleyPParamsUpdate
fromLedgerPParamsUpdate ShelleyBasedEra era
ShelleyBasedEraAllegra = PParamsUpdate (AllegraEra StandardCrypto)
-> ProtocolParametersUpdate
PParamsUpdate (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera, AtMostEra BabbageEra ledgerera) =>
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromShelleyPParamsUpdate
fromLedgerPParamsUpdate ShelleyBasedEra era
ShelleyBasedEraMary = PParamsUpdate (MaryEra StandardCrypto) -> ProtocolParametersUpdate
PParamsUpdate (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera, AtMostEra BabbageEra ledgerera) =>
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromShelleyPParamsUpdate
fromLedgerPParamsUpdate ShelleyBasedEra era
ShelleyBasedEraAlonzo = PParamsUpdate (AlonzoEra StandardCrypto)
-> ProtocolParametersUpdate
PParamsUpdate (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall crypto.
Crypto crypto =>
PParamsUpdate (AlonzoEra crypto) -> ProtocolParametersUpdate
fromAlonzoPParamsUpdate
fromLedgerPParamsUpdate ShelleyBasedEra era
ShelleyBasedEraBabbage = PParamsUpdate (BabbageEra StandardCrypto)
-> ProtocolParametersUpdate
PParamsUpdate (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall crypto.
Crypto crypto =>
PParamsUpdate (BabbageEra crypto) -> ProtocolParametersUpdate
fromBabbagePParamsUpdate
fromLedgerPParamsUpdate ShelleyBasedEra era
ShelleyBasedEraConway = PParamsUpdate StandardConway -> ProtocolParametersUpdate
PParamsUpdate (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall ledgerera.
BabbageEraPParams ledgerera =>
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromConwayPParamsUpdate

fromShelleyCommonPParamsUpdate
  :: EraPParams ledgerera
  => PParamsUpdate ledgerera
  -> ProtocolParametersUpdate
fromShelleyCommonPParamsUpdate :: forall ledgerera.
EraPParams ledgerera =>
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromShelleyCommonPParamsUpdate PParamsUpdate ledgerera
ppu =
  ProtocolParametersUpdate
    { protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
protocolUpdateProtocolVersion = Maybe (Natural, Natural)
forall a. Maybe a
Nothing
    , protocolUpdateMaxBlockHeaderSize :: Maybe Word16
protocolUpdateMaxBlockHeaderSize = StrictMaybe Word16 -> Maybe Word16
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (PParamsUpdate ledgerera
ppu PParamsUpdate ledgerera
-> Getting
     (StrictMaybe Word16) (PParamsUpdate ledgerera) (StrictMaybe Word16)
-> StrictMaybe Word16
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Word16) (PParamsUpdate ledgerera) (StrictMaybe Word16)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Word16)
ppuMaxBHSizeL)
    , protocolUpdateMaxBlockBodySize :: Maybe Word32
protocolUpdateMaxBlockBodySize = StrictMaybe Word32 -> Maybe Word32
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (PParamsUpdate ledgerera
ppu PParamsUpdate ledgerera
-> Getting
     (StrictMaybe Word32) (PParamsUpdate ledgerera) (StrictMaybe Word32)
-> StrictMaybe Word32
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Word32) (PParamsUpdate ledgerera) (StrictMaybe Word32)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Word32)
ppuMaxBBSizeL)
    , protocolUpdateMaxTxSize :: Maybe Word32
protocolUpdateMaxTxSize = StrictMaybe Word32 -> Maybe Word32
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (PParamsUpdate ledgerera
ppu PParamsUpdate ledgerera
-> Getting
     (StrictMaybe Word32) (PParamsUpdate ledgerera) (StrictMaybe Word32)
-> StrictMaybe Word32
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Word32) (PParamsUpdate ledgerera) (StrictMaybe Word32)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Word32)
ppuMaxTxSizeL)
    , protocolUpdateTxFeeFixed :: Maybe Coin
protocolUpdateTxFeeFixed = StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (PParamsUpdate ledgerera
ppu PParamsUpdate ledgerera
-> Getting
     (StrictMaybe Coin) (PParamsUpdate ledgerera) (StrictMaybe Coin)
-> StrictMaybe Coin
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Coin) (PParamsUpdate ledgerera) (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
ppuMinFeeBL)
    , protocolUpdateTxFeePerByte :: Maybe Coin
protocolUpdateTxFeePerByte = StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (PParamsUpdate ledgerera
ppu PParamsUpdate ledgerera
-> Getting
     (StrictMaybe Coin) (PParamsUpdate ledgerera) (StrictMaybe Coin)
-> StrictMaybe Coin
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Coin) (PParamsUpdate ledgerera) (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
ppuMinFeeAL)
    , protocolUpdateStakeAddressDeposit :: Maybe Coin
protocolUpdateStakeAddressDeposit = StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (PParamsUpdate ledgerera
ppu PParamsUpdate ledgerera
-> Getting
     (StrictMaybe Coin) (PParamsUpdate ledgerera) (StrictMaybe Coin)
-> StrictMaybe Coin
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Coin) (PParamsUpdate ledgerera) (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
ppuKeyDepositL)
    , protocolUpdateStakePoolDeposit :: Maybe Coin
protocolUpdateStakePoolDeposit = StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (PParamsUpdate ledgerera
ppu PParamsUpdate ledgerera
-> Getting
     (StrictMaybe Coin) (PParamsUpdate ledgerera) (StrictMaybe Coin)
-> StrictMaybe Coin
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Coin) (PParamsUpdate ledgerera) (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
ppuPoolDepositL)
    , protocolUpdateMinPoolCost :: Maybe Coin
protocolUpdateMinPoolCost = StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (PParamsUpdate ledgerera
ppu PParamsUpdate ledgerera
-> Getting
     (StrictMaybe Coin) (PParamsUpdate ledgerera) (StrictMaybe Coin)
-> StrictMaybe Coin
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Coin) (PParamsUpdate ledgerera) (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Coin)
ppuMinPoolCostL)
    , protocolUpdatePoolRetireMaxEpoch :: Maybe EpochInterval
protocolUpdatePoolRetireMaxEpoch = StrictMaybe EpochInterval -> Maybe EpochInterval
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (PParamsUpdate ledgerera
ppu PParamsUpdate ledgerera
-> Getting
     (StrictMaybe EpochInterval)
     (PParamsUpdate ledgerera)
     (StrictMaybe EpochInterval)
-> StrictMaybe EpochInterval
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe EpochInterval)
  (PParamsUpdate ledgerera)
  (StrictMaybe EpochInterval)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe EpochInterval)
ppuEMaxL)
    , protocolUpdateStakePoolTargetNum :: Maybe Natural
protocolUpdateStakePoolTargetNum = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (PParamsUpdate ledgerera
ppu PParamsUpdate ledgerera
-> Getting
     (StrictMaybe Natural)
     (PParamsUpdate ledgerera)
     (StrictMaybe Natural)
-> StrictMaybe Natural
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Natural)
  (PParamsUpdate ledgerera)
  (StrictMaybe Natural)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate ledgerera) (StrictMaybe Natural)
ppuNOptL)
    , protocolUpdatePoolPledgeInfluence :: Maybe Rational
protocolUpdatePoolPledgeInfluence = NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational (NonNegativeInterval -> Rational)
-> Maybe NonNegativeInterval -> Maybe Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe NonNegativeInterval -> Maybe NonNegativeInterval
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (PParamsUpdate ledgerera
ppu PParamsUpdate ledgerera
-> Getting
     (StrictMaybe NonNegativeInterval)
     (PParamsUpdate ledgerera)
     (StrictMaybe NonNegativeInterval)
-> StrictMaybe NonNegativeInterval
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe NonNegativeInterval)
  (PParamsUpdate ledgerera)
  (StrictMaybe NonNegativeInterval)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe NonNegativeInterval)
ppuA0L)
    , protocolUpdateMonetaryExpansion :: Maybe Rational
protocolUpdateMonetaryExpansion = UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational (UnitInterval -> Rational) -> Maybe UnitInterval -> Maybe Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe UnitInterval -> Maybe UnitInterval
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (PParamsUpdate ledgerera
ppu PParamsUpdate ledgerera
-> Getting
     (StrictMaybe UnitInterval)
     (PParamsUpdate ledgerera)
     (StrictMaybe UnitInterval)
-> StrictMaybe UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe UnitInterval)
  (PParamsUpdate ledgerera)
  (StrictMaybe UnitInterval)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe UnitInterval)
ppuRhoL)
    , protocolUpdateTreasuryCut :: Maybe Rational
protocolUpdateTreasuryCut = UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational (UnitInterval -> Rational) -> Maybe UnitInterval -> Maybe Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe UnitInterval -> Maybe UnitInterval
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (PParamsUpdate ledgerera
ppu PParamsUpdate ledgerera
-> Getting
     (StrictMaybe UnitInterval)
     (PParamsUpdate ledgerera)
     (StrictMaybe UnitInterval)
-> StrictMaybe UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe UnitInterval)
  (PParamsUpdate ledgerera)
  (StrictMaybe UnitInterval)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate ledgerera) (StrictMaybe UnitInterval)
ppuTauL)
    , protocolUpdateCostModels :: Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels = Map AnyPlutusScriptVersion CostModel
forall a. Monoid a => a
mempty
    , protocolUpdatePrices :: Maybe ExecutionUnitPrices
protocolUpdatePrices = Maybe ExecutionUnitPrices
forall a. Maybe a
Nothing
    , protocolUpdateMaxTxExUnits :: Maybe ExecutionUnits
protocolUpdateMaxTxExUnits = Maybe ExecutionUnits
forall a. Maybe a
Nothing
    , protocolUpdateMaxBlockExUnits :: Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits = Maybe ExecutionUnits
forall a. Maybe a
Nothing
    , protocolUpdateMaxValueSize :: Maybe Natural
protocolUpdateMaxValueSize = Maybe Natural
forall a. Maybe a
Nothing
    , protocolUpdateCollateralPercent :: Maybe Natural
protocolUpdateCollateralPercent = Maybe Natural
forall a. Maybe a
Nothing
    , protocolUpdateMaxCollateralInputs :: Maybe Natural
protocolUpdateMaxCollateralInputs = Maybe Natural
forall a. Maybe a
Nothing
    , protocolUpdateUTxOCostPerByte :: Maybe Coin
protocolUpdateUTxOCostPerByte = Maybe Coin
forall a. Maybe a
Nothing
    , protocolUpdateDecentralization :: Maybe Rational
protocolUpdateDecentralization = Maybe Rational
forall a. Maybe a
Nothing
    , protocolUpdateExtraPraosEntropy :: Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy = Maybe (Maybe PraosNonce)
forall a. Maybe a
Nothing
    , protocolUpdateMinUTxOValue :: Maybe Coin
protocolUpdateMinUTxOValue = Maybe Coin
forall a. Maybe a
Nothing
    }

fromShelleyPParamsUpdate
  :: ( EraPParams ledgerera
     , Ledger.AtMostEra Ledger.MaryEra ledgerera
     , Ledger.AtMostEra Ledger.AlonzoEra ledgerera
     , Ledger.AtMostEra Ledger.BabbageEra ledgerera
     )
  => PParamsUpdate ledgerera
  -> ProtocolParametersUpdate
fromShelleyPParamsUpdate :: forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera, AtMostEra BabbageEra ledgerera) =>
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromShelleyPParamsUpdate PParamsUpdate ledgerera
ppu =
  (PParamsUpdate ledgerera -> ProtocolParametersUpdate
forall ledgerera.
EraPParams ledgerera =>
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromShelleyCommonPParamsUpdate PParamsUpdate ledgerera
ppu)
    { protocolUpdateProtocolVersion =
        (\(Ledger.ProtVer Version
a Natural
b) -> (Version -> Natural
forall i. Integral i => Version -> i
Ledger.getVersion Version
a, Natural
b))
          <$> strictMaybeToMaybe (ppu ^. ppuProtocolVersionL)
    , protocolUpdateDecentralization =
        Ledger.unboundRational
          <$> strictMaybeToMaybe (ppu ^. ppuDL)
    , protocolUpdateExtraPraosEntropy =
        fromLedgerNonce
          <$> strictMaybeToMaybe (ppu ^. ppuExtraEntropyL)
    , protocolUpdateMinUTxOValue = strictMaybeToMaybe (ppu ^. ppuMinUTxOValueL)
    }

fromAlonzoCommonPParamsUpdate
  :: AlonzoEraPParams ledgerera
  => PParamsUpdate ledgerera
  -> ProtocolParametersUpdate
fromAlonzoCommonPParamsUpdate :: forall ledgerera.
AlonzoEraPParams ledgerera =>
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromAlonzoCommonPParamsUpdate PParamsUpdate ledgerera
ppu =
  (PParamsUpdate ledgerera -> ProtocolParametersUpdate
forall ledgerera.
EraPParams ledgerera =>
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromShelleyCommonPParamsUpdate PParamsUpdate ledgerera
ppu)
    { protocolUpdateCostModels =
        maybe
          mempty
          fromAlonzoCostModels
          (strictMaybeToMaybe (ppu ^. ppuCostModelsL))
    , protocolUpdatePrices =
        fromAlonzoPrices
          <$> strictMaybeToMaybe (ppu ^. ppuPricesL)
    , protocolUpdateMaxTxExUnits =
        fromAlonzoExUnits
          <$> strictMaybeToMaybe (ppu ^. ppuMaxTxExUnitsL)
    , protocolUpdateMaxBlockExUnits =
        fromAlonzoExUnits
          <$> strictMaybeToMaybe (ppu ^. ppuMaxBlockExUnitsL)
    , protocolUpdateMaxValueSize = strictMaybeToMaybe (ppu ^. ppuMaxValSizeL)
    , protocolUpdateCollateralPercent = strictMaybeToMaybe (ppu ^. ppuCollateralPercentageL)
    , protocolUpdateMaxCollateralInputs = strictMaybeToMaybe (ppu ^. ppuMaxCollateralInputsL)
    , protocolUpdateUTxOCostPerByte = Nothing
    }

fromAlonzoPParamsUpdate
  :: Ledger.Crypto crypto
  => PParamsUpdate (Ledger.AlonzoEra crypto)
  -> ProtocolParametersUpdate
fromAlonzoPParamsUpdate :: forall crypto.
Crypto crypto =>
PParamsUpdate (AlonzoEra crypto) -> ProtocolParametersUpdate
fromAlonzoPParamsUpdate PParamsUpdate (AlonzoEra crypto)
ppu =
  (PParamsUpdate (AlonzoEra crypto) -> ProtocolParametersUpdate
forall ledgerera.
AlonzoEraPParams ledgerera =>
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromAlonzoCommonPParamsUpdate PParamsUpdate (AlonzoEra crypto)
ppu)
    { protocolUpdateProtocolVersion =
        (\(Ledger.ProtVer Version
a Natural
b) -> (Version -> Natural
forall i. Integral i => Version -> i
Ledger.getVersion Version
a, Natural
b))
          <$> strictMaybeToMaybe (ppu ^. ppuProtocolVersionL)
    }

fromBabbageCommonPParamsUpdate
  :: BabbageEraPParams ledgerera
  => PParamsUpdate ledgerera
  -> ProtocolParametersUpdate
fromBabbageCommonPParamsUpdate :: forall ledgerera.
BabbageEraPParams ledgerera =>
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromBabbageCommonPParamsUpdate PParamsUpdate ledgerera
ppu =
  (PParamsUpdate ledgerera -> ProtocolParametersUpdate
forall ledgerera.
AlonzoEraPParams ledgerera =>
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromAlonzoCommonPParamsUpdate PParamsUpdate ledgerera
ppu)
    { protocolUpdateUTxOCostPerByte = unCoinPerByte <$> strictMaybeToMaybe (ppu ^. ppuCoinsPerUTxOByteL)
    }

fromBabbagePParamsUpdate
  :: Ledger.Crypto crypto
  => PParamsUpdate (Ledger.BabbageEra crypto)
  -> ProtocolParametersUpdate
fromBabbagePParamsUpdate :: forall crypto.
Crypto crypto =>
PParamsUpdate (BabbageEra crypto) -> ProtocolParametersUpdate
fromBabbagePParamsUpdate PParamsUpdate (BabbageEra crypto)
ppu =
  (PParamsUpdate (BabbageEra crypto) -> ProtocolParametersUpdate
forall ledgerera.
BabbageEraPParams ledgerera =>
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromBabbageCommonPParamsUpdate PParamsUpdate (BabbageEra crypto)
ppu)
    { protocolUpdateProtocolVersion =
        (\(Ledger.ProtVer Version
a Natural
b) -> (Version -> Natural
forall i. Integral i => Version -> i
Ledger.getVersion Version
a, Natural
b))
          <$> strictMaybeToMaybe (ppu ^. ppuProtocolVersionL)
    }

fromConwayPParamsUpdate
  :: BabbageEraPParams ledgerera
  => PParamsUpdate ledgerera
  -> ProtocolParametersUpdate
fromConwayPParamsUpdate :: forall ledgerera.
BabbageEraPParams ledgerera =>
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromConwayPParamsUpdate = PParamsUpdate ledgerera -> ProtocolParametersUpdate
forall ledgerera.
BabbageEraPParams ledgerera =>
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromBabbageCommonPParamsUpdate

-- ----------------------------------------------------------------------------
-- Conversion functions: protocol parameters to ledger types
--

toLedgerPParams
  :: ShelleyBasedEra era
  -> ProtocolParameters
  -> Either ProtocolParametersConversionError (Ledger.PParams (ShelleyLedgerEra era))
toLedgerPParams :: forall era.
ShelleyBasedEra era
-> ProtocolParameters
-> Either
     ProtocolParametersConversionError (PParams (ShelleyLedgerEra era))
toLedgerPParams ShelleyBasedEra era
ShelleyBasedEraShelley = ProtocolParameters
-> Either
     ProtocolParametersConversionError
     (PParams (ShelleyEra StandardCrypto))
ProtocolParameters
-> Either
     ProtocolParametersConversionError (PParams (ShelleyLedgerEra era))
forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera) =>
ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
toShelleyPParams
toLedgerPParams ShelleyBasedEra era
ShelleyBasedEraAllegra = ProtocolParameters
-> Either
     ProtocolParametersConversionError
     (PParams (AllegraEra StandardCrypto))
ProtocolParameters
-> Either
     ProtocolParametersConversionError (PParams (ShelleyLedgerEra era))
forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera) =>
ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
toShelleyPParams
toLedgerPParams ShelleyBasedEra era
ShelleyBasedEraMary = ProtocolParameters
-> Either
     ProtocolParametersConversionError
     (PParams (MaryEra StandardCrypto))
ProtocolParameters
-> Either
     ProtocolParametersConversionError (PParams (ShelleyLedgerEra era))
forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera) =>
ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
toShelleyPParams
toLedgerPParams ShelleyBasedEra era
ShelleyBasedEraAlonzo = ProtocolParameters
-> Either
     ProtocolParametersConversionError
     (PParams (AlonzoEra StandardCrypto))
ProtocolParameters
-> Either
     ProtocolParametersConversionError (PParams (ShelleyLedgerEra era))
forall crypto.
Crypto crypto =>
ProtocolParameters
-> Either
     ProtocolParametersConversionError (PParams (AlonzoEra crypto))
toAlonzoPParams
toLedgerPParams ShelleyBasedEra era
ShelleyBasedEraBabbage = ProtocolParameters
-> Either
     ProtocolParametersConversionError
     (PParams (BabbageEra StandardCrypto))
ProtocolParameters
-> Either
     ProtocolParametersConversionError (PParams (ShelleyLedgerEra era))
forall ledgerera.
BabbageEraPParams ledgerera =>
ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
toBabbagePParams
toLedgerPParams ShelleyBasedEra era
ShelleyBasedEraConway = ProtocolParameters
-> Either
     ProtocolParametersConversionError (PParams StandardConway)
ProtocolParameters
-> Either
     ProtocolParametersConversionError (PParams (ShelleyLedgerEra era))
forall ledgerera.
BabbageEraPParams ledgerera =>
ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
toConwayPParams

toShelleyCommonPParams
  :: EraPParams ledgerera
  => ProtocolParameters
  -> Either ProtocolParametersConversionError (PParams ledgerera)
toShelleyCommonPParams :: forall ledgerera.
EraPParams ledgerera =>
ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
toShelleyCommonPParams
  ProtocolParameters
    { (Natural, Natural)
protocolParamProtocolVersion :: ProtocolParameters -> (Natural, Natural)
protocolParamProtocolVersion :: (Natural, Natural)
protocolParamProtocolVersion
    , Natural
protocolParamMaxBlockHeaderSize :: ProtocolParameters -> Natural
protocolParamMaxBlockHeaderSize :: Natural
protocolParamMaxBlockHeaderSize
    , Natural
protocolParamMaxBlockBodySize :: ProtocolParameters -> Natural
protocolParamMaxBlockBodySize :: Natural
protocolParamMaxBlockBodySize
    , Natural
protocolParamMaxTxSize :: ProtocolParameters -> Natural
protocolParamMaxTxSize :: Natural
protocolParamMaxTxSize
    , Coin
protocolParamTxFeeFixed :: ProtocolParameters -> Coin
protocolParamTxFeeFixed :: Coin
protocolParamTxFeeFixed
    , Coin
protocolParamTxFeePerByte :: ProtocolParameters -> Coin
protocolParamTxFeePerByte :: Coin
protocolParamTxFeePerByte
    , Coin
protocolParamStakeAddressDeposit :: ProtocolParameters -> Coin
protocolParamStakeAddressDeposit :: Coin
protocolParamStakeAddressDeposit
    , Coin
protocolParamStakePoolDeposit :: ProtocolParameters -> Coin
protocolParamStakePoolDeposit :: Coin
protocolParamStakePoolDeposit
    , Coin
protocolParamMinPoolCost :: ProtocolParameters -> Coin
protocolParamMinPoolCost :: Coin
protocolParamMinPoolCost
    , EpochInterval
protocolParamPoolRetireMaxEpoch :: ProtocolParameters -> EpochInterval
protocolParamPoolRetireMaxEpoch :: EpochInterval
protocolParamPoolRetireMaxEpoch
    , Natural
protocolParamStakePoolTargetNum :: ProtocolParameters -> Natural
protocolParamStakePoolTargetNum :: Natural
protocolParamStakePoolTargetNum
    , Rational
protocolParamPoolPledgeInfluence :: ProtocolParameters -> Rational
protocolParamPoolPledgeInfluence :: Rational
protocolParamPoolPledgeInfluence
    , Rational
protocolParamMonetaryExpansion :: ProtocolParameters -> Rational
protocolParamMonetaryExpansion :: Rational
protocolParamMonetaryExpansion
    , Rational
protocolParamTreasuryCut :: ProtocolParameters -> Rational
protocolParamTreasuryCut :: Rational
protocolParamTreasuryCut
    } = do
    NonNegativeInterval
a0 <- String
-> Rational
-> Either ProtocolParametersConversionError NonNegativeInterval
forall b.
BoundedRational b =>
String -> Rational -> Either ProtocolParametersConversionError b
boundRationalEither String
"A0" Rational
protocolParamPoolPledgeInfluence
    UnitInterval
rho <- String
-> Rational
-> Either ProtocolParametersConversionError UnitInterval
forall b.
BoundedRational b =>
String -> Rational -> Either ProtocolParametersConversionError b
boundRationalEither String
"Rho" Rational
protocolParamMonetaryExpansion
    UnitInterval
tau <- String
-> Rational
-> Either ProtocolParametersConversionError UnitInterval
forall b.
BoundedRational b =>
String -> Rational -> Either ProtocolParametersConversionError b
boundRationalEither String
"Tau" Rational
protocolParamTreasuryCut
    ProtVer
protVer <- (Natural, Natural)
-> Either ProtocolParametersConversionError ProtVer
mkProtVer (Natural, Natural)
protocolParamProtocolVersion
    let ppCommon :: PParams ledgerera
ppCommon =
          PParams ledgerera
forall era. EraPParams era => PParams era
emptyPParams
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ledgerera) Coin
ppMinFeeAL ((Coin -> Identity Coin)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> Coin -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
protocolParamTxFeePerByte
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ledgerera) Coin
ppMinFeeBL ((Coin -> Identity Coin)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> Coin -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
protocolParamTxFeeFixed
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams ledgerera) Word32
ppMaxBBSizeL ((Word32 -> Identity Word32)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> Word32 -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
protocolParamMaxBlockBodySize
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams ledgerera) Word32
ppMaxTxSizeL ((Word32 -> Identity Word32)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> Word32 -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
protocolParamMaxTxSize
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (Word16 -> Identity Word16)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams ledgerera) Word16
ppMaxBHSizeL ((Word16 -> Identity Word16)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> Word16 -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
protocolParamMaxBlockHeaderSize
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ledgerera) Coin
ppKeyDepositL ((Coin -> Identity Coin)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> Coin -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
protocolParamStakeAddressDeposit
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ledgerera) Coin
ppPoolDepositL ((Coin -> Identity Coin)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> Coin -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
protocolParamStakePoolDeposit
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. EraPParams era => Lens' (PParams era) EpochInterval
Lens' (PParams ledgerera) EpochInterval
ppEMaxL ((EpochInterval -> Identity EpochInterval)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> EpochInterval -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochInterval
protocolParamPoolRetireMaxEpoch
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (Natural -> Identity Natural)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. EraPParams era => Lens' (PParams era) Natural
Lens' (PParams ledgerera) Natural
ppNOptL ((Natural -> Identity Natural)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> Natural -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
protocolParamStakePoolTargetNum
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (NonNegativeInterval -> Identity NonNegativeInterval)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era.
EraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams ledgerera) NonNegativeInterval
ppA0L ((NonNegativeInterval -> Identity NonNegativeInterval)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> NonNegativeInterval -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonNegativeInterval
a0
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams ledgerera) UnitInterval
ppRhoL ((UnitInterval -> Identity UnitInterval)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> UnitInterval -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
rho
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams ledgerera) UnitInterval
ppTauL ((UnitInterval -> Identity UnitInterval)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> UnitInterval -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
tau
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (ProtVer -> Identity ProtVer)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams ledgerera) ProtVer
ppProtocolVersionL ((ProtVer -> Identity ProtVer)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> ProtVer -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProtVer
protVer
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ledgerera) Coin
ppMinPoolCostL ((Coin -> Identity Coin)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> Coin -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
protocolParamMinPoolCost
    PParams ledgerera
-> Either ProtocolParametersConversionError (PParams ledgerera)
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParams ledgerera
ppCommon

toShelleyPParams
  :: ( EraPParams ledgerera
     , Ledger.AtMostEra Ledger.MaryEra ledgerera
     , Ledger.AtMostEra Ledger.AlonzoEra ledgerera
     )
  => ProtocolParameters
  -> Either ProtocolParametersConversionError (PParams ledgerera)
toShelleyPParams :: forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera) =>
ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
toShelleyPParams
  protocolParameters :: ProtocolParameters
protocolParameters@ProtocolParameters
    { Maybe Rational
protocolParamDecentralization :: ProtocolParameters -> Maybe Rational
protocolParamDecentralization :: Maybe Rational
protocolParamDecentralization
    , Maybe PraosNonce
protocolParamExtraPraosEntropy :: ProtocolParameters -> Maybe PraosNonce
protocolParamExtraPraosEntropy :: Maybe PraosNonce
protocolParamExtraPraosEntropy
    , Maybe Coin
protocolParamMinUTxOValue :: ProtocolParameters -> Maybe Coin
protocolParamMinUTxOValue :: Maybe Coin
protocolParamMinUTxOValue
    } = do
    PParams ledgerera
ppCommon <- ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
forall ledgerera.
EraPParams ledgerera =>
ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
toShelleyCommonPParams ProtocolParameters
protocolParameters
    UnitInterval
d <-
      String
-> Rational
-> Either ProtocolParametersConversionError UnitInterval
forall b.
BoundedRational b =>
String -> Rational -> Either ProtocolParametersConversionError b
boundRationalEither String
"D"
        (Rational -> Either ProtocolParametersConversionError UnitInterval)
-> Either ProtocolParametersConversionError Rational
-> Either ProtocolParametersConversionError UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProtocolParametersConversionError
-> Maybe Rational
-> Either ProtocolParametersConversionError Rational
forall b a. b -> Maybe a -> Either b a
maybeToRight (String -> ProtocolParametersConversionError
PpceMissingParameter String
"decentralization") Maybe Rational
protocolParamDecentralization
    Coin
minUTxOValue <-
      ProtocolParametersConversionError
-> Maybe Coin -> Either ProtocolParametersConversionError Coin
forall b a. b -> Maybe a -> Either b a
maybeToRight (String -> ProtocolParametersConversionError
PpceMissingParameter String
"protocolParamMinUTxOValue") Maybe Coin
protocolParamMinUTxOValue
    let ppShelley :: PParams ledgerera
ppShelley =
          PParams ledgerera
ppCommon
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) UnitInterval
Lens' (PParams ledgerera) UnitInterval
ppDL ((UnitInterval -> Identity UnitInterval)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> UnitInterval -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
d
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (Nonce -> Identity Nonce)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) Nonce
Lens' (PParams ledgerera) Nonce
ppExtraEntropyL ((Nonce -> Identity Nonce)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> Nonce -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe PraosNonce -> Nonce
toLedgerNonce Maybe PraosNonce
protocolParamExtraPraosEntropy
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
Lens' (PParams ledgerera) Coin
ppMinUTxOValueL ((Coin -> Identity Coin)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> Coin -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
minUTxOValue
    PParams ledgerera
-> Either ProtocolParametersConversionError (PParams ledgerera)
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParams ledgerera
ppShelley

toAlonzoCommonPParams
  :: AlonzoEraPParams ledgerera
  => ProtocolParameters
  -> Either ProtocolParametersConversionError (PParams ledgerera)
toAlonzoCommonPParams :: forall ledgerera.
AlonzoEraPParams ledgerera =>
ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
toAlonzoCommonPParams
  protocolParameters :: ProtocolParameters
protocolParameters@ProtocolParameters
    { Map AnyPlutusScriptVersion CostModel
protocolParamCostModels :: ProtocolParameters -> Map AnyPlutusScriptVersion CostModel
protocolParamCostModels :: Map AnyPlutusScriptVersion CostModel
protocolParamCostModels
    , Maybe ExecutionUnitPrices
protocolParamPrices :: ProtocolParameters -> Maybe ExecutionUnitPrices
protocolParamPrices :: Maybe ExecutionUnitPrices
protocolParamPrices
    , Maybe ExecutionUnits
protocolParamMaxTxExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxTxExUnits :: Maybe ExecutionUnits
protocolParamMaxTxExUnits
    , Maybe ExecutionUnits
protocolParamMaxBlockExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxBlockExUnits :: Maybe ExecutionUnits
protocolParamMaxBlockExUnits
    , Maybe Natural
protocolParamMaxValueSize :: ProtocolParameters -> Maybe Natural
protocolParamMaxValueSize :: Maybe Natural
protocolParamMaxValueSize
    , Maybe Natural
protocolParamCollateralPercent :: ProtocolParameters -> Maybe Natural
protocolParamCollateralPercent :: Maybe Natural
protocolParamCollateralPercent
    , Maybe Natural
protocolParamMaxCollateralInputs :: ProtocolParameters -> Maybe Natural
protocolParamMaxCollateralInputs :: Maybe Natural
protocolParamMaxCollateralInputs
    } = do
    PParams ledgerera
ppShelleyCommon <- ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
forall ledgerera.
EraPParams ledgerera =>
ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
toShelleyCommonPParams ProtocolParameters
protocolParameters
    CostModels
costModels <- Map AnyPlutusScriptVersion CostModel
-> Either ProtocolParametersConversionError CostModels
toAlonzoCostModels Map AnyPlutusScriptVersion CostModel
protocolParamCostModels
    Prices
prices <-
      String
-> (ExecutionUnitPrices
    -> Either ProtocolParametersConversionError Prices)
-> Maybe ExecutionUnitPrices
-> Either ProtocolParametersConversionError Prices
forall a b.
String
-> (a -> Either ProtocolParametersConversionError b)
-> Maybe a
-> Either ProtocolParametersConversionError b
requireParam String
"protocolParamPrices" ExecutionUnitPrices
-> Either ProtocolParametersConversionError Prices
toAlonzoPrices Maybe ExecutionUnitPrices
protocolParamPrices
    ExecutionUnits
maxTxExUnits <-
      String
-> (ExecutionUnits
    -> Either ProtocolParametersConversionError ExecutionUnits)
-> Maybe ExecutionUnits
-> Either ProtocolParametersConversionError ExecutionUnits
forall a b.
String
-> (a -> Either ProtocolParametersConversionError b)
-> Maybe a
-> Either ProtocolParametersConversionError b
requireParam String
"protocolParamMaxTxExUnits" ExecutionUnits
-> Either ProtocolParametersConversionError ExecutionUnits
forall a b. b -> Either a b
Right Maybe ExecutionUnits
protocolParamMaxTxExUnits
    ExecutionUnits
maxBlockExUnits <-
      String
-> (ExecutionUnits
    -> Either ProtocolParametersConversionError ExecutionUnits)
-> Maybe ExecutionUnits
-> Either ProtocolParametersConversionError ExecutionUnits
forall a b.
String
-> (a -> Either ProtocolParametersConversionError b)
-> Maybe a
-> Either ProtocolParametersConversionError b
requireParam String
"protocolParamMaxBlockExUnits" ExecutionUnits
-> Either ProtocolParametersConversionError ExecutionUnits
forall a b. b -> Either a b
Right Maybe ExecutionUnits
protocolParamMaxBlockExUnits
    Natural
maxValueSize <-
      String
-> (Natural -> Either ProtocolParametersConversionError Natural)
-> Maybe Natural
-> Either ProtocolParametersConversionError Natural
forall a b.
String
-> (a -> Either ProtocolParametersConversionError b)
-> Maybe a
-> Either ProtocolParametersConversionError b
requireParam String
"protocolParamMaxBlockExUnits" Natural -> Either ProtocolParametersConversionError Natural
forall a b. b -> Either a b
Right Maybe Natural
protocolParamMaxValueSize
    Natural
collateralPercent <-
      String
-> (Natural -> Either ProtocolParametersConversionError Natural)
-> Maybe Natural
-> Either ProtocolParametersConversionError Natural
forall a b.
String
-> (a -> Either ProtocolParametersConversionError b)
-> Maybe a
-> Either ProtocolParametersConversionError b
requireParam String
"protocolParamCollateralPercent" Natural -> Either ProtocolParametersConversionError Natural
forall a b. b -> Either a b
Right Maybe Natural
protocolParamCollateralPercent
    Natural
maxCollateralInputs <-
      String
-> (Natural -> Either ProtocolParametersConversionError Natural)
-> Maybe Natural
-> Either ProtocolParametersConversionError Natural
forall a b.
String
-> (a -> Either ProtocolParametersConversionError b)
-> Maybe a
-> Either ProtocolParametersConversionError b
requireParam String
"protocolParamMaxCollateralInputs" Natural -> Either ProtocolParametersConversionError Natural
forall a b. b -> Either a b
Right Maybe Natural
protocolParamMaxCollateralInputs
    let ppAlonzoCommon :: PParams ledgerera
ppAlonzoCommon =
          PParams ledgerera
ppShelleyCommon
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (CostModels -> Identity CostModels)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams ledgerera) CostModels
ppCostModelsL ((CostModels -> Identity CostModels)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> CostModels -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CostModels
costModels
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (Prices -> Identity Prices)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
Lens' (PParams ledgerera) Prices
ppPricesL ((Prices -> Identity Prices)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> Prices -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Prices
prices
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (ExUnits -> Identity ExUnits)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams ledgerera) ExUnits
ppMaxTxExUnitsL ((ExUnits -> Identity ExUnits)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> ExUnits -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ExecutionUnits -> ExUnits
toAlonzoExUnits ExecutionUnits
maxTxExUnits
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (ExUnits -> Identity ExUnits)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams ledgerera) ExUnits
ppMaxBlockExUnitsL ((ExUnits -> Identity ExUnits)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> ExUnits -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ExecutionUnits -> ExUnits
toAlonzoExUnits ExecutionUnits
maxBlockExUnits
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (Natural -> Identity Natural)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams ledgerera) Natural
ppMaxValSizeL ((Natural -> Identity Natural)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> Natural -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
maxValueSize
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (Natural -> Identity Natural)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams ledgerera) Natural
ppCollateralPercentageL ((Natural -> Identity Natural)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> Natural -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
collateralPercent
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (Natural -> Identity Natural)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams ledgerera) Natural
ppMaxCollateralInputsL ((Natural -> Identity Natural)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> Natural -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
maxCollateralInputs
    PParams ledgerera
-> Either ProtocolParametersConversionError (PParams ledgerera)
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParams ledgerera
ppAlonzoCommon

toAlonzoPParams
  :: Ledger.Crypto crypto
  => ProtocolParameters
  -> Either ProtocolParametersConversionError (PParams (Ledger.AlonzoEra crypto))
toAlonzoPParams :: forall crypto.
Crypto crypto =>
ProtocolParameters
-> Either
     ProtocolParametersConversionError (PParams (AlonzoEra crypto))
toAlonzoPParams
  protocolParameters :: ProtocolParameters
protocolParameters@ProtocolParameters
    { Maybe Rational
protocolParamDecentralization :: ProtocolParameters -> Maybe Rational
protocolParamDecentralization :: Maybe Rational
protocolParamDecentralization
    } = do
    PParams (AlonzoEra crypto)
ppAlonzoCommon <- ProtocolParameters
-> Either
     ProtocolParametersConversionError (PParams (AlonzoEra crypto))
forall ledgerera.
AlonzoEraPParams ledgerera =>
ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
toAlonzoCommonPParams ProtocolParameters
protocolParameters
    UnitInterval
d <-
      String
-> (Rational
    -> Either ProtocolParametersConversionError UnitInterval)
-> Maybe Rational
-> Either ProtocolParametersConversionError UnitInterval
forall a b.
String
-> (a -> Either ProtocolParametersConversionError b)
-> Maybe a
-> Either ProtocolParametersConversionError b
requireParam
        String
"protocolParamDecentralization"
        (String
-> Rational
-> Either ProtocolParametersConversionError UnitInterval
forall b.
BoundedRational b =>
String -> Rational -> Either ProtocolParametersConversionError b
boundRationalEither String
"D")
        Maybe Rational
protocolParamDecentralization
    let ppAlonzo :: PParams (AlonzoEra crypto)
ppAlonzo =
          PParams (AlonzoEra crypto)
ppAlonzoCommon
            PParams (AlonzoEra crypto)
-> (PParams (AlonzoEra crypto) -> PParams (AlonzoEra crypto))
-> PParams (AlonzoEra crypto)
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams (AlonzoEra crypto)
-> Identity (PParams (AlonzoEra crypto))
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) UnitInterval
Lens' (PParams (AlonzoEra crypto)) UnitInterval
ppDL ((UnitInterval -> Identity UnitInterval)
 -> PParams (AlonzoEra crypto)
 -> Identity (PParams (AlonzoEra crypto)))
-> UnitInterval
-> PParams (AlonzoEra crypto)
-> PParams (AlonzoEra crypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
d
    PParams (AlonzoEra crypto)
-> Either
     ProtocolParametersConversionError (PParams (AlonzoEra crypto))
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParams (AlonzoEra crypto)
ppAlonzo

toBabbagePParams
  :: BabbageEraPParams ledgerera
  => ProtocolParameters
  -> Either ProtocolParametersConversionError (PParams ledgerera)
toBabbagePParams :: forall ledgerera.
BabbageEraPParams ledgerera =>
ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
toBabbagePParams
  protocolParameters :: ProtocolParameters
protocolParameters@ProtocolParameters
    { Maybe Coin
protocolParamUTxOCostPerByte :: ProtocolParameters -> Maybe Coin
protocolParamUTxOCostPerByte :: Maybe Coin
protocolParamUTxOCostPerByte
    } = do
    PParams ledgerera
ppAlonzoCommon <- ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
forall ledgerera.
AlonzoEraPParams ledgerera =>
ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
toAlonzoCommonPParams ProtocolParameters
protocolParameters
    Coin
utxoCostPerByte <-
      String
-> (Coin -> Either ProtocolParametersConversionError Coin)
-> Maybe Coin
-> Either ProtocolParametersConversionError Coin
forall a b.
String
-> (a -> Either ProtocolParametersConversionError b)
-> Maybe a
-> Either ProtocolParametersConversionError b
requireParam String
"protocolParamUTxOCostPerByte" Coin -> Either ProtocolParametersConversionError Coin
forall a b. b -> Either a b
Right Maybe Coin
protocolParamUTxOCostPerByte
    let ppBabbage :: PParams ledgerera
ppBabbage =
          PParams ledgerera
ppAlonzoCommon
            PParams ledgerera
-> (PParams ledgerera -> PParams ledgerera) -> PParams ledgerera
forall a b. a -> (a -> b) -> b
& (CoinPerByte -> Identity CoinPerByte)
-> PParams ledgerera -> Identity (PParams ledgerera)
forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
Lens' (PParams ledgerera) CoinPerByte
ppCoinsPerUTxOByteL ((CoinPerByte -> Identity CoinPerByte)
 -> PParams ledgerera -> Identity (PParams ledgerera))
-> CoinPerByte -> PParams ledgerera -> PParams ledgerera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> CoinPerByte
CoinPerByte Coin
utxoCostPerByte
    PParams ledgerera
-> Either ProtocolParametersConversionError (PParams ledgerera)
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParams ledgerera
ppBabbage

toConwayPParams
  :: BabbageEraPParams ledgerera
  => ProtocolParameters
  -> Either ProtocolParametersConversionError (PParams ledgerera)
toConwayPParams :: forall ledgerera.
BabbageEraPParams ledgerera =>
ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
toConwayPParams = ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
forall ledgerera.
BabbageEraPParams ledgerera =>
ProtocolParameters
-> Either ProtocolParametersConversionError (PParams ledgerera)
toBabbagePParams

-- ----------------------------------------------------------------------------
-- Conversion functions: protocol parameters from ledger types
--

{-# DEPRECATED
  fromLedgerPParams
  "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork."
  #-}
fromLedgerPParams
  :: ShelleyBasedEra era
  -> Ledger.PParams (ShelleyLedgerEra era)
  -> ProtocolParameters
fromLedgerPParams :: forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era) -> ProtocolParameters
fromLedgerPParams ShelleyBasedEra era
ShelleyBasedEraShelley = PParams (ShelleyEra StandardCrypto) -> ProtocolParameters
PParams (ShelleyLedgerEra era) -> ProtocolParameters
forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera) =>
PParams ledgerera -> ProtocolParameters
fromShelleyPParams
fromLedgerPParams ShelleyBasedEra era
ShelleyBasedEraAllegra = PParams (AllegraEra StandardCrypto) -> ProtocolParameters
PParams (ShelleyLedgerEra era) -> ProtocolParameters
forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera) =>
PParams ledgerera -> ProtocolParameters
fromShelleyPParams
fromLedgerPParams ShelleyBasedEra era
ShelleyBasedEraMary = PParams (MaryEra StandardCrypto) -> ProtocolParameters
PParams (ShelleyLedgerEra era) -> ProtocolParameters
forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera) =>
PParams ledgerera -> ProtocolParameters
fromShelleyPParams
fromLedgerPParams ShelleyBasedEra era
ShelleyBasedEraAlonzo = PParams (AlonzoEra StandardCrypto) -> ProtocolParameters
PParams (ShelleyLedgerEra era) -> ProtocolParameters
forall ledgerera.
(AlonzoEraPParams ledgerera, ExactEra AlonzoEra ledgerera) =>
PParams ledgerera -> ProtocolParameters
fromExactlyAlonzoPParams
fromLedgerPParams ShelleyBasedEra era
ShelleyBasedEraBabbage = PParams (BabbageEra StandardCrypto) -> ProtocolParameters
PParams (ShelleyLedgerEra era) -> ProtocolParameters
forall ledgerera.
BabbageEraPParams ledgerera =>
PParams ledgerera -> ProtocolParameters
fromBabbagePParams
fromLedgerPParams ShelleyBasedEra era
ShelleyBasedEraConway = PParams StandardConway -> ProtocolParameters
PParams (ShelleyLedgerEra era) -> ProtocolParameters
forall ledgerera.
BabbageEraPParams ledgerera =>
PParams ledgerera -> ProtocolParameters
fromConwayPParams

{-# DEPRECATED
  fromShelleyCommonPParams
  "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork."
  #-}
fromShelleyCommonPParams
  :: EraPParams ledgerera
  => PParams ledgerera
  -> ProtocolParameters
fromShelleyCommonPParams :: forall ledgerera.
EraPParams ledgerera =>
PParams ledgerera -> ProtocolParameters
fromShelleyCommonPParams PParams ledgerera
pp =
  ProtocolParameters
    { protocolParamProtocolVersion :: (Natural, Natural)
protocolParamProtocolVersion = case PParams ledgerera
pp PParams ledgerera
-> Getting ProtVer (PParams ledgerera) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams ledgerera) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams ledgerera) ProtVer
ppProtocolVersionL of
        Ledger.ProtVer Version
a Natural
b -> (Version -> Natural
forall i. Integral i => Version -> i
Ledger.getVersion Version
a, Natural
b)
    , protocolParamMaxBlockHeaderSize :: Natural
protocolParamMaxBlockHeaderSize = Word16 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Natural) -> Word16 -> Natural
forall a b. (a -> b) -> a -> b
$ PParams ledgerera
pp PParams ledgerera
-> Getting Word16 (PParams ledgerera) Word16 -> Word16
forall s a. s -> Getting a s a -> a
^. Getting Word16 (PParams ledgerera) Word16
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams ledgerera) Word16
ppMaxBHSizeL
    , protocolParamMaxBlockBodySize :: Natural
protocolParamMaxBlockBodySize = Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Natural) -> Word32 -> Natural
forall a b. (a -> b) -> a -> b
$ PParams ledgerera
pp PParams ledgerera
-> Getting Word32 (PParams ledgerera) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams ledgerera) Word32
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams ledgerera) Word32
ppMaxBBSizeL
    , protocolParamMaxTxSize :: Natural
protocolParamMaxTxSize = Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Natural) -> Word32 -> Natural
forall a b. (a -> b) -> a -> b
$ PParams ledgerera
pp PParams ledgerera
-> Getting Word32 (PParams ledgerera) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams ledgerera) Word32
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams ledgerera) Word32
ppMaxTxSizeL
    , protocolParamTxFeeFixed :: Coin
protocolParamTxFeeFixed = PParams ledgerera
pp PParams ledgerera -> Getting Coin (PParams ledgerera) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams ledgerera) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ledgerera) Coin
ppMinFeeBL
    , protocolParamTxFeePerByte :: Coin
protocolParamTxFeePerByte = PParams ledgerera
pp PParams ledgerera -> Getting Coin (PParams ledgerera) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams ledgerera) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ledgerera) Coin
ppMinFeeAL
    , protocolParamStakeAddressDeposit :: Coin
protocolParamStakeAddressDeposit = PParams ledgerera
pp PParams ledgerera -> Getting Coin (PParams ledgerera) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams ledgerera) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ledgerera) Coin
ppKeyDepositL
    , protocolParamStakePoolDeposit :: Coin
protocolParamStakePoolDeposit = PParams ledgerera
pp PParams ledgerera -> Getting Coin (PParams ledgerera) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams ledgerera) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ledgerera) Coin
ppPoolDepositL
    , protocolParamMinPoolCost :: Coin
protocolParamMinPoolCost = PParams ledgerera
pp PParams ledgerera -> Getting Coin (PParams ledgerera) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams ledgerera) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ledgerera) Coin
ppMinPoolCostL
    , protocolParamPoolRetireMaxEpoch :: EpochInterval
protocolParamPoolRetireMaxEpoch = PParams ledgerera
pp PParams ledgerera
-> Getting EpochInterval (PParams ledgerera) EpochInterval
-> EpochInterval
forall s a. s -> Getting a s a -> a
^. Getting EpochInterval (PParams ledgerera) EpochInterval
forall era. EraPParams era => Lens' (PParams era) EpochInterval
Lens' (PParams ledgerera) EpochInterval
ppEMaxL
    , protocolParamStakePoolTargetNum :: Natural
protocolParamStakePoolTargetNum = PParams ledgerera
pp PParams ledgerera
-> Getting Natural (PParams ledgerera) Natural -> Natural
forall s a. s -> Getting a s a -> a
^. Getting Natural (PParams ledgerera) Natural
forall era. EraPParams era => Lens' (PParams era) Natural
Lens' (PParams ledgerera) Natural
ppNOptL
    , protocolParamPoolPledgeInfluence :: Rational
protocolParamPoolPledgeInfluence = NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational (PParams ledgerera
pp PParams ledgerera
-> Getting
     NonNegativeInterval (PParams ledgerera) NonNegativeInterval
-> NonNegativeInterval
forall s a. s -> Getting a s a -> a
^. Getting NonNegativeInterval (PParams ledgerera) NonNegativeInterval
forall era.
EraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams ledgerera) NonNegativeInterval
ppA0L)
    , protocolParamMonetaryExpansion :: Rational
protocolParamMonetaryExpansion = UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational (PParams ledgerera
pp PParams ledgerera
-> Getting UnitInterval (PParams ledgerera) UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval (PParams ledgerera) UnitInterval
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams ledgerera) UnitInterval
ppRhoL)
    , protocolParamTreasuryCut :: Rational
protocolParamTreasuryCut = UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational (PParams ledgerera
pp PParams ledgerera
-> Getting UnitInterval (PParams ledgerera) UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval (PParams ledgerera) UnitInterval
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams ledgerera) UnitInterval
ppTauL)
    , protocolParamCostModels :: Map AnyPlutusScriptVersion CostModel
protocolParamCostModels = Map AnyPlutusScriptVersion CostModel
forall a. Monoid a => a
mempty -- Only from Alonzo onwards
    , protocolParamPrices :: Maybe ExecutionUnitPrices
protocolParamPrices = Maybe ExecutionUnitPrices
forall a. Maybe a
Nothing -- Only from Alonzo onwards
    , protocolParamMaxTxExUnits :: Maybe ExecutionUnits
protocolParamMaxTxExUnits = Maybe ExecutionUnits
forall a. Maybe a
Nothing -- Only from Alonzo onwards
    , protocolParamMaxBlockExUnits :: Maybe ExecutionUnits
protocolParamMaxBlockExUnits = Maybe ExecutionUnits
forall a. Maybe a
Nothing -- Only from Alonzo onwards
    , protocolParamMaxValueSize :: Maybe Natural
protocolParamMaxValueSize = Maybe Natural
forall a. Maybe a
Nothing -- Only from Alonzo onwards
    , protocolParamCollateralPercent :: Maybe Natural
protocolParamCollateralPercent = Maybe Natural
forall a. Maybe a
Nothing -- Only from Alonzo onwards
    , protocolParamMaxCollateralInputs :: Maybe Natural
protocolParamMaxCollateralInputs = Maybe Natural
forall a. Maybe a
Nothing -- Only from Alonzo onwards
    , protocolParamUTxOCostPerByte :: Maybe Coin
protocolParamUTxOCostPerByte = Maybe Coin
forall a. Maybe a
Nothing -- Only from Babbage onwards
    , protocolParamDecentralization :: Maybe Rational
protocolParamDecentralization = Maybe Rational
forall a. Maybe a
Nothing -- Obsolete from Babbage onwards
    , protocolParamExtraPraosEntropy :: Maybe PraosNonce
protocolParamExtraPraosEntropy = Maybe PraosNonce
forall a. Maybe a
Nothing -- Obsolete from Alonzo onwards
    , protocolParamMinUTxOValue :: Maybe Coin
protocolParamMinUTxOValue = Maybe Coin
forall a. Maybe a
Nothing -- Obsolete from Alonzo onwards
    }

{-# DEPRECATED
  fromShelleyPParams
  "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork."
  #-}
fromShelleyPParams
  :: ( EraPParams ledgerera
     , Ledger.AtMostEra Ledger.MaryEra ledgerera
     , Ledger.AtMostEra Ledger.AlonzoEra ledgerera
     )
  => PParams ledgerera
  -> ProtocolParameters
fromShelleyPParams :: forall ledgerera.
(EraPParams ledgerera, AtMostEra MaryEra ledgerera,
 AtMostEra AlonzoEra ledgerera) =>
PParams ledgerera -> ProtocolParameters
fromShelleyPParams PParams ledgerera
pp =
  (PParams ledgerera -> ProtocolParameters
forall ledgerera.
EraPParams ledgerera =>
PParams ledgerera -> ProtocolParameters
fromShelleyCommonPParams PParams ledgerera
pp)
    { protocolParamDecentralization = Just . Ledger.unboundRational $ pp ^. ppDL
    , protocolParamExtraPraosEntropy = fromLedgerNonce $ pp ^. ppExtraEntropyL
    , protocolParamMinUTxOValue = Just $ pp ^. ppMinUTxOValueL
    }

{-# DEPRECATED
  fromAlonzoPParams
  "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork."
  #-}
fromAlonzoPParams
  :: AlonzoEraPParams ledgerera
  => PParams ledgerera
  -> ProtocolParameters
fromAlonzoPParams :: forall ledgerera.
AlonzoEraPParams ledgerera =>
PParams ledgerera -> ProtocolParameters
fromAlonzoPParams PParams ledgerera
pp =
  (PParams ledgerera -> ProtocolParameters
forall ledgerera.
EraPParams ledgerera =>
PParams ledgerera -> ProtocolParameters
fromShelleyCommonPParams PParams ledgerera
pp)
    { protocolParamCostModels = fromAlonzoCostModels $ pp ^. ppCostModelsL
    , protocolParamDecentralization = Just . Ledger.unboundRational $ pp ^. ppDG
    , protocolParamPrices = Just . fromAlonzoPrices $ pp ^. ppPricesL
    , protocolParamMaxTxExUnits = Just . fromAlonzoExUnits $ pp ^. ppMaxTxExUnitsL
    , protocolParamMaxBlockExUnits = Just . fromAlonzoExUnits $ pp ^. ppMaxBlockExUnitsL
    , protocolParamMaxValueSize = Just $ pp ^. ppMaxValSizeL
    , protocolParamCollateralPercent = Just $ pp ^. ppCollateralPercentageL
    , protocolParamMaxCollateralInputs = Just $ pp ^. ppMaxCollateralInputsL
    }

{-# DEPRECATED
  fromExactlyAlonzoPParams
  "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork."
  #-}
fromExactlyAlonzoPParams
  :: (AlonzoEraPParams ledgerera, Ledger.ExactEra Ledger.AlonzoEra ledgerera)
  => PParams ledgerera
  -> ProtocolParameters
fromExactlyAlonzoPParams :: forall ledgerera.
(AlonzoEraPParams ledgerera, ExactEra AlonzoEra ledgerera) =>
PParams ledgerera -> ProtocolParameters
fromExactlyAlonzoPParams PParams ledgerera
pp =
  (PParams ledgerera -> ProtocolParameters
forall ledgerera.
AlonzoEraPParams ledgerera =>
PParams ledgerera -> ProtocolParameters
fromAlonzoPParams PParams ledgerera
pp)
    { protocolParamUTxOCostPerByte = Just . unCoinPerWord $ pp ^. ppCoinsPerUTxOWordL
    }

{-# DEPRECATED
  fromBabbagePParams
  "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork."
  #-}
fromBabbagePParams
  :: BabbageEraPParams ledgerera
  => PParams ledgerera
  -> ProtocolParameters
fromBabbagePParams :: forall ledgerera.
BabbageEraPParams ledgerera =>
PParams ledgerera -> ProtocolParameters
fromBabbagePParams PParams ledgerera
pp =
  (PParams ledgerera -> ProtocolParameters
forall ledgerera.
AlonzoEraPParams ledgerera =>
PParams ledgerera -> ProtocolParameters
fromAlonzoPParams PParams ledgerera
pp)
    { protocolParamUTxOCostPerByte = Just . unCoinPerByte $ pp ^. ppCoinsPerUTxOByteL
    , protocolParamDecentralization = Nothing
    }

{-# DEPRECATED
  fromConwayPParams
  "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork."
  #-}
fromConwayPParams
  :: BabbageEraPParams ledgerera
  => PParams ledgerera
  -> ProtocolParameters
fromConwayPParams :: forall ledgerera.
BabbageEraPParams ledgerera =>
PParams ledgerera -> ProtocolParameters
fromConwayPParams = PParams ledgerera -> ProtocolParameters
forall ledgerera.
BabbageEraPParams ledgerera =>
PParams ledgerera -> ProtocolParameters
fromBabbagePParams

{-# DEPRECATED
  checkProtocolParameters
  "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork. PParams natively enforce these checks."
  #-}
checkProtocolParameters
  :: ()
  => ShelleyBasedEra era
  -> ProtocolParameters
  -> Either ProtocolParametersError ()
checkProtocolParameters :: forall era.
ShelleyBasedEra era
-> ProtocolParameters -> Either ProtocolParametersError ()
checkProtocolParameters ShelleyBasedEra era
sbe ProtocolParameters{Natural
Maybe Natural
Maybe Rational
Maybe Coin
Maybe ExecutionUnits
Maybe ExecutionUnitPrices
Maybe PraosNonce
Rational
(Natural, Natural)
Map AnyPlutusScriptVersion CostModel
Coin
EpochInterval
protocolParamProtocolVersion :: ProtocolParameters -> (Natural, Natural)
protocolParamDecentralization :: ProtocolParameters -> Maybe Rational
protocolParamExtraPraosEntropy :: ProtocolParameters -> Maybe PraosNonce
protocolParamMaxBlockHeaderSize :: ProtocolParameters -> Natural
protocolParamMaxBlockBodySize :: ProtocolParameters -> Natural
protocolParamMaxTxSize :: ProtocolParameters -> Natural
protocolParamTxFeeFixed :: ProtocolParameters -> Coin
protocolParamTxFeePerByte :: ProtocolParameters -> Coin
protocolParamMinUTxOValue :: ProtocolParameters -> Maybe Coin
protocolParamStakeAddressDeposit :: ProtocolParameters -> Coin
protocolParamStakePoolDeposit :: ProtocolParameters -> Coin
protocolParamMinPoolCost :: ProtocolParameters -> Coin
protocolParamPoolRetireMaxEpoch :: ProtocolParameters -> EpochInterval
protocolParamStakePoolTargetNum :: ProtocolParameters -> Natural
protocolParamPoolPledgeInfluence :: ProtocolParameters -> Rational
protocolParamMonetaryExpansion :: ProtocolParameters -> Rational
protocolParamTreasuryCut :: ProtocolParameters -> Rational
protocolParamCostModels :: ProtocolParameters -> Map AnyPlutusScriptVersion CostModel
protocolParamPrices :: ProtocolParameters -> Maybe ExecutionUnitPrices
protocolParamMaxTxExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxBlockExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxValueSize :: ProtocolParameters -> Maybe Natural
protocolParamCollateralPercent :: ProtocolParameters -> Maybe Natural
protocolParamMaxCollateralInputs :: ProtocolParameters -> Maybe Natural
protocolParamUTxOCostPerByte :: ProtocolParameters -> Maybe Coin
protocolParamProtocolVersion :: (Natural, Natural)
protocolParamDecentralization :: Maybe Rational
protocolParamExtraPraosEntropy :: Maybe PraosNonce
protocolParamMaxBlockHeaderSize :: Natural
protocolParamMaxBlockBodySize :: Natural
protocolParamMaxTxSize :: Natural
protocolParamTxFeeFixed :: Coin
protocolParamTxFeePerByte :: Coin
protocolParamMinUTxOValue :: Maybe Coin
protocolParamStakeAddressDeposit :: Coin
protocolParamStakePoolDeposit :: Coin
protocolParamMinPoolCost :: Coin
protocolParamPoolRetireMaxEpoch :: EpochInterval
protocolParamStakePoolTargetNum :: Natural
protocolParamPoolPledgeInfluence :: Rational
protocolParamMonetaryExpansion :: Rational
protocolParamTreasuryCut :: Rational
protocolParamCostModels :: Map AnyPlutusScriptVersion CostModel
protocolParamPrices :: Maybe ExecutionUnitPrices
protocolParamMaxTxExUnits :: Maybe ExecutionUnits
protocolParamMaxBlockExUnits :: Maybe ExecutionUnits
protocolParamMaxValueSize :: Maybe Natural
protocolParamCollateralPercent :: Maybe Natural
protocolParamMaxCollateralInputs :: Maybe Natural
protocolParamUTxOCostPerByte :: Maybe Coin
..} =
  case ShelleyBasedEra era
sbe of
    ShelleyBasedEra era
ShelleyBasedEraShelley -> Either ProtocolParametersError ()
checkMinUTxOVal
    ShelleyBasedEra era
ShelleyBasedEraAllegra -> Either ProtocolParametersError ()
checkMinUTxOVal
    ShelleyBasedEra era
ShelleyBasedEraMary -> Either ProtocolParametersError ()
checkMinUTxOVal
    ShelleyBasedEra era
ShelleyBasedEraAlonzo -> Either ProtocolParametersError ()
checkAlonzoParams
    ShelleyBasedEra era
ShelleyBasedEraBabbage -> Either ProtocolParametersError ()
checkBabbageParams
    ShelleyBasedEra era
ShelleyBasedEraConway -> Either ProtocolParametersError ()
checkBabbageParams
 where
  era :: CardanoEra era
era = ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
sbe

  cModel :: Bool
cModel = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map AnyPlutusScriptVersion CostModel -> Bool
forall k a. Map k a -> Bool
Map.null Map AnyPlutusScriptVersion CostModel
protocolParamCostModels
  prices :: Bool
prices = Maybe ExecutionUnitPrices -> Bool
forall a. Maybe a -> Bool
isJust Maybe ExecutionUnitPrices
protocolParamPrices
  maxTxUnits :: Bool
maxTxUnits = Maybe ExecutionUnits -> Bool
forall a. Maybe a -> Bool
isJust Maybe ExecutionUnits
protocolParamMaxTxExUnits
  maxBlockExUnits :: Bool
maxBlockExUnits = Maybe ExecutionUnits -> Bool
forall a. Maybe a -> Bool
isJust Maybe ExecutionUnits
protocolParamMaxBlockExUnits
  maxValueSize :: Bool
maxValueSize = Maybe Natural -> Bool
forall a. Maybe a -> Bool
isJust Maybe Natural
protocolParamMaxValueSize
  collateralPercent :: Bool
collateralPercent = Maybe Natural -> Bool
forall a. Maybe a -> Bool
isJust Maybe Natural
protocolParamCollateralPercent
  maxCollateralInputs :: Bool
maxCollateralInputs = Maybe Natural -> Bool
forall a. Maybe a -> Bool
isJust Maybe Natural
protocolParamMaxCollateralInputs
  costPerByte :: Bool
costPerByte = Maybe Coin -> Bool
forall a. Maybe a -> Bool
isJust Maybe Coin
protocolParamUTxOCostPerByte
  decentralization :: Bool
decentralization = Maybe Rational -> Bool
forall a. Maybe a -> Bool
isJust Maybe Rational
protocolParamDecentralization
  extraPraosEntropy :: Bool
extraPraosEntropy = Maybe PraosNonce -> Bool
forall a. Maybe a -> Bool
isJust Maybe PraosNonce
protocolParamExtraPraosEntropy

  alonzoPParamFieldsRequirements :: [Bool]
  alonzoPParamFieldsRequirements :: [Bool]
alonzoPParamFieldsRequirements =
    [ Bool
cModel
    , Bool
prices
    , Bool
maxTxUnits
    , Bool
maxBlockExUnits
    , Bool
maxValueSize
    , Bool
collateralPercent
    , Bool
maxCollateralInputs
    , Bool -> Bool
not Bool
costPerByte
    ]

  babbagePParamFieldsRequirements :: [Bool]
  babbagePParamFieldsRequirements :: [Bool]
babbagePParamFieldsRequirements =
    [ Bool
cModel
    , Bool
prices
    , Bool
maxTxUnits
    , Bool
maxBlockExUnits
    , Bool
maxValueSize
    , Bool
collateralPercent
    , Bool
maxCollateralInputs
    , Bool
costPerByte
    , Bool -> Bool
not Bool
decentralization
    , Bool -> Bool
not Bool
extraPraosEntropy
    ]

  checkAlonzoParams :: Either ProtocolParametersError ()
  checkAlonzoParams :: Either ProtocolParametersError ()
checkAlonzoParams = do
    if (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) [Bool]
alonzoPParamFieldsRequirements
      then () -> Either ProtocolParametersError ()
forall a. a -> Either ProtocolParametersError a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      else ProtocolParametersError -> Either ProtocolParametersError ()
forall a b. a -> Either a b
Left ProtocolParametersError
PParamsErrorMissingAlonzoProtocolParameter

  checkBabbageParams :: Either ProtocolParametersError ()
  checkBabbageParams :: Either ProtocolParametersError ()
checkBabbageParams =
    if (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) [Bool]
babbagePParamFieldsRequirements
      then () -> Either ProtocolParametersError ()
forall a. a -> Either ProtocolParametersError a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      else ProtocolParametersError -> Either ProtocolParametersError ()
forall a b. a -> Either a b
Left ProtocolParametersError
PParamsErrorMissingAlonzoProtocolParameter

  checkMinUTxOVal :: Either ProtocolParametersError ()
  checkMinUTxOVal :: Either ProtocolParametersError ()
checkMinUTxOVal =
    if Maybe Coin -> Bool
forall a. Maybe a -> Bool
isJust Maybe Coin
protocolParamMinUTxOValue
      then () -> Either ProtocolParametersError ()
forall a. a -> Either ProtocolParametersError a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      else ProtocolParametersError -> Either ProtocolParametersError ()
forall a b. a -> Either a b
Left (ProtocolParametersError -> Either ProtocolParametersError ())
-> (AnyCardanoEra -> ProtocolParametersError)
-> AnyCardanoEra
-> Either ProtocolParametersError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCardanoEra -> ProtocolParametersError
PParamsErrorMissingMinUTxoValue (AnyCardanoEra -> Either ProtocolParametersError ())
-> AnyCardanoEra -> Either ProtocolParametersError ()
forall a b. (a -> b) -> a -> b
$ CardanoEra era
-> (CardanoEraConstraints era => AnyCardanoEra) -> AnyCardanoEra
forall era a.
CardanoEra era -> (CardanoEraConstraints era => a) -> a
cardanoEraConstraints CardanoEra era
era ((CardanoEraConstraints era => AnyCardanoEra) -> AnyCardanoEra)
-> (CardanoEraConstraints era => AnyCardanoEra) -> AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era

data ProtocolParametersError
  = PParamsErrorMissingMinUTxoValue !AnyCardanoEra
  | PParamsErrorMissingAlonzoProtocolParameter
  deriving Int -> ProtocolParametersError -> ShowS
[ProtocolParametersError] -> ShowS
ProtocolParametersError -> String
(Int -> ProtocolParametersError -> ShowS)
-> (ProtocolParametersError -> String)
-> ([ProtocolParametersError] -> ShowS)
-> Show ProtocolParametersError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtocolParametersError -> ShowS
showsPrec :: Int -> ProtocolParametersError -> ShowS
$cshow :: ProtocolParametersError -> String
show :: ProtocolParametersError -> String
$cshowList :: [ProtocolParametersError] -> ShowS
showList :: [ProtocolParametersError] -> ShowS
Show

instance Error ProtocolParametersError where
  prettyError :: forall ann. ProtocolParametersError -> Doc ann
prettyError = \case
    PParamsErrorMissingMinUTxoValue (AnyCardanoEra CardanoEra era
era) ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> CardanoEra era -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CardanoEra era -> Doc ann
pretty CardanoEra era
era Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" protocol parameters value is missing the following "
        , Doc ann
"field: MinUTxoValue. Did you intend to use a " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> CardanoEra era -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CardanoEra era -> Doc ann
pretty CardanoEra era
era Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" protocol "
        , Doc ann
"parameters value?"
        ]
    ProtocolParametersError
PParamsErrorMissingAlonzoProtocolParameter ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"The Alonzo era protocol parameters in use is missing one or more of the "
        , Doc ann
"following fields: UTxOCostPerWord, CostModels, Prices, MaxTxExUnits, "
        , Doc ann
"MaxBlockExUnits, MaxValueSize, CollateralPercent, MaxCollateralInputs. Did "
        , Doc ann
"you intend to use an Alonzo era protocol parameters value?"
        ]

data ProtocolParametersConversionError
  = PpceOutOfBounds !ProtocolParameterName !Rational
  | PpceVersionInvalid !ProtocolParameterVersion
  | PpceInvalidCostModel !CostModel !CostModelApplyError
  | PpceMissingParameter !ProtocolParameterName
  deriving (ProtocolParametersConversionError
-> ProtocolParametersConversionError -> Bool
(ProtocolParametersConversionError
 -> ProtocolParametersConversionError -> Bool)
-> (ProtocolParametersConversionError
    -> ProtocolParametersConversionError -> Bool)
-> Eq ProtocolParametersConversionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtocolParametersConversionError
-> ProtocolParametersConversionError -> Bool
== :: ProtocolParametersConversionError
-> ProtocolParametersConversionError -> Bool
$c/= :: ProtocolParametersConversionError
-> ProtocolParametersConversionError -> Bool
/= :: ProtocolParametersConversionError
-> ProtocolParametersConversionError -> Bool
Eq, Int -> ProtocolParametersConversionError -> ShowS
[ProtocolParametersConversionError] -> ShowS
ProtocolParametersConversionError -> String
(Int -> ProtocolParametersConversionError -> ShowS)
-> (ProtocolParametersConversionError -> String)
-> ([ProtocolParametersConversionError] -> ShowS)
-> Show ProtocolParametersConversionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtocolParametersConversionError -> ShowS
showsPrec :: Int -> ProtocolParametersConversionError -> ShowS
$cshow :: ProtocolParametersConversionError -> String
show :: ProtocolParametersConversionError -> String
$cshowList :: [ProtocolParametersConversionError] -> ShowS
showList :: [ProtocolParametersConversionError] -> ShowS
Show, Typeable ProtocolParametersConversionError
Typeable ProtocolParametersConversionError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ProtocolParametersConversionError
 -> c ProtocolParametersConversionError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ProtocolParametersConversionError)
-> (ProtocolParametersConversionError -> Constr)
-> (ProtocolParametersConversionError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ProtocolParametersConversionError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ProtocolParametersConversionError))
-> ((forall b. Data b => b -> b)
    -> ProtocolParametersConversionError
    -> ProtocolParametersConversionError)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ProtocolParametersConversionError
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ProtocolParametersConversionError
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ProtocolParametersConversionError -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ProtocolParametersConversionError
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ProtocolParametersConversionError
    -> m ProtocolParametersConversionError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ProtocolParametersConversionError
    -> m ProtocolParametersConversionError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ProtocolParametersConversionError
    -> m ProtocolParametersConversionError)
-> Data ProtocolParametersConversionError
ProtocolParametersConversionError -> Constr
ProtocolParametersConversionError -> DataType
(forall b. Data b => b -> b)
-> ProtocolParametersConversionError
-> ProtocolParametersConversionError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> ProtocolParametersConversionError
-> u
forall u.
(forall d. Data d => d -> u)
-> ProtocolParametersConversionError -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ProtocolParametersConversionError
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ProtocolParametersConversionError
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ProtocolParametersConversionError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ProtocolParametersConversionError
-> c ProtocolParametersConversionError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ProtocolParametersConversionError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ProtocolParametersConversionError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ProtocolParametersConversionError
-> c ProtocolParametersConversionError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ProtocolParametersConversionError
-> c ProtocolParametersConversionError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ProtocolParametersConversionError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ProtocolParametersConversionError
$ctoConstr :: ProtocolParametersConversionError -> Constr
toConstr :: ProtocolParametersConversionError -> Constr
$cdataTypeOf :: ProtocolParametersConversionError -> DataType
dataTypeOf :: ProtocolParametersConversionError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ProtocolParametersConversionError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ProtocolParametersConversionError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ProtocolParametersConversionError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ProtocolParametersConversionError)
$cgmapT :: (forall b. Data b => b -> b)
-> ProtocolParametersConversionError
-> ProtocolParametersConversionError
gmapT :: (forall b. Data b => b -> b)
-> ProtocolParametersConversionError
-> ProtocolParametersConversionError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ProtocolParametersConversionError
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ProtocolParametersConversionError
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ProtocolParametersConversionError
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ProtocolParametersConversionError
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ProtocolParametersConversionError -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> ProtocolParametersConversionError -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ProtocolParametersConversionError
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ProtocolParametersConversionError
-> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ProtocolParametersConversionError
-> m ProtocolParametersConversionError
Data)

type ProtocolParameterName = String

type ProtocolParameterVersion = Natural

instance Error ProtocolParametersConversionError where
  prettyError :: forall ann. ProtocolParametersConversionError -> Doc ann
prettyError = \case
    PpceOutOfBounds String
name Rational
r ->
      Doc ann
"Value for '" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"' is outside of bounds: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Double -> Doc ann
forall ann. Double -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r :: Double)
    PpceVersionInvalid Natural
majorProtVer ->
      Doc ann
"Major protocol version is invalid: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Natural -> Doc ann
forall ann. Natural -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Natural
majorProtVer
    PpceInvalidCostModel CostModel
cm CostModelApplyError
err ->
      Doc ann
"Invalid cost model: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty @Text (CostModelApplyError -> Text
forall str a. (Pretty a, Render str) => a -> str
display CostModelApplyError
err) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" Cost model: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> CostModel -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow CostModel
cm
    PpceMissingParameter String
name ->
      Doc ann
"Missing parameter: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name