{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- | 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,
    ProtocolParametersError(..),
    EpochNo,

    -- * Updates to the protocol parameters
    ProtocolParametersUpdate(..),

    -- * PraosNonce
    PraosNonce,
    makePraosNonce,

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

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

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

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

import           Prelude

import           Control.Applicative ((<|>))
import           Control.Monad
import           Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.!=), (.:), (.:?),
                   (.=))
import           Data.Bifunctor (bimap, first)
import           Data.ByteString (ByteString)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (fromMaybe, isJust)
import           Data.String (IsString)
import           Data.Text (Text)
import           GHC.Generics
import           Numeric.Natural

import           Cardano.Api.Json (toRationalJSON)
import qualified Cardano.Binary as CBOR
import qualified Cardano.Crypto.Hash.Class as Crypto
import           Cardano.Slotting.Slot (EpochNo)

import           Cardano.Ledger.BaseTypes (strictMaybeToMaybe)
import qualified Cardano.Ledger.BaseTypes as Ledger
import qualified Cardano.Ledger.Core as Ledger
import           Cardano.Ledger.Crypto (StandardCrypto)
import qualified Cardano.Ledger.Era as Ledger
import qualified Cardano.Ledger.Keys as Ledger

import qualified Cardano.Ledger.Shelley.PParams as Ledger (ProposedPPUpdates (..), Update (..))
-- Some of the things from Cardano.Ledger.Shelley.PParams are generic across all
-- eras, and some are specific to the Shelley era (and other pre-Alonzo eras).
-- So we import in twice under different names.
import qualified Cardano.Ledger.Shelley.PParams as Shelley (PParams, PParams' (..), PParamsUpdate)

import qualified Cardano.Ledger.Alonzo.Language as Alonzo
import qualified Cardano.Ledger.Alonzo.PParams as Alonzo
import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo

import qualified Cardano.Ledger.Babbage.PParams as Babbage

import           Text.PrettyBy.Default (display)

import           Cardano.Api.Address
import           Cardano.Api.Eras
import           Cardano.Api.Error
import           Cardano.Api.Hash
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.KeysByron
import           Cardano.Api.KeysShelley
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

-- | 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'.
--
data ProtocolParameters =
     ProtocolParameters {

       -- | Protocol version, major and minor. Updating the major version is
       -- used to trigger hard forks.
       --                              (Major  , Minor  )
       ProtocolParameters -> (Natural, Natural)
protocolParamProtocolVersion :: (Natural, Natural),

       -- | 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 Rational
protocolParamDecentralization :: Maybe Rational,

       -- | 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 -> Maybe PraosNonce
protocolParamExtraPraosEntropy :: Maybe PraosNonce,

       -- | 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
protocolParamMaxBlockHeaderSize :: 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
protocolParamMaxBlockBodySize :: 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 -> Natural
protocolParamMaxTxSize :: Natural,

       -- | The constant factor for the minimum fee calculation.
       --
       ProtocolParameters -> Natural
protocolParamTxFeeFixed :: Natural,

       -- | The linear factor for the minimum fee calculation.
       --
       ProtocolParameters -> Natural
protocolParamTxFeePerByte :: Natural,

       -- | The minimum permitted value for new UTxO entries, ie for
       -- transaction outputs.
       --
       ProtocolParameters -> Maybe Lovelace
protocolParamMinUTxOValue :: Maybe Lovelace,

       -- | The deposit required to register a stake address.
       --
       ProtocolParameters -> Lovelace
protocolParamStakeAddressDeposit :: Lovelace,

       -- | The deposit required to register a stake pool.
       --
       ProtocolParameters -> Lovelace
protocolParamStakePoolDeposit :: Lovelace,

       -- | The minimum value that stake pools are permitted to declare for
       -- their cost parameter.
       --
       ProtocolParameters -> Lovelace
protocolParamMinPoolCost :: Lovelace,

       -- | The maximum number of epochs into the future that stake pools
       -- are permitted to schedule a retirement.
       --
       ProtocolParameters -> EpochNo
protocolParamPoolRetireMaxEpoch :: EpochNo,

       -- | The equilibrium target number of stake pools.
       --
       -- This is the \"k\" incentives parameter from the design document.
       --
       ProtocolParameters -> Natural
protocolParamStakePoolTargetNum :: Natural,

       -- | The influence of the pledge in stake pool rewards.
       --
       -- This is the \"a_0\" incentives parameter from the design document.
       --
       ProtocolParameters -> Rational
protocolParamPoolPledgeInfluence :: 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
protocolParamMonetaryExpansion :: 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 -> Rational
protocolParamTreasuryCut :: Rational,

       -- | Cost in ada per word of UTxO storage.
       --
       -- /Introduced in Alonzo/
       ProtocolParameters -> Maybe Lovelace
protocolParamUTxOCostPerWord :: Maybe Lovelace,

       -- | Cost models for script languages that use them.
       --
       -- /Introduced in Alonzo/
       ProtocolParameters -> Map AnyPlutusScriptVersion CostModel
protocolParamCostModels :: Map AnyPlutusScriptVersion CostModel,

       -- | Price of execution units for script languages that use them.
       --
       -- /Introduced in Alonzo/
       ProtocolParameters -> Maybe ExecutionUnitPrices
protocolParamPrices :: Maybe ExecutionUnitPrices,

       -- | Max total script execution resources units allowed per tx
       --
       -- /Introduced in Alonzo/
       ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxTxExUnits :: Maybe ExecutionUnits,

       -- | Max total script execution resources units allowed per block
       --
       -- /Introduced in Alonzo/
       ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxBlockExUnits :: Maybe ExecutionUnits,

       -- | Max size of a Value in a tx output.
       --
       -- /Introduced in Alonzo/
       ProtocolParameters -> Maybe Natural
protocolParamMaxValueSize :: 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
protocolParamCollateralPercent :: Maybe Natural,

       -- | The maximum number of collateral inputs allowed in a transaction.
       --
       -- /Introduced in Alonzo/
       ProtocolParameters -> Maybe Natural
protocolParamMaxCollateralInputs :: Maybe Natural,

       -- | Cost in ada per byte of UTxO storage.
       --
       -- /Introduced in Babbage/
       ProtocolParameters -> Maybe Lovelace
protocolParamUTxOCostPerByte :: Maybe Lovelace

    }
  deriving (ProtocolParameters -> ProtocolParameters -> Bool
(ProtocolParameters -> ProtocolParameters -> Bool)
-> (ProtocolParameters -> ProtocolParameters -> Bool)
-> Eq ProtocolParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolParameters -> ProtocolParameters -> Bool
$c/= :: ProtocolParameters -> ProtocolParameters -> Bool
== :: ProtocolParameters -> ProtocolParameters -> Bool
$c== :: 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
$cto :: forall x. Rep ProtocolParameters x -> ProtocolParameters
$cfrom :: forall x. ProtocolParameters -> Rep ProtocolParameters x
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
showList :: [ProtocolParameters] -> ShowS
$cshowList :: [ProtocolParameters] -> ShowS
show :: ProtocolParameters -> String
$cshow :: ProtocolParameters -> String
showsPrec :: Int -> ProtocolParameters -> ShowS
$cshowsPrec :: Int -> 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
-> Natural
-> Natural
-> Maybe Lovelace
-> Lovelace
-> Lovelace
-> Lovelace
-> EpochNo
-> Natural
-> Rational
-> Rational
-> Rational
-> Maybe Lovelace
-> Map AnyPlutusScriptVersion CostModel
-> Maybe ExecutionUnitPrices
-> Maybe ExecutionUnits
-> Maybe ExecutionUnits
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> ProtocolParameters
ProtocolParameters
        ((Natural, Natural)
 -> Maybe Rational
 -> Maybe PraosNonce
 -> Natural
 -> Natural
 -> Natural
 -> Natural
 -> Natural
 -> Maybe Lovelace
 -> Lovelace
 -> Lovelace
 -> Lovelace
 -> EpochNo
 -> Natural
 -> Rational
 -> Rational
 -> Rational
 -> Maybe Lovelace
 -> Map AnyPlutusScriptVersion CostModel
 -> Maybe ExecutionUnitPrices
 -> Maybe ExecutionUnits
 -> Maybe ExecutionUnits
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Lovelace
 -> ProtocolParameters)
-> Parser (Natural, Natural)
-> Parser
     (Maybe Rational
      -> Maybe PraosNonce
      -> Natural
      -> Natural
      -> Natural
      -> Natural
      -> Natural
      -> Maybe Lovelace
      -> Lovelace
      -> Lovelace
      -> Lovelace
      -> EpochNo
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> 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 (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
   -> Natural
   -> Natural
   -> Maybe Lovelace
   -> Lovelace
   -> Lovelace
   -> Lovelace
   -> EpochNo
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser (Maybe Rational)
-> Parser
     (Maybe PraosNonce
      -> Natural
      -> Natural
      -> Natural
      -> Natural
      -> Natural
      -> Maybe Lovelace
      -> Lovelace
      -> Lovelace
      -> Lovelace
      -> EpochNo
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
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
   -> Natural
   -> Natural
   -> Maybe Lovelace
   -> Lovelace
   -> Lovelace
   -> Lovelace
   -> EpochNo
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser (Maybe PraosNonce)
-> Parser
     (Natural
      -> Natural
      -> Natural
      -> Natural
      -> Natural
      -> Maybe Lovelace
      -> Lovelace
      -> Lovelace
      -> Lovelace
      -> EpochNo
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
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
   -> Natural
   -> Natural
   -> Maybe Lovelace
   -> Lovelace
   -> Lovelace
   -> Lovelace
   -> EpochNo
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser Natural
-> Parser
     (Natural
      -> Natural
      -> Natural
      -> Natural
      -> Maybe Lovelace
      -> Lovelace
      -> Lovelace
      -> Lovelace
      -> EpochNo
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
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
   -> Natural
   -> Natural
   -> Maybe Lovelace
   -> Lovelace
   -> Lovelace
   -> Lovelace
   -> EpochNo
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser Natural
-> Parser
     (Natural
      -> Natural
      -> Natural
      -> Maybe Lovelace
      -> Lovelace
      -> Lovelace
      -> Lovelace
      -> EpochNo
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
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
   -> Natural
   -> Natural
   -> Maybe Lovelace
   -> Lovelace
   -> Lovelace
   -> Lovelace
   -> EpochNo
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser Natural
-> Parser
     (Natural
      -> Natural
      -> Maybe Lovelace
      -> Lovelace
      -> Lovelace
      -> Lovelace
      -> EpochNo
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
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
  (Natural
   -> Natural
   -> Maybe Lovelace
   -> Lovelace
   -> Lovelace
   -> Lovelace
   -> EpochNo
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser Natural
-> Parser
     (Natural
      -> Maybe Lovelace
      -> Lovelace
      -> Lovelace
      -> Lovelace
      -> EpochNo
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
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
"txFeeFixed"
        Parser
  (Natural
   -> Maybe Lovelace
   -> Lovelace
   -> Lovelace
   -> Lovelace
   -> EpochNo
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser Natural
-> Parser
     (Maybe Lovelace
      -> Lovelace
      -> Lovelace
      -> Lovelace
      -> EpochNo
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
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
"txFeePerByte"
        Parser
  (Maybe Lovelace
   -> Lovelace
   -> Lovelace
   -> Lovelace
   -> EpochNo
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser (Maybe Lovelace)
-> Parser
     (Lovelace
      -> Lovelace
      -> Lovelace
      -> EpochNo
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Lovelace)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minUTxOValue"
        Parser
  (Lovelace
   -> Lovelace
   -> Lovelace
   -> EpochNo
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser Lovelace
-> Parser
     (Lovelace
      -> Lovelace
      -> EpochNo
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Lovelace
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stakeAddressDeposit"
        Parser
  (Lovelace
   -> Lovelace
   -> EpochNo
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser Lovelace
-> Parser
     (Lovelace
      -> EpochNo
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Lovelace
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stakePoolDeposit"
        Parser
  (Lovelace
   -> EpochNo
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser Lovelace
-> Parser
     (EpochNo
      -> Natural
      -> Rational
      -> Rational
      -> Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Lovelace
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minPoolCost"
        Parser
  (EpochNo
   -> Natural
   -> Rational
   -> Rational
   -> Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser EpochNo
-> Parser
     (Natural
      -> Rational
      -> Rational
      -> Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser EpochNo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"poolRetireMaxEpoch"
        Parser
  (Natural
   -> Rational
   -> Rational
   -> Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser Natural
-> Parser
     (Rational
      -> Rational
      -> Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
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
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser Rational
-> Parser
     (Rational
      -> Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
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
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser Rational
-> Parser
     (Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
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
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser Rational
-> Parser
     (Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
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
  (Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser (Maybe Lovelace)
-> Parser
     (Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Lovelace)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"utxoCostPerWord"
        Parser
  (Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParameters)
-> Parser (Map AnyPlutusScriptVersion CostModel)
-> Parser
     (Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Key -> Parser (Maybe (Map AnyPlutusScriptVersion CostModel))
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 Lovelace
   -> ProtocolParameters)
-> Parser (Maybe ExecutionUnitPrices)
-> Parser
     (Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
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 Lovelace
   -> ProtocolParameters)
-> Parser (Maybe ExecutionUnits)
-> Parser
     (Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
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 Lovelace
   -> ProtocolParameters)
-> Parser (Maybe ExecutionUnits)
-> Parser
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParameters)
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 Lovelace
   -> ProtocolParameters)
-> Parser (Maybe Natural)
-> Parser
     (Maybe Natural
      -> Maybe Natural -> Maybe Lovelace -> ProtocolParameters)
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 Lovelace -> ProtocolParameters)
-> Parser (Maybe Natural)
-> Parser (Maybe Natural -> Maybe Lovelace -> ProtocolParameters)
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 Lovelace -> ProtocolParameters)
-> Parser (Maybe Natural)
-> Parser (Maybe Lovelace -> ProtocolParameters)
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 Lovelace -> ProtocolParameters)
-> Parser (Maybe Lovelace) -> Parser ProtocolParameters
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Lovelace)
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 ExecutionUnits
Maybe Lovelace
Maybe ExecutionUnitPrices
Maybe PraosNonce
Rational
(Natural, Natural)
Map AnyPlutusScriptVersion CostModel
EpochNo
Lovelace
protocolParamUTxOCostPerByte :: Maybe Lovelace
protocolParamMaxCollateralInputs :: Maybe Natural
protocolParamCollateralPercent :: Maybe Natural
protocolParamMaxValueSize :: Maybe Natural
protocolParamMaxBlockExUnits :: Maybe ExecutionUnits
protocolParamMaxTxExUnits :: Maybe ExecutionUnits
protocolParamPrices :: Maybe ExecutionUnitPrices
protocolParamCostModels :: Map AnyPlutusScriptVersion CostModel
protocolParamUTxOCostPerWord :: Maybe Lovelace
protocolParamTreasuryCut :: Rational
protocolParamMonetaryExpansion :: Rational
protocolParamPoolPledgeInfluence :: Rational
protocolParamStakePoolTargetNum :: Natural
protocolParamPoolRetireMaxEpoch :: EpochNo
protocolParamMinPoolCost :: Lovelace
protocolParamStakePoolDeposit :: Lovelace
protocolParamStakeAddressDeposit :: Lovelace
protocolParamMinUTxOValue :: Maybe Lovelace
protocolParamTxFeePerByte :: Natural
protocolParamTxFeeFixed :: Natural
protocolParamMaxTxSize :: Natural
protocolParamMaxBlockBodySize :: Natural
protocolParamMaxBlockHeaderSize :: Natural
protocolParamExtraPraosEntropy :: Maybe PraosNonce
protocolParamDecentralization :: Maybe Rational
protocolParamProtocolVersion :: (Natural, Natural)
protocolParamUTxOCostPerByte :: ProtocolParameters -> Maybe Lovelace
protocolParamMaxCollateralInputs :: ProtocolParameters -> Maybe Natural
protocolParamCollateralPercent :: ProtocolParameters -> Maybe Natural
protocolParamMaxValueSize :: ProtocolParameters -> Maybe Natural
protocolParamMaxBlockExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxTxExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamPrices :: ProtocolParameters -> Maybe ExecutionUnitPrices
protocolParamCostModels :: ProtocolParameters -> Map AnyPlutusScriptVersion CostModel
protocolParamUTxOCostPerWord :: ProtocolParameters -> Maybe Lovelace
protocolParamTreasuryCut :: ProtocolParameters -> Rational
protocolParamMonetaryExpansion :: ProtocolParameters -> Rational
protocolParamPoolPledgeInfluence :: ProtocolParameters -> Rational
protocolParamStakePoolTargetNum :: ProtocolParameters -> Natural
protocolParamPoolRetireMaxEpoch :: ProtocolParameters -> EpochNo
protocolParamMinPoolCost :: ProtocolParameters -> Lovelace
protocolParamStakePoolDeposit :: ProtocolParameters -> Lovelace
protocolParamStakeAddressDeposit :: ProtocolParameters -> Lovelace
protocolParamMinUTxOValue :: ProtocolParameters -> Maybe Lovelace
protocolParamTxFeePerByte :: ProtocolParameters -> Natural
protocolParamTxFeeFixed :: ProtocolParameters -> Natural
protocolParamMaxTxSize :: ProtocolParameters -> Natural
protocolParamMaxBlockBodySize :: ProtocolParameters -> Natural
protocolParamMaxBlockHeaderSize :: ProtocolParameters -> Natural
protocolParamExtraPraosEntropy :: ProtocolParameters -> Maybe PraosNonce
protocolParamDecentralization :: ProtocolParameters -> Maybe Rational
protocolParamProtocolVersion :: ProtocolParameters -> (Natural, Natural)
..} =
    [Pair] -> Value
object
      [ Key
"extraPraosEntropy"   Key -> Maybe PraosNonce -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe PraosNonce
protocolParamExtraPraosEntropy
      , Key
"stakePoolTargetNum"  Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Natural
protocolParamStakePoolTargetNum
      , Key
"minUTxOValue"        Key -> Maybe Lovelace -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Lovelace
protocolParamMinUTxOValue
      , Key
"poolRetireMaxEpoch"  Key -> EpochNo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= EpochNo
protocolParamPoolRetireMaxEpoch
      , Key
"decentralization"    Key -> Maybe Value -> Pair
forall kv v. (KeyValue 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 -> Lovelace -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Lovelace
protocolParamStakePoolDeposit
      , Key
"maxBlockHeaderSize"  Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Natural
protocolParamMaxBlockHeaderSize
      , Key
"maxBlockBodySize"    Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Natural
protocolParamMaxBlockBodySize
      , Key
"maxTxSize"           Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Natural
protocolParamMaxTxSize
      , Key
"treasuryCut"         Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
toRationalJSON Rational
protocolParamTreasuryCut
      , Key
"minPoolCost"         Key -> Lovelace -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Lovelace
protocolParamMinPoolCost
      , Key
"monetaryExpansion"   Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
toRationalJSON Rational
protocolParamMonetaryExpansion
      , Key
"stakeAddressDeposit" Key -> Lovelace -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Lovelace
protocolParamStakeAddressDeposit
      , Key
"poolPledgeInfluence" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
toRationalJSON Rational
protocolParamPoolPledgeInfluence
      , Key
"protocolVersion"     Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= let (Natural
major, Natural
minor) = (Natural, Natural)
protocolParamProtocolVersion
                                  in [Pair] -> Value
object [Key
"major" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Natural
major, Key
"minor" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Natural
minor]
      , Key
"txFeeFixed"          Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Natural
protocolParamTxFeeFixed
      , Key
"txFeePerByte"        Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Natural
protocolParamTxFeePerByte
      -- Alonzo era:
      , Key
"utxoCostPerWord"        Key -> Maybe Lovelace -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Lovelace
protocolParamUTxOCostPerWord
      , Key
"costModels"             Key -> Map AnyPlutusScriptVersion CostModel -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map AnyPlutusScriptVersion CostModel
protocolParamCostModels
      , Key
"executionUnitPrices"    Key -> Maybe ExecutionUnitPrices -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ExecutionUnitPrices
protocolParamPrices
      , Key
"maxTxExecutionUnits"    Key -> Maybe ExecutionUnits -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ExecutionUnits
protocolParamMaxTxExUnits
      , Key
"maxBlockExecutionUnits" Key -> Maybe ExecutionUnits -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ExecutionUnits
protocolParamMaxBlockExUnits
      , Key
"maxValueSize"           Key -> Maybe Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Natural
protocolParamMaxValueSize
      , Key
"collateralPercentage"   Key -> Maybe Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Natural
protocolParamCollateralPercent
      , Key
"maxCollateralInputs"    Key -> Maybe Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Natural
protocolParamMaxCollateralInputs
      -- Babbage era:
      , Key
"utxoCostPerByte"        Key -> Maybe Lovelace -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Lovelace
protocolParamUTxOCostPerByte
      ]


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

-- | The representation of a change in the 'ProtocolParameters'.
--
data ProtocolParametersUpdate =
     ProtocolParametersUpdate {

       -- | Protocol version, major and minor. Updating the major version is
       -- used to trigger hard forks.
       --
       ProtocolParametersUpdate -> Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: Maybe (Natural, Natural),

       -- | 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 Rational
protocolUpdateDecentralization :: Maybe Rational,

       -- | 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 (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy :: Maybe (Maybe PraosNonce),

       -- | 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 Natural
protocolUpdateMaxBlockHeaderSize :: Maybe 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!
       --
       ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxBlockBodySize :: Maybe 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.
       --
       ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxTxSize :: Maybe Natural,

       -- | The constant factor for the minimum fee calculation.
       --
       ProtocolParametersUpdate -> Maybe Natural
protocolUpdateTxFeeFixed :: Maybe Natural,

       -- | The linear factor for the minimum fee calculation.
       --
       ProtocolParametersUpdate -> Maybe Natural
protocolUpdateTxFeePerByte :: Maybe Natural,

       -- | The minimum permitted value for new UTxO entries, ie for
       -- transaction outputs.
       --
       ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateMinUTxOValue :: Maybe Lovelace,

       -- | The deposit required to register a stake address.
       --
       ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateStakeAddressDeposit :: Maybe Lovelace,

       -- | The deposit required to register a stake pool.
       --
       ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateStakePoolDeposit :: Maybe Lovelace,

       -- | The minimum value that stake pools are permitted to declare for
       -- their cost parameter.
       --
       ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateMinPoolCost :: Maybe Lovelace,

       -- | The maximum number of epochs into the future that stake pools
       -- are permitted to schedule a retirement.
       --
       ProtocolParametersUpdate -> Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch :: Maybe EpochNo,

       -- | The equilibrium target number of stake pools.
       --
       -- This is the \"k\" incentives parameter from the design document.
       --
       ProtocolParametersUpdate -> Maybe Natural
protocolUpdateStakePoolTargetNum :: Maybe Natural,

       -- | The influence of the pledge in stake pool rewards.
       --
       -- This is the \"a_0\" incentives parameter from the design document.
       --
       ProtocolParametersUpdate -> Maybe Rational
protocolUpdatePoolPledgeInfluence :: 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
protocolUpdateMonetaryExpansion :: 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.
       --
       ProtocolParametersUpdate -> Maybe Rational
protocolUpdateTreasuryCut :: Maybe Rational,

       -- Introduced in Alonzo,

       -- | Cost in ada per word of UTxO storage.
       --
       -- /Introduced in Alonzo, obsoleted in Babbage by 'protocolUpdateUTxOCostPerByte'/
       ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateUTxOCostPerWord :: Maybe Lovelace,

       -- Introduced in Alonzo,

       -- | Cost models for script languages that use them.
       --
       -- /Introduced in Alonzo/
       ProtocolParametersUpdate -> Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels :: Map AnyPlutusScriptVersion CostModel,

       -- | Price of execution units for script languages that use them.
       --
       -- /Introduced in Alonzo/
       ProtocolParametersUpdate -> Maybe ExecutionUnitPrices
protocolUpdatePrices :: Maybe ExecutionUnitPrices,

       -- | Max total script execution resources units allowed per tx
       --
       -- /Introduced in Alonzo/
       ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxTxExUnits :: Maybe ExecutionUnits,

       -- | Max total script execution resources units allowed per block
       --
       -- /Introduced in Alonzo/
       ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits :: Maybe ExecutionUnits,

       -- | Max size of a 'Value' in a tx output.
       --
       -- /Introduced in Alonzo/
       ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxValueSize :: 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
protocolUpdateCollateralPercent :: Maybe Natural,

       -- | The maximum number of collateral inputs allowed in a transaction.
       --
       -- /Introduced in Alonzo/
       ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxCollateralInputs :: Maybe Natural,

       -- | Cost in ada per byte of UTxO storage.
       --
       -- /Introduced in Babbage.  Supercedes 'protocolUpdateUTxOCostPerWord'/
       ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateUTxOCostPerByte :: Maybe Lovelace
    }
  deriving (ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
(ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool)
-> (ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool)
-> Eq ProtocolParametersUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
$c/= :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
== :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
$c== :: 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
showList :: [ProtocolParametersUpdate] -> ShowS
$cshowList :: [ProtocolParametersUpdate] -> ShowS
show :: ProtocolParametersUpdate -> String
$cshow :: ProtocolParametersUpdate -> String
showsPrec :: Int -> ProtocolParametersUpdate -> ShowS
$cshowsPrec :: Int -> ProtocolParametersUpdate -> ShowS
Show)

instance Semigroup ProtocolParametersUpdate where
    ProtocolParametersUpdate
ppu1 <> :: ProtocolParametersUpdate
-> ProtocolParametersUpdate -> ProtocolParametersUpdate
<> ProtocolParametersUpdate
ppu2 =
      ProtocolParametersUpdate :: Maybe (Natural, Natural)
-> Maybe Rational
-> Maybe (Maybe PraosNonce)
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe EpochNo
-> Maybe Natural
-> Maybe Rational
-> Maybe Rational
-> Maybe Rational
-> Maybe Lovelace
-> Map AnyPlutusScriptVersion CostModel
-> Maybe ExecutionUnitPrices
-> Maybe ExecutionUnits
-> Maybe ExecutionUnits
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> ProtocolParametersUpdate
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 Natural
protocolUpdateMaxBlockHeaderSize  = (ProtocolParametersUpdate -> Maybe Natural) -> Maybe Natural
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxBlockHeaderSize
      , protocolUpdateMaxBlockBodySize :: Maybe Natural
protocolUpdateMaxBlockBodySize    = (ProtocolParametersUpdate -> Maybe Natural) -> Maybe Natural
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxBlockBodySize
      , protocolUpdateMaxTxSize :: Maybe Natural
protocolUpdateMaxTxSize           = (ProtocolParametersUpdate -> Maybe Natural) -> Maybe Natural
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxTxSize
      , protocolUpdateTxFeeFixed :: Maybe Natural
protocolUpdateTxFeeFixed          = (ProtocolParametersUpdate -> Maybe Natural) -> Maybe Natural
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Natural
protocolUpdateTxFeeFixed
      , protocolUpdateTxFeePerByte :: Maybe Natural
protocolUpdateTxFeePerByte        = (ProtocolParametersUpdate -> Maybe Natural) -> Maybe Natural
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Natural
protocolUpdateTxFeePerByte
      , protocolUpdateMinUTxOValue :: Maybe Lovelace
protocolUpdateMinUTxOValue        = (ProtocolParametersUpdate -> Maybe Lovelace) -> Maybe Lovelace
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateMinUTxOValue
      , protocolUpdateStakeAddressDeposit :: Maybe Lovelace
protocolUpdateStakeAddressDeposit = (ProtocolParametersUpdate -> Maybe Lovelace) -> Maybe Lovelace
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateStakeAddressDeposit
      , protocolUpdateStakePoolDeposit :: Maybe Lovelace
protocolUpdateStakePoolDeposit    = (ProtocolParametersUpdate -> Maybe Lovelace) -> Maybe Lovelace
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateStakePoolDeposit
      , protocolUpdateMinPoolCost :: Maybe Lovelace
protocolUpdateMinPoolCost         = (ProtocolParametersUpdate -> Maybe Lovelace) -> Maybe Lovelace
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateMinPoolCost
      , protocolUpdatePoolRetireMaxEpoch :: Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch  = (ProtocolParametersUpdate -> Maybe EpochNo) -> Maybe EpochNo
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe EpochNo
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.
      , protocolUpdateUTxOCostPerWord :: Maybe Lovelace
protocolUpdateUTxOCostPerWord     = (ProtocolParametersUpdate -> Maybe Lovelace) -> Maybe Lovelace
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateUTxOCostPerWord
      , 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 Lovelace
protocolUpdateUTxOCostPerByte     = (ProtocolParametersUpdate -> Maybe Lovelace) -> Maybe Lovelace
forall a. (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateUTxOCostPerByte
      }
      where
        -- prefer the right hand side:
        merge :: (ProtocolParametersUpdate -> Maybe a) -> Maybe a
        merge :: (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge ProtocolParametersUpdate -> Maybe a
f = ProtocolParametersUpdate -> Maybe a
f ProtocolParametersUpdate
ppu2 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 :: (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 :: Maybe (Natural, Natural)
-> Maybe Rational
-> Maybe (Maybe PraosNonce)
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe EpochNo
-> Maybe Natural
-> Maybe Rational
-> Maybe Rational
-> Maybe Rational
-> Maybe Lovelace
-> Map AnyPlutusScriptVersion CostModel
-> Maybe ExecutionUnitPrices
-> Maybe ExecutionUnits
-> Maybe ExecutionUnits
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> ProtocolParametersUpdate
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 Natural
protocolUpdateMaxBlockHeaderSize  = Maybe Natural
forall a. Maybe a
Nothing
      , protocolUpdateMaxBlockBodySize :: Maybe Natural
protocolUpdateMaxBlockBodySize    = Maybe Natural
forall a. Maybe a
Nothing
      , protocolUpdateMaxTxSize :: Maybe Natural
protocolUpdateMaxTxSize           = Maybe Natural
forall a. Maybe a
Nothing
      , protocolUpdateTxFeeFixed :: Maybe Natural
protocolUpdateTxFeeFixed          = Maybe Natural
forall a. Maybe a
Nothing
      , protocolUpdateTxFeePerByte :: Maybe Natural
protocolUpdateTxFeePerByte        = Maybe Natural
forall a. Maybe a
Nothing
      , protocolUpdateMinUTxOValue :: Maybe Lovelace
protocolUpdateMinUTxOValue        = Maybe Lovelace
forall a. Maybe a
Nothing
      , protocolUpdateStakeAddressDeposit :: Maybe Lovelace
protocolUpdateStakeAddressDeposit = Maybe Lovelace
forall a. Maybe a
Nothing
      , protocolUpdateStakePoolDeposit :: Maybe Lovelace
protocolUpdateStakePoolDeposit    = Maybe Lovelace
forall a. Maybe a
Nothing
      , protocolUpdateMinPoolCost :: Maybe Lovelace
protocolUpdateMinPoolCost         = Maybe Lovelace
forall a. Maybe a
Nothing
      , protocolUpdatePoolRetireMaxEpoch :: Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch  = Maybe EpochNo
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
      , protocolUpdateUTxOCostPerWord :: Maybe Lovelace
protocolUpdateUTxOCostPerWord     = Maybe Lovelace
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 Lovelace
protocolUpdateUTxOCostPerByte     = Maybe Lovelace
forall a. Maybe a
Nothing
      }

instance ToCBOR ProtocolParametersUpdate where
    toCBOR :: ProtocolParametersUpdate -> Encoding
toCBOR ProtocolParametersUpdate{Maybe Natural
Maybe (Maybe PraosNonce)
Maybe Rational
Maybe (Natural, Natural)
Maybe EpochNo
Maybe ExecutionUnits
Maybe Lovelace
Maybe ExecutionUnitPrices
Map AnyPlutusScriptVersion CostModel
protocolUpdateUTxOCostPerByte :: Maybe Lovelace
protocolUpdateMaxCollateralInputs :: Maybe Natural
protocolUpdateCollateralPercent :: Maybe Natural
protocolUpdateMaxValueSize :: Maybe Natural
protocolUpdateMaxBlockExUnits :: Maybe ExecutionUnits
protocolUpdateMaxTxExUnits :: Maybe ExecutionUnits
protocolUpdatePrices :: Maybe ExecutionUnitPrices
protocolUpdateCostModels :: Map AnyPlutusScriptVersion CostModel
protocolUpdateUTxOCostPerWord :: Maybe Lovelace
protocolUpdateTreasuryCut :: Maybe Rational
protocolUpdateMonetaryExpansion :: Maybe Rational
protocolUpdatePoolPledgeInfluence :: Maybe Rational
protocolUpdateStakePoolTargetNum :: Maybe Natural
protocolUpdatePoolRetireMaxEpoch :: Maybe EpochNo
protocolUpdateMinPoolCost :: Maybe Lovelace
protocolUpdateStakePoolDeposit :: Maybe Lovelace
protocolUpdateStakeAddressDeposit :: Maybe Lovelace
protocolUpdateMinUTxOValue :: Maybe Lovelace
protocolUpdateTxFeePerByte :: Maybe Natural
protocolUpdateTxFeeFixed :: Maybe Natural
protocolUpdateMaxTxSize :: Maybe Natural
protocolUpdateMaxBlockBodySize :: Maybe Natural
protocolUpdateMaxBlockHeaderSize :: Maybe Natural
protocolUpdateExtraPraosEntropy :: Maybe (Maybe PraosNonce)
protocolUpdateDecentralization :: Maybe Rational
protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
protocolUpdateUTxOCostPerByte :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateMaxCollateralInputs :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateCollateralPercent :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxValueSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxBlockExUnits :: ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxTxExUnits :: ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdatePrices :: ProtocolParametersUpdate -> Maybe ExecutionUnitPrices
protocolUpdateCostModels :: ProtocolParametersUpdate -> Map AnyPlutusScriptVersion CostModel
protocolUpdateUTxOCostPerWord :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateTreasuryCut :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateMonetaryExpansion :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdatePoolPledgeInfluence :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateStakePoolTargetNum :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdatePoolRetireMaxEpoch :: ProtocolParametersUpdate -> Maybe EpochNo
protocolUpdateMinPoolCost :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateStakePoolDeposit :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateStakeAddressDeposit :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateMinUTxOValue :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateTxFeePerByte :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateTxFeeFixed :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxTxSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxBlockBodySize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxBlockHeaderSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateExtraPraosEntropy :: ProtocolParametersUpdate -> Maybe (Maybe PraosNonce)
protocolUpdateDecentralization :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateProtocolVersion :: ProtocolParametersUpdate -> Maybe (Natural, Natural)
..} =
        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 Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Natural
protocolUpdateMaxBlockHeaderSize
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Natural
protocolUpdateMaxBlockBodySize
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Natural
protocolUpdateMaxTxSize
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Natural
protocolUpdateTxFeeFixed
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Natural
protocolUpdateTxFeePerByte
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Lovelace -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Lovelace
protocolUpdateMinUTxOValue
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Lovelace -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Lovelace
protocolUpdateStakeAddressDeposit
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Lovelace -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Lovelace
protocolUpdateStakePoolDeposit
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Lovelace -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Lovelace
protocolUpdateMinPoolCost
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe EpochNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe EpochNo
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
<> Maybe Lovelace -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Lovelace
protocolUpdateUTxOCostPerWord
     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 Lovelace -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe Lovelace
protocolUpdateUTxOCostPerByte

instance FromCBOR ProtocolParametersUpdate where
    fromCBOR :: 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 Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe EpochNo
-> Maybe Natural
-> Maybe Rational
-> Maybe Rational
-> Maybe Rational
-> Maybe Lovelace
-> Map AnyPlutusScriptVersion CostModel
-> Maybe ExecutionUnitPrices
-> Maybe ExecutionUnits
-> Maybe ExecutionUnits
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> ProtocolParametersUpdate
ProtocolParametersUpdate
        (Maybe (Natural, Natural)
 -> Maybe Rational
 -> Maybe (Maybe PraosNonce)
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Lovelace
 -> Maybe Lovelace
 -> Maybe Lovelace
 -> Maybe Lovelace
 -> Maybe EpochNo
 -> Maybe Natural
 -> Maybe Rational
 -> Maybe Rational
 -> Maybe Rational
 -> Maybe Lovelace
 -> Map AnyPlutusScriptVersion CostModel
 -> Maybe ExecutionUnitPrices
 -> Maybe ExecutionUnits
 -> Maybe ExecutionUnits
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Lovelace
 -> ProtocolParametersUpdate)
-> Decoder s (Maybe (Natural, Natural))
-> Decoder
     s
     (Maybe Rational
      -> Maybe (Maybe PraosNonce)
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Maybe (Natural, Natural))
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Rational
   -> Maybe (Maybe PraosNonce)
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Rational)
-> Decoder
     s
     (Maybe (Maybe PraosNonce)
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Rational)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe (Maybe PraosNonce)
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe (Maybe PraosNonce))
-> Decoder
     s
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe (Maybe PraosNonce))
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s
     (Maybe Natural
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Natural
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s
     (Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Lovelace)
-> Decoder
     s
     (Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Lovelace)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Lovelace)
-> Decoder
     s
     (Maybe Lovelace
      -> Maybe Lovelace
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Lovelace)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Lovelace
   -> Maybe Lovelace
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Lovelace)
-> Decoder
     s
     (Maybe Lovelace
      -> Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Lovelace)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Lovelace
   -> Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Lovelace)
-> Decoder
     s
     (Maybe EpochNo
      -> Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Lovelace)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe EpochNo
   -> Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe EpochNo)
-> Decoder
     s
     (Maybe Natural
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe EpochNo)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Natural
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s
     (Maybe Rational
      -> Maybe Rational
      -> Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Rational
   -> Maybe Rational
   -> Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Rational)
-> Decoder
     s
     (Maybe Rational
      -> Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Rational)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Rational
   -> Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Rational)
-> Decoder
     s
     (Maybe Rational
      -> Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Rational)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Rational
   -> Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Rational)
-> Decoder
     s
     (Maybe Lovelace
      -> Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Rational)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Lovelace
   -> Map AnyPlutusScriptVersion CostModel
   -> Maybe ExecutionUnitPrices
   -> Maybe ExecutionUnits
   -> Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Lovelace)
-> Decoder
     s
     (Map AnyPlutusScriptVersion CostModel
      -> Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Lovelace)
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 Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Map AnyPlutusScriptVersion CostModel)
-> Decoder
     s
     (Maybe ExecutionUnitPrices
      -> Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe ExecutionUnitPrices)
-> Decoder
     s
     (Maybe ExecutionUnits
      -> Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe ExecutionUnits)
-> Decoder
     s
     (Maybe ExecutionUnits
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe ExecutionUnits)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe ExecutionUnits
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe ExecutionUnits)
-> Decoder
     s
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Lovelace
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe ExecutionUnits)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Lovelace
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s
     (Maybe Natural
      -> Maybe Natural -> Maybe Lovelace -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s
  (Maybe Natural
   -> Maybe Natural -> Maybe Lovelace -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s (Maybe Natural -> Maybe Lovelace -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder
  s (Maybe Natural -> Maybe Lovelace -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder s (Maybe Lovelace -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder s (Maybe Lovelace -> ProtocolParametersUpdate)
-> Decoder s (Maybe Lovelace) -> Decoder s ProtocolParametersUpdate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Lovelace)
forall a s. FromCBOR a => Decoder s a
fromCBOR


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

newtype PraosNonce = PraosNonce (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
/= :: PraosNonce -> PraosNonce -> Bool
$c/= :: PraosNonce -> PraosNonce -> Bool
== :: PraosNonce -> PraosNonce -> Bool
$c== :: 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
min :: PraosNonce -> PraosNonce -> PraosNonce
$cmin :: PraosNonce -> PraosNonce -> PraosNonce
max :: PraosNonce -> PraosNonce -> PraosNonce
$cmax :: PraosNonce -> PraosNonce -> PraosNonce
>= :: PraosNonce -> PraosNonce -> Bool
$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
compare :: PraosNonce -> PraosNonce -> Ordering
$ccompare :: PraosNonce -> PraosNonce -> Ordering
$cp1Ord :: Eq 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
$cto :: forall x. Rep PraosNonce x -> PraosNonce
$cfrom :: forall x. PraosNonce -> Rep PraosNonce x
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
showList :: [PraosNonce] -> ShowS
$cshowList :: [PraosNonce] -> ShowS
show :: PraosNonce -> String
$cshow :: PraosNonce -> String
showsPrec :: Int -> PraosNonce -> ShowS
$cshowsPrec :: Int -> PraosNonce -> ShowS
Show, String -> PraosNonce
(String -> PraosNonce) -> IsString PraosNonce
forall a. (String -> a) -> IsString a
fromString :: String -> PraosNonce
$cfromString :: String -> PraosNonce
IsString)   via UsingRawBytesHex PraosNonce
  deriving ([PraosNonce] -> Encoding
[PraosNonce] -> Value
PraosNonce -> Encoding
PraosNonce -> Value
(PraosNonce -> Value)
-> (PraosNonce -> Encoding)
-> ([PraosNonce] -> Value)
-> ([PraosNonce] -> Encoding)
-> ToJSON PraosNonce
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PraosNonce] -> Encoding
$ctoEncodingList :: [PraosNonce] -> Encoding
toJSONList :: [PraosNonce] -> Value
$ctoJSONList :: [PraosNonce] -> Value
toEncoding :: PraosNonce -> Encoding
$ctoEncoding :: PraosNonce -> Encoding
toJSON :: PraosNonce -> Value
$ctoJSON :: PraosNonce -> Value
ToJSON, Value -> Parser [PraosNonce]
Value -> Parser PraosNonce
(Value -> Parser PraosNonce)
-> (Value -> Parser [PraosNonce]) -> FromJSON PraosNonce
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PraosNonce]
$cparseJSONList :: Value -> Parser [PraosNonce]
parseJSON :: Value -> Parser PraosNonce
$cparseJSON :: Value -> Parser 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
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PraosNonce] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PraosNonce] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy PraosNonce -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy PraosNonce -> Size
toCBOR :: PraosNonce -> Encoding
$ctoCBOR :: PraosNonce -> Encoding
$cp1ToCBOR :: Typeable PraosNonce
ToCBOR, Typeable PraosNonce
Decoder s 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
label :: Proxy PraosNonce -> Text
$clabel :: Proxy PraosNonce -> Text
fromCBOR :: Decoder s PraosNonce
$cfromCBOR :: forall s. Decoder s PraosNonce
$cp1FromCBOR :: Typeable PraosNonce
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 -> Maybe PraosNonce
deserialiseFromRawBytes AsType PraosNonce
AsPraosNonce ByteString
bs =
      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 'Lovelace'.
--
-- 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
/= :: ExecutionUnitPrices -> ExecutionUnitPrices -> Bool
$c/= :: ExecutionUnitPrices -> ExecutionUnitPrices -> Bool
== :: ExecutionUnitPrices -> ExecutionUnitPrices -> Bool
$c== :: 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
showList :: [ExecutionUnitPrices] -> ShowS
$cshowList :: [ExecutionUnitPrices] -> ShowS
show :: ExecutionUnitPrices -> String
$cshow :: ExecutionUnitPrices -> String
showsPrec :: Int -> ExecutionUnitPrices -> ShowS
$cshowsPrec :: Int -> ExecutionUnitPrices -> ShowS
Show)

instance ToCBOR ExecutionUnitPrices where
  toCBOR :: ExecutionUnitPrices -> Encoding
toCBOR ExecutionUnitPrices{Rational
priceExecutionSteps :: Rational
priceExecutionSteps :: ExecutionUnitPrices -> Rational
priceExecutionSteps, Rational
priceExecutionMemory :: Rational
priceExecutionMemory :: ExecutionUnitPrices -> 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 :: 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 a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Rational -> ExecutionUnitPrices)
-> Decoder s Rational -> Decoder s ExecutionUnitPrices
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Rational
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ToJSON ExecutionUnitPrices where
  toJSON :: ExecutionUnitPrices -> Value
toJSON ExecutionUnitPrices{Rational
priceExecutionSteps :: Rational
priceExecutionSteps :: ExecutionUnitPrices -> Rational
priceExecutionSteps, Rational
priceExecutionMemory :: Rational
priceExecutionMemory :: ExecutionUnitPrices -> Rational
priceExecutionMemory} =
    [Pair] -> Value
object [ Key
"priceSteps"  Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
toRationalJSON Rational
priceExecutionSteps
           , Key
"priceMemory" Key -> Value -> Pair
forall kv v. (KeyValue 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 (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 -> Maybe Alonzo.Prices
toAlonzoPrices :: ExecutionUnitPrices -> Maybe Prices
toAlonzoPrices ExecutionUnitPrices {
                 Rational
priceExecutionSteps :: Rational
priceExecutionSteps :: ExecutionUnitPrices -> Rational
priceExecutionSteps,
                 Rational
priceExecutionMemory :: Rational
priceExecutionMemory :: ExecutionUnitPrices -> Rational
priceExecutionMemory
               } = do
  NonNegativeInterval
prSteps <- Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
priceExecutionSteps
  NonNegativeInterval
prMem   <- Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
priceExecutionMemory
  Prices -> Maybe Prices
forall (m :: * -> *) a. Monad m => a -> m a
return Prices :: NonNegativeInterval -> NonNegativeInterval -> Prices
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 :: NonNegativeInterval
prSteps :: Prices -> NonNegativeInterval
Alonzo.prSteps, NonNegativeInterval
prMem :: NonNegativeInterval
prMem :: Prices -> NonNegativeInterval
Alonzo.prMem} =
  ExecutionUnitPrices :: Rational -> Rational -> ExecutionUnitPrices
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 (Map Text Integer)
  deriving (CostModel -> CostModel -> Bool
(CostModel -> CostModel -> Bool)
-> (CostModel -> CostModel -> Bool) -> Eq CostModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CostModel -> CostModel -> Bool
$c/= :: CostModel -> CostModel -> Bool
== :: CostModel -> CostModel -> Bool
$c== :: 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
showList :: [CostModel] -> ShowS
$cshowList :: [CostModel] -> ShowS
show :: CostModel -> String
$cshow :: CostModel -> String
showsPrec :: Int -> CostModel -> ShowS
$cshowsPrec :: Int -> CostModel -> ShowS
Show)
  deriving newtype ([CostModel] -> Encoding
[CostModel] -> Value
CostModel -> Encoding
CostModel -> Value
(CostModel -> Value)
-> (CostModel -> Encoding)
-> ([CostModel] -> Value)
-> ([CostModel] -> Encoding)
-> ToJSON CostModel
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CostModel] -> Encoding
$ctoEncodingList :: [CostModel] -> Encoding
toJSONList :: [CostModel] -> Value
$ctoJSONList :: [CostModel] -> Value
toEncoding :: CostModel -> Encoding
$ctoEncoding :: CostModel -> Encoding
toJSON :: CostModel -> Value
$ctoJSON :: CostModel -> Value
ToJSON, Value -> Parser [CostModel]
Value -> Parser CostModel
(Value -> Parser CostModel)
-> (Value -> Parser [CostModel]) -> FromJSON CostModel
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CostModel]
$cparseJSONList :: Value -> Parser [CostModel]
parseJSON :: Value -> Parser CostModel
$cparseJSON :: Value -> Parser CostModel
FromJSON)
  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
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CostModel] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CostModel] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy CostModel -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy CostModel -> Size
toCBOR :: CostModel -> Encoding
$ctoCBOR :: CostModel -> Encoding
$cp1ToCBOR :: Typeable CostModel
ToCBOR, Typeable CostModel
Decoder s 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
label :: Proxy CostModel -> Text
$clabel :: Proxy CostModel -> Text
fromCBOR :: Decoder s CostModel
$cfromCBOR :: forall s. Decoder s CostModel
$cp1FromCBOR :: Typeable CostModel
FromCBOR)

validateCostModel :: PlutusScriptVersion lang
                  -> CostModel
                  -> Either InvalidCostModel ()
validateCostModel :: PlutusScriptVersion lang -> CostModel -> Either InvalidCostModel ()
validateCostModel PlutusScriptVersion lang
PlutusScriptV1 (CostModel Map Text Integer
m) =
    (CostModelApplyError -> InvalidCostModel)
-> Either CostModelApplyError () -> Either InvalidCostModel ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (CostModel -> CostModelApplyError -> InvalidCostModel
InvalidCostModel (Map Text Integer -> CostModel
CostModel Map Text Integer
m))
  (Either CostModelApplyError () -> Either InvalidCostModel ())
-> Either CostModelApplyError () -> Either InvalidCostModel ()
forall a b. (a -> b) -> a -> b
$ Map Text Integer -> Either CostModelApplyError ()
forall (m :: * -> *).
MonadError CostModelApplyError m =>
Map Text Integer -> m ()
Alonzo.assertWellFormedCostModelParams Map Text Integer
m
validateCostModel PlutusScriptVersion lang
PlutusScriptV2 (CostModel Map Text Integer
m) =
    (CostModelApplyError -> InvalidCostModel)
-> Either CostModelApplyError () -> Either InvalidCostModel ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (CostModel -> CostModelApplyError -> InvalidCostModel
InvalidCostModel (Map Text Integer -> CostModel
CostModel Map Text Integer
m))
  (Either CostModelApplyError () -> Either InvalidCostModel ())
-> Either CostModelApplyError () -> Either InvalidCostModel ()
forall a b. (a -> b) -> a -> b
$ Map Text Integer -> Either CostModelApplyError ()
forall (m :: * -> *).
MonadError CostModelApplyError m =>
Map Text Integer -> m ()
Alonzo.assertWellFormedCostModelParams Map Text Integer
m

-- TODO alonzo: it'd be nice if the library told us what was wrong
data InvalidCostModel = InvalidCostModel CostModel Alonzo.CostModelApplyError
  deriving Int -> InvalidCostModel -> ShowS
[InvalidCostModel] -> ShowS
InvalidCostModel -> String
(Int -> InvalidCostModel -> ShowS)
-> (InvalidCostModel -> String)
-> ([InvalidCostModel] -> ShowS)
-> Show InvalidCostModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidCostModel] -> ShowS
$cshowList :: [InvalidCostModel] -> ShowS
show :: InvalidCostModel -> String
$cshow :: InvalidCostModel -> String
showsPrec :: Int -> InvalidCostModel -> ShowS
$cshowsPrec :: Int -> InvalidCostModel -> ShowS
Show

instance Error InvalidCostModel where
  displayError :: InvalidCostModel -> String
displayError (InvalidCostModel CostModel
cm CostModelApplyError
err) =
    String
"Invalid cost model: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CostModelApplyError -> String
forall str a. (Pretty a, Render str) => a -> str
display CostModelApplyError
err String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" Cost model: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CostModel -> String
forall a. Show a => a -> String
show CostModel
cm


toAlonzoCostModels
  :: Map AnyPlutusScriptVersion CostModel
  -> Either String Alonzo.CostModels
toAlonzoCostModels :: Map AnyPlutusScriptVersion CostModel -> Either String CostModels
toAlonzoCostModels Map AnyPlutusScriptVersion CostModel
m = do
  [(Language, CostModel)]
f <- ((AnyPlutusScriptVersion, CostModel)
 -> Either String (Language, CostModel))
-> [(AnyPlutusScriptVersion, CostModel)]
-> Either String [(Language, CostModel)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (AnyPlutusScriptVersion, CostModel)
-> Either String (Language, CostModel)
conv ([(AnyPlutusScriptVersion, CostModel)]
 -> Either String [(Language, CostModel)])
-> [(AnyPlutusScriptVersion, CostModel)]
-> Either String [(Language, CostModel)]
forall a b. (a -> b) -> a -> b
$ Map AnyPlutusScriptVersion CostModel
-> [(AnyPlutusScriptVersion, CostModel)]
forall k a. Map k a -> [(k, a)]
Map.toList Map AnyPlutusScriptVersion CostModel
m
  CostModels -> Either String CostModels
forall a b. b -> Either a b
Right (CostModels -> Either String CostModels)
-> (Map Language CostModel -> CostModels)
-> Map Language CostModel
-> Either String CostModels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Language CostModel -> CostModels
Alonzo.CostModels (Map Language CostModel -> Either String CostModels)
-> Map Language CostModel -> Either String CostModels
forall a b. (a -> b) -> a -> b
$ [(Language, CostModel)] -> Map Language CostModel
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Language, CostModel)]
f
 where
  conv :: (AnyPlutusScriptVersion, CostModel) -> Either String (Alonzo.Language, Alonzo.CostModel)
  conv :: (AnyPlutusScriptVersion, CostModel)
-> Either String (Language, CostModel)
conv (AnyPlutusScriptVersion
anySVer, CostModel
cModel )= do
    -- TODO: Propagate InvalidCostModel further
    CostModel
alonzoCostModel <- (InvalidCostModel -> String)
-> Either InvalidCostModel CostModel -> Either String CostModel
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first InvalidCostModel -> String
forall e. Error e => e -> String
displayError (Either InvalidCostModel CostModel -> Either String CostModel)
-> Either InvalidCostModel CostModel -> Either String CostModel
forall a b. (a -> b) -> a -> b
$ CostModel -> Language -> Either InvalidCostModel CostModel
toAlonzoCostModel CostModel
cModel (AnyPlutusScriptVersion -> Language
toAlonzoScriptLanguage AnyPlutusScriptVersion
anySVer)
    (Language, CostModel) -> Either String (Language, CostModel)
forall a b. b -> Either a b
Right (AnyPlutusScriptVersion -> Language
toAlonzoScriptLanguage AnyPlutusScriptVersion
anySVer, CostModel
alonzoCostModel)

fromAlonzoCostModels
  :: Alonzo.CostModels
  -> Map AnyPlutusScriptVersion CostModel
fromAlonzoCostModels :: CostModels -> Map AnyPlutusScriptVersion CostModel
fromAlonzoCostModels (Alonzo.CostModels Map Language CostModel
m)=
    [(AnyPlutusScriptVersion, CostModel)]
-> Map AnyPlutusScriptVersion CostModel
forall k a. Ord k => [(k, a)] -> Map k a
Map.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 (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 -> [(Language, CostModel)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Language CostModel
m

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

fromAlonzoScriptLanguage :: Alonzo.Language -> AnyPlutusScriptVersion
fromAlonzoScriptLanguage :: Language -> AnyPlutusScriptVersion
fromAlonzoScriptLanguage Language
Alonzo.PlutusV1 = PlutusScriptVersion PlutusScriptV1 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
fromAlonzoScriptLanguage Language
Alonzo.PlutusV2 = PlutusScriptVersion PlutusScriptV2 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV2
PlutusScriptV2

toAlonzoCostModel :: CostModel -> Alonzo.Language -> Either InvalidCostModel Alonzo.CostModel
toAlonzoCostModel :: CostModel -> Language -> Either InvalidCostModel CostModel
toAlonzoCostModel (CostModel Map Text Integer
m) Language
l = (CostModelApplyError -> InvalidCostModel)
-> Either CostModelApplyError CostModel
-> Either InvalidCostModel CostModel
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (CostModel -> CostModelApplyError -> InvalidCostModel
InvalidCostModel (Map Text Integer -> CostModel
CostModel Map Text Integer
m)) (Either CostModelApplyError CostModel
 -> Either InvalidCostModel CostModel)
-> Either CostModelApplyError CostModel
-> Either InvalidCostModel CostModel
forall a b. (a -> b) -> a -> b
$ Language
-> Map Text Integer -> Either CostModelApplyError CostModel
Alonzo.mkCostModel Language
l Map Text Integer
m

fromAlonzoCostModel :: Alonzo.CostModel -> CostModel
fromAlonzoCostModel :: CostModel -> CostModel
fromAlonzoCostModel CostModel
m = Map Text Integer -> CostModel
CostModel (Map Text Integer -> CostModel) -> Map Text Integer -> CostModel
forall a b. (a -> b) -> a -> b
$ CostModel -> Map Text Integer
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
/= :: UpdateProposal -> UpdateProposal -> Bool
$c/= :: UpdateProposal -> UpdateProposal -> Bool
== :: UpdateProposal -> UpdateProposal -> Bool
$c== :: 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
showList :: [UpdateProposal] -> ShowS
$cshowList :: [UpdateProposal] -> ShowS
show :: UpdateProposal -> String
$cshow :: UpdateProposal -> String
showsPrec :: Int -> UpdateProposal -> ShowS
$cshowsPrec :: Int -> 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
deserialiseFromCBOR :: AsType UpdateProposal
-> ByteString -> Either DecoderError UpdateProposal
$cdeserialiseFromCBOR :: AsType UpdateProposal
-> ByteString -> Either DecoderError UpdateProposal
serialiseToCBOR :: UpdateProposal -> ByteString
$cserialiseToCBOR :: UpdateProposal -> ByteString
$cp1SerialiseAsCBOR :: HasTypeProxy 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 :: 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 a s. FromCBOR a => Decoder s a
fromCBOR
        Decoder s (EpochNo -> UpdateProposal)
-> Decoder s EpochNo -> Decoder s UpdateProposal
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 ([(Hash GenesisKey, ProtocolParametersUpdate)]
-> Map (Hash GenesisKey) ProtocolParametersUpdate
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Hash GenesisKey
kh, ProtocolParametersUpdate
params) | Hash GenesisKey
kh <- [Hash GenesisKey]
genesisKeyHashes ])


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

toLedgerUpdate :: forall era ledgerera.
                  ShelleyLedgerEra era ~ ledgerera
               => Ledger.Crypto ledgerera ~ StandardCrypto
               => ShelleyBasedEra era
               -> UpdateProposal
               -> Ledger.Update ledgerera
toLedgerUpdate :: ShelleyBasedEra era -> UpdateProposal -> Update ledgerera
toLedgerUpdate ShelleyBasedEra era
era (UpdateProposal Map (Hash GenesisKey) ProtocolParametersUpdate
ppup EpochNo
epochno) =
    ProposedPPUpdates ledgerera -> EpochNo -> Update ledgerera
forall era. ProposedPPUpdates era -> EpochNo -> Update era
Ledger.Update (ShelleyBasedEra era
-> Map (Hash GenesisKey) ProtocolParametersUpdate
-> ProposedPPUpdates ledgerera
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera,
 Crypto ledgerera ~ StandardCrypto) =>
ShelleyBasedEra era
-> Map (Hash GenesisKey) ProtocolParametersUpdate
-> ProposedPPUpdates ledgerera
toLedgerProposedPPUpdates ShelleyBasedEra era
era Map (Hash GenesisKey) ProtocolParametersUpdate
ppup) EpochNo
epochno


toLedgerProposedPPUpdates :: forall era ledgerera.
                             ShelleyLedgerEra era ~ ledgerera
                          => Ledger.Crypto ledgerera ~ StandardCrypto
                          => ShelleyBasedEra era
                          -> Map (Hash GenesisKey) ProtocolParametersUpdate
                          -> Ledger.ProposedPPUpdates ledgerera
toLedgerProposedPPUpdates :: ShelleyBasedEra era
-> Map (Hash GenesisKey) ProtocolParametersUpdate
-> ProposedPPUpdates ledgerera
toLedgerProposedPPUpdates ShelleyBasedEra era
era =
    Map (KeyHash 'Genesis StandardCrypto) (PParamsDelta ledgerera)
-> ProposedPPUpdates ledgerera
forall era.
Map (KeyHash 'Genesis (Crypto era)) (PParamsDelta era)
-> ProposedPPUpdates era
Ledger.ProposedPPUpdates
  (Map (KeyHash 'Genesis StandardCrypto) (PParamsDelta ledgerera)
 -> ProposedPPUpdates ledgerera)
-> (Map (Hash GenesisKey) ProtocolParametersUpdate
    -> Map (KeyHash 'Genesis StandardCrypto) (PParamsDelta ledgerera))
-> Map (Hash GenesisKey) ProtocolParametersUpdate
-> ProposedPPUpdates ledgerera
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hash GenesisKey -> KeyHash 'Genesis StandardCrypto)
-> Map (Hash GenesisKey) (PParamsDelta ledgerera)
-> Map (KeyHash 'Genesis StandardCrypto) (PParamsDelta ledgerera)
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic (\(GenesisKeyHash kh) -> KeyHash 'Genesis StandardCrypto
kh)
  (Map (Hash GenesisKey) (PParamsDelta ledgerera)
 -> Map (KeyHash 'Genesis StandardCrypto) (PParamsDelta ledgerera))
-> (Map (Hash GenesisKey) ProtocolParametersUpdate
    -> Map (Hash GenesisKey) (PParamsDelta ledgerera))
-> Map (Hash GenesisKey) ProtocolParametersUpdate
-> Map (KeyHash 'Genesis StandardCrypto) (PParamsDelta ledgerera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolParametersUpdate -> PParamsDelta ledgerera)
-> Map (Hash GenesisKey) ProtocolParametersUpdate
-> Map (Hash GenesisKey) (PParamsDelta ledgerera)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (ShelleyBasedEra era
-> ProtocolParametersUpdate -> PParamsDelta (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era
-> ProtocolParametersUpdate -> PParamsDelta (ShelleyLedgerEra era)
toLedgerPParamsDelta ShelleyBasedEra era
era)


toLedgerPParamsDelta :: ShelleyBasedEra era
                     -> ProtocolParametersUpdate
                     -> Ledger.PParamsDelta (ShelleyLedgerEra era)
toLedgerPParamsDelta :: ShelleyBasedEra era
-> ProtocolParametersUpdate -> PParamsDelta (ShelleyLedgerEra era)
toLedgerPParamsDelta ShelleyBasedEra era
ShelleyBasedEraShelley = ProtocolParametersUpdate -> PParamsDelta (ShelleyLedgerEra era)
forall ledgerera.
ProtocolParametersUpdate -> PParamsUpdate ledgerera
toShelleyPParamsUpdate
toLedgerPParamsDelta ShelleyBasedEra era
ShelleyBasedEraAllegra = ProtocolParametersUpdate -> PParamsDelta (ShelleyLedgerEra era)
forall ledgerera.
ProtocolParametersUpdate -> PParamsUpdate ledgerera
toShelleyPParamsUpdate
toLedgerPParamsDelta ShelleyBasedEra era
ShelleyBasedEraMary    = ProtocolParametersUpdate -> PParamsDelta (ShelleyLedgerEra era)
forall ledgerera.
ProtocolParametersUpdate -> PParamsUpdate ledgerera
toShelleyPParamsUpdate
toLedgerPParamsDelta ShelleyBasedEra era
ShelleyBasedEraAlonzo  = ProtocolParametersUpdate -> PParamsDelta (ShelleyLedgerEra era)
forall ledgerera.
ProtocolParametersUpdate -> PParamsUpdate ledgerera
toAlonzoPParamsUpdate
toLedgerPParamsDelta ShelleyBasedEra era
ShelleyBasedEraBabbage = ProtocolParametersUpdate -> PParamsDelta (ShelleyLedgerEra era)
forall ledgerera.
ProtocolParametersUpdate -> PParamsUpdate ledgerera
toBabbagePParamsUpdate


--TODO: we should do validation somewhere, not just silently drop changes that
-- are not valid. Specifically, see Ledger.boundRational below.
toShelleyPParamsUpdate :: ProtocolParametersUpdate
                       -> Shelley.PParamsUpdate ledgerera
toShelleyPParamsUpdate :: ProtocolParametersUpdate -> PParamsUpdate ledgerera
toShelleyPParamsUpdate
    ProtocolParametersUpdate {
      Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: ProtocolParametersUpdate -> Maybe (Natural, Natural)
protocolUpdateProtocolVersion
    , Maybe Rational
protocolUpdateDecentralization :: Maybe Rational
protocolUpdateDecentralization :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateDecentralization
    , Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy :: Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy :: ProtocolParametersUpdate -> Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy
    , Maybe Natural
protocolUpdateMaxBlockHeaderSize :: Maybe Natural
protocolUpdateMaxBlockHeaderSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxBlockHeaderSize
    , Maybe Natural
protocolUpdateMaxBlockBodySize :: Maybe Natural
protocolUpdateMaxBlockBodySize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxBlockBodySize
    , Maybe Natural
protocolUpdateMaxTxSize :: Maybe Natural
protocolUpdateMaxTxSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxTxSize
    , Maybe Natural
protocolUpdateTxFeeFixed :: Maybe Natural
protocolUpdateTxFeeFixed :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateTxFeeFixed
    , Maybe Natural
protocolUpdateTxFeePerByte :: Maybe Natural
protocolUpdateTxFeePerByte :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateTxFeePerByte
    , Maybe Lovelace
protocolUpdateMinUTxOValue :: Maybe Lovelace
protocolUpdateMinUTxOValue :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateMinUTxOValue
    , Maybe Lovelace
protocolUpdateStakeAddressDeposit :: Maybe Lovelace
protocolUpdateStakeAddressDeposit :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateStakeAddressDeposit
    , Maybe Lovelace
protocolUpdateStakePoolDeposit :: Maybe Lovelace
protocolUpdateStakePoolDeposit :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateStakePoolDeposit
    , Maybe Lovelace
protocolUpdateMinPoolCost :: Maybe Lovelace
protocolUpdateMinPoolCost :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateMinPoolCost
    , Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch :: Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch :: ProtocolParametersUpdate -> Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch
    , Maybe Natural
protocolUpdateStakePoolTargetNum :: Maybe Natural
protocolUpdateStakePoolTargetNum :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateStakePoolTargetNum
    , Maybe Rational
protocolUpdatePoolPledgeInfluence :: Maybe Rational
protocolUpdatePoolPledgeInfluence :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdatePoolPledgeInfluence
    , Maybe Rational
protocolUpdateMonetaryExpansion :: Maybe Rational
protocolUpdateMonetaryExpansion :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateMonetaryExpansion
    , Maybe Rational
protocolUpdateTreasuryCut :: Maybe Rational
protocolUpdateTreasuryCut :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateTreasuryCut
    } =
    PParams :: forall (f :: * -> *) era.
HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Coin
-> HKD f Coin
-> HKD f EpochNo
-> HKD f Natural
-> HKD f NonNegativeInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f Nonce
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> PParams' f era
Shelley.PParams {
      _minfeeA :: HKD StrictMaybe Natural
Shelley._minfeeA     = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateTxFeePerByte
    , _minfeeB :: HKD StrictMaybe Natural
Shelley._minfeeB     = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateTxFeeFixed
    , _maxBBSize :: HKD StrictMaybe Natural
Shelley._maxBBSize   = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateMaxBlockBodySize
    , _maxTxSize :: HKD StrictMaybe Natural
Shelley._maxTxSize   = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateMaxTxSize
    , _maxBHSize :: HKD StrictMaybe Natural
Shelley._maxBHSize   = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateMaxBlockHeaderSize
    , _keyDeposit :: HKD StrictMaybe Coin
Shelley._keyDeposit  = Lovelace -> Coin
toShelleyLovelace (Lovelace -> Coin) -> StrictMaybe Lovelace -> StrictMaybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                               Maybe Lovelace -> StrictMaybe Lovelace
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Lovelace
protocolUpdateStakeAddressDeposit
    , _poolDeposit :: HKD StrictMaybe Coin
Shelley._poolDeposit = Lovelace -> Coin
toShelleyLovelace (Lovelace -> Coin) -> StrictMaybe Lovelace -> StrictMaybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                               Maybe Lovelace -> StrictMaybe Lovelace
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Lovelace
protocolUpdateStakePoolDeposit
    , _eMax :: HKD StrictMaybe EpochNo
Shelley._eMax        = Maybe EpochNo -> StrictMaybe EpochNo
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch
    , _nOpt :: HKD StrictMaybe Natural
Shelley._nOpt        = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateStakePoolTargetNum
    , _a0 :: HKD StrictMaybe NonNegativeInterval
Shelley._a0          = Maybe NonNegativeInterval -> StrictMaybe NonNegativeInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe (Maybe NonNegativeInterval -> StrictMaybe NonNegativeInterval)
-> Maybe NonNegativeInterval -> StrictMaybe NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational (Rational -> Maybe NonNegativeInterval)
-> Maybe Rational -> Maybe NonNegativeInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                              Maybe Rational
protocolUpdatePoolPledgeInfluence
    , _rho :: HKD StrictMaybe UnitInterval
Shelley._rho         = Maybe UnitInterval -> StrictMaybe UnitInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe (Maybe UnitInterval -> StrictMaybe UnitInterval)
-> Maybe UnitInterval -> StrictMaybe UnitInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                                Maybe Rational
protocolUpdateMonetaryExpansion
    , _tau :: HKD StrictMaybe UnitInterval
Shelley._tau         = Maybe UnitInterval -> StrictMaybe UnitInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe (Maybe UnitInterval -> StrictMaybe UnitInterval)
-> Maybe UnitInterval -> StrictMaybe UnitInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                                Maybe Rational
protocolUpdateTreasuryCut
    , _d :: HKD StrictMaybe UnitInterval
Shelley._d           = Maybe UnitInterval -> StrictMaybe UnitInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe (Maybe UnitInterval -> StrictMaybe UnitInterval)
-> Maybe UnitInterval -> StrictMaybe UnitInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                                Maybe Rational
protocolUpdateDecentralization
    , _extraEntropy :: HKD StrictMaybe Nonce
Shelley._extraEntropy    = 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
    , _protocolVersion :: HKD StrictMaybe ProtVer
Shelley._protocolVersion = (Natural -> Natural -> ProtVer) -> (Natural, Natural) -> ProtVer
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Natural -> Natural -> ProtVer
Ledger.ProtVer ((Natural, Natural) -> ProtVer)
-> StrictMaybe (Natural, Natural) -> StrictMaybe ProtVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                   Maybe (Natural, Natural) -> StrictMaybe (Natural, Natural)
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe (Natural, Natural)
protocolUpdateProtocolVersion
    , _minUTxOValue :: HKD StrictMaybe Coin
Shelley._minUTxOValue    = Lovelace -> Coin
toShelleyLovelace (Lovelace -> Coin) -> StrictMaybe Lovelace -> StrictMaybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                   Maybe Lovelace -> StrictMaybe Lovelace
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Lovelace
protocolUpdateMinUTxOValue
    , _minPoolCost :: HKD StrictMaybe Coin
Shelley._minPoolCost     = Lovelace -> Coin
toShelleyLovelace (Lovelace -> Coin) -> StrictMaybe Lovelace -> StrictMaybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                   Maybe Lovelace -> StrictMaybe Lovelace
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Lovelace
protocolUpdateMinPoolCost
    }


toAlonzoPParamsUpdate :: ProtocolParametersUpdate
                      -> Alonzo.PParamsUpdate ledgerera
toAlonzoPParamsUpdate :: ProtocolParametersUpdate -> PParamsUpdate ledgerera
toAlonzoPParamsUpdate
    ProtocolParametersUpdate {
      Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: ProtocolParametersUpdate -> Maybe (Natural, Natural)
protocolUpdateProtocolVersion
    , Maybe Rational
protocolUpdateDecentralization :: Maybe Rational
protocolUpdateDecentralization :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateDecentralization
    , Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy :: Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy :: ProtocolParametersUpdate -> Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy
    , Maybe Natural
protocolUpdateMaxBlockHeaderSize :: Maybe Natural
protocolUpdateMaxBlockHeaderSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxBlockHeaderSize
    , Maybe Natural
protocolUpdateMaxBlockBodySize :: Maybe Natural
protocolUpdateMaxBlockBodySize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxBlockBodySize
    , Maybe Natural
protocolUpdateMaxTxSize :: Maybe Natural
protocolUpdateMaxTxSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxTxSize
    , Maybe Natural
protocolUpdateTxFeeFixed :: Maybe Natural
protocolUpdateTxFeeFixed :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateTxFeeFixed
    , Maybe Natural
protocolUpdateTxFeePerByte :: Maybe Natural
protocolUpdateTxFeePerByte :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateTxFeePerByte
    , Maybe Lovelace
protocolUpdateStakeAddressDeposit :: Maybe Lovelace
protocolUpdateStakeAddressDeposit :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateStakeAddressDeposit
    , Maybe Lovelace
protocolUpdateStakePoolDeposit :: Maybe Lovelace
protocolUpdateStakePoolDeposit :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateStakePoolDeposit
    , Maybe Lovelace
protocolUpdateMinPoolCost :: Maybe Lovelace
protocolUpdateMinPoolCost :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateMinPoolCost
    , Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch :: Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch :: ProtocolParametersUpdate -> Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch
    , Maybe Natural
protocolUpdateStakePoolTargetNum :: Maybe Natural
protocolUpdateStakePoolTargetNum :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateStakePoolTargetNum
    , Maybe Rational
protocolUpdatePoolPledgeInfluence :: Maybe Rational
protocolUpdatePoolPledgeInfluence :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdatePoolPledgeInfluence
    , Maybe Rational
protocolUpdateMonetaryExpansion :: Maybe Rational
protocolUpdateMonetaryExpansion :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateMonetaryExpansion
    , Maybe Rational
protocolUpdateTreasuryCut :: Maybe Rational
protocolUpdateTreasuryCut :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateTreasuryCut
    , Maybe Lovelace
protocolUpdateUTxOCostPerWord :: Maybe Lovelace
protocolUpdateUTxOCostPerWord :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateUTxOCostPerWord
    , Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels :: Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels :: ProtocolParametersUpdate -> Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels
    , Maybe ExecutionUnitPrices
protocolUpdatePrices :: Maybe ExecutionUnitPrices
protocolUpdatePrices :: ProtocolParametersUpdate -> Maybe ExecutionUnitPrices
protocolUpdatePrices
    , Maybe ExecutionUnits
protocolUpdateMaxTxExUnits :: Maybe ExecutionUnits
protocolUpdateMaxTxExUnits :: ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxTxExUnits
    , Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits :: Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits :: ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits
    , Maybe Natural
protocolUpdateMaxValueSize :: Maybe Natural
protocolUpdateMaxValueSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxValueSize
    , Maybe Natural
protocolUpdateCollateralPercent :: Maybe Natural
protocolUpdateCollateralPercent :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateCollateralPercent
    , Maybe Natural
protocolUpdateMaxCollateralInputs :: Maybe Natural
protocolUpdateMaxCollateralInputs :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxCollateralInputs
    } =
    PParams :: forall (f :: * -> *) era.
HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Coin
-> HKD f Coin
-> HKD f EpochNo
-> HKD f Natural
-> HKD f NonNegativeInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f Nonce
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> HKD f CostModels
-> HKD f Prices
-> HKD f ExUnits
-> HKD f ExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> PParams' f era
Alonzo.PParams {
      _minfeeA :: HKD StrictMaybe Natural
Alonzo._minfeeA     = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateTxFeePerByte
    , _minfeeB :: HKD StrictMaybe Natural
Alonzo._minfeeB     = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateTxFeeFixed
    , _maxBBSize :: HKD StrictMaybe Natural
Alonzo._maxBBSize   = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateMaxBlockBodySize
    , _maxTxSize :: HKD StrictMaybe Natural
Alonzo._maxTxSize   = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateMaxTxSize
    , _maxBHSize :: HKD StrictMaybe Natural
Alonzo._maxBHSize   = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateMaxBlockHeaderSize
    , _keyDeposit :: HKD StrictMaybe Coin
Alonzo._keyDeposit  = Lovelace -> Coin
toShelleyLovelace (Lovelace -> Coin) -> StrictMaybe Lovelace -> StrictMaybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                              Maybe Lovelace -> StrictMaybe Lovelace
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Lovelace
protocolUpdateStakeAddressDeposit
    , _poolDeposit :: HKD StrictMaybe Coin
Alonzo._poolDeposit = Lovelace -> Coin
toShelleyLovelace (Lovelace -> Coin) -> StrictMaybe Lovelace -> StrictMaybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                              Maybe Lovelace -> StrictMaybe Lovelace
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Lovelace
protocolUpdateStakePoolDeposit
    , _eMax :: HKD StrictMaybe EpochNo
Alonzo._eMax        = Maybe EpochNo -> StrictMaybe EpochNo
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch
    , _nOpt :: HKD StrictMaybe Natural
Alonzo._nOpt        = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateStakePoolTargetNum
    , _a0 :: HKD StrictMaybe NonNegativeInterval
Alonzo._a0          = Maybe NonNegativeInterval -> StrictMaybe NonNegativeInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe (Maybe NonNegativeInterval -> StrictMaybe NonNegativeInterval)
-> Maybe NonNegativeInterval -> StrictMaybe NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational (Rational -> Maybe NonNegativeInterval)
-> Maybe Rational -> Maybe NonNegativeInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                              Maybe Rational
protocolUpdatePoolPledgeInfluence
    , _rho :: HKD StrictMaybe UnitInterval
Alonzo._rho         = Maybe UnitInterval -> StrictMaybe UnitInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe (Maybe UnitInterval -> StrictMaybe UnitInterval)
-> Maybe UnitInterval -> StrictMaybe UnitInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                               Maybe Rational
protocolUpdateMonetaryExpansion
    , _tau :: HKD StrictMaybe UnitInterval
Alonzo._tau         = Maybe UnitInterval -> StrictMaybe UnitInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe (Maybe UnitInterval -> StrictMaybe UnitInterval)
-> Maybe UnitInterval -> StrictMaybe UnitInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                               Maybe Rational
protocolUpdateTreasuryCut
    , _d :: HKD StrictMaybe UnitInterval
Alonzo._d           = Maybe UnitInterval -> StrictMaybe UnitInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe (Maybe UnitInterval -> StrictMaybe UnitInterval)
-> Maybe UnitInterval -> StrictMaybe UnitInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                               Maybe Rational
protocolUpdateDecentralization
    , _extraEntropy :: HKD StrictMaybe Nonce
Alonzo._extraEntropy    = 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
    , _protocolVersion :: HKD StrictMaybe ProtVer
Alonzo._protocolVersion = (Natural -> Natural -> ProtVer) -> (Natural, Natural) -> ProtVer
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Natural -> Natural -> ProtVer
Ledger.ProtVer ((Natural, Natural) -> ProtVer)
-> StrictMaybe (Natural, Natural) -> StrictMaybe ProtVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                  Maybe (Natural, Natural) -> StrictMaybe (Natural, Natural)
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe (Natural, Natural)
protocolUpdateProtocolVersion
    , _minPoolCost :: HKD StrictMaybe Coin
Alonzo._minPoolCost     = Lovelace -> Coin
toShelleyLovelace (Lovelace -> Coin) -> StrictMaybe Lovelace -> StrictMaybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                  Maybe Lovelace -> StrictMaybe Lovelace
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Lovelace
protocolUpdateMinPoolCost
    , _coinsPerUTxOWord :: HKD StrictMaybe Coin
Alonzo._coinsPerUTxOWord  = Lovelace -> Coin
toShelleyLovelace (Lovelace -> Coin) -> StrictMaybe Lovelace -> StrictMaybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                  Maybe Lovelace -> StrictMaybe Lovelace
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Lovelace
protocolUpdateUTxOCostPerWord
    , _costmdls :: HKD StrictMaybe CostModels
Alonzo._costmdls        = if Map AnyPlutusScriptVersion CostModel -> Bool
forall k a. Map k a -> Bool
Map.null Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels
                                  then HKD StrictMaybe CostModels
forall a. StrictMaybe a
Ledger.SNothing
                                  else (String -> StrictMaybe CostModels)
-> (CostModels -> StrictMaybe CostModels)
-> Either String CostModels
-> StrictMaybe CostModels
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (StrictMaybe CostModels -> String -> StrictMaybe CostModels
forall a b. a -> b -> a
const StrictMaybe CostModels
forall a. StrictMaybe a
Ledger.SNothing) CostModels -> StrictMaybe CostModels
forall a. a -> StrictMaybe a
Ledger.SJust
                                         (Map AnyPlutusScriptVersion CostModel -> Either String CostModels
toAlonzoCostModels Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels)
    , _prices :: HKD StrictMaybe Prices
Alonzo._prices          = Maybe Prices -> StrictMaybe Prices
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe (Maybe Prices -> StrictMaybe Prices)
-> Maybe Prices -> StrictMaybe Prices
forall a b. (a -> b) -> a -> b
$
                                  ExecutionUnitPrices -> Maybe Prices
toAlonzoPrices (ExecutionUnitPrices -> Maybe Prices)
-> Maybe ExecutionUnitPrices -> Maybe Prices
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ExecutionUnitPrices
protocolUpdatePrices
    , _maxTxExUnits :: HKD StrictMaybe ExUnits
Alonzo._maxTxExUnits    = 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
    , _maxBlockExUnits :: HKD StrictMaybe ExUnits
Alonzo._maxBlockExUnits = 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
    , _maxValSize :: HKD StrictMaybe Natural
Alonzo._maxValSize      = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateMaxValueSize
    , _collateralPercentage :: HKD StrictMaybe Natural
Alonzo._collateralPercentage = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateCollateralPercent
    , _maxCollateralInputs :: HKD StrictMaybe Natural
Alonzo._maxCollateralInputs  = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateMaxCollateralInputs
    }

-- Decentralization and extra entropy are deprecated in Babbage
toBabbagePParamsUpdate :: ProtocolParametersUpdate
                       -> Babbage.PParamsUpdate ledgerera
toBabbagePParamsUpdate :: ProtocolParametersUpdate -> PParamsUpdate ledgerera
toBabbagePParamsUpdate
    ProtocolParametersUpdate {
      Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: ProtocolParametersUpdate -> Maybe (Natural, Natural)
protocolUpdateProtocolVersion
    , Maybe Natural
protocolUpdateMaxBlockHeaderSize :: Maybe Natural
protocolUpdateMaxBlockHeaderSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxBlockHeaderSize
    , Maybe Natural
protocolUpdateMaxBlockBodySize :: Maybe Natural
protocolUpdateMaxBlockBodySize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxBlockBodySize
    , Maybe Natural
protocolUpdateMaxTxSize :: Maybe Natural
protocolUpdateMaxTxSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxTxSize
    , Maybe Natural
protocolUpdateTxFeeFixed :: Maybe Natural
protocolUpdateTxFeeFixed :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateTxFeeFixed
    , Maybe Natural
protocolUpdateTxFeePerByte :: Maybe Natural
protocolUpdateTxFeePerByte :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateTxFeePerByte
    , Maybe Lovelace
protocolUpdateStakeAddressDeposit :: Maybe Lovelace
protocolUpdateStakeAddressDeposit :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateStakeAddressDeposit
    , Maybe Lovelace
protocolUpdateStakePoolDeposit :: Maybe Lovelace
protocolUpdateStakePoolDeposit :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateStakePoolDeposit
    , Maybe Lovelace
protocolUpdateMinPoolCost :: Maybe Lovelace
protocolUpdateMinPoolCost :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateMinPoolCost
    , Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch :: Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch :: ProtocolParametersUpdate -> Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch
    , Maybe Natural
protocolUpdateStakePoolTargetNum :: Maybe Natural
protocolUpdateStakePoolTargetNum :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateStakePoolTargetNum
    , Maybe Rational
protocolUpdatePoolPledgeInfluence :: Maybe Rational
protocolUpdatePoolPledgeInfluence :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdatePoolPledgeInfluence
    , Maybe Rational
protocolUpdateMonetaryExpansion :: Maybe Rational
protocolUpdateMonetaryExpansion :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateMonetaryExpansion
    , Maybe Rational
protocolUpdateTreasuryCut :: Maybe Rational
protocolUpdateTreasuryCut :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateTreasuryCut
    , Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels :: Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels :: ProtocolParametersUpdate -> Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels
    , Maybe ExecutionUnitPrices
protocolUpdatePrices :: Maybe ExecutionUnitPrices
protocolUpdatePrices :: ProtocolParametersUpdate -> Maybe ExecutionUnitPrices
protocolUpdatePrices
    , Maybe ExecutionUnits
protocolUpdateMaxTxExUnits :: Maybe ExecutionUnits
protocolUpdateMaxTxExUnits :: ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxTxExUnits
    , Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits :: Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits :: ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits
    , Maybe Natural
protocolUpdateMaxValueSize :: Maybe Natural
protocolUpdateMaxValueSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxValueSize
    , Maybe Natural
protocolUpdateCollateralPercent :: Maybe Natural
protocolUpdateCollateralPercent :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateCollateralPercent
    , Maybe Natural
protocolUpdateMaxCollateralInputs :: Maybe Natural
protocolUpdateMaxCollateralInputs :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxCollateralInputs
    , Maybe Lovelace
protocolUpdateUTxOCostPerByte :: Maybe Lovelace
protocolUpdateUTxOCostPerByte :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateUTxOCostPerByte
    } =
    PParams :: forall (f :: * -> *) era.
HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Coin
-> HKD f Coin
-> HKD f EpochNo
-> HKD f Natural
-> HKD f NonNegativeInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> HKD f CostModels
-> HKD f Prices
-> HKD f ExUnits
-> HKD f ExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> PParams' f era
Babbage.PParams {
      _minfeeA :: HKD StrictMaybe Natural
Babbage._minfeeA     = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateTxFeePerByte
    , _minfeeB :: HKD StrictMaybe Natural
Babbage._minfeeB     = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateTxFeeFixed
    , _maxBBSize :: HKD StrictMaybe Natural
Babbage._maxBBSize   = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateMaxBlockBodySize
    , _maxTxSize :: HKD StrictMaybe Natural
Babbage._maxTxSize   = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateMaxTxSize
    , _maxBHSize :: HKD StrictMaybe Natural
Babbage._maxBHSize   = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateMaxBlockHeaderSize
    , _keyDeposit :: HKD StrictMaybe Coin
Babbage._keyDeposit  = Lovelace -> Coin
toShelleyLovelace (Lovelace -> Coin) -> StrictMaybe Lovelace -> StrictMaybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                              Maybe Lovelace -> StrictMaybe Lovelace
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Lovelace
protocolUpdateStakeAddressDeposit
    , _poolDeposit :: HKD StrictMaybe Coin
Babbage._poolDeposit = Lovelace -> Coin
toShelleyLovelace (Lovelace -> Coin) -> StrictMaybe Lovelace -> StrictMaybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                              Maybe Lovelace -> StrictMaybe Lovelace
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Lovelace
protocolUpdateStakePoolDeposit
    , _eMax :: HKD StrictMaybe EpochNo
Babbage._eMax        = Maybe EpochNo -> StrictMaybe EpochNo
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch
    , _nOpt :: HKD StrictMaybe Natural
Babbage._nOpt        = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateStakePoolTargetNum
    , _a0 :: HKD StrictMaybe NonNegativeInterval
Babbage._a0          = Maybe NonNegativeInterval -> StrictMaybe NonNegativeInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe (Maybe NonNegativeInterval -> StrictMaybe NonNegativeInterval)
-> Maybe NonNegativeInterval -> StrictMaybe NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational (Rational -> Maybe NonNegativeInterval)
-> Maybe Rational -> Maybe NonNegativeInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                              Maybe Rational
protocolUpdatePoolPledgeInfluence
    , _rho :: HKD StrictMaybe UnitInterval
Babbage._rho         = Maybe UnitInterval -> StrictMaybe UnitInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe (Maybe UnitInterval -> StrictMaybe UnitInterval)
-> Maybe UnitInterval -> StrictMaybe UnitInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                               Maybe Rational
protocolUpdateMonetaryExpansion
    , _tau :: HKD StrictMaybe UnitInterval
Babbage._tau         = Maybe UnitInterval -> StrictMaybe UnitInterval
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe (Maybe UnitInterval -> StrictMaybe UnitInterval)
-> Maybe UnitInterval -> StrictMaybe UnitInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational (Rational -> Maybe UnitInterval)
-> Maybe Rational -> Maybe UnitInterval
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                               Maybe Rational
protocolUpdateTreasuryCut
    , _protocolVersion :: HKD StrictMaybe ProtVer
Babbage._protocolVersion = (Natural -> Natural -> ProtVer) -> (Natural, Natural) -> ProtVer
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Natural -> Natural -> ProtVer
Ledger.ProtVer ((Natural, Natural) -> ProtVer)
-> StrictMaybe (Natural, Natural) -> StrictMaybe ProtVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                  Maybe (Natural, Natural) -> StrictMaybe (Natural, Natural)
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe (Natural, Natural)
protocolUpdateProtocolVersion
    , _minPoolCost :: HKD StrictMaybe Coin
Babbage._minPoolCost     = Lovelace -> Coin
toShelleyLovelace (Lovelace -> Coin) -> StrictMaybe Lovelace -> StrictMaybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                   Maybe Lovelace -> StrictMaybe Lovelace
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Lovelace
protocolUpdateMinPoolCost
    , _costmdls :: HKD StrictMaybe CostModels
Babbage._costmdls        = if Map AnyPlutusScriptVersion CostModel -> Bool
forall k a. Map k a -> Bool
Map.null Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels
                                  then HKD StrictMaybe CostModels
forall a. StrictMaybe a
Ledger.SNothing
                                  else (String -> StrictMaybe CostModels)
-> (CostModels -> StrictMaybe CostModels)
-> Either String CostModels
-> StrictMaybe CostModels
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (StrictMaybe CostModels -> String -> StrictMaybe CostModels
forall a b. a -> b -> a
const StrictMaybe CostModels
forall a. StrictMaybe a
Ledger.SNothing) CostModels -> StrictMaybe CostModels
forall a. a -> StrictMaybe a
Ledger.SJust
                                         (Map AnyPlutusScriptVersion CostModel -> Either String CostModels
toAlonzoCostModels Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels)
    , _prices :: HKD StrictMaybe Prices
Babbage._prices          = Maybe Prices -> StrictMaybe Prices
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe (Maybe Prices -> StrictMaybe Prices)
-> Maybe Prices -> StrictMaybe Prices
forall a b. (a -> b) -> a -> b
$
                                  ExecutionUnitPrices -> Maybe Prices
toAlonzoPrices (ExecutionUnitPrices -> Maybe Prices)
-> Maybe ExecutionUnitPrices -> Maybe Prices
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ExecutionUnitPrices
protocolUpdatePrices
    , _maxTxExUnits :: HKD StrictMaybe ExUnits
Babbage._maxTxExUnits    = 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
    , _maxBlockExUnits :: HKD StrictMaybe ExUnits
Babbage._maxBlockExUnits = 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
    , _maxValSize :: HKD StrictMaybe Natural
Babbage._maxValSize      = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateMaxValueSize
    , _collateralPercentage :: HKD StrictMaybe Natural
Babbage._collateralPercentage = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateCollateralPercent
    , _maxCollateralInputs :: HKD StrictMaybe Natural
Babbage._maxCollateralInputs  = Maybe Natural -> StrictMaybe Natural
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Natural
protocolUpdateMaxCollateralInputs
    , _coinsPerUTxOByte :: HKD StrictMaybe Coin
Babbage._coinsPerUTxOByte = Lovelace -> Coin
toShelleyLovelace (Lovelace -> Coin) -> StrictMaybe Lovelace -> StrictMaybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                    Maybe Lovelace -> StrictMaybe Lovelace
forall a. Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe Lovelace
protocolUpdateUTxOCostPerByte
    }

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

fromLedgerUpdate :: forall era ledgerera.
                    ShelleyLedgerEra era ~ ledgerera
                 => Ledger.Crypto ledgerera ~ StandardCrypto
                 => ShelleyBasedEra era
                 -> Ledger.Update ledgerera
                 -> UpdateProposal
fromLedgerUpdate :: ShelleyBasedEra era -> Update ledgerera -> UpdateProposal
fromLedgerUpdate ShelleyBasedEra era
era (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,
 Crypto ledgerera ~ StandardCrypto) =>
ShelleyBasedEra era
-> ProposedPPUpdates ledgerera
-> Map (Hash GenesisKey) ProtocolParametersUpdate
fromLedgerProposedPPUpdates ShelleyBasedEra era
era ProposedPPUpdates ledgerera
ppup) EpochNo
epochno


fromLedgerProposedPPUpdates :: forall era ledgerera.
                               ShelleyLedgerEra era ~ ledgerera
                            => Ledger.Crypto ledgerera ~ StandardCrypto
                            => ShelleyBasedEra era
                            -> Ledger.ProposedPPUpdates ledgerera
                            -> Map (Hash GenesisKey) ProtocolParametersUpdate
fromLedgerProposedPPUpdates :: ShelleyBasedEra era
-> ProposedPPUpdates ledgerera
-> Map (Hash GenesisKey) ProtocolParametersUpdate
fromLedgerProposedPPUpdates ShelleyBasedEra era
era =
    (PParamsDelta ledgerera -> ProtocolParametersUpdate)
-> Map (Hash GenesisKey) (PParamsDelta ledgerera)
-> Map (Hash GenesisKey) ProtocolParametersUpdate
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (ShelleyBasedEra era
-> PParamsDelta (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall era.
ShelleyBasedEra era
-> PParamsDelta (ShelleyLedgerEra era) -> ProtocolParametersUpdate
fromLedgerPParamsDelta ShelleyBasedEra era
era)
  (Map (Hash GenesisKey) (PParamsDelta ledgerera)
 -> Map (Hash GenesisKey) ProtocolParametersUpdate)
-> (ProposedPPUpdates ledgerera
    -> Map (Hash GenesisKey) (PParamsDelta 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) (PParamsDelta ledgerera)
-> Map (Hash GenesisKey) (PParamsDelta 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) (PParamsDelta ledgerera)
 -> Map (Hash GenesisKey) (PParamsDelta ledgerera))
-> (ProposedPPUpdates ledgerera
    -> Map (KeyHash 'Genesis StandardCrypto) (PParamsDelta ledgerera))
-> ProposedPPUpdates ledgerera
-> Map (Hash GenesisKey) (PParamsDelta ledgerera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Ledger.ProposedPPUpdates Map (KeyHash 'Genesis (Crypto ledgerera)) (PParamsDelta ledgerera)
ppup) -> Map (KeyHash 'Genesis StandardCrypto) (PParamsDelta ledgerera)
Map (KeyHash 'Genesis (Crypto ledgerera)) (PParamsDelta ledgerera)
ppup)


fromLedgerPParamsDelta :: ShelleyBasedEra era
                       -> Ledger.PParamsDelta (ShelleyLedgerEra era)
                       -> ProtocolParametersUpdate
fromLedgerPParamsDelta :: ShelleyBasedEra era
-> PParamsDelta (ShelleyLedgerEra era) -> ProtocolParametersUpdate
fromLedgerPParamsDelta ShelleyBasedEra era
ShelleyBasedEraShelley = PParamsDelta (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall ledgerera.
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromShelleyPParamsUpdate
fromLedgerPParamsDelta ShelleyBasedEra era
ShelleyBasedEraAllegra = PParamsDelta (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall ledgerera.
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromShelleyPParamsUpdate
fromLedgerPParamsDelta ShelleyBasedEra era
ShelleyBasedEraMary    = PParamsDelta (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall ledgerera.
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromShelleyPParamsUpdate
fromLedgerPParamsDelta ShelleyBasedEra era
ShelleyBasedEraAlonzo  = PParamsDelta (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall ledgerera.
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromAlonzoPParamsUpdate
fromLedgerPParamsDelta ShelleyBasedEra era
ShelleyBasedEraBabbage = PParamsDelta (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall ledgerera.
PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromBabbagePParamsUpdate


fromShelleyPParamsUpdate :: Shelley.PParamsUpdate ledgerera
                         -> ProtocolParametersUpdate
fromShelleyPParamsUpdate :: PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromShelleyPParamsUpdate
    Shelley.PParams {
      HKD StrictMaybe Natural
_minfeeA :: HKD StrictMaybe Natural
_minfeeA :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Shelley._minfeeA
    , HKD StrictMaybe Natural
_minfeeB :: HKD StrictMaybe Natural
_minfeeB :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Shelley._minfeeB
    , HKD StrictMaybe Natural
_maxBBSize :: HKD StrictMaybe Natural
_maxBBSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Shelley._maxBBSize
    , HKD StrictMaybe Natural
_maxTxSize :: HKD StrictMaybe Natural
_maxTxSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Shelley._maxTxSize
    , HKD StrictMaybe Natural
_maxBHSize :: HKD StrictMaybe Natural
_maxBHSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Shelley._maxBHSize
    , HKD StrictMaybe Coin
_keyDeposit :: HKD StrictMaybe Coin
_keyDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Shelley._keyDeposit
    , HKD StrictMaybe Coin
_poolDeposit :: HKD StrictMaybe Coin
_poolDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Shelley._poolDeposit
    , HKD StrictMaybe EpochNo
_eMax :: HKD StrictMaybe EpochNo
_eMax :: forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
Shelley._eMax
    , HKD StrictMaybe Natural
_nOpt :: HKD StrictMaybe Natural
_nOpt :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Shelley._nOpt
    , HKD StrictMaybe NonNegativeInterval
_a0 :: HKD StrictMaybe NonNegativeInterval
_a0 :: forall (f :: * -> *) era.
PParams' f era -> HKD f NonNegativeInterval
Shelley._a0
    , HKD StrictMaybe UnitInterval
_rho :: HKD StrictMaybe UnitInterval
_rho :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Shelley._rho
    , HKD StrictMaybe UnitInterval
_tau :: HKD StrictMaybe UnitInterval
_tau :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Shelley._tau
    , HKD StrictMaybe UnitInterval
_d :: HKD StrictMaybe UnitInterval
_d :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Shelley._d
    , HKD StrictMaybe Nonce
_extraEntropy :: HKD StrictMaybe Nonce
_extraEntropy :: forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
Shelley._extraEntropy
    , HKD StrictMaybe ProtVer
_protocolVersion :: HKD StrictMaybe ProtVer
_protocolVersion :: forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
Shelley._protocolVersion
    , HKD StrictMaybe Coin
_minUTxOValue :: HKD StrictMaybe Coin
_minUTxOValue :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Shelley._minUTxOValue
    , HKD StrictMaybe Coin
_minPoolCost :: HKD StrictMaybe Coin
_minPoolCost :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Shelley._minPoolCost
    } =
    ProtocolParametersUpdate :: Maybe (Natural, Natural)
-> Maybe Rational
-> Maybe (Maybe PraosNonce)
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe EpochNo
-> Maybe Natural
-> Maybe Rational
-> Maybe Rational
-> Maybe Rational
-> Maybe Lovelace
-> Map AnyPlutusScriptVersion CostModel
-> Maybe ExecutionUnitPrices
-> Maybe ExecutionUnits
-> Maybe ExecutionUnits
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> ProtocolParametersUpdate
ProtocolParametersUpdate {
      protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
protocolUpdateProtocolVersion     = (\(Ledger.ProtVer Natural
a Natural
b) -> (Natural
a,Natural
b)) (ProtVer -> (Natural, Natural))
-> Maybe ProtVer -> Maybe (Natural, Natural)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                          StrictMaybe ProtVer -> Maybe ProtVer
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe ProtVer
HKD StrictMaybe ProtVer
_protocolVersion
    , protocolUpdateDecentralization :: Maybe Rational
protocolUpdateDecentralization    = 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 StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
_d
    , protocolUpdateExtraPraosEntropy :: Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy   = Nonce -> Maybe PraosNonce
fromLedgerNonce (Nonce -> Maybe PraosNonce)
-> Maybe Nonce -> Maybe (Maybe PraosNonce)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Nonce -> Maybe Nonce
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Nonce
HKD StrictMaybe Nonce
_extraEntropy
    , protocolUpdateMaxBlockHeaderSize :: Maybe Natural
protocolUpdateMaxBlockHeaderSize  = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_maxBHSize
    , protocolUpdateMaxBlockBodySize :: Maybe Natural
protocolUpdateMaxBlockBodySize    = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_maxBBSize
    , protocolUpdateMaxTxSize :: Maybe Natural
protocolUpdateMaxTxSize           = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_maxTxSize
    , protocolUpdateTxFeeFixed :: Maybe Natural
protocolUpdateTxFeeFixed          = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_minfeeB
    , protocolUpdateTxFeePerByte :: Maybe Natural
protocolUpdateTxFeePerByte        = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_minfeeA
    , protocolUpdateMinUTxOValue :: Maybe Lovelace
protocolUpdateMinUTxOValue        = Coin -> Lovelace
fromShelleyLovelace (Coin -> Lovelace) -> Maybe Coin -> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Coin
HKD StrictMaybe Coin
_minUTxOValue
    , protocolUpdateStakeAddressDeposit :: Maybe Lovelace
protocolUpdateStakeAddressDeposit = Coin -> Lovelace
fromShelleyLovelace (Coin -> Lovelace) -> Maybe Coin -> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Coin
HKD StrictMaybe Coin
_keyDeposit
    , protocolUpdateStakePoolDeposit :: Maybe Lovelace
protocolUpdateStakePoolDeposit    = Coin -> Lovelace
fromShelleyLovelace (Coin -> Lovelace) -> Maybe Coin -> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Coin
HKD StrictMaybe Coin
_poolDeposit
    , protocolUpdateMinPoolCost :: Maybe Lovelace
protocolUpdateMinPoolCost         = Coin -> Lovelace
fromShelleyLovelace (Coin -> Lovelace) -> Maybe Coin -> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Coin
HKD StrictMaybe Coin
_minPoolCost
    , protocolUpdatePoolRetireMaxEpoch :: Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch  = StrictMaybe EpochNo -> Maybe EpochNo
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe EpochNo
HKD StrictMaybe EpochNo
_eMax
    , protocolUpdateStakePoolTargetNum :: Maybe Natural
protocolUpdateStakePoolTargetNum  = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_nOpt
    , 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 StrictMaybe NonNegativeInterval
HKD StrictMaybe NonNegativeInterval
_a0
    , 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 StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
_rho
    , 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 StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
_tau
    , protocolUpdateUTxOCostPerWord :: Maybe Lovelace
protocolUpdateUTxOCostPerWord     = Maybe Lovelace
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 Lovelace
protocolUpdateUTxOCostPerByte     = Maybe Lovelace
forall a. Maybe a
Nothing
    }

fromAlonzoPParamsUpdate :: Alonzo.PParamsUpdate ledgerera
                        -> ProtocolParametersUpdate
fromAlonzoPParamsUpdate :: PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromAlonzoPParamsUpdate
    Alonzo.PParams {
      HKD StrictMaybe Natural
_minfeeA :: HKD StrictMaybe Natural
_minfeeA :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._minfeeA
    , HKD StrictMaybe Natural
_minfeeB :: HKD StrictMaybe Natural
_minfeeB :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._minfeeB
    , HKD StrictMaybe Natural
_maxBBSize :: HKD StrictMaybe Natural
_maxBBSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._maxBBSize
    , HKD StrictMaybe Natural
_maxTxSize :: HKD StrictMaybe Natural
_maxTxSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._maxTxSize
    , HKD StrictMaybe Natural
_maxBHSize :: HKD StrictMaybe Natural
_maxBHSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._maxBHSize
    , HKD StrictMaybe Coin
_keyDeposit :: HKD StrictMaybe Coin
_keyDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Alonzo._keyDeposit
    , HKD StrictMaybe Coin
_poolDeposit :: HKD StrictMaybe Coin
_poolDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Alonzo._poolDeposit
    , HKD StrictMaybe EpochNo
_eMax :: HKD StrictMaybe EpochNo
_eMax :: forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
Alonzo._eMax
    , HKD StrictMaybe Natural
_nOpt :: HKD StrictMaybe Natural
_nOpt :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._nOpt
    , HKD StrictMaybe NonNegativeInterval
_a0 :: HKD StrictMaybe NonNegativeInterval
_a0 :: forall (f :: * -> *) era.
PParams' f era -> HKD f NonNegativeInterval
Alonzo._a0
    , HKD StrictMaybe UnitInterval
_rho :: HKD StrictMaybe UnitInterval
_rho :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Alonzo._rho
    , HKD StrictMaybe UnitInterval
_tau :: HKD StrictMaybe UnitInterval
_tau :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Alonzo._tau
    , HKD StrictMaybe UnitInterval
_d :: HKD StrictMaybe UnitInterval
_d :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Alonzo._d
    , HKD StrictMaybe Nonce
_extraEntropy :: HKD StrictMaybe Nonce
_extraEntropy :: forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
Alonzo._extraEntropy
    , HKD StrictMaybe ProtVer
_protocolVersion :: HKD StrictMaybe ProtVer
_protocolVersion :: forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
Alonzo._protocolVersion
    , HKD StrictMaybe Coin
_minPoolCost :: HKD StrictMaybe Coin
_minPoolCost :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Alonzo._minPoolCost
    , HKD StrictMaybe Coin
_coinsPerUTxOWord :: HKD StrictMaybe Coin
_coinsPerUTxOWord :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Alonzo._coinsPerUTxOWord
    , HKD StrictMaybe CostModels
_costmdls :: HKD StrictMaybe CostModels
_costmdls :: forall (f :: * -> *) era. PParams' f era -> HKD f CostModels
Alonzo._costmdls
    , HKD StrictMaybe Prices
_prices :: HKD StrictMaybe Prices
_prices :: forall (f :: * -> *) era. PParams' f era -> HKD f Prices
Alonzo._prices
    , HKD StrictMaybe ExUnits
_maxTxExUnits :: HKD StrictMaybe ExUnits
_maxTxExUnits :: forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
Alonzo._maxTxExUnits
    , HKD StrictMaybe ExUnits
_maxBlockExUnits :: HKD StrictMaybe ExUnits
_maxBlockExUnits :: forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
Alonzo._maxBlockExUnits
    , HKD StrictMaybe Natural
_maxValSize :: HKD StrictMaybe Natural
_maxValSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._maxValSize
    , HKD StrictMaybe Natural
_collateralPercentage :: HKD StrictMaybe Natural
_collateralPercentage :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._collateralPercentage
    , HKD StrictMaybe Natural
_maxCollateralInputs :: HKD StrictMaybe Natural
_maxCollateralInputs :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._maxCollateralInputs
    } =
    ProtocolParametersUpdate :: Maybe (Natural, Natural)
-> Maybe Rational
-> Maybe (Maybe PraosNonce)
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe EpochNo
-> Maybe Natural
-> Maybe Rational
-> Maybe Rational
-> Maybe Rational
-> Maybe Lovelace
-> Map AnyPlutusScriptVersion CostModel
-> Maybe ExecutionUnitPrices
-> Maybe ExecutionUnits
-> Maybe ExecutionUnits
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> ProtocolParametersUpdate
ProtocolParametersUpdate {
      protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
protocolUpdateProtocolVersion     = (\(Ledger.ProtVer Natural
a Natural
b) -> (Natural
a,Natural
b)) (ProtVer -> (Natural, Natural))
-> Maybe ProtVer -> Maybe (Natural, Natural)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                          StrictMaybe ProtVer -> Maybe ProtVer
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe ProtVer
HKD StrictMaybe ProtVer
_protocolVersion
    , protocolUpdateDecentralization :: Maybe Rational
protocolUpdateDecentralization    = 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 StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
_d
    , protocolUpdateExtraPraosEntropy :: Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy   = Nonce -> Maybe PraosNonce
fromLedgerNonce (Nonce -> Maybe PraosNonce)
-> Maybe Nonce -> Maybe (Maybe PraosNonce)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Nonce -> Maybe Nonce
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Nonce
HKD StrictMaybe Nonce
_extraEntropy
    , protocolUpdateMaxBlockHeaderSize :: Maybe Natural
protocolUpdateMaxBlockHeaderSize  = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_maxBHSize
    , protocolUpdateMaxBlockBodySize :: Maybe Natural
protocolUpdateMaxBlockBodySize    = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_maxBBSize
    , protocolUpdateMaxTxSize :: Maybe Natural
protocolUpdateMaxTxSize           = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_maxTxSize
    , protocolUpdateTxFeeFixed :: Maybe Natural
protocolUpdateTxFeeFixed          = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_minfeeB
    , protocolUpdateTxFeePerByte :: Maybe Natural
protocolUpdateTxFeePerByte        = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_minfeeA
    , protocolUpdateMinUTxOValue :: Maybe Lovelace
protocolUpdateMinUTxOValue        = Maybe Lovelace
forall a. Maybe a
Nothing
    , protocolUpdateStakeAddressDeposit :: Maybe Lovelace
protocolUpdateStakeAddressDeposit = Coin -> Lovelace
fromShelleyLovelace (Coin -> Lovelace) -> Maybe Coin -> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Coin
HKD StrictMaybe Coin
_keyDeposit
    , protocolUpdateStakePoolDeposit :: Maybe Lovelace
protocolUpdateStakePoolDeposit    = Coin -> Lovelace
fromShelleyLovelace (Coin -> Lovelace) -> Maybe Coin -> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Coin
HKD StrictMaybe Coin
_poolDeposit
    , protocolUpdateMinPoolCost :: Maybe Lovelace
protocolUpdateMinPoolCost         = Coin -> Lovelace
fromShelleyLovelace (Coin -> Lovelace) -> Maybe Coin -> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Coin
HKD StrictMaybe Coin
_minPoolCost
    , protocolUpdatePoolRetireMaxEpoch :: Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch  = StrictMaybe EpochNo -> Maybe EpochNo
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe EpochNo
HKD StrictMaybe EpochNo
_eMax
    , protocolUpdateStakePoolTargetNum :: Maybe Natural
protocolUpdateStakePoolTargetNum  = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_nOpt
    , 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 StrictMaybe NonNegativeInterval
HKD StrictMaybe NonNegativeInterval
_a0
    , 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 StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
_rho
    , 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 StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
_tau
    , protocolUpdateUTxOCostPerWord :: Maybe Lovelace
protocolUpdateUTxOCostPerWord     = Coin -> Lovelace
fromShelleyLovelace (Coin -> Lovelace) -> Maybe Coin -> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Coin
HKD StrictMaybe Coin
_coinsPerUTxOWord
    , protocolUpdateCostModels :: Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels          = Map AnyPlutusScriptVersion CostModel
-> (CostModels -> Map AnyPlutusScriptVersion CostModel)
-> Maybe CostModels
-> Map AnyPlutusScriptVersion CostModel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map AnyPlutusScriptVersion CostModel
forall a. Monoid a => a
mempty CostModels -> Map AnyPlutusScriptVersion CostModel
fromAlonzoCostModels
                                               (StrictMaybe CostModels -> Maybe CostModels
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe CostModels
HKD StrictMaybe CostModels
_costmdls)
    , protocolUpdatePrices :: Maybe ExecutionUnitPrices
protocolUpdatePrices              = Prices -> ExecutionUnitPrices
fromAlonzoPrices (Prices -> ExecutionUnitPrices)
-> Maybe Prices -> Maybe ExecutionUnitPrices
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Prices -> Maybe Prices
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Prices
HKD StrictMaybe Prices
_prices
    , protocolUpdateMaxTxExUnits :: Maybe ExecutionUnits
protocolUpdateMaxTxExUnits        = ExUnits -> ExecutionUnits
fromAlonzoExUnits (ExUnits -> ExecutionUnits)
-> Maybe ExUnits -> Maybe ExecutionUnits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe ExUnits -> Maybe ExUnits
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe ExUnits
HKD StrictMaybe ExUnits
_maxTxExUnits
    , protocolUpdateMaxBlockExUnits :: Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits     = ExUnits -> ExecutionUnits
fromAlonzoExUnits (ExUnits -> ExecutionUnits)
-> Maybe ExUnits -> Maybe ExecutionUnits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe ExUnits -> Maybe ExUnits
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe ExUnits
HKD StrictMaybe ExUnits
_maxBlockExUnits
    , protocolUpdateMaxValueSize :: Maybe Natural
protocolUpdateMaxValueSize        = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_maxValSize
    , protocolUpdateCollateralPercent :: Maybe Natural
protocolUpdateCollateralPercent   = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_collateralPercentage
    , protocolUpdateMaxCollateralInputs :: Maybe Natural
protocolUpdateMaxCollateralInputs = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_maxCollateralInputs
    , protocolUpdateUTxOCostPerByte :: Maybe Lovelace
protocolUpdateUTxOCostPerByte     = Maybe Lovelace
forall a. Maybe a
Nothing
    }


fromBabbagePParamsUpdate :: Babbage.PParamsUpdate ledgerera
                         -> ProtocolParametersUpdate
fromBabbagePParamsUpdate :: PParamsUpdate ledgerera -> ProtocolParametersUpdate
fromBabbagePParamsUpdate
    Babbage.PParams {
      HKD StrictMaybe Natural
_minfeeA :: HKD StrictMaybe Natural
_minfeeA :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._minfeeA
    , HKD StrictMaybe Natural
_minfeeB :: HKD StrictMaybe Natural
_minfeeB :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._minfeeB
    , HKD StrictMaybe Natural
_maxBBSize :: HKD StrictMaybe Natural
_maxBBSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._maxBBSize
    , HKD StrictMaybe Natural
_maxTxSize :: HKD StrictMaybe Natural
_maxTxSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._maxTxSize
    , HKD StrictMaybe Natural
_maxBHSize :: HKD StrictMaybe Natural
_maxBHSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._maxBHSize
    , HKD StrictMaybe Coin
_keyDeposit :: HKD StrictMaybe Coin
_keyDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Babbage._keyDeposit
    , HKD StrictMaybe Coin
_poolDeposit :: HKD StrictMaybe Coin
_poolDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Babbage._poolDeposit
    , HKD StrictMaybe EpochNo
_eMax :: HKD StrictMaybe EpochNo
_eMax :: forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
Babbage._eMax
    , HKD StrictMaybe Natural
_nOpt :: HKD StrictMaybe Natural
_nOpt :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._nOpt
    , HKD StrictMaybe NonNegativeInterval
_a0 :: HKD StrictMaybe NonNegativeInterval
_a0 :: forall (f :: * -> *) era.
PParams' f era -> HKD f NonNegativeInterval
Babbage._a0
    , HKD StrictMaybe UnitInterval
_rho :: HKD StrictMaybe UnitInterval
_rho :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Babbage._rho
    , HKD StrictMaybe UnitInterval
_tau :: HKD StrictMaybe UnitInterval
_tau :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Babbage._tau
    , HKD StrictMaybe ProtVer
_protocolVersion :: HKD StrictMaybe ProtVer
_protocolVersion :: forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
Babbage._protocolVersion
    , HKD StrictMaybe Coin
_minPoolCost :: HKD StrictMaybe Coin
_minPoolCost :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Babbage._minPoolCost
    , HKD StrictMaybe Coin
_coinsPerUTxOByte :: HKD StrictMaybe Coin
_coinsPerUTxOByte :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Babbage._coinsPerUTxOByte
    , HKD StrictMaybe CostModels
_costmdls :: HKD StrictMaybe CostModels
_costmdls :: forall (f :: * -> *) era. PParams' f era -> HKD f CostModels
Babbage._costmdls
    , HKD StrictMaybe Prices
_prices :: HKD StrictMaybe Prices
_prices :: forall (f :: * -> *) era. PParams' f era -> HKD f Prices
Babbage._prices
    , HKD StrictMaybe ExUnits
_maxTxExUnits :: HKD StrictMaybe ExUnits
_maxTxExUnits :: forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
Babbage._maxTxExUnits
    , HKD StrictMaybe ExUnits
_maxBlockExUnits :: HKD StrictMaybe ExUnits
_maxBlockExUnits :: forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
Babbage._maxBlockExUnits
    , HKD StrictMaybe Natural
_maxValSize :: HKD StrictMaybe Natural
_maxValSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._maxValSize
    , HKD StrictMaybe Natural
_collateralPercentage :: HKD StrictMaybe Natural
_collateralPercentage :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._collateralPercentage
    , HKD StrictMaybe Natural
_maxCollateralInputs :: HKD StrictMaybe Natural
_maxCollateralInputs :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._maxCollateralInputs
    } =
    ProtocolParametersUpdate :: Maybe (Natural, Natural)
-> Maybe Rational
-> Maybe (Maybe PraosNonce)
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe Lovelace
-> Maybe EpochNo
-> Maybe Natural
-> Maybe Rational
-> Maybe Rational
-> Maybe Rational
-> Maybe Lovelace
-> Map AnyPlutusScriptVersion CostModel
-> Maybe ExecutionUnitPrices
-> Maybe ExecutionUnits
-> Maybe ExecutionUnits
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> ProtocolParametersUpdate
ProtocolParametersUpdate {
      protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
protocolUpdateProtocolVersion     = (\(Ledger.ProtVer Natural
a Natural
b) -> (Natural
a,Natural
b)) (ProtVer -> (Natural, Natural))
-> Maybe ProtVer -> Maybe (Natural, Natural)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                          StrictMaybe ProtVer -> Maybe ProtVer
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe ProtVer
HKD StrictMaybe ProtVer
_protocolVersion
    , 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 Natural
protocolUpdateMaxBlockHeaderSize  = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_maxBHSize
    , protocolUpdateMaxBlockBodySize :: Maybe Natural
protocolUpdateMaxBlockBodySize    = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_maxBBSize
    , protocolUpdateMaxTxSize :: Maybe Natural
protocolUpdateMaxTxSize           = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_maxTxSize
    , protocolUpdateTxFeeFixed :: Maybe Natural
protocolUpdateTxFeeFixed          = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_minfeeB
    , protocolUpdateTxFeePerByte :: Maybe Natural
protocolUpdateTxFeePerByte        = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_minfeeA
    , protocolUpdateMinUTxOValue :: Maybe Lovelace
protocolUpdateMinUTxOValue        = Maybe Lovelace
forall a. Maybe a
Nothing
    , protocolUpdateStakeAddressDeposit :: Maybe Lovelace
protocolUpdateStakeAddressDeposit = Coin -> Lovelace
fromShelleyLovelace (Coin -> Lovelace) -> Maybe Coin -> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Coin
HKD StrictMaybe Coin
_keyDeposit
    , protocolUpdateStakePoolDeposit :: Maybe Lovelace
protocolUpdateStakePoolDeposit    = Coin -> Lovelace
fromShelleyLovelace (Coin -> Lovelace) -> Maybe Coin -> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Coin
HKD StrictMaybe Coin
_poolDeposit
    , protocolUpdateMinPoolCost :: Maybe Lovelace
protocolUpdateMinPoolCost         = Coin -> Lovelace
fromShelleyLovelace (Coin -> Lovelace) -> Maybe Coin -> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Coin
HKD StrictMaybe Coin
_minPoolCost
    , protocolUpdatePoolRetireMaxEpoch :: Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch  = StrictMaybe EpochNo -> Maybe EpochNo
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe EpochNo
HKD StrictMaybe EpochNo
_eMax
    , protocolUpdateStakePoolTargetNum :: Maybe Natural
protocolUpdateStakePoolTargetNum  = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_nOpt
    , 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 StrictMaybe NonNegativeInterval
HKD StrictMaybe NonNegativeInterval
_a0
    , 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 StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
_rho
    , 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 StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
_tau
    , protocolUpdateUTxOCostPerWord :: Maybe Lovelace
protocolUpdateUTxOCostPerWord     = Maybe Lovelace
forall a. Maybe a
Nothing
    , protocolUpdateCostModels :: Map AnyPlutusScriptVersion CostModel
protocolUpdateCostModels          = Map AnyPlutusScriptVersion CostModel
-> (CostModels -> Map AnyPlutusScriptVersion CostModel)
-> Maybe CostModels
-> Map AnyPlutusScriptVersion CostModel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map AnyPlutusScriptVersion CostModel
forall a. Monoid a => a
mempty CostModels -> Map AnyPlutusScriptVersion CostModel
fromAlonzoCostModels
                                               (StrictMaybe CostModels -> Maybe CostModels
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe CostModels
HKD StrictMaybe CostModels
_costmdls)
    , protocolUpdatePrices :: Maybe ExecutionUnitPrices
protocolUpdatePrices              = Prices -> ExecutionUnitPrices
fromAlonzoPrices (Prices -> ExecutionUnitPrices)
-> Maybe Prices -> Maybe ExecutionUnitPrices
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Prices -> Maybe Prices
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Prices
HKD StrictMaybe Prices
_prices
    , protocolUpdateMaxTxExUnits :: Maybe ExecutionUnits
protocolUpdateMaxTxExUnits        = ExUnits -> ExecutionUnits
fromAlonzoExUnits (ExUnits -> ExecutionUnits)
-> Maybe ExUnits -> Maybe ExecutionUnits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe ExUnits -> Maybe ExUnits
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe ExUnits
HKD StrictMaybe ExUnits
_maxTxExUnits
    , protocolUpdateMaxBlockExUnits :: Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits     = ExUnits -> ExecutionUnits
fromAlonzoExUnits (ExUnits -> ExecutionUnits)
-> Maybe ExUnits -> Maybe ExecutionUnits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe ExUnits -> Maybe ExUnits
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe ExUnits
HKD StrictMaybe ExUnits
_maxBlockExUnits
    , protocolUpdateMaxValueSize :: Maybe Natural
protocolUpdateMaxValueSize        = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_maxValSize
    , protocolUpdateCollateralPercent :: Maybe Natural
protocolUpdateCollateralPercent   = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_collateralPercentage
    , protocolUpdateMaxCollateralInputs :: Maybe Natural
protocolUpdateMaxCollateralInputs = StrictMaybe Natural -> Maybe Natural
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Natural
HKD StrictMaybe Natural
_maxCollateralInputs
    , protocolUpdateUTxOCostPerByte :: Maybe Lovelace
protocolUpdateUTxOCostPerByte     = Coin -> Lovelace
fromShelleyLovelace (Coin -> Lovelace) -> Maybe Coin -> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                            StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Coin
HKD StrictMaybe Coin
_coinsPerUTxOByte
    }


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

--TODO: this has to be a Maybe or Either for some of the parameter validation.
-- Both parameters that must be present or absent in specific eras,
-- and parameter values that need validation, such as the Rational values
toLedgerPParams
  :: ShelleyBasedEra era
  -> ProtocolParameters
  -> Ledger.PParams (ShelleyLedgerEra era)
toLedgerPParams :: ShelleyBasedEra era
-> ProtocolParameters -> PParams (ShelleyLedgerEra era)
toLedgerPParams ShelleyBasedEra era
ShelleyBasedEraShelley = ProtocolParameters -> PParams (ShelleyLedgerEra era)
forall ledgerera. ProtocolParameters -> PParams ledgerera
toShelleyPParams
toLedgerPParams ShelleyBasedEra era
ShelleyBasedEraAllegra = ProtocolParameters -> PParams (ShelleyLedgerEra era)
forall ledgerera. ProtocolParameters -> PParams ledgerera
toShelleyPParams
toLedgerPParams ShelleyBasedEra era
ShelleyBasedEraMary    = ProtocolParameters -> PParams (ShelleyLedgerEra era)
forall ledgerera. ProtocolParameters -> PParams ledgerera
toShelleyPParams
toLedgerPParams ShelleyBasedEra era
ShelleyBasedEraAlonzo  = ProtocolParameters -> PParams (ShelleyLedgerEra era)
forall ledgerera. ProtocolParameters -> PParams ledgerera
toAlonzoPParams
toLedgerPParams ShelleyBasedEra era
ShelleyBasedEraBabbage = ProtocolParameters -> PParams (ShelleyLedgerEra era)
forall ledgerera. ProtocolParameters -> PParams ledgerera
toBabbagePParams

toShelleyPParams :: ProtocolParameters -> Shelley.PParams ledgerera
toShelleyPParams :: ProtocolParameters -> PParams ledgerera
toShelleyPParams ProtocolParameters {
                   (Natural, Natural)
protocolParamProtocolVersion :: (Natural, Natural)
protocolParamProtocolVersion :: ProtocolParameters -> (Natural, Natural)
protocolParamProtocolVersion,
                   Maybe Rational
protocolParamDecentralization :: Maybe Rational
protocolParamDecentralization :: ProtocolParameters -> Maybe Rational
protocolParamDecentralization,
                   Maybe PraosNonce
protocolParamExtraPraosEntropy :: Maybe PraosNonce
protocolParamExtraPraosEntropy :: ProtocolParameters -> Maybe PraosNonce
protocolParamExtraPraosEntropy,
                   Natural
protocolParamMaxBlockHeaderSize :: Natural
protocolParamMaxBlockHeaderSize :: ProtocolParameters -> Natural
protocolParamMaxBlockHeaderSize,
                   Natural
protocolParamMaxBlockBodySize :: Natural
protocolParamMaxBlockBodySize :: ProtocolParameters -> Natural
protocolParamMaxBlockBodySize,
                   Natural
protocolParamMaxTxSize :: Natural
protocolParamMaxTxSize :: ProtocolParameters -> Natural
protocolParamMaxTxSize,
                   Natural
protocolParamTxFeeFixed :: Natural
protocolParamTxFeeFixed :: ProtocolParameters -> Natural
protocolParamTxFeeFixed,
                   Natural
protocolParamTxFeePerByte :: Natural
protocolParamTxFeePerByte :: ProtocolParameters -> Natural
protocolParamTxFeePerByte,
                   protocolParamMinUTxOValue :: ProtocolParameters -> Maybe Lovelace
protocolParamMinUTxOValue = Just Lovelace
minUTxOValue,
                   Lovelace
protocolParamStakeAddressDeposit :: Lovelace
protocolParamStakeAddressDeposit :: ProtocolParameters -> Lovelace
protocolParamStakeAddressDeposit,
                   Lovelace
protocolParamStakePoolDeposit :: Lovelace
protocolParamStakePoolDeposit :: ProtocolParameters -> Lovelace
protocolParamStakePoolDeposit,
                   Lovelace
protocolParamMinPoolCost :: Lovelace
protocolParamMinPoolCost :: ProtocolParameters -> Lovelace
protocolParamMinPoolCost,
                   EpochNo
protocolParamPoolRetireMaxEpoch :: EpochNo
protocolParamPoolRetireMaxEpoch :: ProtocolParameters -> EpochNo
protocolParamPoolRetireMaxEpoch,
                   Natural
protocolParamStakePoolTargetNum :: Natural
protocolParamStakePoolTargetNum :: ProtocolParameters -> Natural
protocolParamStakePoolTargetNum,
                   Rational
protocolParamPoolPledgeInfluence :: Rational
protocolParamPoolPledgeInfluence :: ProtocolParameters -> Rational
protocolParamPoolPledgeInfluence,
                   Rational
protocolParamMonetaryExpansion :: Rational
protocolParamMonetaryExpansion :: ProtocolParameters -> Rational
protocolParamMonetaryExpansion,
                   Rational
protocolParamTreasuryCut :: Rational
protocolParamTreasuryCut :: ProtocolParameters -> Rational
protocolParamTreasuryCut
                 } =
   PParams :: forall (f :: * -> *) era.
HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Coin
-> HKD f Coin
-> HKD f EpochNo
-> HKD f Natural
-> HKD f NonNegativeInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f Nonce
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> PParams' f era
Shelley.PParams
     { _protocolVersion :: HKD Identity ProtVer
Shelley._protocolVersion
                             = let (Natural
maj, Natural
minor) = (Natural, Natural)
protocolParamProtocolVersion
                                in Natural -> Natural -> ProtVer
Ledger.ProtVer Natural
maj Natural
minor
     , _d :: HKD Identity UnitInterval
Shelley._d            = case Maybe Rational
protocolParamDecentralization of
                                 -- The decentralization parameter is deprecated in Babbage
                                 -- so we default to 0 if no dentralization parameter is found
                                 -- in the api's 'ProtocolParameter' type. If we don't do this
                                 -- we won't be able to construct an Alonzo tx using the Babbage
                                 -- era's protocol parameter because our only other option is to
                                 -- error.
                                 Maybe Rational
Nothing -> HKD Identity UnitInterval
forall a. Bounded a => a
minBound
                                 Just Rational
pDecentral ->
                                   UnitInterval -> Maybe UnitInterval -> UnitInterval
forall a. a -> Maybe a -> a
fromMaybe
                                     (String -> UnitInterval
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: invalid Decentralization value")
                                     (Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
pDecentral)
     , _extraEntropy :: HKD Identity Nonce
Shelley._extraEntropy = Maybe PraosNonce -> Nonce
toLedgerNonce Maybe PraosNonce
protocolParamExtraPraosEntropy
     , _maxBHSize :: HKD Identity Natural
Shelley._maxBHSize    = Natural
HKD Identity Natural
protocolParamMaxBlockHeaderSize
     , _maxBBSize :: HKD Identity Natural
Shelley._maxBBSize    = Natural
HKD Identity Natural
protocolParamMaxBlockBodySize
     , _maxTxSize :: HKD Identity Natural
Shelley._maxTxSize    = Natural
HKD Identity Natural
protocolParamMaxTxSize
     , _minfeeB :: HKD Identity Natural
Shelley._minfeeB      = Natural
HKD Identity Natural
protocolParamTxFeeFixed
     , _minfeeA :: HKD Identity Natural
Shelley._minfeeA      = Natural
HKD Identity Natural
protocolParamTxFeePerByte
     , _minUTxOValue :: HKD Identity Coin
Shelley._minUTxOValue = Lovelace -> Coin
toShelleyLovelace Lovelace
minUTxOValue
     , _keyDeposit :: HKD Identity Coin
Shelley._keyDeposit   = Lovelace -> Coin
toShelleyLovelace Lovelace
protocolParamStakeAddressDeposit
     , _poolDeposit :: HKD Identity Coin
Shelley._poolDeposit  = Lovelace -> Coin
toShelleyLovelace Lovelace
protocolParamStakePoolDeposit
     , _minPoolCost :: HKD Identity Coin
Shelley._minPoolCost  = Lovelace -> Coin
toShelleyLovelace Lovelace
protocolParamMinPoolCost
     , _eMax :: HKD Identity EpochNo
Shelley._eMax         = EpochNo
HKD Identity EpochNo
protocolParamPoolRetireMaxEpoch
     , _nOpt :: HKD Identity Natural
Shelley._nOpt         = Natural
HKD Identity Natural
protocolParamStakePoolTargetNum
     , _a0 :: HKD Identity NonNegativeInterval
Shelley._a0           = NonNegativeInterval
-> Maybe NonNegativeInterval -> NonNegativeInterval
forall a. a -> Maybe a -> a
fromMaybe
                                 (String -> NonNegativeInterval
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: invalid PoolPledgeInfluence value")
                                 (Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
protocolParamPoolPledgeInfluence)
     , _rho :: HKD Identity UnitInterval
Shelley._rho          = UnitInterval -> Maybe UnitInterval -> UnitInterval
forall a. a -> Maybe a -> a
fromMaybe
                                 (String -> UnitInterval
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: invalid MonetaryExpansion value")
                                 (Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
protocolParamMonetaryExpansion)
     , _tau :: HKD Identity UnitInterval
Shelley._tau          = UnitInterval -> Maybe UnitInterval -> UnitInterval
forall a. a -> Maybe a -> a
fromMaybe
                                 (String -> UnitInterval
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: invalid TreasuryCut value")
                                 (Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
protocolParamTreasuryCut)
     }
toShelleyPParams ProtocolParameters { protocolParamMinUTxOValue :: ProtocolParameters -> Maybe Lovelace
protocolParamMinUTxOValue = Maybe Lovelace
Nothing } =
  String -> PParams ledgerera
forall a. HasCallStack => String -> a
error String
"toShelleyPParams: must specify protocolParamMinUTxOValue"

toAlonzoPParams :: ProtocolParameters -> Alonzo.PParams ledgerera
toAlonzoPParams :: ProtocolParameters -> PParams ledgerera
toAlonzoPParams ProtocolParameters {
                   (Natural, Natural)
protocolParamProtocolVersion :: (Natural, Natural)
protocolParamProtocolVersion :: ProtocolParameters -> (Natural, Natural)
protocolParamProtocolVersion,
                   Maybe Rational
protocolParamDecentralization :: Maybe Rational
protocolParamDecentralization :: ProtocolParameters -> Maybe Rational
protocolParamDecentralization,
                   Maybe PraosNonce
protocolParamExtraPraosEntropy :: Maybe PraosNonce
protocolParamExtraPraosEntropy :: ProtocolParameters -> Maybe PraosNonce
protocolParamExtraPraosEntropy,
                   Natural
protocolParamMaxBlockHeaderSize :: Natural
protocolParamMaxBlockHeaderSize :: ProtocolParameters -> Natural
protocolParamMaxBlockHeaderSize,
                   Natural
protocolParamMaxBlockBodySize :: Natural
protocolParamMaxBlockBodySize :: ProtocolParameters -> Natural
protocolParamMaxBlockBodySize,
                   Natural
protocolParamMaxTxSize :: Natural
protocolParamMaxTxSize :: ProtocolParameters -> Natural
protocolParamMaxTxSize,
                   Natural
protocolParamTxFeeFixed :: Natural
protocolParamTxFeeFixed :: ProtocolParameters -> Natural
protocolParamTxFeeFixed,
                   Natural
protocolParamTxFeePerByte :: Natural
protocolParamTxFeePerByte :: ProtocolParameters -> Natural
protocolParamTxFeePerByte,
                   Lovelace
protocolParamStakeAddressDeposit :: Lovelace
protocolParamStakeAddressDeposit :: ProtocolParameters -> Lovelace
protocolParamStakeAddressDeposit,
                   Lovelace
protocolParamStakePoolDeposit :: Lovelace
protocolParamStakePoolDeposit :: ProtocolParameters -> Lovelace
protocolParamStakePoolDeposit,
                   Lovelace
protocolParamMinPoolCost :: Lovelace
protocolParamMinPoolCost :: ProtocolParameters -> Lovelace
protocolParamMinPoolCost,
                   EpochNo
protocolParamPoolRetireMaxEpoch :: EpochNo
protocolParamPoolRetireMaxEpoch :: ProtocolParameters -> EpochNo
protocolParamPoolRetireMaxEpoch,
                   Natural
protocolParamStakePoolTargetNum :: Natural
protocolParamStakePoolTargetNum :: ProtocolParameters -> Natural
protocolParamStakePoolTargetNum,
                   Rational
protocolParamPoolPledgeInfluence :: Rational
protocolParamPoolPledgeInfluence :: ProtocolParameters -> Rational
protocolParamPoolPledgeInfluence,
                   Rational
protocolParamMonetaryExpansion :: Rational
protocolParamMonetaryExpansion :: ProtocolParameters -> Rational
protocolParamMonetaryExpansion,
                   Rational
protocolParamTreasuryCut :: Rational
protocolParamTreasuryCut :: ProtocolParameters -> Rational
protocolParamTreasuryCut,
                   Maybe Lovelace
protocolParamUTxOCostPerWord :: Maybe Lovelace
protocolParamUTxOCostPerWord :: ProtocolParameters -> Maybe Lovelace
protocolParamUTxOCostPerWord,
                   Map AnyPlutusScriptVersion CostModel
protocolParamCostModels :: Map AnyPlutusScriptVersion CostModel
protocolParamCostModels :: ProtocolParameters -> Map AnyPlutusScriptVersion CostModel
protocolParamCostModels,
                   protocolParamPrices :: ProtocolParameters -> Maybe ExecutionUnitPrices
protocolParamPrices          = Just ExecutionUnitPrices
prices,
                   protocolParamMaxTxExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxTxExUnits    = Just ExecutionUnits
maxTxExUnits,
                   protocolParamMaxBlockExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxBlockExUnits = Just ExecutionUnits
maxBlockExUnits,
                   protocolParamMaxValueSize :: ProtocolParameters -> Maybe Natural
protocolParamMaxValueSize    = Just Natural
maxValueSize,
                   protocolParamCollateralPercent :: ProtocolParameters -> Maybe Natural
protocolParamCollateralPercent   = Just Natural
collateralPercentage,
                   protocolParamMaxCollateralInputs :: ProtocolParameters -> Maybe Natural
protocolParamMaxCollateralInputs = Just Natural
maxCollateralInputs,
                   Maybe Lovelace
protocolParamUTxOCostPerByte :: Maybe Lovelace
protocolParamUTxOCostPerByte :: ProtocolParameters -> Maybe Lovelace
protocolParamUTxOCostPerByte
                 } =
    let !coinsPerUTxOWord :: Lovelace
coinsPerUTxOWord = Lovelace -> Maybe Lovelace -> Lovelace
forall a. a -> Maybe a -> a
fromMaybe
          (String -> Lovelace
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: must specify protocolParamUTxOCostPerWord or protocolParamUTxOCostPerByte") (Maybe Lovelace -> Lovelace) -> Maybe Lovelace -> Lovelace
forall a b. (a -> b) -> a -> b
$
            Maybe Lovelace
protocolParamUTxOCostPerWord Maybe Lovelace -> Maybe Lovelace -> Maybe Lovelace
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Lovelace -> Lovelace -> Lovelace
forall a. Num a => a -> a -> a
* Lovelace
8) (Lovelace -> Lovelace) -> Maybe Lovelace -> Maybe Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Lovelace
protocolParamUTxOCostPerByte)
    in
    PParams :: forall (f :: * -> *) era.
HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Coin
-> HKD f Coin
-> HKD f EpochNo
-> HKD f Natural
-> HKD f NonNegativeInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f Nonce
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> HKD f CostModels
-> HKD f Prices
-> HKD f ExUnits
-> HKD f ExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> PParams' f era
Alonzo.PParams {
      _protocolVersion :: HKD Identity ProtVer
Alonzo._protocolVersion
                           = let (Natural
maj, Natural
minor) = (Natural, Natural)
protocolParamProtocolVersion
                              in Natural -> Natural -> ProtVer
Ledger.ProtVer Natural
maj Natural
minor
    , _d :: HKD Identity UnitInterval
Alonzo._d            = case Maybe Rational
protocolParamDecentralization of
                                 -- The decentralization parameter is deprecated in Babbage
                                 -- so we default to 0 if no dentralization parameter is found
                                 -- in the api's 'ProtocolParameter' type. If we don't do this
                                 -- we won't be able to construct an Alonzo tx using the Babbage
                                 -- era's protocol parameter because our only other option is to
                                 -- error.
                                 Maybe Rational
Nothing -> HKD Identity UnitInterval
forall a. Bounded a => a
minBound
                                 Just Rational
pDecentral ->
                                   UnitInterval -> Maybe UnitInterval -> UnitInterval
forall a. a -> Maybe a -> a
fromMaybe
                                     (String -> UnitInterval
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: invalid Decentralization value")
                                     (Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
pDecentral)
    , _extraEntropy :: HKD Identity Nonce
Alonzo._extraEntropy = Maybe PraosNonce -> Nonce
toLedgerNonce Maybe PraosNonce
protocolParamExtraPraosEntropy
    , _maxBHSize :: HKD Identity Natural
Alonzo._maxBHSize    = Natural
HKD Identity Natural
protocolParamMaxBlockHeaderSize
    , _maxBBSize :: HKD Identity Natural
Alonzo._maxBBSize    = Natural
HKD Identity Natural
protocolParamMaxBlockBodySize
    , _maxTxSize :: HKD Identity Natural
Alonzo._maxTxSize    = Natural
HKD Identity Natural
protocolParamMaxTxSize
    , _minfeeB :: HKD Identity Natural
Alonzo._minfeeB      = Natural
HKD Identity Natural
protocolParamTxFeeFixed
    , _minfeeA :: HKD Identity Natural
Alonzo._minfeeA      = Natural
HKD Identity Natural
protocolParamTxFeePerByte
    , _keyDeposit :: HKD Identity Coin
Alonzo._keyDeposit   = Lovelace -> Coin
toShelleyLovelace Lovelace
protocolParamStakeAddressDeposit
    , _poolDeposit :: HKD Identity Coin
Alonzo._poolDeposit  = Lovelace -> Coin
toShelleyLovelace Lovelace
protocolParamStakePoolDeposit
    , _minPoolCost :: HKD Identity Coin
Alonzo._minPoolCost  = Lovelace -> Coin
toShelleyLovelace Lovelace
protocolParamMinPoolCost
    , _eMax :: HKD Identity EpochNo
Alonzo._eMax         = EpochNo
HKD Identity EpochNo
protocolParamPoolRetireMaxEpoch
    , _nOpt :: HKD Identity Natural
Alonzo._nOpt         = Natural
HKD Identity Natural
protocolParamStakePoolTargetNum
    , _a0 :: HKD Identity NonNegativeInterval
Alonzo._a0           = NonNegativeInterval
-> Maybe NonNegativeInterval -> NonNegativeInterval
forall a. a -> Maybe a -> a
fromMaybe
                               (String -> NonNegativeInterval
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: invalid PoolPledgeInfluence value")
                               (Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
protocolParamPoolPledgeInfluence)
    , _rho :: HKD Identity UnitInterval
Alonzo._rho          = UnitInterval -> Maybe UnitInterval -> UnitInterval
forall a. a -> Maybe a -> a
fromMaybe
                               (String -> UnitInterval
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: invalid MonetaryExpansion value")
                               (Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
protocolParamMonetaryExpansion)
    , _tau :: HKD Identity UnitInterval
Alonzo._tau          = UnitInterval -> Maybe UnitInterval -> UnitInterval
forall a. a -> Maybe a -> a
fromMaybe
                               (String -> UnitInterval
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: invalid TreasuryCut value")
                               (Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
protocolParamTreasuryCut)

      -- New params in Alonzo:
    , _coinsPerUTxOWord :: HKD Identity Coin
Alonzo._coinsPerUTxOWord  = Lovelace -> Coin
toShelleyLovelace Lovelace
coinsPerUTxOWord
    , _costmdls :: HKD Identity CostModels
Alonzo._costmdls        = (String -> CostModels)
-> (CostModels -> CostModels)
-> Either String CostModels
-> CostModels
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                                  (\String
e -> String -> CostModels
forall a. HasCallStack => String -> a
error (String -> CostModels) -> String -> CostModels
forall a b. (a -> b) -> a -> b
$ String
"toAlonzoPParams: invalid cost models, error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e)
                                  CostModels -> CostModels
forall a. a -> a
id
                                  (Map AnyPlutusScriptVersion CostModel -> Either String CostModels
toAlonzoCostModels Map AnyPlutusScriptVersion CostModel
protocolParamCostModels)
    , _prices :: HKD Identity Prices
Alonzo._prices          = Prices -> Maybe Prices -> Prices
forall a. a -> Maybe a -> a
fromMaybe
                                  (String -> Prices
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: invalid Price values")
                                  (ExecutionUnitPrices -> Maybe Prices
toAlonzoPrices ExecutionUnitPrices
prices)
    , _maxTxExUnits :: HKD Identity ExUnits
Alonzo._maxTxExUnits    = ExecutionUnits -> ExUnits
toAlonzoExUnits ExecutionUnits
maxTxExUnits
    , _maxBlockExUnits :: HKD Identity ExUnits
Alonzo._maxBlockExUnits = ExecutionUnits -> ExUnits
toAlonzoExUnits ExecutionUnits
maxBlockExUnits
    , _maxValSize :: HKD Identity Natural
Alonzo._maxValSize      = Natural
HKD Identity Natural
maxValueSize
    , _collateralPercentage :: HKD Identity Natural
Alonzo._collateralPercentage = Natural
HKD Identity Natural
collateralPercentage
    , _maxCollateralInputs :: HKD Identity Natural
Alonzo._maxCollateralInputs  = Natural
HKD Identity Natural
maxCollateralInputs
    }
toAlonzoPParams ProtocolParameters { protocolParamUTxOCostPerWord :: ProtocolParameters -> Maybe Lovelace
protocolParamUTxOCostPerWord = Maybe Lovelace
Nothing } =
  String -> PParams ledgerera
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: must specify protocolParamUTxOCostPerWord"
toAlonzoPParams ProtocolParameters { protocolParamPrices :: ProtocolParameters -> Maybe ExecutionUnitPrices
protocolParamPrices          = Maybe ExecutionUnitPrices
Nothing } =
  String -> PParams ledgerera
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: must specify protocolParamPrices"
toAlonzoPParams ProtocolParameters { protocolParamMaxTxExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxTxExUnits    = Maybe ExecutionUnits
Nothing } =
  String -> PParams ledgerera
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: must specify protocolParamMaxTxExUnits"
toAlonzoPParams ProtocolParameters { protocolParamMaxBlockExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxBlockExUnits = Maybe ExecutionUnits
Nothing } =
  String -> PParams ledgerera
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: must specify protocolParamMaxBlockExUnits"
toAlonzoPParams ProtocolParameters { protocolParamMaxValueSize :: ProtocolParameters -> Maybe Natural
protocolParamMaxValueSize    = Maybe Natural
Nothing } =
  String -> PParams ledgerera
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: must specify protocolParamMaxValueSize"
toAlonzoPParams ProtocolParameters { protocolParamCollateralPercent :: ProtocolParameters -> Maybe Natural
protocolParamCollateralPercent = Maybe Natural
Nothing } =
  String -> PParams ledgerera
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: must specify protocolParamCollateralPercent"
toAlonzoPParams ProtocolParameters { protocolParamMaxCollateralInputs :: ProtocolParameters -> Maybe Natural
protocolParamMaxCollateralInputs = Maybe Natural
Nothing } =
  String -> PParams ledgerera
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: must specify protocolParamMaxCollateralInputs"


toBabbagePParams :: ProtocolParameters -> Babbage.PParams ledgerera
toBabbagePParams :: ProtocolParameters -> PParams ledgerera
toBabbagePParams ProtocolParameters {
                   (Natural, Natural)
protocolParamProtocolVersion :: (Natural, Natural)
protocolParamProtocolVersion :: ProtocolParameters -> (Natural, Natural)
protocolParamProtocolVersion,
                   Natural
protocolParamMaxBlockHeaderSize :: Natural
protocolParamMaxBlockHeaderSize :: ProtocolParameters -> Natural
protocolParamMaxBlockHeaderSize,
                   Natural
protocolParamMaxBlockBodySize :: Natural
protocolParamMaxBlockBodySize :: ProtocolParameters -> Natural
protocolParamMaxBlockBodySize,
                   Natural
protocolParamMaxTxSize :: Natural
protocolParamMaxTxSize :: ProtocolParameters -> Natural
protocolParamMaxTxSize,
                   Natural
protocolParamTxFeeFixed :: Natural
protocolParamTxFeeFixed :: ProtocolParameters -> Natural
protocolParamTxFeeFixed,
                   Natural
protocolParamTxFeePerByte :: Natural
protocolParamTxFeePerByte :: ProtocolParameters -> Natural
protocolParamTxFeePerByte,
                   Lovelace
protocolParamStakeAddressDeposit :: Lovelace
protocolParamStakeAddressDeposit :: ProtocolParameters -> Lovelace
protocolParamStakeAddressDeposit,
                   Lovelace
protocolParamStakePoolDeposit :: Lovelace
protocolParamStakePoolDeposit :: ProtocolParameters -> Lovelace
protocolParamStakePoolDeposit,
                   Lovelace
protocolParamMinPoolCost :: Lovelace
protocolParamMinPoolCost :: ProtocolParameters -> Lovelace
protocolParamMinPoolCost,
                   EpochNo
protocolParamPoolRetireMaxEpoch :: EpochNo
protocolParamPoolRetireMaxEpoch :: ProtocolParameters -> EpochNo
protocolParamPoolRetireMaxEpoch,
                   Natural
protocolParamStakePoolTargetNum :: Natural
protocolParamStakePoolTargetNum :: ProtocolParameters -> Natural
protocolParamStakePoolTargetNum,
                   Rational
protocolParamPoolPledgeInfluence :: Rational
protocolParamPoolPledgeInfluence :: ProtocolParameters -> Rational
protocolParamPoolPledgeInfluence,
                   Rational
protocolParamMonetaryExpansion :: Rational
protocolParamMonetaryExpansion :: ProtocolParameters -> Rational
protocolParamMonetaryExpansion,
                   Rational
protocolParamTreasuryCut :: Rational
protocolParamTreasuryCut :: ProtocolParameters -> Rational
protocolParamTreasuryCut,
                   protocolParamUTxOCostPerByte :: ProtocolParameters -> Maybe Lovelace
protocolParamUTxOCostPerByte = Just Lovelace
utxoCostPerByte,
                   Map AnyPlutusScriptVersion CostModel
protocolParamCostModels :: Map AnyPlutusScriptVersion CostModel
protocolParamCostModels :: ProtocolParameters -> Map AnyPlutusScriptVersion CostModel
protocolParamCostModels,
                   protocolParamPrices :: ProtocolParameters -> Maybe ExecutionUnitPrices
protocolParamPrices          = Just ExecutionUnitPrices
prices,
                   protocolParamMaxTxExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxTxExUnits    = Just ExecutionUnits
maxTxExUnits,
                   protocolParamMaxBlockExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxBlockExUnits = Just ExecutionUnits
maxBlockExUnits,
                   protocolParamMaxValueSize :: ProtocolParameters -> Maybe Natural
protocolParamMaxValueSize    = Just Natural
maxValueSize,
                   protocolParamCollateralPercent :: ProtocolParameters -> Maybe Natural
protocolParamCollateralPercent   = Just Natural
collateralPercentage,
                   protocolParamMaxCollateralInputs :: ProtocolParameters -> Maybe Natural
protocolParamMaxCollateralInputs = Just Natural
maxCollateralInputs
                 } =
    PParams :: forall (f :: * -> *) era.
HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> HKD f Coin
-> HKD f Coin
-> HKD f EpochNo
-> HKD f Natural
-> HKD f NonNegativeInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> HKD f CostModels
-> HKD f Prices
-> HKD f ExUnits
-> HKD f ExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> PParams' f era
Babbage.PParams {
      _protocolVersion :: HKD Identity ProtVer
Babbage._protocolVersion
                           = let (Natural
maj, Natural
minor) = (Natural, Natural)
protocolParamProtocolVersion
                              in Natural -> Natural -> ProtVer
Ledger.ProtVer Natural
maj Natural
minor
    , _maxBHSize :: HKD Identity Natural
Babbage._maxBHSize    = Natural
HKD Identity Natural
protocolParamMaxBlockHeaderSize
    , _maxBBSize :: HKD Identity Natural
Babbage._maxBBSize    = Natural
HKD Identity Natural
protocolParamMaxBlockBodySize
    , _maxTxSize :: HKD Identity Natural
Babbage._maxTxSize    = Natural
HKD Identity Natural
protocolParamMaxTxSize
    , _minfeeB :: HKD Identity Natural
Babbage._minfeeB      = Natural
HKD Identity Natural
protocolParamTxFeeFixed
    , _minfeeA :: HKD Identity Natural
Babbage._minfeeA      = Natural
HKD Identity Natural
protocolParamTxFeePerByte
    , _keyDeposit :: HKD Identity Coin
Babbage._keyDeposit   = Lovelace -> Coin
toShelleyLovelace Lovelace
protocolParamStakeAddressDeposit
    , _poolDeposit :: HKD Identity Coin
Babbage._poolDeposit  = Lovelace -> Coin
toShelleyLovelace Lovelace
protocolParamStakePoolDeposit
    , _minPoolCost :: HKD Identity Coin
Babbage._minPoolCost  = Lovelace -> Coin
toShelleyLovelace Lovelace
protocolParamMinPoolCost
    , _eMax :: HKD Identity EpochNo
Babbage._eMax         = EpochNo
HKD Identity EpochNo
protocolParamPoolRetireMaxEpoch
    , _nOpt :: HKD Identity Natural
Babbage._nOpt         = Natural
HKD Identity Natural
protocolParamStakePoolTargetNum
    , _a0 :: HKD Identity NonNegativeInterval
Babbage._a0           = NonNegativeInterval
-> Maybe NonNegativeInterval -> NonNegativeInterval
forall a. a -> Maybe a -> a
fromMaybe
                               (String -> NonNegativeInterval
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: invalid PoolPledgeInfluence value")
                               (Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
protocolParamPoolPledgeInfluence)
    , _rho :: HKD Identity UnitInterval
Babbage._rho          = UnitInterval -> Maybe UnitInterval -> UnitInterval
forall a. a -> Maybe a -> a
fromMaybe
                               (String -> UnitInterval
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: invalid MonetaryExpansion value")
                               (Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
protocolParamMonetaryExpansion)
    , _tau :: HKD Identity UnitInterval
Babbage._tau          = UnitInterval -> Maybe UnitInterval -> UnitInterval
forall a. a -> Maybe a -> a
fromMaybe
                               (String -> UnitInterval
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: invalid TreasuryCut value")
                               (Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
protocolParamTreasuryCut)

      -- New params in Babbage.
    , _coinsPerUTxOByte :: HKD Identity Coin
Babbage._coinsPerUTxOByte = Lovelace -> Coin
toShelleyLovelace Lovelace
utxoCostPerByte

    , _costmdls :: HKD Identity CostModels
Babbage._costmdls        = (String -> CostModels)
-> (CostModels -> CostModels)
-> Either String CostModels
-> CostModels
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                                  (\String
e -> String -> CostModels
forall a. HasCallStack => String -> a
error (String -> CostModels) -> String -> CostModels
forall a b. (a -> b) -> a -> b
$ String
"toAlonzoPParams: invalid cost models, error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e)
                                  CostModels -> CostModels
forall a. a -> a
id
                                  (Map AnyPlutusScriptVersion CostModel -> Either String CostModels
toAlonzoCostModels Map AnyPlutusScriptVersion CostModel
protocolParamCostModels)
    , _prices :: HKD Identity Prices
Babbage._prices          = Prices -> Maybe Prices -> Prices
forall a. a -> Maybe a -> a
fromMaybe
                                  (String -> Prices
forall a. HasCallStack => String -> a
error String
"toAlonzoPParams: invalid Price values")
                                  (ExecutionUnitPrices -> Maybe Prices
toAlonzoPrices ExecutionUnitPrices
prices)
    , _maxTxExUnits :: HKD Identity ExUnits
Babbage._maxTxExUnits    = ExecutionUnits -> ExUnits
toAlonzoExUnits ExecutionUnits
maxTxExUnits
    , _maxBlockExUnits :: HKD Identity ExUnits
Babbage._maxBlockExUnits = ExecutionUnits -> ExUnits
toAlonzoExUnits ExecutionUnits
maxBlockExUnits
    , _maxValSize :: HKD Identity Natural
Babbage._maxValSize      = Natural
HKD Identity Natural
maxValueSize
    , _collateralPercentage :: HKD Identity Natural
Babbage._collateralPercentage = Natural
HKD Identity Natural
collateralPercentage
    , _maxCollateralInputs :: HKD Identity Natural
Babbage._maxCollateralInputs  = Natural
HKD Identity Natural
maxCollateralInputs
    }
toBabbagePParams ProtocolParameters { protocolParamUTxOCostPerByte :: ProtocolParameters -> Maybe Lovelace
protocolParamUTxOCostPerByte = Maybe Lovelace
Nothing } =
  String -> PParams ledgerera
forall a. HasCallStack => String -> a
error String
"toBabbagePParams: must specify protocolParamUTxOCostPerByte"
toBabbagePParams ProtocolParameters { protocolParamPrices :: ProtocolParameters -> Maybe ExecutionUnitPrices
protocolParamPrices          = Maybe ExecutionUnitPrices
Nothing } =
  String -> PParams ledgerera
forall a. HasCallStack => String -> a
error String
"toBabbagePParams: must specify protocolParamPrices"
toBabbagePParams ProtocolParameters { protocolParamMaxTxExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxTxExUnits    = Maybe ExecutionUnits
Nothing } =
  String -> PParams ledgerera
forall a. HasCallStack => String -> a
error String
"toBabbagePParams: must specify protocolParamMaxTxExUnits"
toBabbagePParams ProtocolParameters { protocolParamMaxBlockExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxBlockExUnits = Maybe ExecutionUnits
Nothing } =
  String -> PParams ledgerera
forall a. HasCallStack => String -> a
error String
"toBabbagePParams: must specify protocolParamMaxBlockExUnits"
toBabbagePParams ProtocolParameters { protocolParamMaxValueSize :: ProtocolParameters -> Maybe Natural
protocolParamMaxValueSize    = Maybe Natural
Nothing } =
  String -> PParams ledgerera
forall a. HasCallStack => String -> a
error String
"toBabbagePParams: must specify protocolParamMaxValueSize"
toBabbagePParams ProtocolParameters { protocolParamCollateralPercent :: ProtocolParameters -> Maybe Natural
protocolParamCollateralPercent = Maybe Natural
Nothing } =
  String -> PParams ledgerera
forall a. HasCallStack => String -> a
error String
"toBabbagePParams: must specify protocolParamCollateralPercent"
toBabbagePParams ProtocolParameters { protocolParamMaxCollateralInputs :: ProtocolParameters -> Maybe Natural
protocolParamMaxCollateralInputs = Maybe Natural
Nothing } =
  String -> PParams ledgerera
forall a. HasCallStack => String -> a
error String
"toBabbagePParams: must specify protocolParamMaxCollateralInputs"

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

fromLedgerPParams
  :: ShelleyBasedEra era
  -> Ledger.PParams (ShelleyLedgerEra era)
  -> ProtocolParameters
fromLedgerPParams :: ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era) -> ProtocolParameters
fromLedgerPParams ShelleyBasedEra era
ShelleyBasedEraShelley = PParams (ShelleyLedgerEra era) -> ProtocolParameters
forall ledgerera. PParams ledgerera -> ProtocolParameters
fromShelleyPParams
fromLedgerPParams ShelleyBasedEra era
ShelleyBasedEraAllegra = PParams (ShelleyLedgerEra era) -> ProtocolParameters
forall ledgerera. PParams ledgerera -> ProtocolParameters
fromShelleyPParams
fromLedgerPParams ShelleyBasedEra era
ShelleyBasedEraMary    = PParams (ShelleyLedgerEra era) -> ProtocolParameters
forall ledgerera. PParams ledgerera -> ProtocolParameters
fromShelleyPParams
fromLedgerPParams ShelleyBasedEra era
ShelleyBasedEraAlonzo  = PParams (ShelleyLedgerEra era) -> ProtocolParameters
forall ledgerera. PParams ledgerera -> ProtocolParameters
fromAlonzoPParams
fromLedgerPParams ShelleyBasedEra era
ShelleyBasedEraBabbage = PParams (ShelleyLedgerEra era) -> ProtocolParameters
forall ledgerera. PParams ledgerera -> ProtocolParameters
fromBabbagePParams


fromShelleyPParams :: Shelley.PParams ledgerera
                   -> ProtocolParameters
fromShelleyPParams :: PParams ledgerera -> ProtocolParameters
fromShelleyPParams
    Shelley.PParams {
      HKD Identity Natural
_minfeeA :: HKD Identity Natural
_minfeeA :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Shelley._minfeeA
    , HKD Identity Natural
_minfeeB :: HKD Identity Natural
_minfeeB :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Shelley._minfeeB
    , HKD Identity Natural
_maxBBSize :: HKD Identity Natural
_maxBBSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Shelley._maxBBSize
    , HKD Identity Natural
_maxTxSize :: HKD Identity Natural
_maxTxSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Shelley._maxTxSize
    , HKD Identity Natural
_maxBHSize :: HKD Identity Natural
_maxBHSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Shelley._maxBHSize
    , HKD Identity Coin
_keyDeposit :: HKD Identity Coin
_keyDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Shelley._keyDeposit
    , HKD Identity Coin
_poolDeposit :: HKD Identity Coin
_poolDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Shelley._poolDeposit
    , HKD Identity EpochNo
_eMax :: HKD Identity EpochNo
_eMax :: forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
Shelley._eMax
    , HKD Identity Natural
_nOpt :: HKD Identity Natural
_nOpt :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Shelley._nOpt
    , HKD Identity NonNegativeInterval
_a0 :: HKD Identity NonNegativeInterval
_a0 :: forall (f :: * -> *) era.
PParams' f era -> HKD f NonNegativeInterval
Shelley._a0
    , HKD Identity UnitInterval
_rho :: HKD Identity UnitInterval
_rho :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Shelley._rho
    , HKD Identity UnitInterval
_tau :: HKD Identity UnitInterval
_tau :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Shelley._tau
    , HKD Identity UnitInterval
_d :: HKD Identity UnitInterval
_d :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Shelley._d
    , HKD Identity Nonce
_extraEntropy :: HKD Identity Nonce
_extraEntropy :: forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
Shelley._extraEntropy
    , HKD Identity ProtVer
_protocolVersion :: HKD Identity ProtVer
_protocolVersion :: forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
Shelley._protocolVersion
    , HKD Identity Coin
_minUTxOValue :: HKD Identity Coin
_minUTxOValue :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Shelley._minUTxOValue
    , HKD Identity Coin
_minPoolCost :: HKD Identity Coin
_minPoolCost :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Shelley._minPoolCost
    } =
    ProtocolParameters :: (Natural, Natural)
-> Maybe Rational
-> Maybe PraosNonce
-> Natural
-> Natural
-> Natural
-> Natural
-> Natural
-> Maybe Lovelace
-> Lovelace
-> Lovelace
-> Lovelace
-> EpochNo
-> Natural
-> Rational
-> Rational
-> Rational
-> Maybe Lovelace
-> Map AnyPlutusScriptVersion CostModel
-> Maybe ExecutionUnitPrices
-> Maybe ExecutionUnits
-> Maybe ExecutionUnits
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> ProtocolParameters
ProtocolParameters {
      protocolParamProtocolVersion :: (Natural, Natural)
protocolParamProtocolVersion     = (\(Ledger.ProtVer Natural
a Natural
b) -> (Natural
a,Natural
b))
                                           ProtVer
HKD Identity ProtVer
_protocolVersion
    , protocolParamDecentralization :: Maybe Rational
protocolParamDecentralization    = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational UnitInterval
HKD Identity UnitInterval
_d
    , protocolParamExtraPraosEntropy :: Maybe PraosNonce
protocolParamExtraPraosEntropy   = Nonce -> Maybe PraosNonce
fromLedgerNonce Nonce
HKD Identity Nonce
_extraEntropy
    , protocolParamMaxBlockHeaderSize :: Natural
protocolParamMaxBlockHeaderSize  = Natural
HKD Identity Natural
_maxBHSize
    , protocolParamMaxBlockBodySize :: Natural
protocolParamMaxBlockBodySize    = Natural
HKD Identity Natural
_maxBBSize
    , protocolParamMaxTxSize :: Natural
protocolParamMaxTxSize           = Natural
HKD Identity Natural
_maxTxSize
    , protocolParamTxFeeFixed :: Natural
protocolParamTxFeeFixed          = Natural
HKD Identity Natural
_minfeeB
    , protocolParamTxFeePerByte :: Natural
protocolParamTxFeePerByte        = Natural
HKD Identity Natural
_minfeeA
    , protocolParamMinUTxOValue :: Maybe Lovelace
protocolParamMinUTxOValue        = Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just (Coin -> Lovelace
fromShelleyLovelace Coin
HKD Identity Coin
_minUTxOValue)
    , protocolParamStakeAddressDeposit :: Lovelace
protocolParamStakeAddressDeposit = Coin -> Lovelace
fromShelleyLovelace Coin
HKD Identity Coin
_keyDeposit
    , protocolParamStakePoolDeposit :: Lovelace
protocolParamStakePoolDeposit    = Coin -> Lovelace
fromShelleyLovelace Coin
HKD Identity Coin
_poolDeposit
    , protocolParamMinPoolCost :: Lovelace
protocolParamMinPoolCost         = Coin -> Lovelace
fromShelleyLovelace Coin
HKD Identity Coin
_minPoolCost
    , protocolParamPoolRetireMaxEpoch :: EpochNo
protocolParamPoolRetireMaxEpoch  = EpochNo
HKD Identity EpochNo
_eMax
    , protocolParamStakePoolTargetNum :: Natural
protocolParamStakePoolTargetNum  = Natural
HKD Identity Natural
_nOpt
    , protocolParamPoolPledgeInfluence :: Rational
protocolParamPoolPledgeInfluence = NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational NonNegativeInterval
HKD Identity NonNegativeInterval
_a0
    , protocolParamMonetaryExpansion :: Rational
protocolParamMonetaryExpansion   = UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational UnitInterval
HKD Identity UnitInterval
_rho
    , protocolParamTreasuryCut :: Rational
protocolParamTreasuryCut         = UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational UnitInterval
HKD Identity UnitInterval
_tau
    , protocolParamUTxOCostPerWord :: Maybe Lovelace
protocolParamUTxOCostPerWord     = Maybe Lovelace
forall a. Maybe a
Nothing    -- Only in Alonzo
    , protocolParamCostModels :: Map AnyPlutusScriptVersion CostModel
protocolParamCostModels          = Map AnyPlutusScriptVersion CostModel
forall k a. Map k a
Map.empty  -- 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 Lovelace
protocolParamUTxOCostPerByte     = Maybe Lovelace
forall a. Maybe a
Nothing    -- Only from babbage onwards
    }


fromAlonzoPParams :: Alonzo.PParams ledgerera -> ProtocolParameters
fromAlonzoPParams :: PParams ledgerera -> ProtocolParameters
fromAlonzoPParams
    Alonzo.PParams {
      HKD Identity Natural
_minfeeA :: HKD Identity Natural
_minfeeA :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._minfeeA
    , HKD Identity Natural
_minfeeB :: HKD Identity Natural
_minfeeB :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._minfeeB
    , HKD Identity Natural
_maxBBSize :: HKD Identity Natural
_maxBBSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._maxBBSize
    , HKD Identity Natural
_maxTxSize :: HKD Identity Natural
_maxTxSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._maxTxSize
    , HKD Identity Natural
_maxBHSize :: HKD Identity Natural
_maxBHSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._maxBHSize
    , HKD Identity Coin
_keyDeposit :: HKD Identity Coin
_keyDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Alonzo._keyDeposit
    , HKD Identity Coin
_poolDeposit :: HKD Identity Coin
_poolDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Alonzo._poolDeposit
    , HKD Identity EpochNo
_eMax :: HKD Identity EpochNo
_eMax :: forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
Alonzo._eMax
    , HKD Identity Natural
_nOpt :: HKD Identity Natural
_nOpt :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._nOpt
    , HKD Identity NonNegativeInterval
_a0 :: HKD Identity NonNegativeInterval
_a0 :: forall (f :: * -> *) era.
PParams' f era -> HKD f NonNegativeInterval
Alonzo._a0
    , HKD Identity UnitInterval
_rho :: HKD Identity UnitInterval
_rho :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Alonzo._rho
    , HKD Identity UnitInterval
_tau :: HKD Identity UnitInterval
_tau :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Alonzo._tau
    , HKD Identity UnitInterval
_d :: HKD Identity UnitInterval
_d :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Alonzo._d
    , HKD Identity Nonce
_extraEntropy :: HKD Identity Nonce
_extraEntropy :: forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
Alonzo._extraEntropy
    , HKD Identity ProtVer
_protocolVersion :: HKD Identity ProtVer
_protocolVersion :: forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
Alonzo._protocolVersion
    , HKD Identity Coin
_minPoolCost :: HKD Identity Coin
_minPoolCost :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Alonzo._minPoolCost
    , HKD Identity Coin
_coinsPerUTxOWord :: HKD Identity Coin
_coinsPerUTxOWord :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Alonzo._coinsPerUTxOWord
    , HKD Identity CostModels
_costmdls :: HKD Identity CostModels
_costmdls :: forall (f :: * -> *) era. PParams' f era -> HKD f CostModels
Alonzo._costmdls
    , HKD Identity Prices
_prices :: HKD Identity Prices
_prices :: forall (f :: * -> *) era. PParams' f era -> HKD f Prices
Alonzo._prices
    , HKD Identity ExUnits
_maxTxExUnits :: HKD Identity ExUnits
_maxTxExUnits :: forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
Alonzo._maxTxExUnits
    , HKD Identity ExUnits
_maxBlockExUnits :: HKD Identity ExUnits
_maxBlockExUnits :: forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
Alonzo._maxBlockExUnits
    , HKD Identity Natural
_maxValSize :: HKD Identity Natural
_maxValSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._maxValSize
    , HKD Identity Natural
_collateralPercentage :: HKD Identity Natural
_collateralPercentage :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._collateralPercentage
    , HKD Identity Natural
_maxCollateralInputs :: HKD Identity Natural
_maxCollateralInputs :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Alonzo._maxCollateralInputs
    } =
    ProtocolParameters :: (Natural, Natural)
-> Maybe Rational
-> Maybe PraosNonce
-> Natural
-> Natural
-> Natural
-> Natural
-> Natural
-> Maybe Lovelace
-> Lovelace
-> Lovelace
-> Lovelace
-> EpochNo
-> Natural
-> Rational
-> Rational
-> Rational
-> Maybe Lovelace
-> Map AnyPlutusScriptVersion CostModel
-> Maybe ExecutionUnitPrices
-> Maybe ExecutionUnits
-> Maybe ExecutionUnits
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> ProtocolParameters
ProtocolParameters {
      protocolParamProtocolVersion :: (Natural, Natural)
protocolParamProtocolVersion     = (\(Ledger.ProtVer Natural
a Natural
b) -> (Natural
a,Natural
b))
                                           ProtVer
HKD Identity ProtVer
_protocolVersion
    , protocolParamDecentralization :: Maybe Rational
protocolParamDecentralization    = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational UnitInterval
HKD Identity UnitInterval
_d
    , protocolParamExtraPraosEntropy :: Maybe PraosNonce
protocolParamExtraPraosEntropy   = Nonce -> Maybe PraosNonce
fromLedgerNonce Nonce
HKD Identity Nonce
_extraEntropy
    , protocolParamMaxBlockHeaderSize :: Natural
protocolParamMaxBlockHeaderSize  = Natural
HKD Identity Natural
_maxBHSize
    , protocolParamMaxBlockBodySize :: Natural
protocolParamMaxBlockBodySize    = Natural
HKD Identity Natural
_maxBBSize
    , protocolParamMaxTxSize :: Natural
protocolParamMaxTxSize           = Natural
HKD Identity Natural
_maxTxSize
    , protocolParamTxFeeFixed :: Natural
protocolParamTxFeeFixed          = Natural
HKD Identity Natural
_minfeeB
    , protocolParamTxFeePerByte :: Natural
protocolParamTxFeePerByte        = Natural
HKD Identity Natural
_minfeeA
    , protocolParamMinUTxOValue :: Maybe Lovelace
protocolParamMinUTxOValue        = Maybe Lovelace
forall a. Maybe a
Nothing
    , protocolParamStakeAddressDeposit :: Lovelace
protocolParamStakeAddressDeposit = Coin -> Lovelace
fromShelleyLovelace Coin
HKD Identity Coin
_keyDeposit
    , protocolParamStakePoolDeposit :: Lovelace
protocolParamStakePoolDeposit    = Coin -> Lovelace
fromShelleyLovelace Coin
HKD Identity Coin
_poolDeposit
    , protocolParamMinPoolCost :: Lovelace
protocolParamMinPoolCost         = Coin -> Lovelace
fromShelleyLovelace Coin
HKD Identity Coin
_minPoolCost
    , protocolParamPoolRetireMaxEpoch :: EpochNo
protocolParamPoolRetireMaxEpoch  = EpochNo
HKD Identity EpochNo
_eMax
    , protocolParamStakePoolTargetNum :: Natural
protocolParamStakePoolTargetNum  = Natural
HKD Identity Natural
_nOpt
    , protocolParamPoolPledgeInfluence :: Rational
protocolParamPoolPledgeInfluence = NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational NonNegativeInterval
HKD Identity NonNegativeInterval
_a0
    , protocolParamMonetaryExpansion :: Rational
protocolParamMonetaryExpansion   = UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational UnitInterval
HKD Identity UnitInterval
_rho
    , protocolParamTreasuryCut :: Rational
protocolParamTreasuryCut         = UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational UnitInterval
HKD Identity UnitInterval
_tau
    , protocolParamUTxOCostPerWord :: Maybe Lovelace
protocolParamUTxOCostPerWord     = Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just (Coin -> Lovelace
fromShelleyLovelace Coin
HKD Identity Coin
_coinsPerUTxOWord)
    , protocolParamCostModels :: Map AnyPlutusScriptVersion CostModel
protocolParamCostModels          = CostModels -> Map AnyPlutusScriptVersion CostModel
fromAlonzoCostModels CostModels
HKD Identity CostModels
_costmdls
    , protocolParamPrices :: Maybe ExecutionUnitPrices
protocolParamPrices              = ExecutionUnitPrices -> Maybe ExecutionUnitPrices
forall a. a -> Maybe a
Just (Prices -> ExecutionUnitPrices
fromAlonzoPrices Prices
HKD Identity Prices
_prices)
    , protocolParamMaxTxExUnits :: Maybe ExecutionUnits
protocolParamMaxTxExUnits        = ExecutionUnits -> Maybe ExecutionUnits
forall a. a -> Maybe a
Just (ExUnits -> ExecutionUnits
fromAlonzoExUnits ExUnits
HKD Identity ExUnits
_maxTxExUnits)
    , protocolParamMaxBlockExUnits :: Maybe ExecutionUnits
protocolParamMaxBlockExUnits     = ExecutionUnits -> Maybe ExecutionUnits
forall a. a -> Maybe a
Just (ExUnits -> ExecutionUnits
fromAlonzoExUnits ExUnits
HKD Identity ExUnits
_maxBlockExUnits)
    , protocolParamMaxValueSize :: Maybe Natural
protocolParamMaxValueSize        = Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
HKD Identity Natural
_maxValSize
    , protocolParamCollateralPercent :: Maybe Natural
protocolParamCollateralPercent   = Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
HKD Identity Natural
_collateralPercentage
    , protocolParamMaxCollateralInputs :: Maybe Natural
protocolParamMaxCollateralInputs = Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
HKD Identity Natural
_maxCollateralInputs
    , protocolParamUTxOCostPerByte :: Maybe Lovelace
protocolParamUTxOCostPerByte     = Maybe Lovelace
forall a. Maybe a
Nothing    -- Only from babbage onwards
    }

fromBabbagePParams :: Babbage.PParams ledgerera -> ProtocolParameters
fromBabbagePParams :: PParams ledgerera -> ProtocolParameters
fromBabbagePParams
    Babbage.PParams {
      HKD Identity Natural
_minfeeA :: HKD Identity Natural
_minfeeA :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._minfeeA
    , HKD Identity Natural
_minfeeB :: HKD Identity Natural
_minfeeB :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._minfeeB
    , HKD Identity Natural
_maxBBSize :: HKD Identity Natural
_maxBBSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._maxBBSize
    , HKD Identity Natural
_maxTxSize :: HKD Identity Natural
_maxTxSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._maxTxSize
    , HKD Identity Natural
_maxBHSize :: HKD Identity Natural
_maxBHSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._maxBHSize
    , HKD Identity Coin
_keyDeposit :: HKD Identity Coin
_keyDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Babbage._keyDeposit
    , HKD Identity Coin
_poolDeposit :: HKD Identity Coin
_poolDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Babbage._poolDeposit
    , HKD Identity EpochNo
_eMax :: HKD Identity EpochNo
_eMax :: forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
Babbage._eMax
    , HKD Identity Natural
_nOpt :: HKD Identity Natural
_nOpt :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._nOpt
    , HKD Identity NonNegativeInterval
_a0 :: HKD Identity NonNegativeInterval
_a0 :: forall (f :: * -> *) era.
PParams' f era -> HKD f NonNegativeInterval
Babbage._a0
    , HKD Identity UnitInterval
_rho :: HKD Identity UnitInterval
_rho :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Babbage._rho
    , HKD Identity UnitInterval
_tau :: HKD Identity UnitInterval
_tau :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
Babbage._tau
    , HKD Identity ProtVer
_protocolVersion :: HKD Identity ProtVer
_protocolVersion :: forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
Babbage._protocolVersion
    , HKD Identity Coin
_minPoolCost :: HKD Identity Coin
_minPoolCost :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Babbage._minPoolCost
    , HKD Identity Coin
_coinsPerUTxOByte :: HKD Identity Coin
_coinsPerUTxOByte :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Babbage._coinsPerUTxOByte
    , HKD Identity CostModels
_costmdls :: HKD Identity CostModels
_costmdls :: forall (f :: * -> *) era. PParams' f era -> HKD f CostModels
Babbage._costmdls
    , HKD Identity Prices
_prices :: HKD Identity Prices
_prices :: forall (f :: * -> *) era. PParams' f era -> HKD f Prices
Babbage._prices
    , HKD Identity ExUnits
_maxTxExUnits :: HKD Identity ExUnits
_maxTxExUnits :: forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
Babbage._maxTxExUnits
    , HKD Identity ExUnits
_maxBlockExUnits :: HKD Identity ExUnits
_maxBlockExUnits :: forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
Babbage._maxBlockExUnits
    , HKD Identity Natural
_maxValSize :: HKD Identity Natural
_maxValSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._maxValSize
    , HKD Identity Natural
_collateralPercentage :: HKD Identity Natural
_collateralPercentage :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._collateralPercentage
    , HKD Identity Natural
_maxCollateralInputs :: HKD Identity Natural
_maxCollateralInputs :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
Babbage._maxCollateralInputs
    } =
    ProtocolParameters :: (Natural, Natural)
-> Maybe Rational
-> Maybe PraosNonce
-> Natural
-> Natural
-> Natural
-> Natural
-> Natural
-> Maybe Lovelace
-> Lovelace
-> Lovelace
-> Lovelace
-> EpochNo
-> Natural
-> Rational
-> Rational
-> Rational
-> Maybe Lovelace
-> Map AnyPlutusScriptVersion CostModel
-> Maybe ExecutionUnitPrices
-> Maybe ExecutionUnits
-> Maybe ExecutionUnits
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Lovelace
-> ProtocolParameters
ProtocolParameters {
      protocolParamProtocolVersion :: (Natural, Natural)
protocolParamProtocolVersion     = (\(Ledger.ProtVer Natural
a Natural
b) -> (Natural
a,Natural
b))
                                           ProtVer
HKD Identity ProtVer
_protocolVersion
    , protocolParamDecentralization :: Maybe Rational
protocolParamDecentralization    = Maybe Rational
forall a. Maybe a
Nothing
    , protocolParamExtraPraosEntropy :: Maybe PraosNonce
protocolParamExtraPraosEntropy   = Maybe PraosNonce
forall a. Maybe a
Nothing
    , protocolParamMaxBlockHeaderSize :: Natural
protocolParamMaxBlockHeaderSize  = Natural
HKD Identity Natural
_maxBHSize
    , protocolParamMaxBlockBodySize :: Natural
protocolParamMaxBlockBodySize    = Natural
HKD Identity Natural
_maxBBSize
    , protocolParamMaxTxSize :: Natural
protocolParamMaxTxSize           = Natural
HKD Identity Natural
_maxTxSize
    , protocolParamTxFeeFixed :: Natural
protocolParamTxFeeFixed          = Natural
HKD Identity Natural
_minfeeB
    , protocolParamTxFeePerByte :: Natural
protocolParamTxFeePerByte        = Natural
HKD Identity Natural
_minfeeA
    , protocolParamMinUTxOValue :: Maybe Lovelace
protocolParamMinUTxOValue        = Maybe Lovelace
forall a. Maybe a
Nothing
    , protocolParamStakeAddressDeposit :: Lovelace
protocolParamStakeAddressDeposit = Coin -> Lovelace
fromShelleyLovelace Coin
HKD Identity Coin
_keyDeposit
    , protocolParamStakePoolDeposit :: Lovelace
protocolParamStakePoolDeposit    = Coin -> Lovelace
fromShelleyLovelace Coin
HKD Identity Coin
_poolDeposit
    , protocolParamMinPoolCost :: Lovelace
protocolParamMinPoolCost         = Coin -> Lovelace
fromShelleyLovelace Coin
HKD Identity Coin
_minPoolCost
    , protocolParamPoolRetireMaxEpoch :: EpochNo
protocolParamPoolRetireMaxEpoch  = EpochNo
HKD Identity EpochNo
_eMax
    , protocolParamStakePoolTargetNum :: Natural
protocolParamStakePoolTargetNum  = Natural
HKD Identity Natural
_nOpt
    , protocolParamPoolPledgeInfluence :: Rational
protocolParamPoolPledgeInfluence = NonNegativeInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational NonNegativeInterval
HKD Identity NonNegativeInterval
_a0
    , protocolParamMonetaryExpansion :: Rational
protocolParamMonetaryExpansion   = UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational UnitInterval
HKD Identity UnitInterval
_rho
    , protocolParamTreasuryCut :: Rational
protocolParamTreasuryCut         = UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational UnitInterval
HKD Identity UnitInterval
_tau
    , protocolParamUTxOCostPerWord :: Maybe Lovelace
protocolParamUTxOCostPerWord     = Maybe Lovelace
forall a. Maybe a
Nothing    -- Obsolete from babbage onwards
    , protocolParamCostModels :: Map AnyPlutusScriptVersion CostModel
protocolParamCostModels          = CostModels -> Map AnyPlutusScriptVersion CostModel
fromAlonzoCostModels CostModels
HKD Identity CostModels
_costmdls
    , protocolParamPrices :: Maybe ExecutionUnitPrices
protocolParamPrices              = ExecutionUnitPrices -> Maybe ExecutionUnitPrices
forall a. a -> Maybe a
Just (Prices -> ExecutionUnitPrices
fromAlonzoPrices Prices
HKD Identity Prices
_prices)
    , protocolParamMaxTxExUnits :: Maybe ExecutionUnits
protocolParamMaxTxExUnits        = ExecutionUnits -> Maybe ExecutionUnits
forall a. a -> Maybe a
Just (ExUnits -> ExecutionUnits
fromAlonzoExUnits ExUnits
HKD Identity ExUnits
_maxTxExUnits)
    , protocolParamMaxBlockExUnits :: Maybe ExecutionUnits
protocolParamMaxBlockExUnits     = ExecutionUnits -> Maybe ExecutionUnits
forall a. a -> Maybe a
Just (ExUnits -> ExecutionUnits
fromAlonzoExUnits ExUnits
HKD Identity ExUnits
_maxBlockExUnits)
    , protocolParamMaxValueSize :: Maybe Natural
protocolParamMaxValueSize        = Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
HKD Identity Natural
_maxValSize
    , protocolParamCollateralPercent :: Maybe Natural
protocolParamCollateralPercent   = Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
HKD Identity Natural
_collateralPercentage
    , protocolParamMaxCollateralInputs :: Maybe Natural
protocolParamMaxCollateralInputs = Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
HKD Identity Natural
_maxCollateralInputs
    , protocolParamUTxOCostPerByte :: Maybe Lovelace
protocolParamUTxOCostPerByte     = Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just (Coin -> Lovelace
fromShelleyLovelace Coin
HKD Identity Coin
_coinsPerUTxOByte)
    }

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
showList :: [ProtocolParametersError] -> ShowS
$cshowList :: [ProtocolParametersError] -> ShowS
show :: ProtocolParametersError -> String
$cshow :: ProtocolParametersError -> String
showsPrec :: Int -> ProtocolParametersError -> ShowS
$cshowsPrec :: Int -> ProtocolParametersError -> ShowS
Show

instance Error ProtocolParametersError where
  displayError :: ProtocolParametersError -> String
displayError (PParamsErrorMissingMinUTxoValue (AnyCardanoEra CardanoEra era
era)) =
   String
"The " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CardanoEra era -> String
forall a. Show a => a -> String
show CardanoEra era
era String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" protocol parameters value is missing the following \
       \field: MinUTxoValue. Did you intend to use a " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CardanoEra era -> String
forall a. Show a => a -> String
show CardanoEra era
era String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" protocol \
       \ parameters value?"
  displayError ProtocolParametersError
PParamsErrorMissingAlonzoProtocolParameter =
    String
"The Alonzo era protocol parameters in use is missing one or more of the \
    \following fields: UTxOCostPerWord, CostModels, Prices, MaxTxExUnits, \
    \MaxBlockExUnits, MaxValueSize, CollateralPercent, MaxCollateralInputs. Did \
    \you intend to use an Alonzo era protocol parameters value?"

checkProtocolParameters
  :: forall era. IsCardanoEra era
  => ShelleyBasedEra era
  -> ProtocolParameters
  -> Either ProtocolParametersError ()
checkProtocolParameters :: ShelleyBasedEra era
-> ProtocolParameters -> Either ProtocolParametersError ()
checkProtocolParameters ShelleyBasedEra era
sbe ProtocolParameters{Natural
Maybe Natural
Maybe Rational
Maybe ExecutionUnits
Maybe Lovelace
Maybe ExecutionUnitPrices
Maybe PraosNonce
Rational
(Natural, Natural)
Map AnyPlutusScriptVersion CostModel
EpochNo
Lovelace
protocolParamUTxOCostPerByte :: Maybe Lovelace
protocolParamMaxCollateralInputs :: Maybe Natural
protocolParamCollateralPercent :: Maybe Natural
protocolParamMaxValueSize :: Maybe Natural
protocolParamMaxBlockExUnits :: Maybe ExecutionUnits
protocolParamMaxTxExUnits :: Maybe ExecutionUnits
protocolParamPrices :: Maybe ExecutionUnitPrices
protocolParamCostModels :: Map AnyPlutusScriptVersion CostModel
protocolParamUTxOCostPerWord :: Maybe Lovelace
protocolParamTreasuryCut :: Rational
protocolParamMonetaryExpansion :: Rational
protocolParamPoolPledgeInfluence :: Rational
protocolParamStakePoolTargetNum :: Natural
protocolParamPoolRetireMaxEpoch :: EpochNo
protocolParamMinPoolCost :: Lovelace
protocolParamStakePoolDeposit :: Lovelace
protocolParamStakeAddressDeposit :: Lovelace
protocolParamMinUTxOValue :: Maybe Lovelace
protocolParamTxFeePerByte :: Natural
protocolParamTxFeeFixed :: Natural
protocolParamMaxTxSize :: Natural
protocolParamMaxBlockBodySize :: Natural
protocolParamMaxBlockHeaderSize :: Natural
protocolParamExtraPraosEntropy :: Maybe PraosNonce
protocolParamDecentralization :: Maybe Rational
protocolParamProtocolVersion :: (Natural, Natural)
protocolParamUTxOCostPerByte :: ProtocolParameters -> Maybe Lovelace
protocolParamMaxCollateralInputs :: ProtocolParameters -> Maybe Natural
protocolParamCollateralPercent :: ProtocolParameters -> Maybe Natural
protocolParamMaxValueSize :: ProtocolParameters -> Maybe Natural
protocolParamMaxBlockExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamMaxTxExUnits :: ProtocolParameters -> Maybe ExecutionUnits
protocolParamPrices :: ProtocolParameters -> Maybe ExecutionUnitPrices
protocolParamCostModels :: ProtocolParameters -> Map AnyPlutusScriptVersion CostModel
protocolParamUTxOCostPerWord :: ProtocolParameters -> Maybe Lovelace
protocolParamTreasuryCut :: ProtocolParameters -> Rational
protocolParamMonetaryExpansion :: ProtocolParameters -> Rational
protocolParamPoolPledgeInfluence :: ProtocolParameters -> Rational
protocolParamStakePoolTargetNum :: ProtocolParameters -> Natural
protocolParamPoolRetireMaxEpoch :: ProtocolParameters -> EpochNo
protocolParamMinPoolCost :: ProtocolParameters -> Lovelace
protocolParamStakePoolDeposit :: ProtocolParameters -> Lovelace
protocolParamStakeAddressDeposit :: ProtocolParameters -> Lovelace
protocolParamMinUTxOValue :: ProtocolParameters -> Maybe Lovelace
protocolParamTxFeePerByte :: ProtocolParameters -> Natural
protocolParamTxFeeFixed :: ProtocolParameters -> Natural
protocolParamMaxTxSize :: ProtocolParameters -> Natural
protocolParamMaxBlockBodySize :: ProtocolParameters -> Natural
protocolParamMaxBlockHeaderSize :: ProtocolParameters -> Natural
protocolParamExtraPraosEntropy :: ProtocolParameters -> Maybe PraosNonce
protocolParamDecentralization :: ProtocolParameters -> Maybe Rational
protocolParamProtocolVersion :: ProtocolParameters -> (Natural, Natural)
..} =
  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
 where
   era :: CardanoEra era
   era :: CardanoEra era
era = ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
shelleyBasedToCardanoEra ShelleyBasedEra era
sbe

   costPerWord :: Bool
costPerWord = Maybe Lovelace -> Bool
forall a. Maybe a -> Bool
isJust Maybe Lovelace
protocolParamUTxOCostPerWord
   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 Lovelace -> Bool
forall a. Maybe a -> Bool
isJust Maybe Lovelace
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
costPerWord
     ,     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 -> Bool
not Bool
costPerWord
     ,     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 (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 (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 Lovelace -> Bool
forall a. Maybe a -> Bool
isJust Maybe Lovelace
protocolParamMinUTxOValue
     then () -> Either ProtocolParametersError ()
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 -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era